diff options
Diffstat (limited to 'erts')
797 files changed, 51933 insertions, 52521 deletions
diff --git a/erts/AUTHORS b/erts/AUTHORS index d8746f65b2..5555502099 100644 --- a/erts/AUTHORS +++ b/erts/AUTHORS @@ -1,7 +1,7 @@ %CopyrightBegin% - Copyright Ericsson AB 1999-2009. All Rights Reserved. + Copyright Ericsson AB 1999-2016. All Rights Reserved. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. diff --git a/erts/Makefile.in b/erts/Makefile.in index feed00dad5..3052dc3065 100644 --- a/erts/Makefile.in +++ b/erts/Makefile.in @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2013. All Rights Reserved. +# Copyright Ericsson AB 2006-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index ec9b66bf29..86799186fd 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -1,7 +1,7 @@ dnl dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 1998-2015. All Rights Reserved. +dnl Copyright Ericsson AB 1998-2016. All Rights Reserved. dnl dnl Licensed under the Apache License, Version 2.0 (the "License"); dnl you may not use this file except in compliance with the License. @@ -74,21 +74,6 @@ AC_ARG_VAR(erl_xcomp_clock_gettime_cpu_time, [clock_gettime() can be used for re AC_ARG_VAR(erl_xcomp_after_morecore_hook, [__after_morecore_hook can track malloc()s core memory usage: yes|no (only used when cross compiling)]) AC_ARG_VAR(erl_xcomp_dlsym_brk_wrappers, [dlsym(RTLD_NEXT, _) brk wrappers can track malloc()s core memory usage: yes|no (only used when cross compiling)]) -dnl Cross compilation variables for OSE -AC_ARG_VAR(erl_xcomp_ose_ldflags_pass1, [Linker flags for the OSE module (pass 1) (only used when cross compiling for OSE)]) -AC_ARG_VAR(erl_xcomp_ose_ldflags_pass2, [Linker flags for the OSE module (pass 2) (only used when cross compiling for OSE)]) -AC_ARG_VAR(erl_xcomp_ose_OSEROOT, [OSE installation root directory (only used when cross compiling for OSE)]) -AC_ARG_VAR(erl_xcomp_ose_STRIP, [Strip utility shipped with the OSE distribution(only used when cross compiling for OSE)]) -AC_ARG_VAR(erl_xcomp_ose_LM_POST_LINK, [OSE postlink tool (only used when cross compiling for OSE)]) -AC_ARG_VAR(erl_xcomp_ose_LM_SET_CONF, [Sets the configuration for an OSE load module (only used when cross compiling for OSE)]) -AC_ARG_VAR(erl_xcomp_ose_LM_ELF_SIZE, [Prints the section size information for an OSE load module (only used when cross compiling for OSE)]) -AC_ARG_VAR(erl_xcomp_ose_LM_LCF, [OSE load module linker configuration file (only used when cross compiling for OSE)]) -AC_ARG_VAR(erl_xcomp_ose_BEAM_LM_CONF, [BEAM OSE load module default configuration file (only used when cross compiling for OSE)]) -AC_ARG_VAR(erl_xcomp_ose_EPMD_LM_CONF, [EPMD OSE load module default configuration file (only used when cross compiling for OSE)]) -AC_ARG_VAR(erl_xcomp_ose_RUN_ERL_LM_CONF, [run_erl_lm OSE load module default configuration file (only used when cross compiling for OSE)]) -AC_ARG_VAR(erl_xcomp_ose_CONFD, [OSE confd source file]) -AC_ARG_VAR(erl_xcomp_ose_CRT0_LM, [OSE crt0 lm source file]) - ]) AC_DEFUN(ERL_XCOMP_SYSROOT_INIT, @@ -503,8 +488,6 @@ AC_CACHE_VAL(ac_cv_sys_ipv6_support, #ifdef __WIN32__ #include <winsock2.h> #include <ws2tcpip.h> -#elif __OSE__ -#error "no ipv6" #else #include <netinet/in.h> #endif], @@ -517,8 +500,6 @@ else #ifdef __WIN32__ #include <winsock2.h> #include <ws2tcpip.h> -#elif __OSE__ -#error "no ipv6" #else #include <netinet/in.h> #endif], @@ -991,12 +972,6 @@ if test "X$host_os" = "Xwin32"; then THR_LIBS= THR_LIB_NAME=win32_threads THR_LIB_TYPE=win32_threads -elif test "X$host_os" = "Xose"; then - AC_MSG_RESULT(yes) - THR_DEFS="-DOSE_THREADS" - THR_LIBS= - THR_LIB_NAME=ose_threads - THR_LIB_TYPE=ose_threads else AC_MSG_RESULT(no) THR_DEFS= @@ -1583,22 +1558,9 @@ case "$THR_LIB_NAME" in fi ;; - pthread|ose_threads) - case "$THR_LIB_NAME" in - pthread) - ETHR_THR_LIB_BASE_DIR=pthread - AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) - ;; - ose_threads) - AC_DEFINE(ETHR_OSE_THREADS, 1, - [Define if you have OSE style threads]) - ETHR_THR_LIB_BASE_DIR=ose - AC_CHECK_HEADER(ose_spi/ose_spi.h, - AC_DEFINE(HAVE_OSE_SPI_H, 1, - [Define if you have the "ose_spi/ose_spi.h" header file.])) - ;; - esac - if test "x$THR_LIB_NAME" = "xpthread"; then + pthread) + ETHR_THR_LIB_BASE_DIR=pthread + AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) case $host_os in openbsd*) # The default stack size is insufficient for our needs @@ -1657,7 +1619,6 @@ case "$THR_LIB_NAME" in *) ;; esac - fi dnl We sometimes need ETHR_DEFS in order to find certain headers dnl (at least for pthread.h on osf1). saved_cppflags="$CPPFLAGS" @@ -1702,7 +1663,6 @@ case "$THR_LIB_NAME" in dnl dnl Check for functions dnl - if test "x$THR_LIB_NAME" = "xpthread"; then AC_CHECK_FUNC(pthread_spin_lock, \ [ethr_have_native_spinlock=yes \ AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \ @@ -1922,8 +1882,6 @@ case "$THR_LIB_NAME" in esac CFLAGS=$old_CFLAGS - fi ## test "x$THR_LIB_NAME" = "xpthread" - if test "X$disable_native_ethr_impls" = "Xyes"; then ethr_have_native_atomics=no else diff --git a/erts/autoconf/configure.vxworks b/erts/autoconf/configure.vxworks index 96dd1f8401..a13e0a6c56 100755 --- a/erts/autoconf/configure.vxworks +++ b/erts/autoconf/configure.vxworks @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2011. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/autoconf/vxworks/sed.general b/erts/autoconf/vxworks/sed.general index 5adee4db45..96a70e4148 100644 --- a/erts/autoconf/vxworks/sed.general +++ b/erts/autoconf/vxworks/sed.general @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2013. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/autoconf/vxworks/sed.vxworks_cpu32 b/erts/autoconf/vxworks/sed.vxworks_cpu32 index e3d54246ab..71663676e7 100644 --- a/erts/autoconf/vxworks/sed.vxworks_cpu32 +++ b/erts/autoconf/vxworks/sed.vxworks_cpu32 @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2010. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/autoconf/vxworks/sed.vxworks_ppc32 b/erts/autoconf/vxworks/sed.vxworks_ppc32 index 012760e127..2146e862fd 100644 --- a/erts/autoconf/vxworks/sed.vxworks_ppc32 +++ b/erts/autoconf/vxworks/sed.vxworks_ppc32 @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2013. All Rights Reserved. +# Copyright Ericsson AB 2006-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/autoconf/vxworks/sed.vxworks_ppc603 b/erts/autoconf/vxworks/sed.vxworks_ppc603 index 55af52571b..fca1ba76d9 100644 --- a/erts/autoconf/vxworks/sed.vxworks_ppc603 +++ b/erts/autoconf/vxworks/sed.vxworks_ppc603 @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2000-2010. All Rights Reserved. +# Copyright Ericsson AB 2000-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/autoconf/vxworks/sed.vxworks_ppc603_nolongcall b/erts/autoconf/vxworks/sed.vxworks_ppc603_nolongcall index e0c0891aeb..51c589d79a 100644 --- a/erts/autoconf/vxworks/sed.vxworks_ppc603_nolongcall +++ b/erts/autoconf/vxworks/sed.vxworks_ppc603_nolongcall @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2010. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/autoconf/vxworks/sed.vxworks_ppc860 b/erts/autoconf/vxworks/sed.vxworks_ppc860 index 8828339e34..485504e706 100644 --- a/erts/autoconf/vxworks/sed.vxworks_ppc860 +++ b/erts/autoconf/vxworks/sed.vxworks_ppc860 @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2010. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/autoconf/vxworks/sed.vxworks_simlinux b/erts/autoconf/vxworks/sed.vxworks_simlinux index 950fb79ec5..10cd7bbb82 100644 --- a/erts/autoconf/vxworks/sed.vxworks_simlinux +++ b/erts/autoconf/vxworks/sed.vxworks_simlinux @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2008-2013. All Rights Reserved. +# Copyright Ericsson AB 2008-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/autoconf/vxworks/sed.vxworks_simso b/erts/autoconf/vxworks/sed.vxworks_simso index 6f2796f04e..cd30f8c2b2 100644 --- a/erts/autoconf/vxworks/sed.vxworks_simso +++ b/erts/autoconf/vxworks/sed.vxworks_simso @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2013. All Rights Reserved. +# Copyright Ericsson AB 2005-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/autoconf/vxworks/sed.vxworks_sparc b/erts/autoconf/vxworks/sed.vxworks_sparc index e67c34af26..a3758423e8 100644 --- a/erts/autoconf/vxworks/sed.vxworks_sparc +++ b/erts/autoconf/vxworks/sed.vxworks_sparc @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/configure.in b/erts/configure.in index 4ade3b3086..11c428ced7 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-2015. All Rights Reserved. +dnl Copyright Ericsson AB 1997-2016. All Rights Reserved. dnl dnl Licensed under the Apache License, Version 2.0 (the "License"); dnl you may not use this file except in compliance with the License. @@ -106,7 +106,6 @@ AC_CONFIG_HEADER($host/config.h:config.h.in include/internal/$host/ethread_heade dnl ---------------------------------------------------------------------- dnl Optional features. dnl ---------------------------------------------------------------------- -enable_child_waiter_thread=no ENABLE_ALLOC_TYPE_VARS= AC_SUBST(ENABLE_ALLOC_TYPE_VARS) @@ -143,14 +142,6 @@ AS_HELP_STRING([--enable-dirty-schedulers], [enable dirty scheduler support]), *) enable_dirty_schedulers=yes ;; esac ], enable_dirty_schedulers=no) -AC_ARG_ENABLE(halfword-emulator, -AS_HELP_STRING([--enable-halfword-emulator], - [enable halfword emulator (only for 64bit builds). Note: Halfword emulator is marked as deprecated and scheduled for removal in future major release.]), -[ case "$enableval" in - no) enable_halfword_emualtor=no ;; - *) enable_halfword_emulator=yes ;; - esac ], enable_halfword_emulator=unknown) - AC_ARG_ENABLE(smp-support, AS_HELP_STRING([--enable-smp-support], [enable smp support]) AS_HELP_STRING([--disable-smp-support], [disable smp support]), @@ -224,24 +215,6 @@ AS_HELP_STRING([--enable-fp-exceptions], esac ],enable_fp_exceptions=auto) -AC_ARG_ENABLE(darwin-universal, -AS_HELP_STRING([--enable-darwin-universal], - [build universal binaries on darwin i386]), -[ case "$enableval" in - no) enable_darwin_universal=no ;; - *) enable_darwin_univeral=yes ;; - esac -],enable_darwin_universal=no) - - -AC_ARG_ENABLE(darwin-64bit, -AS_HELP_STRING([--enable-darwin-64bit], [build 64bit binaries on darwin]), -[ case "$enableval" in - no) enable_darwin_64bit=no ;; - *) enable_darwin_64bit=yes ;; - esac -],enable_darwin_64bit=no) - AC_ARG_ENABLE(m64-build, AS_HELP_STRING([--enable-m64-build], [build 64bit binaries using the -m64 flag to (g)cc]), @@ -256,18 +229,13 @@ AS_HELP_STRING([--enable-m32-build], [build 32bit binaries using the -m32 flag to (g)cc]), [ case "$enableval" in no) enable_m32_build=no ;; - *) - if test X${enable_darwin_64bit} = Xyes -o X${enable_m64_build} = Xyes; - then - AC_MSG_ERROR([(--enable-darwin-64bit or --enable-m64-build) and --enable-m32-build are mutually exclusive]) ; - fi ; - enable_m32_build=yes ;; + *) enable_m32_build=yes ;; esac ],enable_m32_build=no) AC_ARG_WITH(dynamic-trace, -AS_HELP_STRING([--with-dynamic-trace={dtrace|systemtap}], - [specify use of dynamic trace framework, dtrace or systemtap]) +AS_HELP_STRING([--with-dynamic-trace={dtrace|lttng|systemtap}], + [specify use of dynamic trace framework, dtrace, lttng or systemtap]) AS_HELP_STRING([--without-dynamic-trace], [don't enable any dynamic tracing (default)])) @@ -277,6 +245,10 @@ fi case "$with_dynamic_trace" in no) DYNAMIC_TRACE_FRAMEWORK=;; + lttng) + AC_DEFINE(USE_LTTNG,[1], + [Define if you want to use lttng for dynamic tracing]) + DYNAMIC_TRACE_FRAMEWORK=lttng;; dtrace) AC_DEFINE(USE_DTRACE,[1], [Define if you want to use dtrace for dynamic tracing]) @@ -312,10 +284,12 @@ AS_HELP_STRING([--enable-vm-probes], fi) AC_SUBST(USE_VM_PROBES) -if test X"$use_vm_probes" = X"yes"; then - USE_VM_PROBES=yes - AC_DEFINE(USE_VM_PROBES,[1], - [Define to enable VM dynamic trace probes]) +if test X"$DYNAMIC_TRACE_FRAMEWORK" != X"lttng"; then + if test X"$use_vm_probes" = X"yes"; then + USE_VM_PROBES=yes + AC_DEFINE(USE_VM_PROBES,[1], + [Define to enable VM dynamic trace probes]) + fi fi AC_ARG_WITH(assumed-cache-line-size, @@ -351,6 +325,21 @@ AS_HELP_STRING([--disable-saved-compile-time], [disable saved compile time]), AC_DEFINE_UNQUOTED(ERTS_SAVED_COMPILE_TIME, $save_compile_time, [Save compile time?]) +AC_ARG_WITH(microstate-accounting, +AS_HELP_STRING([--with-microstate-accounting={yes|extra}], + [enable microstate account, possibly with extra detailed states]) +AS_HELP_STRING([--without-microstate-accounting], + [don't enable microstate accounting]), +[],[with_microstate_accounting=yes]) + +case "$with_microstate_accounting" in + yes) AC_DEFINE(ERTS_ENABLE_MSACC,[1], + [Define as 1 if you want to enable microstate accounting, 2 if you want extra states]) ;; + extra) AC_DEFINE(ERTS_ENABLE_MSACC,[2], + [Define as 1 if you want to enable microstate accounting, 2 if you want extra states]) ;; + *) ;; +esac + dnl Magic test for clearcase. OTP_RELEASE= if test "${ERLANG_COMMERCIAL_BUILD}" != ""; then @@ -371,42 +360,7 @@ AC_MSG_CHECKING([OTP version]) AC_MSG_RESULT([$OTP_VERSION]) AC_SUBST(OTP_VERSION) -dnl OK, we might have darwin switches off different kinds, lets -dnl check it all before continuing. -TMPSYS=`uname -s`-`uname -m` -if test X${enable_darwin_universal} = Xyes; then - if test X${enable_darwin_64bit} = Xyes; then - AC_MSG_ERROR([--enable-darwin-universal and --enable-darwin-64bit mutually exclusive]) - fi - enable_hipe=no - case $CFLAGS in - *-arch\ ppc*) - ;; - *) - CFLAGS="-arch ppc $CFLAGS" - ;; - esac - case $CFLAGS in - *-arch\ i386*) - ;; - *) - CFLAGS="-arch i386 $CFLAGS" - ;; - esac -fi -if test X${enable_darwin_64bit} = Xyes; then - case "$TMPSYS" in - Darwin-i386|Darwin-x86_64) - ;; - Darwin*) - AC_MSG_ERROR([--enable-darwin-64bit only supported on x86 hosts]) - ;; - *) - AC_MSG_ERROR([--enable-darwin-64bit only supported on Darwin]) - ;; - esac -fi -if test X${enable_darwin_64bit} = Xyes -o X${enable_m64_build} = Xyes; then +if test X${enable_m64_build} = Xyes; then case $CFLAGS in *-m64*) ;; @@ -470,9 +424,6 @@ case $host_os in # -D_WIN32_WINNT=* from CPPFLAGS is saved in ETHR_DEFS. CPPFLAGS="$CPPFLAGS -D_WIN32_WINNT=0x0600 -DWINVER=0x0600" ;; - darwin*) - CPPFLAGS="$CPPFLAGS -D_XOPEN_SOURCE" - ;; *) ;; esac @@ -578,6 +529,7 @@ fi if test "x$GCC" = xyes; then # Treat certain GCC warnings as errors LM_TRY_ENABLE_CFLAG([-Werror=return-type], [WERRORFLAGS]) + LM_TRY_ENABLE_CFLAG([-Werror=implicit], [WERRORFLAGS]) # until the emulator can handle this, I suggest we turn it off! #WFLAGS="-Wall -Wshadow -Wcast-qual -Wmissing-declarations" @@ -731,32 +683,13 @@ case $ARCH-$OPSYS in esac ;; *-darwin*) - if test X${enable_darwin_universal} = Xyes; then - AC_MSG_NOTICE([Adjusting LDFLAGS for universal binaries]) - - case $LDFLAGS in - *-arch\ ppc*) - ;; - *) - LDFLAGS="-arch ppc $LDFLAGS" - ;; - esac - case $LDFLAGS in - *-arch\ i386*) - ;; - *) - LDFLAGS="-arch i386 $LDFLAGS" - ;; - esac - else - case $LDFLAGS in - *-m32*) - ;; - *) - LDFLAGS="-m32 $LDFLAGS" - ;; - esac - fi + case $LDFLAGS in + *-m32*) + ;; + *) + LDFLAGS="-m32 $LDFLAGS" + ;; + esac ;; *) if test X${enable_m64_build} = Xyes; then @@ -796,36 +729,18 @@ esac AC_SUBST(LIBCARBON) -dnl Check if we should/can build a halfword emulator - -AC_MSG_CHECKING(if we are building a halfword emulator (32bit heap on 64bit machine)) -if test "$enable_halfword_emulator" = "yes"; then - if test "$ARCH" = "amd64"; then - AC_DEFINE(HALFWORD_HEAP_EMULATOR, [1], - [Define if building a halfword-heap 64bit emulator]) - ENABLE_ALLOC_TYPE_VARS="$ENABLE_ALLOC_TYPE_VARS halfword" - AC_MSG_RESULT([yes]) - - test -f "$ERL_TOP/erts/CONF_INFO" || - echo "" > "$ERL_TOP/erts/CONF_INFO" - cat >> $ERL_TOP/erts/CONF_INFO <<EOF - - The HALFWORD emulator has been enabled. - This is a DEPRECATED feature scheduled for removal - in a future major release. +dnl Check if we should/can build a sharing-preserving emulator -EOF - else - AC_MSG_ERROR(no; halfword emulator not supported on this architecture) - fi +AC_MSG_CHECKING(if we are building a sharing-preserving emulator) +if test "$enable_sharing_preserving" = "yes"; then + AC_DEFINE(SHCOPY, [1], + [Define if building a sharing-preserving emulator]) + AC_MSG_RESULT([yes]) else AC_MSG_RESULT([no]) fi - - - dnl some tests below will call this if we haven't already - and autoconf dnl can't handle those tests being done conditionally at runtime AC_PROG_CPP @@ -944,10 +859,7 @@ dnl what the user say. This might not be the right way to do it, but dnl for now that is the way we do it. USER_LD=$LD USER_LDFLAGS="$LDFLAGS" -case $host in - *ose) ;; - *) LD='$(CC)' ;; -esac +LD='$(CC)' AC_SUBST(LD) LDFLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH" @@ -962,8 +874,6 @@ dnl This is the os flavour, should be unix, ose, vxworks or win32 case $host in win32) ERLANG_OSTYPE=win32 ;; - *ose) - ERLANG_OSTYPE=ose ;; *) ERLANG_OSTYPE=unix ;; esac @@ -1272,7 +1182,7 @@ case "$enable_threads"-"$found_threads" in AC_MSG_RESULT(yes; enabled by user) ;; unknown-yes) case $host_os in - solaris*|linux*|darwin*|win32|ose) + solaris*|linux*|darwin*|win32) emu_threads=yes AC_MSG_RESULT(yes; default on this platform) ;; @@ -1334,11 +1244,7 @@ else AC_MSG_RESULT(no) fi - disable_child_waiter_thread=no case $host_os in - solaris*) - enable_child_waiter_thread=yes - ;; linux*) AC_MSG_CHECKING([whether dlopen() needs to be called before first call to dlerror()]) if test "x$ETHR_THR_LIB_BASE_TYPE" != "xposix_nptl"; then @@ -1348,16 +1254,6 @@ else else AC_MSG_RESULT(no) fi - if test "x$ETHR_THR_LIB_BASE_TYPE" != "xposix_nptl"; then - # Child waiter thread cannot be enabled - disable_child_waiter_thread=yes - enable_child_waiter_thread=no - fi - ;; - win32|ose) - # Child waiter thread cannot be enabled - disable_child_waiter_thread=yes - enable_child_waiter_thread=no ;; *) ;; @@ -1377,24 +1273,6 @@ else esac done EMU_THR_DEFS=$new_emu_thr_defs - - AC_MSG_CHECKING(whether the child waiter thread should be enabled) - if test $enable_child_waiter_thread = yes; then - AC_DEFINE(ENABLE_CHILD_WAITER_THREAD,[1], - [Define if you want to enable child waiter thread]) - AC_MSG_RESULT(yes) - else - case $ERTS_BUILD_SMP_EMU-$disable_child_waiter_thread in - yes-no) - AC_MSG_RESULT([yes on SMP build, but not on non-SMP build]);; - *-yes) - AC_DEFINE(DISABLE_CHILD_WAITER_THREAD,[1], - [Define if you want to disable child waiter thread]) - AC_MSG_RESULT(no);; - *) - AC_MSG_RESULT(no);; - esac - fi fi AC_SUBST(EMU_THR_LIB_NAME) @@ -1526,19 +1404,27 @@ dnl # if -lsocket doesn't work by itself. #-------------------------------------------------------------------- +tk_oldLibs=$LIBS erl_checkBoth=0 +SOCKET_LIBS="" AC_CHECK_FUNC(connect, erl_checkSocket=0, erl_checkSocket=1) if test "$erl_checkSocket" = 1; then - AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", erl_checkBoth=1) + AC_CHECK_LIB(socket, main, SOCKET_LIBS="-lsocket", erl_checkBoth=1) fi + if test "$erl_checkBoth" = 1; then - tk_oldLibs=$LIBS LIBS="$LIBS -lsocket -lnsl" - AC_CHECK_FUNC(accept, erl_checkNsl=0, [LIBS=$tk_oldLibs]) + AC_CHECK_FUNC(accept, SOCKET_LIBS="-lsocket -lnsl") fi -AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"])) + +LIBS="$tk_oldLibs $SOCKET_LIBS" +AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [SOCKET_LIBS="$SOCKET_LIBS -lnsl"])) AC_CHECK_FUNC(gethostbyname_r,have_gethostbyname_r=yes) +LIBS="$tk_oldLibs $SOCKET_LIBS" + +AC_SUBST(SOCKET_LIBS) + dnl dnl These gethostbyname thingies use old style AC_DEFINE for BC with ancient dnl autoconf... @@ -1666,7 +1552,7 @@ AC_CHECK_HEADERS(fcntl.h limits.h unistd.h syslog.h dlfcn.h ieeefp.h \ sys/ioctl.h sys/time.h sys/uio.h \ sys/socket.h sys/sockio.h sys/socketio.h \ net/errno.h malloc.h arpa/nameser.h libdlpi.h \ - pty.h util.h utmp.h langinfo.h poll.h sdkddkver.h) + pty.h util.h libutil.h utmp.h langinfo.h poll.h sdkddkver.h) AC_CHECK_MEMBERS([struct ifreq.ifr_hwaddr], [], [], [#ifdef __WIN32__ @@ -2118,7 +2004,7 @@ AC_CHECK_FUNCS([getipnodebyname getipnodebyaddr gethostbyname2]) AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlopen \ pread pwrite memmove strerror strerror_r strncasecmp \ gethrtime localtime_r gmtime_r inet_pton \ - memcpy mallopt sbrk _sbrk __sbrk brk _brk __brk \ + mmap mremap memcpy mallopt sbrk _sbrk __sbrk brk _brk __brk \ flockfile fstat strlcpy strlcat setsid posix2time time2posix \ setlocale nl_langinfo poll mlockall ppoll]) @@ -2136,8 +2022,7 @@ fi case X$erl_xcomp_posix_memalign in Xno) ;; - Xyes) AC_DEFINE(HAVE_POSIX_MEMALIGN,[1], - [Define to 1 if you have the `posix_memalign' function.]) ;; + Xyes) have_posix_memalign=yes ;; *) AC_CHECK_FUNC( [posix_memalign], @@ -2152,15 +2037,19 @@ int main(void) { return error; return 0; } -],AC_DEFINE(HAVE_POSIX_MEMALIGN,[1], - [Define to 1 if you have the `posix_memalign' function.]) +],have_posix_memalign=yes ) else - AC_DEFINE(HAVE_POSIX_MEMALIGN,[1], - [Define to 1 if you have the `posix_memalign' function.]) + have_posix_memalign=yes fi]);; esac +if test $have_posix_memalign = yes; then + AC_DEFINE(HAVE_POSIX_MEMALIGN,[1], + [Define to 1 if you have the `posix_memalign' function.]) +fi + + dnl writev on OS X snow leopard is broken for files > 4GB case $host_os in darwin10.8.0) @@ -2170,17 +2059,6 @@ case $host_os in AC_CHECK_FUNCS([writev]) ;; esac -case $host_os in - *ose) - AC_MSG_CHECKING([for mmap]) - AC_MSG_RESULT(not using for OSE) - AC_MSG_CHECKING([for mremap]) - AC_MSG_RESULT(not using for OSE) ;; - *) - AC_CHECK_FUNCS([mmap mremap]) ;; -esac - - AC_CHECK_DECLS([posix2time, time2posix],,,[#include <time.h>]) disable_vfork=false @@ -2829,17 +2707,26 @@ LM_SYS_IPV6 LM_SYS_MULTICAST ERL_TIME_CORRECTION AC_CHECK_PROG(M4, m4, m4) + + +dnl HiPE cannot run on 64-bit without MAP_FIXED and MAP_NORESERVE +if test X${enable_hipe} != Xno && test X$ac_cv_sizeof_void_p != X4; then + AC_CHECK_DECLS([MAP_FIXED, MAP_NORESERVE], [], [], [#include <sys/mman.h>]) + if test X$ac_cv_have_decl_MAP_FIXED != Xyes || test X$ac_cv_have_decl_MAP_NORESERVE != Xyes; then + if test X${enable_hipe} = Xyes; then + AC_MSG_ERROR([HiPE on 64-bit needs MAP_FIXED and MAP_NORESERVE flags for mmap()]) + else + enable_hipe=no + AC_MSG_WARN([Disable HiPE due to lack of MAP_FIXED and MAP_NORESERVE flags for mmap()]) + fi + fi +fi + dnl check to auto-enable hipe here... if test "$cross_compiling" != "yes" && test X${enable_hipe} != Xno; then if test -z "$M4"; then enable_hipe=no AC_MSG_NOTICE([HiPE disabled as no valid m4 is found in PATH]) - elif test "$enable_halfword_emulator" = "yes"; then - if test X${enable_hipe} = Xyes; then - AC_MSG_ERROR([HiPE can not be combined with halfword emulator (yet)]) - else - AC_MSG_NOTICE([HiPE auto-disabled on halfword emulator]) - fi else case "$ARCH-$OPSYS" in x86-linux|amd64-linux|x86-darwin*|amd64-darwin*|ppc-linux|ppc64-linux|ppc-darwin|arm-linux|amd64-freebsd|x86-freebsd|x86-sol2|amd64-sol2|ultrasparc-linux) @@ -2849,44 +2736,6 @@ if test "$cross_compiling" != "yes" && test X${enable_hipe} != Xno; then fi fi -case $ARCH-$OPSYS in - amd64-darwin*|x86-darwin*) - AC_MSG_CHECKING([For modern (leopard) style mcontext_t]) - AC_TRY_COMPILE([ - #include <stdlib.h> - #include <sys/types.h> - #include <unistd.h> - #include <mach/mach.h> - #include <pthread.h> - #include <machine/signal.h> - #include <ucontext.h> - ],[ - #if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) - #define __DARWIN__ 1 - #endif - - #ifndef __DARWIN__ - #error inpossible - #else - - mcontext_t mc = NULL; - int x = mc->__fs.__fpu_mxcsr; - - #endif - ],darwin_mcontext_leopard=yes, - darwin_mcontext_leopard=no) - if test X"$darwin_mcontext_leopard" = X"yes"; then - AC_DEFINE(DARWIN_MODERN_MCONTEXT,[],[Modern style mcontext_t in MacOSX]) - AC_MSG_RESULT(yes) - else - AC_MSG_RESULT(no) - fi - ;; - *) - darwin_mcontext_leopard=no - ;; -esac - if test X${enable_fp_exceptions} = Xauto ; then case $host_os in *linux*) @@ -3502,6 +3351,13 @@ if test X${enable_hipe} = Xyes; then AC_DEFINE(HIPE,[1],[Define to enable HiPE]) HIPE_HELPERS="xmerl syntax_tools edoc" ENABLE_ALLOC_TYPE_VARS="$ENABLE_ALLOC_TYPE_VARS hipe" + case "$ARCH" in + amd64) + # For now exec_alloc is only used for hipe on amd64 + AC_MSG_NOTICE([Enable exec_alloc for hipe code allocation]) + ENABLE_ALLOC_TYPE_VARS="$ENABLE_ALLOC_TYPE_VARS exec_alloc" + ;; + esac fi fi AC_SUBST(HIPE_HELPERS) @@ -3768,7 +3624,7 @@ dnl crypto # #-------------------------------------------------------------------- -DED_SYS_INCLUDE="-I${ERL_TOP}/erts/emulator/beam -I${ERL_TOP}/erts/include -I${ERL_TOP}/erts/include/$host -I${ERL_TOP}/erts/include/internal -I${ERL_TOP}/erts/include/internal/$host -I${ERL_TOP}/erts/emulator/sys/$ERLANG_OSTYPE" +DED_SYS_INCLUDE="-I${ERL_TOP}/erts/emulator/beam -I${ERL_TOP}/erts/include -I${ERL_TOP}/erts/include/$host -I${ERL_TOP}/erts/include/internal -I${ERL_TOP}/erts/include/internal/$host -I${ERL_TOP}/erts/emulator/sys/$ERLANG_OSTYPE -I${ERL_TOP}/erts/emulator/sys/common" if test "X$ETHR_DEFS" = "X"; then DED_THR_DEFS="-D_THREAD_SAFE -D_REENTRANT" @@ -3827,14 +3683,8 @@ case $host_os in DED_LDFLAGS="-m64 $DED_LDFLAGS" ;; *) - if test X${enable_darwin_universal} != Xyes; then - DED_LDFLAGS="-m32 $DED_LDFLAGS" - fi ;; esac - if test X${enable_darwin_universal} = Xyes; then - DED_LDFLAGS="-arch ppc -arch i386 $DED_LDFLAGS" - fi DED_LD="$CC" DED_LD_FLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH" ;; @@ -3919,14 +3769,20 @@ dnl LM_FIND_EMU_CC dnl -dnl DTrace +dnl DTrace & LTTNG dnl case $DYNAMIC_TRACE_FRAMEWORK in dtrace|systemtap) AC_CHECK_TOOL(DTRACE, dtrace, none) test "$DTRACE" = "none" && AC_MSG_ERROR([No dtrace utility found.]); + enable_lttng_test=no enable_dtrace_test=yes;; - *) enable_dtrace_test=no;; + lttng) + enable_lttng_test=yes + enable_dtrace_test=no;; + *) + enable_lttng_test=no + enable_dtrace_test=no;; esac AC_SUBST(DTRACE) @@ -3993,6 +3849,37 @@ if test "$enable_dtrace_test" = "yes" ; then fi fi +if test "$enable_lttng_test" = "yes" ; then + AC_CHECK_HEADERS(lttng/tracepoint.h) + AC_CHECK_HEADERS(lttng/tracepoint-event.h) + dnl The macro tracepoint_enabled is not present in older lttng versions + dnl checking for tracepoint_enabled + AC_MSG_CHECKING([for tracepoint_enabled in lttng/tracepoint.h]) + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [#include <lttng/tracepoint.h> + #define TRACEPOINT_PROVIDER com_ericsson_otp + TRACEPOINT_EVENT( + com_ericsson_otp, + dummy, + TP_ARGS(int, my_int), + TP_FIELDS(ctf_integer(int, my_int, my_int))) + #define TRACEPOINT_CREATE_PROBES + #define TRACEPOINT_DEFINE], + [if(tracepoint_enabled(com_ericsson_otp,dummy)) do {} while(0)])], + [AC_MSG_RESULT([yes])], + [AC_MSG_ERROR([no (must be present)])]) + if test "x$ac_cv_header_lttng_tracepoint_h" = "xyes" \ + -a "x$ac_cv_header_lttng_tracepoint_event_h" = "xyes"; then + # No straight forward way to test for liblttng-ust when no public symbol exists, + # just add the lib. + LIBS="$LIBS -llttng-ust -ldl" + else + AC_MSG_ERROR([No LTTng support found.]) + fi +fi + + dnl dnl SSL, SSH and CRYPTO need the OpenSSL libraries dnl @@ -4940,7 +4827,6 @@ AC_OUTPUT( Makefile:Makefile.in ../make/$host/otp.mk:../make/otp.mk.in ../make/$host/otp_ded.mk:../make/otp_ded.mk.in - ../make/$host/ose_lm.mk:../make/ose_lm.mk.in dnl dnl The ones below should be moved to their respective lib dnl diff --git a/erts/doc/Makefile b/erts/doc/Makefile index d415e544f3..f26a43592e 100644 --- a/erts/doc/Makefile +++ b/erts/doc/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/doc/src/Makefile b/erts/doc/src/Makefile index 83f4c58560..b96cbbce40 100644 --- a/erts/doc/src/Makefile +++ b/erts/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2012. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -50,12 +50,14 @@ XML_REF1_FILES = epmd.xml \ XML_REF3_EFILES = \ erl_prim_loader.xml \ erlang.xml \ + erl_tracer.xml \ init.xml \ zlib.xml XML_REF3_FILES = \ driver_entry.xml \ erl_nif.xml \ + erl_tracer.xml \ erl_driver.xml \ erl_prim_loader.xml \ erlang.xml \ @@ -154,18 +156,9 @@ clean: rm -f $(SPECDIR)/* rm -f errs core *~ -$(SPECDIR)/specs_driver_entry.xml: +$(SPECDIR)/specs_%.xml: escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ - -o$(dir $@) -module driver_entry -$(SPECDIR)/specs_erl_nif.xml: - escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ - -o$(dir $@) -module erl_nif -$(SPECDIR)/specs_erl_driver.xml: - escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ - -o$(dir $@) -module erl_driver -$(SPECDIR)/specs_erts_alloc.xml: - escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ - -o$(dir $@) -module erts_alloc + -o$(dir $@) -module $(patsubst $(SPECDIR)/specs_%.xml,%,$@) # ---------------------------------------------------- # Release Target diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml index 186c9a1143..6d6ba224a0 100644 --- a/erts/doc/src/absform.xml +++ b/erts/doc/src/absform.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2001</year><year>2015</year> + <year>2001</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -68,31 +68,29 @@ <item>If D is a module declaration consisting of the forms <c>F_1</c>, ..., <c>F_k</c>, then Rep(D) = <c>[Rep(F_1), ..., Rep(F_k)]</c>.</item> - <item>If F is an attribute <c>-module(Mod)</c>, then - Rep(F) = <c>{attribute,LINE,module,Mod}</c>.</item> <item>If F is an attribute <c>-behavior(Behavior)</c>, then Rep(F) = <c>{attribute,LINE,behavior,Behavior}</c>.</item> <item>If F is an attribute <c>-behaviour(Behaviour)</c>, then Rep(F) = <c>{attribute,LINE,behaviour,Behaviour}</c>.</item> + <item>If F is an attribute <c>-compile(Options)</c>, then + Rep(F) = <c>{attribute,LINE,compile,Options}</c>.</item> <item>If F is an attribute <c>-export([Fun_1/A_1, ..., Fun_k/A_k])</c>, then Rep(F) = <c>{attribute,LINE,export,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}</c>.</item> - <item>If F is an attribute <c>-import(Mod,[Fun_1/A_1, ..., Fun_k/A_k])</c>, then - Rep(F) = <c>{attribute,LINE,import,{Mod,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}}</c>.</item> <item>If F is an attribute <c>-export_type([Type_1/A_1, ..., Type_k/A_k])</c>, then Rep(F) = <c>{attribute,LINE,export_type,[{Type_1,A_1}, ..., {Type_k,A_k}]}</c>.</item> - <item>If F is an attribute <c>-compile(Options)</c>, then - Rep(F) = <c>{attribute,LINE,compile,Options}</c>.</item> + <item>If F is an attribute <c>-import(Mod,[Fun_1/A_1, ..., Fun_k/A_k])</c>, then + Rep(F) = <c>{attribute,LINE,import,{Mod,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}}</c>.</item> + <item>If F is an attribute <c>-module(Mod)</c>, then + Rep(F) = <c>{attribute,LINE,module,Mod}</c>.</item> + <item>If F is an attribute <c>-optional_callbacks([Fun_1/A_1, ..., Fun_k/A_k])</c>, then + Rep(F) = <c>{attribute,LINE,optional_callbacks,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}</c>.</item> <item>If F is an attribute <c>-file(File,Line)</c>, then Rep(F) = <c>{attribute,LINE,file,{File,Line}}</c>.</item> - <item>If F is a record declaration - <c>-record(Name,{V_1, ..., V_k})</c>, then Rep(F) = - <c>{attribute,LINE,record,{Name,[Rep(V_1), ..., Rep(V_k)]}}</c>. - For Rep(V), see below.</item> - <item>If F is a type declaration - <c>-Type Name(V_1, ..., V_k) :: T</c>, where - <c>Type</c> is either the atom <c>type</c> or the atom <c>opaque</c>, - each <c>V_i</c> is a variable, and <c>T</c> is a type, then Rep(F) = - <c>{attribute,LINE,Type,{Name,Rep(T),[Rep(V_1), ..., Rep(V_k)]}}</c>. + <item>If F is a function declaration + <c>Name Fc_1 ; ... ; Name Fc_k</c>, + where each <c>Fc_i</c> is a function clause with a + pattern sequence of the same length <c>Arity</c>, then + Rep(F) = <c>{function,LINE,Name,Arity,[Rep(Fc_1), ...,Rep(Fc_k)]}</c>. </item> <item>If F is a function specification <c>-Spec Name Ft_1; ...; Ft_k</c>, @@ -109,15 +107,20 @@ <c>Arity</c>, then Rep(F) = <c>{attribute,Line,spec,{{Mod,Name,Arity},[Rep(Ft_1), ..., Rep(Ft_k)]}}</c>. </item> + <item>If F is a record declaration + <c>-record(Name,{V_1, ..., V_k})</c>, + where each <c>V_i</c> is a record field, then Rep(F) = + <c>{attribute,LINE,record,{Name,[Rep(V_1), ..., Rep(V_k)]}}</c>. + For Rep(V), see below.</item> + <item>If F is a type declaration + <c>-Type Name(V_1, ..., V_k) :: T</c>, where + <c>Type</c> is either the atom <c>type</c> or the atom <c>opaque</c>, + each <c>V_i</c> is a variable, and <c>T</c> is a type, then Rep(F) = + <c>{attribute,LINE,Type,{Name,Rep(T),[Rep(V_1), ..., Rep(V_k)]}}</c>. + </item> <item>If F is a wild attribute <c>-A(T)</c>, then Rep(F) = <c>{attribute,LINE,A,T}</c>. <br></br></item> - <item>If F is a function declaration - <c>Name Fc_1 ; ... ; Name Fc_k</c>, - where each <c>Fc_i</c> is a function clause with a - pattern sequence of the same length <c>Arity</c>, then - Rep(F) = <c>{function,LINE,Name,Arity,[Rep(Fc_1), ...,Rep(Fc_k)]}</c>. - </item> </list> <section> @@ -131,11 +134,6 @@ <item>If V is <c>A = E</c>, where <c>E</c> is an expression, then Rep(V) = <c>{record_field,LINE,Rep(A),Rep(E)}</c>.</item> - <item>If V is <c>A :: T</c>, where <c>T</c> is a - type and it does not contain - <c>undefined</c> syntactically, then Rep(V) = - <c>{typed_record_field,{record_field,LINE,Rep(A)},Rep(undefined | T)}</c>. - </item> <item>If V is <c>A :: T</c>, where <c>T</c> is a type, then Rep(V) = <c>{typed_record_field,{record_field,LINE,Rep(A)},Rep(T)}</c>. </item> @@ -162,15 +160,15 @@ <p>There are five kinds of atomic literals, which are represented in the same way in patterns, expressions and guards:</p> <list type="bulleted"> - <item>If L is an integer or character literal, then - Rep(L) = <c>{integer,LINE,L}</c>.</item> + <item>If L is an atom literal, then + Rep(L) = <c>{atom,LINE,L}</c>.</item> <item>If L is a float literal, then Rep(L) = <c>{float,LINE,L}</c>.</item> + <item>If L is an integer or character literal, then + Rep(L) = <c>{integer,LINE,L}</c>.</item> <item>If L is a string literal consisting of the characters <c>C_1</c>, ..., <c>C_k</c>, then Rep(L) = <c>{string,LINE,[C_1, ..., C_k]}</c>.</item> - <item>If L is an atom literal, then - Rep(L) = <c>{atom,LINE,L}</c>.</item> </list> <p>Note that negative integer and float literals do not occur as such; they are parsed as an application of the unary negation operator.</p> @@ -178,47 +176,59 @@ <section> <title>Patterns</title> - <p>If <c>Ps</c> is a sequence of patterns <c>P_1, ..., P_k</c>, then + <p>If Ps is a sequence of patterns <c>P_1, ..., P_k</c>, then Rep(Ps) = <c>[Rep(P_1), ..., Rep(P_k)]</c>. Such sequences occur as the list of arguments to a function or fun.</p> <p>Individual patterns are represented as follows:</p> <list type="bulleted"> - <item>If P is an atomic literal L, then Rep(P) = Rep(L).</item> + <item>If P is an atomic literal <c>L</c>, then Rep(P) = Rep(L).</item> + <item>If P is a bit string pattern + <c><<P_1:Size_1/TSL_1, ..., P_k:Size_k/TSL_k>></c>, where each + <c>Size_i</c> is an expression that can be evaluated to an integer + and each <c>TSL_i</c> is a type specificer list, then + Rep(P) = <c>{bin,LINE,[{bin_element,LINE,Rep(P_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(P_k),Rep(Size_k),Rep(TSL_k)}]}</c>. + For Rep(TSL), see below. + An omitted <c>Size_i</c> is represented by <c>default</c>. + An omitted <c>TSL_i</c> is represented by <c>default</c>.</item> <item>If P is a compound pattern <c>P_1 = P_2</c>, then Rep(P) = <c>{match,LINE,Rep(P_1),Rep(P_2)}</c>.</item> - <item>If P is a variable pattern <c>V</c>, then - Rep(P) = <c>{var,LINE,A}</c>, - where A is an atom with a printname consisting of the same characters as - <c>V</c>.</item> - <item>If P is a universal pattern <c>_</c>, then - Rep(P) = <c>{var,LINE,'_'}</c>.</item> - <item>If P is a tuple pattern <c>{P_1, ..., P_k}</c>, then - Rep(P) = <c>{tuple,LINE,[Rep(P_1), ..., Rep(P_k)]}</c>.</item> - <item>If P is a nil pattern <c>[]</c>, then - Rep(P) = <c>{nil,LINE}</c>.</item> <item>If P is a cons pattern <c>[P_h | P_t]</c>, then Rep(P) = <c>{cons,LINE,Rep(P_h),Rep(P_t)}</c>.</item> - <item>If E is a binary pattern <c><<P_1:Size_1/TSL_1, ..., P_k:Size_k/TSL_k>></c>, then - Rep(E) = <c>{bin,LINE,[{bin_element,LINE,Rep(P_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(P_k),Rep(Size_k),Rep(TSL_k)}]}</c>. - For Rep(TSL), see below. - An omitted <c>Size</c> is represented by <c>default</c>. An omitted <c>TSL</c> - (type specifier list) is represented by <c>default</c>.</item> - <item>If P is <c>P_1 Op P_2</c>, where <c>Op</c> is a binary operator (this - is either an occurrence of <c>++</c> applied to a literal string or character + <item>If P is a map pattern <c>#{A_1, ..., A_k}</c>, where each + <c>A_i</c> is an association <c>P_i_1 := P_i_2</c>, then Rep(P) = + <c>{map,LINE,[Rep(A_1), ..., Rep(A_k)]}</c>. For Rep(A), see + below.</item> + <item>If P is a nil pattern <c>[]</c>, then + Rep(P) = <c>{nil,LINE}</c>.</item> + <item>If P is an operator pattern <c>P_1 Op P_2</c>, + where <c>Op</c> is a binary operator (this is either an occurrence + of <c>++</c> applied to a literal string or character list, or an occurrence of an expression that can be evaluated to a number at compile time), then Rep(P) = <c>{op,LINE,Op,Rep(P_1),Rep(P_2)}</c>.</item> - <item>If P is <c>Op P_0</c>, where <c>Op</c> is a unary operator (this is an - occurrence of an expression that can be evaluated to a number at compile + <item>If P is an operator pattern <c>Op P_0</c>, + where <c>Op</c> is a unary operator (this is an occurrence of + an expression that can be evaluated to a number at compile time), then Rep(P) = <c>{op,LINE,Op,Rep(P_0)}</c>.</item> - <item>If P is a record pattern <c>#Name{Field_1=P_1, ..., Field_k=P_k}</c>, - then Rep(P) = - <c>{record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(P_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(P_k)}]}</c>.</item> - <item>If P is <c>#Name.Field</c>, then - Rep(P) = <c>{record_index,LINE,Name,Rep(Field)}</c>.</item> - <item>If P is <c>( P_0 )</c>, then + <item>If P is a parenthesized pattern <c>( P_0 )</c>, then Rep(P) = <c>Rep(P_0)</c>, - that is, patterns cannot be distinguished from their bodies.</item> + that is, parenthesized patterns cannot be distinguished from their + bodies.</item> + <item>If P is a record field index pattern <c>#Name.Field</c>, + where <c>Field</c> is an atom, then + Rep(P) = <c>{record_index,LINE,Name,Rep(Field)}</c>.</item> + <item>If P is a record pattern + <c>#Name{Field_1=P_1, ..., Field_k=P_k}</c>, + where each <c>Field_i</c> is an atom or <c>_</c>, then Rep(P) = + <c>{record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(P_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(P_k)}]}</c>.</item> + <item>If P is a tuple pattern <c>{P_1, ..., P_k}</c>, then + Rep(P) = <c>{tuple,LINE,[Rep(P_1), ..., Rep(P_k)]}</c>.</item> + <item>If P is a universal pattern <c>_</c>, then + Rep(P) = <c>{var,LINE,'_'}</c>.</item> + <item>If P is a variable pattern <c>V</c>, then + Rep(P) = <c>{var,LINE,A}</c>, + where A is an atom with a printname consisting of the same characters as + <c>V</c>.</item> </list> <p>Note that every pattern has the same source form as some expression, and is represented the same way as the corresponding expression.</p> @@ -226,167 +236,187 @@ <section> <title>Expressions</title> - <p>A body B is a sequence of expressions <c>E_1, ..., E_k</c>, and - Rep(B) = <c>[Rep(E_1), ..., Rep(E_k)]</c>.</p> + <p>A body B is a nonempty sequence of expressions <c>E_1, ..., E_k</c>, + and Rep(B) = <c>[Rep(E_1), ..., Rep(E_k)]</c>.</p> <p>An expression E is one of the following alternatives:</p> <list type="bulleted"> - <item>If P is an atomic literal <c>L</c>, then Rep(P) = Rep(L).</item> - <item>If E is <c>P = E_0</c>, then - Rep(E) = <c>{match,LINE,Rep(P),Rep(E_0)}</c>.</item> - <item>If E is a variable <c>V</c>, then Rep(E) = <c>{var,LINE,A}</c>, - where <c>A</c> is an atom with a printname consisting of the same - characters as <c>V</c>.</item> - <item>If E is a tuple skeleton <c>{E_1, ..., E_k}</c>, then - Rep(E) = <c>{tuple,LINE,[Rep(E_1), ..., Rep(E_k)]}</c>.</item> - <item>If E is <c>[]</c>, then - Rep(E) = <c>{nil,LINE}</c>.</item> - <item>If E is a cons skeleton <c>[E_h | E_t]</c>, then - Rep(E) = <c>{cons,LINE,Rep(E_h),Rep(E_t)}</c>.</item> - <item>If E is a binary constructor <c><<V_1:Size_1/TSL_1, ..., V_k:Size_k/TSL_k>></c>, then Rep(E) = - <c>{bin,LINE,[{bin_element,LINE,Rep(V_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(V_k),Rep(Size_k),Rep(TSL_k)}]}</c>. + <item>If E is an atomic literal <c>L</c>, then Rep(E) = Rep(L).</item> + <item>If E is a bit string comprehension + <c><<E_0 || Q_1, ..., Q_k>></c>, + where each <c>Q_i</c> is a qualifier, then + Rep(E) = <c>{bc,LINE,Rep(E_0),[Rep(Q_1), ..., Rep(Q_k)]}</c>. + For Rep(Q), see below.</item> + <item>If E is a bit string constructor + <c><<E_1:Size_1/TSL_1, ..., E_k:Size_k/TSL_k>></c>, + where each <c>Size_i</c> is an expression and each + <c>TSL_i</c> is a type specificer list, then Rep(E) = + <c>{bin,LINE,[{bin_element,LINE,Rep(E_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(E_k),Rep(Size_k),Rep(TSL_k)}]}</c>. For Rep(TSL), see below. - An omitted <c>Size</c> is represented by <c>default</c>. An omitted <c>TSL</c> - (type specifier list) is represented by <c>default</c>.</item> - <item>If E is <c>E_1 Op E_2</c>, where <c>Op</c> is a binary operator, - then Rep(E) = <c>{op,LINE,Op,Rep(E_1),Rep(E_2)}</c>.</item> - <item>If E is <c>Op E_0</c>, where <c>Op</c> is a unary operator, then - Rep(E) = <c>{op,LINE,Op,Rep(E_0)}</c>.</item> - <item>If E is <c>#Name{Field_1=E_1, ..., Field_k=E_k}</c>, - then Rep(E) = - <c>{record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}</c>.</item> - <item>If E is <c>E_0#Name{Field_1=E_1, ..., Field_k=E_k}</c>, then - Rep(E) = - <c>{record,LINE,Rep(E_0),Name,[{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}</c>.</item> - <item>If E is <c>#Name.Field</c>, then - Rep(E) = <c>{record_index,LINE,Name,Rep(Field)}</c>.</item> - <item>If E is <c>E_0#Name.Field</c>, then - Rep(E) = <c>{record_field,LINE,Rep(E_0),Name,Rep(Field)}</c>.</item> - <item>If E is <c>#{W_1, ..., W_k}</c> where each - <c>W_i</c> is a map assoc or exact field, then Rep(E) = - <c>{map,LINE,[Rep(W_1), ..., Rep(W_k)]}</c>. For Rep(W), see - below.</item> - <item>If E is <c>E_0#{W_1, ..., W_k}</c> where - <c>W_i</c> is a map assoc or exact field, then Rep(E) = - <c>{map,LINE,Rep(E_0),[Rep(W_1), ..., Rep(W_k)]}</c>. - For Rep(W), see below.</item> - <item>If E is <c>catch E_0</c>, then + An omitted <c>Size_i</c> is represented by <c>default</c>. + An omitted <c>TSL_i</c> is represented by <c>default</c>.</item> + <item>If E is a block expression <c>begin B end</c>, + where <c>B</c> is a body, then + Rep(E) = <c>{block,LINE,Rep(B)}</c>.</item> + <item>If E is a case expression <c>case E_0 of Cc_1 ; ... ; Cc_k end</c>, + where <c>E_0</c> is an expression and each <c>Cc_i</c> is a + case clause then Rep(E) = + <c>{'case',LINE,Rep(E_0),[Rep(Cc_1), ..., Rep(Cc_k)]}</c>.</item> + <item>If E is a catch expression <c>catch E_0</c>, then Rep(E) = <c>{'catch',LINE,Rep(E_0)}</c>.</item> - <item>If E is <c>E_0(E_1, ..., E_k)</c>, then + <item>If E is a cons skeleton <c>[E_h | E_t]</c>, then + Rep(E) = <c>{cons,LINE,Rep(E_h),Rep(E_t)}</c>.</item> + <item>If E is a fun expression <c>fun Name/Arity</c>, then + Rep(E) = <c>{'fun',LINE,{function,Name,Arity}}</c>.</item> + <item>If E is a fun expression + <c>fun Module:Name/Arity</c>, then Rep(E) = + <c>{'fun',LINE,{function,Rep(Module),Rep(Name),Rep(Arity)}}</c>. + (Before the R15 release: Rep(E) = + <c>{'fun',LINE,{function,Module,Name,Arity}}</c>.)</item> + <item>If E is a fun expression <c>fun Fc_1 ; ... ; Fc_k end</c>, + where each <c>Fc_i</c> is a function clause then Rep(E) = + <c>{'fun',LINE,{clauses,[Rep(Fc_1), ..., Rep(Fc_k)]}}</c>.</item> + <item>If E is a fun expression + <c>fun Name Fc_1 ; ... ; Name Fc_k end</c>, + where <c>Name</c> is a variable and each + <c>Fc_i</c> is a function clause then Rep(E) = + <c>{named_fun,LINE,Name,[Rep(Fc_1), ..., Rep(Fc_k)]}</c>. + </item> + <item>If E is a function call <c>E_0(E_1, ..., E_k)</c>, then Rep(E) = <c>{call,LINE,Rep(E_0),[Rep(E_1), ..., Rep(E_k)]}</c>.</item> - <item>If E is <c>E_m:E_0(E_1, ..., E_k)</c>, then Rep(E) = - <c>{call,LINE,{remote,LINE,Rep(E_m),Rep(E_0)},[Rep(E_1), ..., Rep(E_k)]}</c>. + <item>If E is a function call <c>E_m:E_0(E_1, ..., E_k)</c>, + then Rep(E) = + <c>{call,LINE,{remote,LINE,Rep(E_m),Rep(E_0)},[Rep(E_1), ..., Rep(E_k)]}</c>. </item> - <item>If E is a list comprehension <c>[E_0 || W_1, ..., W_k]</c>, - where each <c>W_i</c> is a generator or a filter, then Rep(E) = - <c>{lc,LINE,Rep(E_0),[Rep(W_1), ..., Rep(W_k)]}</c>. For Rep(W), see - below.</item> - <item>If E is a binary comprehension - <c><<E_0 || W_1, ..., W_k>></c>, - where each <c>W_i</c> is a generator or a filter, then - Rep(E) = <c>{bc,LINE,Rep(E_0),[Rep(W_1), ..., Rep(W_k)]}</c>. - For Rep(W), see below.</item> - <item>If E is <c>begin B end</c>, where <c>B</c> is a body, then - Rep(E) = <c>{block,LINE,Rep(B)}</c>.</item> - <item>If E is <c>if Ic_1 ; ... ; Ic_k end</c>, + <item>If E is an if expression <c>if Ic_1 ; ... ; Ic_k end</c>, where each <c>Ic_i</c> is an if clause then Rep(E) = <c>{'if',LINE,[Rep(Ic_1), ..., Rep(Ic_k)]}</c>.</item> - <item>If E is <c>case E_0 of Cc_1 ; ... ; Cc_k end</c>, - where <c>E_0</c> is an expression and each <c>Cc_i</c> is a - case clause then Rep(E) = - <c>{'case',LINE,Rep(E_0),[Rep(Cc_1), ..., Rep(Cc_k)]}</c>.</item> - <item>If E is <c>try B catch Tc_1 ; ... ; Tc_k end</c>, + <item>If E is a list comprehension <c>[E_0 || Q_1, ..., Q_k]</c>, + where each <c>Q_i</c> is a qualifier, then Rep(E) = + <c>{lc,LINE,Rep(E_0),[Rep(Q_1), ..., Rep(Q_k)]}</c>. For Rep(Q), see + below.</item> + <item>If E is a map creation <c>#{A_1, ..., A_k}</c>, + where each <c>A_i</c> is an association <c>E_i_1 => E_i_2</c> + or <c>E_i_1 := E_i_2</c>, then Rep(E) = + <c>{map,LINE,[Rep(A_1), ..., Rep(A_k)]}</c>. For Rep(A), see + below.</item> + <item>If E is a map update <c>E_0#{A_1, ..., A_k}</c>, + where each <c>A_i</c> is an association <c>E_i_1 => E_i_2</c> + or <c>E_i_1 := E_i_2</c>, then Rep(E) = + <c>{map,LINE,Rep(E_0),[Rep(A_1), ..., Rep(A_k)]}</c>. + For Rep(A), see below.</item> + <item>If E is a match operator expression <c>P = E_0</c>, + where <c>P</c> is a pattern, then + Rep(E) = <c>{match,LINE,Rep(P),Rep(E_0)}</c>.</item> + <item>If E is nil, <c>[]</c>, then + Rep(E) = <c>{nil,LINE}</c>.</item> + <item>If E is an operator expression <c>E_1 Op E_2</c>, + where <c>Op</c> is a binary operator other than the match + operator <c>=</c>, then + Rep(E) = <c>{op,LINE,Op,Rep(E_1),Rep(E_2)}</c>.</item> + <item>If E is an operator expression <c>Op E_0</c>, + where <c>Op</c> is a unary operator, then + Rep(E) = <c>{op,LINE,Op,Rep(E_0)}</c>.</item> + <item>If E is a parenthesized expression <c>( E_0 )</c>, then + Rep(E) = <c>Rep(E_0)</c>, that is, parenthesized + expressions cannot be distinguished from their bodies.</item> + <item>If E is a receive expression <c>receive Cc_1 ; ... ; Cc_k end</c>, + where each <c>Cc_i</c> is a case clause then Rep(E) = + <c>{'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)]}</c>.</item> + <item>If E is a receive expression + <c>receive Cc_1 ; ... ; Cc_k after E_0 -> B_t end</c>, + where each <c>Cc_i</c> is a case clause, + <c>E_0</c> is an expression and <c>B_t</c> is a body, then Rep(E) = + <c>{'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)],Rep(E_0),Rep(B_t)}</c>.</item> + <item>If E is a record creation + <c>#Name{Field_1=E_1, ..., Field_k=E_k}</c>, + where each <c>Field_i</c> is an atom or <c>_</c>, then Rep(E) = + <c>{record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}</c>.</item> + <item>If E is a record field access <c>E_0#Name.Field</c>, + where <c>Field</c> is an atom, then + Rep(E) = <c>{record_field,LINE,Rep(E_0),Name,Rep(Field)}</c>.</item> + <item>If E is a record field index <c>#Name.Field</c>, + where <c>Field</c> is an atom, then + Rep(E) = <c>{record_index,LINE,Name,Rep(Field)}</c>.</item> + <item>If E is a record update + <c>E_0#Name{Field_1=E_1, ..., Field_k=E_k}</c>, + where each <c>Field_i</c> is an atom, then Rep(E) = + <c>{record,LINE,Rep(E_0),Name,[{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}</c>.</item> + <item>If E is a tuple skeleton <c>{E_1, ..., E_k}</c>, then + Rep(E) = <c>{tuple,LINE,[Rep(E_1), ..., Rep(E_k)]}</c>.</item> + <item>If E is a try expression <c>try B catch Tc_1 ; ... ; Tc_k end</c>, where <c>B</c> is a body and each <c>Tc_i</c> is a catch clause then Rep(E) = <c>{'try',LINE,Rep(B),[],[Rep(Tc_1), ..., Rep(Tc_k)],[]}</c>.</item> - <item>If E is <c>try B of Cc_1 ; ... ; Cc_k catch Tc_1 ; ... ; Tc_n end</c>, + <item>If E is a try expression + <c>try B of Cc_1 ; ... ; Cc_k catch Tc_1 ; ... ; Tc_n end</c>, where <c>B</c> is a body, each <c>Cc_i</c> is a case clause and each <c>Tc_j</c> is a catch clause then Rep(E) = <c>{'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[Rep(Tc_1), ..., Rep(Tc_n)],[]}</c>.</item> - <item>If E is <c>try B after A end</c>, + <item>If E is a try expression <c>try B after A end</c>, where <c>B</c> and <c>A</c> are bodies then Rep(E) = <c>{'try',LINE,Rep(B),[],[],Rep(A)}</c>.</item> - <item>If E is <c>try B of Cc_1 ; ... ; Cc_k after A end</c>, + <item>If E is a try expression + <c>try B of Cc_1 ; ... ; Cc_k after A end</c>, where <c>B</c> and <c>A</c> are a bodies and each <c>Cc_i</c> is a case clause then Rep(E) = <c>{'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[],Rep(A)}</c>.</item> - <item>If E is <c>try B catch Tc_1 ; ... ; Tc_k after A end</c>, + <item>If E is a try expression + <c>try B catch Tc_1 ; ... ; Tc_k after A end</c>, where <c>B</c> and <c>A</c> are bodies and each <c>Tc_i</c> is a catch clause then Rep(E) = <c>{'try',LINE,Rep(B),[],[Rep(Tc_1), ..., Rep(Tc_k)],Rep(A)}</c>.</item> - <item>If E is <c>try B of Cc_1 ; ... ; Cc_k catch Tc_1 ; ... ; Tc_n after A end</c>, + <item>If E is a try expression + <c>try B of Cc_1 ; ... ; Cc_k catch Tc_1 ; ... ; Tc_n after A end</c>, where <c>B</c> and <c>A</c> are a bodies, - each <c>Cc_i</c> is a case clause and + each <c>Cc_i</c> is a case clause, and each <c>Tc_j</c> is a catch clause then Rep(E) = <c>{'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[Rep(Tc_1), ..., Rep(Tc_n)],Rep(A)}</c>.</item> - <item>If E is <c>receive Cc_1 ; ... ; Cc_k end</c>, - where each <c>Cc_i</c> is a case clause then Rep(E) = - <c>{'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)]}</c>.</item> - <item>If E is <c>receive Cc_1 ; ... ; Cc_k after E_0 -> B_t end</c>, - where each <c>Cc_i</c> is a case clause, - <c>E_0</c> is an expression and <c>B_t</c> is a body, then Rep(E) = - <c>{'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)],Rep(E_0),Rep(B_t)}</c>.</item> - <item>If E is <c>fun Name / Arity</c>, then - Rep(E) = <c>{'fun',LINE,{function,Name,Arity}}</c>.</item> - <item>If E is <c>fun Module:Name/Arity</c>, then Rep(E) = - <c>{'fun',LINE,{function,Rep(Module),Rep(Name),Rep(Arity)}}</c>. - (Before the R15 release: Rep(E) = - <c>{'fun',LINE,{function,Module,Name,Arity}}</c>.)</item> - <item>If E is <c>fun Fc_1 ; ... ; Fc_k end</c> - where each <c>Fc_i</c> is a function clause then Rep(E) = - <c>{'fun',LINE,{clauses,[Rep(Fc_1), ..., Rep(Fc_k)]}}</c>.</item> - <item>If E is <c>fun Name Fc_1 ; ... ; Name Fc_k end</c> - where <c>Name</c> is a variable and each - <c>Fc_i</c> is a function clause then Rep(E) = - <c>{named_fun,LINE,Name,[Rep(Fc_1), ..., Rep(Fc_k)]}</c>. - </item> - <item>If E is <c>( E_0 )</c>, then - Rep(E) = <c>Rep(E_0)</c>, that is, parenthesized - expressions cannot be distinguished from their bodies.</item> + <item>If E is a variable <c>V</c>, then Rep(E) = <c>{var,LINE,A}</c>, + where <c>A</c> is an atom with a printname consisting of the same + characters as <c>V</c>.</item> </list> <section> - <title>Generators and Filters</title> - <p>When W is a generator or a filter (in the body of a list or - binary comprehension), then:</p> + <title>Qualifiers</title> + <p>A qualifier Q is one of the following alternatives:</p> <list type="bulleted"> - <item>If W is a generator <c>P <- E</c>, where <c>P</c> is + <item>If Q is a filter <c>E</c>, where <c>E</c> is an expression, then + Rep(Q) = <c>Rep(E)</c>.</item> + <item>If Q is a generator <c>P <- E</c>, where <c>P</c> is a pattern and <c>E</c> is an expression, then - Rep(W) = <c>{generate,LINE,Rep(P),Rep(E)}</c>.</item> - <item>If W is a generator <c>P <= E</c>, where <c>P</c> is + Rep(Q) = <c>{generate,LINE,Rep(P),Rep(E)}</c>.</item> + <item>If Q is a bit string generator + <c>P <= E</c>, where <c>P</c> is a pattern and <c>E</c> is an expression, then - Rep(W) = <c>{b_generate,LINE,Rep(P),Rep(E)}</c>.</item> - <item>If W is a filter <c>E</c>, which is an expression, then - Rep(W) = <c>Rep(E)</c>.</item> + Rep(Q) = <c>{b_generate,LINE,Rep(P),Rep(E)}</c>.</item> </list> </section> <section> - <title>Binary Element Type Specifiers</title> - <p>A type specifier list TSL for a binary element is a sequence of type - specifiers <c>TS_1 - ... - TS_k</c>. + <title>Bit String Element Type Specifiers</title> + <p>A type specifier list TSL for a bit string element is a sequence + of type specifiers <c>TS_1 - ... - TS_k</c>, and Rep(TSL) = <c>[Rep(TS_1), ..., Rep(TS_k)]</c>.</p> - <p>When TS is a type specifier for a binary element, then:</p> <list type="bulleted"> - <item>If TS is an atom <c>A</c>, then Rep(TS) = <c>A</c>.</item> - <item>If TS is a couple <c>A:Value</c> where <c>A</c> is an atom - and <c>Value</c> is an integer, then Rep(TS) = - <c>{A,Value}</c>.</item> + <item>If TS is a type specifier <c>A</c>, where <c>A</c> is an atom, + then Rep(TS) = <c>A</c>.</item> + <item>If TS is a type specifier <c>A:Value</c>, + where <c>A</c> is an atom and <c>Value</c> is an integer, + then Rep(TS) = <c>{A,Value}</c>.</item> </list> </section> <section> - <title>Map Assoc and Exact Fields</title> - <p>When W is an assoc or exact field (in the body of a map), then:</p> + <title>Associations</title> + <p>An association A is one of the following alternatives:</p> <list type="bulleted"> - <item>If W is an assoc field <c>K => V</c>, where - <c>K</c> and <c>V</c> are both expressions, - then Rep(W) = <c>{map_field_assoc,LINE,Rep(K),Rep(V)}</c>. + <item>If A is an association <c>K => V</c>, + then Rep(A) = <c>{map_field_assoc,LINE,Rep(K),Rep(V)}</c>. </item> - <item>If W is an exact field <c>K := V</c>, where - <c>K</c> and <c>V</c> are both expressions, - then Rep(W) = <c>{map_field_exact,LINE,Rep(K),Rep(V)}</c>. + <item>If A is an association <c>K := V</c>, + then Rep(A) = <c>{map_field_exact,LINE,Rep(K),Rep(V)}</c>. </item> </list> </section> @@ -398,39 +428,39 @@ and catch clauses.</p> <p>A clause <c>C</c> is one of the following alternatives:</p> <list type="bulleted"> - <item>If C is a function clause <c>( Ps ) -> B</c> - where <c>Ps</c> is a pattern sequence and <c>B</c> is a body, then - Rep(C) = <c>{clause,LINE,Rep(Ps),[],Rep(B)}</c>.</item> - <item>If C is a function clause <c>( Ps ) when Gs -> B</c> - where <c>Ps</c> is a pattern sequence, - <c>Gs</c> is a guard sequence and <c>B</c> is a body, then - Rep(C) = <c>{clause,LINE,Rep(Ps),Rep(Gs),Rep(B)}</c>.</item> - <item>If C is an if clause <c>Gs -> B</c> - where <c>Gs</c> is a guard sequence and <c>B</c> is a body, then - Rep(C) = <c>{clause,LINE,[],Rep(Gs),Rep(B)}</c>.</item> - <item>If C is a case clause <c>P -> B</c> + <item>If C is a case clause <c>P -> B</c>, where <c>P</c> is a pattern and <c>B</c> is a body, then Rep(C) = <c>{clause,LINE,[Rep(P)],[],Rep(B)}</c>.</item> - <item>If C is a case clause <c>P when Gs -> B</c> + <item>If C is a case clause <c>P when Gs -> B</c>, where <c>P</c> is a pattern, <c>Gs</c> is a guard sequence and <c>B</c> is a body, then Rep(C) = <c>{clause,LINE,[Rep(P)],Rep(Gs),Rep(B)}</c>.</item> - <item>If C is a catch clause <c>P -> B</c> + <item>If C is a catch clause <c>P -> B</c>, where <c>P</c> is a pattern and <c>B</c> is a body, then Rep(C) = <c>{clause,LINE,[Rep({throw,P,_})],[],Rep(B)}</c>.</item> - <item>If C is a catch clause <c>X : P -> B</c> + <item>If C is a catch clause <c>X : P -> B</c>, where <c>X</c> is an atomic literal or a variable pattern, - <c>P</c> is a pattern and <c>B</c> is a body, then + <c>P</c> is a pattern, and <c>B</c> is a body, then Rep(C) = <c>{clause,LINE,[Rep({X,P,_})],[],Rep(B)}</c>.</item> - <item>If C is a catch clause <c>P when Gs -> B</c> - where <c>P</c> is a pattern, <c>Gs</c> is a guard sequence + <item>If C is a catch clause <c>P when Gs -> B</c>, + where <c>P</c> is a pattern, <c>Gs</c> is a guard sequence, and <c>B</c> is a body, then Rep(C) = <c>{clause,LINE,[Rep({throw,P,_})],Rep(Gs),Rep(B)}</c>.</item> - <item>If C is a catch clause <c>X : P when Gs -> B</c> + <item>If C is a catch clause <c>X : P when Gs -> B</c>, where <c>X</c> is an atomic literal or a variable pattern, - <c>P</c> is a pattern, <c>Gs</c> is a guard sequence + <c>P</c> is a pattern, <c>Gs</c> is a guard sequence, and <c>B</c> is a body, then Rep(C) = <c>{clause,LINE,[Rep({X,P,_})],Rep(Gs),Rep(B)}</c>.</item> + <item>If C is a function clause <c>( Ps ) -> B</c>, + where <c>Ps</c> is a pattern sequence and <c>B</c> is a body, then + Rep(C) = <c>{clause,LINE,Rep(Ps),[],Rep(B)}</c>.</item> + <item>If C is a function clause <c>( Ps ) when Gs -> B</c>, + where <c>Ps</c> is a pattern sequence, + <c>Gs</c> is a guard sequence and <c>B</c> is a body, then + Rep(C) = <c>{clause,LINE,Rep(Ps),Rep(Gs),Rep(B)}</c>.</item> + <item>If C is an if clause <c>Gs -> B</c>, + where <c>Gs</c> is a guard sequence and <c>B</c> is a body, then + Rep(C) = <c>{clause,LINE,[],Rep(Gs),Rep(B)}</c>.</item> </list> </section> @@ -444,46 +474,61 @@ <c>[Rep(Gt_1), ..., Rep(Gt_k)]</c>.</p> <p>A guard test <c>Gt</c> is one of the following alternatives:</p> <list type="bulleted"> - <item>If Gt is an atomic literal L, then Rep(Gt) = Rep(L).</item> - <item>If Gt is a variable pattern <c>V</c>, then - Rep(Gt) = <c>{var,LINE,A}</c>, where A is an atom with - a printname consisting of the same characters as <c>V</c>.</item> - <item>If Gt is a tuple skeleton <c>{Gt_1, ..., Gt_k}</c>, then - Rep(Gt) = <c>{tuple,LINE,[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.</item> - <item>If Gt is <c>[]</c>, then Rep(Gt) = <c>{nil,LINE}</c>.</item> - <item>If Gt is a cons skeleton <c>[Gt_h | Gt_t]</c>, then - Rep(Gt) = <c>{cons,LINE,Rep(Gt_h),Rep(Gt_t)}</c>.</item> - <item>If Gt is a binary constructor - <c><<Gt_1:Size_1/TSL_1, ..., Gt_k:Size_k/TSL_k>></c>, then + <item>If Gt is an atomic literal <c>L</c>, then Rep(Gt) = Rep(L).</item> + <item>If Gt is a bit string constructor + <c><<Gt_1:Size_1/TSL_1, ..., Gt_k:Size_k/TSL_k>></c>, + where each <c>Size_i</c> is a guard test and each + <c>TSL_i</c> is a type specificer list, then Rep(Gt) = <c>{bin,LINE,[{bin_element,LINE,Rep(Gt_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(Gt_k),Rep(Size_k),Rep(TSL_k)}]}</c>. For Rep(TSL), see above. - An omitted <c>Size</c> is represented by <c>default</c>. - An omitted <c>TSL</c> (type specifier list) is represented - by <c>default</c>.</item> - <item>If Gt is <c>Gt_1 Op Gt_2</c>, where <c>Op</c> - is a binary operator, then Rep(Gt) = - <c>{op,LINE,Op,Rep(Gt_1),Rep(Gt_2)}</c>.</item> - <item>If Gt is <c>Op Gt_0</c>, where <c>Op</c> is a unary operator, then + An omitted <c>Size_i</c> is represented by <c>default</c>. + An omitted <c>TSL_i</c> is represented by <c>default</c>.</item> + <item>If Gt is a cons skeleton <c>[Gt_h | Gt_t]</c>, then + Rep(Gt) = <c>{cons,LINE,Rep(Gt_h),Rep(Gt_t)}</c>.</item> + <item>If Gt is a function call <c>A(Gt_1, ..., Gt_k)</c>, + where <c>A</c> is an atom, then Rep(Gt) = + <c>{call,LINE,Rep(A),[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.</item> + <item>If Gt is a function call <c>A_m:A(Gt_1, ..., Gt_k)</c>, + where <c>A_m</c> is the atom <c>erlang</c> and <c>A</c> is + an atom or an operator, then Rep(Gt) = + <c>{call,LINE,{remote,LINE,Rep(A_m),Rep(A)},[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.</item> + <item>If Gt is a map creation <c>#{A_1, ..., A_k}</c>, + where each <c>A_i</c> is an association <c>Gt_i_1 => Gt_i_2</c> + or <c>Gt_i_1 := Gt_i_2</c>, then Rep(Gt) = + <c>{map,LINE,[Rep(A_1), ..., Rep(A_k)]}</c>. For Rep(A), see + above.</item> + <item>If Gt is a map update <c>Gt_0#{A_1, ..., A_k}</c>, where each + <c>A_i</c> is an association <c>Gt_i_1 => Gt_i_2</c> + or <c>Gt_i_1 := Gt_i_2</c>, then Rep(Gt) = + <c>{map,LINE,Rep(Gt_0),[Rep(A_1), ..., Rep(A_k)]}</c>. + For Rep(A), see above.</item> + <item>If Gt is nil, <c>[]</c>, + then Rep(Gt) = <c>{nil,LINE}</c>.</item> + <item>If Gt is an operator guard test <c>Gt_1 Op Gt_2</c>, + where <c>Op</c> is a binary operator other than the match + operator <c>=</c>, then + Rep(Gt) = <c>{op,LINE,Op,Rep(Gt_1),Rep(Gt_2)}</c>.</item> + <item>If Gt is an operator guard test <c>Op Gt_0</c>, + where <c>Op</c> is a unary operator, then Rep(Gt) = <c>{op,LINE,Op,Rep(Gt_0)}</c>.</item> - <item>If Gt is <c>#Name{Field_1=Gt_1, ..., Field_k=Gt_k}</c>, then - Rep(E) = - <c>{record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(Gt_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(Gt_k)}]}</c>.</item> - <item>If Gt is <c>#Name.Field</c>, then - Rep(Gt) = <c>{record_index,LINE,Name,Rep(Field)}</c>.</item> - <item>If Gt is <c>Gt_0#Name.Field</c>, then - Rep(Gt) = <c>{record_field,LINE,Rep(Gt_0),Name,Rep(Field)}</c>.</item> - <item>If Gt is <c>A(Gt_1, ..., Gt_k)</c>, where <c>A</c> is an atom, then - Rep(Gt) = <c>{call,LINE,Rep(A),[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.</item> - <item>If Gt is <c>A_m:A(Gt_1, ..., Gt_k)</c>, where <c>A_m</c> is - the atom <c>erlang</c> and <c>A</c> is an atom or an operator, then - Rep(Gt) = <c>{call,LINE,{remote,LINE,Rep(A_m),Rep(A)},[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.</item> - <item>If Gt is <c>{A_m,A}(Gt_1, ..., Gt_k)</c>, where <c>A_m</c> is - the atom <c>erlang</c> and <c>A</c> is an atom or an operator, then - Rep(Gt) = <c>{call,LINE,Rep({A_m,A}),[Rep(Gt_1), ..., Rep(Gt_k)]}</c>. - </item> - <item>If Gt is <c>( Gt_0 )</c>, then + <item>If Gt is a parenthesized guard test <c>( Gt_0 )</c>, then Rep(Gt) = <c>Rep(Gt_0)</c>, that is, parenthesized guard tests cannot be distinguished from their bodies.</item> + <item>If Gt is a record creation + <c>#Name{Field_1=Gt_1, ..., Field_k=Gt_k}</c>, + where each <c>Field_i</c> is an atom or <c>_</c>, then Rep(Gt) = + <c>{record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(Gt_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(Gt_k)}]}</c>.</item> + <item>If Gt is a record field access <c>Gt_0#Name.Field</c>, + where <c>Field</c> is an atom, then + Rep(Gt) = <c>{record_field,LINE,Rep(Gt_0),Name,Rep(Field)}</c>.</item> + <item>If Gt is a record field index <c>#Name.Field</c>, + where <c>Field</c> is an atom, then + Rep(Gt) = <c>{record_index,LINE,Name,Rep(Field)}</c>.</item> + <item>If Gt is a tuple skeleton <c>{Gt_1, ..., Gt_k}</c>, then + Rep(Gt) = <c>{tuple,LINE,[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.</item> + <item>If Gt is a variable pattern <c>V</c>, then + Rep(Gt) = <c>{var,LINE,A}</c>, where A is an atom with + a printname consisting of the same characters as <c>V</c>.</item> </list> <p>Note that every guard test has the same source form as some expression, and is represented the same way as the corresponding expression.</p> @@ -492,91 +537,83 @@ <section> <title>Types</title> <list type="bulleted"> - <item>If T is an annotated type <c>Anno :: Type</c>, - where <c>Anno</c> is a variable and - <c>Type</c> is a type, then Rep(T) = - <c>{ann_type,LINE,[Rep(Anno),Rep(Type)]}</c>.</item> + <item>If T is an annotated type <c>A :: T_0</c>, + where <c>A</c> is a variable, then Rep(T) = + <c>{ann_type,LINE,[Rep(A),Rep(T_0)]}</c>.</item> <item>If T is an atom or integer literal L, then Rep(T) = Rep(L). </item> - <item>If T is <c>L Op R</c>, - where <c>Op</c> is a binary operator and <c>L</c> and <c>R</c> - are types (this is an occurrence of an expression that can be - evaluated to an integer at compile time), then - Rep(T) = <c>{op,LINE,Op,Rep(L),Rep(R)}</c>.</item> - <item>If T is <c>Op A</c>, where <c>Op</c> is a - unary operator and <c>A</c> is a type (this is an occurrence of - an expression that can be evaluated to an integer at compile time), - then Rep(T) = <c>{op,LINE,Op,Rep(A)}</c>.</item> - <item>If T is a bitstring type <c><<_:M,_:_*N>></c>, + <item>If T is a bit string type <c><<_:M,_:_*N>></c>, where <c>M</c> and <c>N</c> are singleton integer types, then Rep(T) = <c>{type,LINE,binary,[Rep(M),Rep(N)]}</c>.</item> <item>If T is the empty list type <c>[]</c>, then Rep(T) = <c>{type,Line,nil,[]}</c>.</item> <item>If T is a fun type <c>fun()</c>, then Rep(T) = <c>{type,LINE,'fun',[]}</c>.</item> - <item>If T is a fun type <c>fun((...) -> B)</c>, - where <c>B</c> is a type, then - Rep(T) = <c>{type,LINE,'fun',[{type,LINE,any},Rep(B)]}</c>. + <item>If T is a fun type <c>fun((...) -> T_0)</c>, then + Rep(T) = <c>{type,LINE,'fun',[{type,LINE,any},Rep(T_0)]}</c>. </item> <item>If T is a fun type <c>fun(Ft)</c>, where <c>Ft</c> is a function type, - then Rep(T) = <c>Rep(Ft)</c>.</item> + then Rep(T) = <c>Rep(Ft)</c>. For Rep(Ft), see below.</item> <item>If T is an integer range type <c>L .. H</c>, where <c>L</c> and <c>H</c> are singleton integer types, then Rep(T) = <c>{type,LINE,range,[Rep(L),Rep(H)]}</c>.</item> <item>If T is a map type <c>map()</c>, then Rep(T) = <c>{type,LINE,map,any}</c>.</item> - <item>If T is a map type <c>#{P_1, ..., P_k}</c>, where each - <c>P_i</c> is a map pair type, then Rep(T) = - <c>{type,LINE,map,[Rep(P_1), ..., Rep(P_k)]}</c>.</item> - <item>If T is a map pair type <c>K => V</c>, where - <c>K</c> and <c>V</c> are types, then Rep(T) = - <c>{type,LINE,map_field_assoc,[Rep(K),Rep(V)]}</c>.</item> - <item>If T is a predefined (or built-in) type <c>N(A_1, ..., A_k)</c>, - where each <c>A_i</c> is a type, then Rep(T) = - <c>{type,LINE,N,[Rep(A_1), ..., Rep(A_k)]}</c>.</item> + <item>If T is a map type <c>#{A_1, ..., A_k}</c>, where each + <c>A_i</c> is an association type, then Rep(T) = + <c>{type,LINE,map,[Rep(A_1), ..., Rep(A_k)]}</c>. + For Rep(A), see below.</item> + <item>If T is an operator type <c>T_1 Op T_2</c>, + where <c>Op</c> is a binary operator (this is an occurrence of + an expression that can be evaluated to an integer at compile + time), then + Rep(T) = <c>{op,LINE,Op,Rep(T_1),Rep(T_2)}</c>.</item> + <item>If T is an operator type <c>Op T_0</c>, where <c>Op</c> is a + unary operator (this is an occurrence of + an expression that can be evaluated to an integer at compile time), + then Rep(T) = <c>{op,LINE,Op,Rep(T_0)}</c>.</item> + <item>If T is <c>( T_0 )</c>, then Rep(T) = <c>Rep(T_0)</c>, + that is, parenthesized types cannot be distinguished from their + bodies.</item> + <item>If T is a predefined (or built-in) type <c>N(T_1, ..., T_k)</c>, + then Rep(T) = + <c>{type,LINE,N,[Rep(T_1), ..., Rep(T_k)]}</c>.</item> <item>If T is a record type <c>#Name{F_1, ..., F_k}</c>, where each <c>F_i</c> is a record field type, then Rep(T) = <c>{type,LINE,record,[Rep(Name),Rep(F_1), ..., Rep(F_k)]}</c>. - </item> - <item>If T is a record field type <c>Name :: Type</c>, - where <c>Type</c> is a type, then Rep(T) = - <c>{type,LINE,field_type,[Rep(Name),Rep(Type)]}</c>.</item> - <item>If T is a remote type <c>M:N(A_1, ..., A_k)</c>, where - each <c>A_i</c> is a type, then Rep(T) = - <c>{remote_type,LINE,[Rep(M),Rep(N),[Rep(A_1), ..., Rep(A_k)]]}</c>. + For Rep(F), see below.</item> + <item>If T is a remote type <c>M:N(T_1, ..., T_k)</c>, then Rep(T) = + <c>{remote_type,LINE,[Rep(M),Rep(N),[Rep(T_1), ..., Rep(T_k)]]}</c>. </item> <item>If T is a tuple type <c>tuple()</c>, then Rep(T) = <c>{type,LINE,tuple,any}</c>.</item> - <item>If T is a tuple type <c>{A_1, ..., A_k}</c>, where - each <c>A_i</c> is a type, then Rep(T) = - <c>{type,LINE,tuple,[Rep(A_1), ..., Rep(A_k)]}</c>.</item> - <item>If T is a type union <c>T_1 | ... | T_k</c>, - where each <c>T_i</c> is a type, then Rep(T) = + <item>If T is a tuple type <c>{T_1, ..., T_k}</c>, then Rep(T) = + <c>{type,LINE,tuple,[Rep(T_1), ..., Rep(T_k)]}</c>.</item> + <item>If T is a type union <c>T_1 | ... | T_k</c>, then Rep(T) = <c>{type,LINE,union,[Rep(T_1), ..., Rep(T_k)]}</c>.</item> <item>If T is a type variable <c>V</c>, then Rep(T) = <c>{var,LINE,A}</c>, where <c>A</c> is an atom with a printname consisting of the same characters as <c>V</c>. A type variable is any variable except underscore (<c>_</c>).</item> - <item>If T is a user-defined type <c>N(A_1, ..., A_k)</c>, - where each <c>A_i</c> is a type, then Rep(T) = - <c>{user_type,LINE,N,[Rep(A_1), ..., Rep(A_k)]}</c>.</item> - <item>If T is <c>( T_0 )</c>, then Rep(T) = <c>Rep(T_0)</c>, - that is, parenthesized types cannot be distinguished from their - bodies.</item> + <item>If T is a user-defined type <c>N(T_1, ..., T_k)</c>, + then Rep(T) = + <c>{user_type,LINE,N,[Rep(T_1), ..., Rep(T_k)]}</c>.</item> </list> <section> <title>Function Types</title> + <p>A function type Ft is one of the following alternatives:</p> <list type="bulleted"> <item>If Ft is a constrained function type <c>Ft_1 when Fc</c>, where <c>Ft_1</c> is a function type and <c>Fc</c> is a function constraint, then Rep(T) = - <c>{type,LINE,bounded_fun,[Rep(Ft_1),Rep(Fc)]}</c>.</item> - <item>If Ft is a function type <c>(A_1, ..., A_n) -> B</c>, - where each <c>A_i</c> and <c>B</c> are types, then - Rep(Ft) = <c>{type,LINE,'fun',[{type,LINE,product,[Rep(A_1), - ..., Rep(A_n)]},Rep(B)]}</c>.</item> + <c>{type,LINE,bounded_fun,[Rep(Ft_1),Rep(Fc)]}</c>. + For Rep(Fc), see below.</item> + <item>If Ft is a function type <c>(T_1, ..., T_n) -> T_0</c>, + where each <c>T_i</c> is a type, then + Rep(Ft) = <c>{type,LINE,'fun',[{type,LINE,product,[Rep(T_1), + ..., Rep(T_n)]},Rep(T_0)]}</c>.</item> </list> </section> @@ -592,6 +629,27 @@ </item> </list> </section> + + <section> + <title>Association Types</title> + <list type="bulleted"> + <item>If A is an association type <c>K => V</c>, where + <c>K</c> and <c>V</c> are types, then Rep(A) = + <c>{type,LINE,map_field_assoc,[Rep(K),Rep(V)]}</c>.</item> + <item>If A is an association type <c>K := V</c>, where + <c>K</c> and <c>V</c> are types, then Rep(A) = + <c>{type,LINE,map_field_exact,[Rep(K),Rep(V)]}</c>.</item> + </list> + </section> + + <section> + <title>Record Field Types</title> + <list type="bulleted"> + <item>If F is a record field type <c>Name :: Type</c>, + where <c>Type</c> is a type, then Rep(F) = + <c>{type,LINE,field_type,[Rep(Name),Rep(Type)]}</c>.</item> + </list> + </section> </section> <section> diff --git a/erts/doc/src/alt_dist.xml b/erts/doc/src/alt_dist.xml index 2263302707..e283acc1b4 100644 --- a/erts/doc/src/alt_dist.xml +++ b/erts/doc/src/alt_dist.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2000</year><year>2013</year> + <year>2000</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/book.xml b/erts/doc/src/book.xml index 12eda03ee5..a0780c91d9 100644 --- a/erts/doc/src/book.xml +++ b/erts/doc/src/book.xml @@ -4,7 +4,7 @@ <book xmlns:xi="http://www.w3.org/2001/XInclude"> <header titlestyle="normal"> <copyright> - <year>1997</year><year>2013</year> + <year>1997</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/communication.xml b/erts/doc/src/communication.xml index 3deea3e4af..1eb05310e9 100644 --- a/erts/doc/src/communication.xml +++ b/erts/doc/src/communication.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2012</year><year>2013</year> + <year>2012</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/crash_dump.xml b/erts/doc/src/crash_dump.xml index 61c9159823..0b827ae583 100644 --- a/erts/doc/src/crash_dump.xml +++ b/erts/doc/src/crash_dump.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1999</year><year>2013</year> + <year>1999</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/driver.xml b/erts/doc/src/driver.xml index a68e87d3b3..4bef5e1388 100644 --- a/erts/doc/src/driver.xml +++ b/erts/doc/src/driver.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2001</year><year>2013</year> + <year>2001</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/driver_entry.xml b/erts/doc/src/driver_entry.xml index bad20d6343..ae7f264d0c 100644 --- a/erts/doc/src/driver_entry.xml +++ b/erts/doc/src/driver_entry.xml @@ -247,14 +247,10 @@ typedef struct erl_drv_entry { something that the <c>WaitForMultipleObjects</c> API function understands). (Some trickery in the emulator allows more than the built-in limit of 64 <c>Events</c> to be used.)</p> - <p>On Enea OSE the <c>event</c> is one or more signals that can - be retrieved using <seealso marker="ose:ose_erl_driver#erl_drv_ose_get_signal">erl_drv_ose_get_signal</seealso>.</p> <p>To use this with threads and asynchronous routines, create a - pipe on unix, an Event on Windows or a unique signal number on - Enea OSE. When the routine + pipe on unix and an Event on Windows. When the routine completes, write to the pipe (use <c>SetEvent</c> on - Windows or send a message to the emulator process on Enea OSE), - this will make the emulator call + Windows), this will make the emulator call <c>ready_input</c> or <c>ready_output</c>.</p> <p>Spurious events may happen. That is, calls to <c>ready_input</c> or <c>ready_output</c> even though no real events are signaled. In @@ -441,7 +437,14 @@ typedef struct erl_drv_entry { <seealso marker="erl_driver#erl_drv_busy_msgq_limits">erl_drv_busy_msgq_limits()</seealso> function. </item> - </taglist> + <tag><c>ERL_DRV_FLAG_USE_INIT_ACK</c></tag> + <item>When this flag is given the linked-in driver has to manually + acknowledge that the port has been successfully started using + <seealso marker="erl_driver#erl_drv_init_ack">erl_drv_init_ack()</seealso>. + This allows the implementor to make the erlang:open_port exit with + badarg after some initial asynchronous initialization has been done. + </item> + </taglist> </item> <tag>void *handle2</tag> <item> diff --git a/erts/doc/src/epmd.xml b/erts/doc/src/epmd.xml index 7f61804bea..d9f580d081 100644 --- a/erts/doc/src/epmd.xml +++ b/erts/doc/src/epmd.xml @@ -4,7 +4,7 @@ <comref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index ed3e7e34c4..c499fc8081 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -4,7 +4,7 @@ <comref> <header> <copyright> - <year>1996</year><year>2015</year> + <year>1996</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -632,6 +632,15 @@ <p>Sets the initial process dictionary size of processes to the size <c><![CDATA[Size]]></c>.</p> </item> + <tag><marker id="+hmqd"><c>+hmqd off_heap|on_heap|mixed</c></marker></tag> + <item><p> + Sets the default value for the process flag + <c>message_queue_data</c>. If <c>+hmqd</c> is not + passed, <c>mixed</c> will be the default. For more information, + see the documentation of + <seealso marker="erlang#process_flag_message_queue_data"><c>process_flag(message_queue_data, + MQD)</c></seealso>. + </p></item> <tag><c><![CDATA[+K true | false]]></c></tag> <item> <p>Enables or disables the kernel poll functionality if diff --git a/erts/doc/src/erl_dist_protocol.xml b/erts/doc/src/erl_dist_protocol.xml index b435d5c9b4..f9fa981d9a 100644 --- a/erts/doc/src/erl_dist_protocol.xml +++ b/erts/doc/src/erl_dist_protocol.xml @@ -364,14 +364,14 @@ If Result > 0, the packet only consists of [119, Result]. NodeInfo is, as expressed in Erlang: </p> <code> - io:format("active name ~ts at port ~p, fd = ~p ~n", + io:format("active name ~ts at port ~p, fd = ~p~n", [NodeName, Port, Fd]). </code> <p> or </p> <code> - io:format("old/unused name ~ts at port ~p, fd = ~p~n", + io:format("old/unused name ~ts at port ~p, fd = ~p ~n", [NodeName, Port, Fd]). </code> diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index 34dc8af238..175b7f6bfb 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -4,7 +4,7 @@ <cref> <header> <copyright> - <year>2001</year><year>2015</year> + <year>2001</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -1077,9 +1077,7 @@ typedef struct ErlIOVec { <c>select</c>/<c>poll</c> can use). On windows, the Win32 API function <c>WaitForMultipleObjects</c> is used. This places other restrictions on the event object. - Refer to the Win32 SDK documentation. - On Enea OSE, the receive function is used. See the <seealso - marker="ose:ose_erl_driver"></seealso> for more details.</p> + Refer to the Win32 SDK documentation.</p> <p>The <c>on</c> parameter should be <c>1</c> for setting events and <c>0</c> for clearing them.</p> <p>The <c>mode</c> argument is a bitwise-or combination of @@ -1091,7 +1089,7 @@ typedef struct ErlIOVec { <seealso marker="driver_entry#ready_output">ready_output</seealso>. </p> <note> - <p>Some OS (Windows and Enea OSE) do not differentiate between read and write events. + <p>Some OS (Windows) do not differentiate between read and write events. The call-back for a fired event then only depends on the value of <c>mode</c>.</p> </note> <p><c>ERL_DRV_USE</c> specifies if we are using the event object or if we want to close it. @@ -2166,6 +2164,53 @@ ERL_DRV_MAP int sz </func> <func> + <name><ret>void</ret><nametext>erl_drv_init_ack(ErlDrvPort port, ErlDrvData res)</nametext></name> + <fsummary>Acknowledge the start of the port</fsummary> + <desc> + <marker id="erl_drv_init_ack"></marker> + <p>Arguments:</p> + <taglist> + <tag><c>port</c></tag> + <item>The port handle of the port (driver instance) creating + doing the acknowledgment. + </item> + <tag><c>res</c></tag> + <item>The result of the port initialization. This can be the same values + as the return value of <seealso marker="driver_entry#start">start</seealso>, + i.e any of the error codes or the ErlDrvData that is to be used for this + port. + </item> + </taglist> + <p> + When this function is called the initiating erlang:open_port call is + returned as if the <seealso marker="driver_entry#start">start</seealso> + function had just been called. It can only be used when the + <seealso marker="driver_entry#driver_flags">ERL_DRV_FLAG_USE_INIT_ACK</seealso> + flag has been set on the linked-in driver. + </p> + </desc> + </func> + + <func> + <name><ret>void</ret><nametext>erl_drv_set_os_pid(ErlDrvPort port, ErlDrvSInt pid)</nametext></name> + <fsummary>Set the os_pid for the port</fsummary> + <desc> + <marker id="erl_drv_set_os_pid"></marker> + <p>Arguments:</p> + <taglist> + <tag><c>port</c></tag> + <item>The port handle of the port (driver instance) to set the pid on. + </item> + <tag><c>pid</c></tag> + <item>The pid to set.</item> + </taglist> + <p> + Set the os_pid seen when doing erlang:port_info/2 on this port. + </p> + </desc> + </func> + + <func> <name><ret>int</ret><nametext>erl_drv_thread_create(char *name, ErlDrvTid *tid, void * (*func)(void *), diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 420c9fea38..7546f7ef81 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -4,7 +4,7 @@ <cref> <header> <copyright> - <year>2001</year><year>2015</year> + <year>2001</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -524,6 +524,18 @@ typedef struct { <p>Note that <c>ErlNifBinary</c> is a semi-opaque type and you are only allowed to read fields <c>size</c> and <c>data</c>.</p> </item> + + <tag><marker id="ErlNifBinaryToTerm"/>ErlNifBinaryToTerm</tag> + <item> + <p>An enumeration of the options that can be given to + <seealso marker="#enif_binary_to_term">enif_binary_to_term</seealso>. + For default behavior, use the value <c>0</c>.</p> + <taglist> + <tag><c>ERL_NIF_BIN2TERM_SAFE</c></tag> + <item><p>Use this option when receiving data from untrusted sources.</p></item> + </taglist> + </item> + <tag><marker id="ErlNifPid"/>ErlNifPid</tag> <item> <p><c>ErlNifPid</c> is a process identifier (pid). In contrast to @@ -532,6 +544,14 @@ typedef struct { <seealso marker="#ErlNifEnv">environment</seealso>. <c>ErlNifPid</c> is an opaque type.</p> </item> + <tag><marker id="ErlNifPort"/>ErlNifPort</tag> + <item> + <p><c>ErlNifPort</c> is a port identifier. In contrast to + port id terms (instances of <c>ERL_NIF_TERM</c>), <c>ErlNifPort</c>'s are self + contained and not bound to any + <seealso marker="#ErlNifEnv">environment</seealso>. <c>ErlNifPort</c> + is an opaque type.</p> + </item> <tag><marker id="ErlNifResourceType"/>ErlNifResourceType</tag> <item> @@ -546,8 +566,7 @@ typedef struct { <code type="none"> typedef void ErlNifResourceDtor(ErlNifEnv* env, void* obj); </code> - <p>The function prototype of a resource destructor function. - A destructor function is not allowed to call any term-making functions.</p> + <p>The function prototype of a resource destructor function.</p> </item> <tag><marker id="ErlNifCharEncoding"/>ErlNifCharEncoding</tag> <item> @@ -591,6 +610,21 @@ typedef enum { </taglist> </item> + <tag><marker id="ErlNifUniqueInteger"/>ErlNifUniqueInteger</tag> + <item> + <p>An enumeration of the properties that can be requested from + <seealso marker="#enif_make_unique_integer">enif_unique_integer</seealso>. + For default properties, use the value <c>0</c>.</p> + <taglist> + <tag><c>ERL_NIF_UNIQUE_POSITIVE</c></tag> + <item><p>Return only positive integers</p></item> + <tag><c>ERL_NIF_UNIQUE_MONOTONIC</c></tag> + <item><p>Return only + <seealso marker="time_correction#Strictly_Monotonically_Increasing">strictly + monotonically increasing</seealso> integer corresponding to creation time</p></item> + </taglist> + </item> + </taglist> </section> @@ -632,6 +666,25 @@ typedef enum { have been allocated with <seealso marker="#enif_alloc_env">enif_alloc_env</seealso>. </p></desc> </func> + <func><name><ret>size_t</ret><nametext>enif_binary_to_term(ErlNifEnv *env, const unsigned char* data, size_t size, ERL_NIF_TERM *term, ErlNifBinaryToTerm opts)</nametext></name> + <fsummary>Create a term from the external format</fsummary> + <desc> + <p>Create a term that is the result of decoding the binary data + at <c>data</c>, which must be encoded according to the Erlang external term format. + No more than <c>size</c> bytes are read from <c>data</c>. Argument <c>opts</c> + correspond to the second argument to <seealso marker="erlang#binary_to_term-2"> + <c>erlang:binary_to_term/2</c></seealso>, and must be either <c>0</c> or + <c>ERL_NIF_BIN2TERM_SAFE</c>.</p> + <p>On success, store the resulting term at <c>*term</c> and return + the actual number of bytes read. Return zero if decoding fails or if <c>opts</c> + is invalid.</p> + <p>See also: + <seealso marker="#ErlNifBinaryToTerm"><c>ErlNifBinaryToTerm</c></seealso>, + <seealso marker="erlang#binary_to_term-2"><c>erlang:binary_to_term/2</c></seealso> and + <seealso marker="#enif_term_to_binary"><c>enif_term_to_binary</c></seealso>. + </p> + </desc> + </func> <func><name><ret>int</ret><nametext>enif_compare(ERL_NIF_TERM lhs, ERL_NIF_TERM rhs)</nametext></name> <fsummary>Compare two terms</fsummary> <desc><p>Return an integer less than, equal to, or greater than @@ -689,7 +742,48 @@ typedef enum { a number of repeated NIF-calls without the need to create threads. See also the <seealso marker="#WARNING">warning</seealso> text at the beginning of this document.</p> </desc> + </func> + + <func> + <name><ret>ErlNifTime</ret><nametext>enif_convert_time_unit(ErlNifTime val, ErlNifTimeUnit from, ErlNifTimeUnit to)</nametext></name> + <fsummary>Convert time unit of a time value</fsummary> + <desc> + <marker id="enif_convert_time_unit"></marker> + <p>Arguments:</p> + <taglist> + <tag><c>val</c></tag> + <item>Value to convert time unit for.</item> + <tag><c>from</c></tag> + <item>Time unit of <c>val</c>.</item> + <tag><c>to</c></tag> + <item>Time unit of returned value.</item> + </taglist> + <p>Converts the <c>val</c> value of time unit <c>from</c> to + the corresponding value of time unit <c>to</c>. The result is + rounded using the floor function.</p> + <p>Returns <c>ERL_NIF_TIME_ERROR</c> if called with an invalid + time unit argument.</p> + <p>See also: + <seealso marker="#ErlNifTime"><c>ErlNifTime</c></seealso> and + <seealso marker="#ErlNifTimeUnit"><c>ErlNifTimeUnit</c></seealso>. + </p> + </desc> + </func> + + <func> + <name><ret>ERL_NIF_TERM</ret><nametext>enif_cpu_time(ErlNifEnv *)</nametext></name> + <fsummary></fsummary> + <desc> + <p>Returns the CPU time in the same format as <seealso marker="erlang#timestamp-0">erlang:timestamp()</seealso>. + The CPU time is the time the current logical cpu has spent executing since + some arbitrary point in the past. + If the OS does not support fetching of this value <c>enif_cpu_time</c> + invokes <seealso marker="#enif_make_badarg">enif_make_badarg</seealso>. + </p> + </desc> + </func> + <func><name><ret>int</ret><nametext>enif_equal_tids(ErlNifTid tid1, ErlNifTid tid2)</nametext></name> <fsummary></fsummary> <desc><p>Same as <seealso marker="erl_driver#erl_drv_equal_tids">erl_drv_equal_tids</seealso>. @@ -744,6 +838,12 @@ typedef enum { pid variable <c>*pid</c> from it and return true. Otherwise return false. No check if the process is alive is done.</p></desc> </func> + <func><name><ret>int</ret><nametext>enif_get_local_port(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifPort* port_id)</nametext></name> + <fsummary>Read an local port term</fsummary> + <desc><p>If <c>term</c> identifies a node local port, initialize the + port variable <c>*port_id</c> from it and return true. Otherwise return false. + No check if the port is alive is done.</p></desc> + </func> <func><name><ret>int</ret><nametext>enif_get_list_cell(ErlNifEnv* env, ERL_NIF_TERM list, ERL_NIF_TERM* head, ERL_NIF_TERM* tail)</nametext></name> <fsummary>Get head and tail from a list</fsummary> <desc><p>Set <c>*head</c> and <c>*tail</c> from @@ -753,7 +853,7 @@ typedef enum { <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> <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> + or return false if <c>term</c> is not a proper 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> @@ -912,6 +1012,17 @@ typedef enum { <fsummary>Determine if a term is a port</fsummary> <desc><p>Return true if <c>term</c> is a port.</p></desc> </func> + <func><name><ret>int</ret><nametext>enif_is_port_alive(ErlNifEnv* env, ErlNifPort *port_id)</nametext></name> + <fsummary>Determine if a local port is alive or not.</fsummary> + <desc><p>Return true if <c>port_id</c> is currently alive.</p> + <p>This function can only be used in a from a NIF-calling thread.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_is_process_alive(ErlNifEnv* env, ErlNifPid *pid)</nametext></name> + <fsummary>Determine if a local process is alive or not.</fsummary> + <desc><p>Return true if <c>pid</c> is currently alive.</p> + <p>This function is only thread-safe when the emulator with SMP support is used. + It can only be used in a non-SMP emulator from a NIF-calling thread.</p></desc> + </func> <func><name><ret>int</ret><nametext>enif_is_ref(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name> <fsummary>Determine if a term is a reference</fsummary> <desc><p>Return true if <c>term</c> is a reference.</p></desc> @@ -961,7 +1072,7 @@ typedef enum { <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> + 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 @@ -1195,6 +1306,23 @@ typedef enum { <fsummary>Create an unsigned integer term</fsummary> <desc><p>Create an integer term from an unsigned 64-bit integer.</p></desc> </func> + <func> + <name><ret>ERL_NIF_TERM</ret><nametext>enif_make_unique_integer(ErlNifEnv *env, ErlNifUniqueInteger properties)</nametext></name> + <fsummary></fsummary> + <desc> + <p>Returns a unique integer with the same properties as given by <seealso marker="erlang#unique_integer-1">erlang:unique_integer/1</seealso>.</p> + <p><c>env</c> is the environment to create the integer in.</p> + <p> + <c>ERL_NIF_UNIQUE_POSITIVE</c> and <c>ERL_NIF_UNIQUE_MONOTONIC</c> can + be passed as the second argument to change the properties of the + integer returned. It is possible to combine them by or:ing the + two values together. + </p> + <p>See also: + <seealso marker="#ErlNifUniqueInteger"><c>ErlNifUniqueInteger</c></seealso>. + </p> + </desc> + </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_ulong(ErlNifEnv* env, unsigned long i)</nametext></name> <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> @@ -1265,6 +1393,33 @@ enif_map_iterator_destroy(env, &iter); or false if the iterator is positioned at the head (before the first entry).</p></desc> </func> + + <func> + <name><ret>ErlNifTime</ret><nametext>enif_monotonic_time(ErlNifTimeUnit time_unit)</nametext></name> + <fsummary>Get Erlang Monotonic Time</fsummary> + <desc> + <marker id="enif_monotonic_time"></marker> + <p>Arguments:</p> + <taglist> + <tag><c>time_unit</c></tag> + <item>Time unit of returned value.</item> + </taglist> + <p> + Returns the current + <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso>. Note that it is not uncommon with + negative values. + </p> + <p>Returns <c>ERL_NIF_TIME_ERROR</c> if called with an invalid + time unit argument, or if called from a thread that is not a + scheduler thread.</p> + <p>See also: + <seealso marker="#ErlNifTime"><c>ErlNifTime</c></seealso> and + <seealso marker="#ErlNifTimeUnit"><c>ErlNifTimeUnit</c></seealso>. + </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>. @@ -1290,6 +1445,11 @@ enif_map_iterator_destroy(env, &iter); <desc><p>Same as <seealso marker="erl_driver#erl_drv_mutex_unlock">erl_drv_mutex_unlock</seealso>. </p></desc> </func> + <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_now_time(ErlNifEnv *env)</nametext></name> + <fsummary></fsummary> + <desc><p>Retuns an <seealso marker="erlang#now-0">erlang:now()</seealso> timestamp. + The enif_now_time function is <em>deprecated</em>.</p></desc> + </func> <func><name><ret>ErlNifResourceType *</ret><nametext>enif_open_resource_type(ErlNifEnv* env, const char* module_str, const char* name, ErlNifResourceDtor* dtor, ErlNifResourceFlags flags, ErlNifResourceFlags* tried)</nametext></name> @@ -1319,6 +1479,35 @@ enif_map_iterator_destroy(env, &iter); and <seealso marker="#upgrade">upgrade</seealso>.</p> </desc> </func> + <func><name><ret>int</ret><nametext>enif_port_command(ErlNifEnv* env, const ErlNifPort* to_port, ErlNifEnv *msg_env, ERL_NIF_TERM msg)</nametext></name> + <fsummary>Send a port_command to to_port</fsummary> + <desc> + <p>This function works the same as <seealso marker="erlang#port_command-2">erlang:port_command/2</seealso> + except that it is always completely asynchronous. This call may return false + if it detects that the port is already dead, otherwise it will return true. + </p> + <taglist> + <tag><c>env</c></tag> + <item>The environment of the calling process. May not be NULL.</item> + <tag><c>*to_port</c></tag> + <item>The port id of the receiving port. The port id should refer to a + port on the local node.</item> + <tag><c>msg_env</c></tag> + <item>The environment of the message term. Can be a process + independent environment allocated with + <seealso marker="#enif_alloc_env">enif_alloc_env</seealso> or NULL.</item> + <tag><c>msg</c></tag> + <item>The message term to send. The same limitations apply as on the + payload to <seealso marker="erlang#port_command-2">erlang:port_command/2</seealso>.</item> + </taglist> + <p>Using a <c>msg_env</c> of NULL is an optimization which groups together + calls to <c>enif_alloc_env</c>, <c>enif_make_copy</c>, <c>enif_port_command</c> + and <c>enif_free_env</c> into one call. This optimization is only usefull + when a majority of the terms are to be copied from <c>env</c> to the <c>msg_env</c>.</p> + <p>The call may return false if it detects that the command failed for some reason. Otherwise true is returned.</p> + <p>See also: <seealso marker="#enif_get_local_port"><c>enif_get_local_port</c></seealso>.</p> + </desc> + </func> <func><name><ret>void *</ret><nametext>enif_priv_data(ErlNifEnv* env)</nametext></name> <fsummary>Get the private data of a NIF library</fsummary> <desc><p>Return the pointer to the private data that was set by <c>load</c>, @@ -1442,7 +1631,7 @@ enif_map_iterator_destroy(env, &iter); <tag><c>msg_env</c></tag> <item>The environment of the message term. Must be a process independent environment allocated with - <seealso marker="#enif_alloc_env">enif_alloc_env</seealso>.</item> + <seealso marker="#enif_alloc_env">enif_alloc_env</seealso> or NULL.</item> <tag><c>msg</c></tag> <item>The message term to send.</item> </taglist> @@ -1451,8 +1640,12 @@ enif_map_iterator_destroy(env, &iter); <c>msg</c>) will be invalidated by a successful call to <c>enif_send</c>. The environment should either be freed with <seealso marker="#enif_free_env">enif_free_env</seealso> of cleared for reuse with <seealso marker="#enif_clear_env">enif_clear_env</seealso>.</p> + <p>If <c>msg_env</c> is set to NULL the <c>msg</c> term is copied and + the original term and its environemt is still valid after the call.</p> <p>This function is only thread-safe when the emulator with SMP support is used. It can only be used in a non-SMP emulator from a NIF-calling thread.</p> + <note><p>Passing <c>msg_env</c> as <c>NULL</c> is only supported since + erts-8.0 (OTP 19).</p></note> </desc> </func> <func><name><ret>unsigned</ret><nametext>enif_sizeof_resource(void* obj)</nametext></name> @@ -1466,6 +1659,18 @@ enif_map_iterator_destroy(env, &iter); <desc><p>Same as <seealso marker="erl_driver#driver_system_info">driver_system_info</seealso>. </p></desc> </func> + <func><name><ret>int</ret><nametext>enif_term_to_binary(ErlNifEnv *env, ERL_NIF_TERM term, ErlNifBinary *bin)</nametext></name> + <fsummary>Convert a term to the external format</fsummary> + <desc> + <p>Allocates a new binary with <seealso marker="#enif_alloc_binary">enif_alloc_binary</seealso> + and stores the result of encoding <c>term</c> according to the Erlang external term format.</p> + <p>Returns true on success or false if allocation failed.</p> + <p>See also: + <seealso marker="erlang#term_to_binary-1"><c>erlang:term_to_binary/1</c></seealso> and + <seealso marker="#enif_binary_to_term"><c>enif_binary_to_term</c></seealso>. + </p> + </desc> + </func> <func><name><ret>int</ret><nametext>enif_thread_create(char *name,ErlNifTid *tid,void * (*func)(void *),void *args,ErlNifThreadOpts *opts)</nametext></name> <fsummary></fsummary> <desc><p>Same as <seealso marker="erl_driver#erl_drv_thread_create">erl_drv_thread_create</seealso>. @@ -1496,54 +1701,6 @@ enif_map_iterator_destroy(env, &iter); <desc><p>Same as <seealso marker="erl_driver#erl_drv_thread_self">erl_drv_thread_self</seealso>. </p></desc> </func> - <func><name><ret>int</ret><nametext>enif_tsd_key_create(char *name, ErlNifTSDKey *key)</nametext></name> - <fsummary></fsummary> - <desc><p>Same as <seealso marker="erl_driver#erl_drv_tsd_key_create">erl_drv_tsd_key_create</seealso>. - </p></desc> - </func> - <func><name><ret>void</ret><nametext>enif_tsd_key_destroy(ErlNifTSDKey key)</nametext></name> - <fsummary></fsummary> - <desc><p>Same as <seealso marker="erl_driver#erl_drv_tsd_key_destroy">erl_drv_tsd_key_destroy</seealso>. - </p></desc> - </func> - <func><name><ret>void *</ret><nametext>enif_tsd_get(ErlNifTSDKey key)</nametext></name> - <fsummary></fsummary> - <desc><p>Same as <seealso marker="erl_driver#erl_drv_tsd_get">erl_drv_tsd_get</seealso>. - </p></desc> - </func> - <func><name><ret>void</ret><nametext>enif_tsd_set(ErlNifTSDKey key, void *data)</nametext></name> - <fsummary></fsummary> - <desc><p>Same as <seealso marker="erl_driver#erl_drv_tsd_set">erl_drv_tsd_set</seealso>. - </p></desc> - </func> - - - <func> - <name><ret>ErlNifTime</ret><nametext>enif_monotonic_time(ErlNifTimeUnit time_unit)</nametext></name> - <fsummary>Get Erlang Monotonic Time</fsummary> - <desc> - <marker id="enif_monotonic_time"></marker> - <p>Arguments:</p> - <taglist> - <tag><c>time_unit</c></tag> - <item>Time unit of returned value.</item> - </taglist> - <p> - Returns - <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang - monotonic time</seealso>. Note that it is not uncommon with - negative values. - </p> - <p>Returns <c>ERL_NIF_TIME_ERROR</c> if called with an invalid - time unit argument, or if called from a thread that is not a - scheduler thread.</p> - <p>See also:</p> - <list> - <item><seealso marker="#ErlNifTime"><c>ErlNifTime</c></seealso></item> - <item><seealso marker="#ErlNifTimeUnit"><c>ErlNifTimeUnit</c></seealso></item> - </list> - </desc> - </func> <func> <name><ret>ErlNifTime</ret><nametext>enif_time_offset(ErlNifTimeUnit time_unit)</nametext></name> @@ -1563,41 +1720,33 @@ enif_map_iterator_destroy(env, &iter); <p>Returns <c>ERL_NIF_TIME_ERROR</c> if called with an invalid time unit argument, or if called from a thread that is not a scheduler thread.</p> - <p>See also:</p> - <list> - <item><seealso marker="#ErlNifTime"><c>ErlNifTime</c></seealso></item> - <item><seealso marker="#ErlNifTimeUnit"><c>ErlNifTimeUnit</c></seealso></item> - </list> + <p>See also: + <seealso marker="#ErlNifTime"><c>ErlNifTime</c></seealso> and + <seealso marker="#ErlNifTimeUnit"><c>ErlNifTimeUnit</c></seealso>. + </p> </desc> </func> - <func> - <name><ret>ErlNifTime</ret><nametext>enif_convert_time_unit(ErlNifTime val, ErlNifTimeUnit from, ErlNifTimeUnit to)</nametext></name> - <fsummary>Convert time unit of a time value</fsummary> - <desc> - <marker id="enif_convert_time_unit"></marker> - <p>Arguments:</p> - <taglist> - <tag><c>val</c></tag> - <item>Value to convert time unit for.</item> - <tag><c>from</c></tag> - <item>Time unit of <c>val</c>.</item> - <tag><c>to</c></tag> - <item>Time unit of returned value.</item> - </taglist> - <p>Converts the <c>val</c> value of time unit <c>from</c> to - the corresponding value of time unit <c>to</c>. The result is - rounded using the floor function.</p> - <p>Returns <c>ERL_NIF_TIME_ERROR</c> if called with an invalid - time unit argument.</p> - <p>See also:</p> - <list> - <item><seealso marker="#ErlNifTime"><c>ErlNifTime</c></seealso></item> - <item><seealso marker="#ErlNifTimeUnit"><c>ErlNifTimeUnit</c></seealso></item> - </list> - </desc> + <func><name><ret>int</ret><nametext>enif_tsd_key_create(char *name, ErlNifTSDKey *key)</nametext></name> + <fsummary></fsummary> + <desc><p>Same as <seealso marker="erl_driver#erl_drv_tsd_key_create">erl_drv_tsd_key_create</seealso>. + </p></desc> + </func> + <func><name><ret>void</ret><nametext>enif_tsd_key_destroy(ErlNifTSDKey key)</nametext></name> + <fsummary></fsummary> + <desc><p>Same as <seealso marker="erl_driver#erl_drv_tsd_key_destroy">erl_drv_tsd_key_destroy</seealso>. + </p></desc> + </func> + <func><name><ret>void *</ret><nametext>enif_tsd_get(ErlNifTSDKey key)</nametext></name> + <fsummary></fsummary> + <desc><p>Same as <seealso marker="erl_driver#erl_drv_tsd_get">erl_drv_tsd_get</seealso>. + </p></desc> + </func> + <func><name><ret>void</ret><nametext>enif_tsd_set(ErlNifTSDKey key, void *data)</nametext></name> + <fsummary></fsummary> + <desc><p>Same as <seealso marker="erl_driver#erl_drv_tsd_set">erl_drv_tsd_set</seealso>. + </p></desc> </func> - </funcs> <section> <title>SEE ALSO</title> diff --git a/erts/doc/src/erl_prim_loader.xml b/erts/doc/src/erl_prim_loader.xml index db4f132609..d3ece37cc5 100644 --- a/erts/doc/src/erl_prim_loader.xml +++ b/erts/doc/src/erl_prim_loader.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -50,36 +50,9 @@ <c>-loader_debug</c> are also experimental</p></warning> </description> - <datatypes> - <datatype> - <name name="host"/> - </datatype> - </datatypes> <funcs> <func> - <name name="start" arity="3"/> - <fsummary>Start the Erlang low level loader</fsummary> - <desc> - <p>Starts the Erlang low level loader. This function is called - by the <c>init</c> process (and module). The <c>init</c> - process reads the command line flags <c>-id <anno>Id</anno></c>, - <c>-loader <anno>Loader</anno></c>, and <c>-hosts <anno>Hosts</anno></c>. These are - the arguments supplied to the <c>start/3</c> function.</p> - <p>If <c>-loader</c> is not given, the default loader is - <c>efile</c> which tells the system to read from the file - system.</p> - <p>If <c>-loader</c> is <c>inet</c>, the <c>-id <anno>Id</anno></c>, - <c>-hosts <anno>Hosts</anno></c>, and <c>-setcookie Cookie</c> flags must - also be supplied. <c><anno>Hosts</anno></c> identifies hosts which this - node can contact in order to load modules. One Erlang - runtime system with a <c>erl_boot_server</c> process must be - started on each of hosts given in <c><anno>Hosts</anno></c> in order to - answer the requests. See <seealso - marker="kernel:erl_boot_server">erl_boot_server(3)</seealso>.</p> - </desc> - </func> - <func> <name name="get_file" arity="1"/> <fsummary>Get a file</fsummary> <desc> @@ -87,8 +60,6 @@ <c><anno>Filename</anno></c> is either an absolute file name or just the name of the file, for example <c>"lists.beam"</c>. If an internal path is set to the loader, this path is used to find the file. - If a user supplied loader is used, the path can be stripped - off if it is obsolete, and the loader does not use a path. <c><anno>FullName</anno></c> is the complete name of the fetched file. <c><anno>Bin</anno></c> is the contents of the file as a binary.</p> @@ -189,17 +160,12 @@ <p>Specifies which other Erlang nodes the <c>inet</c> loader can use. This flag is mandatory if the <c>-loader inet</c> flag is present. On each host, there must be on Erlang node - with the <c>erl_boot_server</c> which handles the load - requests. <c>Hosts</c> is a list of IP addresses (hostnames + with the <seealso + marker="kernel:erl_boot_server">erl_boot_server(3)</seealso> + which handles the load requests. + <c>Hosts</c> is a list of IP addresses (hostnames are not acceptable).</p> </item> - <tag><c>-id Id</c></tag> - <item> - <p>Specifies the identity of the Erlang runtime system. If - the system runs as a distributed node, <c>Id</c> must be - identical to the name supplied with the <c>-sname</c> or - <c>-name</c> distribution flags.</p> - </item> <tag><c>-setcookie Cookie</c></tag> <item> <p>Specifies the cookie of the Erlang runtime system. This flag diff --git a/erts/doc/src/erl_tracer.xml b/erts/doc/src/erl_tracer.xml new file mode 100644 index 0000000000..2075b962d8 --- /dev/null +++ b/erts/doc/src/erl_tracer.xml @@ -0,0 +1,668 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2016</year><year>2016</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + </legalnotice> + + <title>erl_tracer</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + </header> + <module>erl_tracer</module> + <modulesummary>Erlang Tracer Behaviour</modulesummary> + <description> + <p>A behaviour module for implementing the back end of the erlang + tracing system. The functions in this module will be called whenever + a trace probe is triggered. Both the <c>enabled</c> and <c>trace</c> + functions are called in the context of the entity that triggered the + trace probe. + This means that the overhead by having the tracing enabled will be + greatly effected by how much time is spent in these functions. So do as + little work as possible in these functions.</p> + <note> + <p>All functions in this behaviour have to be implemented as NIF's. + This is a limitation that may the lifted in the future. + There is an <seealso marker="#example">example tracer module nif</seealso> + implementation at the end of this page.</p> + </note> + <warning> + <p>Do not send messages or issue port commands to the <c>Tracee</c> + in any of the callbacks. Doing so is not allowed and can cause all + sorts of strange behaviour, including but not limited to infinite + recursions.</p> + </warning> + </description> + + <datatypes> + <datatype> <name name="trace_tag_send" /> </datatype> + <datatype> <name name="trace_tag_receive" /> </datatype> + <datatype> <name name="trace_tag_call" /> </datatype> + <datatype> <name name="trace_tag_procs" /> </datatype> + <datatype> <name name="trace_tag_ports" /> </datatype> + <datatype> <name name="trace_tag_running_procs" /> </datatype> + <datatype> <name name="trace_tag_running_ports" /> </datatype> + <datatype> <name name="trace_tag_gc" /> </datatype> + <datatype> + <name name="trace_tag" /> + <desc> + <p>The different trace tags that the tracer will be called with. + Each trace tag is described in greater detail in + <seealso marker="#trace">Module:trace/6</seealso> + </p> + </desc> + </datatype> + <datatype> + <name name="tracee" /> + <desc> + <p>The process or port that the trace belongs to. + </p> + </desc> + </datatype> + <datatype> + <name name="trace_opts" /> + <desc> + <p>The options for the tracee. + <taglist> + <tag><c>timestamp</c></tag> + <item>If not set to <c>undefined</c>, the tracer has been requested to + include a timestamp.</item> + <tag><c>match_spec_result</c></tag> + <item>If not set to <c>true</c>, the tracer has been requested to + include the output of a match specification that was run.</item> + <tag><c>scheduler_id</c></tag> + <item>Set to a number of the scheduler id is to be included by the tracer. + Otherwise it is set to <c>undefined</c>.</item> + </taglist> + </p> + </desc> + </datatype> + <datatype> + <name name="tracer_state" /> + <desc> + <p> + The state which is given when calling + <seealso marker="erlang#trace-3"><c>erlang:trace(PidPortSpec,true,[{tracer,Module,TracerState}])</c></seealso>. + The tracer state is an immutable value that is passed to erl_tracer callbacks and should + contain all the data that is needed to generate the trace event. + </p> + </desc> + </datatype> + </datatypes> + + <section> + <title>CALLBACK FUNCTIONS</title> + <p>The following functions + should be exported from a <c>erl_tracer</c> callback module.</p> + <taglist> + <tag><seealso marker="#enabled"><c>Module:enabled/3</c></seealso></tag> + <item>Mandatory</item> + <tag><seealso marker="#trace"><c>Module:trace/6</c></seealso></tag> + <item>Mandatory</item> + <tag><seealso marker="#enabled_procs"><c>Module:enabled_procs/3</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#trace_procs"><c>Module:trace_procs/6</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#enabled_ports"><c>Module:enabled_ports/3</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#trace_ports"><c>Module:trace_ports/6</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#enabled_running_ports"><c>Module:enabled_running_ports/3</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#trace_running_ports"><c>Module:trace_running_ports/6</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#enabled_running_procs"><c>Module:enabled_running_procs/3</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#trace_running_procs"><c>Module:trace_running_procs/6</c></seealso></tag> + <item>Optional</item> + </taglist> + + </section> + <marker id="enabled"></marker> + <funcs> + <func> + <name>Module:enabled(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag">trace_tag()</seealso> | trace_status</v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint is triggered. It + allows the tracer to decide whether a trace should be generated or not. + This check is made as early as possible in order to limit the amount of + overhead associated with tracing. If <c>trace</c> is returned the + necessary trace data will be created and the trace call-back of the tracer + will be called. If <c>discard</c> is returned, this trace call + will be discarded and no call to trace will be done. If + <c>remove</c> is returned, the VM will attempt to remove this tracer + from the tracee, together with any trace flags set on the tracee. + </p> + <p><c>trace_status</c> is a special type of <c>TraceTag</c> which is used + to check if the tracer should still be active. It is called in multiple + scenarios, but most significantly it is used when tracing is started + using this tracer.</p> + <p>This function may be called multiple times per tracepoint, so it + is important that it is both fast and side effect free.</p> + </desc> + </func> + <marker id="trace"></marker> + <func> + <name>Module:trace(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag">trace_tag()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled">Module:enabled/3</seealso> + callback returned <c>trace</c>. In it any side effects needed by + the tracer should be done. The tracepoint payload is located in + the <c>FirstTraceTerm</c> and <c>SecondTraceTerm</c>. The content + of the TraceTerms depends on which <c>TraceTag</c> has been triggered. + The <c>FirstTraceTerm</c> and <c>SecondTraceTerm</c> correspond to the + fourth and fifth slot in the trace tuples described in + <seealso marker="erlang#trace_3_trace_messages">erlang:trace/3</seealso>. + If the tuple only has four elements, <c>SecondTraceTerm</c> will be + <c>undefined</c>.</p> + </desc> + </func> + <func> + <name name="trace">Module:trace(seq_trace, TracerState, Label, SeqTraceInfo, undefined, Opts) -> Result</name> + <fsummary>Check if a sequence trace event should be generated.</fsummary> + <type> + <v>TracerState = term()</v> + <v>Label = term()</v> + <v>SeqTraceInfo = term()</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>The <c>TraceTag</c> <c>seq_trace</c> is handled a little bit + differently. There is not <c>Tracee</c> for seq_trace, instead the + <c>Label</c> associated with the seq_trace event is given. + For more info on what <c>Label</c> and <c>SeqTraceInfo</c> can be + see the <seealso marker="kernel:seq_trace">seq_trace</seealso> manual.</p> + </desc> + </func> + + <marker id="enabled_procs"></marker> + <func> + <name>Module:enabled_procs(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_procs">trace_tag_procs()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>procs</c></seealso> + is triggered.</p> + <p>If <c>enabled_procs/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_procs"></marker> + <func> + <name>Module:trace_procs(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_procs">trace_tag()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_procs">Module:enabled_procs/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_procs/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_ports"></marker> + <func> + <name>Module:enabled_ports(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_ports">trace_tag_ports()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>ports</c></seealso> + is triggered.</p> + <p>If <c>enabled_ports/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_ports"></marker> + <func> + <name>Module:trace_ports(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_ports">trace_tag()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_ports">Module:enabled_ports/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_ports/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_running_procs"></marker> + <func> + <name>Module:enabled_running_procs(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_running_procs">trace_tag_running_procs()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>running_procs | running</c></seealso> + is triggered.</p> + <p>If <c>enabled_running_procs/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_running_procs"></marker> + <func> + <name>Module:trace_running_procs(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_running_procs">trace_tag_running_procs()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_running_procs">Module:enabled_running_procs/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_running_procs/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_running_ports"></marker> + <func> + <name>Module:enabled_running_ports(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_running_ports">trace_tag_running_ports()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>running_ports</c></seealso> + is triggered.</p> + <p>If <c>enabled_running_ports/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_running_ports"></marker> + <func> + <name>Module:trace_running_ports(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_running_ports">trace_tag_running_ports()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_running_ports">Module:enabled_running_ports/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_running_ports/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_call"></marker> + <func> + <name>Module:enabled_call(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_call">trace_tag_call()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>call | return_to</c></seealso> + is triggered.</p> + <p>If <c>enabled_call/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_call"></marker> + <func> + <name>Module:trace_call(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_call">trace_tag_call()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_call">Module:enabled_call/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_call/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_send"></marker> + <func> + <name>Module:enabled_send(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_send">trace_tag_send()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>send</c></seealso> + is triggered.</p> + <p>If <c>enabled_send/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_send"></marker> + <func> + <name>Module:trace_send(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_send">trace_tag_send()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_send">Module:enabled_send/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_send/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_receive"></marker> + <func> + <name>Module:enabled_receive(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_receive">trace_tag_receive()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>'receive'</c></seealso> + is triggered.</p> + <p>If <c>enabled_receive/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_receive"></marker> + <func> + <name>Module:trace_receive(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_receive">trace_tag_receive()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_receive">Module:enabled_receive/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_receive/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_garbage_collection"></marker> + <func> + <name>Module:enabled_garbage_collection(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_gc">trace_tag_gc()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>garbage_collection</c></seealso> + is triggered.</p> + <p>If <c>enabled_garbage_collection/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_garbage_collection"></marker> + <func> + <name>Module:trace_garbage_collection(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_gc">trace_tag_gc()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_garbage_collection">Module:enabled_garbage_collection/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_garbage_collection/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + </funcs> + <section> + <marker id="example"></marker> + <title>Erl Tracer Module example</title> + <p>In the example below a tracer module with a nif backend sends a message + for each <c>send</c> trace tag containing only the sender and receiver. + Using this tracer module, a much more lightweight message tracer is + used that only records who sent messages to who.</p> + <p>Here is an example session using it on Linux.</p> + <pre> +$ gcc -I erts-8.0/include/ -fPIC -shared -o erl_msg_tracer.so erl_msg_tracer.c +$ erl +Erlang/OTP 19 [DEVELOPMENT] [erts-8.0] [source-ed2b56b] [64-bit] [smp:8:8] [async-threads:10] [hipe] [kernel-poll:false] + +Eshell V8.0 (abort with ^G) +1> c(erl_msg_tracer), erl_msg_tracer:load(). +ok +2> Tracer = spawn(fun F() -> receive M -> io:format("~p~n",[M]), F() end end). +<0.37.0> +3> erlang:trace(new, true, [send,{tracer, erl_msg_tracer, Tracer}]). +0 +{<0.39.0>,<0.27.0>} +4> {ok, D} = file:open("/tmp/tmp.data",[write]). +{trace,#Port<0.486>,<0.40.0>} +{trace,<0.40.0>,<0.21.0>} +{trace,#Port<0.487>,<0.4.0>} +{trace,#Port<0.488>,<0.4.0>} +{trace,#Port<0.489>,<0.4.0>} +{trace,#Port<0.490>,<0.4.0>} +{ok,<0.40.0>} +{trace,<0.41.0>,<0.27.0>} +5> + </pre> + <p>erl_msg_tracer.erl</p> + <pre> +-module(erl_msg_tracer). + +-export([enabled/3, trace/6, load/0]). + +load() -> + erlang:load_nif("erl_msg_tracer", []). + +enabled(_, _, _) -> + error. + +trace(_, _, _,_, _, _) -> + error. + </pre> + <p>erl_msg_tracer.c</p> + <pre> +#include "erl_nif.h" + +/* NIF interface declarations */ +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); +static void unload(ErlNifEnv* env, void* priv_data); + +/* The NIFs: */ +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +static ErlNifFunc nif_funcs[] = { + {"enabled", 3, enabled}, + {"trace", 6, trace} +}; + +ERL_NIF_INIT(erl_msg_tracer, nif_funcs, load, NULL, upgrade, unload) + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + *priv_data = NULL; + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) +{ + +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, + ERL_NIF_TERM load_info) +{ + if (*old_priv_data != NULL || *priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if (load(env, priv_data, load_info)) { + return -1; + } + return 0; +} + +/* + * argv[0]: Trace Tag + * argv[1]: TracerState + * argv[2]: Tracee + */ +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPid to_pid; + if (enif_get_local_pid(env, argv[1], &to_pid)) + if (!enif_is_process_alive(env, &to_pid)) + /* tracer is dead so we should remove this tracepoint */ + return enif_make_atom(env, "remove"); + + /* Only generate trace for when tracer != tracee */ + if (enif_is_identical(argv[1], argv[2])) + return enif_make_atom(env, "discard"); + + /* Only trigger trace messages on 'send' */ + if (enif_is_identical(enif_make_atom(env, "send"), argv[0])) + return enif_make_atom(env, "trace"); + + /* Have to answer trace_status */ + if (enif_is_identical(enif_make_atom(env, "trace_status"), argv[0])) + return enif_make_atom(env, "trace"); + + return enif_make_atom(env, "discard"); +} + +/* + * argv[0]: Trace Tag, should only be 'send' + * argv[1]: TracerState, process to send {argv[2], argv[4]} to + * argv[2]: Tracee + * argv[3]: Message, ignored + * argv[4]: Recipient + * argv[5]: Options, ignored + */ +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPid to_pid; + + if (enif_get_local_pid(env, argv[1], &to_pid)) { + ERL_NIF_TERM msg = enif_make_tuple3(env, enif_make_atom(env, "trace"), argv[2], argv[4]); + enif_send(env, &to_pid, NULL, msg); + } + + return enif_make_atom(env, "ok"); +} + </pre> + </section> +</erlref> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 30e6751f41..3276bc34b0 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2015</year> + <year>1996</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -59,6 +59,12 @@ </datatype> <datatype> + <name name="message_queue_data"></name> + <desc><p>See <seealso marker="#process_flag_message_queue_data"><c>erlang:process_flag(message_queue_data, MQD)</c></seealso>.</p> + </desc> + </datatype> + + <datatype> <name name="timestamp"></name> <desc><p>See <seealso marker="#timestamp/0">erlang:timestamp/0</seealso>.</p> </desc> @@ -125,6 +131,17 @@ </note> </item> + <tag><c>perf_counter</c></tag> + <item><p>Symbolic representation of the performance counter + time unit used by the Erlang runtime system.</p> + + <p>The <c>perf_counter</c> time unit behaves much in the same way + as the <c>native</c> time unit. That is it might differ inbetween + run-time restarts. You get values of this type by calling + <seealso marker="kernel:os#perf_counter/0"><c>os:perf_counter()</c></seealso> + </p> + </item> + </taglist> <p>The <c>time_unit/0</c> type may be extended. Use @@ -1105,7 +1122,7 @@ <fsummary>Prints a term on standard output.</fsummary> <desc> <p>Prints a text representation of <c><anno>Term</anno></c> on the - standard output. On OSE, the term is printed to the ramlog.</p> + standard output.</p> <warning> <p>This BIF is intended for debugging only.</p> </warning> @@ -2596,6 +2613,48 @@ os_prompt% </pre> </func> <func> + <name name="match_spec_test" arity="3"/> + <fsummary>Test that a match specification works</fsummary> + <desc> + <p> + This function is a utility to test a match_spec used in calls to + <seealso marker="stdlib:ets#select/2">ets:select/2</seealso> and + <seealso marker="#trace_pattern/3">erlang:trace_pattern/3</seealso>. + The function both tests MatchSpec for "syntactic" correctness and + runs the match_spec against the object. If the match_spec contains + errors, the tuple {error, Errors} is returned where Errors is a list + of natural language descriptions of what was wrong with the match_spec. + </p> + <p> + If the <c><anno>Type</anno></c> is <c>table</c> the object to match + against should be a tuple. The function then returns + {ok,Result,[],Warnings} where Result is what would have been the + result in a real ets:select/2 call or false if the match_spec does + not match the object tuple. + </p> + + <p> + If <c><anno>Type</anno></c> is <c>trace</c> the object to match + against should be a list. The function returns + {ok, Result, Flags, Warnings} where Result is <c>true</c> if a trace + message should be emitted, <c>false</c> if a trace message should not + be emitted or the message term to be appended to the trace message. + Flags is a list containing all the trace flags that will be enabled, + at the moment this is only <c>return_trace</c>. + </p> + + <p> + This is a useful debugging and test tool, especially when writing complicated + match specifications. + </p> + <p> + See also + <seealso marker="stdlib:ets#test_ms/2">ets:test_ms/2</seealso>. + </p> + </desc> + </func> + + <func> <name name="max" arity="2"/> <fsummary>Returns the largest of two terms.</fsummary> <desc> @@ -4281,9 +4340,59 @@ os_prompt% </pre> <p>Returns the old value of the flag.</p> </desc> </func> - + <marker id="process_flag_message_queue_data"/> <func> <name name="process_flag" arity="2" clause_i="5"/> + <fsummary>Set process flag <c>message_queue_data</c> for the calling process</fsummary> + <type name="message_queue_data"/> + <desc> + <p>This flag determines how messages in the message queue + are stored. When the flag is:</p> + <taglist> + <tag><c>off_heap</c></tag> + <item><p> + <em>All</em> messages in the message queue will be stored + outside of the process heap. This implies that <em>no</em> + messages in the message queue will be part of a garbage + collection of the process. + </p></item> + <tag><c>on_heap</c></tag> + <item><p> + All messages in the message queue will eventually be + placed on heap. They may however temporarily be stored + off heap. This is how messages always have been stored + up until ERTS version 8.0. + </p></item> + <tag><c>mixed</c></tag> + <item><p> + Messages may be placed either on the heap or outside + of the heap. + </p></item> + </taglist> + <p> + The default <c>message_queue_data</c> process flag is determined + by the <seealso marker="erl#+hmqd"><c>+hmqd</c></seealso> + <c>erl</c> command line argument. + </p> + <p> + If the process potentially may get a hugh amount of messages, + you are recommended to set the flag to <c>off_heap</c>. This + since a garbage collection with lots of messages placed on + the heap may become extremly expensive and the process may + consume large amounts of memory. Performance of the + actual message passing is however generally better when not + using the <c>off_heap</c> flag. + </p> + <p> + When changing this flag messages will be moved. This work + has been initiated but not completed when this function + call returns. + </p> + <p>Returns the old value of the flag.</p> + </desc> + </func> + <func> + <name name="process_flag" arity="2" clause_i="6"/> <fsummary>Sets process flag <c>priority</c> for the calling process.</fsummary> <type name="priority_level"/> <desc> @@ -4357,7 +4466,7 @@ os_prompt% </pre> </func> <func> - <name name="process_flag" arity="2" clause_i="6"/> + <name name="process_flag" arity="2" clause_i="7"/> <fsummary>Sets process flag <c>save_calls</c> for the calling process.</fsummary> <desc> <p><c><anno>N</anno></c> must be an integer in the interval 0..10000. @@ -4388,7 +4497,7 @@ os_prompt% </pre> </func> <func> - <name name="process_flag" arity="2" clause_i="7"/> + <name name="process_flag" arity="2" clause_i="8"/> <fsummary>Sets process flag <c>sensitive</c> for the calling process.</fsummary> <desc> <p>Sets or clears flag <c>sensitive</c> for the current process. @@ -4442,6 +4551,7 @@ os_prompt% </pre> <type name="process_info_result_item"/> <type name="priority_level"/> <type name="stack_item"/> + <type name="message_queue_data" /> <desc> <p>Returns a list containing <c><anno>InfoTuple</anno></c>s with miscellaneous information about the process identified by @@ -4494,6 +4604,7 @@ os_prompt% </pre> <type name="process_info_result_item"/> <type name="stack_item"/> <type name="priority_level"/> + <type name="message_queue_data" /> <desc> <p>Returns information about the process identified by <c><anno>Pid</anno></c>, as specified by @@ -4585,6 +4696,17 @@ os_prompt% </pre> The content of <c><anno>GCInfo</anno></c> can be changed without prior notice.</p> </item> + <tag><c>{garbage_collection_info, <anno>GCInfo</anno>}</c></tag> + <item> + <p><c><anno>GCInfo</anno></c> is a list containing miscellaneous + detailed information about garbage collection for this process. + The content of <c><anno>GCInfo</anno></c> can be changed without + prior notice. + See <seealso marker="#gc_minor_start">gc_minor_start</seealso> in + <seealso marker="#trace/3">erlang:trace/3</seealso> for details about + what each item means. + </p> + </item> <tag><c>{group_leader, <anno>GroupLeader</anno>}</c></tag> <item> <p><c><anno>GroupLeader</anno></c> is group leader for the I/O of @@ -4662,6 +4784,15 @@ os_prompt% </pre> monitor by name, the list item is <c>{process, {<anno>RegName</anno>, <anno>Node</anno>}}</c>.</p> </item> + <tag><c>{message_queue_data, <anno>MQD</anno>}</c></tag> + <item> + <p>Returns the current state of the <c>message_queue_data</c> + process flag. <c><anno>MQD</anno></c> is either <c>off_heap</c>, + <c>on_heap</c>, or <c>mixed</c>. For more information, see the + documentation of + <seealso marker="#process_flag_message_queue_data"><c>process_flag(message_queue_data, + MQD)</c></seealso>.</p> + </item> <tag><c>{priority, <anno>Level</anno>}</c></tag> <item> <p><c><anno>Level</anno></c> is the current priority level for @@ -4747,7 +4878,9 @@ os_prompt% </pre> <tag><c>{total_heap_size, <anno>Size</anno>}</c></tag> <item> <p><c><anno>Size</anno></c> is the total size, in words, of all heap - fragments of the process. This includes the process stack.</p> + fragments of the process. This includes the process stack and + any unreceived messages that are considered to be part of the + heap. </p> </item> <tag><c>{trace, <anno>InternalTraceFlags</anno>}</c></tag> <item> @@ -4804,6 +4937,12 @@ os_prompt% </pre> <seealso marker="kernel:code">code(3)</seealso>) and is not to be used elsewhere.</p> </warning> + <note> + <p>As from <c>ERTS</c> 8.0 (OTP 19), any lingering processes + that still execute the old code will be killed by this function. + In earlier versions, such incorrect use could cause much + more fatal failures, like emulator crash.</p> + </note> <p>Failure: <c>badarg</c> if there is no old code for <c><anno>Module</anno></c>.</p> </desc> @@ -5430,6 +5569,8 @@ true</pre> <name name="spawn_opt" arity="2"/> <fsummary>Creates a new process with a fun as entry point.</fsummary> <type name="priority_level"/> + <type name="message_queue_data" /> + <type name="spawn_opt_option" /> <desc> <p>Returns the process identifier (pid) of a new process started by the application of <c><anno>Fun</anno></c> @@ -5445,6 +5586,8 @@ true</pre> <name name="spawn_opt" arity="3"/> <fsummary>Creates a new process with a fun as entry point on a given node.</fsummary> <type name="priority_level"/> + <type name="message_queue_data" /> + <type name="spawn_opt_option" /> <desc> <p>Returns the process identifier (pid) of a new process started by the application of <c><anno>Fun</anno></c> to the @@ -5459,6 +5602,8 @@ true</pre> <name name="spawn_opt" arity="4"/> <fsummary>Creates a new process with a function as entry point.</fsummary> <type name="priority_level"/> + <type name="message_queue_data" /> + <type name="spawn_opt_option" /> <desc> <p>Works as <seealso marker="#spawn/3">spawn/3</seealso>, except that an @@ -5560,6 +5705,18 @@ true</pre> fine-tuning an application and to measure the execution time with various <c><anno>VSize</anno></c> values.</p> </item> + <tag><c>{message_queue_data, <anno>MQD</anno>}</c></tag> + <item> + <p>Sets the state of the <c>message_queue_data</c> process + flag. <c><anno>MQD</anno></c> should be either <c>off_heap</c>, + <c>on_heap</c>, or <c>mixed</c>. The default + <c>message_queue_data</c> process flag is determined by the + <seealso marker="erl#+hmqd"><c>+hmqd</c></seealso> <c>erl</c> + command line argument. For more information, see the + documentation of + <seealso marker="#process_flag_message_queue_data"><c>process_flag(message_queue_data, + <anno>MQD</anno>)</c></seealso>.</p> + </item> </taglist> </desc> </func> @@ -5568,6 +5725,8 @@ true</pre> <name name="spawn_opt" arity="5"/> <fsummary>Creates a new process with a function as entry point on a given node.</fsummary> <type name="priority_level"/> + <type name="message_queue_data" /> + <type name="spawn_opt_option" /> <desc> <p>Returns the process identifier (pid) of a new process started by the application @@ -5756,6 +5915,146 @@ true</pre> <func> <name name="statistics" arity="1" clause_i="6"/> + <fsummary>Information about microstate accounting.</fsummary> + <desc> + <marker id="statistics_microstate_accounting"></marker> + <p> + Microstate accounting can be used to measure how much time the Erlang + runtime system spends doing various tasks. It is designed to be as + lightweight as possible, but there will be some overhead when this + is enabled. Microstate accounting is meant to be a profiling tool + to help figure out performance bottlenecks. + To <c>start</c>/<c>stop</c>/<c>reset</c> microstate_accounting you use + the system_flag + <seealso marker="#system_flag_microstate_accounting"> + <c>microstate_accounting</c></seealso>. + </p> + <p> + <c>erlang:statistics(microstate_accounting)</c> returns a list of maps + representing some of the OS threads within ERTS. Each map contains + <c>type</c> and <c>id</c> fields that can be used to identify what + thread it is, and also a counters field that contains data about how + much time has been spent in the various states.</p> + <pre> +> <input>erlang:statistics(microstate_accounting).</input> +[#{counters => #{aux => 1899182914, + check_io => 2605863602, + emulator => 45731880463, + gc => 1512206910, + other => 5421338456, + port => 221631, + sleep => 5150294100}, + id => 1, + type => scheduler}|...] + </pre> + <p>The time unit is the same as returned by + <seealso marker="kernel:os#perf_counter/0"> + <c>os:perf_counter/0</c></seealso>. + So to convert it to milliseconds you could do something like this:</p> + <pre> +lists:map( + fun(#{ counters := Cnt } = M) -> + MsCnt = maps:map(fun(_K, PerfCount) -> + erlang:convert_time_unit(PerfCount, perf_counter, 1000) + end, Cnt), + M#{ counters := MsCnt } + end, erlang:statistics(microstate_accounting)). + </pre> + <p> + It is important to note that these values are not guaranteed to be + the exact time spent in each state. This is because of various + optimisation done in order to keep the overhead as small as possible. + </p> + + <p>Currently the following <c><anno>MSAcc_Thread_Type</anno></c> are available:</p> + <taglist> + <tag><c>scheduler</c></tag> + <item>The main execution threads that do most of the work.</item> + <tag><c>async</c></tag><item>Async threads are used by various + linked-in drivers (mainly the file drivers) do offload non-cpu + intensive work.</item> + <tag><c>aux</c></tag><item>Takes care of any work that is not + specifically assigned to a scheduler.</item> + </taglist> + <p>Currently the following <c><anno>MSAcc_Thread_State</anno></c>s are available. + All states are exclusive, meaning that a thread cannot be in two states + at once. So if you add the numbers of all counters in a thread + you will get the total run-time for that thread.</p> + <taglist> + <tag><c>aux</c></tag> + <item>Time spent handling auxiliary jobs.</item> + <tag><c>check_io</c></tag> + <item>Time spent checking for new I/O events.</item> + <tag><c>emulator</c></tag> + <item>Time spent executing erlang processes.</item> + <tag><c>gc</c></tag> + <item>Time spent doing garbage collection. When extra states are + enabled this is the time spent doing non-fullsweep garbage + collections.</item> + <tag><c>other</c></tag> + <item>Time spent doing unaccounted things.</item> + <tag><c>port</c></tag> + <item>Time spent executing ports.</item> + <tag><c>sleep</c></tag> + <item>Time spent sleeping.</item> + </taglist> + <p>It is possible to add more fine grained <c><anno>MSAcc_Thread_State</anno></c>s + through configure. + (e.g. <c>./configure --with-microstate-accounting=extra</c>). + Enabling these states will cause a performance degradation when + microstate accounting is turned off and increase the overhead when + it is turned on.</p> + <taglist> + <tag><c>alloc</c></tag> + <item>Time spent managing memory. Without extra states this time is + spread out over all other states.</item> + <tag><c>bif</c></tag> + <item>Time spent in bifs. Without extra states this time is part of + the <c>emulator</c> state.</item> + <tag><c>busy_wait</c></tag> + <item>Time spent busy waiting. This is also the state where a + scheduler no longer reports that it is active when using + <seealso marker="#statistics_scheduler_wall_time"> + <c>erlang:statistics(scheduler_wall_time)</c></seealso>. + So if you add all other states but this and sleep and then divide that + by all time in the thread you should get something very similar to the + scheduler_wall_time fraction. Without extra states this time is part + of the <c>other</c> state.</item> + <tag><c>ets</c></tag> + <item>Time spent executing ETS bifs. Without extra states this time is + part of the <c>emulator</c> state.</item> + <tag><c>gc_full</c></tag> + <item>Time spent doing fullsweep garbage collection. Without extra + states this time is part of the <c>gc</c> state.</item> + <tag><c>nif</c></tag> + <item>Time spent in nifs. Without extra states this time is part of + the <c>emulator</c> state.</item> + <tag><c>send</c></tag> + <item>Time spent sending messages (processes only). Without extra + states this time is part of the <c>emulator</c> state.</item> + <tag><c>timers</c></tag> + <item>Time spent managing timers. Without extra states this time is + part of the <c>other</c> state.</item> + </taglist> + <p>There is a utility module called + <seealso marker="runtime_tools:msacc"><c>msacc</c></seealso> in + runtime_tools that can be used to more easily analyse these + statistics.</p> + + <p> + Returns <c>undefined</c> if the system flag + <seealso marker="#system_flag_microstate_accounting"> + <c>microstate_accounting</c></seealso> + is turned off. + </p> + <p>The list of thread information is unsorted and may appear in + different order between calls.</p> + <note><p>The threads and states are subject to change without any + prior notice.</p></note> + </desc> + </func> + <func> + <name name="statistics" arity="1" clause_i="7"/> <fsummary>Information about reductions.</fsummary> <desc> <marker id="statistics_reductions"></marker> @@ -5773,7 +6072,7 @@ true</pre> </func> <func> - <name name="statistics" arity="1" clause_i="7"/> + <name name="statistics" arity="1" clause_i="8"/> <fsummary>Information about the run-queues.</fsummary> <desc><marker id="statistics_run_queue"></marker> <p> @@ -5789,7 +6088,7 @@ true</pre> </func> <func> - <name name="statistics" arity="1" clause_i="8"/> + <name name="statistics" arity="1" clause_i="9"/> <fsummary>Information about the run-queue lengths.</fsummary> <desc><marker id="statistics_run_queue_lengths"></marker> <p> @@ -5809,7 +6108,7 @@ true</pre> </func> <func> - <name name="statistics" arity="1" clause_i="9"/> + <name name="statistics" arity="1" clause_i="10"/> <fsummary>Information about runtime.</fsummary> <desc> <p>Returns information about runtime, in milliseconds.</p> @@ -5824,7 +6123,7 @@ true</pre> </func> <func> - <name name="statistics" arity="1" clause_i="10"/> + <name name="statistics" arity="1" clause_i="11"/> <fsummary>Information about each schedulers work time.</fsummary> <desc> <marker id="statistics_scheduler_wall_time"></marker> @@ -5895,7 +6194,7 @@ ok </func> <func> - <name name="statistics" arity="1" clause_i="11"/> + <name name="statistics" arity="1" clause_i="12"/> <fsummary>Information about active processes and ports.</fsummary> <desc><marker id="statistics_total_active_tasks"></marker> <p> @@ -5913,7 +6212,7 @@ ok </func> <func> - <name name="statistics" arity="1" clause_i="12"/> + <name name="statistics" arity="1" clause_i="13"/> <fsummary>Information about the run-queue lengths.</fsummary> <desc><marker id="statistics_total_run_queue_lengths"></marker> <p> @@ -5932,7 +6231,7 @@ ok </func> <func> - <name name="statistics" arity="1" clause_i="13"/> + <name name="statistics" arity="1" clause_i="14"/> <fsummary>Information about wall clock.</fsummary> <desc> <p>Returns information about wall clock. <c>wall_clock</c> can @@ -6166,6 +6465,17 @@ ok <func> <name name="system_flag" arity="2" clause_i="5"/> + <fsummary>Set system flag microstate_accounting</fsummary> + <desc><p><marker id="system_flag_microstate_accounting"></marker> + Turns on/off microstate accounting measurements. By passing reset it is possible to reset + all counters to 0.</p> + <p>For more information see, + <seealso marker="#statistics_microstate_accounting">erlang:statistics(microstate_accounting)</seealso>. + </p> + </desc> + </func> + <func> + <name name="system_flag" arity="2" clause_i="6"/> <fsummary>Sets system flag <c>min_heap_size</c>.</fsummary> <desc> <p>Sets the default minimum heap size for processes. The size @@ -6180,7 +6490,7 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="6"/> + <name name="system_flag" arity="2" clause_i="7"/> <fsummary>Sets system flag <c>min_bin_vheap_size</c>.</fsummary> <desc> <p>Sets the default minimum binary virtual heap size for @@ -6197,45 +6507,57 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="7"/> + <name name="system_flag" arity="2" clause_i="8"/> <fsummary>Sets system flag <c>multi_scheduling</c>.</fsummary> <desc> <p><marker id="system_flag_multi_scheduling"></marker> If multi-scheduling is enabled, more than one scheduler thread is used by the emulator. Multi-scheduling can be - blocked. When multi-scheduling is blocked, only - one scheduler thread schedules Erlang processes.</p> + blocked in two different ways. Either all schedulers but + one is blocked, or all <em>normal</em> schedulers but + one is blocked. When only normal schedulers are blocked + dirty schedulers are free to continue to schedule + processes.</p> <p>If <c><anno>BlockState</anno> =:= block</c>, multi-scheduling is - blocked. If <c><anno>BlockState</anno> =:= unblock</c> and no one + blocked. That is, one and only one scheduler thread will + execute. If <c><anno>BlockState</anno> =:= unblock</c> and no one else blocks multi-scheduling, and this process has blocked only once, multi-scheduling is unblocked.</p> - <p>One process can block multi-scheduling multiple times. - If a process has blocked multiple times, it must - unblock exactly as many times as it has blocked before it - has released its multi-scheduling block. If a process that - has blocked multi-scheduling exits, it releases its - blocking of multi-scheduling.</p> + <p>If <c><anno>BlockState</anno> =:= block_normal</c>, normal + multi-scheduling is blocked. That is, only one normal scheduler + thread will execute, but multiple dirty schedulers may execute. + If <c><anno>BlockState</anno> =:= unblock_normal</c> and no one + else blocks normal multi-scheduling, and this process has + blocked only once, normal multi-scheduling is unblocked.</p> + <p>One process can block multi-scheduling as well as normal + multi-scheduling multiple times. If a process has blocked + multiple times, it must unblock exactly as many times as it + has blocked before it has released its multi-scheduling + block. If a process that has blocked multi-scheduling or normal + multi scheduling exits, it automatically releases its blocking + of multi-scheduling and normal multi-scheduling.</p> <p>The return values are <c>disabled</c>, <c>blocked</c>, - or <c>enabled</c>. The returned value describes the - state just after the call to + <c>blocked_normal</c>, or <c>enabled</c>. The returned value + describes the state just after the call to <c>erlang:system_flag(multi_scheduling, <anno>BlockState</anno>)</c> has been made. For information about the return values, see <seealso marker="#system_info_multi_scheduling">erlang:system_info(multi_scheduling)</seealso>.</p> - <note><p>Blocking of multi-scheduling is normally not needed. - If you feel that you need to block multi-scheduling, - consider it a few more times again. Blocking multi-scheduling - is only to be used as a last resort, as it is most likely - a <em>very inefficient</em> way to solve the problem.</p> + <note><p>Blocking of multi-scheduling and normal multi-scheduling + is normally not needed. If you feel that you need to use these + features, consider it a few more times again. Blocking + multi-scheduling is only to be used as a last resort, as it is + most likely a <em>very inefficient</em> way to solve the problem.</p> </note> <p>See also <seealso marker="#system_info_multi_scheduling">erlang:system_info(multi_scheduling)</seealso>, + <seealso marker="#system_info_normal_multi_scheduling_blockers">erlang:system_info(normal_multi_scheduling_blockers)</seealso>, <seealso marker="#system_info_multi_scheduling_blockers">erlang:system_info(multi_scheduling_blockers)</seealso>, and <seealso marker="#system_info_schedulers">erlang:system_info(schedulers)</seealso>.</p> </desc> </func> <func> - <name name="system_flag" arity="2" clause_i="8"/> + <name name="system_flag" arity="2" clause_i="9"/> <fsummary>Sets system flag <c>scheduler_bind_type</c>.</fsummary> <type name="scheduler_bind_type"/> <desc> @@ -6353,7 +6675,7 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="9"/> + <name name="system_flag" arity="2" clause_i="10"/> <fsummary>Sets system flag <c>scheduler_wall_time</c>.</fsummary> <desc><p><marker id="system_flag_scheduler_wall_time"></marker> Turns on or off scheduler wall time measurements.</p> @@ -6363,7 +6685,7 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="10"/> + <name name="system_flag" arity="2" clause_i="11"/> <fsummary>Sets system flag <c>schedulers_online</c>.</fsummary> <desc> <p><marker id="system_flag_schedulers_online"></marker> @@ -6388,7 +6710,7 @@ ok </func> <func> - <name name="system_flag" arity="2" clause_i="11"/> + <name name="system_flag" arity="2" clause_i="12"/> <fsummary>Sets system flag <c>trace_control_word</c>.</fsummary> <desc> <p>Sets the value of the node trace control word to @@ -6727,6 +7049,7 @@ ok <name name="system_info" arity="1" clause_i="65"/> <name name="system_info" arity="1" clause_i="66"/> <name name="system_info" arity="1" clause_i="67"/> + <name name="system_info" arity="1" clause_i="68"/> <fsummary>Information about the system.</fsummary> <desc> <p>Returns various information about the current system @@ -7062,6 +7385,16 @@ ok where <c><anno>MinHeapSize</anno></c> is the current system-wide minimum heap size for spawned processes.</p> </item> + <tag><marker id="system_info_message_queue_data"><c>message_queue_data</c></marker></tag> + <item> + <p>Returns the default value of the <c>message_queue_data</c> + process flag which is either <c>off_heap</c>, <c>on_heap</c>, or <c>mixed</c>. + This default is set by the <c>erl</c> command line argument + <seealso marker="erl#+hmqd"><c>+hmqd</c></seealso>. For more information on the + <c>message_queue_data</c> process flag, see documentation of + <seealso marker="#process_flag_message_queue_data"><c>process_flag(message_queue_data, + MQD)</c></seealso>.</p> + </item> <tag><c>min_bin_vheap_size</c></tag> <item> <p>Returns <c>{min_bin_vheap_size, @@ -7081,7 +7414,8 @@ ok <tag><c>multi_scheduling</c></tag> <item> <marker id="system_info_multi_scheduling"></marker> - <p>Returns <c>disabled</c>, <c>blocked</c>, or <c>enabled</c>:</p> + <p>Returns <c>disabled</c>, <c>blocked</c>, <c>blocked_normal</c>, + or <c>enabled</c>:</p> <taglist> <tag><c>disabled</c></tag> <item> @@ -7092,14 +7426,22 @@ ok <tag><c>blocked</c></tag> <item> <p>The emulator has more than one scheduler thread, - but all scheduler threads except one are blocked, - that is, only one scheduler thread schedules + but all scheduler threads except one are blocked. + That is, only one scheduler thread schedules Erlang processes and executes Erlang code.</p> </item> + <tag><c>blocked_normal</c></tag> + <item> + <p>The emulator has more than one scheduler thread, + but all normal scheduler threads except one are + blocked. Note that dirty schedulers are not + blocked, and may schedule Erlang processes and + execute native code.</p> + </item> <tag><c>enabled</c></tag> <item> <p>The emulator has more than one scheduler thread, - and no scheduler threads are blocked, that is, + and no scheduler threads are blocked. That is, all available scheduler threads schedule Erlang processes and execute Erlang code.</p> </item> @@ -7107,6 +7449,7 @@ ok <p>See also <seealso marker="#system_flag_multi_scheduling">erlang:system_flag(multi_scheduling, BlockState)</seealso>, <seealso marker="#system_info_multi_scheduling_blockers">erlang:system_info(multi_scheduling_blockers)</seealso>, + <seealso marker="#system_info_normal_multi_scheduling_blockers">erlang:system_info(normal_multi_scheduling_blockers)</seealso>, and <seealso marker="#system_info_schedulers">erlang:system_info(schedulers)</seealso>.</p> </item> @@ -7123,6 +7466,8 @@ ok <p>See also <seealso marker="#system_flag_multi_scheduling">erlang:system_flag(multi_scheduling, BlockState)</seealso>, <seealso marker="#system_info_multi_scheduling">erlang:system_info(multi_scheduling)</seealso>, + <seealso marker="#system_info_normal_multi_scheduling_blockers">erlang:system_info(normal_multi_scheduling_blockers)</seealso>, + and <seealso marker="#system_info_schedulers">erlang:system_info(schedulers)</seealso>.</p> </item> @@ -7132,7 +7477,25 @@ ok used by the runtime system. It is on the form "<major ver>.<minor ver>".</p> </item> - <tag><c>otp_release</c></tag> + <tag><c>normal_multi_scheduling_blockers</c></tag> + <item> + <marker id="system_info_normal_multi_scheduling_blockers"></marker> + <p>Returns a list of <c><anno>Pid</anno></c>s when + normal multi-scheduling is blocked (i.e. all normal schedulers + but one is blocked), otherwise the empty list is returned. + The <c><anno>Pid</anno></c>s in the list represent all the + processes currently blocking normal multi-scheduling. + A <c><anno>Pid</anno></c> occurs only once in the list, even if + the corresponding process has blocked multiple times.</p> + <p>See also + <seealso marker="#system_flag_multi_scheduling">erlang:system_flag(multi_scheduling, BlockState)</seealso>, + <seealso marker="#system_info_multi_scheduling">erlang:system_info(multi_scheduling)</seealso>, + <seealso marker="#system_info_multi_scheduling_blockers">erlang:system_info(multi_scheduling_blockers)</seealso>, + + and + <seealso marker="#system_info_schedulers">erlang:system_info(schedulers)</seealso>.</p> + </item> + <tag><marker id="system_info_otp_release"><c>otp_release</c></marker></tag> <item> <marker id="system_info_otp_release"></marker> <p>Returns a string containing the OTP release number of the @@ -7373,6 +7736,7 @@ ok <seealso marker="#system_info_scheduler_id">erlang:system_info(scheduler_id)</seealso>, <seealso marker="#system_flag_multi_scheduling">erlang:system_flag(multi_scheduling, BlockState)</seealso>, <seealso marker="#system_info_multi_scheduling">erlang:system_info(multi_scheduling)</seealso>, + <seealso marker="#system_info_normal_multi_scheduling_blockers">erlang:system_info(normal_multi_scheduling_blockers)</seealso> and <seealso marker="#system_info_multi_scheduling_blockers">erlang:system_info(multi_scheduling_blockers)</seealso>.</p> </item> @@ -7604,7 +7968,7 @@ ok <c>stack_size</c>, <c>mbuf_size</c>, <c>old_heap_size</c>, and <c>old_heap_block_size</c>. These tuples are explained in the description of trace message - <seealso marker="#gc_start">gc_start</seealso> (see + <seealso marker="#gc_minor_start">gc_minor_start</seealso> (see <seealso marker="#trace/3">erlang:trace/3</seealso>). New tuples can be added, and the order of the tuples in the <c>Info</c> list can be changed at any time without @@ -8027,22 +8391,47 @@ timestamp() -> <c><anno>How</anno> == false</c>) the trace flags in <c><anno>FlagList</anno></c> for the process or processes represented by - <c><anno>PidSpec</anno></c>.</p> - <p><c><anno>PidSpec</anno></c> is either a process identifier - (pid) for a local process, or one of the following atoms:</p> + <c><anno>PidPortSpec</anno></c>.</p> + <p><c><anno>PidPortSpec</anno></c> is either a process identifier + (pid) for a local process, a port identifier, + or one of the following atoms:</p> <taglist> + <tag><c>all</c></tag> + <item> + <p>All currently existing processes and ports and all that + will be created in the future.</p> + </item> + <tag><c>processes</c></tag> + <item> + <p>All currently existing processes and all that will be created in the future.</p> + </item> + <tag><c>ports</c></tag> + <item> + <p>All currently existing ports and all that will be created in the future.</p> + </item> <tag><c>existing</c></tag> <item> + <p>All currently existing processes and ports.</p> + </item> + <tag><c>existing_processes</c></tag> + <item> <p>All currently existing processes.</p> </item> + <tag><c>existing_ports</c></tag> + <item> + <p>All currently existing ports.</p> + </item> <tag><c>new</c></tag> <item> - <p>All processes that are created in the future.</p> + <p>All processes and ports that will be created in the future.</p> </item> - <tag><c>all</c></tag> + <tag><c>new_processes</c></tag> + <item> + <p>All processes that will be created in the future.</p> + </item> + <tag><c>new_ports</c></tag> <item> - <p>All currently existing processes and all processes that - are created in the future.</p> + <p>All ports that will be created in the future.</p> </item> </taglist> <p><c><anno>FlagList</anno></c> can contain any number of the @@ -8051,35 +8440,28 @@ timestamp() -> <taglist> <tag><c>all</c></tag> <item> - <p>Sets all trace flags except <c>{tracer, Tracer}</c> and + <p>Sets all trace flags except <c>tracer</c> and <c>cpu_timestamp</c>, which are in their nature different than the others.</p> </item> <tag><c>send</c></tag> <item> <p>Traces sending of messages.</p> - <p>Message tags: <c>send</c> and - <c>send_to_non_existing_process</c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_send">send</seealso></c> and + <c><seealso marker="#trace_3_trace_messages_send_to_non_existing_process">send_to_non_existing_process</seealso></c>.</p> </item> <tag><c>'receive'</c></tag> <item> <p>Traces receiving of messages.</p> - <p>Message tags: <c>'receive'</c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_receive">'receive'</seealso></c>.</p> </item> - <tag><c>procs</c></tag> - <item> - <p>Traces process-related events.</p> - <p>Message tags: <c>spawn</c>, <c>exit</c>, - <c>register</c>, <c>unregister</c>, <c>link</c>, - <c>unlink</c>, <c>getting_linked</c>, and - <c>getting_unlinked</c>.</p> - </item> - <tag><c>call</c></tag> +<tag><c>call</c></tag> <item> <p>Traces certain function calls. Specify which function calls to trace by calling <seealso marker="#trace_pattern/3">erlang:trace_pattern/3</seealso>.</p> - <p>Message tags: <c>call</c> and <c>return_from</c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_call">call</seealso></c> and + <c><seealso marker="#trace_3_trace_messages_return_from">return_from</seealso></c>.</p> </item> <tag><c>silent</c></tag> <item> @@ -8097,8 +8479,9 @@ timestamp() -> specification function <c>{silent,Bool}</c>, giving a high degree of control of which functions with which arguments that trigger the trace.</p> - <p>Message tags: <c>call</c>, <c>return_from</c>, and - <c>return_to</c>. Or rather, the absence of.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_call">call</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_return_from">return_from</seealso></c>, and + <c><seealso marker="#trace_3_trace_messages_return_to">return_to</seealso></c>. Or rather, the absence of.</p> </item> <tag><c>return_to</c></tag> <item> @@ -8119,23 +8502,63 @@ timestamp() -> <p>To get trace messages containing return values from functions, use the <c>{return_trace}</c> match specification action instead.</p> - <p>Message tags: <c>return_to</c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_return_to">return_to</seealso></c>.</p> + </item> + <tag><c>procs</c></tag> + <item> + <p>Traces process-related events.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_spawn">spawn</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_spawned">spawned</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_exit">exit</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_register">register</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_unregister">unregister</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_link">link</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_unlink">unlink</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_getting_linked">getting_linked</seealso></c>, and + <c><seealso marker="#trace_3_trace_messages_getting_unlinked">getting_unlinked</seealso></c>.</p> + </item> + <tag><c>ports</c></tag> + <item> + <p>Traces port-related events.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_open">open</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_closed">closed</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_register">register</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_unregister">unregister</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_getting_linked">getting_linked</seealso></c>, and + <c><seealso marker="#trace_3_trace_messages_getting_unlinked">getting_unlinked</seealso></c>.</p> </item> <tag><c>running</c></tag> <item> <p>Traces scheduling of processes.</p> - <p>Message tags: <c>in</c> and <c>out</c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_in_proc">in</seealso></c> and + <c><seealso marker="#trace_3_trace_messages_out_proc">out</seealso></c>.</p> </item> <tag><c>exiting</c></tag> <item> <p>Traces scheduling of exiting processes.</p> - <p>Message tags: <c>in_exiting</c>, <c>out_exiting</c>, and - <c>out_exited</c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_in_exiting_proc">in_exiting</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_out_exiting_proc">out_exiting</seealso></c>, and + <c><seealso marker="#trace_3_trace_messages_out_exited_proc">out_exited</seealso></c>.</p> + </item> + <tag><c>running_procs</c></tag> + <item> + <p>Traces scheduling of processes just like <c>running</c>. + However this option also includes schedule events when the + process executes within the context of a port without + being scheduled out itself.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_in_proc">in</seealso></c> and + <c><seealso marker="#trace_3_trace_messages_out_proc">out</seealso></c>.</p> + </item> + <tag><c>running_ports</c></tag> + <item> + <p>Traces scheduling of ports.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_in_port">in</seealso></c> and + <c><seealso marker="#trace_3_trace_messages_out_port">out</seealso></c>.</p> </item> <tag><c>garbage_collection</c></tag> <item> <p>Traces garbage collections of processes.</p> - <p>Message tags: <c>gc_start</c> and <c>gc_end</c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_gc_minor_start">gc_minor_start</seealso></c> and <c><seealso marker="#trace_3_trace_messages_gc_minor_end">gc_minor_end</seealso></c>.</p> </item> <tag><c>timestamp</c></tag> <item> @@ -8150,8 +8573,8 @@ timestamp() -> in CPU time, not wall clock time. That is, <c>cpu_timestamp</c> will not be used if <c>monotonic_timestamp</c>, or <c>strict_monotonic_timestamp</c> is enabled. - Only allowed with <c>PidSpec==all</c>. If the host - machine OS does not support high-resolution + Only allowed with <c><anno>PidPortSpec</anno>==all</c>. If the + host machine OS does not support high-resolution CPU time measurements, <c>trace/3</c> exits with <c>badarg</c>. Notice that most OS do not synchronize this value across cores, so be prepared @@ -8163,8 +8586,8 @@ timestamp() -> <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang monotonic time</seealso> time-stamp in all trace messages. The time-stamp (Ts) has the same format and value as produced by - <c>erlang:monotonic_time(nano_seconds)</c>. This flag overrides - the <c>cpu_timestamp</c> flag.</p> + <c><seealso marker="#monotonic_time-1">erlang:monotonic_time(nano_seconds)</seealso></c>. + This flag overrides the <c>cpu_timestamp</c> flag.</p> </item> <tag><c>strict_monotonic_timestamp</c></tag> <item> @@ -8173,9 +8596,9 @@ timestamp() -> monotonic time</seealso> and a monotonically increasing integer in all trace messages. The time-stamp (Ts) has the same format and value as produced by - <c>{erlang:monotonic_time(nano_seconds), - erlang:unique_integer([monotonic])}</c>. This flag overrides - the <c>cpu_timestamp</c> flag.</p> + <c>{<seealso marker="#monotonic_time-1">erlang:monotonic_time(nano_seconds)</seealso>, + <seealso marker="#unique_integer-1">erlang:unique_integer([monotonic])</seealso>}</c>. + This flag overrides the <c>cpu_timestamp</c> flag.</p> </item> <tag><c>arity</c></tag> <item> @@ -8209,12 +8632,20 @@ timestamp() -> <item> <p>Specifies where to send the trace messages. <c>Tracer</c> must be the process identifier of a local process - or the port identifier - of a local port. If this flag is not given, trace - messages are sent to the process that called - <c>erlang:trace/3</c>.</p> + or the port identifier of a local port.</p> + </item> + <tag><c>{tracer, TracerModule, TracerState}</c></tag> + <item> + <p>Specifies that a tracer module should be called + instead of sending a trace message. The tracer module + can then ignore or change the trace message. For more details + on how to write a tracer module see + <seealso marker="erts:erl_tracer"><c>erl_tracer</c></seealso> + </p> </item> </taglist> + <p>If no <c>tracer</c> is given, the calling process + will be receiving all of the trace messages</p> <p>The effect of combining <c>set_on_first_link</c> with <c>set_on_link</c> is the same as having <c>set_on_first_link</c> alone. Likewise for @@ -8235,21 +8666,36 @@ timestamp() -> the other one will become active.</p> <marker id="trace_3_trace_messages"></marker> <taglist> - <tag><c>{trace, Pid, 'receive', Msg}</c></tag> + <tag> + <marker id="trace_3_trace_messages_send"></marker> + <c>{trace, PidPort, send, Msg, To}</c> + </tag> <item> - <p>When <c>Pid</c> receives message <c>Msg</c>.</p> - </item> - <tag><c>{trace, Pid, send, Msg, To}</c></tag> - <item> - <p>When <c>Pid</c> sends message <c>Msg</c> to + <p>When <c>PidPort</c> sends message <c>Msg</c> to process <c>To</c>.</p> </item> - <tag><c>{trace, Pid, send_to_non_existing_process, Msg, To}</c></tag> + <tag> + <marker id="trace_3_trace_messages_send_to_non_existing_process"></marker> + <c>{trace, PidPort, send_to_non_existing_process, Msg, To}</c> + </tag> <item> - <p>When <c>Pid</c> sends message <c>Msg</c> to + <p>When <c>PidPort</c> sends message <c>Msg</c> to the non-existing process <c>To</c>.</p> </item> - <tag><c>{trace, Pid, call, {M, F, Args}}</c></tag> + <tag> + <marker id="trace_3_trace_messages_receive"></marker> + <c>{trace, PidPort, 'receive', Msg}</c> + </tag> + <item> + <p>When <c>PidPort</c> receives message <c>Msg</c>. + If <c>Msg</c> is set to timeout, then a receive + statement may have timedout, or the process received + a message with the payload <c>timeout</c>.</p> + </item> + <tag> + <marker id="trace_3_trace_messages_call"></marker> + <c>{trace, Pid, call, {M, F, Args}}</c> + </tag> <item> <p>When <c>Pid</c> calls a traced function. The return values of calls are never supplied, only the call and its @@ -8258,7 +8704,10 @@ timestamp() -> change the contents of this message, so that <c>Arity</c> is specified instead of <c>Args</c>.</p> </item> - <tag><c>{trace, Pid, return_to, {M, F, Arity}}</c></tag> + <tag> + <marker id="trace_3_trace_messages_return_to"></marker> + <c>{trace, Pid, return_to, {M, F, Arity}}</c> + </tag> <item> <p>When <c>Pid</c> returns <em>to</em> the specified function. This trace message is sent if both @@ -8270,76 +8719,175 @@ timestamp() -> (that is, the functions match specification matched, and <c>{message, false}</c> was not an action).</p> </item> - <tag><c>{trace, Pid, return_from, {M, F, Arity}, ReturnValue}</c></tag> + <tag> + <marker id="trace_3_trace_messages_return_from"></marker> + <c>{trace, Pid, return_from, {M, F, Arity}, ReturnValue}</c> + </tag> <item> <p>When <c>Pid</c> returns <em>from</em> the specified function. This trace message is sent if flag <c>call</c> is set, and the function has a match specification with a <c>return_trace</c> or <c>exception_trace</c> action.</p> </item> - <tag><c>{trace, Pid, exception_from, {M, F, Arity}, {Class, Value}}</c></tag> + <tag> + <marker id="trace_3_trace_messages_exception_from"></marker> + <c>{trace, Pid, exception_from, {M, F, Arity}, {Class, Value}}</c> + </tag> <item> <p>When <c>Pid</c> exits <em>from</em> the specified function because of an exception. This trace message is sent if flag <c>call</c> is set, and the function has a match specification with an <c>exception_trace</c> action.</p> </item> - <tag><c>{trace, Pid, spawn, Pid2, {M, F, Args}}</c></tag> + <tag> + <marker id="trace_3_trace_messages_spawn"></marker> + <c>{trace, Pid, spawn, Pid2, {M, F, Args}}</c> + </tag> <item> <p>When <c>Pid</c> spawns a new process <c>Pid2</c> with the specified function call as entry point.</p> <p><c>Args</c> is supposed to be the argument list, but can be any term if the spawn is erroneous.</p> </item> - <tag><c>{trace, Pid, exit, Reason}</c></tag> + <tag> + <marker id="trace_3_trace_messages_spawned"></marker> + <c>{trace, Pid, spawned, Pid2, {M, F, Args}}</c> + </tag> + <item> + <p>When <c>Pid</c> is spawned by process <c>Pid2</c> with + the specified function call as entry point.</p> + <p><c>Args</c> is supposed to be the argument list, + but can be any term if the spawn is erroneous.</p> + </item> + <tag> + <marker id="trace_3_trace_messages_exit"></marker> + <c>{trace, Pid, exit, Reason}</c> + </tag> <item> <p>When <c>Pid</c> exits with reason <c>Reason</c>.</p> </item> - <tag><c>{trace, Pid, link, Pid2}</c></tag> + <tag> + <marker id="trace_3_trace_messages_register"></marker> + <c>{trace, PidPort, register, RegName}</c> + </tag> + <item> + <p>When <c>PidPort</c> gets the name <c>RegName</c> registered.</p> + </item> + <tag> + <marker id="trace_3_trace_messages_unregister"></marker> + <c>{trace, PidPort, unregister, RegName}</c> + </tag> + <item> + <p>When <c>PidPort</c> gets the name <c>RegName</c> unregistered. + This is done automatically when a registered + process or port exits.</p> + </item> + <tag> + <marker id="trace_3_trace_messages_link"></marker> + <c>{trace, Pid, link, Pid2}</c> + </tag> <item> <p>When <c>Pid</c> links to a process <c>Pid2</c>.</p> </item> - <tag><c>{trace, Pid, unlink, Pid2}</c></tag> + <tag> + <marker id="trace_3_trace_messages_unlink"></marker> + <c>{trace, Pid, unlink, Pid2}</c> + </tag> <item> <p>When <c>Pid</c> removes the link from a process <c>Pid2</c>.</p> </item> - <tag><c>{trace, Pid, getting_linked, Pid2}</c></tag> + <tag> + <marker id="trace_3_trace_messages_getting_linked"></marker> + <c>{trace, PidPort, getting_linked, Pid2}</c> + </tag> <item> - <p>When <c>Pid</c> gets linked to a process <c>Pid2</c>.</p> + <p>When <c>PidPort</c> gets linked to a process <c>Pid2</c>.</p> </item> - <tag><c>{trace, Pid, getting_unlinked, Pid2}</c></tag> + <tag> + <marker id="trace_3_trace_messages_getting_unlinked"></marker> + <c>{trace, PidPort, getting_unlinked, Pid2}</c> + </tag> <item> - <p>When <c>Pid</c> gets unlinked from a process <c>Pid2</c>.</p> + <p>When <c>PidPort</c> gets unlinked from a process <c>Pid2</c>.</p> </item> - <tag><c>{trace, Pid, register, RegName}</c></tag> + <tag> + <marker id="trace_3_trace_messages_exit"></marker> + <c>{trace, Pid, exit, Reason}</c> + </tag> <item> - <p>When <c>Pid</c> gets the name <c>RegName</c> registered.</p> + <p>When <c>Pid</c> exits with reason <c>Reason</c>.</p> </item> - <tag><c>{trace, Pid, unregister, RegName}</c></tag> + <tag> + <marker id="trace_3_trace_messages_open"></marker> + <c>{trace, Port, open, Pid, Driver}</c> + </tag> <item> - <p>When <c>Pid</c> gets the name <c>RegName</c> unregistered. - This is done automatically when a registered - process exits.</p> + <p>When <c>Pid</c> opens a new port <c>Port</c> with + the running the <c>Driver</c>.</p> + <p><c>Driver</c> is the name of the driver as an atom.</p> </item> - <tag><c>{trace, Pid, in, {M, F, Arity} | 0}</c></tag> + <tag> + <marker id="trace_3_trace_messages_closed"></marker> + <c>{trace, Port, closed, Reason}</c> + </tag> + <item> + <p>When <c>Port</c> closed with <c>Reason</c>.</p> + </item> + <tag> + <marker id="trace_3_trace_messages_in_proc"></marker> + <marker id="trace_3_trace_messages_in_exiting_proc"></marker> + <c>{trace, Pid, in | in_exiting, {M, F, Arity} | 0}</c> + </tag> <item> <p>When <c>Pid</c> is scheduled to run. The process runs in function <c>{M, F, Arity}</c>. On some rare occasions, the current function cannot be determined, then the last element is <c>0</c>.</p> </item> - <tag><c>{trace, Pid, out, {M, F, Arity} | 0}</c></tag> + <tag> + <marker id="trace_3_trace_messages_out_proc"></marker> + <marker id="trace_3_trace_messages_out_exiting_proc"></marker> + <marker id="trace_3_trace_messages_out_exited_proc"></marker> + <c>{trace, Pid, out | out_exiting | out_exited, {M, F, Arity} | 0}</c> + </tag> <item> <p>When <c>Pid</c> is scheduled out. The process was running in function {M, F, Arity}. On some rare occasions, the current function cannot be determined, then the last element is <c>0</c>.</p> </item> - <tag><c>{trace, Pid, gc_start, Info}</c></tag> + <tag> + <marker id="trace_3_trace_messages_in_port"></marker> + <c>{trace, Port, in, Command | 0}</c> + </tag> + <item> + <p>When <c>Port</c> is scheduled to run. <c>Command</c> is the + first thing the port will execute, it may however run several + commands before being scheduled out. On some rare + occasions, the current function cannot be determined, + then the last element is <c>0</c>.</p> + <p>The possible commands are: <c>call | close | command | connect | control | flush | info | link | open | unlink</c></p> + </item> + <tag> + <marker id="trace_3_trace_messages_out_port"></marker> + <c>{trace, Port, out, Command | 0}</c> + </tag> + <item> + <p>When <c>Port</c> is scheduled out. The last command run + was <c>Command</c>. On some rare occasions, + the current function cannot be determined, then the last + element is <c>0</c>. <c>Command</c> can contain the same + commands as <c>in</c> + </p> + </item> + <tag> + <marker id="trace_3_trace_messages_gc_minor_start"></marker> + <c>{trace, Pid, gc_minor_start, Info}</c> + </tag> <item> - <marker id="gc_start"></marker> - <p>Sent when garbage collection is about to be started. + <marker id="gc_minor_start"></marker> + <p>Sent when a young garbage collection is about to be started. <c>Info</c> is a list of two-element tuples, where the first element is a key, and the second is the value. Do not depend on any order of the tuples. @@ -8378,26 +8926,46 @@ timestamp() -> </taglist> <p>All sizes are in words.</p> </item> - <tag><c>{trace, Pid, gc_end, Info}</c></tag> + <tag> + <marker id="trace_3_trace_messages_gc_minor_end"></marker> + <c>{trace, Pid, gc_minor_end, Info}</c> + </tag> <item> - <p>Sent when garbage collection is finished. <c>Info</c> - contains the same kind of list as in message <c>gc_start</c>, + <p>Sent when young garbage collection is finished. <c>Info</c> + contains the same kind of list as in message <c>gc_minor_start</c>, but the sizes reflect the new sizes after garbage collection.</p> </item> + <tag> + <marker id="trace_3_trace_messages_gc_major_start"></marker> + <c>{trace, Pid, gc_major_start, Info}</c> + </tag> + <item> + <p>Sent when fullsweep garbage collection is about to be started. <c>Info</c> + contains the same kind of list as in message <c>gc_minor_start</c>.</p> + </item> + <tag> + <marker id="trace_3_trace_messages_gc_major_end"></marker> + <c>{trace, Pid, gc_major_end, Info}</c> + </tag> + <item> + <p>Sent when fullsweep garbage collection is finished. <c>Info</c> + contains the same kind of list as in message <c>gc_minor_start</c> + but the sizes reflect the new sizes after a fullsweep garbage collection.</p> + </item> </taglist> - <p>If the tracing process dies, the flags are silently - removed.</p> - <p>Only one process can trace a particular process. Therefore, + <p>If the tracing process/port dies or the tracer module returns + <c>remove</c>, the flags are silently removed.</p> + <p>Each process can only be traced by one tracer. Therefore, attempts to trace an already traced process fail.</p> <p>Returns: A number indicating the number of processes that - matched <c><anno>PidSpec</anno></c>. - If <c><anno>PidSpec</anno></c> is a process + matched <c><anno>PidPortSpec</anno></c>. + If <c><anno>PidPortSpec</anno></c> is a process identifier, the return value is <c>1</c>. - If <c><anno>PidSpec</anno></c> + If <c><anno>PidPortSpec</anno></c> is <c>all</c> or <c>existing</c>, the return value is - the number of processes running, excluding tracer processes. - If <c><anno>PidSpec</anno></c> is <c>new</c>, the return value is + the number of processes running. + If <c><anno>PidPortSpec</anno></c> is <c>new</c>, the return value is <c>0</c>.</p> <p>Failure: <c>badarg</c> if the specified arguments are not supported. For example, <c>cpu_timestamp</c> is not @@ -8409,7 +8977,11 @@ timestamp() -> <name name="trace_delivered" arity="1"/> <fsummary>Notification when trace has been delivered.</fsummary> <desc> - <p>The delivery of trace messages is dislocated on the time-line + <p>The delivery of trace messages (generated by + <seealso marker="#trace/3"><c>erlang:trace/3</c></seealso>, + <seealso marker="kernel:seq_trace"><c>seq_trace</c></seealso> or + <seealso marker="#system_profile/2"><c>erlang:system_profile/2</c></seealso>) + is dislocated on the time-line compared to other events in the system. If you know that <c><anno>Tracee</anno></c> has passed some specific point in its execution, @@ -8430,13 +9002,16 @@ timestamp() -> has not been traced by someone, but if this is the case, <em>no</em> trace messages have been delivered when the <c>trace_delivered</c> message arrives.</p> - <p>Notice that that <c><anno>Tracee</anno></c> must refer + <p>Notice that <c><anno>Tracee</anno></c> must refer to a process currently, or previously existing on the same node as the caller of <c>erlang:trace_delivered(<anno>Tracee</anno>)</c> resides on. The special <c><anno>Tracee</anno></c> atom <c>all</c> - denotes all processes - that currently are traced in the node.</p> + denotes all processes that currently are traced in the node.</p> + <p>When used together with an <seealso marker="erts:erl_tracer"> + Tracer Module</seealso> any message sent in the trace callback + is guaranteed to have reached it's recipient before the + <c>trace_delivered</c> message is sent.</p> <p>Example: Process <c>A</c> is <c><anno>Tracee</anno></c>, port <c>B</c> is tracer, and process <c>C</c> is the port owner of <c>B</c>. <c>C</c> wants to close <c>B</c> when @@ -8459,12 +9034,15 @@ timestamp() -> <type name="trace_info_flag"/> <type name="trace_match_spec"/> <desc> - <p>Returns trace information about a process or function.</p> - <p>To get information about a process, - <c><anno>PidOrFunc</anno></c> is to - be a process identifier (pid) or the atom <c>new</c>. - The atom <c>new</c> means that the default trace state for - processes to be created is returned.</p> + <p>Returns trace information about a port, process or function.</p> + <p>To get information about a port or process, + <c><anno>PidPortOrFunc</anno></c> is to + be a process identifier (pid), port identifier or one of + the atoms <c>new</c>, <c>new_processes</c>, <c>new_ports</c>. + The atom <c>new</c> or <c>new_processes</c> means that the default trace + state for processes to be created is returned. The atom <c>new_ports</c> + means that the default trace state for ports to be created is returned. + </p> <p>The following <c>Item</c>s are valid:</p> <taglist> <tag><c>flags</c></tag> @@ -8474,19 +9052,22 @@ timestamp() -> traces are enabled, and one or more of the followings atoms if traces are enabled: <c>send</c>, <c>'receive'</c>, <c>set_on_spawn</c>, <c>call</c>, - <c>return_to</c>, <c>procs</c>, <c>set_on_first_spawn</c>, - <c>set_on_link</c>, <c>running</c>, + <c>return_to</c>, <c>procs</c>, <c>ports</c>, <c>set_on_first_spawn</c>, + <c>set_on_link</c>, <c>running</c>, <c>running_procs</c>, + <c>running_ports</c>, <c>silent</c>, <c>exiting</c> + <c>monotonic_timestamp</c>, <c>strict_monotonic_timestamp</c>, <c>garbage_collection</c>, <c>timestamp</c>, and <c>arity</c>. The order is arbitrary.</p> </item> <tag><c>tracer</c></tag> <item> - <p>Returns the identifier for process or port tracing this + <p>Returns the identifier for process, port or a tuple containing + the tracer module and tracer state tracing this process. If this process is not being traced, the return value is <c>[]</c>.</p> </item> </taglist> - <p>To get information about a function, <c>PidOrFunc</c> is to + <p>To get information about a function, <c><anno>PidPortOrFunc</anno></c> is to be the three-element tuple <c>{Module, Function, Arity}</c> or the atom <c>on_load</c>. No wild cards are allowed. Returns <c>undefined</c> if the function does not exist, or @@ -8510,8 +9091,8 @@ timestamp() -> </item> <tag><c>meta</c></tag> <item> - <p>Returns the meta-trace tracer process or port for this - function, if it has one. If the function is not + <p>Returns the meta-trace tracer process, port or trace module + for this function, if it has one. If the function is not meta-traced, the returned value is <c>false</c>. If the function is meta-traced but has once detected that the tracer process is invalid, the returned value is [].</p> @@ -8554,7 +9135,7 @@ timestamp() -> <c>Value</c> is the requested information as described earlier. If a pid for a dead process was given, or the name of a non-existing function, <c>Value</c> is <c>undefined</c>.</p> - <p>If <c><anno>PidOrFunc</anno></c> is <c>on_load</c>, the information + <p>If <c><anno>PidPortOrFunc</anno></c> is <c>on_load</c>, the information returned refers to the default value for code that will be loaded.</p> </desc> @@ -8679,13 +9260,12 @@ timestamp() -> the process, a <c>return_to</c> message is also sent when this function returns to its caller.</p> </item> - <tag><c>meta | {meta, <anno>Pid</anno>}</c></tag> + <tag><c>meta | {meta, <anno>Pid</anno>} | {meta, <anno>TracerModule</anno>, <anno>TracerState</anno>}</c> + </tag> <item> <p>Turns on or off meta-tracing for all types of function - calls. Trace messages are sent to the tracer process - or port <c><anno>Pid</anno></c> whenever any of the specified - functions are called, regardless of how they are called. - If no <c><anno>Pid</anno></c> is specified, + calls. Trace messages are sent to the tracer whenever any of + the specified functions are called. If no tracer is specified, <c>self()</c> is used as a default tracer process.</p> <p>Meta-tracing traces all processes and does not care about the process trace flags set by <c>trace/3</c>, @@ -8693,7 +9273,7 @@ timestamp() -> <c>[call, timestamp]</c>.</p> <p>The match specification function <c>{return_trace}</c> works with meta-trace and sends its trace message to the - same tracer process.</p> + same tracer.</p> </item> <tag><c>call_count</c></tag> <item> diff --git a/erts/doc/src/erlc.xml b/erts/doc/src/erlc.xml index 9fc5864413..a64927fec2 100644 --- a/erts/doc/src/erlc.xml +++ b/erts/doc/src/erlc.xml @@ -4,7 +4,7 @@ <comref> <header> <copyright> - <year>1997</year><year>2013</year> + <year>1997</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/erlsrv.xml b/erts/doc/src/erlsrv.xml index ccb8b2dd76..fb00444aa4 100644 --- a/erts/doc/src/erlsrv.xml +++ b/erts/doc/src/erlsrv.xml @@ -4,7 +4,7 @@ <comref> <header> <copyright> - <year>1998</year><year>2013</year> + <year>1998</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml index 15b78ffa10..70775b9f0f 100644 --- a/erts/doc/src/erts_alloc.xml +++ b/erts/doc/src/erts_alloc.xml @@ -4,7 +4,7 @@ <cref> <header> <copyright> - <year>2002</year><year>2015</year> + <year>2002</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -52,6 +52,8 @@ <item>Allocator used for ETS data.</item> <tag><c>driver_alloc</c></tag> <item>Allocator used for driver data.</item> + <tag><c>literal_alloc</c></tag> + <item>Allocator used for constant terms in Erlang code.</item> <tag><c>sl_alloc</c></tag> <item>Allocator used for memory blocks that are expected to be short-lived.</item> @@ -61,6 +63,9 @@ <tag><c>fix_alloc</c></tag> <item>A fast allocator used for some frequently used fixed size data types.</item> + <tag><c>exec_alloc</c></tag> + <item>Allocator used by hipe for native executable code + on specific architectures (x86_64).</item> <tag><c>std_alloc</c></tag> <item>Allocator used for most memory blocks not allocated via any of the other allocators described above.</item> @@ -77,8 +82,9 @@ instead of creating new segments. This in order to reduce the number of system calls made.</item> </taglist> - <p><c>sys_alloc</c> is always enabled and - cannot be disabled. <c>mseg_alloc</c> is always enabled if it is + <p><c>sys_alloc</c> and <c>literal_alloc</c> are always enabled and + cannot be disabled. <c>exec_alloc</c> is only available if it is needed + and cannot be disabled. <c>mseg_alloc</c> is always enabled if it is available and an allocator that uses it is enabled. All other allocators can be <seealso marker="#M_e">enabled or disabled</seealso>. By default all allocators are enabled. @@ -250,11 +256,13 @@ <item><c>E: ets_alloc</c></item> <item><c>F: fix_alloc</c></item> <item><c>H: eheap_alloc</c></item> + <item><c>I: literal_alloc</c></item> <item><c>L: ll_alloc</c></item> <item><c>M: mseg_alloc</c></item> <item><c>R: driver_alloc</c></item> <item><c>S: sl_alloc</c></item> <item><c>T: temp_alloc</c></item> + <item><c>X: exec_alloc</c></item> <item><c>Y: sys_alloc</c></item> </list> <p>The following flags are available for configuration of @@ -563,6 +571,25 @@ set to <c>false</c>, <c>sys_alloc</c> carriers will never be created by allocators using the <c>alloc_util</c> framework.</item> </taglist> + <p>The following flag is special for <c>literal_alloc</c>:</p> + <taglist> + <tag><marker id="MIscs"/><c><![CDATA[+MIscs <size in MB>]]></c></tag> + <item> + <c>literal_alloc</c> super carrier size (in MB). The amount of + <em>virtual</em> address space reserved for literal terms in + Erlang code on 64-bit architectures. The default is 1024 (1GB) + and is usually sufficient. The flag is ignored on 32-bit + architectures.</item> + </taglist> + <p>The following flag is special for <c>exec_alloc</c>:</p> + <taglist> + <tag><marker id="MIscs"/><c><![CDATA[+MXscs <size in MB>]]></c></tag> + <item> + <c>exec_alloc</c> super carrier size (in MB). The amount of + <em>virtual</em> address space reserved for native executable code + used by hipe on specific architectures (x86_64). The default is 512 MB. + </item> + </taglist> <p>Instrumentation flags:</p> <taglist> <tag><marker id="Mim"/><c>+Mim true|false</c></tag> diff --git a/erts/doc/src/inet_cfg.xml b/erts/doc/src/inet_cfg.xml index 5caf232a62..027fe600d7 100644 --- a/erts/doc/src/inet_cfg.xml +++ b/erts/doc/src/inet_cfg.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2004</year><year>2013</year> + <year>2004</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/init.xml b/erts/doc/src/init.xml index fe26df61f7..84a5aea335 100644 --- a/erts/doc/src/init.xml +++ b/erts/doc/src/init.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -247,10 +247,7 @@ <c>Expr</c> during system initialization. If any of these steps fail (syntax error, parse error or exception during 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> - <p>This example uses Erlang as a hexadecimal calculator:</p> + example that uses Erlang as a hexadecimal calculator:</p> <pre> % <input>erl -noshell -eval 'R = 16#1F+16#A0, io:format("~.16B~n", [R])' \\</input> <input>-s erlang halt</input> diff --git a/erts/doc/src/match_spec.xml b/erts/doc/src/match_spec.xml index 08dad8cc10..3944f24f84 100644 --- a/erts/doc/src/match_spec.xml +++ b/erts/doc/src/match_spec.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1999</year><year>2013</year> + <year>1999</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -287,7 +287,7 @@ can <em>not</em> be one of the atoms <c><![CDATA[all]]></c>, <c><![CDATA[new]]></c> or <c><![CDATA[existing]]></c> (unless, of course, they are registered names). <c><![CDATA[P2]]></c> can <em>not</em> be <c><![CDATA[cpu_timestamp]]></c> nor - <c><![CDATA[{tracer,_}]]></c>. + <c><![CDATA[tracer]]></c>. Returns <c><![CDATA[true]]></c> and may only be used in the <c><![CDATA[MatchBody]]></c> part when tracing. </p> @@ -298,7 +298,7 @@ be either a process identifier or a registered name and is given as the first argument to the match_spec function. <c><![CDATA[P2]]></c> can <em>not</em> be <c><![CDATA[cpu_timestamp]]></c> nor - <c><![CDATA[{tracer,_}]]></c>. Returns + <c><![CDATA[tracer]]></c>. Returns <c><![CDATA[true]]></c> and may only be used in the <c><![CDATA[MatchBody]]></c> part when tracing. </p> @@ -308,11 +308,14 @@ disable list is applied first, but effectively all changes are applied atomically. The trace flags are the same as for <c><![CDATA[erlang:trace/3]]></c> not including - <c><![CDATA[cpu_timestamp]]></c> but including <c><![CDATA[{tracer,_}]]></c>. If a + <c><![CDATA[cpu_timestamp]]></c> but including <c><![CDATA[tracer]]></c>. If a tracer is specified in both lists, the tracer in the enable list takes precedence. If no tracer is specified the same tracer as the process executing the match spec is - used. With three parameters to this function the first is + used. When using a <seealso marker="erl_tracer">tracer module</seealso> + the module has to be loaded before the match specification is executed. + If it is not loaded the match will fail. + With three parameters to this function the first is either a process identifier or the registered name of a process to set trace flags on, the second is the disable list, and the third is the enable list. Returns @@ -525,7 +528,7 @@ </section> <section> - <title>Examples</title> + <title>ETS Examples</title> <p>Match an argument list of three where the first and third arguments are equal:</p> <code type="none"><![CDATA[ @@ -616,5 +619,44 @@ <p>The function <c><![CDATA[ets:test_ms/2]]></c> can be useful for testing complicated ets matches.</p> </section> + <section> + <title>Tracing Examples</title> + <p>Only generate trace message if trace control word is set to 1:</p> + <code type="none"><![CDATA[ +[{'_', + [{'==',{get_tcw},{const, 1}}], + []}] + ]]></code> + <p>Only generate trace message if there is a seq trace token:</p> + <code type="none"><![CDATA[ +[{'_', + [{'==',{is_seq_trace},{const, 1}}], + []}] + ]]></code> + <p>Remove 'silent' trace flag when first argument is 'verbose' + and add it when it is 'silent':</p> + <code type="none"><![CDATA[ +[{'$1', + [{'==',{hd, '$1'},verbose}], + [{trace, [silent],[]}]}, + {'$1', + [{'==',{hd, '$1'},silent}], + [{trace, [],[silent]}]}] + ]]></code> + <p>Add return_trace message if function is of arity 3:</p> + <code type="none"><![CDATA[ +[{'$1', + [{'==',{length, '$1'},3}], + [{return_trace}]}, + {'_',[],[]}] + ]]></code> + <p>Only generate trace message if function is of arity 3 and first argument is 'trace':</p> + <code type="none"><![CDATA[ +[{['trace','$2','$3'], + [], + []}, + {'_',[],[]}] + ]]></code> + </section> </chapter> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 7ccddf4ff0..7501ccd9ce 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2004</year><year>2015</year> + <year>2004</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/notes_history.xml b/erts/doc/src/notes_history.xml index 0886ae4039..0bc2ab1383 100644 --- a/erts/doc/src/notes_history.xml +++ b/erts/doc/src/notes_history.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2006</year><year>2013</year> + <year>2006</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/part.xml b/erts/doc/src/part.xml index 2f5eca93db..b2abfc62ca 100644 --- a/erts/doc/src/part.xml +++ b/erts/doc/src/part.xml @@ -4,7 +4,7 @@ <part xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/part_notes.xml b/erts/doc/src/part_notes.xml index 83bb479715..e579b7635d 100644 --- a/erts/doc/src/part_notes.xml +++ b/erts/doc/src/part_notes.xml @@ -4,7 +4,7 @@ <part xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>2004</year><year>2013</year> + <year>2004</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/part_notes_history.xml b/erts/doc/src/part_notes_history.xml index 055d1681d5..277683a2b5 100644 --- a/erts/doc/src/part_notes_history.xml +++ b/erts/doc/src/part_notes_history.xml @@ -4,7 +4,7 @@ <part xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>2006</year><year>2013</year> + <year>2006</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/ref_man.xml b/erts/doc/src/ref_man.xml index ac589f8cb5..e45402a397 100644 --- a/erts/doc/src/ref_man.xml +++ b/erts/doc/src/ref_man.xml @@ -4,7 +4,7 @@ <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -56,5 +56,6 @@ <xi:include href="driver_entry.xml"/> <xi:include href="erts_alloc.xml"/> <xi:include href="erl_nif.xml"/> + <xi:include href="erl_tracer.xml"/> </application> diff --git a/erts/doc/src/run_erl.xml b/erts/doc/src/run_erl.xml index 0a5b2c6136..6b0fef7c0a 100644 --- a/erts/doc/src/run_erl.xml +++ b/erts/doc/src/run_erl.xml @@ -4,7 +4,7 @@ <comref> <header> <copyright> - <year>1999</year><year>2013</year> + <year>1999</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -59,7 +59,7 @@ first argument to run_erl on the command line.</item> <tag>pipe_dir</tag> <item>This is where to put the named pipe, usually - <c><![CDATA[/tmp/]]></c> on Unix or <c><![CDATA[/pipe/]]></c> on OSE. It shall be suffixed by a <c><![CDATA[/]]></c> (slash), + <c><![CDATA[/tmp/]]></c>. It shall be suffixed by a <c><![CDATA[/]]></c> (slash), i.e. not <c><![CDATA[/tmp/epipies]]></c>, but <c><![CDATA[/tmp/epipes/]]></c>. </item> <tag>log_dir</tag> <item>This is where the log files are written. There will be one diff --git a/erts/doc/src/specs.xml b/erts/doc/src/specs.xml index 41a3984659..ed6be650e5 100644 --- a/erts/doc/src/specs.xml +++ b/erts/doc/src/specs.xml @@ -2,6 +2,7 @@ <specs xmlns:xi="http://www.w3.org/2001/XInclude"> <xi:include href="../specs/specs_erl_prim_loader.xml"/> <xi:include href="../specs/specs_erlang.xml"/> + <xi:include href="../specs/specs_erl_tracer.xml"/> <xi:include href="../specs/specs_init.xml"/> <xi:include href="../specs/specs_zlib.xml"/> </specs> diff --git a/erts/doc/src/start.xml b/erts/doc/src/start.xml index 386fbe6e88..adacf5b98d 100644 --- a/erts/doc/src/start.xml +++ b/erts/doc/src/start.xml @@ -4,7 +4,7 @@ <comref> <header> <copyright> - <year>1999</year><year>2013</year> + <year>1999</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/start_erl.xml b/erts/doc/src/start_erl.xml index 62610b43b0..243aeaa717 100644 --- a/erts/doc/src/start_erl.xml +++ b/erts/doc/src/start_erl.xml @@ -4,7 +4,7 @@ <comref> <header> <copyright> - <year>1998</year><year>2013</year> + <year>1998</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/tty.xml b/erts/doc/src/tty.xml index cd46d1203c..b2866c82cf 100644 --- a/erts/doc/src/tty.xml +++ b/erts/doc/src/tty.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/werl.xml b/erts/doc/src/werl.xml index 9e7ad584eb..1a3cb6f502 100644 --- a/erts/doc/src/werl.xml +++ b/erts/doc/src/werl.xml @@ -4,7 +4,7 @@ <comref> <header> <copyright> - <year>1998</year><year>2013</year> + <year>1998</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/zlib.xml b/erts/doc/src/zlib.xml index 0a641346d9..861661043f 100644 --- a/erts/doc/src/zlib.xml +++ b/erts/doc/src/zlib.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2005</year><year>2013</year> + <year>2005</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/erts/emulator/Makefile b/erts/emulator/Makefile index 550e6e6f5b..65fdbdb747 100644 --- a/erts/emulator/Makefile +++ b/erts/emulator/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index a919f0e3ac..fb486c917f 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2013. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -23,10 +23,6 @@ include ../vsn.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk -include $(TARGET)/gen_git_version.mk -ifeq ($(findstring ose,$(TARGET)),ose) -include $(ERL_TOP)/make/$(TARGET)/ose_lm.mk -endif - ENABLE_ALLOC_TYPE_VARS = @ENABLE_ALLOC_TYPE_VARS@ HIPE_ENABLED=@HIPE_ENABLED@ DTRACE_ENABLED=@DTRACE_ENABLED@ @@ -245,9 +241,7 @@ HCC = @HCC@ LD = @LD@ DEXPORT = @DEXPORT@ RANLIB = @RANLIB@ -ifneq ($(findstring ose,$(TARGET)),ose) STRIP = strip -endif PERL = @PERL@ RM = @RM@ MKDIR = @MKDIR@ @@ -323,7 +317,7 @@ else CS_CFLAGS = $(CS_CFLAGS_) endif CS_LDFLAGS = $(LDFLAGS) -CS_LIBS = -L../lib/internal/$(TARGET) -lerts_internal$(TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ +CS_LIBS = -L../lib/internal/$(TARGET) -lerts_internal$(TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ @SOCKET_LIBS@ LIBS += @TERMCAP_LIB@ -L../lib/internal/$(TARGET) @ERTS_INTERNAL_X_LIBS@ @@ -404,7 +398,7 @@ EMULATOR_EXECUTABLE = beam$(TF_MARKER).dll else EMULATOR_EXECUTABLE = beam$(TF_MARKER) endif -CS_EXECUTABLE = child_setup$(TYPEMARKER) +CS_EXECUTABLE = erl_child_setup$(TYPEMARKER) # ---------------------------------------------------------------------- @@ -583,7 +577,7 @@ GENERATE += $(TARGET)/erl_version.h # driver table $(TTF_DIR)/driver_tab.c: Makefile.in utils/make_driver_tab - $(gen_verbose)LANG=C $(PERL) utils/make_driver_tab -o $@ -nifs $(STATIC_NIF_LIBS) -drivers $(DRV_OBJS) $(STATIC_DRIVER_LIBS) + $(gen_verbose)LANG=C $(PERL) utils/make_driver_tab -o $@ -nifs $(NIF_OBJS) $(STATIC_NIF_LIBS) -drivers $(DRV_OBJS) $(STATIC_DRIVER_LIBS) GENERATE += $(TTF_DIR)/driver_tab.c @@ -597,6 +591,7 @@ ifeq ($(TARGET),win32) PRELOAD_OBJ = $(OBJDIR)/beams.$(RES_EXT) PRELOAD_SRC = $(TARGET)/beams.rc $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ + $(ERL_TOP)/erts/preloaded/ebin/erts_code_purger.beam \ $(ERL_TOP)/erts/preloaded/ebin/init.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \ @@ -605,12 +600,14 @@ $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_zip.beam \ $(ERL_TOP)/erts/preloaded/ebin/erl_prim_loader.beam \ $(ERL_TOP)/erts/preloaded/ebin/erlang.beam \ - $(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam + $(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam \ + $(ERL_TOP)/erts/preloaded/ebin/erl_tracer.beam $(gen_verbose)LANG=C $(PERL) utils/make_preload $(MAKE_PRELOAD_EXTRA) -rc $^ > $@ else PRELOAD_OBJ = $(OBJDIR)/preload.o PRELOAD_SRC = $(TARGET)/preload.c $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ + $(ERL_TOP)/erts/preloaded/ebin/erts_code_purger.beam \ $(ERL_TOP)/erts/preloaded/ebin/init.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \ @@ -619,7 +616,8 @@ $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_zip.beam \ $(ERL_TOP)/erts/preloaded/ebin/erl_prim_loader.beam \ $(ERL_TOP)/erts/preloaded/ebin/erlang.beam \ - $(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam + $(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam \ + $(ERL_TOP)/erts/preloaded/ebin/erl_tracer.beam $(gen_verbose)LANG=C $(PERL) utils/make_preload -old $^ > $@ endif @@ -684,14 +682,6 @@ $(OBJDIR)/%.o: $(TTF_DIR)/%.c $(OBJDIR)/%.o: sys/$(ERLANG_OSTYPE)/%.c $(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ -ifeq ($(findstring ose,$(TARGET)),ose) -$(OBJDIR)/ose_confd.o: $(OSE_CONFD) - $(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ - -$(OBJDIR)/crt0_lm.o: $(CRT0_LM) - $(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ -endif - $(OBJDIR)/%.o: sys/common/%.c $(V_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ @@ -701,14 +691,17 @@ $(OBJDIR)/%.o: drivers/common/%.c $(OBJDIR)/%.o: drivers/$(ERLANG_OSTYPE)/%.c $(V_CC) $(CFLAGS) $(INCLUDES) -Idrivers/common -Idrivers/$(ERLANG_OSTYPE) -I../etc/$(ERLANG_OSTYPE) -c $< -o $@ +$(OBJDIR)/%.o: nifs/common/%.c + $(V_CC) $(CFLAGS) -DLIBSCTP=$(LIBSCTP) $(INCLUDES) -Inifs/common -Inifs/$(ERLANG_OSTYPE) -c $< -o $@ + # ---------------------------------------------------------------------- # Specials # -CS_SRC = sys/$(ERLANG_OSTYPE)/erl_child_setup.c +CS_OBJ = $(OBJDIR)/erl_child_setup.o $(OBJDIR)/sys_uds.o $(OBJDIR)/hash.o -$(BINDIR)/$(CS_EXECUTABLE): $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(CS_SRC) $(ERTS_LIB) - $(ld_verbose)$(CS_PURIFY) $(CC) $(CS_LDFLAGS) -o $(BINDIR)/$(CS_EXECUTABLE) \ - $(CS_CFLAGS) $(COMMON_INCLUDES) $(CS_SRC) $(CS_LIBS) +$(BINDIR)/$(CS_EXECUTABLE): $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(CS_OBJ) $(ERTS_LIB) + $(ld_verbose)$(CS_PURIFY) $(LD) $(CS_LDFLAGS) -o $(BINDIR)/$(CS_EXECUTABLE) \ + $(CS_CFLAGS) $(COMMON_INCLUDES) $(CS_OBJ) $(CS_LIBS) $(OBJDIR)/%.kp.o: sys/common/%.c $(V_CC) -DERTS_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ @@ -787,7 +780,11 @@ RUN_OBJS = \ $(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o \ $(OBJDIR)/erl_bif_binary.o $(OBJDIR)/erl_ao_firstfit_alloc.o \ $(OBJDIR)/erl_thr_queue.o $(OBJDIR)/erl_sched_spec_pre_alloc.o \ - $(OBJDIR)/erl_ptab.o $(OBJDIR)/erl_map.o + $(OBJDIR)/erl_ptab.o $(OBJDIR)/erl_map.o \ + $(OBJDIR)/erl_msacc.o + +LTTNG_OBJS = $(OBJDIR)/erlang_lttng.o +NIF_OBJS = $(OBJDIR)/erl_tracer_nif.o ifeq ($(TARGET),win32) DRV_OBJS = \ @@ -810,31 +807,10 @@ OS_OBJS = \ $(OBJDIR)/dosmap.o else -ifeq ($(findstring ose,$(TARGET)),ose) -OS_OBJS = \ - $(OBJDIR)/sys.o \ - $(OBJDIR)/driver_tab.o \ - $(OBJDIR)/ose_efile.o \ - $(OBJDIR)/gzio.o \ - $(OBJDIR)/elib_memmove.o - -OS_OBJS += $(OBJDIR)/ose_confd.o \ - $(OBJDIR)/crt0_lm.o - -OS_OBJS += $(OBJDIR)/sys_float.o \ - $(OBJDIR)/sys_time.o - -DRV_OBJS = \ - $(OBJDIR)/efile_drv.o \ - $(OBJDIR)/ose_signal_drv.o \ - $(OBJDIR)/inet_drv.o \ - $(OBJDIR)/zlib_drv.o \ - $(OBJDIR)/ram_file_drv.o \ - $(OBJDIR)/ttsl_drv.o - -else OS_OBJS = \ $(OBJDIR)/sys.o \ + $(OBJDIR)/sys_drivers.o \ + $(OBJDIR)/sys_uds.o \ $(OBJDIR)/driver_tab.o \ $(OBJDIR)/unix_efile.o \ $(OBJDIR)/gzio.o \ @@ -849,7 +825,6 @@ DRV_OBJS = \ $(OBJDIR)/ram_file_drv.o \ $(OBJDIR)/ttsl_drv.o endif -endif ifneq ($(STATIC_NIFS),no) STATIC_NIF_LIBS = $(STATIC_NIFS) @@ -917,9 +892,9 @@ ifdef HIPE_ENABLED EXTRA_BASE_OBJS += $(HIPE_OBJS) endif -BASE_OBJS = $(EMU_OBJS) $(RUN_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) +BASE_OBJS = $(EMU_OBJS) $(RUN_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) $(LTTNG_OBJS) -before_DTrace_OBJS = $(BASE_OBJS) $(DRV_OBJS) +before_DTrace_OBJS = $(BASE_OBJS) $(DRV_OBJS) $(NIF_OBJS) DTRACE_OBJS = ifdef DTRACE_ENABLED_2STEP @@ -1022,19 +997,12 @@ $(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) $(STATIC_DRIVER_LIBS) $(LIBS) else -ifeq ($(findstring ose,$(TARGET)),ose) -$(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) $(LCF) - $(call build-ose-load-module, $@, $(INIT_OBJS) $(OBJS), $(STATIC_NIF_LIBS) \ - $(STATIC_DRIVER_LIBS) $(LIBS), $(BEAM_LMCONF)) - -else $(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) $(ld_verbose)$(PURIFY) $(LD) -o $(BINDIR)/$(EMULATOR_EXECUTABLE) \ $(HIPEBEAMLDFLAGS) $(LDFLAGS) $(DEXPORT) $(INIT_OBJS) $(OBJS) \ $(STATIC_NIF_LIBS) $(STATIC_DRIVER_LIBS) $(LIBS) endif -endif # ---------------------------------------------------------------------- # Dependencies @@ -1079,6 +1047,7 @@ endif BEAM_SRC=$(wildcard beam/*.c) DRV_COMMON_SRC=$(wildcard drivers/common/*.c) DRV_OSTYPE_SRC=$(wildcard drivers/$(ERLANG_OSTYPE)/*.c) +NIF_COMMON_SRC=$(wildcard nifs/common/*.c) ALL_SYS_SRC=$(wildcard sys/$(ERLANG_OSTYPE)/*.c) $(wildcard sys/common/*.c) # We use $(shell ls) here instead of wildcard as $(wildcard ) resolved at # loadtime of the makefile and at that time these files are not generated yet. @@ -1111,7 +1080,7 @@ MG_FLAG=-MG endif DEP_CC=$(CC) -DEP_FLAGS=-MM $(MG_FLAG) $(CFLAGS) $(INCLUDES) -Idrivers/common -Idrivers/$(ERLANG_OSTYPE) +DEP_FLAGS=-MM $(MG_FLAG) $(CFLAGS) $(INCLUDES) -Inifs/common -Idrivers/common -Idrivers/$(ERLANG_OSTYPE) SYS_SRC=$(ALL_SYS_SRC) endif @@ -1136,6 +1105,8 @@ $(TTF_DIR)/depend.mk: $(TTF_DIR)/GENERATED $(PRELOAD_SRC) | $(SED_DEPEND) >> $(TTF_DIR)/depend.mk $(V_at)$(DEP_CC) $(DEP_FLAGS) -I../etc/$(ERLANG_OSTYPE) $(DRV_OSTYPE_SRC) \ | $(SED_DEPEND) >> $(TTF_DIR)/depend.mk + $(V_at)$(DEP_CC) $(DEP_FLAGS) $(NIF_COMMON_SRC) \ + | $(SED_DEPEND) >> $(TTF_DIR)/depend.mk $(V_at)$(DEP_CC) $(DEP_FLAGS) $(SYS_SRC) \ | $(SED_DEPEND) >> $(TTF_DIR)/depend.mk $(V_at)$(DEP_CC) $(DEP_FLAGS) $(TARGET_SRC) \ diff --git a/erts/emulator/beam/atom.c b/erts/emulator/beam/atom.c index fe91134ef4..a5e778e4aa 100644 --- a/erts/emulator/beam/atom.c +++ b/erts/emulator/beam/atom.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -176,7 +176,7 @@ atom_alloc(Atom* tmpl) /* * Precompute ordinal value of first 3 bytes + 7 bits. - * This is used by utils.c:cmp_atoms(). + * This is used by utils.c:erts_cmp_atoms(). * We cannot use the full 32 bits of the first 4 bytes, * since we use the sign of the difference between two * ordinal values to represent their relative order. @@ -435,6 +435,9 @@ init_atom_table(void) f.cmp = (HCMP_FUN) atom_cmp; f.alloc = (HALLOC_FUN) atom_alloc; f.free = (HFREE_FUN) atom_free; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; atom_text_pos = NULL; atom_text_end = NULL; diff --git a/erts/emulator/beam/atom.h b/erts/emulator/beam/atom.h index ead56c83d8..fbd0528009 100644 --- a/erts/emulator/beam/atom.h +++ b/erts/emulator/beam/atom.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -129,6 +129,7 @@ typedef enum { (erts_is_atom_utf8_bytes((byte *) LSTR, sizeof(LSTR) - 1, (TERM))) #define ERTS_DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) #define ERTS_INIT_AM(S) AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) +#define ERTS_MAKE_AM(Str) am_atom_put(Str, sizeof(Str) - 1) int atom_table_size(void); /* number of elements */ int atom_table_sz(void); /* table size in bytes, excluding stored objects */ diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index cb6d294a41..3022c0a99a 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2013. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -43,7 +43,7 @@ atom false true atom Underscore='_' atom Noname='nonode@nohost' atom EOT='$end_of_table' -atom Cookie='' +atom Empty='' # # Used in the Beam emulator loop. (Smaller literals usually means tighter code.) @@ -102,6 +102,7 @@ atom asynchronous atom atom atom atom_used atom attributes +atom await_microstate_accounting_modifications atom await_port_send_result atom await_proc_exit atom await_result @@ -118,14 +119,15 @@ atom bif_timer_server atom binary atom binary_bin_to_list_trap atom binary_copy_trap +atom binary_find_trap atom binary_longest_prefix_trap atom binary_longest_suffix_trap -atom binary_match_trap -atom binary_matches_trap atom binary_to_list_continue atom binary_to_term_trap atom block +atom block_normal atom blocked +atom blocked_normal atom bm atom bnot atom bor @@ -159,6 +161,7 @@ atom close atom closed atom code atom command +atom commandv atom compact atom compat_rel atom compile @@ -173,6 +176,7 @@ atom const atom context_switches atom control atom copy +atom counters atom cpu atom cpu_timestamp atom cr @@ -189,9 +193,12 @@ atom dexit atom depth atom dgroup_leader atom dictionary +atom dirty_cpu atom dirty_cpu_schedulers_online +atom dirty_io atom disable_trace atom disabled +atom discard atom display_items atom dist atom dist_cmd @@ -210,7 +217,9 @@ atom dsend atom dsend_continue_trap atom dunlink atom duplicate_bag +atom duplicated atom dupnames +atom einval atom elib_malloc atom emulator atom enable_trace @@ -224,6 +233,7 @@ atom exception_trace atom extended atom Eq='=:=' atom Eqeq='==' +atom erl_tracer atom erlang atom ERROR='ERROR' atom error_handler @@ -236,6 +246,9 @@ atom exact_reductions atom exclusive atom exit_status atom existing +atom existing_processes +atom existing_ports +atom existing atom exiting atom exports atom external @@ -258,7 +271,12 @@ atom functions atom function_clause atom garbage_collecting atom garbage_collection +atom garbage_collection_info atom gc_end +atom gc_major_end +atom gc_major_start +atom gc_minor_end +atom gc_minor_start atom gc_start atom Ge='>=' atom generational @@ -268,6 +286,7 @@ atom get_tcw atom getenv atom gather_gc_info_result atom gather_io_bytes +atom gather_microstate_accounting_result atom gather_sched_wall_time_result atom gather_system_check_result atom getting_linked @@ -300,6 +319,7 @@ atom index atom infinity atom info atom info_msg +atom init atom initial_call atom input atom internal @@ -343,6 +363,7 @@ atom match atom match_limit atom match_limit_recursion atom match_spec +atom match_spec_result atom max atom maximum atom max_tables max_processes @@ -353,17 +374,20 @@ atom memory_internal atom memory_types atom message atom message_binary +atom message_queue_data atom message_queue_len atom messages atom merge_trap atom meta atom meta_match_spec atom micro_seconds +atom microstate_accounting atom milli_seconds atom min_heap_size atom min_bin_vheap_size atom minor_version atom Minus='-' +atom mixed atom module atom module_info atom monitored_by @@ -388,6 +412,8 @@ atom net_kernel_terminated atom never_utf atom new atom new_index +atom new_processes +atom new_ports atom new_uniq atom newline atom next @@ -427,10 +453,12 @@ atom notify atom notsup atom nouse_stdio atom objects +atom off_heap atom offset atom ok atom old_heap_block_size atom old_heap_size +atom on_heap atom on_load atom open atom open_error @@ -441,13 +469,6 @@ atom orelse atom os_pid atom os_type atom os_version -atom ose_bg_proc -atom ose_int_proc -atom ose_phantom -atom ose_pri_proc -atom ose_process_prio -atom ose_process_type -atom ose_ti_proc atom out atom out_exited atom out_exiting @@ -532,6 +553,7 @@ atom scheme atom scientific atom scope atom seconds +atom send_to_non_existing_process atom sensitive atom sequential_tracer atom sequential_trace_token @@ -553,6 +575,7 @@ atom size atom sl_alloc atom spawn_executable atom spawn_driver +atom spawned atom ssl_tls atom stack_size atom start @@ -561,6 +584,7 @@ atom static atom stderr_to_stdout atom stop atom stream +atom strict_monotonic atom strict_monotonic_timestamp atom sunrm atom suspend @@ -588,10 +612,13 @@ atom total_active_tasks atom total_heap_size atom total_run_queue_lengths atom tpkt -atom trace trace_ts traced +atom trace trace_ts traced atom trace_control_word +atom trace_status atom tracer atom trap_exit +atom trim +atom trim_all atom try_clause atom true atom tuple @@ -607,6 +634,7 @@ atom use_stdio atom used atom utf8 atom unblock +atom unblock_normal atom uniq atom unless_suspending atom unloaded diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 0e192b1ebd..87508dcf5f 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2013. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -38,9 +38,9 @@ #include "erl_thr_progress.h" static void set_default_trace_pattern(Eterm module); -static Eterm check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp); +static Eterm check_process_code(Process* rp, Module* modp, Uint flags, int *redsp); static void delete_code(Module* modp); -static void decrement_refc(BeamInstr* code); +static void decrement_refc(BeamCodeHeader*); 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); @@ -58,8 +58,8 @@ BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1) return am_undefined; } erts_rlock_old_code(code_ix); - res = (erts_is_module_native(modp->curr.code) || - erts_is_module_native(modp->old.code)) ? + res = (erts_is_module_native(modp->curr.code_hdr) || + erts_is_module_native(modp->old.code_hdr)) ? am_true : am_false; erts_runlock_old_code(code_ix); return res; @@ -81,12 +81,12 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3) modp = erts_get_module(BIF_ARG_1, erts_active_code_ix()); if (modp && modp->curr.num_breakpoints > 0) { - ASSERT(modp->curr.code != NULL); + ASSERT(modp->curr.code_hdr != NULL); erts_clear_module_break(modp); ASSERT(modp->curr.num_breakpoints == 0); } - erts_start_staging_code_ix(); + erts_start_staging_code_ix(1); res = erts_make_stub_module(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); @@ -139,6 +139,25 @@ prepare_loading_2(BIF_ALIST_2) BIF_RET(res); } +BIF_RETTYPE +has_prepared_code_on_load_1(BIF_ALIST_1) +{ + Eterm res; + ProcBin* pb; + + if (!ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_1)) { + error: + BIF_ERROR(BIF_P, BADARG); + } + + pb = (ProcBin*) binary_val(BIF_ARG_1); + res = erts_has_code_on_load(pb->val); + if (res == NIL) { + goto error; + } + BIF_RET(res); +} + struct m { Binary* code; Eterm module; @@ -154,7 +173,7 @@ static struct /* Protected by code_write_permission */ { Process* stager; ErtsThrPrgrLaterOp lop; -}commiter_state; +} committer_state; #endif static Eterm @@ -163,14 +182,13 @@ exception_list(Process* p, Eterm tag, struct m* mp, Sint exceptions) Eterm* hp = HAlloc(p, 3 + 2*exceptions); Eterm res = NIL; - mp += exceptions - 1; while (exceptions > 0) { if (mp->exception) { res = CONS(hp, mp->module, res); hp += 2; exceptions--; } - mp--; + mp++; } return TUPLE2(hp, tag, res); } @@ -179,8 +197,8 @@ exception_list(Process* p, Eterm tag, struct m* mp, Sint exceptions) BIF_RETTYPE finish_loading_1(BIF_ALIST_1) { - int i; - int n; + Sint i; + Sint n; struct m* p = NULL; Uint exceptions; Eterm res; @@ -201,9 +219,13 @@ finish_loading_1(BIF_ALIST_1) */ n = erts_list_length(BIF_ARG_1); - if (n == -1) { - ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); - goto done; + if (n < 0) { + badarg: + if (p) { + erts_free(ERTS_ALC_T_LOADER_TMP, p); + } + erts_release_code_write_permission(); + BIF_ERROR(BIF_P, BADARG); } p = erts_alloc(ERTS_ALC_T_LOADER_TMP, n*sizeof(struct m)); @@ -218,29 +240,32 @@ finish_loading_1(BIF_ALIST_1) ProcBin* pb; if (!ERTS_TERM_IS_MAGIC_BINARY(term)) { - ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); - goto done; + goto badarg; } pb = (ProcBin*) binary_val(term); p[i].code = pb->val; p[i].module = erts_module_for_prepared_code(p[i].code); if (p[i].module == NIL) { - ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); - goto done; + goto badarg; } BIF_ARG_1 = CDR(cons); } /* * Since we cannot handle atomic loading of a group of modules - * if one or more of them uses on_load, we will only allow one - * element in the list. This limitation is intended to be - * lifted in the future. + * if one or more of them uses on_load, we will only allow + * more than one element in the list if none of the modules + * have an on_load function. */ if (n > 1) { - ERTS_BIF_PREP_ERROR(res, BIF_P, SYSTEM_LIMIT); - goto done; + for (i = 0; i < n; i++) { + if (erts_has_code_on_load(p[i].code) == am_true) { + erts_free(ERTS_ALC_T_LOADER_TMP, p); + erts_release_code_write_permission(); + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + } + } } /* @@ -252,11 +277,27 @@ finish_loading_1(BIF_ALIST_1) */ res = am_ok; - erts_start_staging_code_ix(); + erts_start_staging_code_ix(n); for (i = 0; i < n; i++) { p[i].modp = erts_put_module(p[i].module); + p[i].modp->seen = 0; } + + exceptions = 0; + for (i = 0; i < n; i++) { + p[i].exception = 0; + if (p[i].modp->seen) { + p[i].exception = 1; + exceptions++; + } + p[i].modp->seen = 1; + } + if (exceptions) { + res = exception_list(BIF_P, am_duplicated, p, exceptions); + goto done; + } + for (i = 0; i < n; i++) { if (p[i].modp->curr.num_breakpoints > 0 || p[i].modp->curr.num_traced_exports > 0 || @@ -281,7 +322,7 @@ finish_loading_1(BIF_ALIST_1) exceptions = 0; for (i = 0; i < n; i++) { p[i].exception = 0; - if (p[i].modp->curr.code && p[i].modp->old.code) { + if (p[i].modp->curr.code_hdr && p[i].modp->old.code_hdr) { p[i].exception = 1; exceptions++; } @@ -367,9 +408,9 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking, * schedulers to read active code_ix in a safe way while executing * without any memory barriers at all. */ - ASSERT(commiter_state.stager == NULL); - commiter_state.stager = c_p; - erts_schedule_thr_prgr_later_op(smp_code_ix_commiter, NULL, &commiter_state.lop); + ASSERT(committer_state.stager == NULL); + committer_state.stager = c_p; + erts_schedule_thr_prgr_later_op(smp_code_ix_commiter, NULL, &committer_state.lop); erts_proc_inc_refc(c_p); erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); /* @@ -385,11 +426,11 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking, #ifdef ERTS_SMP static void smp_code_ix_commiter(void* null) { - Process* p = commiter_state.stager; + Process* p = committer_state.stager; erts_commit_staging_code_ix(); #ifdef DEBUG - commiter_state.stager = NULL; + committer_state.stager = NULL; #endif erts_release_code_write_permission(); erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); @@ -417,7 +458,7 @@ check_old_code_1(BIF_ALIST_1) modp = erts_get_module(BIF_ARG_1, code_ix); if (modp != NULL) { erts_rlock_old_code(code_ix); - if (modp->old.code != NULL) { + if (modp->old.code_hdr) { res = am_true; } erts_runlock_old_code(code_ix); @@ -426,7 +467,7 @@ check_old_code_1(BIF_ALIST_1) } Eterm -erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp) +erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp) { Module* modp; Eterm res; @@ -441,7 +482,8 @@ erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp) if (!modp) return am_false; erts_rlock_old_code(code_ix); - res = modp->old.code ? check_process_code(c_p, modp, allow_gc, redsp) : am_false; + res = (!modp->old.code_hdr ? am_false : + check_process_code(c_p, modp, flags, redsp)); erts_runlock_old_code(code_ix); return res; @@ -450,49 +492,21 @@ erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp) BIF_RETTYPE erts_internal_check_process_code_2(BIF_ALIST_2) { int reds = 0; + Uint flags; Eterm res; - Eterm olist = BIF_ARG_2; - int allow_gc = 1; if (is_not_atom(BIF_ARG_1)) goto badarg; - while (is_list(olist)) { - Eterm *lp = list_val(olist); - Eterm opt = CAR(lp); - if (is_tuple(opt)) { - Eterm* tp = tuple_val(opt); - switch (arityval(tp[0])) { - case 2: - switch (tp[1]) { - case am_allow_gc: - switch (tp[2]) { - case am_false: - allow_gc = 0; - break; - case am_true: - allow_gc = 1; - break; - default: - goto badarg; - } - break; - default: - goto badarg; - } - break; - default: - goto badarg; - } - } - else - goto badarg; - olist = CDR(lp); + if (is_not_small(BIF_ARG_2)) + goto badarg; + + flags = unsigned_val(BIF_ARG_2); + if (flags & ~ERTS_CPC_ALL) { + goto badarg; } - if (is_not_nil(olist)) - goto badarg; - res = erts_check_process_code(BIF_P, BIF_ARG_1, allow_gc, &reds); + res = erts_check_process_code(BIF_P, BIF_ARG_1, flags, &reds); ASSERT(is_value(res)); @@ -519,13 +533,13 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1) } { - erts_start_staging_code_ix(); + erts_start_staging_code_ix(0); code_ix = erts_staging_code_ix(); modp = erts_get_module(BIF_ARG_1, code_ix); if (!modp) { res = am_undefined; } - else if (modp->old.code != 0) { + else if (modp->old.code_hdr) { erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); erts_dsprintf(dsbufp, "Module %T must be purged before loading\n", BIF_ARG_1); @@ -563,8 +577,8 @@ BIF_RETTYPE module_loaded_1(BIF_ALIST_1) } code_ix = erts_active_code_ix(); if ((modp = erts_get_module(BIF_ARG_1, code_ix)) != NULL) { - if (modp->curr.code != NULL - && modp->curr.code[MI_ON_LOAD_FUNCTION_PTR] == 0) { + if (modp->curr.code_hdr + && modp->curr.code_hdr->on_load_function_ptr == NULL) { res = am_true; } } @@ -611,8 +625,8 @@ BIF_RETTYPE call_on_load_function_1(BIF_ALIST_1) { Module* modp = erts_get_module(BIF_ARG_1, erts_active_code_ix()); - if (modp && modp->curr.code) { - BIF_TRAP_CODE_PTR_0(BIF_P, modp->curr.code[MI_ON_LOAD_FUNCTION_PTR]); + if (modp && modp->curr.code_hdr) { + BIF_TRAP_CODE_PTR_0(BIF_P, modp->curr.code_hdr->on_load_function_ptr); } else { BIF_ERROR(BIF_P, BADARG); @@ -623,7 +637,6 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) { ErtsCodeIndex code_ix; Module* modp; - Eterm on_load; if (!erts_try_seize_code_write_permission(BIF_P)) { ERTS_BIF_YIELD2(bif_export[BIF_finish_after_on_load_2], @@ -638,14 +651,14 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) code_ix = erts_active_code_ix(); modp = erts_get_module(BIF_ARG_1, code_ix); - if (!modp || modp->curr.code == 0) { + if (!modp || !modp->curr.code_hdr) { error: erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_release_code_write_permission(); BIF_ERROR(BIF_P, BADARG); } - if ((on_load = modp->curr.code[MI_ON_LOAD_FUNCTION_PTR]) == 0) { + if (modp->curr.code_hdr->on_load_function_ptr == NULL) { goto error; } if (BIF_ARG_2 != am_false && BIF_ARG_2 != am_true) { @@ -667,7 +680,7 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) ep->code[4] = 0; } } - modp->curr.code[MI_ON_LOAD_FUNCTION_PTR] = 0; + modp->curr.code_hdr->on_load_function_ptr = NULL; set_default_trace_pattern(BIF_ARG_1); } else if (BIF_ARG_2 == am_false) { BeamInstr* code; @@ -679,13 +692,16 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) * the current code; the old code is not touched. */ erts_total_code_size -= modp->curr.code_length; - code = modp->curr.code; - end = (BeamInstr *)((char *)code + modp->curr.code_length); + code = (BeamInstr*) modp->curr.code_hdr; + end = (BeamInstr *) ((char *)code + modp->curr.code_length); erts_cleanup_funs_on_purge(code, end); beam_catches_delmod(modp->curr.catches, code, modp->curr.code_length, erts_active_code_ix()); - erts_free(ERTS_ALC_T_CODE, (void *) code); - modp->curr.code = NULL; + if (modp->curr.code_hdr->literals_start) { + erts_free(ERTS_ALC_T_LITERAL, modp->curr.code_hdr->literals_start); + } + erts_free(ERTS_ALC_T_CODE, modp->curr.code_hdr); + modp->curr.code_hdr = NULL; modp->curr.code_length = 0; modp->curr.catches = BEAM_CATCHES_NIL; erts_remove_from_ranges(code); @@ -703,13 +719,13 @@ set_default_trace_pattern(Eterm module) Binary *match_spec; Binary *meta_match_spec; struct trace_pattern_flags trace_pattern_flags; - Eterm meta_tracer_pid; + ErtsTracer meta_tracer; erts_get_default_trace_pattern(&trace_pattern_is_on, &match_spec, &meta_match_spec, &trace_pattern_flags, - &meta_tracer_pid); + &meta_tracer); if (trace_pattern_is_on) { Eterm mfa[1]; mfa[0] = module; @@ -717,35 +733,54 @@ set_default_trace_pattern(Eterm module) match_spec, meta_match_spec, 1, trace_pattern_flags, - meta_tracer_pid, 1); + meta_tracer, 1); } } +static ERTS_INLINE int +check_mod_funs(Process *p, ErlOffHeap *off_heap, char *area, size_t area_size) +{ + struct erl_off_heap_header* oh; + for (oh = off_heap->first; oh; oh = oh->next) { + if (thing_subtag(oh->thing_word) == FUN_SUBTAG) { + ErlFunThing* funp = (ErlFunThing*) oh; + if (ErtsInArea(funp->fe->address, area, area_size)) + return !0; + } + } + return 0; +} + + static Eterm -check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) +check_process_code(Process* rp, Module* modp, Uint flags, int *redsp) { BeamInstr* start; + char* literals; + Uint lit_bsize; char* mod_start; Uint mod_size; - BeamInstr* end; Eterm* sp; - struct erl_off_heap_header* oh; int done_gc = 0; + int need_gc = 0; + ErtsMessage *msgp; + ErlHeapFragment *hfrag; -#define INSIDE(a) (start <= (a) && (a) < end) +#define ERTS_ORDINARY_GC__ (1 << 0) +#define ERTS_LITERAL_GC__ (1 << 1) /* * Pick up limits for the module. */ - start = modp->old.code; - end = (BeamInstr *)((char *)start + modp->old.code_length); + start = (BeamInstr*) modp->old.code_hdr; mod_start = (char *) start; mod_size = modp->old.code_length; /* * Check if current instruction or continuation pointer points into module. */ - if (INSIDE(rp->i) || INSIDE(rp->cp)) { + if (ErtsInArea(rp->i, mod_start, mod_size) + || ErtsInArea(rp->cp, mod_start, mod_size)) { return am_true; } @@ -753,7 +788,7 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) * Check all continuation pointers stored on the stack. */ for (sp = rp->stop; sp < STACK_START(rp); sp++) { - if (is_CP(*sp) && INSIDE(cp_val(*sp))) { + if (is_CP(*sp) && ErtsInArea(cp_val(*sp), mod_start, mod_size)) { return am_true; } } @@ -767,15 +802,15 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) struct StackTrace *s; ASSERT(is_list(rp->ftrace)); s = (struct StackTrace *) big_val(CDR(list_val(rp->ftrace))); - if ((s->pc && INSIDE(s->pc)) || - (s->current && INSIDE(s->current))) { + if ((s->pc && ErtsInArea(s->pc, mod_start, mod_size)) || + (s->current && ErtsInArea(s->current, mod_start, mod_size))) { rp->freason = EXC_NULL; rp->fvalue = NIL; rp->ftrace = NIL; } else { int i; for (i = 0; i < s->depth; i++) { - if (INSIDE(s->trace[i])) { + if (ErtsInArea(s->trace[i], mod_start, mod_size)) { rp->freason = EXC_NULL; rp->fvalue = NIL; rp->ftrace = NIL; @@ -796,111 +831,147 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp) } /* - * See if there are funs that refer to the old version of the module. + * Message queue can contains funs, but (at least currently) no + * literals. If we got references to this module from the message + * queue, a GC cannot remove these... */ - rescan: - for (oh = MSO(rp).first; oh; oh = oh->next) { - if (thing_subtag(oh->thing_word) == FUN_SUBTAG) { - ErlFunThing* funp = (ErlFunThing*) oh; + erts_smp_proc_lock(rp, ERTS_PROC_LOCK_MSGQ); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ); - if (INSIDE((BeamInstr *) funp->fe->address)) { - if (done_gc) { - return am_true; - } else { - if (!allow_gc) - return am_aborted; - /* - * Try to get rid of this fun by garbage collecting. - * Clear both fvalue and ftrace to make sure they - * don't hold any funs. - */ - rp->freason = EXC_NULL; - rp->fvalue = NIL; - rp->ftrace = NIL; - done_gc = 1; - FLAGS(rp) |= F_NEED_FULLSWEEP; - *redsp += erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity); - goto rescan; - } - } + literals = (char*) modp->old.code_hdr->literals_start; + lit_bsize = (char*) modp->old.code_hdr->literals_end - literals; + + for (msgp = rp->msg.first; msgp; msgp = msgp->next) { + if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) + hfrag = &msgp->hfrag; + else if (is_value(ERL_MESSAGE_TERM(msgp)) && msgp->data.heap_frag) + hfrag = msgp->data.heap_frag; + else + continue; + for (; hfrag; hfrag = hfrag->next) { + if (check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)) + return am_true; + /* Should not contain any literals... */ + ASSERT(!any_heap_refs(&hfrag->mem[0], + &hfrag->mem[hfrag->used_size], + literals, + lit_bsize)); } } - /* - * See if there are constants inside the module referenced by the process. - */ - done_gc = 0; - for (;;) { - ErlMessage* mp; - - if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, mod_start, mod_size)) { + while (1) { + + /* Check heap, stack etc... */ + if (check_mod_funs(rp, &rp->off_heap, mod_start, mod_size)) + goto try_gc; + if (!(flags & ERTS_CPC_COPY_LITERALS)) { + /* Process ok. May contain old literals but we will be called + * again before module is purged. + */ + return am_false; + } + if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, literals, lit_bsize)) { rp->freason = EXC_NULL; rp->fvalue = NIL; rp->ftrace = NIL; } - if (any_heap_ref_ptrs(rp->stop, rp->hend, mod_start, mod_size)) { - goto need_gc; - } - if (any_heap_refs(rp->heap, rp->htop, mod_start, mod_size)) { - goto need_gc; - } - - if (any_heap_refs(rp->old_heap, rp->old_htop, mod_start, mod_size)) { - goto need_gc; + if (any_heap_ref_ptrs(rp->stop, rp->hend, literals, lit_bsize)) + goto try_literal_gc; + if (any_heap_refs(rp->heap, rp->htop, literals, lit_bsize)) + goto try_literal_gc; + if (any_heap_refs(rp->old_heap, rp->old_htop, literals, lit_bsize)) + goto try_literal_gc; + + /* Check dictionary */ + if (rp->dictionary) { + Eterm* start = ERTS_PD_START(rp->dictionary); + Eterm* end = start + ERTS_PD_SIZE(rp->dictionary); + + if (any_heap_ref_ptrs(start, end, literals, lit_bsize)) + goto try_literal_gc; } - if (rp->dictionary != NULL) { - Eterm* start = rp->dictionary->data; - Eterm* end = start + rp->dictionary->used; + /* Check heap fragments */ + for (hfrag = rp->mbuf; hfrag; hfrag = hfrag->next) { + Eterm *hp, *hp_end; + /* Off heap lists should already have been moved into process */ + ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)); - if (any_heap_ref_ptrs(start, end, mod_start, mod_size)) { - goto need_gc; - } + hp = &hfrag->mem[0]; + hp_end = &hfrag->mem[hfrag->used_size]; + if (any_heap_refs(hp, hp_end, literals, lit_bsize)) + goto try_literal_gc; } - for (mp = rp->msg.first; mp != NULL; mp = mp->next) { - if (any_heap_ref_ptrs(mp->m, mp->m+2, mod_start, mod_size)) { - goto need_gc; +#ifdef DEBUG + /* + * Message buffer fragments should not have any references + * to literals, and off heap lists should already have + * been moved into process off heap structure. + */ + for (msgp = rp->msg_frag; msgp; msgp = msgp->next) { + if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) + hfrag = &msgp->hfrag; + else + hfrag = msgp->data.heap_frag; + for (; hfrag; hfrag = hfrag->next) { + Eterm *hp, *hp_end; + ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)); + + hp = &hfrag->mem[0]; + hp_end = &hfrag->mem[hfrag->used_size]; + ASSERT(!any_heap_refs(hp, hp_end, literals, lit_bsize)); } } - break; - need_gc: - if (done_gc) { +#endif + + return am_false; + + try_literal_gc: + need_gc |= ERTS_LITERAL_GC__; + + try_gc: + need_gc |= ERTS_ORDINARY_GC__; + + if ((done_gc & need_gc) == need_gc) return am_true; - } else { - Eterm* literals; - Uint lit_size; - struct erl_off_heap_header* oh; - if (!allow_gc) - return am_aborted; + if (!(flags & ERTS_CPC_ALLOW_GC)) + return am_aborted; - /* - * Try to get rid of constants by by garbage collecting. - * Clear both fvalue and ftrace. - */ - rp->freason = EXC_NULL; - rp->fvalue = NIL; - rp->ftrace = NIL; - done_gc = 1; + need_gc &= ~done_gc; + + /* + * Try to get rid of literals by by garbage collecting. + * Clear both fvalue and ftrace. + */ + + rp->freason = EXC_NULL; + rp->fvalue = NIL; + rp->ftrace = NIL; + + if (need_gc & ERTS_ORDINARY_GC__) { FLAGS(rp) |= F_NEED_FULLSWEEP; - *redsp += erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity); - literals = (Eterm *) modp->old.code[MI_LITERALS_START]; - lit_size = (Eterm *) modp->old.code[MI_LITERALS_END] - literals; - oh = (struct erl_off_heap_header *) - modp->old.code[MI_LITERALS_OFF_HEAP]; - *redsp += lit_size / 10; /* Need, better value... */ - erts_garbage_collect_literals(rp, literals, lit_size, oh); + *redsp += erts_garbage_collect_nobump(rp, 0, rp->arg_reg, rp->arity); + done_gc |= ERTS_ORDINARY_GC__; + } + if (need_gc & ERTS_LITERAL_GC__) { + struct erl_off_heap_header* oh; + oh = modp->old.code_hdr->literals_off_heap; + *redsp += lit_bsize / 64; /* Need, better value... */ + erts_garbage_collect_literals(rp, (Eterm*)literals, lit_bsize, oh); + done_gc |= ERTS_LITERAL_GC__; } + need_gc = 0; } - return am_false; -#undef INSIDE -} -#define in_area(ptr,start,nbytes) \ - ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes)) +#undef ERTS_ORDINARY_GC__ +#undef ERTS_LITERAL_GC__ + +} static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) @@ -913,7 +984,7 @@ any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) switch (primary_tag(val)) { case TAG_PRIMARY_BOXED: case TAG_PRIMARY_LIST: - if (in_area(EXPAND_POINTER(val), mod_start, mod_size)) { + if (ErtsInArea(val, mod_start, mod_size)) { return 1; } break; @@ -933,7 +1004,7 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) switch (primary_tag(val)) { case TAG_PRIMARY_BOXED: case TAG_PRIMARY_LIST: - if (in_area(EXPAND_POINTER(val), mod_start, mod_size)) { + if (ErtsInArea(val, mod_start, mod_size)) { return 1; } break; @@ -943,7 +1014,7 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) if (header_is_bin_matchstate(val)) { ErlBinMatchState *ms = (ErlBinMatchState*) p; ErlBinMatchBuffer *mb = &(ms->mb); - if (in_area(EXPAND_POINTER(mb->orig), mod_start, mod_size)) { + if (ErtsInArea(mb->orig, mod_start, mod_size)) { return 1; } } @@ -958,7 +1029,104 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) #undef in_area -BIF_RETTYPE purge_module_1(BIF_ALIST_1) +#ifdef ERTS_SMP +static void copy_literals_commit(void*); +#endif + +copy_literals_t erts_clrange = {NULL, 0, THE_NON_VALUE}; + +/* copy literals + * + * copy_literals.ptr = LitPtr + * copy_literals.sz = LitSz + * ------ THR PROG COMMIT ----- + * + * - check process code + * - check process code + * ... + * copy_literals.ptr = NULL + * copy_literals.sz = 0 + * ------ THR PROG COMMIT ----- + * ... + */ + + +BIF_RETTYPE erts_internal_copy_literals_2(BIF_ALIST_2) +{ + ErtsCodeIndex code_ix; + Eterm res = am_true; + + if (is_not_atom(BIF_ARG_1) || (am_true != BIF_ARG_2 && am_false != BIF_ARG_2)) { + BIF_ERROR(BIF_P, BADARG); + } + + if (!erts_try_seize_code_write_permission(BIF_P)) { + ERTS_BIF_YIELD2(bif_export[BIF_erts_internal_copy_literals_2], + BIF_P, BIF_ARG_1, BIF_ARG_2); + } + + code_ix = erts_active_code_ix(); + + if (BIF_ARG_2 == am_true) { + Module* modp = erts_get_module(BIF_ARG_1, code_ix); + if (!modp || !modp->old.code_hdr) { + res = am_false; + goto done; + } + if (erts_clrange.ptr != NULL + && !(BIF_P->static_flags & ERTS_STC_FLG_SYSTEM_PROC)) { + res = am_aborted; + goto done; + } + erts_clrange.ptr = modp->old.code_hdr->literals_start; + erts_clrange.sz = modp->old.code_hdr->literals_end - erts_clrange.ptr; + erts_clrange.pid = BIF_P->common.id; + } else if (BIF_ARG_2 == am_false) { + if (erts_clrange.pid != BIF_P->common.id) { + res = am_false; + goto done; + } + erts_clrange.ptr = NULL; + erts_clrange.sz = 0; + erts_clrange.pid = THE_NON_VALUE; + } + +#ifdef ERTS_SMP + ASSERT(committer_state.stager == NULL); + committer_state.stager = BIF_P; + erts_schedule_thr_prgr_later_op(copy_literals_commit, NULL, &committer_state.lop); + erts_proc_inc_refc(BIF_P); + erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL); + ERTS_BIF_YIELD_RETURN(BIF_P, am_true); +#endif +done: + erts_release_code_write_permission(); + BIF_RET(res); +} + +#ifdef ERTS_SMP +static void copy_literals_commit(void* null) { + Process* p = committer_state.stager; +#ifdef DEBUG + committer_state.stager = NULL; +#endif + erts_release_code_write_permission(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + if (!ERTS_PROC_IS_EXITING(p)) { + erts_resume(p, ERTS_PROC_LOCK_STATUS); + } + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + erts_proc_dec_refc(p); +} +#endif /* ERTS_SMP */ + + +/* Do the actualy module purging and return: + * true for success + * false if no such old module + * BADARG if not an atom + */ +BIF_RETTYPE erts_internal_purge_module_1(BIF_ALIST_1) { ErtsCodeIndex code_ix; BeamInstr* code; @@ -972,7 +1140,8 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1) } if (!erts_try_seize_code_write_permission(BIF_P)) { - ERTS_BIF_YIELD1(bif_export[BIF_purge_module_1], BIF_P, BIF_ARG_1); + ERTS_BIF_YIELD1(bif_export[BIF_erts_internal_purge_module_1], + BIF_P, BIF_ARG_1); } code_ix = erts_active_code_ix(); @@ -982,7 +1151,7 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1) */ if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL) { - ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + ERTS_BIF_PREP_RET(ret, am_false); } else { erts_rwlock_old_code(code_ix); @@ -990,8 +1159,8 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1) /* * Any code to purge? */ - if (modp->old.code == 0) { - ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + if (!modp->old.code_hdr) { + ERTS_BIF_PREP_RET(ret, am_false); } else { /* @@ -1013,14 +1182,17 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1) */ ASSERT(erts_total_code_size >= modp->old.code_length); erts_total_code_size -= modp->old.code_length; - code = modp->old.code; + code = (BeamInstr*) modp->old.code_hdr; end = (BeamInstr *)((char *)code + modp->old.code_length); erts_cleanup_funs_on_purge(code, end); beam_catches_delmod(modp->old.catches, code, modp->old.code_length, code_ix); - decrement_refc(code); + decrement_refc(modp->old.code_hdr); + if (modp->old.code_hdr->literals_start) { + erts_free(ERTS_ALC_T_LITERAL, modp->old.code_hdr->literals_start); + } erts_free(ERTS_ALC_T_CODE, (void *) code); - modp->old.code = NULL; + modp->old.code_hdr = NULL; modp->old.code_length = 0; modp->old.catches = BEAM_CATCHES_NIL; erts_remove_from_ranges(code); @@ -1037,10 +1209,9 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1) } static void -decrement_refc(BeamInstr* code) +decrement_refc(BeamCodeHeader* code_hdr) { - struct erl_off_heap_header* oh = - (struct erl_off_heap_header *) code[MI_LITERALS_OFF_HEAP]; + struct erl_off_heap_header* oh = code_hdr->literals_off_heap; while (oh) { Binary* bptr; @@ -1089,10 +1260,11 @@ delete_code(Module* modp) ASSERT(modp->curr.num_breakpoints == 0); ASSERT(modp->curr.num_traced_exports == 0); modp->old = modp->curr; - modp->curr.code = NULL; + modp->curr.code_hdr = NULL; modp->curr.code_length = 0; modp->curr.catches = BEAM_CATCHES_NIL; modp->curr.nif = NULL; + } @@ -1106,9 +1278,9 @@ beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module) * if not, delete old code; error if old code already exists. */ - if (modp->curr.code != NULL && modp->old.code != NULL) { + if (modp->curr.code_hdr && modp->old.code_hdr) { return am_not_purged; - } else if (modp->old.code == NULL) { /* Make the current version old. */ + } else if (!modp->old.code_hdr) { /* Make the current version old. */ delete_code(modp); } return NIL; diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 9860968687..2ee98ed7b5 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2013. All Rights Reserved. + * Copyright Ericsson AB 2000-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -92,15 +92,15 @@ get_mtime(Process *c_p) /* ** Helpers */ -static Eterm do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, - int local, Binary* ms, Eterm tracer_pid); +static ErtsTracer do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, + int local, Binary* ms, ErtsTracer tracer); static void set_break(BpFunctions* f, Binary *match_spec, Uint break_flags, - enum erts_break_op count_op, Eterm tracer_pid); + enum erts_break_op count_op, ErtsTracer tracer); static void set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags, enum erts_break_op count_op, - Eterm tracer_pid); + ErtsTracer tracer); static void clear_break(BpFunctions* f, Uint break_flags); static int clear_function_break(BeamInstr *pc, Uint break_flags); @@ -108,7 +108,7 @@ static int clear_function_break(BeamInstr *pc, Uint break_flags); static BpDataTime* get_time_break(BeamInstr *pc); static GenericBpData* check_break(BeamInstr *pc, Uint break_flags); -static void bp_meta_unref(BpMetaPid* bmp); +static void bp_meta_unref(BpMetaTracer* bmt); static void bp_count_unref(BpCount* bcp); static void bp_time_unref(BpDataTime* bdt); static void consolidate_bp_data(Module* modp, BeamInstr* pc, int local); @@ -154,8 +154,8 @@ erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified) num_modules = 0; for (current = 0; current < max_modules; current++) { modp = module_code(current, code_ix); - if (modp->curr.code) { - max_funcs += modp->curr.code[MI_NUM_FUNCTIONS]; + if (modp->curr.code_hdr) { + max_funcs += modp->curr.code_hdr->num_functions; module[num_modules++] = modp; } } @@ -163,9 +163,9 @@ erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified) f->matching = (BpFunction *) Alloc(max_funcs*sizeof(BpFunction)); i = 0; for (current = 0; current < num_modules; current++) { - BeamInstr** code_base = (BeamInstr **) module[current]->curr.code; + BeamCodeHeader* code_hdr = module[current]->curr.code_hdr; BeamInstr* code; - Uint num_functions = (Uint)(UWord) code_base[MI_NUM_FUNCTIONS]; + Uint num_functions = (Uint)(UWord) code_hdr->num_functions; Uint fi; if (specified > 0) { @@ -179,7 +179,7 @@ erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified) BeamInstr* pc; int wi; - code = code_base[MI_FUNCTIONS+fi]; + code = code_hdr->functions[fi]; ASSERT(code[0] == (BeamInstr) BeamOp(op_i_func_info_IaaI)); pc = code+5; if (erts_is_native_break(pc)) { @@ -302,7 +302,7 @@ consolidate_bp_data(Module* modp, BeamInstr* pc, int local) MatchSetUnref(dst->local_ms); } if (flags & ERTS_BPF_META_TRACE) { - bp_meta_unref(dst->meta_pid); + bp_meta_unref(dst->meta_tracer); MatchSetUnref(dst->meta_ms); } if (flags & ERTS_BPF_COUNT) { @@ -343,8 +343,8 @@ consolidate_bp_data(Module* modp, BeamInstr* pc, int local) MatchSetRef(dst->local_ms); } if (flags & ERTS_BPF_META_TRACE) { - dst->meta_pid = src->meta_pid; - erts_refc_inc(&dst->meta_pid->refc, 1); + dst->meta_tracer = src->meta_tracer; + erts_refc_inc(&dst->meta_tracer->refc, 1); dst->meta_ms = src->meta_ms; MatchSetRef(dst->meta_ms); } @@ -436,13 +436,13 @@ uninstall_breakpoint(BeamInstr* pc) void erts_set_trace_break(BpFunctions* f, Binary *match_spec) { - set_break(f, match_spec, ERTS_BPF_LOCAL_TRACE, 0, am_true); + set_break(f, match_spec, ERTS_BPF_LOCAL_TRACE, 0, erts_tracer_true); } void -erts_set_mtrace_break(BpFunctions* f, Binary *match_spec, Eterm tracer_pid) +erts_set_mtrace_break(BpFunctions* f, Binary *match_spec, ErtsTracer tracer) { - set_break(f, match_spec, ERTS_BPF_META_TRACE, 0, tracer_pid); + set_break(f, match_spec, ERTS_BPF_META_TRACE, 0, tracer); } void @@ -450,13 +450,13 @@ erts_set_call_trace_bif(BeamInstr *pc, Binary *match_spec, int local) { Uint flags = local ? ERTS_BPF_LOCAL_TRACE : ERTS_BPF_GLOBAL_TRACE; - set_function_break(pc, match_spec, flags, 0, NIL); + set_function_break(pc, match_spec, flags, 0, erts_tracer_nil); } void -erts_set_mtrace_bif(BeamInstr *pc, Binary *match_spec, Eterm tracer_pid) +erts_set_mtrace_bif(BeamInstr *pc, Binary *match_spec, ErtsTracer tracer) { - set_function_break(pc, match_spec, ERTS_BPF_META_TRACE, 0, tracer_pid); + set_function_break(pc, match_spec, ERTS_BPF_META_TRACE, 0, tracer); } void @@ -464,7 +464,7 @@ erts_set_time_trace_bif(BeamInstr *pc, enum erts_break_op count_op) { set_function_break(pc, NULL, ERTS_BPF_TIME_TRACE|ERTS_BPF_TIME_TRACE_ACTIVE, - count_op, NIL); + count_op, erts_tracer_nil); } void @@ -474,21 +474,21 @@ erts_clear_time_trace_bif(BeamInstr *pc) { void erts_set_debug_break(BpFunctions* f) { - set_break(f, NULL, ERTS_BPF_DEBUG, 0, NIL); + set_break(f, NULL, ERTS_BPF_DEBUG, 0, erts_tracer_nil); } void erts_set_count_break(BpFunctions* f, enum erts_break_op count_op) { set_break(f, 0, ERTS_BPF_COUNT|ERTS_BPF_COUNT_ACTIVE, - count_op, NIL); + count_op, erts_tracer_nil); } void erts_set_time_break(BpFunctions* f, enum erts_break_op count_op) { set_break(f, 0, ERTS_BPF_TIME_TRACE|ERTS_BPF_TIME_TRACE_ACTIVE, - count_op, NIL); + count_op, erts_tracer_nil); } void @@ -549,21 +549,21 @@ erts_clear_all_breaks(BpFunctions* f) int erts_clear_module_break(Module *modp) { - BeamInstr** code_base; + BeamCodeHeader* code_hdr; Uint n; Uint i; ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); ASSERT(modp); - code_base = (BeamInstr **) modp->curr.code; - if (code_base == NULL) { + code_hdr = modp->curr.code_hdr; + if (!code_hdr) { return 0; } - n = (Uint)(UWord) code_base[MI_NUM_FUNCTIONS]; + n = (Uint)(UWord) code_hdr->num_functions; for (i = 0; i < n; ++i) { BeamInstr* pc; - pc = code_base[MI_FUNCTIONS+i] + 5; + pc = code_hdr->functions[i] + 5; if (erts_is_native_break(pc)) { continue; } @@ -575,7 +575,7 @@ erts_clear_module_break(Module *modp) { for (i = 0; i < n; ++i) { BeamInstr* pc; - pc = code_base[MI_FUNCTIONS+i] + 5; + pc = code_hdr->functions[i] + 5; if (erts_is_native_break(pc)) { continue; } @@ -625,19 +625,26 @@ erts_generic_breakpoint(Process* c_p, BeamInstr* I, Eterm* reg) if (bp_flags & ERTS_BPF_LOCAL_TRACE) { ASSERT((bp_flags & ERTS_BPF_GLOBAL_TRACE) == 0); - (void) do_call_trace(c_p, I, reg, 1, bp->local_ms, am_true); + (void) do_call_trace(c_p, I, reg, 1, bp->local_ms, erts_tracer_true); } else if (bp_flags & ERTS_BPF_GLOBAL_TRACE) { - (void) do_call_trace(c_p, I, reg, 0, bp->local_ms, am_true); + (void) do_call_trace(c_p, I, reg, 0, bp->local_ms, erts_tracer_true); } if (bp_flags & ERTS_BPF_META_TRACE) { - Eterm old_pid; - Eterm new_pid; - - old_pid = (Eterm) erts_smp_atomic_read_nob(&bp->meta_pid->pid); - new_pid = do_call_trace(c_p, I, reg, 1, bp->meta_ms, old_pid); - if (new_pid != old_pid) { - erts_smp_atomic_set_nob(&bp->meta_pid->pid, new_pid); + ErtsTracer old_tracer, new_tracer; + + old_tracer = erts_smp_atomic_read_nob(&bp->meta_tracer->tracer); + + new_tracer = do_call_trace(c_p, I, reg, 1, bp->meta_ms, old_tracer); + if (!ERTS_TRACER_COMPARE(new_tracer, old_tracer)) { + if (old_tracer == erts_smp_atomic_cmpxchg_acqb( + &bp->meta_tracer->tracer, + (erts_aint_t)new_tracer, + (erts_aint_t)old_tracer)) { + ERTS_TRACER_CLEAR(&old_tracer); + } else { + ERTS_TRACER_CLEAR(&new_tracer); + } } } @@ -645,7 +652,8 @@ erts_generic_breakpoint(Process* c_p, BeamInstr* I, Eterm* reg) erts_smp_atomic_inc_nob(&bp->count->acount); } - if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE && erts_is_tracer_proc_valid(c_p)) { + if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE + && ERTS_TRACER_PROC_IS_ENABLED(c_p)) { Eterm w; erts_trace_time_call(c_p, I, bp->time); w = (BeamInstr) *c_p->cp; @@ -690,7 +698,7 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) Eterm (*func)(Process*, Eterm*, BeamInstr*); Export* ep = bif_export[bif_index]; Uint32 flags = 0, flags_meta = 0; - Eterm meta_tracer_pid = NIL; + ErtsTracer meta_tracer = erts_tracer_nil; int applying = (I == &(ep->code[3])); /* Yup, the apply code for a bif * is actually in the * export entry */ @@ -718,23 +726,32 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) IS_TRACED_FL(p, F_TRACE_CALLS)) { int local = !!(bp_flags & ERTS_BPF_LOCAL_TRACE); flags = erts_call_trace(p, ep->code, bp->local_ms, args, - local, &ERTS_TRACER_PROC(p)); + local, &ERTS_TRACER(p)); } if (bp_flags & ERTS_BPF_META_TRACE) { - Eterm tpid1, tpid2; + ErtsTracer old_tracer; - tpid1 = tpid2 = - (Eterm) erts_smp_atomic_read_nob(&bp->meta_pid->pid); + meta_tracer = erts_smp_atomic_read_nob(&bp->meta_tracer->tracer); + old_tracer = meta_tracer; flags_meta = erts_call_trace(p, ep->code, bp->meta_ms, args, - 0, &tpid2); - meta_tracer_pid = tpid2; - if (tpid1 != tpid2) { - erts_smp_atomic_set_nob(&bp->meta_pid->pid, tpid2); + 0, &meta_tracer); + + if (!ERTS_TRACER_COMPARE(old_tracer, meta_tracer)) { + ErtsTracer new_tracer = erts_tracer_nil; + erts_tracer_update(&new_tracer, meta_tracer); + if (old_tracer == erts_smp_atomic_cmpxchg_acqb( + &bp->meta_tracer->tracer, + (erts_aint_t)new_tracer, + (erts_aint_t)old_tracer)) { + ERTS_TRACER_CLEAR(&old_tracer); + } else { + ERTS_TRACER_CLEAR(&new_tracer); + } } } if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE && IS_TRACED_FL(p, F_TRACE_CALLS) && - erts_is_tracer_proc_valid(p)) { + ERTS_TRACER_PROC_IS_ENABLED(p)) { BeamInstr *pc = (BeamInstr *)ep->code+3; erts_trace_time_call(p, pc, bp->time); } @@ -778,8 +795,6 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) if (reason != TRAP) { Eterm class; Eterm value = p->fvalue; - DeclareTmpHeapNoproc(nocatch,3); - UseTmpHeapNoproc(3); /* Expand error value like in handle_error() */ if (reason & EXF_ARGLIST) { Eterm *tp; @@ -788,7 +803,8 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) value = tp[1]; } if ((reason & EXF_THROWN) && (p->catches <= 0)) { - value = TUPLE2(nocatch, am_nocatch, value); + Eterm *hp = HAlloc(p, 3); + value = TUPLE2(hp, am_nocatch, value); reason = EXC_ERROR; } /* Note: expand_error_value() could theoretically @@ -801,11 +817,11 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) if (flags_meta & MATCH_SET_EXCEPTION_TRACE) { erts_trace_exception(p, ep->code, class, value, - &meta_tracer_pid); + &meta_tracer); } if (flags & MATCH_SET_EXCEPTION_TRACE) { erts_trace_exception(p, ep->code, class, value, - &ERTS_TRACER_PROC(p)); + &ERTS_TRACER(p)); } if ((flags & MATCH_SET_RETURN_TO_TRACE) && p->catches > 0) { /* can only happen if(local)*/ @@ -827,7 +843,6 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) } } } - UnUseTmpHeapNoproc(3); if ((flags_meta|flags) & MATCH_SET_EXCEPTION_TRACE) { erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); ERTS_TRACE_FLAGS(p) |= F_EXCEPTION_TRACE; @@ -836,11 +851,11 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) } } else { if (flags_meta & MATCH_SET_RX_TRACE) { - erts_trace_return(p, ep->code, result, &meta_tracer_pid); + erts_trace_return(p, ep->code, result, &meta_tracer); } /* MATCH_SET_RETURN_TO_TRACE cannot occur if(meta) */ if (flags & MATCH_SET_RX_TRACE) { - erts_trace_return(p, ep->code, result, &ERTS_TRACER_PROC(p)); + erts_trace_return(p, ep->code, result, &ERTS_TRACER(p)); } if (flags & MATCH_SET_RETURN_TO_TRACE) { /* can only happen if(local)*/ @@ -857,14 +872,14 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) return result; } -static Eterm +static ErtsTracer do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, - int local, Binary* ms, Eterm tracer_pid) + int local, Binary* ms, ErtsTracer tracer) { Eterm* cpp; int return_to_trace = 0; BeamInstr w; - BeamInstr *cp_save; + BeamInstr *cp_save = c_p->cp; Uint32 flags; Uint need = 0; Eterm* E = c_p->stop; @@ -899,7 +914,7 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, ASSERT(is_CP(*cpp)); } ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); - flags = erts_call_trace(c_p, I-3, ms, reg, local, &tracer_pid); + flags = erts_call_trace(c_p, I-3, ms, reg, local, &tracer); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); if (cpp) { c_p->cp = cp_save; @@ -910,7 +925,7 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, need += 1; } if (flags & MATCH_SET_RX_TRACE) { - need += 3; + need += 3 + size_object(tracer); } if (need) { ASSERT(c_p->htop <= E && E <= c_p->hend); @@ -926,14 +941,15 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, E[0] = make_cp(c_p->cp); c_p->cp = beam_return_to_trace; } - if (flags & MATCH_SET_RX_TRACE) { + if (flags & MATCH_SET_RX_TRACE) + { E -= 3; + c_p->stop = E; ASSERT(c_p->htop <= E && E <= c_p->hend); ASSERT(is_CP((Eterm) (UWord) (I - 3))); - ASSERT(am_true == tracer_pid || - is_internal_pid(tracer_pid) || is_internal_port(tracer_pid)); + ASSERT(IS_TRACER_VALID(tracer)); E[2] = make_cp(c_p->cp); - E[1] = tracer_pid; + E[1] = copy_object(tracer, c_p); E[0] = make_cp(I - 3); /* We ARE at the beginning of an instruction, the funcinfo is above i. */ @@ -942,9 +958,9 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); ERTS_TRACE_FLAGS(c_p) |= F_EXCEPTION_TRACE; erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); - } - c_p->stop = E; - return tracer_pid; + } else + c_p->stop = E; + return tracer; } void @@ -974,7 +990,7 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt) if (pbt == 0) { /* First call of process to instrumented function */ pbt = Alloc(sizeof(process_breakpoint_time_t)); - (void) ERTS_PROC_SET_CALL_TIME(c_p, ERTS_PROC_LOCK_MAIN, pbt); + (void) ERTS_PROC_SET_CALL_TIME(c_p, pbt); } else { ASSERT(pbt->pc); /* add time to previous code */ @@ -1098,9 +1114,9 @@ erts_is_trace_break(BeamInstr *pc, Binary **match_spec_ret, int local) return 0; } -int +int erts_is_mtrace_break(BeamInstr *pc, Binary **match_spec_ret, - Eterm *tracer_pid_ret) + ErtsTracer *tracer_ret) { GenericBpData* bp = check_break(pc, ERTS_BPF_META_TRACE); @@ -1108,9 +1124,8 @@ erts_is_mtrace_break(BeamInstr *pc, Binary **match_spec_ret, if (match_spec_ret) { *match_spec_ret = bp->meta_ms; } - if (tracer_pid_ret) { - *tracer_pid_ret = - (Eterm) erts_smp_atomic_read_nob(&bp->meta_pid->pid); + if (tracer_ret) { + *tracer_ret = erts_smp_atomic_read_nob(&bp->meta_tracer->tracer); } return 1; } @@ -1205,17 +1220,17 @@ int erts_is_time_break(Process *p, BeamInstr *pc, Eterm *retval) { BeamInstr * erts_find_local_func(Eterm mfa[3]) { Module *modp; - BeamInstr** code_base; + BeamCodeHeader* code_hdr; BeamInstr* code_ptr; Uint i,n; if ((modp = erts_get_module(mfa[0], erts_active_code_ix())) == NULL) return NULL; - if ((code_base = (BeamInstr **) modp->curr.code) == NULL) + if ((code_hdr = modp->curr.code_hdr) == NULL) return NULL; - n = (BeamInstr) code_base[MI_NUM_FUNCTIONS]; + n = (BeamInstr) code_hdr->num_functions; for (i = 0; i < n; ++i) { - code_ptr = code_base[MI_FUNCTIONS+i]; + code_ptr = code_hdr->functions[i]; ASSERT(((BeamInstr) BeamOp(op_i_func_info_IaaI)) == code_ptr[0]); ASSERT(mfa[0] == ((Eterm) code_ptr[2]) || is_nil((Eterm) code_ptr[2])); @@ -1391,7 +1406,7 @@ void erts_schedule_time_break(Process *p, Uint schedule) { static void set_break(BpFunctions* f, Binary *match_spec, Uint break_flags, - enum erts_break_op count_op, Eterm tracer_pid) + enum erts_break_op count_op, ErtsTracer tracer) { Uint i; Uint n; @@ -1400,13 +1415,13 @@ set_break(BpFunctions* f, Binary *match_spec, Uint break_flags, for (i = 0; i < n; i++) { BeamInstr* pc = f->matching[i].pc; set_function_break(pc, match_spec, break_flags, - count_op, tracer_pid); + count_op, tracer); } } static void set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags, - enum erts_break_op count_op, Eterm tracer_pid) + enum erts_break_op count_op, ErtsTracer tracer) { GenericBp* g; GenericBpData* bp; @@ -1439,7 +1454,7 @@ set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags, MatchSetUnref(bp->local_ms); } else if (common & ERTS_BPF_META_TRACE) { MatchSetUnref(bp->meta_ms); - bp_meta_unref(bp->meta_pid); + bp_meta_unref(bp->meta_tracer); } else if (common & ERTS_BPF_COUNT) { if (count_op == erts_break_stop) { bp->flags &= ~ERTS_BPF_COUNT_ACTIVE; @@ -1474,13 +1489,15 @@ set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags, MatchSetRef(match_spec); bp->local_ms = match_spec; } else if (break_flags & ERTS_BPF_META_TRACE) { - BpMetaPid* bmp; + BpMetaTracer* bmt; + ErtsTracer meta_tracer = erts_tracer_nil; MatchSetRef(match_spec); bp->meta_ms = match_spec; - bmp = Alloc(sizeof(BpMetaPid)); - erts_refc_init(&bmp->refc, 1); - erts_smp_atomic_init_nob(&bmp->pid, tracer_pid); - bp->meta_pid = bmp; + bmt = Alloc(sizeof(BpMetaTracer)); + erts_refc_init(&bmt->refc, 1); + erts_tracer_update(&meta_tracer, tracer); /* copy tracer */ + erts_smp_atomic_init_nob(&bmt->tracer, (erts_aint_t)meta_tracer); + bp->meta_tracer = bmt; } else if (break_flags & ERTS_BPF_COUNT) { BpCount* bcp; @@ -1544,7 +1561,7 @@ clear_function_break(BeamInstr *pc, Uint break_flags) } if (common & ERTS_BPF_META_TRACE) { MatchSetUnref(bp->meta_ms); - bp_meta_unref(bp->meta_pid); + bp_meta_unref(bp->meta_tracer); } if (common & ERTS_BPF_COUNT) { ASSERT((bp->flags & ERTS_BPF_COUNT_ACTIVE) == 0); @@ -1560,10 +1577,12 @@ clear_function_break(BeamInstr *pc, Uint break_flags) } static void -bp_meta_unref(BpMetaPid* bmp) +bp_meta_unref(BpMetaTracer* bmt) { - if (erts_refc_dectest(&bmp->refc, 0) <= 0) { - Free(bmp); + if (erts_refc_dectest(&bmt->refc, 0) <= 0) { + ErtsTracer trc = erts_smp_atomic_read_nob(&bmt->tracer); + ERTS_TRACER_CLEAR(&trc); + Free(bmt); } } @@ -1598,9 +1617,7 @@ bp_time_unref(BpDataTime* bdt) h_p = erts_pid2proc(NULL, 0, item->pid, ERTS_PROC_LOCK_MAIN); if (h_p) { - pbt = ERTS_PROC_SET_CALL_TIME(h_p, - ERTS_PROC_LOCK_MAIN, - NULL); + pbt = ERTS_PROC_SET_CALL_TIME(h_p, NULL); if (pbt) { Free(pbt); } diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h index 2b89d6fc71..08641b86d6 100644 --- a/erts/emulator/beam/beam_bp.h +++ b/erts/emulator/beam/beam_bp.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2013. All Rights Reserved. + * Copyright Ericsson AB 2000-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -55,15 +55,15 @@ typedef struct { } BpCount; typedef struct { - erts_smp_atomic_t pid; + erts_smp_atomic_t tracer; erts_refc_t refc; -} BpMetaPid; +} BpMetaTracer; typedef struct generic_bp_data { Uint flags; Binary* local_ms; /* Match spec for local call trace */ Binary* meta_ms; /* Match spec for meta trace */ - BpMetaPid* meta_pid; /* Meta trace pid */ + BpMetaTracer* meta_tracer; /* Meta tracer */ BpCount* count; /* For call count */ BpDataTime* time; /* For time trace */ } GenericBpData; @@ -132,10 +132,10 @@ void erts_set_call_trace_bif(BeamInstr *pc, Binary *match_spec, int local); void erts_clear_call_trace_bif(BeamInstr *pc, int local); void erts_set_mtrace_break(BpFunctions *f, Binary *match_spec, - Eterm tracer_pid); + ErtsTracer tracer); void erts_clear_mtrace_break(BpFunctions *f); void erts_set_mtrace_bif(BeamInstr *pc, Binary *match_spec, - Eterm tracer_pid); + ErtsTracer tracer); void erts_clear_mtrace_bif(BeamInstr *pc); void erts_set_debug_break(BpFunctions *f); @@ -150,13 +150,13 @@ void erts_clear_export_break(Module *modp, BeamInstr* pc); BeamInstr erts_generic_breakpoint(Process* c_p, BeamInstr* I, Eterm* reg); BeamInstr erts_trace_break(Process *p, BeamInstr *pc, Eterm *args, - Uint32 *ret_flags, Eterm *tracer_pid); + Uint32 *ret_flags, ErtsTracer *tracer); int erts_is_trace_break(BeamInstr *pc, Binary **match_spec_ret, int local); int erts_is_mtrace_break(BeamInstr *pc, Binary **match_spec_ret, - Eterm *tracer_pid_rte); + ErtsTracer *tracer_ret); int erts_is_mtrace_bif(BeamInstr *pc, Binary **match_spec_ret, - Eterm *tracer_pid_ret); + ErtsTracer *tracer_ret); int erts_is_native_break(BeamInstr *pc); int erts_is_count_break(BeamInstr *pc, Uint *count_ret); int erts_is_time_break(Process *p, BeamInstr *pc, Eterm *call_time); @@ -173,19 +173,7 @@ void erts_clear_time_trace_bif(BeamInstr *pc); BeamInstr *erts_find_local_func(Eterm mfa[3]); -ERTS_GLB_INLINE Uint erts_bp_sched2ix(void); - #if ERTS_GLB_INLINE_INCL_FUNC_DEF -ERTS_GLB_INLINE Uint erts_bp_sched2ix(void) -{ -#ifdef ERTS_SMP - ErtsSchedulerData *esdp; - esdp = erts_get_scheduler_data(); - return esdp->no - 1; -#else - return 0; -#endif -} extern erts_smp_atomic32_t erts_active_bp_index; extern erts_smp_atomic32_t erts_staging_bp_index; diff --git a/erts/emulator/beam/beam_catches.c b/erts/emulator/beam/beam_catches.c index 7a1f4901aa..cd592c7e5e 100644 --- a/erts/emulator/beam/beam_catches.c +++ b/erts/emulator/beam/beam_catches.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2013. All Rights Reserved. + * Copyright Ericsson AB 2000-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/beam_catches.h b/erts/emulator/beam/beam_catches.h index 59ee64d033..8eb2165ac9 100644 --- a/erts/emulator/beam/beam_catches.h +++ b/erts/emulator/beam/beam_catches.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2013. All Rights Reserved. + * Copyright Ericsson AB 2000-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 90985e4f53..a4ad3e7886 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2013. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -73,6 +73,40 @@ erts_debug_flat_size_1(BIF_ALIST_1) } } +BIF_RETTYPE +erts_debug_size_shared_1(BIF_ALIST_1) +{ + Process* p = BIF_P; + Eterm term = BIF_ARG_1; + Uint size = size_shared(term); + + if (IS_USMALL(0, size)) { + BIF_RET(make_small(size)); + } else { + Eterm* hp = HAlloc(p, BIG_UINT_HEAP_SIZE); + BIF_RET(uint_to_big(size, hp)); + } +} + +BIF_RETTYPE +erts_debug_copy_shared_1(BIF_ALIST_1) +{ + Process* p = BIF_P; + Eterm term = BIF_ARG_1; + Uint size; + Eterm* hp; + Eterm copy; + erts_shcopy_t info; + INITIALIZE_SHCOPY(info); + + size = copy_shared_calculate(term, &info); + if (size > 0) { + hp = HAlloc(p, size); + } + copy = copy_shared_perform(term, size, &info, &hp, &p->off_heap); + DESTROY_SHCOPY(info); + BIF_RET(copy); +} BIF_RETTYPE erts_debug_breakpoint_2(BIF_ALIST_2) @@ -208,7 +242,7 @@ erts_debug_disassemble_1(BIF_ALIST_1) Eterm bin; Eterm mfa; BeamInstr* funcinfo = NULL; /* Initialized to eliminate warning. */ - BeamInstr* code_base; + BeamCodeHeader* code_hdr; BeamInstr* code_ptr = NULL; /* Initialized to eliminate warning. */ BeamInstr instr; BeamInstr uaddr; @@ -258,12 +292,12 @@ erts_debug_disassemble_1(BIF_ALIST_1) */ code_ptr = ((BeamInstr *) ep->addressv[code_ix]) - 5; funcinfo = code_ptr+2; - } else if (modp == NULL || (code_base = modp->curr.code) == NULL) { + } else if (modp == NULL || (code_hdr = modp->curr.code_hdr) == NULL) { BIF_RET(am_undef); } else { - n = code_base[MI_NUM_FUNCTIONS]; + n = code_hdr->num_functions; for (i = 0; i < n; i++) { - code_ptr = (BeamInstr *) code_base[MI_FUNCTIONS+i]; + code_ptr = code_hdr->functions[i]; if (code_ptr[3] == name && code_ptr[4] == arity) { funcinfo = code_ptr+2; break; @@ -397,7 +431,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) packed >>= 10; break; case '0': /* Tight shift */ - *ap++ = packed & (BEAM_TIGHT_MASK / sizeof(Eterm)); + *ap++ = packed & BEAM_TIGHT_MASK; packed >>= BEAM_TIGHT_SHIFT; break; case '6': /* Shift 16 steps */ @@ -432,39 +466,33 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) while (*sign) { switch (*sign) { case 'r': /* x(0) */ - erts_print(to, to_arg, "x(0)"); + erts_print(to, to_arg, "r(0)"); break; case 'x': /* x(N) */ - if (reg_index(ap[0]) == 0) { - erts_print(to, to_arg, "x[0]"); - } else { - erts_print(to, to_arg, "x(%d)", reg_index(ap[0])); + { + Uint n = ap[0] / sizeof(Eterm); + erts_print(to, to_arg, "x(%d)", n); + ap++; } - ap++; break; case 'y': /* y(N) */ - erts_print(to, to_arg, "y(%d)", reg_index(ap[0]) - CP_SIZE); - ap++; + { + Uint n = ap[0] / sizeof(Eterm) - CP_SIZE; + erts_print(to, to_arg, "y(%d)", n); + ap++; + } break; case 'n': /* Nil */ erts_print(to, to_arg, "[]"); break; case 's': /* Any source (tagged constant or register) */ - tag = beam_reg_tag(*ap); - if (tag == X_REG_DEF) { - if (reg_index(*ap) == 0) { - erts_print(to, to_arg, "x[0]"); - } else { - erts_print(to, to_arg, "x(%d)", reg_index(*ap)); - } - ap++; - break; - } else if (tag == Y_REG_DEF) { - erts_print(to, to_arg, "y(%d)", reg_index(*ap) - CP_SIZE); + tag = loader_tag(*ap); + if (tag == LOADER_X_REG) { + erts_print(to, to_arg, "x(%d)", loader_x_reg_index(*ap)); ap++; break; - } else if (tag == R_REG_DEF) { - erts_print(to, to_arg, "x(0)"); + } else if (tag == LOADER_Y_REG) { + erts_print(to, to_arg, "y(%d)", loader_y_reg_index(*ap) - CP_SIZE); ap++; break; } @@ -481,20 +509,12 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) ap++; break; case 'd': /* Destination (x(0), x(N), y(N)) */ - switch (beam_reg_tag(*ap)) { - case X_REG_DEF: - if (reg_index(*ap) == 0) { - erts_print(to, to_arg, "x[0]"); - } else { - erts_print(to, to_arg, "x(%d)", reg_index(*ap)); - } - break; - case Y_REG_DEF: - erts_print(to, to_arg, "y(%d)", reg_index(*ap) - CP_SIZE); - break; - case R_REG_DEF: - erts_print(to, to_arg, "x(0)"); - break; + if (*ap & 1) { + erts_print(to, to_arg, "y(%d)", + *ap / sizeof(Eterm) - CP_SIZE); + } else { + erts_print(to, to_arg, "x(%d)", + *ap / sizeof(Eterm)); } ap++; break; @@ -561,7 +581,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) ap++; break; case 'l': /* fr(N) */ - erts_print(to, to_arg, "fr(%d)", reg_index(ap[0])); + erts_print(to, to_arg, "fr(%d)", loader_reg_index(ap[0])); ap++; break; default: @@ -580,7 +600,6 @@ 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_lins_rfI: case op_i_select_val_lins_xfI: case op_i_select_val_lins_yfI: { @@ -600,7 +619,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) } } break; - case op_i_select_val_bins_rfI: case op_i_select_val_bins_xfI: case op_i_select_val_bins_yfI: { @@ -614,7 +632,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) } } break; - case op_i_select_tuple_arity_rfI: case op_i_select_tuple_arity_xfI: case op_i_select_tuple_arity_yfI: { @@ -639,7 +656,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) } } break; - case op_i_jump_on_val_rfII: case op_i_jump_on_val_xfII: case op_i_jump_on_val_yfII: { @@ -651,7 +667,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) } } break; - case op_i_jump_on_val_zero_rfI: case op_i_jump_on_val_zero_xfI: case op_i_jump_on_val_zero_yfI: { @@ -663,7 +678,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) } } break; - case op_i_put_tuple_rI: case op_i_put_tuple_xI: case op_i_put_tuple_yI: case op_new_map_dII: @@ -673,20 +687,16 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) int n = unpacked[-1]; while (n > 0) { - if (!is_header(ap[0])) { + switch (loader_tag(ap[0])) { + case LOADER_X_REG: + erts_print(to, to_arg, " x(%d)", loader_x_reg_index(ap[0])); + break; + case LOADER_Y_REG: + erts_print(to, to_arg, " x(%d)", loader_y_reg_index(ap[0])); + break; + default: erts_print(to, to_arg, " %T", (Eterm) ap[0]); - } else { - switch ((ap[0] >> 2) & 0x03) { - case R_REG_DEF: - erts_print(to, to_arg, " x(0)"); - break; - case X_REG_DEF: - erts_print(to, to_arg, " x(%d)", ap[0] >> 4); - break; - case Y_REG_DEF: - erts_print(to, to_arg, " y(%d)", ap[0] >> 4); - break; - } + break; } ap++, size++, n--; } @@ -699,18 +709,16 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) while (n > 0) { if (n % 3 == 1) { erts_print(to, to_arg, " %X", ap[0]); - } else if (!is_header(ap[0])) { - erts_print(to, to_arg, " %T", (Eterm) ap[0]); } else { - switch ((ap[0] >> 2) & 0x03) { - case R_REG_DEF: - erts_print(to, to_arg, " x(0)"); + switch (loader_tag(ap[0])) { + case LOADER_X_REG: + erts_print(to, to_arg, " x(%d)", loader_x_reg_index(ap[0])); break; - case X_REG_DEF: - erts_print(to, to_arg, " x(%d)", ap[0] >> 4); + case LOADER_Y_REG: + erts_print(to, to_arg, " y(%d)", loader_y_reg_index(ap[0])); break; - case Y_REG_DEF: - erts_print(to, to_arg, " y(%d)", ap[0] >> 4); + default: + erts_print(to, to_arg, " %T", (Eterm) ap[0]); break; } } diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 1fe4cc9374..72526bca5e 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -99,10 +99,7 @@ do { \ do { \ int i_; \ int Arity_ = PC[-1]; \ - if (Arity_ > 0) { \ - CHECK_TERM(r(0)); \ - } \ - for (i_ = 1; i_ < Arity_; i_++) { \ + for (i_ = 0; i_ < Arity_; i_++) { \ CHECK_TERM(x(i_)); \ } \ } while (0) @@ -116,6 +113,9 @@ do { \ #define MAX(x, y) (((x) > (y)) ? (x) : (y)) #endif +#define GET_BIF_MODULE(p) ((Eterm) (((Export *) p)->code[0])) +#define GET_BIF_FUNCTION(p) ((Eterm) (((Export *) p)->code[1])) +#define GET_BIF_ARITY(p) ((Eterm) (((Export *) p)->code[2])) #define GET_BIF_ADDRESS(p) ((BifFunction) (((Export *) p)->code[4])) #define TermWords(t) (((t) / (sizeof(BeamInstr)/sizeof(Eterm))) + !!((t) % (sizeof(BeamInstr)/sizeof(Eterm)))) @@ -151,25 +151,21 @@ do { \ ASSERT(VALID_INSTR(* (Eterm *)(ip))); \ I = (ip) -#define FetchArgs(S1, S2) tmp_arg1 = (S1); tmp_arg2 = (S2) +/* + * Register target (X or Y register). + */ +#define REG_TARGET(Target) (*(((Target) & 1) ? &yb(Target-1) : &xb(Target))) /* * Store a result into a register given a destination descriptor. */ -#define StoreResult(Result, DestDesc) \ - do { \ - Eterm stb_reg; \ - stb_reg = (DestDesc); \ - CHECK_TERM(Result); \ - switch (beam_reg_tag(stb_reg)) { \ - case R_REG_DEF: \ - r(0) = (Result); break; \ - case X_REG_DEF: \ - xb(x_reg_offset(stb_reg)) = (Result); break; \ - default: \ - yb(y_reg_offset(stb_reg)) = (Result); break; \ - } \ +#define StoreResult(Result, DestDesc) \ + do { \ + Eterm stb_reg; \ + stb_reg = (DestDesc); \ + CHECK_TERM(Result); \ + REG_TARGET(stb_reg) = (Result); \ } while (0) #define StoreSimpleDest(Src, Dest) Dest = (Src) @@ -180,22 +176,16 @@ do { \ * be just before the next instruction. */ -#define StoreBifResult(Dst, Result) \ - do { \ - BeamInstr* stb_next; \ - Eterm stb_reg; \ - stb_reg = Arg(Dst); \ - I += (Dst) + 2; \ - stb_next = (BeamInstr *) *I; \ - CHECK_TERM(Result); \ - switch (beam_reg_tag(stb_reg)) { \ - case R_REG_DEF: \ - r(0) = (Result); Goto(stb_next); \ - case X_REG_DEF: \ - xb(x_reg_offset(stb_reg)) = (Result); Goto(stb_next); \ - default: \ - yb(y_reg_offset(stb_reg)) = (Result); Goto(stb_next); \ - } \ +#define StoreBifResult(Dst, Result) \ + do { \ + BeamInstr* stb_next; \ + Eterm stb_reg; \ + stb_reg = Arg(Dst); \ + I += (Dst) + 2; \ + stb_next = (BeamInstr *) *I; \ + CHECK_TERM(Result); \ + REG_TARGET(stb_reg) = (Result); \ + Goto(stb_next); \ } while (0) #define ClauseFail() goto jump_f @@ -250,6 +240,14 @@ void** beam_ops; HEAP_TOP(c_p) = HTOP; \ c_p->stop = E +#define HEAVY_SWAPIN \ + SWAPIN; \ + FCALLS = c_p->fcalls + +#define HEAVY_SWAPOUT \ + SWAPOUT; \ + c_p->fcalls = FCALLS + /* * Use LIGHT_SWAPOUT when the called function * will call HeapOnlyAlloc() (and never HAlloc()). @@ -293,7 +291,7 @@ void** beam_ops; #define Ib(N) (N) #define x(N) reg[N] #define y(N) E[N] -#define r(N) x##N +#define r(N) x(N) /* * Makes sure that there are StackNeed + HeapNeed + 1 words available @@ -309,12 +307,10 @@ void** beam_ops; needed = (StackNeed) + 1; \ if (E - HTOP < (needed + (HeapNeed))) { \ SWAPOUT; \ - reg[0] = r(0); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect(c_p, needed + (HeapNeed), reg, (M)); \ + FCALLS -= erts_garbage_collect_nobump(c_p, needed + (HeapNeed), reg, (M)); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - r(0) = reg[0]; \ SWAPIN; \ } \ E -= needed; \ @@ -363,12 +359,10 @@ void** beam_ops; unsigned need = (Nh); \ if ((E - HTOP < need) || (MSO(c_p).overhead + (VNh) >= BIN_VHEAP_SZ(c_p))) {\ SWAPOUT; \ - reg[0] = r(0); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \ + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - r(0) = reg[0]; \ SWAPIN; \ } \ HEAP_SPACE_VERIFIED(need); \ @@ -386,12 +380,10 @@ void** beam_ops; unsigned need = (Nh); \ if (E - HTOP < need) { \ SWAPOUT; \ - reg[0] = r(0); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \ + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live));\ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - r(0) = reg[0]; \ SWAPIN; \ } \ HEAP_SPACE_VERIFIED(need); \ @@ -408,15 +400,11 @@ void** beam_ops; unsigned need = (Nh); \ if (E - HTOP < need) { \ SWAPOUT; \ - reg[0] = r(0); \ reg[Live] = Extra; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)+1); \ + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)+1); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - if (Live > 0) { \ - r(0) = reg[0]; \ - } \ Extra = reg[Live]; \ SWAPIN; \ } \ @@ -438,10 +426,9 @@ void** beam_ops; #define MakeFun(FunP, NumFree) \ do { \ - SWAPOUT; \ - reg[0] = r(0); \ + HEAVY_SWAPOUT; \ r(0) = new_fun(c_p, reg, (ErlFunEntry *) FunP, NumFree); \ - SWAPIN; \ + HEAVY_SWAPIN; \ } while (0) #define PutTuple(Dst, Arity) \ @@ -531,15 +518,19 @@ void** beam_ops; ASSERT(VALID_INSTR(Dst)); \ Goto(Dst) -#define GetR(pos, tr) \ - do { \ - tr = Arg(pos); \ - switch (beam_reg_tag(tr)) { \ - case R_REG_DEF: tr = r(0); break; \ - case X_REG_DEF: tr = xb(x_reg_offset(tr)); break; \ - case Y_REG_DEF: ASSERT(y_reg_offset(tr) >= 1); tr = yb(y_reg_offset(tr)); break; \ - } \ - CHECK_TERM(tr); \ +#define GetR(pos, tr) \ + do { \ + tr = Arg(pos); \ + switch (loader_tag(tr)) { \ + case LOADER_X_REG: \ + tr = x(loader_x_reg_index(tr)); \ + break; \ + case LOADER_Y_REG: \ + ASSERT(loader_y_reg_index(tr) >= 1); \ + tr = y(loader_y_reg_index(tr)); \ + break; \ + } \ + CHECK_TERM(tr); \ } while (0) #define GetArg1(N, Dst) GetR((N), Dst) @@ -557,24 +548,93 @@ void** beam_ops; HTOP += 2; \ } while (0) +#define Swap(R1, R2) \ + do { \ + Eterm V = R1; \ + R1 = R2; \ + R2 = V; \ + } while (0) + +#define SwapTemp(R1, R2, Tmp) \ + do { \ + Eterm V = R1; \ + R1 = R2; \ + R2 = Tmp = V; \ + } while (0) + #define Move(Src, Dst, Store) \ do { \ Eterm term = (Src); \ Store(term, Dst); \ } while (0) -#define Move2(S1, D1, S2, D2) D1 = (S1); D2 = (S2) +#define Move2Par(S1, D1, S2, D2) \ + do { \ + Eterm V1, V2; \ + V1 = (S1); V2 = (S2); D1 = V1; D2 = V2; \ + } while (0) + +#define MoveShift(Src, SD, D) \ + do { \ + Eterm V; \ + V = Src; D = SD; SD = V; \ + } while (0) + +#define MoveDup(Src, D1, D2) \ + do { \ + D1 = D2 = (Src); \ + } while (0) + #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; } +#define MoveWindow3(S1, S2, S3, D) \ + do { \ + Eterm xt0, xt1, xt2; \ + Eterm *y = &D; \ + xt0 = S1; \ + xt1 = S2; \ + xt2 = S3; \ + y[0] = xt0; \ + y[1] = xt1; \ + y[2] = xt2; \ + } while (0) + +#define MoveWindow4(S1, S2, S3, S4, D) \ + do { \ + Eterm xt0, xt1, xt2, xt3; \ + Eterm *y = &D; \ + xt0 = S1; \ + xt1 = S2; \ + xt2 = S3; \ + xt3 = S4; \ + y[0] = xt0; \ + y[1] = xt1; \ + y[2] = xt2; \ + y[3] = xt3; \ + } while (0) -#define MoveReturn(Src, Dest) \ - (Dest) = (Src); \ - I = c_p->cp; \ - ASSERT(VALID_INSTR(*c_p->cp)); \ - c_p->cp = 0; \ - CHECK_TERM(r(0)); \ +#define MoveWindow5(S1, S2, S3, S4, S5, D) \ + do { \ + Eterm xt0, xt1, xt2, xt3, xt4; \ + Eterm *y = &D; \ + xt0 = S1; \ + xt1 = S2; \ + xt2 = S3; \ + xt3 = S4; \ + xt4 = S5; \ + y[0] = xt0; \ + y[1] = xt1; \ + y[2] = xt2; \ + y[3] = xt3; \ + y[4] = xt4; \ + } while (0) + +#define MoveReturn(Src) \ + x(0) = (Src); \ + I = c_p->cp; \ + ASSERT(VALID_INSTR(*c_p->cp)); \ + c_p->cp = 0; \ + CHECK_TERM(r(0)); \ Goto(*I) #define DeallocateReturn(Deallocate) \ @@ -586,26 +646,26 @@ void** beam_ops; Goto(*I); \ } while (0) -#define MoveDeallocateReturn(Src, Dest, Deallocate) \ - (Dest) = (Src); \ +#define MoveDeallocateReturn(Src, Deallocate) \ + x(0) = (Src); \ DeallocateReturn(Deallocate) -#define MoveCall(Src, Dest, CallDest, Size) \ - (Dest) = (Src); \ +#define MoveCall(Src, CallDest, Size) \ + x(0) = (Src); \ SET_CP(c_p, I+Size+1); \ - SET_I((BeamInstr *) CallDest); \ + SET_I((BeamInstr *) CallDest); \ Dispatch(); -#define MoveCallLast(Src, Dest, CallDest, Deallocate) \ - (Dest) = (Src); \ - RESTORE_CP(E); \ - E = ADD_BYTE_OFFSET(E, (Deallocate)); \ - SET_I((BeamInstr *) CallDest); \ +#define MoveCallLast(Src, CallDest, Deallocate) \ + x(0) = (Src); \ + RESTORE_CP(E); \ + E = ADD_BYTE_OFFSET(E, (Deallocate)); \ + SET_I((BeamInstr *) CallDest); \ Dispatch(); -#define MoveCallOnly(Src, Dest, CallDest) \ - (Dest) = (Src); \ - SET_I((BeamInstr *) CallDest); \ +#define MoveCallOnly(Src, CallDest) \ + x(0) = (Src); \ + SET_I((BeamInstr *) CallDest); \ Dispatch(); #define MoveJump(Src) \ @@ -613,60 +673,69 @@ void** beam_ops; SET_I((BeamInstr *) Arg(0)); \ Goto(*I); -#define GetList(Src, H, T) do { \ - Eterm* tmp_ptr = list_val(Src); \ - H = CAR(tmp_ptr); \ - T = CDR(tmp_ptr); } while (0) - -#define GetTupleElement(Src, Element, Dest) \ - do { \ - tmp_arg1 = (Eterm) COMPRESS_POINTER(((unsigned char *) tuple_val(Src)) + \ - (Element)); \ - (Dest) = (*(Eterm *) EXPAND_POINTER(tmp_arg1)); \ +#define GetList(Src, H, T) \ + do { \ + Eterm* tmp_ptr = list_val(Src); \ + Eterm hd, tl; \ + hd = CAR(tmp_ptr); \ + tl = CDR(tmp_ptr); \ + H = hd; T = tl; \ } while (0) -#define ExtractNextElement(Dest) \ - tmp_arg1 += sizeof(Eterm); \ - (Dest) = (* (Eterm *) (((unsigned char *) EXPAND_POINTER(tmp_arg1)))) - -#define ExtractNextElement2(Dest) \ - do { \ - Eterm* ene_dstp = &(Dest); \ - ene_dstp[0] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[1]; \ - ene_dstp[1] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[2]; \ - tmp_arg1 += sizeof(Eterm) + sizeof(Eterm); \ +#define GetTupleElement(Src, Element, Dest) \ + do { \ + Eterm* src; \ + src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \ + (Dest) = *src; \ } while (0) -#define ExtractNextElement3(Dest) \ - do { \ - Eterm* ene_dstp = &(Dest); \ - ene_dstp[0] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[1]; \ - ene_dstp[1] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[2]; \ - ene_dstp[2] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[3]; \ - tmp_arg1 += 3*sizeof(Eterm); \ +#define GetTupleElement2(Src, Element, Dest) \ + do { \ + Eterm* src; \ + Eterm* dst; \ + Eterm E1, E2; \ + src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \ + dst = &(Dest); \ + E1 = src[0]; \ + E2 = src[1]; \ + dst[0] = E1; \ + dst[1] = E2; \ } while (0) -#define ExtractNextElement4(Dest) \ - do { \ - Eterm* ene_dstp = &(Dest); \ - ene_dstp[0] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[1]; \ - ene_dstp[1] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[2]; \ - ene_dstp[2] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[3]; \ - ene_dstp[3] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[4]; \ - tmp_arg1 += 4*sizeof(Eterm); \ +#define GetTupleElement2Y(Src, Element, D1, D2) \ + do { \ + Eterm* src; \ + Eterm E1, E2; \ + src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \ + E1 = src[0]; \ + E2 = src[1]; \ + D1 = E1; \ + D2 = E2; \ } while (0) -#define ExtractElement(Element, Dest) \ - do { \ - tmp_arg1 += (Element); \ - (Dest) = (* (Eterm *) EXPAND_POINTER(tmp_arg1)); \ +#define GetTupleElement3(Src, Element, Dest) \ + do { \ + Eterm* src; \ + Eterm* dst; \ + Eterm E1, E2, E3; \ + src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \ + dst = &(Dest); \ + E1 = src[0]; \ + E2 = src[1]; \ + E3 = src[2]; \ + dst[0] = E1; \ + dst[1] = E2; \ + dst[2] = E3; \ } while (0) #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 NotEqualExact(X, Y, Action) if (EQ(X,Y)) { Action; } +#define Equal(X, Y, Action) CMP_EQ_ACTION(X,Y,Action) +#define NotEqual(X, Y, Action) CMP_NE_ACTION(X,Y,Action) +#define IsLessThan(X, Y, Action) CMP_LT_ACTION(X,Y,Action) +#define IsGreaterEqual(X, Y, Action) CMP_GE_ACTION(X,Y,Action) #define IsFloat(Src, Fail) if (is_not_float(Src)) { Fail; } @@ -690,18 +759,26 @@ void** beam_ops; if (is_not_list(Src)) { Fail; } \ A(Need, Alive) -#define IsNonemptyListTestHeap(Src, Need, Alive, Fail) \ - if (is_not_list(Src)) { Fail; } \ +#define IsNonemptyListTestHeap(Need, Alive, Fail) \ + if (is_not_list(x(0))) { Fail; } \ TestHeap(Need, Alive) +#define IsNonemptyListGetList(Src, H, T, Fail) \ + if (is_not_list(Src)) { \ + Fail; \ + } else { \ + Eterm* tmp_ptr = list_val(Src); \ + Eterm hd, tl; \ + hd = CAR(tmp_ptr); \ + tl = CDR(tmp_ptr); \ + H = hd; T = tl; \ + } + #define IsTuple(X, Action) if (is_not_tuple(X)) Action -#define IsArity(Pointer, Arity, Fail) \ - if (*(Eterm *) \ - EXPAND_POINTER(tmp_arg1 = (Eterm) \ - COMPRESS_POINTER(tuple_val(Pointer))) != (Arity)) \ - { \ - Fail; \ +#define IsArity(Pointer, Arity, Fail) \ + if (*tuple_val(Pointer) != (Arity)) { \ + Fail; \ } #define IsMap(Src, Fail) if (!is_map(Src)) { Fail; } @@ -738,15 +815,21 @@ void** beam_ops; } \ } while (0) -#define IsTupleOfArity(Src, Arity, Fail) \ - do { \ - if (is_not_tuple(Src) || \ - *(Eterm *) \ - EXPAND_POINTER(tmp_arg1 = \ - (Eterm) COMPRESS_POINTER(tuple_val(Src))) != Arity) { \ - Fail; \ - } \ +#ifdef DEBUG +#define IsTupleOfArity(Src, Arityval, Fail) \ + do { \ + if (!(is_tuple(Src) && *tuple_val(Src) == Arityval)) { \ + Fail; \ + } \ } while (0) +#else +#define IsTupleOfArity(Src, Arityval, Fail) \ + do { \ + if (!(is_boxed(Src) && *tuple_val(Src) == Arityval)) { \ + Fail; \ + } \ + } while (0) +#endif #define IsBoolean(X, Fail) if ((X) != am_true && (X) != am_false) { Fail; } @@ -756,7 +839,7 @@ void** beam_ops; #define IsBitstring(Src, Fail) \ if (is_not_binary(Src)) { Fail; } -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) #define BsSafeMul(A, B, Fail, Target) \ do { Uint64 _res = (A) * (B); \ if (_res / B != A) { Fail; } \ @@ -773,6 +856,7 @@ void** beam_ops; #define BsGetFieldSize(Bits, Unit, Fail, Target) \ do { \ Sint _signed_size; Uint _uint_size; \ + Uint temp_bits; \ if (is_small(Bits)) { \ _signed_size = signed_val(Bits); \ if (_signed_size < 0) { Fail; } \ @@ -787,6 +871,7 @@ void** beam_ops; #define BsGetUncheckedFieldSize(Bits, Unit, Fail, Target) \ do { \ Sint _signed_size; Uint _uint_size; \ + Uint temp_bits; \ if (is_small(Bits)) { \ _signed_size = signed_val(Bits); \ if (_signed_size < 0) { Fail; } \ @@ -998,23 +1083,17 @@ init_emulator(void) */ #if defined(__GNUC__) && defined(sparc) && !defined(DEBUG) -# define REG_x0 asm("%l0") # define REG_xregs asm("%l1") # define REG_htop asm("%l2") # define REG_stop asm("%l3") # define REG_I asm("%l4") # define REG_fcalls asm("%l5") -# define REG_tmp_arg1 asm("%l6") -# define REG_tmp_arg2 asm("%l7") #else -# define REG_x0 # define REG_xregs # define REG_htop # define REG_stop # define REG_I # define REG_fcalls -# define REG_tmp_arg1 -# define REG_tmp_arg2 #endif #ifdef USE_VM_PROBES @@ -1132,11 +1211,6 @@ void process_main(void) ERTS_DECLARE_DUMMY(Eterm pid); #endif - /* - * X register zero; also called r(0) - */ - register Eterm x0 REG_x0 = NIL; - /* Pointer to X registers: x(1)..x(N); reg[0] is used when doing GC, * in all other cases x0 is used. */ @@ -1164,17 +1238,6 @@ void process_main(void) register Sint FCALLS REG_fcalls = 0; /* - * Temporaries used for picking up arguments for instructions. - */ - register Eterm tmp_arg1 REG_tmp_arg1 = NIL; - register Eterm tmp_arg2 REG_tmp_arg2 = NIL; -#if HEAP_ON_C_STACK - Eterm tmp_big[2]; /* Temporary buffer for small bignums if HEAP_ON_C_STACK. */ -#else - Eterm *tmp_big; /* Temporary buffer for small bignums if !HEAP_ON_C_STACK. */ -#endif - - /* * X registers and floating point registers are located in * scheduler specific data. */ @@ -1185,8 +1248,6 @@ void process_main(void) */ int neg_o_reds = 0; - Eterm (*arith_func)(Process* p, Eterm* reg, Uint live); - #ifdef ERTS_OPCODE_COUNTER_SUPPORT static void* counting_opcodes[] = { DEFINE_COUNTING_OPCODES }; #else @@ -1197,13 +1258,13 @@ void process_main(void) #endif #endif - Uint temp_bits; /* Temporary used by BsSkipBits2 & BsGetInteger2 */ - Eterm pt_arity; /* Used by do_put_tuple */ Uint64 start_time = 0; /* Monitor long schedule */ BeamInstr* start_time_i = NULL; + ERTS_MSACC_DECLARE_CACHE_X() /* a cached value of the tsd pointer for msacc */ + ERL_BITS_DECLARE_STATEP; /* Has to be last declaration */ @@ -1247,9 +1308,6 @@ void process_main(void) PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); -#if HALFWORD_HEAP - ASSERT(erts_get_scheduler_data()->num_tmp_heap_used == 0); -#endif ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); c_p = schedule(c_p, reds_used); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); @@ -1260,6 +1318,8 @@ void process_main(void) ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_MSACC_UPDATE_CACHE_X(); + if (erts_system_monitor_long_schedule != 0) { start_time = erts_timestamp_millis(); start_time_i = c_p->i; @@ -1267,9 +1327,6 @@ void process_main(void) reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array; freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array; -#if !HEAP_ON_C_STACK - tmp_big = ERTS_PROC_GET_SCHDATA(c_p)->beam_emu_tmp_heap; -#endif ERL_BITS_RELOAD_STATEP(c_p); { int reds; @@ -1278,7 +1335,7 @@ void process_main(void) int i; argp = c_p->arg_reg; - for (i = c_p->arity - 1; i > 0; i--) { + for (i = c_p->arity - 1; i >= 0; i--) { reg[i] = argp[i]; CHECK_TERM(reg[i]); } @@ -1302,12 +1359,6 @@ void process_main(void) } next = (BeamInstr *) *I; - r(0) = c_p->arg_reg[0]; -#ifdef HARDDEBUG - if (c_p->arity > 0) { - CHECK_TERM(r(0)); - } -#endif SWAPIN; ASSERT(VALID_INSTR(next)); @@ -1346,26 +1397,24 @@ void process_main(void) #endif #include "beam_hot.h" -#define STORE_ARITH_RESULT(res) StoreBifResult(2, (res)); -#define ARITH_FUNC(name) erts_gc_##name - { Eterm increment_reg_val; Eterm increment_val; Uint live; Eterm result; - OpCase(i_increment_yIId): - increment_reg_val = yb(Arg(0)); + OpCase(i_increment_rIId): + increment_reg_val = x(0); + I--; goto do_increment; OpCase(i_increment_xIId): increment_reg_val = xb(Arg(0)); goto do_increment; - OpCase(i_increment_rIId): - increment_reg_val = r(0); - I--; + OpCase(i_increment_yIId): + increment_reg_val = yb(Arg(0)); + goto do_increment; do_increment: increment_val = Arg(1); @@ -1374,229 +1423,133 @@ void process_main(void) ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); if (MY_IS_SSMALL(i)) { result = make_small(i); - store_result: StoreBifResult(3, result); } } live = Arg(2); - SWAPOUT; - reg[0] = r(0); + HEAVY_SWAPOUT; reg[live] = increment_reg_val; reg[live+1] = make_small(increment_val); result = erts_gc_mixed_plus(c_p, reg, live); - r(0) = reg[0]; - SWAPIN; + HEAVY_SWAPIN; ERTS_HOLE_CHECK(c_p); if (is_value(result)) { - goto store_result; + StoreBifResult(3, result); } 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) +#define DO_OUTLINED_ARITH_2(name, Op1, Op2) \ + do { \ + Eterm result; \ + Uint live = Arg(1); \ + \ + HEAVY_SWAPOUT; \ + reg[live] = Op1; \ + reg[live+1] = Op2; \ + result = erts_gc_##name(c_p, reg, live); \ + HEAVY_SWAPIN; \ + ERTS_HOLE_CHECK(c_p); \ + if (is_value(result)) { \ + StoreBifResult(4, result); \ + } \ + goto lb_Cl_error; \ + } while (0) - OpCase(i_plus_jIxxd): { + Eterm PlusOp1, PlusOp2; Eterm result; - if (is_both_small(xb(Arg(2)), xb(Arg(3)))) { - Sint i = signed_val(xb(Arg(2))) + signed_val(xb(Arg(3))); + OpCase(i_plus_jIxxd): + PlusOp1 = xb(Arg(2)); + PlusOp2 = xb(Arg(3)); + goto do_plus; + + OpCase(i_plus_jIxyd): + PlusOp1 = xb(Arg(2)); + PlusOp2 = yb(Arg(3)); + goto do_plus; + + OpCase(i_plus_jIssd): + GetArg2(2, PlusOp1, PlusOp2); + goto do_plus; + + do_plus: + if (is_both_small(PlusOp1, PlusOp2)) { + Sint i = signed_val(PlusOp1) + signed_val(PlusOp2); 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))); + DO_OUTLINED_ARITH_2(mixed_plus, PlusOp1, PlusOp2); } - OpCase(i_plus_jId): { + Eterm MinusOp1, MinusOp2; Eterm result; - if (is_both_small(tmp_arg1, tmp_arg2)) { - Sint i = signed_val(tmp_arg1) + signed_val(tmp_arg2); - ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); - if (MY_IS_SSMALL(i)) { - result = make_small(i); - STORE_ARITH_RESULT(result); - } - } - arith_func = ARITH_FUNC(mixed_plus); - goto do_big_arith2; - } - OpCase(i_minus_jIxxd): - { - Eterm result; + MinusOp1 = xb(Arg(2)); + MinusOp2 = xb(Arg(3)); + goto do_minus; - 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; + OpCase(i_minus_jIssd): + GetArg2(2, MinusOp1, MinusOp2); + goto do_minus; - if (is_both_small(tmp_arg1, tmp_arg2)) { - Sint i = signed_val(tmp_arg1) - signed_val(tmp_arg2); + do_minus: + if (is_both_small(MinusOp1, MinusOp2)) { + Sint i = signed_val(MinusOp1) - signed_val(MinusOp2); ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); if (MY_IS_SSMALL(i)) { result = make_small(i); - STORE_ARITH_RESULT(result); + StoreBifResult(4, result); } } - arith_func = ARITH_FUNC(mixed_minus); - goto do_big_arith2; + DO_OUTLINED_ARITH_2(mixed_minus, MinusOp1, MinusOp2); } - OpCase(i_is_lt_f): - if (CMP_GE(tmp_arg1, tmp_arg2)) { - ClauseFail(); - } - Next(1); - - OpCase(i_is_ge_f): - if (CMP_LT(tmp_arg1, tmp_arg2)) { - ClauseFail(); - } - Next(1); - - OpCase(i_is_eq_f): - if (CMP_NE(tmp_arg1, tmp_arg2)) { - ClauseFail(); - } - Next(1); - - OpCase(i_is_ne_f): - if (CMP_EQ(tmp_arg1, tmp_arg2)) { - ClauseFail(); - } - Next(1); - - OpCase(i_is_eq_exact_f): - if (!EQ(tmp_arg1, tmp_arg2)) { - ClauseFail(); - } - Next(1); - { Eterm is_eq_exact_lit_val; - OpCase(i_is_eq_exact_literal_xfc): - is_eq_exact_lit_val = xb(Arg(0)); - I++; + OpCase(i_is_eq_exact_literal_fxc): + is_eq_exact_lit_val = xb(Arg(1)); goto do_is_eq_exact_literal; - OpCase(i_is_eq_exact_literal_yfc): - is_eq_exact_lit_val = yb(Arg(0)); - I++; + OpCase(i_is_eq_exact_literal_fyc): + is_eq_exact_lit_val = yb(Arg(1)); goto do_is_eq_exact_literal; - OpCase(i_is_eq_exact_literal_rfc): - is_eq_exact_lit_val = r(0); - do_is_eq_exact_literal: - if (!eq(Arg(1), is_eq_exact_lit_val)) { + if (!eq(Arg(2), is_eq_exact_lit_val)) { ClauseFail(); } - Next(2); + Next(3); } { Eterm is_ne_exact_lit_val; - OpCase(i_is_ne_exact_literal_xfc): - is_ne_exact_lit_val = xb(Arg(0)); - I++; + OpCase(i_is_ne_exact_literal_fxc): + is_ne_exact_lit_val = xb(Arg(1)); goto do_is_ne_exact_literal; - OpCase(i_is_ne_exact_literal_yfc): - is_ne_exact_lit_val = yb(Arg(0)); - I++; + OpCase(i_is_ne_exact_literal_fyc): + is_ne_exact_lit_val = yb(Arg(1)); goto do_is_ne_exact_literal; - OpCase(i_is_ne_exact_literal_rfc): - is_ne_exact_lit_val = r(0); - do_is_ne_exact_literal: - if (eq(Arg(1), is_ne_exact_lit_val)) { + if (eq(Arg(2), is_ne_exact_lit_val)) { ClauseFail(); } - Next(2); + Next(3); } - 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): { + OpCase(i_move_call_only_fc): { r(0) = Arg(1); } /* FALL THROUGH */ @@ -1606,7 +1559,7 @@ void process_main(void) Dispatch(); } - OpCase(i_move_call_last_fPcr): { + OpCase(i_move_call_last_fPc): { r(0) = Arg(2); } /* FALL THROUGH */ @@ -1618,7 +1571,7 @@ void process_main(void) Dispatch(); } - OpCase(i_move_call_crf): { + OpCase(i_move_call_cf): { r(0) = Arg(0); I++; } @@ -1630,7 +1583,7 @@ void process_main(void) Dispatch(); } - OpCase(i_move_call_ext_last_ePcr): { + OpCase(i_move_call_ext_last_ePc): { r(0) = Arg(2); } /* FALL THROUGH */ @@ -1646,7 +1599,7 @@ void process_main(void) DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0)); Dispatchx(); - OpCase(i_move_call_ext_cre): { + OpCase(i_move_call_ext_ce): { r(0) = Arg(0); I++; } @@ -1656,7 +1609,7 @@ void process_main(void) DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0)); Dispatchx(); - OpCase(i_move_call_ext_only_ecr): { + OpCase(i_move_call_ext_only_ec): { r(0) = Arg(1); } /* FALL THROUGH */ @@ -1722,17 +1675,11 @@ void process_main(void) PRE_BIF_SWAPOUT(c_p); c_p->fcalls = FCALLS - 1; - reg[0] = r(0); result = erl_send(c_p, r(0), x(1)); PreFetch(0, next); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); - if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) { - result = erts_gc_after_bif_call(c_p, result, reg, 2); - r(0) = reg[0]; - E = c_p->stop; - } HTOP = HEAP_TOP(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { @@ -1743,7 +1690,6 @@ void process_main(void) SET_CP(c_p, I+1); SET_I(c_p->i); SWAPIN; - r(0) = reg[0]; Dispatch(); } goto find_func_info; @@ -1753,29 +1699,23 @@ void process_main(void) Eterm element_index; Eterm element_tuple; - OpCase(i_element_xjsd): - element_tuple = xb(Arg(0)); - I++; + OpCase(i_element_jxsd): + element_tuple = xb(Arg(1)); goto do_element; - OpCase(i_element_yjsd): - element_tuple = yb(Arg(0)); - I++; + OpCase(i_element_jysd): + element_tuple = yb(Arg(1)); goto do_element; - OpCase(i_element_rjsd): - element_tuple = r(0); - /* Fall through */ - do_element: - GetArg1(1, element_index); + GetArg1(2, element_index); if (is_small(element_index) && is_tuple(element_tuple)) { Eterm* tp = tuple_val(element_tuple); if ((signed_val(element_index) >= 1) && (signed_val(element_index) <= arityval(*tp))) { Eterm result = tp[signed_val(element_index)]; - StoreBifResult(2, result); + StoreBifResult(3, result); } } } @@ -1789,29 +1729,24 @@ void process_main(void) { Eterm fast_element_tuple; - OpCase(i_fast_element_rjId): - fast_element_tuple = r(0); + OpCase(i_fast_element_jxId): + fast_element_tuple = xb(Arg(1)); + goto do_fast_element; + + OpCase(i_fast_element_jyId): + fast_element_tuple = yb(Arg(1)); + goto do_fast_element; do_fast_element: if (is_tuple(fast_element_tuple)) { Eterm* tp = tuple_val(fast_element_tuple); - Eterm pos = Arg(1); /* Untagged integer >= 1 */ + Eterm pos = Arg(2); /* Untagged integer >= 1 */ if (pos <= arityval(*tp)) { Eterm result = tp[pos]; - StoreBifResult(2, result); + StoreBifResult(3, result); } } goto badarg; - - OpCase(i_fast_element_xjId): - fast_element_tuple = xb(Arg(0)); - I++; - goto do_fast_element; - - OpCase(i_fast_element_yjId): - fast_element_tuple = yb(Arg(0)); - I++; - goto do_fast_element; } OpCase(catch_yf): @@ -1832,11 +1767,10 @@ void process_main(void) SWAPIN; } /* only x(2) is included in the rootset here */ - if (E - HTOP < 3 || c_p->mbuf) { /* Force GC in case add_stacktrace() - * created heap fragments */ + if (E - HTOP < 3) { SWAPOUT; PROCESS_MAIN_CHK_LOCKS(c_p); - FCALLS -= erts_garbage_collect(c_p, 3, reg+2, 1); + FCALLS -= erts_garbage_collect_nobump(c_p, 3, reg+2, 1); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; @@ -1917,13 +1851,20 @@ void process_main(void) * Pick up the next message and place it in x(0). * If no message, jump to a wait or wait_timeout instruction. */ - OpCase(i_loop_rec_fr): + OpCase(i_loop_rec_f): { BeamInstr *next; - ErlMessage* msgp; + ErtsMessage* msgp; - loop_rec__: + /* + * We need to disable GC while matching messages + * in the queue. This since messages with data outside + * the heap will be corrupted by a GC. + */ + ASSERT(!(c_p->flags & F_DELAY_GC)); + c_p->flags |= F_DELAY_GC; + loop_rec__: PROCESS_MAIN_CHK_LOCKS(c_p); msgp = PEEK_MESSAGE(c_p); @@ -1935,6 +1876,7 @@ void process_main(void) if (ERTS_PROC_PENDING_EXIT(c_p)) { erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); SWAPOUT; + c_p->flags &= ~F_DELAY_GC; goto do_schedule; /* Will be rescheduled for exit */ } ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); @@ -1944,32 +1886,27 @@ void process_main(void) else #endif { + c_p->flags &= ~F_DELAY_GC; SET_I((BeamInstr *) Arg(0)); Goto(*I); /* Jump to a wait or wait_timeout instruction */ } } - ErtsMoveMsgAttachmentIntoProc(msgp, c_p, E, HTOP, FCALLS, - { - SWAPOUT; - reg[0] = r(0); - PROCESS_MAIN_CHK_LOCKS(c_p); - }, - { - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - r(0) = reg[0]; - SWAPIN; - }); if (is_non_value(ERL_MESSAGE_TERM(msgp))) { - /* - * A corrupt distribution message that we weren't able to decode; - * remove it... - */ - ASSERT(!msgp->data.attached); - /* TODO: Add DTrace probe for this bad message situation? */ - UNLINK_MESSAGE(c_p, msgp); - free_message(msgp); - goto loop_rec__; + SWAPOUT; /* erts_decode_dist_message() may write to heap... */ + if (!erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) { + /* + * A corrupt distribution message that we weren't able to decode; + * remove it... + */ + /* No swapin should be needed */ + ASSERT(HTOP == c_p->htop && E == c_p->stop); + /* TODO: Add DTrace probe for this bad message situation? */ + UNLINK_MESSAGE(c_p, msgp); + msgp->next = NULL; + erts_cleanup_messages(msgp); + goto loop_rec__; + } + SWAPIN; } PreFetch(1, next); r(0) = ERL_MESSAGE_TERM(msgp); @@ -1981,8 +1918,7 @@ void process_main(void) */ OpCase(remove_message): { BeamInstr *next; - ErlMessage* msgp; - + ErtsMessage* msgp; PROCESS_MAIN_CHK_LOCKS(c_p); PreFetch(0, next); @@ -1996,20 +1932,7 @@ void process_main(void) if (DT_UTAG(c_p) != NIL) { if (DT_UTAG_FLAGS(c_p) & DT_UTAG_PERMANENT) { SEQ_TRACE_TOKEN(c_p) = am_have_dt_utag; -#ifdef DTRACE_TAG_HARDDEBUG - if (DT_UTAG_FLAGS(c_p) & DT_UTAG_SPREADING) - erts_fprintf(stderr, - "Dtrace -> (%T) stop spreading " - "tag %T with message %T\r\n", - c_p->common.id,DT_UTAG(c_p),ERL_MESSAGE_TERM(msgp)); -#endif } else { -#ifdef DTRACE_TAG_HARDDEBUG - erts_fprintf(stderr, - "Dtrace -> (%T) kill tag %T with " - "message %T\r\n", - c_p->common.id,DT_UTAG(c_p),ERL_MESSAGE_TERM(msgp)); -#endif DT_UTAG(c_p) = NIL; SEQ_TRACE_TOKEN(c_p) = NIL; } @@ -2029,12 +1952,6 @@ void process_main(void) DT_UTAG(c_p) = ERL_MESSAGE_DT_UTAG(msgp); } DT_UTAG_FLAGS(c_p) |= DT_UTAG_SPREADING; -#ifdef DTRACE_TAG_HARDDEBUG - erts_fprintf(stderr, - "Dtrace -> (%T) receive tag (%T) " - "with message %T\r\n", - c_p->common.id, DT_UTAG(c_p), ERL_MESSAGE_TERM(msgp)); -#endif } else { #endif ASSERT(is_tuple(SEQ_TRACE_TOKEN(c_p))); @@ -2064,7 +1981,7 @@ void process_main(void) dtrace_proc_str(c_p, receiver_name); token2 = SEQ_TRACE_TOKEN(c_p); - if (token2 != NIL && token2 != am_have_dt_utag) { + if (have_seqtrace(token2)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token2)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token2)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token2)); @@ -2077,11 +1994,21 @@ void process_main(void) UNLINK_MESSAGE(c_p, msgp); JOIN_MESSAGE(c_p); CANCEL_TIMER(c_p); - free_message(msgp); + + erts_save_message_in_proc(c_p, msgp); + c_p->flags &= ~F_DELAY_GC; + + if (ERTS_IS_GC_DESIRED_INTERNAL(c_p, HTOP, E)) { + /* + * We want to GC soon but we leave a few + * reductions giving the message some time + * to turn into garbage. + */ + ERTS_VBUMP_LEAVE_REDS_INTERNAL(c_p, 5, FCALLS); + } ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); - NextPF(0, next); } @@ -2090,9 +2017,22 @@ void process_main(void) * message didn't match), then jump to the loop_rec instruction. */ OpCase(loop_rec_end_f): { + + ASSERT(c_p->flags & F_DELAY_GC); + SET_I((BeamInstr *) Arg(0)); SAVE_MESSAGE(c_p); - goto loop_rec__; + if (FCALLS > 0 || FCALLS > neg_o_reds) { + FCALLS--; + goto loop_rec__; + } + + c_p->flags &= ~F_DELAY_GC; + c_p->i = I; + SWAPOUT; + c_p->arity = 0; + c_p->current = NULL; + goto do_schedule; } /* * Prepare to wait for a message or a timeout, whichever occurs first. @@ -2131,8 +2071,6 @@ void process_main(void) * 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; @@ -2249,10 +2187,6 @@ void process_main(void) select_val2 = xb(Arg(0)); goto do_select_tuple_arity2; - OpCase(i_select_tuple_arity2_rfAAff): - select_val2 = r(0); - I--; - do_select_tuple_arity2: if (is_not_tuple(select_val2)) { goto select_val2_fail; @@ -2268,10 +2202,6 @@ void process_main(void) select_val2 = xb(Arg(0)); goto do_select_val2; - OpCase(i_select_val2_rfccff): - select_val2 = r(0); - I--; - do_select_val2: if (select_val2 == Arg(2)) { I += 3; @@ -2295,10 +2225,6 @@ void process_main(void) select_val = yb(Arg(0)); goto do_select_tuple_arity; - OpCase(i_select_tuple_arity_rfI): - select_val = r(0); - I--; - do_select_tuple_arity: if (is_tuple(select_val)) { select_val = *tuple_val(select_val); @@ -2315,10 +2241,6 @@ void process_main(void) 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; @@ -2345,10 +2267,6 @@ void process_main(void) select_val = yb(Arg(0)); goto do_binary_search; - OpCase(i_select_val_bins_rfI): - select_val = r(0); - I--; - do_binary_search: { struct Pairs { @@ -2409,10 +2327,6 @@ void process_main(void) jump_on_val_zero_index = xb(Arg(0)); goto do_jump_on_val_zero_index; - OpCase(i_jump_on_val_zero_rfI): - jump_on_val_zero_index = r(0); - I--; - do_jump_on_val_zero_index: if (is_small(jump_on_val_zero_index)) { jump_on_val_zero_index = signed_val(jump_on_val_zero_index); @@ -2437,10 +2351,6 @@ void process_main(void) jump_on_val_index = xb(Arg(0)); goto do_jump_on_val_index; - OpCase(i_jump_on_val_rfII): - jump_on_val_index = r(0); - I--; - do_jump_on_val_index: if (is_small(jump_on_val_index)) { jump_on_val_index = (Uint) (signed_val(jump_on_val_index) - Arg(3)); @@ -2460,15 +2370,12 @@ void process_main(void) do { Eterm term = *I++; - switch (term & _TAG_IMMED1_MASK) { - case (R_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: - *hp++ = r(0); - break; - case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: - *hp++ = x(term >> _TAG_IMMED1_SIZE); + switch (loader_tag(term)) { + case LOADER_X_REG: + *hp++ = x(loader_x_reg_index(term)); break; - case (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: - *hp++ = y(term >> _TAG_IMMED1_SIZE); + case LOADER_Y_REG: + *hp++ = y(loader_y_reg_index(term)); break; default: *hp++ = term; @@ -2482,31 +2389,26 @@ void process_main(void) OpCase(new_map_dII): { Eterm res; - x(0) = r(0); - SWAPOUT; + HEAVY_SWAPOUT; res = new_map(c_p, reg, I-1); - SWAPIN; - r(0) = x(0); + HEAVY_SWAPIN; StoreResult(res, Arg(0)); Next(3+Arg(2)); } -#define PUT_TERM_REG(term, desc) \ -do { \ - switch ((desc) & _TAG_IMMED1_MASK) { \ - case (R_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ - r(0) = (term); \ - break; \ - case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ - x((desc) >> _TAG_IMMED1_SIZE) = (term); \ - break; \ - case (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ - y((desc) >> _TAG_IMMED1_SIZE) = (term); \ - break; \ - default: \ - ASSERT(0); \ - break; \ - } \ +#define PUT_TERM_REG(term, desc) \ +do { \ + switch (loader_tag(desc)) { \ + case LOADER_X_REG: \ + x(loader_x_reg_index(desc)) = (term); \ + break; \ + case LOADER_Y_REG: \ + y(loader_y_reg_index(desc)) = (term); \ + break; \ + default: \ + ASSERT(0); \ + break; \ + } \ } while(0) OpCase(i_get_map_elements_fsI): { @@ -2577,12 +2479,10 @@ do { \ Eterm map; GetArg1(1, map); - x(0) = r(0); - SWAPOUT; + HEAVY_SWAPOUT; res = update_map_assoc(c_p, reg, map, I); - SWAPIN; + HEAVY_SWAPIN; if (is_value(res)) { - r(0) = x(0); StoreResult(res, Arg(2)); Next(5+Arg(4)); } else { @@ -2601,12 +2501,10 @@ do { \ Eterm map; GetArg1(1, map); - x(0) = r(0); - SWAPOUT; + HEAVY_SWAPOUT; res = update_map_exact(c_p, reg, map, I); - SWAPIN; + HEAVY_SWAPIN; if (is_value(res)) { - r(0) = x(0); StoreResult(res, Arg(2)); Next(5+Arg(4)); } else { @@ -2688,13 +2586,10 @@ do { \ { typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); GcBifFunction bf; - Eterm arg; Eterm result; Uint live = (Uint) Arg(3); - GetArg1(2, arg); - reg[0] = r(0); - reg[live] = arg; + GetArg1(2, x(live)); bf = (GcBifFunction) Arg(1); c_p->fcalls = FCALLS; SWAPOUT; @@ -2705,7 +2600,6 @@ do { \ ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; - r(0) = reg[0]; ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { @@ -2715,12 +2609,12 @@ do { \ SET_I((BeamInstr *) Arg(0)); Goto(*I); } - reg[0] = arg; + x(0) = x(live); I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf)); goto post_error_handling; } - OpCase(i_gc_bif2_jIId): /* Note, one less parameter than the i_gc_bif1 + OpCase(i_gc_bif2_jIIssd): /* Note, one less parameter than the i_gc_bif1 and i_gc_bif3 */ { typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); @@ -2728,9 +2622,13 @@ do { \ Eterm result; Uint live = (Uint) Arg(2); - reg[0] = r(0); - reg[live++] = tmp_arg1; - reg[live] = tmp_arg2; + GetArg2(3, x(live), x(live+1)); + /* + * XXX This calling convention does not make sense. 'live' + * should point out the first argument, not the second + * (i.e. 'live' should not be incremented below). + */ + live++; bf = (GcBifFunction) Arg(1); c_p->fcalls = FCALLS; SWAPOUT; @@ -2741,35 +2639,37 @@ do { \ ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; - r(0) = reg[0]; ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { - StoreBifResult(3, result); + StoreBifResult(5, result); } if (Arg(0) != 0) { SET_I((BeamInstr *) Arg(0)); Goto(*I); } - reg[0] = tmp_arg1; - reg[1] = tmp_arg2; + live--; + x(0) = x(live); + x(1) = x(live+1); I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf)); goto post_error_handling; } - OpCase(i_gc_bif3_jIsId): + OpCase(i_gc_bif3_jIIssd): { typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); GcBifFunction bf; - Eterm arg; Eterm result; - Uint live = (Uint) Arg(3); + Uint live = (Uint) Arg(2); - GetArg1(2, arg); - reg[0] = r(0); - reg[live++] = arg; - reg[live++] = tmp_arg1; - reg[live] = tmp_arg2; + x(live) = x(SCRATCH_X_REG); + GetArg2(3, x(live+1), x(live+2)); + /* + * XXX This calling convention does not make sense. 'live' + * should point out the first argument, not the third + * (i.e. 'live' should not be incremented below). + */ + live += 2; bf = (GcBifFunction) Arg(1); c_p->fcalls = FCALLS; SWAPOUT; @@ -2780,19 +2680,19 @@ do { \ ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; - r(0) = reg[0]; ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { - StoreBifResult(4, result); + StoreBifResult(5, result); } if (Arg(0) != 0) { SET_I((BeamInstr *) Arg(0)); Goto(*I); } - reg[0] = arg; - reg[1] = tmp_arg1; - reg[2] = tmp_arg2; + live -= 2; + x(0) = x(live); + x(1) = x(live+1); + x(2) = x(live+2); I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf)); goto post_error_handling; } @@ -2800,12 +2700,13 @@ do { \ /* * Guards bifs and, or, xor in guards. */ - OpCase(i_bif2_fbd): + OpCase(i_bif2_fbssd): { - Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2}; + Eterm tmp_reg[2]; Eterm (*bf)(Process*, Eterm*); Eterm result; + GetArg2(2, tmp_reg[0], tmp_reg[1]); bf = (BifFunction) Arg(1); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2817,7 +2718,7 @@ do { \ ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; if (is_value(result)) { - StoreBifResult(2, result); + StoreBifResult(4, result); } SET_I((BeamInstr *) Arg(0)); Goto(*I); @@ -2826,12 +2727,13 @@ do { \ /* * Guards bifs and, or, xor, relational operators in body. */ - OpCase(i_bif2_body_bd): + OpCase(i_bif2_body_bssd): { - Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2}; + Eterm tmp_reg[2]; Eterm (*bf)(Process*, Eterm*); Eterm result; + GetArg2(1, tmp_reg[0], tmp_reg[1]); bf = (BifFunction) Arg(0); PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); @@ -2842,10 +2744,10 @@ do { \ ERTS_HOLE_CHECK(c_p); if (is_value(result)) { ASSERT(!is_CP(result)); - StoreBifResult(1, result); + StoreBifResult(3, result); } - reg[0] = tmp_arg1; - reg[1] = tmp_arg2; + reg[0] = tmp_reg[0]; + reg[1] = tmp_reg[1]; SWAPOUT; I = handle_error(c_p, I, reg, bf); goto post_error_handling; @@ -2857,9 +2759,20 @@ do { \ */ OpCase(call_bif_e): { - Eterm (*bf)(Process*, Eterm*, BeamInstr*) = GET_BIF_ADDRESS(Arg(0)); + Eterm (*bf)(Process*, Eterm*, BeamInstr*); Eterm result; BeamInstr *next; + ErlHeapFragment *live_hf_end; + + if (ERTS_MSACC_IS_ENABLED_CACHED_X()) { + if (GET_BIF_MODULE(Arg(0)) == am_ets) { + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_ETS); + } else { + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_BIF); + } + } + + bf = GET_BIF_ADDRESS(Arg(0)); PRE_BIF_SWAPOUT(c_p); c_p->fcalls = FCALLS - 1; @@ -2869,20 +2782,26 @@ do { \ PreFetch(1, next); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - reg[0] = r(0); + live_hf_end = c_p->mbuf; result = (*bf)(c_p, reg, I); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); ERTS_HOLE_CHECK(c_p); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) { + if (ERTS_IS_GC_DESIRED(c_p)) { Uint arity = ((Export *)Arg(0))->code[2]; - result = erts_gc_after_bif_call(c_p, result, reg, arity); + result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, result, reg, arity); E = c_p->stop; } + PROCESS_MAIN_CHK_LOCKS(c_p); HTOP = HEAP_TOP(c_p); FCALLS = c_p->fcalls; + /* We have to update the cache if we are enabled in order + to make sure no book keeping is done after we disabled + msacc. We don't always do this as it is quite expensive. */ + if (ERTS_MSACC_IS_ENABLED_CACHED_X()) + ERTS_MSACC_UPDATE_CACHE_X(); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); if (is_value(result)) { r(0) = result; CHECK_TERM(r(0)); @@ -2891,7 +2810,6 @@ do { \ SET_CP(c_p, I+2); SET_I(c_p->i); SWAPIN; - r(0) = reg[0]; Dispatch(); } @@ -2907,111 +2825,81 @@ do { \ * Arithmetic operations. */ - OpCase(i_times_jId): + OpCase(i_times_jIssd): { - arith_func = ARITH_FUNC(mixed_times); - goto do_big_arith2; + Eterm Op1, Op2; + GetArg2(2, Op1, Op2); + DO_OUTLINED_ARITH_2(mixed_times, Op1, Op2); } - OpCase(i_m_div_jId): + OpCase(i_m_div_jIssd): { - arith_func = ARITH_FUNC(mixed_div); - goto do_big_arith2; + Eterm Op1, Op2; + GetArg2(2, Op1, Op2); + DO_OUTLINED_ARITH_2(mixed_div, Op1, Op2); } - OpCase(i_int_div_jId): + OpCase(i_int_div_jIssd): { - Eterm result; + Eterm Op1, Op2; - if (tmp_arg2 == SMALL_ZERO) { + GetArg2(2, Op1, Op2); + if (Op2 == SMALL_ZERO) { goto badarith; - } else if (is_both_small(tmp_arg1, tmp_arg2)) { - Sint ires = signed_val(tmp_arg1) / signed_val(tmp_arg2); + } else if (is_both_small(Op1, Op2)) { + Sint ires = signed_val(Op1) / signed_val(Op2); if (MY_IS_SSMALL(ires)) { - result = make_small(ires); - STORE_ARITH_RESULT(result); + Eterm result = make_small(ires); + StoreBifResult(4, result); } } - arith_func = ARITH_FUNC(int_div); - goto do_big_arith2; + DO_OUTLINED_ARITH_2(int_div, Op1, Op2); } - OpCase(i_rem_jIxxd): { - Eterm result; + Eterm RemOp1, RemOp2; - 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)))); + OpCase(i_rem_jIxxd): + RemOp1 = xb(Arg(2)); + RemOp2 = xb(Arg(3)); + goto do_rem; + + OpCase(i_rem_jIssd): + GetArg2(2, RemOp1, RemOp2); + goto do_rem; + + do_rem: + if (RemOp2 == SMALL_ZERO) { + goto badarith; + } else if (is_both_small(RemOp1, RemOp2)) { + Eterm result = make_small(signed_val(RemOp1) % signed_val(RemOp2)); StoreBifResult(4, result); + } else { + DO_OUTLINED_ARITH_2(int_rem, RemOp1, RemOp2); } - DO_BIG_ARITH(ARITH_FUNC(int_rem),xb(Arg(2)),xb(Arg(3))); } - OpCase(i_rem_jId): { - Eterm result; - - if (tmp_arg2 == SMALL_ZERO) { - goto badarith; - } else if (is_both_small(tmp_arg1, tmp_arg2)) { - result = make_small(signed_val(tmp_arg1) % signed_val(tmp_arg2)); - STORE_ARITH_RESULT(result); - } else { - arith_func = ARITH_FUNC(int_rem); - goto do_big_arith2; - } - } + Eterm BandOp1, BandOp2; OpCase(i_band_jIxcd): - { - Eterm result; + BandOp1 = xb(Arg(2)); + BandOp2 = Arg(3); + goto do_band; + + OpCase(i_band_jIssd): + GetArg2(2, BandOp1, BandOp2); + goto do_band; - if (is_both_small(xb(Arg(2)), Arg(3))) { + do_band: + if (is_both_small(BandOp1, BandOp2)) { /* * No need to untag -- TAG & TAG == TAG. */ - result = xb(Arg(2)) & Arg(3); + Eterm result = BandOp1 & BandOp2; StoreBifResult(4, result); } - DO_BIG_ARITH(ARITH_FUNC(band),xb(Arg(2)),Arg(3)); - } - - OpCase(i_band_jId): - { - Eterm result; - - if (is_both_small(tmp_arg1, tmp_arg2)) { - /* - * No need to untag -- TAG & TAG == TAG. - */ - result = tmp_arg1 & tmp_arg2; - STORE_ARITH_RESULT(result); - } - arith_func = ARITH_FUNC(band); - goto do_big_arith2; - } - -#undef DO_BIG_ARITH - - do_big_arith2: - { - Eterm result; - Uint live = Arg(1); - - SWAPOUT; - reg[0] = r(0); - reg[live] = tmp_arg1; - reg[live+1] = tmp_arg2; - result = arith_func(c_p, reg, live); - r(0) = reg[0]; - SWAPIN; - ERTS_HOLE_CHECK(c_p); - if (is_value(result)) { - STORE_ARITH_RESULT(result); - } - goto lb_Cl_error; + DO_OUTLINED_ARITH_2(band, BandOp1, BandOp2); } /* @@ -3032,97 +2920,105 @@ do { \ goto find_func_info; } - OpCase(i_bor_jId): + OpCase(i_bor_jIssd): { - Eterm result; + Eterm Op1, Op2; - if (is_both_small(tmp_arg1, tmp_arg2)) { + GetArg2(2, Op1, Op2); + if (is_both_small(Op1, Op2)) { /* * No need to untag -- TAG | TAG == TAG. */ - result = tmp_arg1 | tmp_arg2; - STORE_ARITH_RESULT(result); + Eterm result = Op1 | Op2; + StoreBifResult(4, result); } - arith_func = ARITH_FUNC(bor); - goto do_big_arith2; + DO_OUTLINED_ARITH_2(bor, Op1, Op2); } - OpCase(i_bxor_jId): + OpCase(i_bxor_jIssd): { - Eterm result; + Eterm Op1, Op2; - if (is_both_small(tmp_arg1, tmp_arg2)) { + GetArg2(2, Op1, Op2); + if (is_both_small(Op1, Op2)) { /* * We could extract the tag from one argument, but a tag extraction * could mean a shift. Therefore, play it safe here. */ - result = make_small(signed_val(tmp_arg1) ^ signed_val(tmp_arg2)); - STORE_ARITH_RESULT(result); + Eterm result = make_small(signed_val(Op1) ^ signed_val(Op2)); + StoreBifResult(4, result); } - arith_func = ARITH_FUNC(bxor); - goto do_big_arith2; + DO_OUTLINED_ARITH_2(bxor, Op1, Op2); } { + Eterm Op1, Op2; Sint i; Sint ires; Eterm* bigp; + Eterm tmp_big[2]; - OpCase(i_bsr_jId): - if (is_small(tmp_arg2)) { - i = -signed_val(tmp_arg2); - if (is_small(tmp_arg1)) { + OpCase(i_bsr_jIssd): + GetArg2(2, Op1, Op2); + if (is_small(Op2)) { + i = -signed_val(Op2); + if (is_small(Op1)) { goto small_shift; - } else if (is_big(tmp_arg1)) { + } else if (is_big(Op1)) { if (i == 0) { - StoreBifResult(2, tmp_arg1); + StoreBifResult(4, Op1); } goto big_shift; } - } else if (is_big(tmp_arg2)) { + } else if (is_big(Op2)) { /* * N bsr NegativeBigNum == N bsl MAX_SMALL * N bsr PositiveBigNum == N bsl MIN_SMALL */ - tmp_arg2 = make_small(bignum_header_is_neg(*big_val(tmp_arg2)) ? + Op2 = make_small(bignum_header_is_neg(*big_val(Op2)) ? MAX_SMALL : MIN_SMALL); goto do_bsl; } goto badarith; - OpCase(i_bsl_jId): + OpCase(i_bsl_jIssd): + GetArg2(2, Op1, Op2); + do_bsl: - if (is_small(tmp_arg2)) { - i = signed_val(tmp_arg2); + if (is_small(Op2)) { + i = signed_val(Op2); - if (is_small(tmp_arg1)) { + if (is_small(Op1)) { small_shift: - ires = signed_val(tmp_arg1); + ires = signed_val(Op1); if (i == 0 || ires == 0) { - StoreBifResult(2, tmp_arg1); + StoreBifResult(4, Op1); } else if (i < 0) { /* Right shift */ i = -i; if (i >= SMALL_BITS-1) { - tmp_arg1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO; + Op1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO; } else { - tmp_arg1 = make_small(ires >> i); + Op1 = make_small(ires >> i); } - StoreBifResult(2, tmp_arg1); + StoreBifResult(4, Op1); } else if (i < SMALL_BITS-1) { /* Left shift */ if ((ires > 0 && ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ires) == 0) || ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ~ires) == 0) { - tmp_arg1 = make_small(ires << i); - StoreBifResult(2, tmp_arg1); + Op1 = make_small(ires << i); + StoreBifResult(4, Op1); } } - tmp_arg1 = small_to_big(ires, tmp_big); + Op1 = small_to_big(ires, tmp_big); +#ifdef TAG_LITERAL_PTR + Op1 |= TAG_LITERAL_PTR; +#endif big_shift: if (i > 0) { /* Left shift. */ - ires = big_size(tmp_arg1) + (i / D_EXP); + ires = big_size(Op1) + (i / D_EXP); } else { /* Right shift. */ - ires = big_size(tmp_arg1); + ires = big_size(Op1); if (ires <= (-i / D_EXP)) ires = 3; /* ??? */ else @@ -3140,14 +3036,14 @@ do { \ c_p->freason = SYSTEM_LIMIT; goto lb_Cl_error; } - TestHeapPreserve(ires+1, Arg(1), tmp_arg1); + TestHeapPreserve(ires+1, Arg(1), Op1); bigp = HTOP; - tmp_arg1 = big_lshift(tmp_arg1, i, bigp); - if (is_big(tmp_arg1)) { + Op1 = big_lshift(Op1, i, bigp); + if (is_big(Op1)) { HTOP += bignum_header_arity(*HTOP) + 1; } HEAP_SPACE_VERIFIED(0); - if (is_nil(tmp_arg1)) { + if (is_nil(Op1)) { /* * This result must have been only slight larger * than allowed since it wasn't caught by the @@ -3157,25 +3053,25 @@ do { \ goto lb_Cl_error; } ERTS_HOLE_CHECK(c_p); - StoreBifResult(2, tmp_arg1); + StoreBifResult(4, Op1); } - } else if (is_big(tmp_arg1)) { + } else if (is_big(Op1)) { if (i == 0) { - StoreBifResult(2, tmp_arg1); + StoreBifResult(4, Op1); } goto big_shift; } - } else if (is_big(tmp_arg2)) { - if (bignum_header_is_neg(*big_val(tmp_arg2))) { + } else if (is_big(Op2)) { + if (bignum_header_is_neg(*big_val(Op2))) { /* * N bsl NegativeBigNum is either 0 or -1, depending on * the sign of N. Since we don't believe this case * is common, do the calculation with the minimum * amount of code. */ - tmp_arg2 = make_small(MIN_SMALL); + Op2 = make_small(MIN_SMALL); goto do_bsl; - } else if (is_small(tmp_arg1) || is_big(tmp_arg1)) { + } else if (is_small(Op1) || is_big(Op1)) { /* * N bsl PositiveBigNum is too large to represent. */ @@ -3199,12 +3095,10 @@ do { \ bnot_val = make_small(~signed_val(bnot_val)); } else { Uint live = Arg(2); - SWAPOUT; - reg[0] = r(0); + HEAVY_SWAPOUT; reg[live] = bnot_val; bnot_val = erts_gc_bnot(c_p, reg, live); - r(0) = reg[0]; - SWAPIN; + HEAVY_SWAPIN; ERTS_HOLE_CHECK(c_p); if (is_nil(bnot_val)) { goto lb_Cl_error; @@ -3219,11 +3113,10 @@ do { \ OpCase(i_apply): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = apply(c_p, r(0), x(1), x(2), reg); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_CP(c_p, I+1); SET_I(next); Dispatch(); @@ -3234,12 +3127,11 @@ do { \ OpCase(i_apply_last_P): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = apply(c_p, r(0), x(1), x(2), reg); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { - r(0) = reg[0]; - SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0])); + SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(0)); SET_I(next); Dispatch(); @@ -3250,11 +3142,10 @@ do { \ OpCase(i_apply_only): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = apply(c_p, r(0), x(1), x(2), reg); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_I(next); Dispatch(); } @@ -3265,12 +3156,10 @@ do { \ OpCase(apply_I): { BeamInstr *next; - reg[0] = r(0); - SWAPOUT; + HEAVY_SWAPOUT; next = fixed_apply(c_p, reg, Arg(0)); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_CP(c_p, I+2); SET_I(next); Dispatch(); @@ -3282,13 +3171,11 @@ do { \ OpCase(apply_last_IP): { BeamInstr *next; - reg[0] = r(0); - SWAPOUT; + HEAVY_SWAPOUT; next = fixed_apply(c_p, reg, Arg(0)); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { - r(0) = reg[0]; - SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0])); + SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(1)); SET_I(next); Dispatch(); @@ -3300,11 +3187,10 @@ do { \ OpCase(i_apply_fun): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = apply_fun(c_p, r(0), x(1), reg); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_CP(c_p, I+1); SET_I(next); Dispatchfun(); @@ -3315,12 +3201,11 @@ do { \ OpCase(i_apply_fun_last_P): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = apply_fun(c_p, r(0), x(1), reg); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { - r(0) = reg[0]; - SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0])); + SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(0)); SET_I(next); Dispatchfun(); @@ -3331,11 +3216,10 @@ do { \ OpCase(i_apply_fun_only): { BeamInstr *next; - SWAPOUT; + HEAVY_SWAPOUT; next = apply_fun(c_p, r(0), x(1), reg); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_I(next); Dispatchfun(); } @@ -3345,13 +3229,10 @@ do { \ OpCase(i_call_fun_I): { BeamInstr *next; - SWAPOUT; - reg[0] = r(0); - + HEAVY_SWAPOUT; next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_CP(c_p, I+2); SET_I(next); Dispatchfun(); @@ -3362,13 +3243,11 @@ do { \ OpCase(i_call_fun_last_IP): { BeamInstr *next; - SWAPOUT; - reg[0] = r(0); + HEAVY_SWAPOUT; next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { - r(0) = reg[0]; - SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0])); + SET_CP(c_p, (BeamInstr *) E[0]); E = ADD_BYTE_OFFSET(E, Arg(1)); SET_I(next); Dispatchfun(); @@ -3452,10 +3331,9 @@ do { \ */ argp = c_p->arg_reg; - for (i = c_p->arity - 1; i > 0; i--) { + for (i = c_p->arity - 1; i >= 0; i--) { argp[i] = reg[i]; } - c_p->arg_reg[0] = r(0); SWAPOUT; c_p->i = I; goto do_schedule1; @@ -3468,23 +3346,18 @@ do { \ Eterm* p; PreFetch(3, next); - GetArg2(0, element, tuple); + GetArg1(0, element); + tuple = REG_TARGET(Arg(1)); ASSERT(is_tuple(tuple)); p = (Eterm *) ((unsigned char *) tuple_val(tuple) + Arg(2)); *p = element; NextPF(3, next); } - OpCase(i_is_ne_exact_f): - if (EQ(tmp_arg1, tmp_arg2)) { - ClauseFail(); - } - Next(1); - OpCase(normal_exit): { SWAPOUT; c_p->freason = EXC_NORMAL; - c_p->arity = 0; /* In case this process will ever be garbed again. */ + c_p->arity = 0; /* In case this process will never be garbed again. */ ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); erts_do_exit_process(c_p, am_normal); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); @@ -3498,48 +3371,18 @@ do { \ goto do_schedule; } - OpCase(raise_ss): { - /* This was not done very well in R10-0; then, we passed the tag in - the first argument and hoped that the existing c_p->ftrace was - still correct. But the ftrace-object already includes the tag - (or rather, the freason). Now, we pass the original ftrace in - the first argument. We also handle atom tags in the first - argument for backwards compatibility. - */ - Eterm raise_val1; - Eterm raise_val2; - GetArg2(0, raise_val1, raise_val2); - c_p->fvalue = raise_val2; - if (c_p->freason == EXC_NULL) { - /* a safety check for the R10-0 case; should not happen */ - c_p->ftrace = NIL; - c_p->freason = EXC_ERROR; - } - /* for R10-0 code, keep existing c_p->ftrace and hope it's correct */ - switch (raise_val1) { - case am_throw: - c_p->freason = EXC_THROWN & ~EXF_SAVETRACE; - break; - case am_error: - c_p->freason = EXC_ERROR & ~EXF_SAVETRACE; - break; - case am_exit: - c_p->freason = EXC_EXIT & ~EXF_SAVETRACE; - break; - default: - {/* R10-1 and later - XXX note: should do sanity check on given trace if it can be - passed from a user! Currently only expecting generated calls. - */ - struct StackTrace *s; - c_p->ftrace = raise_val1; - s = get_trace_from_exc(raise_val1); - if (s == NULL) { - c_p->freason = EXC_ERROR; - } else { - c_p->freason = PRIMARY_EXCEPTION(s->freason); - } - } + OpCase(i_raise): { + Eterm raise_trace = x(2); + Eterm raise_value = x(1); + struct StackTrace *s; + + c_p->fvalue = raise_value; + c_p->ftrace = raise_trace; + s = get_trace_from_exc(raise_trace); + if (s == NULL) { + c_p->freason = EXC_ERROR; + } else { + c_p->freason = PRIMARY_EXCEPTION(s->freason); } goto find_func_info; } @@ -3547,25 +3390,14 @@ do { \ { Eterm badmatch_val; - OpCase(badmatch_y): - badmatch_val = yb(Arg(0)); - goto do_badmatch; - OpCase(badmatch_x): badmatch_val = xb(Arg(0)); - goto do_badmatch; - - OpCase(badmatch_r): - badmatch_val = r(0); - - do_badmatch: c_p->fvalue = badmatch_val; c_p->freason = BADMATCH; } /* Fall through here */ find_func_info: { - reg[0] = r(0); SWAPOUT; I = handle_error(c_p, I, reg, NULL); goto post_error_handling; @@ -3582,11 +3414,9 @@ do { \ * code[3]: &&call_error_handler * code[4]: Not used */ - SWAPOUT; - reg[0] = r(0); + HEAVY_SWAPOUT; I = call_error_handler(c_p, I-3, reg, am_undefined_function); - r(0) = reg[0]; - SWAPIN; + HEAVY_SWAPIN; if (I) { Goto(*I); } @@ -3594,18 +3424,13 @@ do { \ /* Fall through */ OpCase(error_action_code): { handle_error: - reg[0] = r(0); SWAPOUT; I = handle_error(c_p, NULL, reg, NULL); post_error_handling: if (I == 0) { goto do_schedule; } else { - r(0) = reg[0]; ASSERT(!is_value(r(0))); - if (c_p->mbuf) { - erts_garbage_collect(c_p, 0, reg+1, 3); - } SWAPIN; Goto(*I); } @@ -3629,6 +3454,9 @@ do { \ * I[3]: Function pointer to dirty NIF */ BifFunction vbf; + ErlHeapFragment *live_hf_end; + + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF); DTRACE_NIF_ENTRY(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); c_p->current = I-3; /* current and vbf set to please handle_error */ @@ -3643,8 +3471,8 @@ do { \ typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]); NifF* fp = vbf = (NifF*) I[1]; struct enif_environment_t env; - erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2]); - reg[0] = r(0); + erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2], NULL); + live_hf_end = c_p->mbuf; nif_bif_result = (*fp)(&env, bif_nif_arity, reg); if (env.exception_thrown) nif_bif_result = THE_NON_VALUE; @@ -3654,6 +3482,8 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); + DTRACE_NIF_RETURN(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); goto apply_bif_or_nif_epilogue; @@ -3668,6 +3498,13 @@ do { \ * code[3]: &&apply_bif * code[4]: Function pointer to BIF function */ + if (ERTS_MSACC_IS_ENABLED_CACHED_X()) { + if ((Eterm)I[-3] == am_ets) { + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_ETS); + } else { + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_BIF); + } + } c_p->current = I-3; /* In case we apply process_info/1,2 or load_nif/1 */ c_p->i = I; /* In case we apply check_process_code/2. */ @@ -3683,25 +3520,32 @@ do { \ bif_nif_arity = I[-1]; ASSERT(bif_nif_arity <= 4); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); - reg[0] = r(0); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); { Eterm (*bf)(Process*, Eterm*, BeamInstr*) = vbf; ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + live_hf_end = c_p->mbuf; nif_bif_result = (*bf)(c_p, reg, I); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(nif_bif_result)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); } - + /* We have to update the cache if we are enabled in order + to make sure no book keeping is done after we disabled + msacc. We don't always do this as it is quite expensive. */ + if (ERTS_MSACC_IS_ENABLED_CACHED_X()) + ERTS_MSACC_UPDATE_CACHE_X(); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); DTRACE_BIF_RETURN(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); apply_bif_or_nif_epilogue: ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); ERTS_HOLE_CHECK(c_p); - if (c_p->mbuf) { - nif_bif_result = erts_gc_after_bif_call(c_p, nif_bif_result, - reg, bif_nif_arity); + if (ERTS_IS_GC_DESIRED(c_p)) { + nif_bif_result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, + nif_bif_result, + reg, bif_nif_arity); } SWAPIN; /* There might have been a garbage collection. */ FCALLS = c_p->fcalls; @@ -3713,7 +3557,6 @@ do { \ Goto(*I); } else if (c_p->freason == TRAP) { SET_I(c_p->i); - r(0) = reg[0]; if (c_p->flags & F_HIBERNATE_SCHED) { c_p->flags &= ~F_HIBERNATE_SCHED; goto do_schedule; @@ -3735,21 +3578,21 @@ do { \ StoreBifResult(1, result); } + OpCase(i_get_hash_cId): + { + Eterm arg; + Eterm result; + + GetArg1(0, arg); + result = erts_pd_hash_get_with_hx(c_p, Arg(1), arg); + StoreBifResult(2, result); + } + { Eterm case_end_val; OpCase(case_end_x): case_end_val = xb(Arg(0)); - goto do_case_end; - - OpCase(case_end_y): - case_end_val = yb(Arg(0)); - goto do_case_end; - - OpCase(case_end_r): - case_end_val = r(0); - - do_case_end: c_p->fvalue = case_end_val; c_p->freason = EXC_CASE_CLAUSE; goto find_func_info; @@ -3797,19 +3640,13 @@ do { \ goto do_bs_init_bits_known; } - OpCase(i_bs_init_bits_fail_heap_IjId): { - /* tmp_arg1 was fetched by an i_fetch instruction */ - num_bits_term = tmp_arg1; - alloc = Arg(0); - I++; + OpCase(i_bs_init_bits_fail_heap_sIjId): { + GetArg1(0, num_bits_term); + alloc = Arg(1); + I += 2; goto do_bs_init_bits; } - OpCase(i_bs_init_bits_fail_rjId): { - num_bits_term = r(0); - alloc = 0; - goto do_bs_init_bits; - } OpCase(i_bs_init_bits_fail_yjId): { num_bits_term = yb(Arg(0)); I++; @@ -3929,52 +3766,48 @@ do { \ } { - OpCase(i_bs_init_fail_heap_IjId): { - /* tmp_arg1 was fetched by an i_fetch instruction */ - tmp_arg2 = Arg(0); - I++; - goto do_bs_init; - } + Eterm BsOp1, BsOp2; - OpCase(i_bs_init_fail_rjId): { - tmp_arg1 = r(0); - tmp_arg2 = 0; + OpCase(i_bs_init_fail_heap_sIjId): { + GetArg1(0, BsOp1); + BsOp2 = Arg(1); + I += 2; goto do_bs_init; } OpCase(i_bs_init_fail_yjId): { - tmp_arg1 = yb(Arg(0)); - tmp_arg2 = 0; + BsOp1 = yb(Arg(0)); + BsOp2 = 0; I++; goto do_bs_init; } OpCase(i_bs_init_fail_xjId): { - tmp_arg1 = xb(Arg(0)); - tmp_arg2 = 0; + BsOp1 = xb(Arg(0)); + BsOp2 = 0; I++; } /* FALL THROUGH */ do_bs_init: - if (is_small(tmp_arg1)) { - Sint size = signed_val(tmp_arg1); + if (is_small(BsOp1)) { + Sint size = signed_val(BsOp1); if (size < 0) { goto badarg; } - tmp_arg1 = (Eterm) size; + BsOp1 = (Eterm) size; } else { Uint bytes; - if (!term_to_Uint(tmp_arg1, &bytes)) { + if (!term_to_Uint(BsOp1, &bytes)) { c_p->freason = bytes; goto lb_Cl_error; } if ((bytes >> (8*sizeof(Uint)-3)) != 0) { goto system_limit; } - tmp_arg1 = (Eterm) bytes; + BsOp1 = (Eterm) bytes; } - if (tmp_arg1 <= ERL_ONHEAP_BIN_LIMIT) { + if (BsOp1 <= ERL_ONHEAP_BIN_LIMIT) { goto do_heap_bin_alloc; } else { goto do_proc_bin_alloc; @@ -3982,15 +3815,15 @@ do { \ OpCase(i_bs_init_heap_IIId): { - tmp_arg1 = Arg(0); - tmp_arg2 = Arg(1); + BsOp1 = Arg(0); + BsOp2 = Arg(1); I++; goto do_proc_bin_alloc; } OpCase(i_bs_init_IId): { - tmp_arg1 = Arg(0); - tmp_arg2 = 0; + BsOp1 = Arg(0); + BsOp2 = 0; } /* FALL THROUGH */ do_proc_bin_alloc: { @@ -3999,13 +3832,13 @@ do { \ erts_bin_offset = 0; erts_writable_bin = 0; - TestBinVHeap(tmp_arg1 / sizeof(Eterm), - tmp_arg2 + PROC_BIN_SIZE + ERL_SUB_BIN_SIZE, Arg(1)); + TestBinVHeap(BsOp1 / sizeof(Eterm), + BsOp2 + PROC_BIN_SIZE + ERL_SUB_BIN_SIZE, Arg(1)); /* * Allocate the binary struct itself. */ - bptr = erts_bin_nrml_alloc(tmp_arg1); + bptr = erts_bin_nrml_alloc(BsOp1); erts_refc_init(&bptr->refc, 1); erts_current_bin = (byte *) bptr->orig_bytes; @@ -4015,28 +3848,28 @@ do { \ pb = (ProcBin *) HTOP; HTOP += PROC_BIN_SIZE; pb->thing_word = HEADER_PROC_BIN; - pb->size = tmp_arg1; + pb->size = BsOp1; pb->next = MSO(c_p).first; MSO(c_p).first = (struct erl_off_heap_header*) pb; pb->val = bptr; pb->bytes = (byte*) bptr->orig_bytes; pb->flags = 0; - OH_OVERHEAD(&(MSO(c_p)), tmp_arg1 / sizeof(Eterm)); + OH_OVERHEAD(&(MSO(c_p)), BsOp1 / sizeof(Eterm)); StoreBifResult(2, make_binary(pb)); } OpCase(i_bs_init_heap_bin_heap_IIId): { - tmp_arg1 = Arg(0); - tmp_arg2 = Arg(1); + BsOp1 = Arg(0); + BsOp2 = Arg(1); I++; goto do_heap_bin_alloc; } OpCase(i_bs_init_heap_bin_IId): { - tmp_arg1 = Arg(0); - tmp_arg2 = 0; + BsOp1 = Arg(0); + BsOp2 = 0; } /* Fall through */ do_heap_bin_alloc: @@ -4044,33 +3877,36 @@ do { \ ErlHeapBin* hb; Uint bin_need; - bin_need = heap_bin_size(tmp_arg1); + bin_need = heap_bin_size(BsOp1); erts_bin_offset = 0; erts_writable_bin = 0; - TestHeap(bin_need+tmp_arg2+ERL_SUB_BIN_SIZE, Arg(1)); + TestHeap(bin_need+BsOp2+ERL_SUB_BIN_SIZE, Arg(1)); hb = (ErlHeapBin *) HTOP; HTOP += bin_need; - hb->thing_word = header_heap_bin(tmp_arg1); - hb->size = tmp_arg1; + hb->thing_word = header_heap_bin(BsOp1); + hb->size = BsOp1; erts_current_bin = (byte *) hb->data; - tmp_arg1 = make_binary(hb); - StoreBifResult(2, tmp_arg1); + BsOp1 = make_binary(hb); + StoreBifResult(2, BsOp1); } } - OpCase(i_bs_add_jId): { - Uint Unit = Arg(1); - if (is_both_small(tmp_arg1, tmp_arg2)) { - Sint Arg1 = signed_val(tmp_arg1); - Sint Arg2 = signed_val(tmp_arg2); + OpCase(bs_add_jssId): { + Eterm Op1, Op2; + Uint Unit = Arg(3); + + GetArg2(1, Op1, Op2); + if (is_both_small(Op1, Op2)) { + Sint Arg1 = signed_val(Op1); + Sint Arg2 = signed_val(Op2); if (Arg1 >= 0 && Arg2 >= 0) { - BsSafeMul(Arg2, Unit, goto system_limit, tmp_arg1); - tmp_arg1 += Arg1; + BsSafeMul(Arg2, Unit, goto system_limit, Op1); + Op1 += Arg1; store_bs_add_result: - if (tmp_arg1 <= MAX_SMALL) { - tmp_arg1 = make_small(tmp_arg1); + if (Op1 <= MAX_SMALL) { + Op1 = make_small(Op1); } else { /* * May generate a heap fragment, but in this @@ -4082,10 +3918,10 @@ do { \ * references (such as the heap). */ SWAPOUT; - tmp_arg1 = erts_make_integer(tmp_arg1, c_p); + Op1 = erts_make_integer(Op1, c_p); HTOP = HEAP_TOP(c_p); } - StoreBifResult(2, tmp_arg1); + StoreBifResult(4, Op1); } goto badarg; } else { @@ -4108,16 +3944,16 @@ do { \ * an Uint, the reason is SYSTEM_LIMIT. */ - if (!term_to_Uint(tmp_arg1, &a)) { + if (!term_to_Uint(Op1, &a)) { if (a == BADARG) { goto badarg; } - if (!term_to_Uint(tmp_arg2, &b)) { + if (!term_to_Uint(Op2, &b)) { c_p->freason = b; goto lb_Cl_error; } goto system_limit; - } else if (!term_to_Uint(tmp_arg2, &b)) { + } else if (!term_to_Uint(Op2, &b)) { c_p->freason = b; goto lb_Cl_error; } @@ -4127,8 +3963,8 @@ do { \ */ BsSafeMul(b, Unit, goto system_limit, c); - tmp_arg1 = a + c; - if (tmp_arg1 < a) { + Op1 = a + c; + if (Op1 < a) { /* * If the result is less than one of the * arguments, there must have been an overflow. @@ -4150,52 +3986,47 @@ do { \ } /* - * tmp_arg1 = Number of bytes to build - * tmp_arg2 = Source binary - * Operands: Fail ExtraHeap Live Unit Dst + * x(SCRATCH_X_REG); + * Operands: Fail ExtraHeap Live Unit Size Dst */ - OpCase(i_bs_append_jIIId): { + OpCase(i_bs_append_jIIIsd): { Uint live = Arg(2); Uint res; + Eterm Size; - SWAPOUT; - reg[0] = r(0); - reg[live] = tmp_arg2; - res = erts_bs_append(c_p, reg, live, tmp_arg1, Arg(1), Arg(3)); - r(0) = reg[0]; - SWAPIN; + GetArg1(4, Size); + HEAVY_SWAPOUT; + reg[live] = x(SCRATCH_X_REG); + res = erts_bs_append(c_p, reg, live, Size, Arg(1), Arg(3)); + HEAVY_SWAPIN; if (is_non_value(res)) { /* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */ goto lb_Cl_error; } - StoreBifResult(4, res); + StoreBifResult(5, res); } /* - * tmp_arg1 = Number of bytes to build - * tmp_arg2 = Source binary - * Operands: Fail Unit Dst + * Operands: Fail Size Src Unit Dst */ - OpCase(i_bs_private_append_jId): { + OpCase(i_bs_private_append_jIssd): { Eterm res; + Eterm Size, Src; - res = erts_bs_private_append(c_p, tmp_arg2, tmp_arg1, Arg(1)); + GetArg2(2, Size, Src); + res = erts_bs_private_append(c_p, Src, Size, Arg(1)); if (is_non_value(res)) { /* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */ goto lb_Cl_error; } - StoreBifResult(2, res); + StoreBifResult(4, res); } - /* - * tmp_arg1 = Initial size of writable binary - * Operands: Live Dst - */ OpCase(bs_init_writable): { - SWAPOUT; + HEAVY_SWAPOUT; r(0) = erts_bs_init_writable(c_p, r(0)); - SWAPIN; + HEAVY_SWAPIN; Next(0); } @@ -4252,7 +4083,7 @@ do { \ StoreBifResult(1, result); } - OpCase(i_bs_put_utf16_jIs): { + OpCase(bs_put_utf16_jIs): { Eterm arg; GetArg1(2, arg); @@ -4286,26 +4117,29 @@ do { \ /* * Only used for validating a value matched out. - * - * tmp_arg1 = Integer to validate - * tmp_arg2 = Match context */ - OpCase(i_bs_validate_unicode_retract_j): { - /* - * There is no need to untag the integer, but it IS necessary - * to make sure it is small (a bignum pointer could fall in - * the valid range). - */ - if (is_not_small(tmp_arg1) || tmp_arg1 > make_small(0x10FFFFUL) || - (make_small(0xD800UL) <= tmp_arg1 && - tmp_arg1 <= make_small(0xDFFFUL))) { - ErlBinMatchBuffer *mb = ms_matchbuffer(tmp_arg2); + OpCase(i_bs_validate_unicode_retract_jss): { + Eterm i; /* Integer to validate */ - mb->offset -= 32; - goto badarg; - } - Next(1); - } + /* + * There is no need to untag the integer, but it IS necessary + * to make sure it is small (a bignum pointer could fall in + * the valid range). + */ + + GetArg1(1, i); + if (is_not_small(i) || i > make_small(0x10FFFFUL) || + (make_small(0xD800UL) <= i && i <= make_small(0xDFFFUL))) { + Eterm ms; /* Match context */ + ErlBinMatchBuffer* mb; + + GetArg1(2, ms); + mb = ms_matchbuffer(ms); + mb->offset -= 32; + goto badarg; + } + Next(3); + } /* * Matching of binaries. @@ -4317,9 +4151,6 @@ do { \ Uint slots; Eterm context; - OpCase(i_bs_start_match2_rfIId): { - context = r(0); - do_start_match: slots = Arg(2); if (!is_boxed(context)) { @@ -4366,7 +4197,7 @@ do { \ ClauseFail(); } NextPF(4, next); - } + OpCase(i_bs_start_match2_xfIId): { context = xb(Arg(0)); I++; @@ -4379,18 +4210,6 @@ do { \ } } - OpCase(bs_test_zero_tail2_fr): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - - PreFetch(1, next); - _mb = (ErlBinMatchBuffer*) ms_matchbuffer(r(0)); - if (_mb->size != _mb->offset) { - ClauseFail(); - } - NextPF(1, next); - } - OpCase(bs_test_zero_tail2_fx): { BeamInstr *next; ErlBinMatchBuffer *_mb; @@ -4403,16 +4222,6 @@ do { \ NextPF(2, next); } - OpCase(bs_test_tail_imm2_frI): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - PreFetch(2, next); - _mb = ms_matchbuffer(r(0)); - if (_mb->size - _mb->offset != Arg(1)) { - ClauseFail(); - } - NextPF(2, next); - } OpCase(bs_test_tail_imm2_fxI): { BeamInstr *next; ErlBinMatchBuffer *_mb; @@ -4424,16 +4233,6 @@ do { \ NextPF(3, next); } - OpCase(bs_test_unit_frI): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - PreFetch(2, next); - _mb = ms_matchbuffer(r(0)); - if ((_mb->size - _mb->offset) % Arg(1)) { - ClauseFail(); - } - NextPF(2, next); - } OpCase(bs_test_unit_fxI): { BeamInstr *next; ErlBinMatchBuffer *_mb; @@ -4445,16 +4244,6 @@ do { \ NextPF(3, next); } - OpCase(bs_test_unit8_fr): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - PreFetch(1, next); - _mb = ms_matchbuffer(r(0)); - if ((_mb->size - _mb->offset) & 7) { - ClauseFail(); - } - NextPF(1, next); - } OpCase(bs_test_unit8_fx): { BeamInstr *next; ErlBinMatchBuffer *_mb; @@ -4469,19 +4258,11 @@ do { \ { Eterm bs_get_integer8_context; - OpCase(i_bs_get_integer_8_rfd): { - bs_get_integer8_context = r(0); - goto do_bs_get_integer_8; - } - OpCase(i_bs_get_integer_8_xfd): { - bs_get_integer8_context = xb(Arg(0)); - I++; - } - - do_bs_get_integer_8: { ErlBinMatchBuffer *_mb; Eterm _result; + bs_get_integer8_context = xb(Arg(0)); + I++; _mb = ms_matchbuffer(bs_get_integer8_context); if (_mb->size - _mb->offset < 8) { ClauseFail(); @@ -4499,15 +4280,10 @@ do { \ { Eterm bs_get_integer_16_context; - OpCase(i_bs_get_integer_16_rfd): - bs_get_integer_16_context = r(0); - goto do_bs_get_integer_16; - OpCase(i_bs_get_integer_16_xfd): bs_get_integer_16_context = xb(Arg(0)); I++; - do_bs_get_integer_16: { ErlBinMatchBuffer *_mb; Eterm _result; @@ -4528,17 +4304,10 @@ do { \ { Eterm bs_get_integer_32_context; - OpCase(i_bs_get_integer_32_rfId): - bs_get_integer_32_context = r(0); - goto do_bs_get_integer_32; - - OpCase(i_bs_get_integer_32_xfId): bs_get_integer_32_context = xb(Arg(0)); I++; - - do_bs_get_integer_32: { ErlBinMatchBuffer *_mb; Uint32 _integer; @@ -4551,11 +4320,11 @@ do { \ _integer = get_int32(_mb->base + _mb->offset/8); } _mb->offset += 32; -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) if (IS_USMALL(0, _integer)) { #endif _result = make_small(_integer); -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) } else { TestHeap(BIG_UINT_HEAP_SIZE, Arg(1)); _result = uint_to_big((Uint) _integer, HTOP); @@ -4567,103 +4336,82 @@ do { \ } } - /* Operands: Size Live Fail Flags Dst */ - OpCase(i_bs_get_integer_imm_rIIfId): { - tmp_arg1 = r(0); - /* Operands: Size Live Fail Flags Dst */ - goto do_bs_get_integer_imm_test_heap; - } + { + Eterm Ms, Sz; - /* Operands: x(Reg) Size Live Fail Flags Dst */ + /* Operands: x(Reg) Size Live Fail Flags Dst */ OpCase(i_bs_get_integer_imm_xIIfId): { - tmp_arg1 = xb(Arg(0)); - I++; - /* Operands: Size Live Fail Flags Dst */ - goto do_bs_get_integer_imm_test_heap; - } - - /* - * tmp_arg1 = match context - * Operands: Size Live Fail Flags Dst - */ - do_bs_get_integer_imm_test_heap: { - Uint wordsneeded; - tmp_arg2 = Arg(0); - wordsneeded = 1+WSIZE(NBYTES(tmp_arg2)); - TestHeapPreserve(wordsneeded, Arg(1), tmp_arg1); - I += 2; - /* Operands: Fail Flags Dst */ - goto do_bs_get_integer_imm; - } - - /* Operands: Size Fail Flags Dst */ - OpCase(i_bs_get_integer_small_imm_rIfId): { - tmp_arg1 = r(0); - tmp_arg2 = Arg(0); - I++; - /* Operands: Fail Flags Dst */ - goto do_bs_get_integer_imm; - } + Uint wordsneeded; + Ms = xb(Arg(0)); + Sz = Arg(1); + wordsneeded = 1+WSIZE(NBYTES(Sz)); + TestHeapPreserve(wordsneeded, Arg(2), Ms); + I += 3; + /* Operands: Fail Flags Dst */ + goto do_bs_get_integer_imm; + } - /* Operands: x(Reg) Size Fail Flags Dst */ + /* Operands: x(Reg) Size Fail Flags Dst */ OpCase(i_bs_get_integer_small_imm_xIfId): { - tmp_arg1 = xb(Arg(0)); - tmp_arg2 = Arg(1); - I += 2; - /* Operands: Fail Flags Dst */ - goto do_bs_get_integer_imm; - } + Ms = xb(Arg(0)); + Sz = Arg(1); + I += 2; + /* Operands: Fail Flags Dst */ + goto do_bs_get_integer_imm; + } - /* - * tmp_arg1 = match context - * tmp_arg2 = size of field - * Operands: Fail Flags Dst - */ + /* + * Ms = match context + * Sz = size of field + * Operands: Fail Flags Dst + */ do_bs_get_integer_imm: { - ErlBinMatchBuffer* mb; - Eterm result; + ErlBinMatchBuffer* mb; + Eterm result; - mb = ms_matchbuffer(tmp_arg1); - LIGHT_SWAPOUT; - result = erts_bs_get_integer_2(c_p, tmp_arg2, Arg(1), mb); - LIGHT_SWAPIN; - HEAP_SPACE_VERIFIED(0); - if (is_non_value(result)) { - ClauseFail(); + mb = ms_matchbuffer(Ms); + LIGHT_SWAPOUT; + result = erts_bs_get_integer_2(c_p, Sz, Arg(1), mb); + LIGHT_SWAPIN; + HEAP_SPACE_VERIFIED(0); + if (is_non_value(result)) { + ClauseFail(); + } + StoreBifResult(2, result); } - StoreBifResult(2, result); } /* - * tmp_arg1 = Match context - * tmp_arg2 = Size field - * Operands: Fail Live FlagsAndUnit Dst + * Operands: Fail Live FlagsAndUnit Ms Sz Dst */ - OpCase(i_bs_get_integer_fIId): { + OpCase(i_bs_get_integer_fIIssd): { Uint flags; Uint size; + Eterm Ms; + Eterm Sz; ErlBinMatchBuffer* mb; Eterm result; flags = Arg(2); - BsGetFieldSize(tmp_arg2, (flags >> 3), ClauseFail(), size); + GetArg2(3, Ms, Sz); + BsGetFieldSize(Sz, (flags >> 3), ClauseFail(), size); if (size >= SMALL_BITS) { Uint wordsneeded; - /* check bits size before potential gc. + /* Check bits size before potential gc. * We do not want a gc and then realize we don't need - * the allocated space (i.e. if the op fails) + * the allocated space (i.e. if the op fails). * - * remember to reacquire the matchbuffer after gc. + * Remember to re-acquire the matchbuffer after gc. */ - mb = ms_matchbuffer(tmp_arg1); + mb = ms_matchbuffer(Ms); if (mb->size - mb->offset < size) { ClauseFail(); } wordsneeded = 1+WSIZE(NBYTES((Uint) size)); - TestHeapPreserve(wordsneeded, Arg(1), tmp_arg1); + TestHeapPreserve(wordsneeded, Arg(1), Ms); } - mb = ms_matchbuffer(tmp_arg1); + mb = ms_matchbuffer(Ms); LIGHT_SWAPOUT; result = erts_bs_get_integer_2(c_p, size, flags, mb); LIGHT_SWAPIN; @@ -4671,18 +4419,13 @@ do { \ if (is_non_value(result)) { ClauseFail(); } - StoreBifResult(3, result); + StoreBifResult(5, result); } { Eterm get_utf8_context; /* Operands: MatchContext Fail Dst */ - OpCase(i_bs_get_utf8_rfd): { - get_utf8_context = r(0); - goto do_bs_get_utf8; - } - OpCase(i_bs_get_utf8_xfd): { get_utf8_context = xb(Arg(0)); I++; @@ -4693,7 +4436,7 @@ do { \ * Operands: Fail Dst */ - do_bs_get_utf8: { + { Eterm result = erts_bs_get_utf8(ms_matchbuffer(get_utf8_context)); if (is_non_value(result)) { ClauseFail(); @@ -4706,12 +4449,7 @@ do { \ Eterm get_utf16_context; /* Operands: MatchContext Fail Flags Dst */ - OpCase(i_bs_get_utf16_rfId): { - get_utf16_context = r(0); - goto do_bs_get_utf16; - } - - OpCase(i_bs_get_utf16_xfId): { + OpCase(i_bs_get_utf16_xfId): { get_utf16_context = xb(Arg(0)); I++; } @@ -4720,7 +4458,7 @@ do { \ * get_utf16_context = match_context * Operands: Fail Flags Dst */ - do_bs_get_utf16: { + { Eterm result = erts_bs_get_utf16(ms_matchbuffer(get_utf16_context), Arg(1)); if (is_non_value(result)) { @@ -4739,26 +4477,10 @@ do { \ Uint orig; Uint hole_size; - OpCase(bs_context_to_binary_r): { - context_to_binary_context = x0; - I -= 2; - goto do_context_to_binary; - } - - /* Unfortunately, inlining can generate this instruction. */ - OpCase(bs_context_to_binary_y): { - context_to_binary_context = yb(Arg(0)); - goto do_context_to_binary0; - } - - OpCase(bs_context_to_binary_x): { + OpCase(bs_context_to_binary_x): context_to_binary_context = xb(Arg(0)); - - do_context_to_binary0: I--; - } - do_context_to_binary: if (is_boxed(context_to_binary_context) && header_is_bin_matchstate(*boxed_val(context_to_binary_context))) { ErlBinMatchState* ms; @@ -4770,17 +4492,11 @@ do { \ } Next(2); - OpCase(i_bs_get_binary_all_reuse_rfI): { - context_to_binary_context = x0; - goto do_bs_get_binary_all_reuse; - } - OpCase(i_bs_get_binary_all_reuse_xfI): { context_to_binary_context = xb(Arg(0)); I++; } - do_bs_get_binary_all_reuse: mb = ms_matchbuffer(context_to_binary_context); size = mb->size - mb->offset; if (size % Arg(1) != 0) { @@ -4808,16 +4524,11 @@ do { \ { Eterm match_string_context; - OpCase(i_bs_match_string_rfII): { - match_string_context = r(0); - goto do_bs_match_string; - } OpCase(i_bs_match_string_xfII): { match_string_context = xb(Arg(0)); I++; } - do_bs_match_string: { BeamInstr *next; byte* bytes; @@ -4845,14 +4556,6 @@ do { \ } } - OpCase(i_bs_save2_rI): { - BeamInstr *next; - ErlBinMatchState *_ms; - PreFetch(1, next); - _ms = (ErlBinMatchState*) boxed_val((Eterm) r(0)); - _ms->save_offset[Arg(0)] = _ms->mb.offset; - NextPF(1, next); - } OpCase(i_bs_save2_xI): { BeamInstr *next; ErlBinMatchState *_ms; @@ -4862,14 +4565,6 @@ do { \ NextPF(2, next); } - OpCase(i_bs_restore2_rI): { - BeamInstr *next; - ErlBinMatchState *_ms; - PreFetch(1, next); - _ms = (ErlBinMatchState*) boxed_val((Eterm) r(0)); - _ms->mb.offset = _ms->save_offset[Arg(0)]; - NextPF(1, next); - } OpCase(i_bs_restore2_xI): { BeamInstr *next; ErlBinMatchState *_ms; @@ -4904,7 +4599,7 @@ do { \ SWAPOUT; /* Needed for shared heap */ ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); - erts_trace_return(c_p, code, r(0), E+1/*Process tracer*/); + erts_trace_return(c_p, code, r(0), ERTS_TRACER_FROM_ETERM(E+1)/* tracer */); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); SWAPIN; c_p->cp = NULL; @@ -4917,9 +4612,7 @@ do { \ BeamInstr real_I; ASSERT(I[-5] == (BeamInstr) BeamOp(op_i_func_info_IaaI)); SWAPOUT; - reg[0] = r(0); real_I = erts_generic_breakpoint(c_p, I, reg); - r(0) = reg[0]; SWAPIN; ASSERT(VALID_INSTR(real_I)); Goto(real_I); @@ -4979,7 +4672,7 @@ do { \ BeamInstr *next; PreFetch(2, next); - GetR(0, targ1); + targ1 = REG_TARGET(Arg(0)); /* Arg(0) == HEADER_FLONUM */ GET_DOUBLE(targ1, *(FloatDef*)ADD_BYTE_OFFSET(freg, fr)); NextPF(2, next); @@ -4999,7 +4692,7 @@ do { \ Eterm fr = Arg(1); BeamInstr *next; - GetR(0, targ1); + targ1 = REG_TARGET(Arg(0)); PreFetch(2, next); if (is_small(targ1)) { fb(fr) = (double) signed_val(targ1); @@ -5095,7 +4788,12 @@ do { \ #ifdef HIPE { - unsigned cmd; +#define HIPE_MODE_SWITCH(Cmd) \ + SWAPOUT; \ + c_p->fcalls = FCALLS; \ + c_p->def_arg_reg[4] = -neg_o_reds; \ + c_p = hipe_mode_switch(c_p, Cmd, reg); \ + goto L_post_hipe_mode_switch OpCase(hipe_trap_call): { /* @@ -5109,52 +4807,45 @@ do { \ */ ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI)); 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; + HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL | (I[-1] << 8)); } OpCase(hipe_trap_call_closure): { ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI)); 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; + HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (I[-1] << 8)); } OpCase(hipe_trap_return): { - cmd = HIPE_MODE_SWITCH_CMD_RETURN; - goto L_hipe_mode_switch; + HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RETURN); } OpCase(hipe_trap_throw): { - cmd = HIPE_MODE_SWITCH_CMD_THROW; - goto L_hipe_mode_switch; + HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_THROW); } OpCase(hipe_trap_resume): { - cmd = HIPE_MODE_SWITCH_CMD_RESUME; - goto L_hipe_mode_switch; + HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RESUME); } - L_hipe_mode_switch: - /* XXX: this abuse of def_arg_reg[] is horrid! */ - SWAPOUT; - c_p->fcalls = FCALLS; - c_p->def_arg_reg[4] = -neg_o_reds; - reg[0] = r(0); - c_p = hipe_mode_switch(c_p, cmd, reg); +#undef HIPE_MODE_SWITCH + + L_post_hipe_mode_switch: reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array; freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array; ERL_BITS_RELOAD_STATEP(c_p); + /* XXX: this abuse of def_arg_reg[] is horrid! */ neg_o_reds = -c_p->def_arg_reg[4]; FCALLS = c_p->fcalls; SWAPIN; - switch( c_p->def_arg_reg[3] ) { /* Halfword wont work with hipe yet! */ + switch( c_p->def_arg_reg[3] ) { case HIPE_MODE_SWITCH_RES_RETURN: ASSERT(is_value(reg[0])); - MoveReturn(reg[0], r(0)); + SET_I(c_p->cp); + c_p->cp = 0; + Goto(*I); 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(); case HIPE_MODE_SWITCH_RES_CALL_CLOSURE: /* This can be used to call any function value, but currently it's @@ -5163,9 +4854,8 @@ do { \ BeamInstr *next; next = call_fun(c_p, c_p->arity - 1, reg, THE_NON_VALUE); - SWAPIN; + HEAVY_SWAPIN; if (next != NULL) { - r(0) = reg[0]; SET_I(next); Dispatchfun(); } @@ -5213,22 +4903,54 @@ do { \ } OpCase(i_hibernate): { - SWAPOUT; + HEAVY_SWAPOUT; if (erts_hibernate(c_p, r(0), x(1), x(2), reg)) { + FCALLS = c_p->fcalls; c_p->flags &= ~F_HIBERNATE_SCHED; goto do_schedule; } else { + HEAVY_SWAPIN; I = handle_error(c_p, I, reg, hibernate_3); goto post_error_handling; } } + /* This is optimised as an instruction because + it has to be very very fast */ + OpCase(i_perf_counter): { + BeamInstr* next; + ErtsSysPerfCounter ts; + PreFetch(0, next); + + ts = erts_sys_perf_counter(); + + if (IS_SSMALL(ts)) { + r(0) = make_small((Sint)ts); + } else { + TestHeap(ERTS_SINT64_HEAP_SIZE(ts),0); + r(0) = make_big(HTOP); +#if defined(ARCH_32) || HALFWORD_HEAP + if (ts >= (((Uint64) 1) << 32)) { + *HTOP = make_pos_bignum_header(2); + BIG_DIGIT(HTOP, 0) = (Uint) (ts & ((Uint) 0xffffffff)); + BIG_DIGIT(HTOP, 1) = (Uint) ((ts >> 32) & ((Uint) 0xffffffff)); + HTOP += 3; + } + else +#endif + { + *HTOP = make_pos_bignum_header(1); + BIG_DIGIT(HTOP, 0) = (Uint) ts; + HTOP += 2; + } + } + NextPF(0, next); + } + OpCase(i_debug_breakpoint): { - SWAPOUT; - reg[0] = r(0); + HEAVY_SWAPOUT; I = call_error_handler(c_p, I-3, reg, am_breakpoint); - r(0) = reg[0]; - SWAPIN; + HEAVY_SWAPIN; if (I) { Goto(*I); } @@ -5517,7 +5239,8 @@ next_catch(Process* c_p, Eterm *reg) { BeamInstr *cpp = c_p->cp; if (cpp == beam_exception_trace) { erts_trace_exception(c_p, cp_val(ptr[0]), - reg[1], reg[2], ptr+1); + reg[1], reg[2], + ERTS_TRACER_FROM_ETERM(ptr+1)); /* Skip return_trace parameters */ ptr += 2; } else if (cpp == beam_return_trace) { @@ -5544,7 +5267,8 @@ next_catch(Process* c_p, Eterm *reg) { } if (cp_val(*prev) == beam_exception_trace) { erts_trace_exception(c_p, cp_val(ptr[0]), - reg[1], reg[2], ptr+1); + reg[1], reg[2], + ERTS_TRACER_FROM_ETERM(ptr+1)); } /* Skip return_trace parameters */ ptr += 2; @@ -6338,7 +6062,7 @@ erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* re return -1; } #else /* ERTS_SMP */ - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); if (!c_p->msg.len) #endif erts_smp_atomic32_read_band_relb(&c_p->state, ~ERTS_PSFLG_ACTIVE); @@ -6439,7 +6163,7 @@ call_fun(Process* p, /* Current process. */ */ module = fe->module; if ((modp = erts_get_module(module, code_ix)) != NULL - && modp->curr.code != NULL) { + && modp->curr.code_hdr != NULL) { /* * There is a module loaded, but obviously the fun is not * defined in it. We must not call the error_handler @@ -6644,23 +6368,20 @@ static Eterm get_map_element_hash(Eterm map, Eterm key, Uint32 hx) return vs ? *vs : THE_NON_VALUE; } -#define GET_TERM(term, dest) \ -do { \ - Eterm src = (Eterm)(term); \ - switch (src & _TAG_IMMED1_MASK) { \ - case (R_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ - dest = x(0); \ - break; \ - case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ - dest = x(src >> _TAG_IMMED1_SIZE); \ - break; \ - case (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \ - dest = y(src >> _TAG_IMMED1_SIZE); \ - break; \ - default: \ - dest = src; \ - break; \ - } \ +#define GET_TERM(term, dest) \ +do { \ + Eterm src = (Eterm)(term); \ + switch (loader_tag(src)) { \ + case LOADER_X_REG: \ + dest = x(loader_x_reg_index(src)); \ + break; \ + case LOADER_Y_REG: \ + dest = y(loader_y_reg_index(src)); \ + break; \ + default: \ + dest = src; \ + break; \ + } \ } while(0) @@ -6699,13 +6420,6 @@ new_map(Process* p, Eterm* reg, BeamInstr* I) erts_factory_proc_init(&factory, p); res = erts_hashmap_from_array(&factory, thp, n/2, 0); erts_factory_close(&factory); - 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; } @@ -6771,13 +6485,6 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) 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; } @@ -6937,12 +6644,6 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I) /* 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; } @@ -6998,14 +6699,6 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I) 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; @@ -7114,6 +6807,15 @@ erts_is_builtin(Eterm Mod, Eterm Name, int arity) Export e; Export* ep; + if (Mod == am_erlang && Name == am_apply && arity == 3) { + /* + * Special case. apply/3 is built-in (implemented in C), + * but implemented in a different way than all other + * BIFs. + */ + return 1; + } + e.code[0] = Mod; e.code[1] = Name; e.code[2] = arity; diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index a6dce2d1d2..2e21a553ed 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -80,7 +80,7 @@ ErlDrvBinary* erts_gzinflate_buffer(char*, int); typedef struct { Uint value; /* Value of label (NULL if not known yet). */ - Uint patches; /* Index (into code buffer) to first location + Sint patches; /* Index (into code buffer) to first location * which must be patched with the value of this label. */ #ifdef ERTS_SMP @@ -284,9 +284,10 @@ typedef struct LoaderState { int specific_op; /* Specific opcode (-1 if not found). */ int num_functions; /* Number of functions in module. */ int num_labels; /* Number of labels. */ - int code_buffer_size; /* Size of code buffer in words. */ - BeamInstr* code; /* Loaded code. */ - int ci; /* Current index into loaded code. */ + BeamCodeHeader* hdr; /* Loaded code header */ + BeamInstr* codev; /* Loaded code buffer */ + int codev_size; /* Size of code buffer in words. */ + int ci; /* Current index into loaded code buffer. */ Label* labels; StringPatch* string_patches; /* Linked list of position into string table to patch. */ BeamInstr catches; /* Linked list of catch_yf instructions. */ @@ -480,7 +481,7 @@ static void free_literal_fragment(ErlHeapFragment*); static void loader_state_dtor(Binary* magic); static Eterm insert_new_code(Process *c_p, ErtsProcLocks c_p_locks, Eterm group_leader, Eterm module, - BeamInstr* code, Uint size); + BeamCodeHeader* code, Uint size); static int init_iff_file(LoaderState* stp, byte* code, Uint size); static int scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mandatory); @@ -526,15 +527,15 @@ static void new_string_patch(LoaderState* stp, int pos); static Uint new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size); static int genopargcompare(GenOpArg* a, GenOpArg* b); static Eterm get_module_info(Process* p, ErtsCodeIndex code_ix, - BeamInstr* code, Eterm module, Eterm what); + BeamCodeHeader*, Eterm module, Eterm what); static Eterm exported_from_module(Process* p, ErtsCodeIndex code_ix, Eterm mod); -static Eterm functions_in_module(Process* p, BeamInstr* code); -static Eterm attributes_for_module(Process* p, BeamInstr* code); -static Eterm compilation_info_for_module(Process* p, BeamInstr* code); -static Eterm md5_of_module(Process* p, BeamInstr* code); -static Eterm has_native(BeamInstr* code); -static Eterm native_addresses(Process* p, BeamInstr* code); +static Eterm functions_in_module(Process* p, BeamCodeHeader*); +static Eterm attributes_for_module(Process* p, BeamCodeHeader*); +static Eterm compilation_info_for_module(Process* p, BeamCodeHeader*); +static Eterm md5_of_module(Process* p, BeamCodeHeader*); +static Eterm has_native(BeamCodeHeader*); +static Eterm native_addresses(Process* p, BeamCodeHeader*); int patch_funentries(Eterm Patchlist); int patch(Eterm Addresses, Uint fe); static int safe_mul(UWord a, UWord b, UWord* resp); @@ -601,6 +602,7 @@ extern void check_allocated_block(Uint type, void *blk); #define CHKBLK(TYPE,BLK) /* nothing */ #endif + Eterm erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader, Eterm* modp, byte* code, Uint unloaded_size) @@ -641,20 +643,27 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader, /* * Initialize code area. */ - stp->code_buffer_size = 2048 + stp->num_functions; - stp->code = (BeamInstr *) erts_alloc(ERTS_ALC_T_CODE, - sizeof(BeamInstr) * stp->code_buffer_size); + stp->codev_size = 2048 + stp->num_functions; + stp->hdr = (BeamCodeHeader*) erts_alloc(ERTS_ALC_T_CODE, + (offsetof(BeamCodeHeader,functions) + + sizeof(BeamInstr) * stp->codev_size)); - stp->code[MI_NUM_FUNCTIONS] = stp->num_functions; - stp->ci = MI_FUNCTIONS + stp->num_functions + 1; + stp->hdr->num_functions = stp->num_functions; - stp->code[MI_ATTR_PTR] = 0; - stp->code[MI_ATTR_SIZE] = 0; - stp->code[MI_ATTR_SIZE_ON_HEAP] = 0; - 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; + /* Let the codev array start at functions[0] in order to index + * both function pointers and the loaded code itself that follows. + */ + stp->codev = (BeamInstr*) &stp->hdr->functions; + stp->ci = stp->num_functions + 1; + + stp->hdr->attr_ptr = NULL; + stp->hdr->attr_size = 0; + stp->hdr->attr_size_on_heap = 0; + stp->hdr->compile_ptr = NULL; + stp->hdr->compile_size = 0; + stp->hdr->compile_size_on_heap = 0; + stp->hdr->literals_start = NULL; + stp->hdr->md5_ptr = NULL; /* * Read the atom table. @@ -776,7 +785,7 @@ erts_finish_loading(Binary* magic, Process* c_p, CHKBLK(ERTS_ALC_T_CODE,stp->code); retval = insert_new_code(c_p, c_p_locks, stp->group_leader, stp->module, - stp->code, stp->loaded_size); + stp->hdr, stp->loaded_size); if (retval != NIL) { goto load_error; } @@ -799,7 +808,8 @@ erts_finish_loading(Binary* magic, Process* c_p, debug_dump_code(stp->code,stp->ci); #endif #endif - stp->code = NULL; /* Prevent code from being freed. */ + stp->hdr = NULL; /* Prevent code from being freed. */ + stp->codev = NULL; *modp = stp->module; /* @@ -831,7 +841,8 @@ erts_alloc_loader_state(void) stp->specific_op = -1; stp->genop = NULL; stp->atom = NULL; - stp->code = NULL; + stp->hdr = NULL; + stp->codev = NULL; stp->labels = NULL; stp->import = NULL; stp->export = NULL; @@ -870,13 +881,30 @@ erts_module_for_prepared_code(Binary* magic) return NIL; } stp = ERTS_MAGIC_BIN_DATA(magic); - if (stp->code != 0) { + if (stp->hdr != 0) { return stp->module; } else { return NIL; } } +/* + * Return a non-zero value if the module has an on_load function, + * or 0 if it does not. + */ + +Eterm +erts_has_code_on_load(Binary* magic) +{ + LoaderState* stp; + + if (ERTS_MAGIC_BIN_DESTRUCTOR(magic) != loader_state_dtor) { + return NIL; + } + stp = ERTS_MAGIC_BIN_DATA(magic); + return stp->on_load ? am_true : am_false; +} + static void free_loader_state(Binary* magic) { @@ -891,7 +919,7 @@ static ErlHeapFragment* new_literal_fragment(Uint size) ErlHeapFragment* bp; bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(ERTS_ALC_T_PREPARED_CODE, ERTS_HEAP_FRAG_SIZE(size)); - ERTS_INIT_HEAP_FRAG(bp, size); + ERTS_INIT_HEAP_FRAG(bp, size, size); return bp; } @@ -920,9 +948,13 @@ loader_state_dtor(Binary* magic) driver_free_binary(stp->bin); stp->bin = 0; } - if (stp->code != 0) { - erts_free(ERTS_ALC_T_CODE, stp->code); - stp->code = 0; + if (stp->hdr != 0) { + if (stp->hdr->literals_start) { + erts_free(ERTS_ALC_T_LITERAL, stp->hdr->literals_start); + } + erts_free(ERTS_ALC_T_CODE, stp->hdr); + stp->hdr = 0; + stp->codev = 0; } if (stp->labels != 0) { erts_free(ERTS_ALC_T_PREPARED_CODE, (void *) stp->labels); @@ -995,7 +1027,7 @@ loader_state_dtor(Binary* magic) static Eterm insert_new_code(Process *c_p, ErtsProcLocks c_p_locks, - Eterm group_leader, Eterm module, BeamInstr* code, + Eterm group_leader, Eterm module, BeamCodeHeader* code_hdr, Uint size) { Module* modp; @@ -1016,7 +1048,7 @@ insert_new_code(Process *c_p, ErtsProcLocks c_p_locks, erts_total_code_size += size; modp = erts_put_module(module); - modp->curr.code = code; + modp->curr.code_hdr = code_hdr; modp->curr.code_length = size; modp->curr.catches = BEAM_CATCHES_NIL; /* Will be filled in later. */ @@ -1024,7 +1056,7 @@ insert_new_code(Process *c_p, ErtsProcLocks c_p_locks, * Update ranges (used for finding a function from a PC value). */ - erts_update_ranges(code, size); + erts_update_ranges((BeamInstr*)modp->curr.code_hdr, size); return NIL; } @@ -1373,7 +1405,7 @@ read_export_table(LoaderState* stp) if (value == 0) { LoadError2(stp, "export table entry %d: label %d not resolved", i, n); } - stp->export[i].address = address = stp->code + value; + stp->export[i].address = address = stp->codev + value; /* * Find out if there is a BIF with the same name. @@ -1392,7 +1424,7 @@ read_export_table(LoaderState* stp) * any other functions that walk through all local functions. */ - if (stp->labels[n].patches) { + if (stp->labels[n].patches >= 0) { LoadError3(stp, "there are local calls to the stub for " "the BIF %T:%T/%d", stp->module, func, arity); @@ -1513,10 +1545,10 @@ read_literal_table(LoaderState* stp) } if (heap_size > 0) { - erts_factory_message_init(&factory, NULL, NULL, - new_literal_fragment(heap_size)); + erts_factory_heap_frag_init(&factory, + new_literal_fragment(heap_size)); factory.alloc_type = ERTS_ALC_T_PREPARED_CODE; - val = erts_decode_ext(&factory, &p); + val = erts_decode_ext(&factory, &p, 0); if (is_non_value(val)) { LoadError1(stp, "literal %d: bad external format", i); @@ -1527,7 +1559,7 @@ read_literal_table(LoaderState* stp) } else { erts_factory_dummy_init(&factory); - val = erts_decode_ext(&factory, &p); + val = erts_decode_ext(&factory, &p, 0); if (is_non_value(val)) { LoadError1(stp, "literal %d: bad external format", i); } @@ -1735,7 +1767,7 @@ read_code_header(LoaderState* stp) stp->num_labels * sizeof(Label)); for (i = 0; i < stp->num_labels; i++) { stp->labels[i].value = 0; - stp->labels[i].patches = 0; + stp->labels[i].patches = -1; #ifdef ERTS_SMP stp->labels[i].looprec_targeted = 0; #endif @@ -1754,13 +1786,14 @@ read_code_header(LoaderState* stp) } else {} #define CodeNeed(w) do { \ - ASSERT(ci <= code_buffer_size); \ - if (code_buffer_size < ci+(w)) { \ - code_buffer_size = 2*ci+(w); \ - stp->code = code = \ - (BeamInstr *) erts_realloc(ERTS_ALC_T_CODE, \ - (void *) code, \ - code_buffer_size * sizeof(BeamInstr)); \ + ASSERT(ci <= codev_size); \ + if (codev_size < ci+(w)) { \ + codev_size = 2*ci+(w); \ + stp->hdr = (BeamCodeHeader*) erts_realloc(ERTS_ALC_T_CODE, \ + (void *) stp->hdr, \ + (offsetof(BeamCodeHeader,functions) \ + + codev_size * sizeof(BeamInstr))); \ + code = stp->codev = (BeamInstr*) &stp->hdr->functions; \ } \ } while (0) @@ -1776,7 +1809,7 @@ load_code(LoaderState* stp) int arg; /* Number of current argument. */ int num_specific; /* Number of specific ops for current. */ BeamInstr* code; - int code_buffer_size; + int codev_size; int specific; Uint last_label = 0; /* Number of last label. */ Uint function_number = 0; @@ -1793,15 +1826,15 @@ load_code(LoaderState* stp) FUNC_INFO_SZ = 5 }; - code = stp->code; - code_buffer_size = stp->code_buffer_size; + code = stp->codev; + codev_size = stp->codev_size; ci = stp->ci; for (;;) { int new_op; GenOp* tmp_op; - ASSERT(ci <= code_buffer_size); + ASSERT(ci <= codev_size); get_next_instr: GetByte(stp, new_op); @@ -1847,9 +1880,7 @@ load_code(LoaderState* stp) case TAG_o: break; case TAG_x: - if (last_op->a[arg].val == 0) { - last_op->a[arg].type = TAG_r; - } else if (last_op->a[arg].val >= MAX_REG) { + if (last_op->a[arg].val >= MAX_REG) { LoadError1(stp, "invalid x register number: %u", last_op->a[arg].val); } @@ -1894,15 +1925,14 @@ load_code(LoaderState* stp) */ { Eterm* hp; -/* XXX:PaN - Halfword should use ARCH_64 variant instead */ -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) Uint high, low; # endif last_op->a[arg].val = new_literal(stp, &hp, FLOAT_SIZE_OBJECT); hp[0] = HEADER_FLONUM; last_op->a[arg].type = TAG_q; -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) GetInt(stp, 8, hp[1]); # else GetInt(stp, 4, high); @@ -1998,42 +2028,47 @@ load_code(LoaderState* stp) ASSERT(arity == last_op->arity); do_transform: - if (stp->genop == NULL) { - last_op_next = NULL; - goto get_next_instr; - } - + ASSERT(stp->genop != NULL); if (gen_opc[stp->genop->op].transform != -1) { - int need; - tmp_op = stp->genop; - - for (need = gen_opc[stp->genop->op].min_window-1; need > 0; need--) { - if (tmp_op == NULL) { - goto get_next_instr; - } - tmp_op = tmp_op->next; + if (stp->genop->next == NULL) { + /* + * Simple heuristic: Most transformations requires + * at least two instructions, so make sure that + * there are. That will reduce the number of + * TE_SHORT_WINDOWs. + */ + goto get_next_instr; } switch (transform_engine(stp)) { case TE_FAIL: - last_op_next = NULL; - last_op = NULL; + /* + * No transformation found. stp->genop != NULL and + * last_op_next is still valid. Go ahead and load + * the instruction. + */ break; case TE_OK: + /* + * Some transformation was applied. last_op_next is + * no longer valid and stp->genop may be NULL. + * Try to transform again. + */ + if (stp->genop == NULL) { + last_op_next = &stp->genop; + goto get_next_instr; + } last_op_next = NULL; - last_op = NULL; goto do_transform; case TE_SHORT_WINDOW: - last_op_next = NULL; - last_op = NULL; + /* + * No transformation applied. stp->genop != NULL and + * last_op_next is still valid. Fetch a new instruction + * before trying the transformation again. + */ goto get_next_instr; } } - if (stp->genop == NULL) { - last_op_next = NULL; - goto get_next_instr; - } - /* * From the collected generic instruction, find the specific * instruction. @@ -2056,7 +2091,42 @@ load_code(LoaderState* stp) if (((opc[specific].mask[0] & mask[0]) == mask[0]) && ((opc[specific].mask[1] & mask[1]) == mask[1]) && ((opc[specific].mask[2] & mask[2]) == mask[2])) { - break; + + if (!opc[specific].involves_r) { + break; /* No complications - match */ + } + + /* + * The specific operation uses the 'r' operand, + * which is shorthand for x(0). Now things + * get complicated. First we must check whether + * all operands that should be of type 'r' use + * x(0) (as opposed to some other X register). + */ + for (arg = 0; arg < arity; arg++) { + if (opc[specific].involves_r & (1 << arg) && + tmp_op->a[arg].type == TAG_x) { + if (tmp_op->a[arg].val != 0) { + break; /* Other X register than 0 */ + } + } + } + + if (arg == arity) { + /* + * All 'r' operands use x(0) in the generic + * operation. That means a match. Now we + * will need to rewrite the generic instruction + * to actually use 'r' instead of 'x(0)'. + */ + for (arg = 0; arg < arity; arg++) { + if (opc[specific].involves_r & (1 << arg) && + tmp_op->a[arg].type == TAG_x) { + tmp_op->a[arg].type = TAG_r; + } + } + break; /* Match */ + } } specific++; } @@ -2167,14 +2237,11 @@ load_code(LoaderState* stp) break; case 's': /* Any source (tagged constant or register) */ switch (tag) { - case TAG_r: - code[ci++] = make_rreg(); - break; case TAG_x: - code[ci++] = make_xreg(tmp_op->a[arg].val); + code[ci++] = make_loader_x_reg(tmp_op->a[arg].val); break; case TAG_y: - code[ci++] = make_yreg(tmp_op->a[arg].val); + code[ci++] = make_loader_y_reg(tmp_op->a[arg].val); break; case TAG_i: code[ci++] = (BeamInstr) make_small((Uint)tmp_op->a[arg].val); @@ -2185,6 +2252,10 @@ load_code(LoaderState* stp) case TAG_n: code[ci++] = NIL; break; + case TAG_q: + new_literal_patch(stp, ci); + code[ci++] = tmp_op->a[arg].val; + break; default: LoadError1(stp, "bad tag %d for general source", tmp_op->a[arg].type); @@ -2193,14 +2264,11 @@ load_code(LoaderState* stp) break; case 'd': /* Destination (x(0), x(N), y(N) */ switch (tag) { - case TAG_r: - code[ci++] = make_rreg(); - break; case TAG_x: - code[ci++] = make_xreg(tmp_op->a[arg].val); + code[ci++] = tmp_op->a[arg].val * sizeof(Eterm); break; case TAG_y: - code[ci++] = make_yreg(tmp_op->a[arg].val); + code[ci++] = tmp_op->a[arg].val * sizeof(Eterm) + 1; break; default: LoadError1(stp, "bad tag %d for destination", @@ -2357,20 +2425,13 @@ load_code(LoaderState* stp) stp->labels[tmp_op->a[arg].val].patches = ci; ci++; break; - case TAG_r: - CodeNeed(1); - code[ci++] = (R_REG_DEF << _TAG_PRIMARY_SIZE) | - TAG_PRIMARY_HEADER; - break; case TAG_x: CodeNeed(1); - code[ci++] = (tmp_op->a[arg].val << _TAG_IMMED1_SIZE) | - (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER; + code[ci++] = make_loader_x_reg(tmp_op->a[arg].val); break; case TAG_y: CodeNeed(1); - code[ci++] = (tmp_op->a[arg].val << _TAG_IMMED1_SIZE) | - (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER; + code[ci++] = make_loader_y_reg(tmp_op->a[arg].val); break; case TAG_n: CodeNeed(1); @@ -2393,8 +2454,7 @@ load_code(LoaderState* stp) switch (stp->specific_op) { case op_i_func_info_IaaI: { - Uint offset; - + Sint offset; if (function_number >= stp->num_functions) { LoadError1(stp, "too many functions in module (header said %d)", stp->num_functions); @@ -2436,15 +2496,15 @@ load_code(LoaderState* stp) stp->arity = code[ci-1]; ASSERT(stp->labels[last_label].value == ci - FUNC_INFO_SZ); - offset = MI_FUNCTIONS + function_number; - code[offset] = stp->labels[last_label].patches; + stp->hdr->functions[function_number] = (BeamInstr*) stp->labels[last_label].patches; + offset = function_number; stp->labels[last_label].patches = offset; function_number++; if (stp->arity > MAX_ARG) { LoadError1(stp, "too many arguments: %d", stp->arity); } #ifdef DEBUG - ASSERT(stp->labels[0].patches == 0); /* Should not be referenced. */ + ASSERT(stp->labels[0].patches < 0); /* Should not be referenced. */ for (i = 1; i < stp->num_labels; i++) { ASSERT(stp->labels[i].patches < ci); } @@ -2458,7 +2518,6 @@ load_code(LoaderState* stp) stp->on_load = ci; break; case op_bs_put_string_II: - case op_i_bs_match_string_rfII: case op_i_bs_match_string_xfII: new_string_patch(stp, ci-1); break; @@ -2515,7 +2574,7 @@ load_code(LoaderState* stp) * End of code found. */ case op_int_code_end: - stp->code_buffer_size = code_buffer_size; + stp->codev_size = codev_size; stp->ci = ci; stp->function = THE_NON_VALUE; stp->genop = NULL; @@ -2530,7 +2589,10 @@ load_code(LoaderState* stp) { GenOp* next = stp->genop->next; FREE_GENOP(stp, stp->genop); - stp->genop = next; + if ((stp->genop = next) == NULL) { + last_op_next = &stp->genop; + goto get_next_instr; + } goto do_transform; } } @@ -2674,12 +2736,18 @@ mixed_types(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) } static int -same_label(LoaderState* stp, GenOpArg Target, GenOpArg Label) +is_killed_apply(LoaderState* stp, GenOpArg Reg, GenOpArg Live) { - return Target.type = TAG_f && Label.type == TAG_u && - Target.val == Label.val; + return Reg.type == TAG_x && Live.type == TAG_u && + Live.val+2 <= Reg.val; } +static int +is_killed(LoaderState* stp, GenOpArg Reg, GenOpArg Live) +{ + return Reg.type == TAG_x && Live.type == TAG_u && + Live.val <= Reg.val; +} /* * Generate an instruction for element/2. @@ -2696,17 +2764,17 @@ gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index, op->next = NULL; if (Index.type == TAG_i && Index.val > 0 && - (Tuple.type == TAG_r || Tuple.type == TAG_x || Tuple.type == TAG_y)) { + (Tuple.type == TAG_x || Tuple.type == TAG_y)) { op->op = genop_i_fast_element_4; - op->a[0] = Tuple; - op->a[1] = Fail; + op->a[0] = Fail; + op->a[1] = Tuple; op->a[2].type = TAG_u; op->a[2].val = Index.val; op->a[3] = Dst; } else { op->op = genop_i_element_4; - op->a[0] = Tuple; - op->a[1] = Fail; + op->a[0] = Fail; + op->a[1] = Tuple; op->a[2] = Index; op->a[3] = Dst; } @@ -2832,23 +2900,16 @@ gen_get_integer2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, goto generic; } } else { - GenOp* op2; - NEW_GENOP(stp, op2); - - op->op = genop_i_fetch_2; - op->arity = 2; - op->a[0] = Ms; - op->a[1] = Size; - op->next = op2; - - op2->op = genop_i_bs_get_integer_4; - op2->arity = 4; - op2->a[0] = Fail; - op2->a[1] = Live; - op2->a[2].type = TAG_u; - op2->a[2].val = (Unit.val << 3) | Flags.val; - op2->a[3] = Dst; - op2->next = NULL; + op->op = genop_i_bs_get_integer_6; + op->arity = 6; + op->a[0] = Fail; + op->a[1] = Live; + op->a[2].type = TAG_u; + op->a[2].val = (Unit.val << 3) | Flags.val; + op->a[3] = Ms; + op->a[4] = Size; + op->a[5] = Dst; + op->next = NULL; return op; } op->next = NULL; @@ -3272,14 +3333,14 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time) op->a[1].type = TAG_u; if (Time.type == TAG_i && (timeout = Time.val) >= 0 && -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) (timeout >> 32) == 0 #else 1 #endif ) { op->a[1].val = timeout; -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) } else if (Time.type == TAG_q) { Eterm big; @@ -3296,7 +3357,7 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time) } #endif } else { -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) error: #endif op->op = genop_i_wait_error_0; @@ -3319,14 +3380,14 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time) op->a[1].type = TAG_u; if (Time.type == TAG_i && (timeout = Time.val) >= 0 && -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) (timeout >> 32) == 0 #else 1 #endif ) { op->a[1].val = timeout; -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) } else if (Time.type == TAG_q) { Eterm big; @@ -3343,7 +3404,7 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time) } #endif } else { -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) error: #endif op->op = genop_i_wait_error_locked_0; @@ -3899,9 +3960,7 @@ gen_make_fun2(LoaderState* stp, GenOpArg idx) /* * Rewrite gc_bifs with one parameter (the common case). Utilized * in ops.tab to rewrite instructions calling bif's in guards - * to use a garbage collecting implementation. The instructions - * are sometimes once again rewritten to handle literals (putting the - * parameter in the mostly unused r[0] before the instruction is executed). + * to use a garbage collecting implementation. */ static GenOp* gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, @@ -3956,10 +4015,6 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, /* * This is used by the ops.tab rule that rewrites gc_bifs with two parameters. - * The instruction returned is then again rewritten to an i_load instruction - * followed by i_gc_bif2_jIId, to handle literals properly. - * As opposed to the i_gc_bif1_jIsId, the instruction i_gc_bif2_jIId is - * always rewritten, regardless of if there actually are any literals. */ static GenOp* gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, @@ -3986,23 +4041,19 @@ gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, op->a[2].val = stp->import[Bif.val].arity; return op; } - op->op = genop_ii_gc_bif2_6; + op->op = genop_i_gc_bif2_6; op->arity = 6; op->a[0] = Fail; op->a[1].type = TAG_u; - op->a[2] = S1; - op->a[3] = S2; - op->a[4] = Live; + op->a[2] = Live; + op->a[3] = S1; + op->a[4] = S2; op->a[5] = Dst; return op; } /* * This is used by the ops.tab rule that rewrites gc_bifs with three parameters. - * The instruction returned is then again rewritten to a move instruction that - * uses r[0] for temp storage, followed by an i_load instruction, - * followed by i_gc_bif3_jIsId, to handle literals properly. Rewriting - * always occur, as with the gc_bif2 counterpart. */ static GenOp* gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, @@ -4033,10 +4084,10 @@ gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, op->arity = 7; op->a[0] = Fail; op->a[1].type = TAG_u; - op->a[2] = S1; - op->a[3] = S2; - op->a[4] = S3; - op->a[5] = Live; + op->a[2] = Live; + op->a[3] = S1; + op->a[4] = S2; + op->a[5] = S3; op->a[6] = Dst; op->next = NULL; return op; @@ -4258,6 +4309,53 @@ gen_get_map_element(LoaderState* stp, GenOpArg Fail, GenOpArg Src, return op; } +static int +hash_internal_genop_arg(LoaderState* stp, GenOpArg Key, Uint32* hx) +{ + switch (Key.type) { + case TAG_a: + *hx = atom_tab(atom_val(Key.val))->slot.bucket.hvalue; + return 1; + case TAG_i: + *hx = Key.val; + return 1; + case TAG_n: + *hx = make_internal_hash(NIL); + return 1; + case TAG_q: + *hx = make_internal_hash(stp->literals[Key.val].term); + return 1; + default: + return 0; + } +} + + +static GenOp* +gen_get(LoaderState* stp, GenOpArg Src, GenOpArg Dst) +{ + GenOp* op; + Uint32 hx = 0; + + NEW_GENOP(stp, op); + op->next = NULL; + if (hash_internal_genop_arg(stp, Src, &hx)) { + op->arity = 3; + op->op = genop_i_get_hash_3; + op->a[0] = Src; + op->a[1].type = TAG_u; + op->a[1].val = (BeamInstr) hx; + op->a[2] = Dst; + } else { + op->arity = 2; + op->op = genop_i_get_2; + op->a[0] = Src; + op->a[1] = Dst; + } + return op; +} + + static GenOp* gen_get_map_elements(LoaderState* stp, GenOpArg Fail, GenOpArg Src, GenOpArg Size, GenOpArg* Rest) @@ -4323,7 +4421,7 @@ gen_has_map_fields(LoaderState* stp, GenOpArg Fail, GenOpArg Src, 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 */ + op->a[3+2*i+1].val = SCRATCH_X_REG; /* Ignore result */ } return op; } @@ -4336,8 +4434,8 @@ gen_has_map_fields(LoaderState* stp, GenOpArg Fail, GenOpArg Src, static int freeze_code(LoaderState* stp) { - BeamInstr* code = stp->code; - Uint *literal_end = NULL; + BeamCodeHeader* code_hdr = stp->hdr; + BeamInstr* codev = (BeamInstr*) &stp->hdr->functions; int i; byte* str_table; unsigned strtab_size = stp->chunks[STR_CHUNK].size; @@ -4362,77 +4460,76 @@ freeze_code(LoaderState* stp) if (stp->line_instr == 0) { line_size = 0; } else { - line_size = (MI_LINE_FUNC_TAB + (stp->num_functions + 1) + - (stp->current_li+1) + stp->num_fnames) * - sizeof(Eterm) + (stp->current_li+1) * stp->loc_size; + line_size = (offsetof(BeamCodeLineTab,func_tab) + + (stp->num_functions + 1) * sizeof(BeamInstr**) /* func_tab */ + + (stp->current_li + 1) * sizeof(BeamInstr*) /* line items */ + + stp->num_fnames * sizeof(Eterm) /* fname table */ + + (stp->current_li + 1) * stp->loc_size); /* loc_tab */ } - size = (stp->ci * sizeof(BeamInstr)) + - (stp->total_literal_size * sizeof(Eterm)) + + size = offsetof(BeamCodeHeader,functions) + (stp->ci * sizeof(BeamInstr)) + strtab_size + attr_size + compile_size + MD5_SIZE + line_size; /* * Move the code to its final location. */ - code = (BeamInstr *) erts_realloc(ERTS_ALC_T_CODE, (void *) code, size); - CHKBLK(ERTS_ALC_T_CODE,code); + code_hdr = (BeamCodeHeader*) erts_realloc(ERTS_ALC_T_CODE, (void *) code_hdr, size); + codev = (BeamInstr*) &code_hdr->functions; + CHKBLK(ERTS_ALC_T_CODE,code_hdr); /* * Place a pointer to the op_int_code_end instruction in the * function table in the beginning of the file. */ - code[MI_FUNCTIONS+stp->num_functions] = (BeamInstr) (code + stp->ci - 1); - CHKBLK(ERTS_ALC_T_CODE,code); + code_hdr->functions[stp->num_functions] = (codev + stp->ci - 1); + CHKBLK(ERTS_ALC_T_CODE,code_hdr); /* * Store the pointer to the on_load function. */ if (stp->on_load) { - code[MI_ON_LOAD_FUNCTION_PTR] = (BeamInstr) (code + stp->on_load); + code_hdr->on_load_function_ptr = codev + stp->on_load; } else { - code[MI_ON_LOAD_FUNCTION_PTR] = 0; + code_hdr->on_load_function_ptr = NULL; } - CHKBLK(ERTS_ALC_T_CODE,code); + CHKBLK(ERTS_ALC_T_CODE,code_hdr); - literal_end = (Uint *) (code+stp->ci); /* - * Place the literal heap directly after the code and fix up all - * instructions that refer to it. + * Place the literals in their own allocated heap (for fast range check) + * and fix up all instructions that refer to it. */ { - Uint* ptr; - Uint* low; - Uint* high; + Eterm* ptr; LiteralPatch* lp; ErlOffHeap code_off_heap; ERTS_INIT_OFF_HEAP(&code_off_heap); - low = (Uint *) (code+stp->ci); - high = low + stp->total_literal_size; - code[MI_LITERALS_START] = (BeamInstr) low; - code[MI_LITERALS_END] = (BeamInstr) high; - ptr = low; + ptr = (Eterm*)erts_alloc(ERTS_ALC_T_LITERAL, + stp->total_literal_size*sizeof(Eterm)); + code_hdr->literals_start = ptr; + code_hdr->literals_end = ptr + stp->total_literal_size; for (i = 0; i < stp->num_literals; i++) { - if (stp->literals[i].heap_frags) { - move_multi_frags(&ptr, &code_off_heap, stp->literals[i].heap_frags, - &stp->literals[i].term, 1); + if (is_not_immed(stp->literals[i].term)) { + erts_move_multi_frags(&ptr, &code_off_heap, + stp->literals[i].heap_frags, + &stp->literals[i].term, 1, 1); + ASSERT(erts_is_literal(stp->literals[i].term, + ptr_val(stp->literals[i].term))); } - else ASSERT(is_immed(stp->literals[i].term)); } - code[MI_LITERALS_OFF_HEAP] = (BeamInstr) code_off_heap.first; + code_hdr->literals_off_heap = code_off_heap.first; lp = stp->literal_patches; while (lp != 0) { BeamInstr* op_ptr; Literal* lit; - op_ptr = code + lp->pos; + op_ptr = codev + lp->pos; lit = &stp->literals[op_ptr[0]]; op_ptr[0] = lit->term; lp = lp->next; } - literal_end += stp->total_literal_size; } CHKBLK(ERTS_ALC_T_CODE,code); @@ -4440,52 +4537,49 @@ freeze_code(LoaderState* stp) * If there is line information, place it here. */ if (stp->line_instr == 0) { - code[MI_LINE_TABLE] = (BeamInstr) 0; - str_table = (byte *) literal_end; + code_hdr->line_table = NULL; + str_table = (byte *) (codev + stp->ci); } else { - Eterm* line_tab = (Eterm *) literal_end; - Eterm* p; - int ftab_size = stp->num_functions; - int num_instrs = stp->current_li; - Eterm* first_line_item; + BeamCodeLineTab* const line_tab = (BeamCodeLineTab *) (codev+stp->ci); + const int ftab_size = stp->num_functions; + const int num_instrs = stp->current_li; + const BeamInstr** const line_items = + (const BeamInstr**) &line_tab->func_tab[ftab_size + 1]; - code[MI_LINE_TABLE] = (BeamInstr) line_tab; - p = line_tab + MI_LINE_FUNC_TAB; + code_hdr->line_table = line_tab; - first_line_item = (p + ftab_size + 1); for (i = 0; i < ftab_size; i++) { - *p++ = (Eterm) (BeamInstr) (first_line_item + stp->func_line[i]); + line_tab->func_tab[i] = line_items + stp->func_line[i]; } - *p++ = (Eterm) (BeamInstr) (first_line_item + num_instrs); - ASSERT(p == first_line_item); + line_tab->func_tab[i] = line_items + num_instrs; + for (i = 0; i < num_instrs; i++) { - *p++ = (Eterm) (BeamInstr) (code + stp->line_instr[i].pos); + line_items[i] = codev + stp->line_instr[i].pos; } - *p++ = (Eterm) (BeamInstr) (code + stp->ci - 1); + line_items[i] = codev + stp->ci - 1; - line_tab[MI_LINE_FNAME_PTR] = (Eterm) (BeamInstr) p; - memcpy(p, stp->fname, stp->num_fnames*sizeof(Eterm)); - p += stp->num_fnames; + line_tab->fname_ptr = (Eterm*) &line_items[i + 1]; + memcpy(line_tab->fname_ptr, stp->fname, stp->num_fnames*sizeof(Eterm)); - line_tab[MI_LINE_LOC_TAB] = (Eterm) (BeamInstr) p; - line_tab[MI_LINE_LOC_SIZE] = stp->loc_size; + line_tab->loc_size = stp->loc_size; if (stp->loc_size == 2) { - Uint16* locp = (Uint16 *) p; - for (i = 0; i < num_instrs; i++) { + Uint16* locp = (Uint16 *) &line_tab->fname_ptr[stp->num_fnames]; + line_tab->loc_tab.p2 = locp; + for (i = 0; i < num_instrs; i++) { *locp++ = (Uint16) stp->line_instr[i].loc; - } - *locp++ = LINE_INVALID_LOCATION; - str_table = (byte *) locp; + } + *locp++ = LINE_INVALID_LOCATION; + str_table = (byte *) locp; } else { - Uint32* locp = (Uint32 *) p; - ASSERT(stp->loc_size == 4); + Uint32* locp = (Uint32 *) &line_tab->fname_ptr[stp->num_fnames]; + ASSERT(stp->loc_size == 4); + line_tab->loc_tab.p4 = locp; for (i = 0; i < num_instrs; i++) { *locp++ = stp->line_instr[i].loc; } *locp++ = LINE_INVALID_LOCATION; - str_table = (byte *) locp; + str_table = (byte *) locp; } - CHKBLK(ERTS_ALC_T_CODE,code); } @@ -4497,13 +4591,13 @@ freeze_code(LoaderState* stp) if (attr_size) { byte* attr = str_table + strtab_size; sys_memcpy(attr, stp->chunks[ATTR_CHUNK].start, stp->chunks[ATTR_CHUNK].size); - code[MI_ATTR_PTR] = (BeamInstr) attr; - code[MI_ATTR_SIZE] = (BeamInstr) stp->chunks[ATTR_CHUNK].size; + code_hdr->attr_ptr = attr; + code_hdr->attr_size = (BeamInstr) stp->chunks[ATTR_CHUNK].size; decoded_size = erts_decode_ext_size(attr, attr_size); if (decoded_size < 0) { LoadError0(stp, "bad external term representation of module attributes"); } - code[MI_ATTR_SIZE_ON_HEAP] = decoded_size; + code_hdr->attr_size_on_heap = decoded_size; } CHKBLK(ERTS_ALC_T_CODE,code); if (compile_size) { @@ -4513,9 +4607,9 @@ freeze_code(LoaderState* stp) stp->chunks[COMPILE_CHUNK].size); CHKBLK(ERTS_ALC_T_CODE,code); - code[MI_COMPILE_PTR] = (BeamInstr) compile_info; + code_hdr->compile_ptr = compile_info; CHKBLK(ERTS_ALC_T_CODE,code); - code[MI_COMPILE_SIZE] = (BeamInstr) stp->chunks[COMPILE_CHUNK].size; + code_hdr->compile_size = (BeamInstr) stp->chunks[COMPILE_CHUNK].size; CHKBLK(ERTS_ALC_T_CODE,code); decoded_size = erts_decode_ext_size(compile_info, compile_size); CHKBLK(ERTS_ALC_T_CODE,code); @@ -4523,7 +4617,7 @@ freeze_code(LoaderState* stp) LoadError0(stp, "bad external term representation of compilation information"); } CHKBLK(ERTS_ALC_T_CODE,code); - code[MI_COMPILE_SIZE_ON_HEAP] = decoded_size; + code_hdr->compile_size_on_heap = decoded_size; } CHKBLK(ERTS_ALC_T_CODE,code); { @@ -4531,7 +4625,7 @@ freeze_code(LoaderState* stp) 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; + code_hdr->md5_ptr = md5_sum; CHKBLK(ERTS_ALC_T_CODE,code); } CHKBLK(ERTS_ALC_T_CODE,code); @@ -4540,7 +4634,7 @@ freeze_code(LoaderState* stp) * Make sure that we have not overflowed the allocated code space. */ ASSERT(str_table + strtab_size + attr_size + compile_size + MD5_SIZE == - ((byte *) code) + size); + ((byte *) code_hdr) + size); /* * Patch all instructions that refer to the string table. @@ -4552,46 +4646,47 @@ freeze_code(LoaderState* stp) BeamInstr* op_ptr; byte* strp; - op_ptr = code + sp->pos; + op_ptr = codev + sp->pos; strp = str_table + op_ptr[0]; op_ptr[0] = (BeamInstr) strp; sp = sp->next; } } - CHKBLK(ERTS_ALC_T_CODE,code); + CHKBLK(ERTS_ALC_T_CODE,code_hdr); /* * Resolve all labels. */ for (i = 0; i < stp->num_labels; i++) { - Uint this_patch; - Uint next_patch; + Sint this_patch; + Sint next_patch; Uint value = stp->labels[i].value; - if (value == 0 && stp->labels[i].patches != 0) { + if (value == 0 && stp->labels[i].patches >= 0) { LoadError1(stp, "label %d not resolved", i); } ASSERT(value < stp->ci); this_patch = stp->labels[i].patches; - while (this_patch != 0) { + while (this_patch >= 0) { ASSERT(this_patch < stp->ci); - next_patch = code[this_patch]; + next_patch = codev[this_patch]; ASSERT(next_patch < stp->ci); - code[this_patch] = (BeamInstr) (code + value); + codev[this_patch] = (BeamInstr) (codev + value); this_patch = next_patch; } } - CHKBLK(ERTS_ALC_T_CODE,code); + CHKBLK(ERTS_ALC_T_CODE,code_hdr); /* * Save the updated code pointer and code size. */ - stp->code = code; + stp->hdr = code_hdr; + stp->codev = codev; stp->loaded_size = size; - CHKBLK(ERTS_ALC_T_CODE,code); + CHKBLK(ERTS_ALC_T_CODE,code_hdr); return 1; load_error: @@ -4599,7 +4694,8 @@ freeze_code(LoaderState* stp) * Make sure that the caller frees the newly reallocated block, and * not the old one (in case it has moved). */ - stp->code = code; + stp->hdr = code_hdr; + stp->codev = codev; return 0; } @@ -4610,7 +4706,7 @@ final_touch(LoaderState* stp) int on_load = stp->on_load; unsigned catches; Uint index; - BeamInstr* code = stp->code; + BeamInstr* codev = stp->codev; Module* modp; /* @@ -4620,10 +4716,10 @@ final_touch(LoaderState* stp) index = stp->catches; catches = BEAM_CATCHES_NIL; while (index != 0) { - BeamInstr next = code[index]; - code[index] = BeamOpCode(op_catch_yf); - catches = beam_catches_cons((BeamInstr *)code[index+2], catches); - code[index+2] = make_catch(catches); + BeamInstr next = codev[index]; + codev[index] = BeamOpCode(op_catch_yf); + catches = beam_catches_cons((BeamInstr *)codev[index+2], catches); + codev[index+2] = make_catch(catches); index = next; } modp = erts_put_module(stp->module); @@ -4674,8 +4770,8 @@ final_touch(LoaderState* stp) current = stp->import[i].patches; while (current != 0) { ASSERT(current < stp->ci); - next = stp->code[current]; - stp->code[current] = import; + next = stp->codev[current]; + stp->codev[current] = import; current = next; } } @@ -4688,7 +4784,7 @@ final_touch(LoaderState* stp) for (i = 0; i < stp->num_lambdas; i++) { unsigned entry_label = stp->lambdas[i].label; ErlFunEntry* fe = stp->lambdas[i].fe; - BeamInstr* code_ptr = (BeamInstr *) (stp->code + stp->labels[entry_label].value); + BeamInstr* code_ptr = stp->codev + stp->labels[entry_label].value; if (fe->address[0] != 0) { /* @@ -4710,31 +4806,25 @@ transform_engine(LoaderState* st) Uint op; int ap; /* Current argument. */ Uint* restart; /* Where to restart if current match fails. */ - GenOpArg def_vars[TE_MAX_VARS]; /* Default buffer for variables. */ - GenOpArg* var = def_vars; - int num_vars = 0; + GenOpArg var[TE_MAX_VARS]; /* Buffer for variables. */ + GenOpArg* rest_args = NULL; + int num_rest_args = 0; int i; /* General index. */ Uint mask; GenOp* instr; + GenOp* first = st->genop; + GenOp* keep = NULL; Uint* pc; - int rval; static Uint restart_fail[1] = {TOP_fail}; - ASSERT(gen_opc[st->genop->op].transform != -1); - pc = op_transform + gen_opc[st->genop->op].transform; - restart = pc; + ASSERT(gen_opc[first->op].transform != -1); + restart = op_transform + gen_opc[first->op].transform; restart: - if (var != def_vars) { - erts_free(ERTS_ALC_T_LOADER_TMP, (void *) var); - var = def_vars; - } ASSERT(restart != NULL); pc = restart; ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ - instr = st->genop; - -#define RETURN(r) rval = (r); goto do_return; + instr = first; #ifdef DEBUG restart = NULL; @@ -4752,7 +4842,7 @@ transform_engine(LoaderState* st) * We'll need at least one more instruction to decide whether * this combination matches or not. */ - RETURN(TE_SHORT_WINDOW); + return TE_SHORT_WINDOW; } if (*pc++ != instr->op) goto restart; @@ -4801,7 +4891,8 @@ transform_engine(LoaderState* st) if (var[i].type != instr->a[ap].type) goto restart; switch (var[i].type) { - case TAG_r: case TAG_n: break; + case TAG_n: + break; default: if (var[i].val != instr->a[ap].val) goto restart; @@ -4913,19 +5004,9 @@ transform_engine(LoaderState* st) #if defined(TOP_rest_args) case TOP_rest_args: { - int n = *pc++; int formal_arity = gen_opc[instr->op].arity; - int j = formal_arity; - - num_vars = n + (instr->arity - formal_arity); - var = erts_alloc(ERTS_ALC_T_LOADER_TMP, - num_vars * sizeof(GenOpArg)); - for (i = 0; i < n; i++) { - var[i] = def_vars[i]; - } - while (i < num_vars) { - var[i++] = instr->a[j++]; - } + num_rest_args = instr->arity - formal_arity; + rest_args = instr->a + formal_arity; } break; #endif @@ -4934,21 +5015,22 @@ transform_engine(LoaderState* st) break; case TOP_commit: instr = instr->next; /* The next_instr was optimized away. */ - - /* - * The left-hand side of this transformation matched. - * Delete all matched instructions. - */ - while (st->genop != instr) { - GenOp* next = st->genop->next; - FREE_GENOP(st, st->genop); - st->genop = next; - } + keep = instr; + st->genop = instr; #ifdef DEBUG instr = 0; #endif break; - +#if defined(TOP_keep) + case TOP_keep: + /* Keep the current instruction unchanged. */ + keep = instr; + st->genop = instr; +#ifdef DEBUG + instr = 0; +#endif + break; +#endif #if defined(TOP_call_end) case TOP_call_end: { @@ -4973,22 +5055,19 @@ transform_engine(LoaderState* st) lastp = &((*lastp)->next); } - instr = instr->next; /* The next_instr was optimized away. */ - - /* - * The left-hand side of this transformation matched. - * Delete all matched instructions. - */ - while (st->genop != instr) { - GenOp* next = st->genop->next; - FREE_GENOP(st, st->genop); - st->genop = next; - } - *lastp = st->genop; + keep = instr->next; /* The next_instr was optimized away. */ + *lastp = keep; st->genop = new_instr; } - RETURN(TE_OK); + /* FALLTHROUGH */ #endif + case TOP_end: + while (first != keep) { + GenOp* next = first->next; + FREE_GENOP(st, first); + first = next; + } + return TE_OK; case TOP_new_instr: /* * Note that the instructions are generated in reverse order. @@ -5000,6 +5079,12 @@ transform_engine(LoaderState* st) instr->arity = gen_opc[op].arity; ap = 0; break; +#ifdef TOP_rename + case TOP_rename: + instr->op = op = *pc++; + instr->arity = gen_opc[op].arity; + return TE_OK; +#endif case TOP_store_type: i = *pc++; instr->a[ap].type = i; @@ -5019,14 +5104,10 @@ transform_engine(LoaderState* st) #if defined(TOP_store_rest_args) case TOP_store_rest_args: { - int n = *pc++; - int num_extra = num_vars - n; - - ASSERT(n <= num_vars); - GENOP_ARITY(instr, instr->arity+num_extra); + GENOP_ARITY(instr, instr->arity+num_rest_args); memcpy(instr->a, instr->def_args, ap*sizeof(GenOpArg)); - memcpy(instr->a+ap, var+n, num_extra*sizeof(GenOpArg)); - ap += num_extra; + memcpy(instr->a+ap, rest_args, num_rest_args*sizeof(GenOpArg)); + ap += num_rest_args; } break; #endif @@ -5038,21 +5119,12 @@ transform_engine(LoaderState* st) case TOP_try_me_else_fail: restart = restart_fail; break; - case TOP_end: - RETURN(TE_OK); case TOP_fail: - RETURN(TE_FAIL); + return TE_FAIL; default: ASSERT(0); } } -#undef RETURN - - do_return: - if (var != def_vars) { - erts_free(ERTS_ALC_T_LOADER_TMP, (void *) var); - } - return rval; } static void @@ -5311,7 +5383,7 @@ new_label(LoaderState* stp) (void *) stp->labels, stp->num_labels * sizeof(Label)); stp->labels[num].value = 0; - stp->labels[num].patches = 0; + stp->labels[num].patches = -1; return num; } @@ -5371,7 +5443,7 @@ erts_module_info_0(Process* p, Eterm module) { Module* modp; ErtsCodeIndex code_ix = erts_active_code_ix(); - BeamInstr* code; + BeamCodeHeader* code_hdr; Eterm *hp; Eterm list = NIL; Eterm tup; @@ -5385,13 +5457,13 @@ erts_module_info_0(Process* p, Eterm module) return THE_NON_VALUE; } - code = modp->curr.code; - if (code == NULL) { + code_hdr = modp->curr.code_hdr; + if (code_hdr == NULL) { return THE_NON_VALUE; } #define BUILD_INFO(What) \ - tup = get_module_info(p, code_ix, code, module, What); \ + tup = get_module_info(p, code_ix, code_hdr, module, What); \ hp = HAlloc(p, 5); \ tup = TUPLE2(hp, What, tup); \ hp += 3; \ @@ -5414,7 +5486,7 @@ erts_module_info_1(Process* p, Eterm module, Eterm what) { Module* modp; ErtsCodeIndex code_ix = erts_active_code_ix(); - BeamInstr* code; + BeamCodeHeader* code_hdr; if (is_not_atom(module)) { return THE_NON_VALUE; @@ -5425,34 +5497,34 @@ erts_module_info_1(Process* p, Eterm module, Eterm what) return THE_NON_VALUE; } - code = modp->curr.code; - if (code == NULL) { + code_hdr = modp->curr.code_hdr; + if (code_hdr == NULL) { return THE_NON_VALUE; } - return get_module_info(p, code_ix, code, module, what); + return get_module_info(p, code_ix, code_hdr, module, what); } static Eterm -get_module_info(Process* p, ErtsCodeIndex code_ix, BeamInstr* code, +get_module_info(Process* p, ErtsCodeIndex code_ix, BeamCodeHeader* code_hdr, Eterm module, Eterm what) { if (what == am_module) { return module; } else if (what == am_md5) { - return md5_of_module(p, code); + return md5_of_module(p, code_hdr); } else if (what == am_exports) { return exported_from_module(p, code_ix, module); } else if (what == am_functions) { - return functions_in_module(p, code); + return functions_in_module(p, code_hdr); } else if (what == am_attributes) { - return attributes_for_module(p, code); + return attributes_for_module(p, code_hdr); } else if (what == am_compile) { - return compilation_info_for_module(p, code); + return compilation_info_for_module(p, code_hdr); } else if (what == am_native_addresses) { - return native_addresses(p, code); + return native_addresses(p, code_hdr); } else if (what == am_native) { - return has_native(code); + return has_native(code_hdr); } return THE_NON_VALUE; } @@ -5464,7 +5536,7 @@ get_module_info(Process* p, ErtsCodeIndex code_ix, BeamInstr* code, Eterm functions_in_module(Process* p, /* Process whose heap to use. */ - BeamInstr* code) + BeamCodeHeader* code_hdr) { int i; Uint num_functions; @@ -5473,12 +5545,12 @@ functions_in_module(Process* p, /* Process whose heap to use. */ Eterm* hp_end; Eterm result = NIL; - num_functions = code[MI_NUM_FUNCTIONS]; + num_functions = code_hdr->num_functions; need = 5*num_functions; hp = HAlloc(p, need); hp_end = hp + need; for (i = num_functions-1; i >= 0 ; i--) { - BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i]; + BeamInstr* func_info = code_hdr->functions[i]; Eterm name = (Eterm) func_info[3]; int arity = (int) func_info[4]; Eterm tuple; @@ -5504,11 +5576,11 @@ functions_in_module(Process* p, /* Process whose heap to use. */ */ static Eterm -has_native(BeamInstr *code) +has_native(BeamCodeHeader *code_hdr) { Eterm result = am_false; #ifdef HIPE - if (erts_is_module_native(code)) { + if (erts_is_module_native(code_hdr)) { result = am_true; } #endif @@ -5516,15 +5588,15 @@ has_native(BeamInstr *code) } int -erts_is_module_native(BeamInstr* code) +erts_is_module_native(BeamCodeHeader* code_hdr) { Uint i, num_functions; /* Check NativeAdress of first real function in module */ - if (code != NULL) { - num_functions = code[MI_NUM_FUNCTIONS]; + if (code_hdr != NULL) { + num_functions = code_hdr->num_functions; for (i=0; i<num_functions; i++) { - BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i]; + BeamInstr* func_info = (BeamInstr *) code_hdr->functions[i]; Eterm name = (Eterm) func_info[3]; if (is_atom(name)) { return func_info[1] != 0; @@ -5541,7 +5613,7 @@ erts_is_module_native(BeamInstr* code) */ static Eterm -native_addresses(Process* p, BeamInstr* code) +native_addresses(Process* p, BeamCodeHeader* code_hdr) { int i; Eterm* hp; @@ -5550,12 +5622,12 @@ native_addresses(Process* p, BeamInstr* code) Eterm* hp_end; Eterm result = NIL; - num_functions = code[MI_NUM_FUNCTIONS]; + num_functions = code_hdr->num_functions; need = (6+BIG_UINT_HEAP_SIZE)*num_functions; hp = HAlloc(p, need); hp_end = hp + need; for (i = num_functions-1; i >= 0 ; i--) { - BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i]; + BeamInstr* func_info = code_hdr->functions[i]; Eterm name = (Eterm) func_info[3]; int arity = (int) func_info[4]; Eterm tuple; @@ -5621,16 +5693,16 @@ exported_from_module(Process* p, /* Process whose heap to use. */ Eterm attributes_for_module(Process* p, /* Process whose heap to use. */ - BeamInstr* code) + BeamCodeHeader* code_hdr) { byte* ext; Eterm result = NIL; - ext = (byte *) code[MI_ATTR_PTR]; + ext = code_hdr->attr_ptr; if (ext != NULL) { ErtsHeapFactory factory; - erts_factory_proc_prealloc_init(&factory, p, code[MI_ATTR_SIZE_ON_HEAP]); - result = erts_decode_ext(&factory, &ext); + erts_factory_proc_prealloc_init(&factory, p, code_hdr->attr_size_on_heap); + result = erts_decode_ext(&factory, &ext, 0); if (is_value(result)) { erts_factory_close(&factory); } @@ -5644,16 +5716,16 @@ attributes_for_module(Process* p, /* Process whose heap to use. */ Eterm compilation_info_for_module(Process* p, /* Process whose heap to use. */ - BeamInstr* code) + BeamCodeHeader* code_hdr) { byte* ext; Eterm result = NIL; - ext = (byte *) code[MI_COMPILE_PTR]; + ext = code_hdr->compile_ptr; if (ext != NULL) { ErtsHeapFactory factory; - erts_factory_proc_prealloc_init(&factory, p, code[MI_COMPILE_SIZE_ON_HEAP]); - result = erts_decode_ext(&factory, &ext); + erts_factory_proc_prealloc_init(&factory, p, code_hdr->compile_size_on_heap); + result = erts_decode_ext(&factory, &ext, 0); if (is_value(result)) { erts_factory_close(&factory); } @@ -5667,9 +5739,9 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */ Eterm md5_of_module(Process* p, /* Process whose heap to use. */ - BeamInstr* code) + BeamCodeHeader* code_hdr) { - return new_binary(p, (byte *) code[MI_MD5_PTR], MD5_SIZE); + return new_binary(p, code_hdr->md5_ptr, MD5_SIZE); } /* @@ -5868,7 +5940,7 @@ make_stub(BeamInstr* fp, Eterm mod, Eterm func, Uint arity, Uint native, BeamIns fp[4] = arity; #ifdef HIPE if (native) { - fp[5] = BeamOpCode(op_move_return_nr); + fp[5] = BeamOpCode(op_move_return_n); hipe_mfa_save_orig_beam_op(mod, func, arity, fp+5); } #endif @@ -5880,7 +5952,7 @@ static byte* stub_copy_info(LoaderState* stp, int chunk, /* Chunk: ATTR_CHUNK or COMPILE_CHUNK */ byte* info, /* Where to store info. */ - BeamInstr* ptr_word, /* Where to store pointer into info. */ + byte** ptr_word, /* Where to store pointer into info. */ BeamInstr* size_word, /* Where to store size into info. */ BeamInstr* size_on_heap_word) /* Where to store size on heap. */ { @@ -5888,7 +5960,7 @@ stub_copy_info(LoaderState* stp, Uint size = stp->chunks[chunk].size; if (size != 0) { memcpy(info, stp->chunks[chunk].start, size); - *ptr_word = (BeamInstr) info; + *ptr_word = info; decoded_size = erts_decode_ext_size(info, size); if (decoded_size < 0) { return 0; @@ -6143,15 +6215,14 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) BeamInstr Patchlist; Eterm MD5Bin; Eterm* tp; - BeamInstr* code = NULL; - BeamInstr* ptrs; + BeamCodeHeader* code_hdr; + BeamInstr* code_base; BeamInstr* fp; byte* info; - Uint ci; - int n; + Sint n; int code_size; int rval; - int i; + Sint i; byte* temp_alloc = NULL; byte* bytes; Uint size; @@ -6225,40 +6296,40 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) * Allocate memory for the stub module. */ - 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) { + code_size = (offsetof(BeamCodeHeader,functions) + + ((n+1) * sizeof(BeamInstr*)) + + (WORDS_PER_FUNCTION*n + 1) * sizeof(BeamInstr) + + stp->chunks[ATTR_CHUNK].size + + stp->chunks[COMPILE_CHUNK].size + + MD5_SIZE); + code_hdr = erts_alloc_fnf(ERTS_ALC_T_CODE, code_size); + if (!code_hdr) { goto error; } /* - * Initialize code area. + * Initialize code header. */ - code[MI_NUM_FUNCTIONS] = n; - code[MI_ATTR_PTR] = 0; - code[MI_ATTR_SIZE] = 0; - code[MI_ATTR_SIZE_ON_HEAP] = 0; - code[MI_COMPILE_PTR] = 0; - code[MI_COMPILE_SIZE] = 0; - code[MI_COMPILE_SIZE_ON_HEAP] = 0; - code[MI_LITERALS_START] = 0; - code[MI_LITERALS_END] = 0; - code[MI_LITERALS_OFF_HEAP] = 0; - code[MI_ON_LOAD_FUNCTION_PTR] = 0; - code[MI_LINE_TABLE] = 0; - code[MI_MD5_PTR] = 0; - ci = MI_FUNCTIONS + n + 1; + code_hdr->num_functions = n; + code_hdr->attr_ptr = NULL; + code_hdr->attr_size = 0; + code_hdr->attr_size_on_heap = 0; + code_hdr->compile_ptr = NULL; + code_hdr->compile_size = 0; + code_hdr->compile_size_on_heap = 0; + code_hdr->literals_start = NULL; + code_hdr->literals_end = NULL; + code_hdr->literals_off_heap = 0; + code_hdr->on_load_function_ptr = NULL; + code_hdr->line_table = NULL; + code_hdr->md5_ptr = NULL; /* * Make stubs for all functions. */ - ptrs = code + MI_FUNCTIONS; - fp = code + ci; + fp = code_base = (BeamInstr*) &code_hdr->functions[n+1]; for (i = 0; i < n; i++) { Eterm* listp; Eterm tuple; @@ -6301,11 +6372,11 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) * Set the pointer and make the stub. Put a return instruction * as the body until we know what kind of trap we should put there. */ - ptrs[i] = (BeamInstr) fp; + code_hdr->functions[i] = fp; #ifdef HIPE op = (Eterm) BeamOpCode(op_hipe_trap_call); /* Might be changed later. */ #else - op = (Eterm) BeamOpCode(op_move_return_nr); + op = (Eterm) BeamOpCode(op_move_return_n); #endif fp = make_stub(fp, Mod, func, arity, (Uint)native_address, op); } @@ -6314,7 +6385,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) * Insert the last pointer and the int_code_end instruction. */ - ptrs[i] = (BeamInstr) fp; + code_hdr->functions[i] = fp; *fp++ = (BeamInstr) BeamOp(op_int_code_end); /* @@ -6323,16 +6394,16 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) info = (byte *) fp; info = stub_copy_info(stp, ATTR_CHUNK, info, - code+MI_ATTR_PTR, - code+MI_ATTR_SIZE, - code+MI_ATTR_SIZE_ON_HEAP); + &code_hdr->attr_ptr, + &code_hdr->attr_size, + &code_hdr->attr_size_on_heap); if (info == NULL) { goto error; } info = stub_copy_info(stp, COMPILE_CHUNK, info, - code+MI_COMPILE_PTR, - code+MI_COMPILE_SIZE, - code+MI_COMPILE_SIZE_ON_HEAP); + &code_hdr->compile_ptr, + &code_hdr->compile_size, + &code_hdr->compile_size_on_heap); if (info == NULL) { goto error; } @@ -6341,7 +6412,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) 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; + code_hdr->md5_ptr = info; } erts_free_aligned_binary_bytes(tmp); } @@ -6350,7 +6421,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) * Insert the module in the module table. */ - rval = insert_new_code(p, 0, p->group_leader, Mod, code, code_size); + rval = insert_new_code(p, 0, p->group_leader, Mod, code_hdr, code_size); if (rval != NIL) { goto error; } @@ -6359,7 +6430,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) * Export all stub functions and insert the correct type of HiPE trap. */ - fp = code + ci; + fp = code_base; for (i = 0; i < n; i++) { stub_final_touch(stp, fp); fp += WORDS_PER_FUNCTION; diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h index d5af634fad..fd2dd97fee 100644 --- a/erts/emulator/beam/beam_load.h +++ b/erts/emulator/beam/beam_load.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2013. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -24,7 +24,6 @@ #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); @@ -34,7 +33,6 @@ typedef struct gen_op_entry { int specific; int num_specific; int transform; - int min_window; } GenOpEntry; extern GenOpEntry gen_opc[]; @@ -52,6 +50,7 @@ extern BeamInstr* em_call_error_handler; extern BeamInstr* em_apply_bif; extern BeamInstr* em_call_nif; + /* * The following variables keep a sorted list of address ranges for * each module. It allows us to quickly find a function given an @@ -60,72 +59,81 @@ extern BeamInstr* em_call_nif; /* Total code size in bytes */ extern Uint erts_total_code_size; -/* - * Index into start of code chunks which contains additional information - * about the loaded module. - * - * First number of functions. - */ -#define MI_NUM_FUNCTIONS 0 +typedef struct BeamCodeLineTab_ BeamCodeLineTab; /* - * The attributes retrieved by Mod:module_info(attributes). - */ - -#define MI_ATTR_PTR 1 -#define MI_ATTR_SIZE 2 -#define MI_ATTR_SIZE_ON_HEAP 3 - -/* - * The compilation information retrieved by Mod:module_info(compile). - */ - -#define MI_COMPILE_PTR 4 -#define MI_COMPILE_SIZE 5 -#define MI_COMPILE_SIZE_ON_HEAP 6 - -/* - * Literal area (constant pool). - */ -#define MI_LITERALS_START 7 -#define MI_LITERALS_END 8 -#define MI_LITERALS_OFF_HEAP 9 - -/* - * Pointer to the on_load function (or NULL if none). - */ -#define MI_ON_LOAD_FUNCTION_PTR 10 - -/* - * Pointer to the line table (or NULL if none). - */ -#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. - * - * The actual loaded code (for the first function) start just beyond - * this table. + * Header of code chunks which contains additional information + * about the loaded module. */ - -#define MI_FUNCTIONS 13 +typedef struct beam_code_header { + /* + * Number of functions. + */ + UWord num_functions; + + /* + * The attributes retrieved by Mod:module_info(attributes). + */ + byte* attr_ptr; + UWord attr_size; + UWord attr_size_on_heap; + + /* + * The compilation information retrieved by Mod:module_info(compile). + */ + byte* compile_ptr; + UWord compile_size; + UWord compile_size_on_heap; + + /* + * Literal area (constant pool). + */ + Eterm* literals_start; + Eterm* literals_end; + struct erl_off_heap_header* literals_off_heap; + + /* + * Pointer to the on_load function (or NULL if none). + */ + BeamInstr* on_load_function_ptr; + + /* + * Pointer to the line table (or NULL if none). + */ + BeamCodeLineTab* line_table; + + /* + * Pointer to the module MD5 sum (16 bytes) + */ + byte* md5_ptr; + + /* + * 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. + * + * The actual loaded code (for the first function) start just beyond + * this table. + */ + BeamInstr* functions[1]; + +}BeamCodeHeader; + +int erts_is_module_native(BeamCodeHeader* code); /* * Layout of the line table. */ - -#define MI_LINE_FNAME_PTR 0 -#define MI_LINE_LOC_TAB 1 -#define MI_LINE_LOC_SIZE 2 -#define MI_LINE_FUNC_TAB 3 +struct BeamCodeLineTab_ { + Eterm* fname_ptr; + int loc_size; + union { + Uint16* p2; + Uint32* p4; + }loc_tab; + const BeamInstr** func_tab[1]; +}; #define LINE_INVALID_LOCATION (0) diff --git a/erts/emulator/beam/beam_ranges.c b/erts/emulator/beam/beam_ranges.c index 19079ba150..55342a38c6 100644 --- a/erts/emulator/beam/beam_ranges.c +++ b/erts/emulator/beam/beam_ranges.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012. All Rights Reserved. + * Copyright Ericsson AB 2012-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -37,8 +37,8 @@ typedef struct { #define RANGE_END(R) ((BeamInstr*)erts_smp_atomic_read_nob(&(R)->end)) static Range* find_range(BeamInstr* pc); -static void lookup_loc(FunctionInfo* fi, BeamInstr* pc, - BeamInstr* modp, int idx); +static void lookup_loc(FunctionInfo* fi, const BeamInstr* pc, + BeamCodeHeader*, int idx); /* * The following variables keep a sorted list of address ranges for @@ -53,6 +53,7 @@ struct ranges { }; static struct ranges r[ERTS_NUM_CODE_IX]; static erts_smp_atomic_t mem_used; +static Range* write_ptr; #ifdef HARD_DEBUG static void check_consistency(struct ranges* p) @@ -72,6 +73,17 @@ static void check_consistency(struct ranges* p) # define CHECK(r) #endif /* HARD_DEBUG */ +static int +rangecompare(Range* a, Range* b) +{ + if (a->start < b->start) { + return -1; + } else if (a->start == b->start) { + return 0; + } else { + return 1; + } +} void erts_init_ranges(void) @@ -88,45 +100,70 @@ erts_init_ranges(void) } void -erts_start_staging_ranges(void) +erts_start_staging_ranges(int num_new) { + ErtsCodeIndex src = erts_active_code_ix(); ErtsCodeIndex dst = erts_staging_code_ix(); + Sint need; if (r[dst].modules) { erts_smp_atomic_add_nob(&mem_used, -r[dst].allocated); erts_free(ERTS_ALC_T_MODULE_REFS, r[dst].modules); - r[dst].modules = NULL; } + + need = r[dst].allocated = r[src].n + num_new; + erts_smp_atomic_add_nob(&mem_used, need); + write_ptr = erts_alloc(ERTS_ALC_T_MODULE_REFS, + need * sizeof(Range)); + r[dst].modules = write_ptr; } void erts_end_staging_ranges(int commit) { - ErtsCodeIndex dst = erts_staging_code_ix(); - - if (commit && r[dst].modules == NULL) { + if (commit) { Sint i; - Sint n; - - /* No modules added, just clone src and remove purged code. */ ErtsCodeIndex src = erts_active_code_ix(); + ErtsCodeIndex dst = erts_staging_code_ix(); + Range* mp; + Sint num_inserted; - erts_smp_atomic_add_nob(&mem_used, r[src].n); - r[dst].modules = erts_alloc(ERTS_ALC_T_MODULE_REFS, - r[src].n * sizeof(Range)); - r[dst].allocated = r[src].n; - n = 0; + mp = r[dst].modules; + num_inserted = write_ptr - mp; for (i = 0; i < r[src].n; i++) { Range* rp = r[src].modules+i; if (rp->start < RANGE_END(rp)) { /* Only insert a module that has not been purged. */ - r[dst].modules[n] = *rp; - n++; + write_ptr->start = rp->start; + erts_smp_atomic_init_nob(&write_ptr->end, + (erts_aint_t)(RANGE_END(rp))); + write_ptr++; + } + } + + /* + * There are num_inserted new range entries (unsorted) at the + * beginning of the modules array, followed by the old entries + * (sorted). We must now sort the entire array. + */ + + r[dst].n = write_ptr - mp; + if (num_inserted > 1) { + qsort(mp, r[dst].n, sizeof(Range), + (int (*)(const void *, const void *)) rangecompare); + } else if (num_inserted == 1) { + /* Sift the new range into place. This is faster than qsort(). */ + Range t = mp[0]; + for (i = 0; i < r[dst].n-1 && t.start > mp[i+1].start; i++) { + mp[i] = mp[i+1]; } + mp[i] = t; } - r[dst].n = n; + r[dst].modules = mp; + CHECK(&r[dst]); erts_smp_atomic_set_nob(&r[dst].mid, - (erts_aint_t) (r[dst].modules + n / 2)); + (erts_aint_t) (r[dst].modules + + r[dst].n / 2)); } } @@ -135,82 +172,29 @@ erts_update_ranges(BeamInstr* code, Uint size) { ErtsCodeIndex dst = erts_staging_code_ix(); ErtsCodeIndex src = erts_active_code_ix(); - Sint i; - Sint n; - Sint need; if (src == dst) { ASSERT(!erts_initialized); /* - * During start-up of system, the indices are the same. - * Handle this by faking a source area. + * During start-up of system, the indices are the same + * and erts_start_staging_ranges() has not been called. */ - src = (src+1) % ERTS_NUM_CODE_IX; - if (r[src].modules) { - erts_smp_atomic_add_nob(&mem_used, -r[src].allocated); - erts_free(ERTS_ALC_T_MODULE_REFS, r[src].modules); + if (r[dst].modules == NULL) { + Sint need = 128; + erts_smp_atomic_add_nob(&mem_used, need); + r[dst].modules = erts_alloc(ERTS_ALC_T_MODULE_REFS, + need * sizeof(Range)); + r[dst].allocated = need; + write_ptr = r[dst].modules; } - r[src] = r[dst]; - r[dst].modules = 0; } - CHECK(&r[src]); - - ASSERT(r[dst].modules == NULL); - need = r[dst].allocated = r[src].n + 1; - erts_smp_atomic_add_nob(&mem_used, need); - r[dst].modules = (Range *) erts_alloc(ERTS_ALC_T_MODULE_REFS, - need * sizeof(Range)); - n = 0; - for (i = 0; i < r[src].n; i++) { - Range* rp = r[src].modules+i; - if (code < rp->start) { - r[dst].modules[n].start = code; - erts_smp_atomic_init_nob(&r[dst].modules[n].end, - (erts_aint_t)(((byte *)code) + size)); - ASSERT(!n || RANGE_END(&r[dst].modules[n-1]) < code); - n++; - break; - } - if (rp->start < RANGE_END(rp)) { - /* Only insert a module that has not been purged. */ - r[dst].modules[n].start = rp->start; - erts_smp_atomic_init_nob(&r[dst].modules[n].end, - (erts_aint_t)(RANGE_END(rp))); - ASSERT(!n || RANGE_END(&r[dst].modules[n-1]) < rp->start); - n++; - } - } - - while (i < r[src].n) { - Range* rp = r[src].modules+i; - if (rp->start < RANGE_END(rp)) { - /* Only insert a module that has not been purged. */ - r[dst].modules[n].start = rp->start; - erts_smp_atomic_init_nob(&r[dst].modules[n].end, - (erts_aint_t)(RANGE_END(rp))); - ASSERT(!n || RANGE_END(&r[dst].modules[n-1]) < rp->start); - n++; - } - i++; - } - - if (n == 0 || code > r[dst].modules[n-1].start) { - r[dst].modules[n].start = code; - erts_smp_atomic_init_nob(&r[dst].modules[n].end, - (erts_aint_t)(((byte *)code) + size)); - ASSERT(!n || RANGE_END(&r[dst].modules[n-1]) < code); - n++; - } - - ASSERT(n <= r[src].n+1); - r[dst].n = n; - erts_smp_atomic_set_nob(&r[dst].mid, - (erts_aint_t) (r[dst].modules + n / 2)); - - CHECK(&r[dst]); - CHECK(&r[src]); + ASSERT(r[dst].modules); + write_ptr->start = code; + erts_smp_atomic_init_nob(&(write_ptr->end), + (erts_aint_t)(((byte *)code) + size)); + write_ptr++; } void @@ -241,6 +225,7 @@ erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info) BeamInstr** high; BeamInstr** mid; Range* rp; + BeamCodeHeader* hdr; fi->current = NULL; fi->needed = 5; @@ -249,9 +234,10 @@ erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info) if (rp == 0) { return; } + hdr = (BeamCodeHeader*) rp->start; - low = (BeamInstr **) (rp->start + MI_FUNCTIONS); - high = low + rp->start[MI_NUM_FUNCTIONS]; + low = hdr->functions; + high = low + hdr->num_functions; while (low < high) { mid = low + (high-low) / 2; if (pc < mid[0]) { @@ -259,10 +245,9 @@ erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info) } else if (pc < mid[1]) { fi->current = mid[0]+2; if (full_info) { - BeamInstr** fp = (BeamInstr **) (rp->start + - MI_FUNCTIONS); + BeamInstr** fp = hdr->functions; int idx = mid - fp; - lookup_loc(fi, pc, rp->start, idx); + lookup_loc(fi, pc, hdr, idx); } return; } else { @@ -295,39 +280,34 @@ find_range(BeamInstr* pc) } static void -lookup_loc(FunctionInfo* fi, BeamInstr* orig_pc, BeamInstr* modp, int idx) +lookup_loc(FunctionInfo* fi, const BeamInstr* pc, + BeamCodeHeader* code_hdr, int idx) { - Eterm* line = (Eterm *) modp[MI_LINE_TABLE]; - Eterm* low; - Eterm* high; - Eterm* mid; - Eterm pc; + BeamCodeLineTab* lt = code_hdr->line_table; + const BeamInstr** low; + const BeamInstr** high; + const BeamInstr** mid; - if (line == 0) { + if (lt == NULL) { return; } - pc = (Eterm) (BeamInstr) orig_pc; - fi->fname_ptr = (Eterm *) (BeamInstr) line[MI_LINE_FNAME_PTR]; - low = (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB+idx]; - high = (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB+idx+1]; + fi->fname_ptr = lt->fname_ptr; + low = lt->func_tab[idx]; + high = lt->func_tab[idx+1]; while (high > low) { mid = low + (high-low) / 2; if (pc < mid[0]) { high = mid; } else if (pc < mid[1]) { int file; - int index = mid - (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB]; + int index = mid - lt->func_tab[0]; - if (line[MI_LINE_LOC_SIZE] == 2) { - Uint16* loc_table = - (Uint16 *) (BeamInstr) line[MI_LINE_LOC_TAB]; - fi->loc = loc_table[index]; + if (lt->loc_size == 2) { + fi->loc = lt->loc_tab.p2[index]; } else { - Uint32* loc_table = - (Uint32 *) (BeamInstr) line[MI_LINE_LOC_TAB]; - ASSERT(line[MI_LINE_LOC_SIZE] == 4); - fi->loc = loc_table[index]; + ASSERT(lt->loc_size == 4); + fi->loc = lt->loc_tab.p4[index]; } if (fi->loc == LINE_INVALID_LOCATION) { return; diff --git a/erts/emulator/beam/benchmark.c b/erts/emulator/beam/benchmark.c index 44f5c760c2..c8409784ef 100644 --- a/erts/emulator/beam/benchmark.c +++ b/erts/emulator/beam/benchmark.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2012. All Rights Reserved. + * Copyright Ericsson AB 2002-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/benchmark.h b/erts/emulator/beam/benchmark.h index 0fb0b93f12..0272896f4f 100644 --- a/erts/emulator/beam/benchmark.h +++ b/erts/emulator/beam/benchmark.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2012. All Rights Reserved. + * Copyright Ericsson AB 2002-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 095df36a43..c38d031ab8 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -44,6 +44,7 @@ #include "erl_ptab.h" #include "erl_bits.h" #include "erl_bif_unique.h" +#include "erl_msacc.h" Export *erts_await_result; static Export* flush_monitor_messages_trap = NULL; @@ -54,6 +55,9 @@ Export* erts_format_cpu_topology_trap = NULL; static Export dsend_continue_trap_export; Export *erts_convert_time_unit_trap = NULL; +static Export *await_msacc_mod_trap = NULL; +static erts_smp_atomic32_t msacc; + static Export *await_sched_wall_time_mod_trap; static erts_smp_atomic32_t sched_wall_time; @@ -72,7 +76,7 @@ BIF_RETTYPE spawn_3(BIF_ALIST_3) ErlSpawnOpts so; Eterm pid; - so.flags = 0; + so.flags = erts_default_spo_flags; pid = erl_create_process(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &so); if (is_non_value(pid)) { BIF_ERROR(BIF_P, so.error_code); @@ -119,15 +123,12 @@ static int insert_internal_link(Process* p, Eterm rpid) erts_add_link(&ERTS_P_LINKS(p), LINK_PID, rp->common.id); erts_add_link(&ERTS_P_LINKS(rp), LINK_PID, p->common.id); - ASSERT(is_nil(ERTS_TRACER_PROC(p)) - || is_internal_pid(ERTS_TRACER_PROC(p)) - || is_internal_port(ERTS_TRACER_PROC(p))); + ASSERT(IS_TRACER_VALID(ERTS_TRACER(p))); if (IS_TRACED(p)) { if (ERTS_TRACE_FLAGS(p) & (F_TRACE_SOL|F_TRACE_SOL1)) { ERTS_TRACE_FLAGS(rp) |= (ERTS_TRACE_FLAGS(p) & TRACEE_FLAGS); - ERTS_TRACER_PROC(rp) = ERTS_TRACER_PROC(p); /* maybe steal */ - + erts_tracer_replace(&rp->common, ERTS_TRACER(p)); if (ERTS_TRACE_FLAGS(p) & F_TRACE_SOL1) { /* maybe override */ ERTS_TRACE_FLAGS(rp) &= ~(F_TRACE_SOL1 | F_TRACE_SOL); ERTS_TRACE_FLAGS(p) &= ~(F_TRACE_SOL1 | F_TRACE_SOL); @@ -136,7 +137,8 @@ static int insert_internal_link(Process* p, Eterm rpid) } } if (IS_TRACED_FL(rp, F_TRACE_PROCS)) - trace_proc(p, rp, am_getting_linked, p->common.id); + trace_proc(p, p == rp ? rp_locks : ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK, + rp, am_getting_linked, p->common.id); if (p == rp) erts_smp_proc_unlock(p, rp_locks & ~ERTS_PROC_LOCK_MAIN); @@ -155,7 +157,7 @@ BIF_RETTYPE link_1(BIF_ALIST_1) DistEntry *dep; if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS)) { - trace_proc(BIF_P, BIF_P, am_link, BIF_ARG_1); + trace_proc(BIF_P, ERTS_PROC_LOCK_MAIN, BIF_P, am_link, BIF_ARG_1); } /* check that the pid or port which is our argument is OK */ @@ -589,7 +591,7 @@ erts_queue_monitor_message(Process *p, Eterm reason_copy, ref_copy, item_copy; Uint reason_size, ref_size, item_size, heap_size; ErlOffHeap *ohp; - ErlHeapFragment *bp; + ErtsMessage *msgp; reason_size = IS_CONST(reason) ? 0 : size_object(reason); item_size = IS_CONST(item) ? 0 : size_object(item); @@ -597,11 +599,8 @@ erts_queue_monitor_message(Process *p, heap_size = 6+reason_size+ref_size+item_size; - hp = erts_alloc_message_heap(heap_size, - &bp, - &ohp, - p, - p_locksp); + msgp = erts_alloc_message_heap(p, p_locksp, heap_size, + &hp, &ohp); reason_copy = (IS_CONST(reason) ? reason @@ -612,7 +611,7 @@ 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); + erts_queue_message(p, p_locksp, msgp, tup); } static BIF_RETTYPE @@ -841,7 +840,7 @@ BIF_RETTYPE spawn_link_3(BIF_ALIST_3) ErlSpawnOpts so; Eterm pid; - so.flags = SPO_LINK; + so.flags = erts_default_spo_flags|SPO_LINK; pid = erl_create_process(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &so); if (is_non_value(pid)) { BIF_ERROR(BIF_P, so.error_code); @@ -878,7 +877,7 @@ BIF_RETTYPE spawn_opt_1(BIF_ALIST_1) /* * Store default values for options. */ - so.flags = SPO_USE_ARGS; + so.flags = erts_default_spo_flags|SPO_USE_ARGS; so.min_heap_size = H_MIN_SIZE; so.min_vheap_size = BIN_VH_MIN_SIZE; so.priority = PRIORITY_NORMAL; @@ -913,6 +912,22 @@ BIF_RETTYPE spawn_opt_1(BIF_ALIST_1) so.priority = PRIORITY_LOW; else goto error; + } else if (arg == am_message_queue_data) { + switch (val) { + case am_mixed: + so.flags &= ~(SPO_OFF_HEAP_MSGQ|SPO_ON_HEAP_MSGQ); + break; + case am_on_heap: + so.flags &= ~SPO_OFF_HEAP_MSGQ; + so.flags |= SPO_ON_HEAP_MSGQ; + break; + case am_off_heap: + so.flags &= ~SPO_ON_HEAP_MSGQ; + so.flags |= SPO_OFF_HEAP_MSGQ; + break; + default: + goto error; + } } else if (arg == am_min_heap_size && is_small(val)) { Sint min_heap_size = signed_val(val); if (min_heap_size < 0) { @@ -984,6 +999,7 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1) Process *rp; DistEntry *dep; ErtsLink *l = NULL, *rl = NULL; + ErtsProcLocks cp_locks = ERTS_PROC_LOCK_MAIN; /* * SMP specific note concerning incoming exit signals: @@ -998,7 +1014,7 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1) */ if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS)) { - trace_proc(BIF_P, BIF_P, am_unlink, BIF_ARG_1); + trace_proc(BIF_P, cp_locks, BIF_P, am_unlink, BIF_ARG_1); } if (is_internal_port(BIF_ARG_1)) { @@ -1103,10 +1119,10 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1) erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); + cp_locks |= ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS; + /* get process struct */ - rp = erts_pid2proc_opt(BIF_P, (ERTS_PROC_LOCK_MAIN - | ERTS_PROC_LOCK_LINK - | ERTS_PROC_LOCK_STATUS), + rp = erts_pid2proc_opt(BIF_P, cp_locks, BIF_ARG_1, ERTS_PROC_LOCK_LINK, ERTS_P2P_FLG_ALLOW_OTHER_X); @@ -1132,14 +1148,17 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1) erts_destroy_link(rl); if (IS_TRACED_FL(rp, F_TRACE_PROCS) && rl != NULL) { - trace_proc(BIF_P, rp, am_getting_unlinked, BIF_P->common.id); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_STATUS); + cp_locks &= ~ERTS_PROC_LOCK_STATUS; + trace_proc(BIF_P, (ERTS_PROC_LOCK_MAIN | ERTS_PROC_LOCK_LINK), + rp, am_getting_unlinked, BIF_P->common.id); } if (rp != BIF_P) erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); } - erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); + erts_smp_proc_unlock(BIF_P, cp_locks & ~ERTS_PROC_LOCK_MAIN); BIF_RET(am_true); @@ -1550,7 +1569,7 @@ static BIF_RETTYPE process_flag_aux(Process *BIF_P, scb->n = 0; } - scb = ERTS_PROC_SET_SAVED_CALLS_BUF(rp, ERTS_PROC_LOCK_MAIN, scb); + scb = ERTS_PROC_SET_SAVED_CALLS_BUF(rp, scb); if (!scb) old_value = make_small(0); @@ -1578,9 +1597,7 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2) if (is_not_atom(BIF_ARG_2)) { goto error; } - old_value = erts_proc_set_error_handler(BIF_P, - ERTS_PROC_LOCK_MAIN, - BIF_ARG_2); + old_value = erts_proc_set_error_handler(BIF_P, BIF_ARG_2); BIF_RET(old_value); } else if (BIF_ARG_1 == am_priority) { @@ -1694,6 +1711,12 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2) } BIF_RET(old_value); } + else if (BIF_ARG_1 == am_message_queue_data) { + old_value = erts_change_message_queue_management(BIF_P, BIF_ARG_2); + if (is_non_value(old_value)) + goto error; + BIF_RET(old_value); + } else if (BIF_ARG_1 == am_sensitive) { Uint is_sensitive; if (BIF_ARG_2 == am_true) { @@ -1713,7 +1736,9 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2) ERTS_TRACE_FLAGS(BIF_P) &= ~F_SENSITIVE; } erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_ALL_MINOR); - BIF_RET(old_value); + /* make sure to bump all reds so that we get + rescheduled immediately so setting takes effect */ + BIF_RET2(old_value, CONTEXT_REDS); } else if (BIF_ARG_1 == am_monitor_nodes) { /* @@ -1888,7 +1913,7 @@ static Sint remote_send(Process *p, DistEntry *dep, } if (res >= 0) { - if (IS_TRACED(p)) + if (IS_TRACED_FL(p, F_TRACE_SEND)) trace_send(p, full_to, msg); if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); @@ -1907,7 +1932,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) Eterm* tp; if (is_internal_pid(to)) { - if (IS_TRACED(p)) + if (IS_TRACED_FL(p, F_TRACE_SEND)) trace_send(p, to, msg); if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); @@ -1934,9 +1959,9 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) } else if (is_atom(to)) { Eterm id = erts_whereis_name_to_id(p, to); - rp = erts_proc_lookup(id); + rp = erts_proc_lookup_raw(id); if (rp) { - if (IS_TRACED(p)) + if (IS_TRACED_FL(p, F_TRACE_SEND)) trace_send(p, to, msg); if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); @@ -1952,7 +1977,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) goto port_common; } - if (IS_TRACED(p)) + if (IS_TRACED_FL(p, F_TRACE_SEND)) trace_send(p, to, msg); if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); @@ -1983,11 +2008,20 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) port_common: ret_val = 0; - + if (pt) { int ps_flags = ctx->suspend ? 0 : ERTS_PORT_SIG_FLG_NOSUSPEND; *refp = NIL; + if (IS_TRACED_FL(p, F_TRACE_SEND)) /* trace once only !! */ + trace_send(p, portid, msg); + + if (have_seqtrace(SEQ_TRACE_TOKEN(p))) { + seq_trace_update_send(p); + seq_trace_output(SEQ_TRACE_TOKEN(p), msg, + SEQ_TRACE_SEND, portid, p); + } + switch (erts_port_command(p, ps_flags, pt, msg, refp)) { case ERTS_PORT_OP_CALLER_EXIT: /* We are exiting... */ @@ -2020,22 +2054,10 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) break; } } - - if (IS_TRACED(p)) /* trace once only !! */ - trace_send(p, portid, msg); + if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); - - if (SEQ_TRACE_TOKEN(p) != NIL -#ifdef USE_VM_PROBES - && SEQ_TRACE_TOKEN(p) != am_have_dt_utag -#endif - ) { - seq_trace_update_send(p); - seq_trace_output(SEQ_TRACE_TOKEN(p), msg, - SEQ_TRACE_SEND, portid, p); - } - + if (ERTS_PROC_IS_EXITING(p)) { KILL_CATCHES(p); /* Must exit */ return SEND_USER_ERROR; @@ -2058,7 +2080,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) if (dep == erts_this_dist_entry) { Eterm id; erts_deref_dist_entry(dep); - if (IS_TRACED(p)) + if (IS_TRACED_FL(p, F_TRACE_SEND)) trace_send(p, to, msg); if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); @@ -2089,7 +2111,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) } return ret; } else { - if (IS_TRACED(p)) /* XXX Is this really neccessary ??? */ + if (IS_TRACED_FL(p, F_TRACE_SEND)) trace_send(p, to, msg); if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); @@ -2131,7 +2153,11 @@ BIF_RETTYPE send_3(BIF_ALIST_3) int connect = !0; Eterm l = opts; Sint result; + DeclareTypedTmpHeap(ErtsSendContext, ctx, BIF_P); + + ERTS_MSACC_PUSH_STATE_M_X(); + UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P); ctx->suspend = !0; @@ -2160,7 +2186,10 @@ BIF_RETTYPE send_3(BIF_ALIST_3) ref = NIL; #endif + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_SEND); result = do_send(p, to, msg, &ref, ctx); + ERTS_MSACC_POP_STATE_M_X(); + if (result > 0) { ERTS_VBUMP_REDS(p, result); if (ERTS_IS_PROC_OUT_OF_REDS(p)) @@ -2276,8 +2305,8 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) Eterm ref; Sint result; DeclareTypedTmpHeap(ErtsSendContext, ctx, p); + ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_SEND); UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), p); - #ifdef DEBUG ref = NIL; #endif @@ -2288,7 +2317,9 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT; result = do_send(p, to, msg, &ref, ctx); - + + ERTS_MSACC_POP_STATE_M_X(); + if (result > 0) { ERTS_VBUMP_REDS(p, result); if (ERTS_IS_PROC_OUT_OF_REDS(p)) @@ -2812,7 +2843,7 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1) { Eterm res; char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_CHARACTERS); - int i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS); + Sint i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS); if (i < 0) { erts_free(ERTS_ALC_T_TMP, (void *) buf); @@ -2832,7 +2863,7 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1) BIF_RETTYPE list_to_existing_atom_1(BIF_ALIST_1) { - int i; + Sint i; char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_CHARACTERS); if ((i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS)) < 0) { @@ -2892,175 +2923,20 @@ BIF_RETTYPE integer_to_list_1(BIF_ALIST_1) /**********************************************************************/ -/* convert a list of ascii ascii integer value to an integer */ - - -#define LTI_BAD_STRUCTURE 0 -#define LTI_NO_INTEGER 1 -#define LTI_SOME_INTEGER 2 -#define LTI_ALL_INTEGER 3 - -static int do_list_to_integer(Process *p, Eterm orig_list, - Eterm *integer, Eterm *rest) -{ - Sint i = 0; - Uint ui = 0; - int skip = 0; - int neg = 0; - Sint n = 0; - int m; - int lg2; - Eterm res; - Eterm* hp; - Eterm *hp_end; - Eterm lst = orig_list; - Eterm tail = lst; - int error_res = LTI_BAD_STRUCTURE; - - if (is_nil(lst)) { - error_res = LTI_NO_INTEGER; - error: - *rest = tail; - *integer = make_small(0); - return error_res; - } - if (is_not_list(lst)) - goto error; - - /* if first char is a '-' then it is a negative integer */ - if (CAR(list_val(lst)) == make_small('-')) { - neg = 1; - skip = 1; - lst = CDR(list_val(lst)); - if (is_not_list(lst)) { - tail = lst; - error_res = LTI_NO_INTEGER; - goto error; - } - } else if (CAR(list_val(lst)) == make_small('+')) { - /* ignore plus */ - skip = 1; - lst = CDR(list_val(lst)); - if (is_not_list(lst)) { - tail = lst; - error_res = LTI_NO_INTEGER; - goto error; - } - } - - /* Calculate size and do type check */ - - while(1) { - if (is_not_small(CAR(list_val(lst)))) { - break; - } - if (unsigned_val(CAR(list_val(lst))) < '0' || - unsigned_val(CAR(list_val(lst))) > '9') { - break; - } - ui = ui * 10; - ui = ui + unsigned_val(CAR(list_val(lst))) - '0'; - n++; - lst = CDR(list_val(lst)); - if (is_nil(lst)) { - break; - } - if (is_not_list(lst)) { - break; - } - } - - tail = lst; - if (!n) { - error_res = LTI_NO_INTEGER; - goto error; - } - - - /* If n <= 8 then we know it's a small int - ** since 2^27 = 134217728. If n > 8 then we must - ** construct a bignum and let that routine do the checking - */ - - if (n <= SMALL_DIGITS) { /* It must be small */ - if (neg) i = -(Sint)ui; - else i = (Sint)ui; - res = make_small(i); - } else { - /* Convert from log10 to log2 by multiplying with 1/log10(2)=3.3219 - which we round up to (3 + 1/3) */ - lg2 = (n+1)*3 + (n+1)/3 + 1; - m = (lg2+D_EXP-1)/D_EXP; /* number of digits */ - m = BIG_NEED_SIZE(m); /* number of words + thing */ - - hp = HAlloc(p, m); - hp_end = hp + m; - - lst = orig_list; - if (skip) - lst = CDR(list_val(lst)); - - /* load first digits (at least one digit) */ - if ((i = (n % D_DECIMAL_EXP)) == 0) - i = D_DECIMAL_EXP; - n -= i; - m = 0; - while(i--) { - m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0'); - lst = CDR(list_val(lst)); - } - res = small_to_big(m, hp); /* load first digits */ - - while(n) { - i = D_DECIMAL_EXP; - n -= D_DECIMAL_EXP; - m = 0; - while(i--) { - m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0'); - lst = CDR(list_val(lst)); - } - if (is_small(res)) - res = small_to_big(signed_val(res), hp); - res = big_times_small(res, D_DECIMAL_BASE, hp); - if (is_small(res)) - res = small_to_big(signed_val(res), hp); - res = big_plus_small(res, m, hp); - } - - if (neg) { - if (is_small(res)) - res = make_small(-signed_val(res)); - else { - Uint *big = big_val(res); /* point to thing */ - *big = bignum_header_neg(*big); - } - } - - if (is_not_small(res)) { - res = big_plus_small(res, 0, hp); /* includes conversion to small */ +/* + * Converts a list of ascii base10 digits to an integer fully or partially. + * Returns result and the remaining tail. + * On error returns: {error,not_a_list}, or {error, no_integer} + */ - if (is_not_small(res)) { - hp += (big_arity(res)+1); - } - } - HRelease(p,hp_end,hp); - } - *integer = res; - *rest = tail; - if (tail != NIL) { - return LTI_SOME_INTEGER; - } - return LTI_ALL_INTEGER; -} BIF_RETTYPE string_to_integer_1(BIF_ALIST_1) { Eterm res; Eterm tail; Eterm *hp; /* must be a list */ - switch (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&tail)) { - /* HAlloc after do_list_to_integer as it - might HAlloc itself (bignum) */ + switch (erts_list_to_integer(BIF_P, BIF_ARG_1, 10, &res, &tail)) { + /* HAlloc after erts_list_to_integer as it might HAlloc itself (bignum) */ case LTI_BAD_STRUCTURE: hp = HAlloc(BIF_P,3); BIF_RET(TUPLE2(hp, am_error, am_not_a_list)); @@ -3075,13 +2951,14 @@ BIF_RETTYPE string_to_integer_1(BIF_ALIST_1) BIF_RETTYPE list_to_integer_1(BIF_ALIST_1) { - /* Using do_list_to_integer is about twice as fast as using + /* Using erts_list_to_integer is about twice as fast as using erts_chars_to_integer because we do not have to copy the entire list */ Eterm res; Eterm dummy; /* must be a list */ - if (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&dummy) != LTI_ALL_INTEGER) { + if (erts_list_to_integer(BIF_P, BIF_ARG_1, 10, + &res, &dummy) != LTI_ALL_INTEGER) { BIF_ERROR(BIF_P,BADARG); } BIF_RET(res); @@ -3089,14 +2966,12 @@ BIF_RETTYPE list_to_integer_1(BIF_ALIST_1) BIF_RETTYPE list_to_integer_2(BIF_ALIST_2) { - /* Bif implementation is about 50% faster than pure erlang, and since we have erts_chars_to_integer now it is simpler as well. This could be optmized further if we did not have to copy the list to buf. */ - int i; - Eterm res; - char *buf = NULL; + Sint i; + Eterm res, dummy; int base; i = erts_list_length(BIF_ARG_1); @@ -3104,31 +2979,16 @@ BIF_RETTYPE list_to_integer_2(BIF_ALIST_2) BIF_ERROR(BIF_P, BADARG); base = signed_val(BIF_ARG_2); - + if (base < 2 || base > 36) BIF_ERROR(BIF_P, BADARG); - /* Take fast path if base it 10 */ - if (base == 10) - return list_to_integer_1(BIF_P,&BIF_ARG_1); - - buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1); - - if (intlist_to_buf(BIF_ARG_1, buf, i) < 0) - goto list_to_integer_1_error; - buf[i] = '\0'; /* null terminal */ - - if ((res = erts_chars_to_integer(BIF_P,buf,i,base)) == THE_NON_VALUE) - goto list_to_integer_1_error; - - erts_free(ERTS_ALC_T_TMP, (void *) buf); + if (erts_list_to_integer(BIF_P, BIF_ARG_1, base, + &res, &dummy) != LTI_ALL_INTEGER) { + BIF_ERROR(BIF_P,BADARG); + } BIF_RET(res); - - list_to_integer_1_error: - erts_free(ERTS_ALC_T_TMP, (void *) buf); - BIF_ERROR(BIF_P, BADARG); - - } +} /**********************************************************************/ @@ -3434,7 +3294,7 @@ static BIF_RETTYPE do_charbuf_to_float(Process *BIF_P,char *buf) { BIF_RETTYPE list_to_float_1(BIF_ALIST_1) { - int i; + Sint i; Eterm res; char *buf = NULL; @@ -3551,7 +3411,7 @@ BIF_RETTYPE list_to_tuple_1(BIF_ALIST_1) Eterm* cons; Eterm res; Eterm* hp; - int len; + Sint len; if ((len = erts_list_length(list)) < 0 || len > ERTS_MAX_TUPLE_SIZE) { BIF_ERROR(BIF_P, BADARG); @@ -3827,11 +3687,9 @@ BIF_RETTYPE now_0(BIF_ALIST_0) BIF_RETTYPE garbage_collect_0(BIF_ALIST_0) { - int reds; - FLAGS(BIF_P) |= F_NEED_FULLSWEEP; - reds = erts_garbage_collect(BIF_P, 0, NULL, 0); - BIF_RET2(am_true, reds); + erts_garbage_collect(BIF_P, 0, NULL, 0); + BIF_RET(am_true); } /**********************************************************************/ @@ -3900,7 +3758,7 @@ BIF_RETTYPE display_string_1(BIF_ALIST_1) { Process* p = BIF_P; Eterm string = BIF_ARG_1; - int len = is_string(string); + Sint len = is_string(string); char *str; if (len <= 0) { @@ -3955,7 +3813,7 @@ BIF_RETTYPE halt_1(BIF_ALIST_1) erts_exit(ERTS_ABORT_EXIT, ""); } else if (is_string(BIF_ARG_1) || BIF_ARG_1 == NIL) { - int i; + Sint i; if ((i = intlist_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE-1)) < 0) { goto error; @@ -4025,7 +3883,7 @@ BIF_RETTYPE halt_2(BIF_ALIST_2) erts_exit(ERTS_ABORT_EXIT, ""); } else if (is_string(BIF_ARG_1) || BIF_ARG_1 == NIL) { - int i; + Sint i; if ((i = intlist_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE-1)) < 0) { goto error; @@ -4122,16 +3980,9 @@ BIF_RETTYPE make_fun_3(BIF_ALIST_3) if (arity < 0) { goto error; } -#if HALFWORD_HEAP - hp = HAlloc(BIF_P, 3); - hp[0] = HEADER_EXPORT; - /* Yes, May be misaligned, but X86_64 will fix it... */ - *((Export **) (hp+1)) = erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity); -#else hp = HAlloc(BIF_P, 2); hp[0] = HEADER_EXPORT; hp[1] = (Eterm) erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity); -#endif BIF_RET(make_export(hp)); } @@ -4175,7 +4026,7 @@ BIF_RETTYPE list_to_pid_1(BIF_ALIST_1) { Uint a = 0, b = 0, c = 0; char* cp; - int i; + Sint i; DistEntry *dep = NULL; char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, 65); /* @@ -4352,22 +4203,33 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) Sint n; if (BIF_ARG_1 == am_multi_scheduling) { - if (BIF_ARG_2 == am_block || BIF_ARG_2 == am_unblock) { + if (BIF_ARG_2 == am_block || BIF_ARG_2 == am_unblock + || BIF_ARG_2 == am_block_normal || BIF_ARG_2 == am_unblock_normal) { #ifndef ERTS_SMP BIF_RET(am_disabled); #else + int block = (BIF_ARG_2 == am_block + || BIF_ARG_2 == am_block_normal); + int normal = (BIF_ARG_2 == am_block_normal + || BIF_ARG_2 == am_unblock_normal); if (erts_no_schedulers == 1) BIF_RET(am_disabled); else { switch (erts_block_multi_scheduling(BIF_P, ERTS_PROC_LOCK_MAIN, - BIF_ARG_2 == am_block, + block, + normal, 0)) { case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED: BIF_RET(am_blocked); + case ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED: + BIF_RET(am_blocked_normal); case ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED: ERTS_BIF_YIELD_RETURN_X(BIF_P, am_blocked, am_multi_scheduling); + case ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED: + ERTS_BIF_YIELD_RETURN_X(BIF_P, am_blocked_normal, + am_multi_scheduling); case ERTS_SCHDLR_SSPND_DONE: BIF_RET(am_enabled); case ERTS_SCHDLR_SSPND_YIELD_RESTART: @@ -4400,11 +4262,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) switch (erts_set_schedulers_online(BIF_P, ERTS_PROC_LOCK_MAIN, signed_val(BIF_ARG_2), - &old_no -#ifdef ERTS_DIRTY_SCHEDULERS - , 0 -#endif - )) { + &old_no, 0)) { case ERTS_SCHDLR_SSPND_DONE: BIF_RET(make_small(old_no)); case ERTS_SCHDLR_SSPND_YIELD_RESTART: @@ -4484,15 +4342,37 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) } else if (BIF_ARG_1 == am_trace_control_word) { BIF_RET(db_set_trace_control_word(BIF_P, BIF_ARG_2)); } else if (BIF_ARG_1 == am_sequential_tracer) { - Eterm old_value = erts_set_system_seq_tracer(BIF_P, - ERTS_PROC_LOCK_MAIN, - BIF_ARG_2); - if (old_value != THE_NON_VALUE) { - BIF_RET(old_value); - } + ErtsTracer new_seq_tracer, old_seq_tracer; + Eterm ret; + + if (BIF_ARG_2 == am_false) + new_seq_tracer = erts_tracer_nil; + else + new_seq_tracer = erts_term_to_tracer(THE_NON_VALUE, BIF_ARG_2); + + if (new_seq_tracer == THE_NON_VALUE) + goto error; + + old_seq_tracer = erts_set_system_seq_tracer(BIF_P, + ERTS_PROC_LOCK_MAIN, + new_seq_tracer); + + ERTS_TRACER_CLEAR(&new_seq_tracer); + + if (old_seq_tracer == THE_NON_VALUE) + goto error; + + if (ERTS_TRACER_IS_NIL(old_seq_tracer)) + BIF_RET(am_false); + + ret = erts_tracer_to_term(BIF_P, old_seq_tracer); + + ERTS_TRACER_CLEAR(&old_seq_tracer); + + BIF_RET(ret); } else if (BIF_ARG_1 == make_small(1)) { int i, max; - ErlMessage* mp; + ErtsMessage* mp; erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_smp_thr_progress_block(); @@ -4585,6 +4465,31 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) default: ERTS_INTERNAL_ERROR("Unknown state"); } +#ifdef ERTS_ENABLE_MSACC + } else if (BIF_ARG_1 == am_microstate_accounting) { + Eterm threads; + if (BIF_ARG_2 == am_true || BIF_ARG_2 == am_false) { + erts_aint32_t new = BIF_ARG_2 == am_true ? ERTS_MSACC_ENABLE : ERTS_MSACC_DISABLE; + erts_aint32_t old = erts_smp_atomic32_xchg_nob(&msacc, new); + Eterm ref = erts_msacc_request(BIF_P, new, &threads); + if (is_non_value(ref)) + BIF_RET(old ? am_true : am_false); + BIF_TRAP3(await_msacc_mod_trap, + BIF_P, + ref, + old ? am_true : am_false, + threads); + } else if (BIF_ARG_2 == am_reset) { + Eterm ref = erts_msacc_request(BIF_P, ERTS_MSACC_RESET, &threads); + erts_aint32_t old = erts_smp_atomic32_read_nob(&msacc); + ASSERT(is_value(ref)); + BIF_TRAP3(await_msacc_mod_trap, + BIF_P, + ref, + old ? am_true : am_false, + threads); + } +#endif } else if (ERTS_IS_ATOM_STR("scheduling_statistics", BIF_ARG_1)) { int what; if (ERTS_IS_ATOM_STR("disable", BIF_ARG_2)) @@ -4637,7 +4542,7 @@ BIF_RETTYPE hash_2(BIF_ALIST_2) if ((range = signed_val(BIF_ARG_2)) <= 0) { /* [1..MAX_SMALL] */ BIF_ERROR(BIF_P, BADARG); } -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) if (range > ((1L << 27) - 1)) BIF_ERROR(BIF_P, BADARG); #endif @@ -4709,7 +4614,7 @@ BIF_RETTYPE phash2_2(BIF_ALIST_2) /* * Return either a small or a big. Use the heap for bigs if there is room. */ -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) BIF_RET(make_small(final_hash)); #else if (IS_USMALL(0, final_hash)) { @@ -4749,29 +4654,27 @@ BIF_RETTYPE erts_internal_cmp_term_2(BIF_ALIST_2) { /* * Processes doing yield on return in a bif ends up in bif_return_trap(). */ -static BIF_RETTYPE bif_return_trap( -#ifdef DEBUG - BIF_ALIST_2 -#else - BIF_ALIST_1 -#endif - ) +static BIF_RETTYPE bif_return_trap(BIF_ALIST_2) { -#ifdef DEBUG + Eterm res = BIF_ARG_1; + switch (BIF_ARG_2) { - case am_multi_scheduling: #ifdef ERTS_SMP - erts_dbg_multi_scheduling_return_trap(BIF_P, BIF_ARG_1); -#endif - break; - case am_schedulers_online: + case am_multi_scheduling: { + int msb = erts_is_multi_scheduling_blocked(); + if (msb > 0) + res = am_blocked; + else if (msb < 0) + res = am_blocked_normal; + else + ERTS_INTERNAL_ERROR("Unexpected multi scheduling block state"); break; + } +#endif default: break; } -#endif - - BIF_RET(BIF_ARG_1); + BIF_RET(res); } /* @@ -4803,7 +4706,7 @@ skip_current_msgq(Process *c_p) res = 0; } else { - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); c_p->msg.save = c_p->msg.last; res = 1; } @@ -4876,17 +4779,12 @@ void erts_init_bif(void) erts_smp_atomic_init_nob(&erts_dead_ports_ptr, (erts_aint_t) NULL); /* - * bif_return_trap/1 is a hidden BIF that bifs that need to - * yield the calling process traps to. The only thing it does: - * return the value passed as argument. + * bif_return_trap/2 is a hidden BIF that bifs that need to + * yield the calling process traps to. */ - erts_init_trap_export(&bif_return_trap_export, am_erlang, am_bif_return_trap, -#ifdef DEBUG - 2 -#else - 1 -#endif - , &bif_return_trap); + erts_init_trap_export(&bif_return_trap_export, + am_erlang, am_bif_return_trap, 2, + &bif_return_trap); erts_await_result = erts_export_put(am_erts_internal, am_await_result, @@ -4914,8 +4812,12 @@ void erts_init_bif(void) await_port_send_result_trap = erts_export_put(am_erts_internal, am_await_port_send_result, 3); await_sched_wall_time_mod_trap - = erts_export_put(am_erlang, am_await_sched_wall_time_modifications, 2); + = erts_export_put(am_erlang, am_await_sched_wall_time_modifications, 2); + await_msacc_mod_trap + = erts_export_put(am_erts_internal, am_await_microstate_accounting_modifications, 3); + erts_smp_atomic32_init_nob(&sched_wall_time, 0); + erts_smp_atomic32_init_nob(&msacc, ERTS_MSACC_IS_ENABLED()); } #ifdef HARDDEBUG diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index c6ed60376a..546e3830b9 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -54,22 +54,24 @@ extern Export *erts_convert_time_unit_trap; (p)->fcalls = -CONTEXT_REDS; \ } while(0) - -#define ERTS_VBUMP_ALL_REDS(p) \ +#define ERTS_VBUMP_ALL_REDS_INTERNAL(p, fcalls) \ do { \ if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) { \ - if ((p)->fcalls > 0) \ - ERTS_PROC_GET_SCHDATA((p))->virtual_reds += (p)->fcalls; \ - (p)->fcalls = 0; \ + if ((fcalls) > 0) \ + ERTS_PROC_GET_SCHDATA((p))->virtual_reds += (fcalls); \ + (fcalls) = 0; \ } \ else { \ - if ((p)->fcalls > -CONTEXT_REDS) \ + if ((fcalls) > -CONTEXT_REDS) \ ERTS_PROC_GET_SCHDATA((p))->virtual_reds \ - += ((p)->fcalls - (-CONTEXT_REDS)); \ - (p)->fcalls = -CONTEXT_REDS; \ + += ((fcalls) - (-CONTEXT_REDS)); \ + (fcalls) = -CONTEXT_REDS; \ } \ } while(0) +#define ERTS_VBUMP_ALL_REDS(p) \ + ERTS_VBUMP_ALL_REDS_INTERNAL((p), (p)->fcalls) + #define BUMP_REDS(p, gc) do { \ ASSERT(p); \ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));\ @@ -110,10 +112,34 @@ do { \ } \ } while(0) -#define ERTS_BIF_REDS_LEFT(p) \ +#define ERTS_VBUMP_LEAVE_REDS_INTERNAL(P, Reds, FCalls) \ + do { \ + if (ERTS_PROC_GET_SAVED_CALLS_BUF((P))) { \ + int nreds__ = ((int)(Reds)) - CONTEXT_REDS; \ + if ((FCalls) > nreds__) { \ + ERTS_PROC_GET_SCHDATA((P))->virtual_reds \ + += (FCalls) - nreds__; \ + (FCalls) = nreds__; \ + } \ + } \ + else { \ + if ((FCalls) > (Reds)) { \ + ERTS_PROC_GET_SCHDATA((P))->virtual_reds \ + += (FCalls) - (Reds); \ + (FCalls) = (Reds); \ + } \ + } \ + } while (0) + +#define ERTS_VBUMP_LEAVE_REDS(P, Reds) \ + ERTS_VBUMP_LEAVE_REDS_INTERNAL(P, Reds, (P)->fcalls) + +#define ERTS_REDS_LEFT(p, FCalls) \ (ERTS_PROC_GET_SAVED_CALLS_BUF((p)) \ - ? ((p)->fcalls > -CONTEXT_REDS ? ((p)->fcalls - (-CONTEXT_REDS)) : 0)\ - : ((p)->fcalls > 0 ? (p)->fcalls : 0)) + ? ((FCalls) > -CONTEXT_REDS ? ((FCalls) - (-CONTEXT_REDS)) : 0) \ + : ((FCalls) > 0 ? (FCalls) : 0)) + +#define ERTS_BIF_REDS_LEFT(p) ERTS_REDS_LEFT(p, p->fcalls) #define BIF_RET2(x, gc) do { \ BUMP_REDS(BIF_P, (gc)); \ @@ -312,37 +338,20 @@ do { \ } while(0) extern Export bif_return_trap_export; -#ifdef DEBUG -#define ERTS_BIF_PREP_YIELD_RETURN_X(RET, P, VAL, DEBUG_VAL) \ -do { \ - ERTS_VBUMP_ALL_REDS(P); \ - ERTS_BIF_PREP_TRAP2(RET, &bif_return_trap_export, (P), (VAL), \ - (DEBUG_VAL)); \ -} while (0) -#else -#define ERTS_BIF_PREP_YIELD_RETURN_X(RET, P, VAL, DEBUG_VAL) \ +#define ERTS_BIF_PREP_YIELD_RETURN_X(RET, P, VAL, OP) \ do { \ ERTS_VBUMP_ALL_REDS(P); \ - ERTS_BIF_PREP_TRAP1(RET, &bif_return_trap_export, (P), (VAL)); \ + ERTS_BIF_PREP_TRAP2(RET, &bif_return_trap_export, (P), (VAL), (OP));\ } while (0) -#endif #define ERTS_BIF_PREP_YIELD_RETURN(RET, P, VAL) \ ERTS_BIF_PREP_YIELD_RETURN_X(RET, (P), (VAL), am_undefined) -#ifdef DEBUG -#define ERTS_BIF_YIELD_RETURN_X(P, VAL, DEBUG_VAL) \ +#define ERTS_BIF_YIELD_RETURN_X(P, VAL, OP) \ do { \ ERTS_VBUMP_ALL_REDS(P); \ - BIF_TRAP2(&bif_return_trap_export, (P), (VAL), (DEBUG_VAL)); \ + BIF_TRAP2(&bif_return_trap_export, (P), (VAL), (OP)); \ } while (0) -#else -#define ERTS_BIF_YIELD_RETURN_X(P, VAL, DEBUG_VAL) \ -do { \ - ERTS_VBUMP_ALL_REDS(P); \ - BIF_TRAP1(&bif_return_trap_export, (P), (VAL)); \ -} while (0) -#endif #define ERTS_BIF_RETURN_YIELD(P) ERTS_VBUMP_ALL_REDS((P)) diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 3177d5dae7..872f0f9b2a 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2013. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -115,7 +115,7 @@ bif erlang:time_offset/0 bif erlang:time_offset/1 bif erlang:timestamp/0 -bif erlang:open_port/2 +bif erts_internal:open_port/2 bif erlang:pid_to_list/1 bif erlang:ports/0 @@ -125,7 +125,6 @@ bif erlang:process_flag/3 bif erlang:process_info/1 bif erlang:process_info/2 bif erlang:processes/0 -bif erlang:purge_module/1 bif erlang:put/2 bif erlang:register/2 bif erlang:registered/0 @@ -167,10 +166,11 @@ 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:term_type/1 bif erts_internal:map_hashmap_children/1 bif erts_internal:time_unit/0 +bif erts_internal:perf_counter_unit/0 bif erts_internal:is_system_process/1 @@ -181,9 +181,8 @@ bif erlang:port_set_data/2 bif erlang:port_get_data/1 # Tracing & debugging. -bif erlang:trace_pattern/2 -bif erlang:trace_pattern/3 -bif erlang:trace/3 +bif erts_internal:trace_pattern/3 +bif erts_internal:trace/3 bif erlang:trace_info/2 bif erlang:trace_delivered/1 bif erlang:seq_trace/2 @@ -372,6 +371,7 @@ bif os:getpid/0 bif os:timestamp/0 bif os:system_time/0 bif os:system_time/1 +bif os:perf_counter/0 # # Bifs in the erl_ddll module (the module actually does not exist) @@ -641,6 +641,20 @@ bif ets:update_counter/4 bif erts_debug:map_info/1 # +# New in 19.0 +# + +bif erts_internal:copy_literals/2 +bif erts_internal:purge_module/1 +bif binary:split/2 +bif binary:split/3 +bif erts_debug:size_shared/1 +bif erts_debug:copy_shared/1 +bif erlang:has_prepared_code_on_load/1 + +bif maps:take/2 + +# # Obsolete # diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 87d3be2b0f..4baee7900b 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -48,7 +48,7 @@ _t_dst = (dst)+((sz)-1); \ _t_src = (src)+((sz)-1); \ while(_t_sz--) *_t_dst-- = *_t_src--; \ - } \ + } \ } while(0) /* add a and b with carry in + out */ @@ -423,6 +423,25 @@ #endif +/* Forward declaration of lookup tables (See below in this file) used in list to + * integer conversions for different bases. Also used in bignum printing. + */ +static const byte digits_per_sint_lookup[36-1]; +static const byte digits_per_small_lookup[36-1]; +static const Sint largest_power_of_base_lookup[36-1]; + +static ERTS_INLINE byte get_digits_per_signed_int(Uint base) { + return digits_per_sint_lookup[base-2]; +} + +static ERTS_INLINE byte get_digits_per_small(Uint base) { + return digits_per_small_lookup[base-2]; +} + +static ERTS_INLINE Sint get_largest_power_of_base(Uint base) { + return largest_power_of_base_lookup[base-2]; +} + /* ** compare two number vectors */ @@ -1487,20 +1506,8 @@ Eterm uint_to_big(Uint x, Eterm *y) Eterm uword_to_big(UWord x, Eterm *y) { -#if HALFWORD_HEAP - Uint upper = x >> 32; - Uint lower = x & 0xFFFFFFFFUL; - if (upper == 0) { - *y = make_pos_bignum_header(1); - } else { - *y = make_pos_bignum_header(2); - BIG_DIGIT(y, 1) = upper; - } - BIG_DIGIT(y, 0) = lower; -#else *y = make_pos_bignum_header(1); BIG_DIGIT(y, 0) = x; -#endif return make_big(y); } @@ -1525,7 +1532,7 @@ Eterm small_to_big(Sint x, Eterm *y) Eterm erts_uint64_to_big(Uint64 x, Eterm **hpp) { Eterm *hp = *hpp; -#if defined(ARCH_32) || HALFWORD_HEAP +#if defined(ARCH_32) if (x >= (((Uint64) 1) << 32)) { *hp = make_pos_bignum_header(2); BIG_DIGIT(hp, 0) = (Uint) (x & ((Uint) 0xffffffff)); @@ -1555,7 +1562,7 @@ Eterm erts_sint64_to_big(Sint64 x, Eterm **hpp) neg = 1; ux = -(Uint64)x; } -#if defined(ARCH_32) || HALFWORD_HEAP +#if defined(ARCH_32) if (ux >= (((Uint64) 1) << 32)) { if (neg) *hp = make_neg_bignum_header(2); @@ -1588,7 +1595,7 @@ erts_uint64_array_to_big(Uint **hpp, int neg, int len, Uint64 *array) pot_digits = digits = 0; for (i = 0; i < len; i++) { -#if defined(ARCH_32) || HALFWORD_HEAP +#if defined(ARCH_32) Uint low_val = array[i] & ((Uint) 0xffffffff); Uint high_val = (array[i] >> 32) & ((Uint) 0xffffffff); BIG_DIGIT(headerp, pot_digits) = low_val; @@ -1651,8 +1658,6 @@ big_to_double(Wterm x, double* resp) /* * Logic has been copied from erl_bif_guard.c and slightly * modified to use a static instead of dynamic heap - * - * HALFWORD: Return relative term with 'heap' as base. */ Eterm double_to_big(double x, Eterm *heap, Uint hsz) @@ -1683,7 +1688,7 @@ double_to_big(double x, Eterm *heap, Uint hsz) sz = BIG_NEED_SIZE(ds); /* number of words including arity */ hp = heap; - res = make_big_rel(hp, heap); + res = make_big(hp); xp = (ErtsDigit*) (hp + 1); ASSERT(ds < hsz); @@ -1733,8 +1738,10 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) short sign = BIG_SIGN(xp); ErtsDigit rem; Uint n = 0; + const Uint digits_per_Sint = get_digits_per_signed_int(10); + const Sint largest_pow_of_base = get_largest_power_of_base(10); - if (xl == 1 && *dx < D_DECIMAL_BASE) { + if (xl == 1 && *dx < largest_pow_of_base) { rem = *dx; if (rem == 0) { (*write_func)(arg, '0'); n++; @@ -1752,7 +1759,7 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) MOVE_DIGITS(tmp, dx, xl); while(1) { - tmpl = D_div(tmp, tmpl, D_DECIMAL_BASE, tmp, &rem); + tmpl = D_div(tmp, tmpl, largest_pow_of_base, tmp, &rem); if (tmpl == 1 && *tmp == 0) { while(rem) { (*write_func)(arg, (rem % 10)+'0'); n++; @@ -1760,7 +1767,7 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) } break; } else { - int i = D_DECIMAL_EXP; + Uint i = digits_per_Sint; while(i--) { (*write_func)(arg, (rem % 10)+'0'); n++; rem /= 10; @@ -2562,63 +2569,100 @@ int term_equals_2pow32(Eterm x) } } +static ERTS_INLINE int c2int_is_invalid_char(byte ch, int base) { + return (ch < '0' + || (ch > ('0' + base - 1) + && !(base > 10 + && ((ch >= 'a' && ch < ('a' + base - 10)) + || (ch >= 'A' && ch < ('A' + base - 10)))))); +} -#define IS_VALID_CHARACTER(CHAR,BASE) \ - (CHAR < '0' \ - || (CHAR > ('0' + BASE - 1) \ - && !(BASE > 10 \ - && ((CHAR >= 'a' && CHAR < ('a' + BASE - 10)) \ - || (CHAR >= 'A' && CHAR < ('A' + BASE - 10)))))) -#define CHARACTER_FROM_BASE(CHAR) \ - ((CHAR <= '9') ? CHAR - '0' : 10 + ((CHAR <= 'Z') ? CHAR - 'A' : CHAR - 'a')) -#define D_BASE_EXP(BASE) (d_base_exp_lookup[BASE-2]) -#define D_BASE_BASE(BASE) (d_base_base_lookup[BASE-2]) -#define LG2_LOOKUP(BASE) (lg2_lookup[base-2]) +static ERTS_INLINE byte c2int_digit_from_base(byte ch) { + return ch <= '9' ? ch - '0' + : (10 + (ch <= 'Z' ? ch - 'A' : ch - 'a')); +} /* - * for i in 2..64 do - * lg2_lookup[i-2] = log2(i) - * end - * How many bits are needed to store string of size n + * How many bits are needed to store 1 digit of given base in binary + * Wo.Alpha formula: Table [log2[n], {n,2,36}] */ -const double lg2_lookup[] = { 1.0, 1.58496, 2, 2.32193, 2.58496, 2.80735, 3.0, - 3.16993, 3.32193, 3.45943, 3.58496, 3.70044, 3.80735, 3.90689, 4.0, - 4.08746, 4.16993, 4.24793, 4.32193, 4.39232, 4.45943, 4.52356, 4.58496, - 4.64386, 4.70044, 4.75489, 4.80735, 4.85798, 4.90689, 4.9542, 5.0, - 5.04439, 5.08746, 5.12928, 5.16993, 5.20945, 5.24793, 5.2854, 5.32193, - 5.35755, 5.39232, 5.42626, 5.45943, 5.49185, 5.52356, 5.55459, 5.58496, - 5.61471, 5.64386, 5.67243, 5.70044, 5.72792, 5.75489, 5.78136, 5.80735, - 5.83289, 5.85798, 5.88264, 5.90689, 5.93074, 5.9542, 5.97728, 6.0 }; +static const double lg2_lookup[36-1] = { + 1.0, 1.58496, 2.0, 2.32193, 2.58496, 2.80735, 3.0, 3.16993, 3.32193, + 3.45943, 3.58496, 3.70044, 3.80735, 3.90689, 4.0, 4.08746, 4.16993, 4.24793, + 4.32193, 4.39232, 4.45943, 4.52356, 4.58496, 4.64386, 4.70044, 4.75489, + 4.80735, 4.85798, 4.90689, 4.9542, 5.0, 5.04439, 5.08746, 5.12928, 5.16993 +}; +static ERTS_INLINE double lookup_log2(Uint base) { + return lg2_lookup[base - 2]; +} /* - * for i in 2..64 do - * d_base_exp_lookup[i-2] = 31 / lg2_lookup[i-2]; - * end - * How many characters can fit in 31 bits + * How many digits can fit into a signed int (Sint) for given base, we take + * one digit away just to be on the safer side (some corner cases). */ -const byte d_base_exp_lookup[] = { 31, 19, 15, 13, 11, 11, 10, 9, 9, 8, 8, 8, 8, - 7, 7, 7, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5 }; +static const byte digits_per_sint_lookup[36-1] = { +#if (SIZEOF_VOID_P == 4) + /* Wo.Alpha formula: Table [Trunc[31 / log[2,n]]-1, {n, 2, 36}] */ + 30, 18, 14, 12, 10, 10, 9, 8, 8, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 4 +#elif (SIZEOF_VOID_P == 8) + /* Wo.Alpha formula: Table [Trunc[63 / log[2,n]]-1, {n, 2, 36}] */ + 62, 38, 30, 26, 23, 21, 20, 18, 17, 17, 16, 16, 15, 15, 14, 14, 14, 13, 13, + 13, 13, 12, 12, 12, 12, 12, 12, 11, 11, 11, 11, 11, 11, 11, 11 +#else + #error "Please produce a lookup table for the new architecture" +#endif +}; + +/* + * How many digits can fit into Erlang Small (SMALL_BITS-1) counting sign bit + */ +static const byte digits_per_small_lookup[36-1] = { +#if (SIZEOF_VOID_P == 4) + /* Wo.Alpha formula: Table [Trunc[27 / log[2,n]]-1, {n, 2, 36}] */ + 27, 17, 13, 11, 10, 9, 9, 8, 8, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 +#elif (SIZEOF_VOID_P == 8) + /* Wo.Alpha formula: Table [Trunc[59 / log[2,n]]-1, {n, 2, 36}] */ + 59, 37, 29, 25, 22, 21, 19, 18, 17, 17, 16, 15, 15, 15, 14, 14, 14, 13, 13, + 13, 13, 13, 12, 12, 12, 12, 12, 12, 12, 11, 11, 11, 11, 11, 11 +#else + #error "Please produce a lookup table for the new architecture" +#endif +}; /* - * for i in 2..64 do - * d_base_base_lookup[i-2] = pow(i,d_base_exp_lookup[i-2]); - * end - * How much can the characters which fit in 31 bit represent + * Largest power of base which can be represented in a signed int (Sint). + * Calculated by base 2..36 to the power of corresponding element from + * digits_per_sint_lookup. */ -const Uint d_base_base_lookup[] = { 2147483648u, 1162261467u, 1073741824u, - 1220703125u, 362797056u, 1977326743u, 1073741824u, 387420489u, - 1000000000u, 214358881u, 429981696u, 815730721u, 1475789056u, - 170859375u, 268435456u, 410338673u, 612220032u, 893871739u, 1280000000u, - 1801088541u, 113379904u, 148035889u, 191102976u, 244140625u, 308915776u, - 387420489u, 481890304u, 594823321u, 729000000u, 887503681u, 1073741824u, - 1291467969u, 1544804416u, 1838265625u, 60466176u, 69343957u, 79235168u, - 90224199u, 102400000u, 115856201u, 130691232u, 147008443u, 164916224u, - 184528125u, 205962976u, 229345007u, 254803968u, 282475249u, 312500000u, - 345025251u, 380204032u, 418195493u, 459165024u, 503284375u, 550731776u, - 601692057u, 656356768u, 714924299u, 777600000u, 844596301u, 916132832u, - 992436543u, 1073741824u }; +static const Sint largest_power_of_base_lookup[36-1] = { +#if (SIZEOF_VOID_P == 4) + /* Wo.Alpha formula: Table [Pow[n, Trunc[31 / log[2,n]]-1], {n, 2, 36}] */ + 1073741824, 387420489, 268435456, 244140625, 60466176, 282475249, 134217728, + 43046721, 100000000, 19487171, 35831808, 62748517, 105413504, 11390625, + 16777216, 24137569, 34012224, 47045881, 64000000, 85766121, 5153632, + 6436343,7962624, 9765625, 11881376, 14348907, 17210368, 20511149, 24300000, + 28629151, 33554432, 39135393, 45435424, 52521875, 1679616 +#elif (SIZEOF_VOID_P == 8) + /* Wo.Alpha formula: Table [Pow[n, Trunc[63 / log[2,n]]-1], {n, 2, 36}] + * with LL added after each element manually */ + 4611686018427387904LL, 1350851717672992089LL, 1152921504606846976LL, + 1490116119384765625LL, 789730223053602816LL, 558545864083284007LL, + 1152921504606846976LL, 150094635296999121LL, 100000000000000000LL, + 505447028499293771LL, 184884258895036416LL, 665416609183179841LL, + 155568095557812224LL, 437893890380859375LL, 72057594037927936LL, + 168377826559400929LL, 374813367582081024LL, 42052983462257059LL, + 81920000000000000LL, 154472377739119461LL, 282810057883082752LL, + 21914624432020321LL, 36520347436056576LL, 59604644775390625LL, + 95428956661682176LL, 150094635296999121LL, 232218265089212416LL, + 12200509765705829LL, 17714700000000000LL, 25408476896404831LL, + 36028797018963968LL, 50542106513726817LL, 70188843638032384LL, + 96549157373046875LL, 131621703842267136LL +#else + #error "Please produce a lookup table for the new architecture" +#endif +}; Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, Uint size, const int base) { @@ -2628,8 +2672,11 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, int neg = 0; byte b; Eterm *hp, *hp_end; - int m; + Sint m; int lg2; + const Uint digits_per_small = get_digits_per_small(base); + const Uint digits_per_Sint = get_digits_per_signed_int(base); + const Sint largest_pow_of_base = get_largest_power_of_base(base); if (size == 0) goto bytebuf_to_integer_1_error; @@ -2644,57 +2691,68 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, size--; } + /* Trim leading zeroes */ + if (size) { + while (*bytes == '0') { + bytes++; + size--; + if (!size) { + /* All zero! */ + res = make_small(0); + goto bytebuf_to_integer_1_done; + } + } + } + if (size == 0) goto bytebuf_to_integer_1_error; - if (size < SMALL_DIGITS && base <= 10) { - /* * - * Take shortcut if we know that all chars are '0' < b < '9' and - * fit in a small. This improves speed by about 10% over the generic - * small case. - * */ - while (size--) { - b = *bytes++; + if (size < digits_per_small) { + if (base <= 10) { + /* * + * Take shortcut if we know that all chars are '0' < b < '9' and + * fit in a small. This improves speed by about 10% over the generic + * small case. + * */ + while (size--) { + b = *bytes++; - if (b < '0' || b > ('0'+base-1)) - goto bytebuf_to_integer_1_error; + if (b < '0' || b > ('0'+base-1)) + goto bytebuf_to_integer_1_error; - i = i * base + b - '0'; - } + i = i * base + b - '0'; + } - if (neg) - i = -i; - res = make_small(i); - goto bytebuf_to_integer_1_done; + if (neg) + i = -i; + res = make_small(i); + goto bytebuf_to_integer_1_done; + } + + /* Take shortcut if we know it will fit in a small. + * This improves speed by about 30%. + */ + while (size) { + b = *bytes++; + size--; + + if (c2int_is_invalid_char(b, base)) + goto bytebuf_to_integer_1_error; + + i = i * base + c2int_digit_from_base(b); + } + + if (neg) + i = -i; + res = make_small(i); + goto bytebuf_to_integer_1_done; } /* * Calculate the maximum number of bits which will * be needed to represent the binary */ - lg2 = ((size+2)*LG2_LOOKUP(base)+1); - - if (lg2 < SMALL_BITS) { - /* Take shortcut if we know it will fit in a small. - * This improves speed by about 30%. - */ - while (size) { - b = *bytes++; - size--; - - if (IS_VALID_CHARACTER(b,base)) - goto bytebuf_to_integer_1_error; - - i = i * base + CHARACTER_FROM_BASE(b); - - } - - if (neg) - i = -i; - res = make_small(i); - goto bytebuf_to_integer_1_done; - - } + lg2 = ((size+2)*lookup_log2(base)+1); /* Start calculating bignum */ m = (lg2 + D_EXP-1)/D_EXP; @@ -2703,8 +2761,8 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, hp = HAlloc(BIF_P, m); hp_end = hp + m; - if ((i = (size % D_BASE_EXP(base))) == 0) - i = D_BASE_EXP(base); + if ((i = (size % digits_per_Sint)) == 0) + i = digits_per_Sint; n = size - i; m = 0; @@ -2712,34 +2770,34 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, while (i--) { b = *bytes++; - if (IS_VALID_CHARACTER(b,base)) { + if (c2int_is_invalid_char(b,base)) { HRelease(BIF_P, hp_end, hp); goto bytebuf_to_integer_1_error; } - m = base * m + CHARACTER_FROM_BASE(b); + m = base * m + c2int_digit_from_base(b); } res = small_to_big(m, hp); while (n) { - i = D_BASE_EXP(base); - n -= D_BASE_EXP(base); + i = digits_per_Sint; + n -= digits_per_Sint; m = 0; while (i--) { b = *bytes++; - if (IS_VALID_CHARACTER(b,base)) { + if (c2int_is_invalid_char(b,base)) { HRelease(BIF_P, hp_end, hp); goto bytebuf_to_integer_1_error; } - m = base * m + CHARACTER_FROM_BASE(b); + m = base * m + c2int_digit_from_base(b); } if (is_small(res)) { res = small_to_big(signed_val(res), hp); } - res = big_times_small(res, D_BASE_BASE(base), hp); + res = big_times_small(res, largest_pow_of_base, hp); if (is_small(res)) { res = small_to_big(signed_val(res), hp); } @@ -2770,5 +2828,166 @@ bytebuf_to_integer_1_error: bytebuf_to_integer_1_done: return res; +} +/* Converts list of digits with given 'base' to integer sequentially. Returns + * result in 'integer_out', remaining tail goes to 'tail_out' and returns result + * code if the list was consumed fully or partially or there was an error + */ +LTI_result_t erts_list_to_integer(Process *BIF_P, Eterm orig_list, + const Uint base, + Eterm *integer_out, Eterm *tail_out) +{ + Sint i = 0; + Uint ui = 0; + int skip = 0; + int neg = 0; + Sint n = 0; + Sint m; + int lg2; + Eterm res; + Eterm lst = orig_list; + Eterm tail = lst; + int error_res = LTI_BAD_STRUCTURE; + const Uint digits_per_small = get_digits_per_small(base); + const Uint digits_per_Sint = get_digits_per_signed_int(base); + + if (is_nil(lst)) { + error_res = LTI_NO_INTEGER; + error: + *tail_out = tail; + *integer_out = make_small(0); + return error_res; + } + if (is_not_list(lst)) + goto error; + + /* if first char is a '-' then it is a negative integer */ + if (CAR(list_val(lst)) == make_small('-')) { + neg = 1; + skip = 1; + lst = CDR(list_val(lst)); + if (is_not_list(lst)) { + tail = lst; + error_res = LTI_NO_INTEGER; + goto error; + } + } else if (CAR(list_val(lst)) == make_small('+')) { + /* ignore plus */ + skip = 1; + lst = CDR(list_val(lst)); + if (is_not_list(lst)) { + tail = lst; + error_res = LTI_NO_INTEGER; + goto error; + } + } + + /* Calculate size and do type check */ + + while(1) { + byte ch; + if (is_not_small(CAR(list_val(lst)))) { + break; + } + ch = unsigned_val(CAR(list_val(lst))); + if (c2int_is_invalid_char(ch, base)) { + break; + } + ui = ui * base; + ui = ui + c2int_digit_from_base(ch); + n++; + lst = CDR(list_val(lst)); + if (is_nil(lst)) { + break; + } + if (is_not_list(lst)) { + break; + } + } + + tail = lst; + if (!n) { + error_res = LTI_NO_INTEGER; + goto error; + } + + + /* If length fits inside Sint then we know it's a small int. Else we + * must construct a bignum and let that routine do the checking + */ + + if (n <= digits_per_small) { /* It must be small */ + i = neg ? -(Sint)ui : (Sint)ui; + res = make_small(i); + } else { + const Sint largest_pow_of_base = get_largest_power_of_base(base); + Eterm *hp; + Eterm *hp_end; + + /* Convert from log_base to log2 using lookup table */ + lg2 = ((n+2)*lookup_log2(base)+1); + m = (lg2+D_EXP-1)/D_EXP; /* number of digits */ + m = BIG_NEED_SIZE(m); /* number of words + thing */ + + hp = HAlloc(BIF_P, m); + hp_end = hp + m; + + lst = orig_list; + if (skip) + lst = CDR(list_val(lst)); + + /* load first digits (at least one digit) */ + if ((i = (n % digits_per_Sint)) == 0) + i = digits_per_Sint; + n -= i; + m = 0; + while(i--) { + m *= base; + m += c2int_digit_from_base(unsigned_val(CAR(list_val(lst)))); + lst = CDR(list_val(lst)); + } + res = small_to_big(m, hp); /* load first digits */ + + while(n) { + i = digits_per_Sint; + n -= digits_per_Sint; + m = 0; + while(i--) { + m *= base; + m += c2int_digit_from_base(unsigned_val(CAR(list_val(lst)))); + lst = CDR(list_val(lst)); + } + if (is_small(res)) + res = small_to_big(signed_val(res), hp); + res = big_times_small(res, largest_pow_of_base, hp); + if (is_small(res)) + res = small_to_big(signed_val(res), hp); + res = big_plus_small(res, m, hp); + } + + if (neg) { + if (is_small(res)) + res = make_small(-signed_val(res)); + else { + Uint *big = big_val(res); /* point to thing */ + *big = bignum_header_neg(*big); + } + } + + if (is_not_small(res)) { + res = big_plus_small(res, 0, hp); /* includes conversion to small */ + + if (is_not_small(res)) { + hp += (big_arity(res)+1); + } + } + HRelease(BIF_P, hp_end, hp); + } + *integer_out = res; + *tail_out = tail; + if (tail != NIL) { + return LTI_SOME_INTEGER; + } + return LTI_ALL_INTEGER; } diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 3c1f1e6b23..464acd67f6 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -35,7 +35,7 @@ typedef Uint ErtsDigit; -#if ((SIZEOF_VOID_P == 4) || HALFWORD_HEAP) && defined(SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG == 8) +#if (SIZEOF_VOID_P == 4) && defined(SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG == 8) /* Assume 32-bit machine with long long support */ typedef Uint64 ErtsDoubleDigit; typedef Uint16 ErtsHalfDigit; @@ -54,9 +54,6 @@ typedef Uint32 ErtsHalfDigit; #error "can not determine machine size" #endif -#define D_DECIMAL_EXP 9 -#define D_DECIMAL_BASE 1000000000 - typedef Uint dsize_t; /* Vector size type */ #define D_EXP (ERTS_SIZEOF_ETERM*8) @@ -90,13 +87,9 @@ typedef Uint dsize_t; /* Vector size type */ #define BIG_UINT_HEAP_SIZE (1 + 1) /* always, since sizeof(Uint) <= sizeof(Eterm) */ -#if HALFWORD_HEAP -#define BIG_UWORD_HEAP_SIZE(UW) (((UW) >> (sizeof(Uint) * 8)) ? 3 : 2) -#else #define BIG_UWORD_HEAP_SIZE(UW) BIG_UINT_HEAP_SIZE -#endif -#if defined(ARCH_32) || HALFWORD_HEAP +#if defined(ARCH_32) #define ERTS_UINT64_BIG_HEAP_SIZE__(X) \ ((X) >= (((Uint64) 1) << 32) ? (1 + 2) : (1 + 1)) @@ -178,5 +171,15 @@ Eterm erts_sint64_to_big(Sint64, Eterm **); Eterm erts_chars_to_integer(Process *, char*, Uint, const int); +/* How list_to_integer classifies the input, was it even a string? */ +typedef enum { + LTI_BAD_STRUCTURE = 0, + LTI_NO_INTEGER = 1, + LTI_SOME_INTEGER = 2, + LTI_ALL_INTEGER = 3 +} LTI_result_t; + +LTI_result_t erts_list_to_integer(Process *BIF_P, Eterm orig_list, + const Uint base, + Eterm *integer_out, Eterm *tail_out); #endif - diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index 247c8f1122..cfd8fbe2f5 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -34,6 +34,9 @@ #include "erl_binary.h" #include "erl_bits.h" +#define L2B_B2L_MIN_EXEC_REDS (CONTEXT_REDS/4) +#define L2B_B2L_RESCHED_REDS (CONTEXT_REDS/40) + static Export binary_to_list_continue_export; static Export list_to_binary_continue_export; @@ -415,10 +418,10 @@ binary_to_list_chunk(Process *c_p, } static ERTS_INLINE BIF_RETTYPE -binary_to_list(Process *c_p, Eterm *hp, Eterm tail, byte *bytes, Uint size, Uint bitoffs) +binary_to_list(Process *c_p, Eterm *hp, Eterm tail, byte *bytes, + Uint size, Uint bitoffs, int reds_left, int one_chunk) { - int reds_left = ERTS_BIF_REDS_LEFT(c_p); - if (size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION) { + if (one_chunk) { Eterm res; BIF_RETTYPE ret; int bump_reds = (size - 1)/ERTS_B2L_BYTES_PER_REDUCTION + 1; @@ -472,11 +475,29 @@ BIF_RETTYPE binary_to_list_1(BIF_ALIST_1) Uint size; Uint bitsize; Uint bitoffs; + int reds_left; + int one_chunk; if (is_not_binary(BIF_ARG_1)) { goto error; } + size = binary_size(BIF_ARG_1); + reds_left = ERTS_BIF_REDS_LEFT(BIF_P); + one_chunk = size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION; + if (!one_chunk) { + if (size < L2B_B2L_MIN_EXEC_REDS*ERTS_B2L_BYTES_PER_REDUCTION) { + if (reds_left <= L2B_B2L_RESCHED_REDS) { + /* Yield and do it with full context reds... */ + ERTS_BIF_YIELD1(bif_export[BIF_binary_to_list_1], + BIF_P, BIF_ARG_1); + } + /* Allow a bit more reductions... */ + one_chunk = 1; + reds_left = L2B_B2L_MIN_EXEC_REDS; + } + } + ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize); if (bitsize != 0) { goto error; @@ -486,7 +507,8 @@ BIF_RETTYPE binary_to_list_1(BIF_ALIST_1) } else { Eterm* hp = HAlloc(BIF_P, 2 * size); byte* bytes = binary_bytes(real_bin)+offset; - return binary_to_list(BIF_P, hp, NIL, bytes, size, bitoffs); + return binary_to_list(BIF_P, hp, NIL, bytes, size, + bitoffs, reds_left, one_chunk); } error: @@ -505,6 +527,8 @@ BIF_RETTYPE binary_to_list_3(BIF_ALIST_3) Uint start; Uint stop; Eterm* hp; + int reds_left; + int one_chunk; if (is_not_binary(BIF_ARG_1)) { goto error; @@ -513,6 +537,21 @@ BIF_RETTYPE binary_to_list_3(BIF_ALIST_3) goto error; } size = binary_size(BIF_ARG_1); + reds_left = ERTS_BIF_REDS_LEFT(BIF_P); + one_chunk = size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION; + if (!one_chunk) { + if (size < L2B_B2L_MIN_EXEC_REDS*ERTS_B2L_BYTES_PER_REDUCTION) { + if (reds_left <= L2B_B2L_RESCHED_REDS) { + /* Yield and do it with full context reds... */ + ERTS_BIF_YIELD3(bif_export[BIF_binary_to_list_3], + BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + } + /* Allow a bit more reductions... */ + one_chunk = 1; + reds_left = L2B_B2L_MIN_EXEC_REDS; + } + } + ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize); if (start < 1 || start > size || stop < 1 || stop > size || stop < start ) { @@ -520,7 +559,8 @@ BIF_RETTYPE binary_to_list_3(BIF_ALIST_3) } i = stop-start+1; hp = HAlloc(BIF_P, 2*i); - return binary_to_list(BIF_P, hp, NIL, bytes+start-1, i, bitoffs); + return binary_to_list(BIF_P, hp, NIL, bytes+start-1, i, + bitoffs, reds_left, one_chunk); error: BIF_ERROR(BIF_P, BADARG); } @@ -537,11 +577,27 @@ BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1) byte* bytes; Eterm previous = NIL; Eterm* hp; + int reds_left; + int one_chunk; if (is_not_binary(BIF_ARG_1)) { BIF_ERROR(BIF_P, BADARG); } size = binary_size(BIF_ARG_1); + reds_left = ERTS_BIF_REDS_LEFT(BIF_P); + one_chunk = size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION; + if (!one_chunk) { + if (size < L2B_B2L_MIN_EXEC_REDS*ERTS_B2L_BYTES_PER_REDUCTION) { + if (reds_left <= L2B_B2L_RESCHED_REDS) { + /* Yield and do it with full context reds... */ + ERTS_BIF_YIELD1(bif_export[BIF_bitstring_to_list_1], + BIF_P, BIF_ARG_1); + } + /* Allow a bit more reductions... */ + one_chunk = 1; + reds_left = L2B_B2L_MIN_EXEC_REDS; + } + } ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize); bytes = binary_bytes(real_bin)+offset; if (bitsize == 0) { @@ -566,7 +622,8 @@ BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1) hp += 2; } - return binary_to_list(BIF_P, hp, previous, bytes, size, bitoffs); + return binary_to_list(BIF_P, hp, previous, bytes, size, + bitoffs, reds_left, one_chunk); } @@ -795,8 +852,19 @@ static BIF_RETTYPE list_to_binary_continue(BIF_ALIST_1) BIF_RETTYPE erts_list_to_binary_bif(Process *c_p, Eterm arg, Export *bif) { + int orig_reds_left = ERTS_BIF_REDS_LEFT(c_p); BIF_RETTYPE ret; + if (orig_reds_left < L2B_B2L_MIN_EXEC_REDS) { + if (orig_reds_left <= L2B_B2L_RESCHED_REDS) { + /* Yield and do it with full context reds... */ + ERTS_BIF_PREP_YIELD1(ret, bif, c_p, arg); + return ret; + } + /* Allow a bit more reductions... */ + orig_reds_left = L2B_B2L_MIN_EXEC_REDS; + } + if (is_nil(arg)) ERTS_BIF_PREP_RET(ret, new_binary(c_p, (byte *) "", 0)); else if (is_not_list(arg)) @@ -818,7 +886,6 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *c_p, Eterm arg, Export *bif) bif, erts_iolist_size_yielding, erts_iolist_to_buf_yielding); - int orig_reds_left = ERTS_BIF_REDS_LEFT(c_p); /* * First try to do it all at once without having to use diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 0ddf7f4e6d..d02c6828f9 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -252,7 +252,7 @@ print_process_info(int to, void *to_arg, Process *p) /* display the message queue only if there is anything in it */ if (!ERTS_IS_CRASH_DUMPING && p->msg.first != NULL && !garbing) { - ErlMessage* mp; + ErtsMessage* mp; erts_print(to, to_arg, "Message queue: ["); for (mp = p->msg.first; mp; mp = mp->next) erts_print(to, to_arg, mp->next ? "%T," : "%T", ERL_MESSAGE_TERM(mp)); @@ -323,7 +323,7 @@ print_process_info(int to, void *to_arg, Process *p) erts_print(to, to_arg, "Heap unused: %bpu\n", (p->hend - p->htop)); erts_print(to, to_arg, "OldHeap unused: %bpu\n", (OLD_HEAP(p) == NULL) ? 0 : (OLD_HEND(p) - OLD_HTOP(p)) ); - erts_print(to, to_arg, "Memory: %beu\n", erts_process_memory(p)); + erts_print(to, to_arg, "Memory: %beu\n", erts_process_memory(p, !0)); if (garbing) { print_garb_info(to, to_arg, p); @@ -347,8 +347,11 @@ print_process_info(int to, void *to_arg, Process *p) static void print_garb_info(int to, void *to_arg, Process* p) { +#ifdef ERTS_SMP /* ERTS_SMP: A scheduler is probably concurrently doing gc... */ -#ifndef ERTS_SMP + if (!ERTS_IS_CRASH_DUMPING) + return; +#endif erts_print(to, to_arg, "New heap start: %bpX\n", p->heap); erts_print(to, to_arg, "New heap top: %bpX\n", p->htop); erts_print(to, to_arg, "Stack top: %bpX\n", p->stop); @@ -356,7 +359,6 @@ print_garb_info(int to, void *to_arg, Process* p) erts_print(to, to_arg, "Old heap start: %bpX\n", OLD_HEAP(p)); erts_print(to, to_arg, "Old heap top: %bpX\n", OLD_HTOP(p)); erts_print(to, to_arg, "Old heap end: %bpX\n", OLD_HEND(p)); -#endif } void @@ -381,7 +383,7 @@ loaded(int to, void *to_arg) int i; int old = 0; int cur = 0; - BeamInstr* code; + BeamCodeHeader* code; Module* modp; ErtsCodeIndex code_ix; @@ -439,30 +441,30 @@ loaded(int to, void *to_arg) erts_print(to, to_arg, "\n"); erts_print(to, to_arg, "Current size: %d\n", modp->curr.code_length); - code = modp->curr.code; - if (code != NULL && code[MI_ATTR_PTR]) { + code = modp->curr.code_hdr; + if (code != NULL && code->attr_ptr) { erts_print(to, to_arg, "Current attributes: "); - dump_attributes(to, to_arg, (byte *) code[MI_ATTR_PTR], - code[MI_ATTR_SIZE]); + dump_attributes(to, to_arg, code->attr_ptr, + code->attr_size); } - if (code != NULL && code[MI_COMPILE_PTR]) { + if (code != NULL && code->compile_ptr) { erts_print(to, to_arg, "Current compilation info: "); - dump_attributes(to, to_arg, (byte *) code[MI_COMPILE_PTR], - code[MI_COMPILE_SIZE]); + dump_attributes(to, to_arg, code->compile_ptr, + code->compile_size); } if (modp->old.code_length != 0) { erts_print(to, to_arg, "Old size: %d\n", modp->old.code_length); - code = modp->old.code; - if (code[MI_ATTR_PTR]) { + code = modp->old.code_hdr; + if (code->attr_ptr) { erts_print(to, to_arg, "Old attributes: "); - dump_attributes(to, to_arg, (byte *) code[MI_ATTR_PTR], - code[MI_ATTR_SIZE]); + dump_attributes(to, to_arg, code->attr_ptr, + code->attr_size); } - if (code[MI_COMPILE_PTR]) { + if (code->compile_ptr) { erts_print(to, to_arg, "Old compilation info: "); - dump_attributes(to, to_arg, (byte *) code[MI_COMPILE_PTR], - code[MI_COMPILE_SIZE]); + dump_attributes(to, to_arg, code->compile_ptr, + code->compile_size); } } } @@ -684,7 +686,7 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) crash dump. */ erts_thr_progress_fatal_error_block(&tpd_buf); -#ifdef ERTS_THR_HAVE_SIG_FUNCS +#ifdef ERTS_SYS_SUSPEND_SIGNAL /* * We suspend all scheduler threads so that we can dump some * data about the currently running processes and scheduler data. @@ -818,7 +820,7 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) #ifdef ERTS_SMP -#if defined(ERTS_THR_HAVE_SIG_FUNCS) +#ifdef ERTS_SYS_SUSPEND_SIGNAL /* We resume all schedulers so that we are in a known safe state when we write the rest of the crash dump */ diff --git a/erts/emulator/beam/code_ix.c b/erts/emulator/beam/code_ix.c index 209d008d18..ec6267711b 100644 --- a/erts/emulator/beam/code_ix.c +++ b/erts/emulator/beam/code_ix.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012. All Rights Reserved. + * Copyright Ericsson AB 2012-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -65,12 +65,12 @@ void erts_code_ix_init(void) CIX_TRACE("init"); } -void erts_start_staging_code_ix(void) +void erts_start_staging_code_ix(int num_new) { beam_catches_start_staging(); export_start_staging(); module_start_staging(); - erts_start_staging_ranges(); + erts_start_staging_ranges(num_new); CIX_TRACE("start"); } @@ -94,6 +94,7 @@ void erts_commit_staging_code_ix(void) ix = (ix + 1) % ERTS_NUM_CODE_IX; erts_smp_atomic32_set_nob(&the_staging_code_index, ix); export_staging_unlock(); + erts_tracer_nif_clear(); CIX_TRACE("activate"); } diff --git a/erts/emulator/beam/code_ix.h b/erts/emulator/beam/code_ix.h index 5f00b409ef..584a605771 100644 --- a/erts/emulator/beam/code_ix.h +++ b/erts/emulator/beam/code_ix.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012-2013. All Rights Reserved. + * Copyright Ericsson AB 2012-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -100,7 +100,7 @@ void erts_release_code_write_permission(void); * Must be followed by calls to either "end" and "commit" or "abort" before * code write permission can be released. */ -void erts_start_staging_code_ix(void); +void erts_start_staging_code_ix(int num_new); /* End the staging. * Preceded by "start" and must be followed by "commit". diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 64be43edb4..ccc4cbad43 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2012. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -35,56 +35,59 @@ #include "erl_bits.h" #include "dtrace-wrapper.h" -static void move_one_frag(Eterm** hpp, ErlHeapFragment*, ErlOffHeap*); +static void move_one_frag(Eterm** hpp, ErlHeapFragment*, ErlOffHeap*, int); /* * Copy object "obj" to process p. */ -Eterm -copy_object(Eterm obj, Process* to) -{ - Uint size = size_object(obj); - Eterm* hp = HAlloc(to, size); - Eterm res; +Eterm copy_object_x(Eterm obj, Process* to, Uint extra) { + if (!is_immed(obj)) { + Uint size = size_object(obj); + Eterm* hp = HAllocX(to, size, extra); + Eterm res; #ifdef USE_VM_PROBES - if (DTRACE_ENABLED(copy_object)) { - DTRACE_CHARBUF(proc_name, 64); + if (DTRACE_ENABLED(copy_object)) { + DTRACE_CHARBUF(proc_name, 64); - erts_snprintf(proc_name, sizeof(DTRACE_CHARBUF_NAME(proc_name)), - "%T", to->common.id); - DTRACE2(copy_object, proc_name, size); - } + erts_snprintf(proc_name, sizeof(DTRACE_CHARBUF_NAME(proc_name)), + "%T", to->common.id); + DTRACE2(copy_object, proc_name, size); + } #endif - res = copy_struct(obj, size, &hp, &to->off_heap); + res = copy_struct(obj, size, &hp, &to->off_heap); #ifdef DEBUG - if (eq(obj, res) == 0) { - erts_exit(ERTS_ABORT_EXIT, "copy not equal to source\n"); - } + if (eq(obj, res) == 0) { + erts_exit(ERTS_ABORT_EXIT, "copy not equal to source\n"); + } #endif - return res; + return res; + } + return obj; } /* * Return the "flat" size of the object. */ -#if HALFWORD_HEAP -Uint size_object_rel(Eterm obj, Eterm* base) -#else Uint size_object(Eterm obj) -#endif { Uint sum = 0; Eterm* ptr; int arity; +#ifdef DEBUG + Eterm mypid = erts_get_current_pid(); +#endif DECLARE_ESTACK(s); + + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size_object %p\n", mypid, obj)); + for (;;) { switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: sum += 2; - ptr = list_val_rel(obj,base); + ptr = list_val(obj); obj = *ptr++; if (!IS_CONST(obj)) { ESTACK_PUSH(s, obj); @@ -93,11 +96,11 @@ Uint size_object(Eterm obj) break; case TAG_PRIMARY_BOXED: { - Eterm hdr = *boxed_val_rel(obj,base); + Eterm hdr = *boxed_val(obj); ASSERT(is_header(hdr)); switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: - ptr = tuple_val_rel(obj,base); + ptr = tuple_val(obj); arity = header_arity(hdr); sum += arity + 1; if (arity == 0) { /* Empty tuple -- unusual. */ @@ -113,7 +116,7 @@ Uint size_object(Eterm obj) break; case FUN_SUBTAG: { - Eterm* bptr = fun_val_rel(obj,base); + Eterm* bptr = fun_val(obj); ErlFunThing* funp = (ErlFunThing *) bptr; unsigned eterms = 1 /* creator */ + funp->num_free; unsigned sz = thing_arityval(hdr); @@ -134,7 +137,7 @@ Uint size_object(Eterm obj) { Uint n; flatmap_t *mp; - mp = (flatmap_t*)flatmap_val_rel(obj,base); + mp = (flatmap_t*)flatmap_val(obj); ptr = (Eterm *)mp; n = flatmap_get_size(mp) + 1; sum += n + 2; @@ -153,7 +156,7 @@ Uint size_object(Eterm obj) { Eterm *head; Uint sz; - head = hashmap_val_rel(obj, base); + head = hashmap_val(obj); sz = hashmap_bitcount(MAP_HEADER_VAL(hdr)); sum += 1 + sz + header_arity(hdr); head += 1 + header_arity(hdr); @@ -182,7 +185,7 @@ Uint size_object(Eterm obj) Uint bitoffs; Uint extra_bytes; Eterm hdr; - ERTS_GET_REAL_BIN_REL(obj, real_bin, offset, bitoffs, bitsize, base); + ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize); if ((bitsize + bitoffs) > 8) { sum += ERL_SUB_BIN_SIZE; extra_bytes = 2; @@ -192,11 +195,11 @@ Uint size_object(Eterm obj) } else { extra_bytes = 0; } - hdr = *binary_val_rel(real_bin,base); + hdr = *binary_val(real_bin); if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) { sum += PROC_BIN_SIZE; } else { - sum += heap_bin_size(binary_size_rel(obj,base)+extra_bytes); + sum += heap_bin_size(binary_size(obj)+extra_bytes); } goto pop_next; } @@ -214,6 +217,7 @@ Uint size_object(Eterm obj) pop_next: if (ESTACK_ISEMPTY(s)) { DESTROY_ESTACK(s); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size was: %u\n", mypid, sum)); return sum; } obj = ESTACK_POP(s); @@ -225,14 +229,377 @@ Uint size_object(Eterm obj) } /* + * Machinery for sharing preserving information + * Using a WSTACK but not very transparently; consider refactoring + */ + +#define DECLARE_BITSTORE(s) \ + DECLARE_WSTACK(s); \ + int WSTK_CONCAT(s,_bitoffs) = 0; \ + int WSTK_CONCAT(s,_offset) = 0; \ + UWord WSTK_CONCAT(s,_buffer) = 0 + +#define DESTROY_BITSTORE(s) DESTROY_WSTACK(s) +#define BITSTORE_PUT(s,i) \ +do { \ + WSTK_CONCAT(s,_buffer) |= i << WSTK_CONCAT(s,_bitoffs); \ + WSTK_CONCAT(s,_bitoffs) += 2; \ + if (WSTK_CONCAT(s,_bitoffs) >= 8*sizeof(UWord)) { \ + WSTACK_PUSH(s, WSTK_CONCAT(s,_buffer)); \ + WSTK_CONCAT(s,_bitoffs) = 0; \ + WSTK_CONCAT(s,_buffer) = 0; \ + } \ +} while(0) +#define BITSTORE_CLOSE(s) \ +do { \ + if (WSTK_CONCAT(s,_bitoffs) > 0) { \ + WSTACK_PUSH(s, WSTK_CONCAT(s,_buffer)); \ + WSTK_CONCAT(s,_bitoffs) = 0; \ + } \ +} while(0) + +#define BITSTORE_FETCH(s,dst) \ +do { \ + UWord result; \ + if (WSTK_CONCAT(s,_bitoffs) <= 0) { \ + WSTK_CONCAT(s,_buffer) = s.wstart[WSTK_CONCAT(s,_offset)]; \ + WSTK_CONCAT(s,_offset)++; \ + WSTK_CONCAT(s,_bitoffs) = 8*sizeof(UWord); \ + } \ + WSTK_CONCAT(s,_bitoffs) -= 2; \ + result = WSTK_CONCAT(s,_buffer) & 3; \ + WSTK_CONCAT(s,_buffer) >>= 2; \ + (dst) = result; \ +} while(0) + +#define BOXED_VISITED_MASK ((Eterm) 3) +#define BOXED_VISITED ((Eterm) 1) +#define BOXED_SHARED_UNPROCESSED ((Eterm) 2) +#define BOXED_SHARED_PROCESSED ((Eterm) 3) + +#define COUNT_OFF_HEAP (0) + +#define IN_LITERAL_PURGE_AREA(info, ptr) \ + ((info)->range_ptr && ( \ + (info)->range_ptr <= (ptr) && \ + (ptr) < ((info)->range_ptr + (info)->range_sz))) +/* + * Return the real size of an object and find sharing information + * This currently returns the same as erts_debug:size/1. + * It is argued whether the size of subterms in constant pools + * should be counted or not. + */ + +Uint size_shared(Eterm obj) +{ + Eterm saved_obj = obj; + Uint sum = 0; + Eterm* ptr; + + DECLARE_EQUEUE(s); + DECLARE_BITSTORE(b); + + for (;;) { + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: { + Eterm head, tail; + ptr = list_val(obj); + /* we're not counting anything that's outside our heap */ + if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) { + goto pop_next; + } + head = CAR(ptr); + tail = CDR(ptr); + /* if it's visited, don't count it */ + if (primary_tag(tail) == TAG_PRIMARY_HEADER || + primary_tag(head) == TAG_PRIMARY_HEADER) { + goto pop_next; + } + /* else make it visited now */ + switch (primary_tag(tail)) { + case TAG_PRIMARY_LIST: + ptr[1] = (tail - TAG_PRIMARY_LIST) | TAG_PRIMARY_HEADER; + break; + case TAG_PRIMARY_IMMED1: + CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; + CDR(ptr) = (tail - TAG_PRIMARY_IMMED1) | primary_tag(head); + break; + case TAG_PRIMARY_BOXED: + BITSTORE_PUT(b, primary_tag(head)); + CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; + CDR(ptr) = (tail - TAG_PRIMARY_BOXED) | TAG_PRIMARY_HEADER; + break; + } + /* and count it */ + sum += 2; + if (!IS_CONST(head)) { + EQUEUE_PUT(s, head); + } + obj = tail; + break; + } + case TAG_PRIMARY_BOXED: { + Eterm hdr; + ptr = boxed_val(obj); + /* we're not counting anything that's outside our heap */ + if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) { + goto pop_next; + } + hdr = *ptr; + /* if it's visited, don't count it */ + if (primary_tag(hdr) != TAG_PRIMARY_HEADER) { + goto pop_next; + } + /* else make it visited now */ + *ptr = (hdr - primary_tag(hdr)) + BOXED_VISITED; + /* and count it */ + ASSERT(is_header(hdr)); + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: { + int arity = header_arity(hdr); + sum += arity + 1; + if (arity == 0) { /* Empty tuple -- unusual. */ + goto pop_next; + } + while (arity-- > 0) { + obj = *++ptr; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + case FUN_SUBTAG: { + ErlFunThing* funp = (ErlFunThing *) ptr; + unsigned eterms = 1 /* creator */ + funp->num_free; + unsigned sz = thing_arityval(hdr); + sum += 1 /* header */ + sz + eterms; + ptr += 1 /* header */ + sz; + while (eterms-- > 0) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + case SUB_BINARY_SUBTAG: { + ErlSubBin* sb = (ErlSubBin *) ptr; + Uint extra_bytes; + Eterm hdr; + ASSERT((sb->thing_word & ~BOXED_VISITED_MASK) == HEADER_SUB_BIN); + if (sb->bitsize + sb->bitoffs > 8) { + sum += ERL_SUB_BIN_SIZE; + extra_bytes = 2; + } else if (sb->bitsize + sb->bitoffs > 0) { + sum += ERL_SUB_BIN_SIZE; + extra_bytes = 1; + } else { + extra_bytes = 0; + } + ptr = binary_val(sb->orig); + hdr = (*ptr) & ~BOXED_VISITED_MASK; + if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) { + sum += PROC_BIN_SIZE; + } else { + ASSERT(thing_subtag(hdr) == HEAP_BINARY_SUBTAG); + sum += heap_bin_size(binary_size(obj) + extra_bytes); + } + goto pop_next; + } + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : { + flatmap_t *mp = (flatmap_t*)flatmap_val(obj); + Uint n = flatmap_get_size(mp) + 1; + ptr = (Eterm *)mp; + sum += n + 2; + ptr += 2; /* hdr + size words */ + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(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 : { + Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + sum += 1 + n + header_arity(hdr); + ptr += 1 + header_arity(hdr); + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + default: + erts_exit(ERTS_ABORT_EXIT, "size_shared: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); + } + case BIN_MATCHSTATE_SUBTAG: + erts_exit(ERTS_ABORT_EXIT, + "size_shared: matchstate term not allowed"); + default: + sum += thing_arityval(hdr) + 1; + goto pop_next; + } + break; + } + case TAG_PRIMARY_IMMED1: + pop_next: + if (EQUEUE_ISEMPTY(s)) { + goto cleanup; + } + obj = EQUEUE_GET(s); + break; + default: + erts_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj); + } + } + +cleanup: + obj = saved_obj; + BITSTORE_CLOSE(b); + for (;;) { + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: { + Eterm head, tail; + ptr = list_val(obj); + if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) { + goto cleanup_next; + } + head = CAR(ptr); + tail = CDR(ptr); + /* if not already clean, clean it up */ + if (primary_tag(tail) == TAG_PRIMARY_HEADER) { + if (primary_tag(head) == TAG_PRIMARY_HEADER) { + Eterm saved; + BITSTORE_FETCH(b, saved); + CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | saved; + CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) | TAG_PRIMARY_BOXED; + } else { + CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) | TAG_PRIMARY_LIST; + } + } else if (primary_tag(head) == TAG_PRIMARY_HEADER) { + CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | primary_tag(tail); + CDR(ptr) = tail = (tail - primary_tag(tail)) | TAG_PRIMARY_IMMED1; + } else { + goto cleanup_next; + } + /* and its children too */ + if (!IS_CONST(head)) { + EQUEUE_PUT_UNCHECKED(s, head); + } + obj = tail; + break; + } + case TAG_PRIMARY_BOXED: { + Eterm hdr; + ptr = boxed_val(obj); + if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) { + goto cleanup_next; + } + hdr = *ptr; + /* if not already clean, clean it up */ + if (primary_tag(hdr) == TAG_PRIMARY_HEADER) { + goto cleanup_next; + } + else { + ASSERT(primary_tag(hdr) == BOXED_VISITED); + *ptr = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER; + } + /* and its children too */ + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: { + int arity = header_arity(hdr); + if (arity == 0) { /* Empty tuple -- unusual. */ + goto cleanup_next; + } + while (arity-- > 0) { + obj = *++ptr; + if (!IS_CONST(obj)) { + EQUEUE_PUT_UNCHECKED(s, obj); + } + } + goto cleanup_next; + } + case FUN_SUBTAG: { + ErlFunThing* funp = (ErlFunThing *) ptr; + unsigned eterms = 1 /* creator */ + funp->num_free; + unsigned sz = thing_arityval(hdr); + ptr += 1 /* header */ + sz; + while (eterms-- > 0) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT_UNCHECKED(s, obj); + } + } + goto cleanup_next; + } + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : { + flatmap_t *mp = (flatmap_t *) ptr; + Uint n = flatmap_get_size(mp) + 1; + ptr += 2; /* hdr + size words */ + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT_UNCHECKED(s, obj); + } + } + goto cleanup_next; + } + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : { + Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + sum += 1 + n + header_arity(hdr); + ptr += 1 + header_arity(hdr); + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT_UNCHECKED(s, obj); + } + } + goto cleanup_next; + } + default: + erts_exit(ERTS_ABORT_EXIT, "size_shared: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); + } + default: + goto cleanup_next; + } + break; + } + case TAG_PRIMARY_IMMED1: + cleanup_next: + if (EQUEUE_ISEMPTY(s)) { + goto all_clean; + } + obj = EQUEUE_GET(s); + break; + default: + erts_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj); + } + } + + all_clean: + /* Return the result */ + DESTROY_EQUEUE(s); + DESTROY_BITSTORE(b); + return sum; +} + + +/* * Copy a structure to a heap. */ -#if HALFWORD_HEAP -Eterm copy_struct_rel(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, - Eterm* src_base, Eterm* dst_base) -#else -Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) -#endif +Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint *bsz) { char* hstart; Uint hsize; @@ -247,19 +614,23 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) Eterm* argp; Eterm* const_tuple; Eterm hdr; + Eterm *hend; int i; #ifdef DEBUG Eterm org_obj = obj; Uint org_sz = sz; + Eterm mypid = erts_get_current_pid(); #endif if (IS_CONST(obj)) return obj; + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_struct %p\n", mypid, obj)); + DTRACE1(copy_struct, (int32_t)sz); hp = htop = *hpp; - hbot = htop + sz; + hbot = hend = htop + sz; hstart = (char *)htop; hsize = (char*) hbot - hstart; const_tuple = 0; @@ -268,7 +639,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: argp = &res; - objp = list_val_rel(obj,src_base); + objp = list_val(obj); goto L_copy_list; case TAG_PRIMARY_BOXED: argp = &res; goto L_copy_boxed; default: @@ -286,14 +657,11 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) hp++; break; case TAG_PRIMARY_LIST: - objp = list_val_rel(obj,src_base); - #if !HALFWORD_HEAP || defined(DEBUG) - if (in_area(objp,hstart,hsize)) { - ASSERT(!HALFWORD_HEAP); + objp = list_val(obj); + if (ErtsInArea(objp,hstart,hsize)) { hp++; break; } - #endif argp = hp++; /* Fall through */ @@ -309,23 +677,15 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } else { CAR(htop) = elem; - #if HALFWORD_HEAP - CDR(htop) = CDR(objp); - *tailp = make_list_rel(htop,dst_base); - htop += 2; - goto L_copy; - #else tailp = &CDR(htop); htop += 2; - #endif } - ASSERT(!HALFWORD_HEAP || tp < hp || tp >= hbot); - *tp = make_list_rel(tailp - 1, dst_base); + *tp = make_list(tailp - 1); obj = CDR(objp); if (!is_list(obj)) { break; } - objp = list_val_rel(obj,src_base); + objp = list_val(obj); } switch (primary_tag(obj)) { case TAG_PRIMARY_IMMED1: *tailp = obj; goto L_copy; @@ -337,24 +697,21 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } case TAG_PRIMARY_BOXED: - #if !HALFWORD_HEAP || defined(DEBUG) - if (in_area(boxed_val_rel(obj,src_base),hstart,hsize)) { - ASSERT(!HALFWORD_HEAP); + if (ErtsInArea(boxed_val(obj),hstart,hsize)) { hp++; break; } - #endif argp = hp++; L_copy_boxed: - objp = boxed_val_rel(obj, src_base); + objp = boxed_val(obj); hdr = *objp; switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: { int const_flag = 1; /* assume constant tuple */ i = arityval(hdr); - *argp = make_tuple_rel(htop, dst_base); + *argp = make_tuple(htop); tp = htop; /* tp is pointer to new arity value */ *htop++ = *objp++; /* copy arity value */ while (i--) { @@ -383,7 +740,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) while (i--) { *tp++ = *objp++; } - *argp = make_binary_rel(hbot, dst_base); + *argp = make_binary(hbot); pb = (ProcBin*) hbot; erts_refc_inc(&pb->val->refc, 2); pb->next = off_heap->first; @@ -410,7 +767,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) extra_bytes = 0; } real_size = size+extra_bytes; - objp = binary_val_rel(real_bin,src_base); + objp = binary_val(real_bin); if (thing_subtag(*objp) == HEAP_BINARY_SUBTAG) { ErlHeapBin* from = (ErlHeapBin *) objp; ErlHeapBin* to; @@ -440,7 +797,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) off_heap->first = (struct erl_off_heap_header*) to; OH_OVERHEAD(off_heap, to->size / sizeof(Eterm)); } - *argp = make_binary_rel(hbot, dst_base); + *argp = make_binary(hbot); if (extra_bytes != 0) { ErlSubBin* res; hbot -= ERL_SUB_BIN_SIZE; @@ -452,7 +809,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) res->offs = 0; res->is_writable = 0; res->orig = *argp; - *argp = make_binary_rel(hbot, dst_base); + *argp = make_binary(hbot); } break; } @@ -470,7 +827,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) funp->next = off_heap->first; off_heap->first = (struct erl_off_heap_header*) funp; erts_refc_inc(&funp->fe->refc, 2); - *argp = make_fun_rel(tp, dst_base); + *argp = make_fun(tp); } break; case EXTERNAL_PID_SUBTAG: @@ -490,7 +847,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) off_heap->first = (struct erl_off_heap_header*)etp; erts_refc_inc(&etp->node->refc, 2); - *argp = make_external_rel(tp, dst_base); + *argp = make_external(tp); } break; case MAP_SUBTAG: @@ -498,7 +855,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) switch (MAP_HEADER_TYPE(hdr)) { case MAP_HEADER_TAG_FLATMAP_HEAD : i = flatmap_get_size(objp) + 3; - *argp = make_flatmap_rel(htop, dst_base); + *argp = make_flatmap(htop); while (i--) { *htop++ = *objp++; } @@ -509,7 +866,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) 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); + *argp = make_hashmap(tp); break; default: erts_exit(ERTS_ABORT_EXIT, "copy_struct: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); @@ -522,7 +879,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) i = thing_arityval(hdr)+1; hbot -= i; tp = hbot; - *argp = make_boxed_rel(hbot, dst_base); + *argp = make_boxed(hbot); while (i--) { *tp++ = *objp++; } @@ -538,22 +895,870 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } } + if (bsz) { + *hpp = htop; + *bsz = hend - hbot; + } else { #ifdef DEBUG - if (htop != hbot) - erts_exit(ERTS_ABORT_EXIT, - "Internal error in copy_struct() when copying %T:" - " htop=%p != hbot=%p (sz=%beu)\n", - org_obj, htop, hbot, org_sz); + if (htop != hbot) + erts_exit(ERTS_ABORT_EXIT, + "Internal error in copy_struct() when copying %T:" + " htop=%p != hbot=%p (sz=%beu)\n", + org_obj, htop, hbot, org_sz); #else - if (htop > hbot) { - erts_exit(ERTS_ABORT_EXIT, - "Internal error in copy_struct(): htop, hbot overrun\n"); - } + if (htop > hbot) { + erts_exit(ERTS_ABORT_EXIT, + "Internal error in copy_struct(): htop, hbot overrun\n"); + } #endif - *hpp = (Eterm *) (hstart+hsize); + *hpp = (Eterm *) (hstart+hsize); + } + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", mypid, res)); return res; } + +/* + * Machinery for the table used by the sharing preserving copier + * Using an ESTACK but not very transparently; consider refactoring + */ + +#define DECLARE_SHTABLE(s) \ + DECLARE_ESTACK(s); \ + Uint ESTK_CONCAT(s,_offset) = 0 +#define DESTROY_SHTABLE(s) DESTROY_ESTACK(s) +#define SHTABLE_INCR 4 +#define SHTABLE_NEXT(s) ESTK_CONCAT(s,_offset) +#define SHTABLE_PUSH(s,x,y,b) \ +do { \ + if (s.sp > s.end - SHTABLE_INCR) { \ + erl_grow_estack(&(s), SHTABLE_INCR); \ + } \ + *s.sp++ = (x); \ + *s.sp++ = (y); \ + *s.sp++ = (Eterm) NULL; \ + *s.sp++ = (Eterm) (b); \ + ESTK_CONCAT(s,_offset) += SHTABLE_INCR; \ +} while(0) +#define SHTABLE_X(s,e) (s.start[e]) +#define SHTABLE_Y(s,e) (s.start[(e)+1]) +#define SHTABLE_FWD(s,e) ((Eterm *) (s.start[(e)+2])) +#define SHTABLE_FWD_UPD(s,e,p) (s.start[(e)+2] = (Eterm) (p)) +#define SHTABLE_REV(s,e) ((Eterm *) (s.start[(e)+3])) + +#define LIST_SHARED_UNPROCESSED ((Eterm) 0) +#define LIST_SHARED_PROCESSED ((Eterm) 1) + +#define HEAP_ELEM_TO_BE_FILLED _unchecked_make_list(NULL) + + +/* + * Specialized macros for using/reusing the persistent state + */ + +#define DECLARE_EQUEUE_INIT_INFO(q, info) \ + UWord* EQUE_DEF_QUEUE(q) = info->queue_default; \ + ErtsEQueue q = { \ + EQUE_DEF_QUEUE(q), /* start */ \ + EQUE_DEF_QUEUE(q), /* front */ \ + EQUE_DEF_QUEUE(q), /* back */ \ + 1, /* possibly_empty */ \ + EQUE_DEF_QUEUE(q) + DEF_EQUEUE_SIZE, /* end */ \ + ERTS_ALC_T_ESTACK /* alloc_type */ \ + } + +#define DECLARE_EQUEUE_FROM_INFO(q, info) \ + /* no EQUE_DEF_QUEUE(q), read-only */ \ + ErtsEQueue q = { \ + info->queue_start, /* start */ \ + info->queue_start, /* front */ \ + info->queue_start, /* back */ \ + 1, /* possibly_empty */ \ + info->queue_end, /* end */ \ + info->queue_alloc_type /* alloc_type */ \ + } + +#define DECLARE_BITSTORE_INIT_INFO(s, info) \ + UWord* WSTK_DEF_STACK(s) = info->bitstore_default; \ + 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 */ \ + }; \ + int WSTK_CONCAT(s,_bitoffs) = 0; \ + /* no WSTK_CONCAT(s,_offset), write-only */ \ + UWord WSTK_CONCAT(s,_buffer) = 0 + +#define DECLARE_BITSTORE_FROM_INFO(s, info) \ + /* no WSTK_DEF_STACK(s), read-only */ \ + ErtsWStack s = { \ + info->bitstore_start, /* wstart */ \ + NULL, /* wsp, read-only */ \ + NULL, /* wend, read-only */ \ + NULL, /* wdef, read-only */ \ + info->bitstore_alloc_type /* alloc_type */ \ + }; \ + int WSTK_CONCAT(s,_bitoffs) = 0; \ + int WSTK_CONCAT(s,_offset) = 0; \ + UWord WSTK_CONCAT(s,_buffer) = 0 + +#define DECLARE_SHTABLE_INIT_INFO(s, info) \ + Eterm* ESTK_DEF_STACK(s) = info->shtable_default; \ + ErtsEStack s = { \ + 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 */ \ + }; \ + Uint ESTK_CONCAT(s,_offset) = 0 + +#define DECLARE_SHTABLE_FROM_INFO(s, info) \ + /* no ESTK_DEF_STACK(s), read-only */ \ + ErtsEStack s = { \ + info->shtable_start, /* start */ \ + NULL, /* sp, read-only */ \ + NULL, /* end, read-only */ \ + NULL, /* def, read-only */ \ + info->shtable_alloc_type /* alloc_type */ \ + }; \ + /* no ESTK_CONCAT(s,_offset), read-only */ + +/* + * Copy object "obj" preserving sharing. + * First half: count size and calculate sharing. + */ +Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info) +{ + Uint sum; + Uint e; + unsigned sz; + Eterm* ptr; +#ifdef DEBUG + Eterm mypid = erts_get_current_pid(); +#endif + + DECLARE_EQUEUE_INIT_INFO(s, info); + DECLARE_BITSTORE_INIT_INFO(b, info); + DECLARE_SHTABLE_INIT_INFO(t, info); + + /* step #0: + ------------------------------------------------------- + get rid of the easy cases first: + - copying constants + - if not a proper process, do flat copy + */ + + if (IS_CONST(obj)) + return 0; + + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_calculate %p\n", mypid, obj)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] message is %T\n", mypid, obj)); + + /* step #1: + ------------------------------------------------------- + traverse the term and calculate the size; + when traversing, transform as you do in size_shared + but when you find shared objects: + + a. add entry in the table, indexed by i + b. mark them: + b1. boxed terms, set header to (i | 11) + store (old header, NONV, NULL, backptr) in the entry + b2. cons cells, set CDR to NONV, set CAR to i + store (old CAR, old CDR, NULL, backptr) in the entry + */ + + sum = 0; + + for (;;) { + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: { + Eterm head, tail; + ptr = list_val(obj); + /* off heap list pointers are copied verbatim */ + if (erts_is_literal(obj,ptr)) { + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", mypid, ptr, obj)); + if (IN_LITERAL_PURGE_AREA(info,ptr)) + info->literal_size += size_object(obj); + goto pop_next; + } + head = CAR(ptr); + tail = CDR(ptr); + /* if it's visited, don't count it; + if not already shared, make it shared and store it in the table */ + if (primary_tag(tail) == TAG_PRIMARY_HEADER || + primary_tag(head) == TAG_PRIMARY_HEADER) { + if (tail != THE_NON_VALUE) { + e = SHTABLE_NEXT(t); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabling L %p\n", mypid, ptr)); + SHTABLE_PUSH(t, head, tail, ptr); + CAR(ptr) = (e << _TAG_PRIMARY_SIZE) | LIST_SHARED_UNPROCESSED; + CDR(ptr) = THE_NON_VALUE; + } + goto pop_next; + } + /* else make it visited now */ + switch (primary_tag(tail)) { + case TAG_PRIMARY_LIST: + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/L %p\n", mypid, ptr)); + CDR(ptr) = (tail - TAG_PRIMARY_LIST) | TAG_PRIMARY_HEADER; + break; + case TAG_PRIMARY_IMMED1: + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/I %p\n", mypid, ptr)); + CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; + CDR(ptr) = (tail - TAG_PRIMARY_IMMED1) | primary_tag(head); + break; + case TAG_PRIMARY_BOXED: + BITSTORE_PUT(b, primary_tag(head)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/B %p\n", mypid, ptr)); + CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; + CDR(ptr) = (tail - TAG_PRIMARY_BOXED) | TAG_PRIMARY_HEADER; + break; + } + /* and count it */ + sum += 2; + if (!IS_CONST(head)) { + EQUEUE_PUT(s, head); + } + obj = tail; + break; + } + case TAG_PRIMARY_BOXED: { + Eterm hdr; + ptr = boxed_val(obj); + /* off heap pointers to boxes are copied verbatim */ + if (erts_is_literal(obj,ptr)) { + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", mypid, ptr, obj)); + if (IN_LITERAL_PURGE_AREA(info,ptr)) + info->literal_size += size_object(obj); + goto pop_next; + } + hdr = *ptr; + /* if it's visited, don't count it; + if not already shared, make it shared and store it in the table */ + if (primary_tag(hdr) != TAG_PRIMARY_HEADER) { + if (primary_tag(hdr) == BOXED_VISITED) { + e = SHTABLE_NEXT(t); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabling B %p\n", mypid, ptr)); + SHTABLE_PUSH(t, hdr, THE_NON_VALUE, ptr); + *ptr = (e << _TAG_PRIMARY_SIZE) | BOXED_SHARED_UNPROCESSED; + } + goto pop_next; + } + /* else make it visited now */ + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling B %p\n", mypid, ptr)); + *ptr = (hdr - primary_tag(hdr)) + BOXED_VISITED; + /* and count it */ + ASSERT(is_header(hdr)); + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: { + int arity = header_arity(hdr); + sum += arity + 1; + if (arity == 0) { /* Empty tuple -- unusual. */ + goto pop_next; + } + while (arity-- > 0) { + obj = *++ptr; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + case FUN_SUBTAG: { + ErlFunThing* funp = (ErlFunThing *) ptr; + unsigned eterms = 1 /* creator */ + funp->num_free; + sz = thing_arityval(hdr); + sum += 1 /* header */ + sz + eterms; + ptr += 1 /* header */ + sz; + while (eterms-- > 0) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + case SUB_BINARY_SUBTAG: { + ErlSubBin* sb = (ErlSubBin *) ptr; + Eterm real_bin = sb->orig; + Uint bit_offset = sb->bitoffs; + Uint bit_size = sb->bitsize; + size_t size = sb->size; + Uint extra_bytes; + Eterm hdr; + if (bit_size + bit_offset > 8) { + sum += ERL_SUB_BIN_SIZE; + extra_bytes = 2; + } else if (bit_size + bit_offset > 0) { + sum += ERL_SUB_BIN_SIZE; + extra_bytes = 1; + } else { + extra_bytes = 0; + } + ASSERT(is_boxed(real_bin) && + (((*boxed_val(real_bin)) & + (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK)) + == _TAG_HEADER_REFC_BIN)); + hdr = *_unchecked_binary_val(real_bin) & ~BOXED_VISITED_MASK; + if (thing_subtag(hdr) == HEAP_BINARY_SUBTAG) { + sum += heap_bin_size(size+extra_bytes); + } else { + ASSERT(thing_subtag(hdr) == REFC_BINARY_SUBTAG); + sum += PROC_BIN_SIZE; + } + goto pop_next; + } + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : { + flatmap_t *mp = (flatmap_t *) ptr; + Uint n = flatmap_get_size(mp) + 1; + sum += n + 2; + ptr += 2; /* hdr + size words */ + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(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 : { + Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + sum += 1 + n + header_arity(hdr); + ptr += 1 + header_arity(hdr); + + if (n == 0) { + goto pop_next; + } + while(n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + default: + erts_exit(ERTS_ABORT_EXIT, "copy_shared_calculate: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); + } + case BIN_MATCHSTATE_SUBTAG: + erts_exit(ERTS_ABORT_EXIT, + "size_shared: matchstate term not allowed"); + default: + sum += thing_arityval(hdr) + 1; + goto pop_next; + } + break; + } + case TAG_PRIMARY_IMMED1: + pop_next: + if (EQUEUE_ISEMPTY(s)) { + /* add sentinel to the table */ + SHTABLE_PUSH(t, THE_NON_VALUE, THE_NON_VALUE, NULL); + /* store persistent info */ + BITSTORE_CLOSE(b); + info->queue_start = s.start; + info->queue_end = s.end; + info->queue_alloc_type = s.alloc_type; + info->bitstore_start = b.wstart; + info->bitstore_alloc_type = b.alloc_type; + info->shtable_start = t.start; + info->shtable_alloc_type = t.alloc_type; + /* single point of return: the size of the object */ + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size was: %u\n", mypid, sum)); + return sum + info->literal_size; + } + obj = EQUEUE_GET(s); + break; + default: + erts_exit(ERTS_ABORT_EXIT, "[pid=%T] size_shared: bad tag for %#x\n", obj); + } + } +} + +/* + * Copy object "obj" preserving sharing. + * Second half: copy and restore the object. + */ +Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, + Eterm** hpp, ErlOffHeap* off_heap) { + Uint e; + unsigned sz; + Eterm* ptr; + Eterm* hp; + Eterm* hscan; + Eterm result; + Eterm* resp; + Eterm *hbot, *hend; + unsigned remaining; +#ifdef DEBUG + Eterm mypid = erts_get_current_pid(); + Eterm saved_obj = obj; +#endif + + DECLARE_EQUEUE_FROM_INFO(s, info); + DECLARE_BITSTORE_FROM_INFO(b, info); + DECLARE_SHTABLE_FROM_INFO(t, info); + + /* step #0: + ------------------------------------------------------- + get rid of the easy cases first: + - copying constants + - if not a proper process, do flat copy + */ + + if (IS_CONST(obj)) + return obj; + + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_perform %p\n", mypid, obj)); + + /* step #2: was performed before this function was called + ------------------------------------------------------- + allocate new space + */ + + hscan = hp = *hpp; + hbot = hend = hp + size; + + /* step #3: + ------------------------------------------------------- + traverse the term a second time and when traversing: + a. if the object is marked as shared + a1. if the entry contains a forwarding ptr, use that + a2. otherwise, copy it to the new space and store the + forwarding ptr to the entry + b. otherwise, reverse-transform as you do in size_shared + and copy to the new space + */ + + resp = &result; + remaining = 0; + for (;;) { + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: { + Eterm head, tail; + ptr = list_val(obj); + /* off heap list pointers are copied verbatim */ + if (erts_is_literal(obj,ptr)) { + if (!IN_LITERAL_PURGE_AREA(info,ptr)) { + *resp = obj; + } else { + Uint bsz = 0; + *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz); + hbot -= bsz; + } + goto cleanup_next; + } + head = CAR(ptr); + tail = CDR(ptr); + /* if it is shared */ + if (tail == THE_NON_VALUE) { + e = head >> _TAG_PRIMARY_SIZE; + /* if it has been processed, just use the forwarding pointer */ + if (primary_tag(head) == LIST_SHARED_PROCESSED) { + *resp = make_list(SHTABLE_FWD(t, e)); + goto cleanup_next; + } + /* else, let's process it now, + copy it and keep the forwarding pointer */ + else { + CAR(ptr) = (head - primary_tag(head)) + LIST_SHARED_PROCESSED; + head = SHTABLE_X(t, e); + tail = SHTABLE_Y(t, e); + ptr = &(SHTABLE_X(t, e)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled L %p is %p\n", mypid, ptr, SHTABLE_REV(t, e))); + SHTABLE_FWD_UPD(t, e, hp); + } + } + /* if not already clean, clean it up and copy it */ + if (primary_tag(tail) == TAG_PRIMARY_HEADER) { + if (primary_tag(head) == TAG_PRIMARY_HEADER) { + Eterm saved; + BITSTORE_FETCH(b, saved); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/B %p\n", mypid, ptr)); + CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) + saved; + CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_BOXED; + } else { + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/L %p\n", mypid, ptr)); + CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_LIST; + } + } else if (primary_tag(head) == TAG_PRIMARY_HEADER) { + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/I %p\n", mypid, ptr)); + CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | primary_tag(tail); + CDR(ptr) = tail = (tail - primary_tag(tail)) | TAG_PRIMARY_IMMED1; + } else { + ASSERT(0 && "cannot come here"); + goto cleanup_next; + } + /* and its children too */ + if (IS_CONST(head)) { + CAR(hp) = head; + } else { + EQUEUE_PUT_UNCHECKED(s, head); + CAR(hp) = HEAP_ELEM_TO_BE_FILLED; + } + *resp = make_list(hp); + resp = &(CDR(hp)); + hp += 2; + obj = tail; + break; + } + case TAG_PRIMARY_BOXED: { + Eterm hdr; + ptr = boxed_val(obj); + /* off heap pointers to boxes are copied verbatim */ + if (erts_is_literal(obj,ptr)) { + if (!IN_LITERAL_PURGE_AREA(info,ptr)) { + *resp = obj; + } else { + Uint bsz = 0; + *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz); + hbot -= bsz; + } + goto cleanup_next; + } + hdr = *ptr; + /* clean it up, unless it's already clean or shared and processed */ + switch (primary_tag(hdr)) { + case TAG_PRIMARY_HEADER: + ASSERT(0 && "cannot come here"); + /* if it is shared and has been processed, + just use the forwarding pointer */ + case BOXED_SHARED_PROCESSED: + e = hdr >> _TAG_PRIMARY_SIZE; + *resp = make_boxed(SHTABLE_FWD(t, e)); + goto cleanup_next; + /* if it is shared but has not been processed yet, let's process + it now: copy it and keep the forwarding pointer */ + case BOXED_SHARED_UNPROCESSED: + e = hdr >> _TAG_PRIMARY_SIZE; + *ptr = (hdr - primary_tag(hdr)) + BOXED_SHARED_PROCESSED; + hdr = SHTABLE_X(t, e); + ASSERT(primary_tag(hdr) == BOXED_VISITED); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled B %p is %p\n", mypid, ptr, SHTABLE_REV(t, e))); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", mypid, ptr)); + SHTABLE_X(t, e) = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER; + SHTABLE_FWD_UPD(t, e, hp); + break; + case BOXED_VISITED: + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", mypid, ptr)); + *ptr = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER; + break; + } + /* and its children too */ + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: { + int arity = header_arity(hdr); + *resp = make_boxed(hp); + *hp++ = hdr; + while (arity-- > 0) { + obj = *++ptr; + if (IS_CONST(obj)) { + *hp++ = obj; + } else { + EQUEUE_PUT_UNCHECKED(s, obj); + *hp++ = HEAP_ELEM_TO_BE_FILLED; + } + } + goto cleanup_next; + } + case FUN_SUBTAG: { + ErlFunThing* funp = (ErlFunThing *) ptr; + unsigned eterms = 1 /* creator */ + funp->num_free; + sz = thing_arityval(hdr); + funp = (ErlFunThing *) hp; + *resp = make_fun(hp); + *hp++ = hdr; + ptr++; + while (sz-- > 0) { + *hp++ = *ptr++; + } + while (eterms-- > 0) { + obj = *ptr++; + if (IS_CONST(obj)) { + *hp++ = obj; + } else { + EQUEUE_PUT_UNCHECKED(s, obj); + *hp++ = HEAP_ELEM_TO_BE_FILLED; + } + } + funp->next = off_heap->first; + off_heap->first = (struct erl_off_heap_header*) funp; + erts_refc_inc(&funp->fe->refc, 2); + goto cleanup_next; + } + case MAP_SUBTAG: + *resp = make_flatmap(hp); + *hp++ = hdr; + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : { + flatmap_t *mp = (flatmap_t *) ptr; + Uint n = flatmap_get_size(mp) + 1; + *hp++ = *++ptr; /* keys */ + while (n--) { + obj = *++ptr; + if (IS_CONST(obj)) { + *hp++ = obj; + } else { + EQUEUE_PUT_UNCHECKED(s, obj); + *hp++ = HEAP_ELEM_TO_BE_FILLED; + } + } + goto cleanup_next; + } + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + *hp++ = *++ptr; /* total map size */ + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : { + Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + while (n--) { + obj = *++ptr; + if (IS_CONST(obj)) { + *hp++ = obj; + } else { + EQUEUE_PUT_UNCHECKED(s, obj); + *hp++ = HEAP_ELEM_TO_BE_FILLED; + } + } + goto cleanup_next; + } + default: + erts_exit(ERTS_ABORT_EXIT, "copy_shared_perform: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); + } + case REFC_BINARY_SUBTAG: { + ProcBin* pb = (ProcBin *) ptr; + sz = thing_arityval(hdr); + if (pb->flags) { + erts_emasculate_writable_binary(pb); + } + pb = (ProcBin *) hp; + *resp = make_binary(hp); + *hp++ = hdr; + ptr++; + while (sz-- > 0) { + *hp++ = *ptr++; + } + erts_refc_inc(&pb->val->refc, 2); + pb->next = off_heap->first; + pb->flags = 0; + off_heap->first = (struct erl_off_heap_header*) pb; + OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm)); + goto cleanup_next; + } + case SUB_BINARY_SUBTAG: { + ErlSubBin* sb = (ErlSubBin *) ptr; + Eterm real_bin = sb->orig; + Uint bit_offset = sb->bitoffs; + Uint bit_size = sb->bitsize; + Uint offset = sb->offs; + size_t size = sb->size; + Uint extra_bytes; + Uint real_size; + if ((bit_size + bit_offset) > 8) { + extra_bytes = 2; + } else if ((bit_size + bit_offset) > 0) { + extra_bytes = 1; + } else { + extra_bytes = 0; + } + real_size = size+extra_bytes; + ASSERT(is_boxed(real_bin) && + (((*boxed_val(real_bin)) & + (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK)) + == _TAG_HEADER_REFC_BIN)); + ptr = _unchecked_binary_val(real_bin); + *resp = make_binary(hp); + if (extra_bytes != 0) { + ErlSubBin* res = (ErlSubBin *) hp; + hp += ERL_SUB_BIN_SIZE; + res->thing_word = HEADER_SUB_BIN; + res->size = size; + res->bitsize = bit_size; + res->bitoffs = bit_offset; + res->offs = 0; + res->is_writable = 0; + res->orig = make_binary(hp); + } + if (thing_subtag(*ptr & ~BOXED_VISITED_MASK) == HEAP_BINARY_SUBTAG) { + ErlHeapBin* from = (ErlHeapBin *) ptr; + ErlHeapBin* to = (ErlHeapBin *) hp; + hp += heap_bin_size(real_size); + to->thing_word = header_heap_bin(real_size); + to->size = real_size; + sys_memcpy(to->data, ((byte *)from->data)+offset, real_size); + } else { + ProcBin* from = (ProcBin *) ptr; + ProcBin* to = (ProcBin *) hp; + ASSERT(thing_subtag(*ptr & ~BOXED_VISITED_MASK) == REFC_BINARY_SUBTAG); + if (from->flags) { + erts_emasculate_writable_binary(from); + } + hp += PROC_BIN_SIZE; + to->thing_word = HEADER_PROC_BIN; + to->size = real_size; + to->val = from->val; + erts_refc_inc(&to->val->refc, 2); + to->bytes = from->bytes + offset; + to->next = off_heap->first; + to->flags = 0; + off_heap->first = (struct erl_off_heap_header*) to; + OH_OVERHEAD(off_heap, to->size / sizeof(Eterm)); + } + goto cleanup_next; + } + case EXTERNAL_PID_SUBTAG: + case EXTERNAL_PORT_SUBTAG: + case EXTERNAL_REF_SUBTAG: { + ExternalThing *etp = (ExternalThing *) hp; + sz = thing_arityval(hdr); + *resp = make_external(hp); + *hp++ = hdr; + ptr++; + while (sz-- > 0) { + *hp++ = *ptr++; + } + etp->next = off_heap->first; + off_heap->first = (struct erl_off_heap_header*) etp; + erts_refc_inc(&etp->node->refc, 2); + goto cleanup_next; + } + default: + sz = thing_arityval(hdr); + *resp = make_boxed(hp); + *hp++ = hdr; + ptr++; + while (sz-- > 0) { + *hp++ = *ptr++; + } + goto cleanup_next; + } + break; + } + case TAG_PRIMARY_IMMED1: + *resp = obj; + cleanup_next: + if (EQUEUE_ISEMPTY(s)) { + goto all_clean; + } + obj = EQUEUE_GET(s); + for (;;) { + ASSERT(hscan < hp); + if (remaining == 0) { + if (*hscan == HEAP_ELEM_TO_BE_FILLED) { + resp = hscan; + hscan += 2; + break; /* scanning loop */ + } else if (primary_tag(*hscan) == TAG_PRIMARY_HEADER) { + switch (*hscan & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: + remaining = header_arity(*hscan); + hscan++; + break; + case FUN_SUBTAG: { + ErlFunThing* funp = (ErlFunThing *) hscan; + hscan += 1 + thing_arityval(*hscan); + remaining = 1 + funp->num_free; + break; + } + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(*hscan)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : { + flatmap_t *mp = (flatmap_t *) hscan; + remaining = flatmap_get_size(mp) + 1; + hscan += 2; + break; + } + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : + remaining = hashmap_bitcount(MAP_HEADER_VAL(*hscan)); + hscan += MAP_HEADER_ARITY(*hscan) + 1; + break; + default: + erts_exit(ERTS_ABORT_EXIT, + "copy_shared_perform: bad hashmap type %d\n", + MAP_HEADER_TYPE(*hscan)); + } + break; + case SUB_BINARY_SUBTAG: + ASSERT(((ErlSubBin *) hscan)->bitoffs + + ((ErlSubBin *) hscan)->bitsize > 0); + hscan += ERL_SUB_BIN_SIZE; + break; + default: + hscan += 1 + thing_arityval(*hscan); + break; + } + } else { + hscan++; + } + } else if (*hscan == HEAP_ELEM_TO_BE_FILLED) { + resp = hscan++; + remaining--; + break; /* scanning loop */ + } else { + hscan++; + remaining--; + } + } + ASSERT(resp < hp); + break; + default: + erts_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj); + } + } + + /* step #4: + ------------------------------------------------------- + traverse the table and reverse-transform all stored entries + */ + +all_clean: + for (e = 0; ; e += SHTABLE_INCR) { + ptr = SHTABLE_REV(t, e); + if (ptr == NULL) + break; + VERBOSE(DEBUG_SHCOPY, ("[copy] restoring shared: %x\n", ptr)); + /* entry was a list */ + if (SHTABLE_Y(t, e) != THE_NON_VALUE) { + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] untabling L %p\n", mypid, ptr)); + CAR(ptr) = SHTABLE_X(t, e); + CDR(ptr) = SHTABLE_Y(t, e); + } + /* entry was boxed */ + else { + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] untabling B %p\n", mypid, ptr)); + *ptr = SHTABLE_X(t, e); + ASSERT(primary_tag(*ptr) == TAG_PRIMARY_HEADER); + } + } + +#ifdef DEBUG + if (eq(saved_obj, result) == 0) { + erts_fprintf(stderr, "original = %T\n", saved_obj); + erts_fprintf(stderr, "copy = %T\n", result); + erts_exit(ERTS_ABORT_EXIT, "copy (shared) not equal to source\n"); + } +#endif + + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] original was %T\n", mypid, saved_obj)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy is %T\n", mypid, result)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", mypid, result)); + + ASSERT(hbot == hp); + ASSERT(size == ((hp - *hpp) + (hend - hbot))); + *hpp = hend; + return result; +} + + /* * Copy a term that is guaranteed to be contained in a single * heap block. The heap block is copied word by word, and any @@ -563,21 +1768,12 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) * * NOTE: Assumes that term is a tuple (ptr is an untagged tuple ptr). */ -#if HALFWORD_HEAP -Eterm copy_shallow_rel(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, - Eterm* src_base) -#else Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) -#endif { Eterm* tp = ptr; Eterm* hp = *hpp; const Eterm res = make_tuple(hp); -#if HALFWORD_HEAP - const Sint offs = COMPRESS_POINTER(hp - (tp - src_base)); -#else const Sint offs = (hp - tp) * sizeof(Eterm); -#endif while (sz--) { Eterm val = *tp++; @@ -652,17 +1848,24 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) * move markers. * Typically used to copy a multi-fragmented message (from NIF). */ -void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first, - Eterm* refs, unsigned nrefs) +void erts_move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first, + Eterm* refs, unsigned nrefs, int literals) { ErlHeapFragment* bp; Eterm* hp_start = *hpp; Eterm* hp_end; Eterm* hp; unsigned i; + Eterm literal_tag; + +#ifdef TAG_LITERAL_PTR + literal_tag = (Eterm) literals ? TAG_LITERAL_PTR : 0; +#else + literal_tag = (Eterm) 0; +#endif for (bp=first; bp!=NULL; bp=bp->next) { - move_one_frag(hpp, bp, off_heap); + move_one_frag(hpp, bp, off_heap, literals); } hp_end = *hpp; for (hp=hp_start; hp<hp_end; ++hp) { @@ -675,6 +1878,9 @@ void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first, val = *ptr; if (IS_MOVED_BOXED(val)) { ASSERT(is_boxed(val)); +#ifdef TAG_LITERAL_PTR + val |= literal_tag; +#endif *hp = val; } break; @@ -682,7 +1888,11 @@ void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first, ptr = list_val(gval); val = *ptr; if (IS_MOVED_CONS(val)) { - *hp = ptr[1]; + val = ptr[1]; +#ifdef TAG_LITERAL_PTR + val |= literal_tag; +#endif + *hp = val; } break; case TAG_PRIMARY_HEADER: @@ -693,12 +1903,12 @@ void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first, } } for (i=0; i<nrefs; ++i) { - refs[i] = follow_moved(refs[i]); + refs[i] = follow_moved(refs[i], literal_tag); } } static void -move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap) +move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap, int literals) { Eterm* ptr = frag->mem; Eterm* end = ptr + frag->used_size; @@ -735,4 +1945,3 @@ move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap) OH_OVERHEAD(off_heap, frag->off_heap.overhead); frag->off_heap.first = NULL; } - diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 787241b960..52fd57e101 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -337,7 +337,7 @@ static void doit_link_net_exits_sub(ErtsLink *sublnk, void *vlnecp) erts_destroy_link(rlnk); if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) { /* We didn't exit the process and it is traced */ - trace_proc(NULL, rp, am_getting_unlinked, sublnk->pid); + trace_proc(NULL, 0, rp, am_getting_unlinked, sublnk->pid); } } erts_smp_proc_unlock(rp, rp_locks); @@ -378,10 +378,11 @@ static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp) ASSERT(lnk->type == LINK_NODE); if (is_internal_pid(lnk->pid)) { ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK; - rp = erts_pid2proc(NULL, 0, lnk->pid, rp_locks); - if (!rp) { + ErlOffHeap *ohp; + rp = erts_proc_lookup(lnk->pid); + if (!rp) goto done; - } + erts_smp_proc_lock(rp, rp_locks); rlnk = erts_remove_link(&ERTS_P_LINKS(rp), name); if (rlnk != NULL) { ASSERT(is_atom(rlnk->pid) && (rlnk->type == LINK_NODE)); @@ -389,12 +390,14 @@ static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp) } n = ERTS_LINK_REFC(lnk); for (i = 0; i < n; ++i) { - ErlHeapFragment* bp; - ErlOffHeap *ohp; Eterm tup; - Eterm *hp = erts_alloc_message_heap(3,&bp,&ohp,rp,&rp_locks); + Eterm *hp; + ErtsMessage *msgp; + + msgp = erts_alloc_message_heap(rp, &rp_locks, + 3, &hp, &ohp); tup = TUPLE2(hp, am_nodedown, name); - erts_queue_message(rp, &rp_locks, bp, tup, NIL); + erts_queue_message(rp, &rp_locks, msgp, tup); } erts_smp_proc_unlock(rp, rp_locks); } @@ -737,19 +740,11 @@ Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx) 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); + Eterm* hp = HAlloc(p, 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; @@ -886,11 +881,7 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx) DTRACE_CHARBUF(receiver_name, 64); #endif - if (SEQ_TRACE_TOKEN(sender) != NIL -#ifdef USE_VM_PROBES - && SEQ_TRACE_TOKEN(sender) != am_have_dt_utag -#endif - ) { + if (have_seqtrace(SEQ_TRACE_TOKEN(sender))) { seq_trace_update_send(sender); token = SEQ_TRACE_TOKEN(sender); seq_trace_output(token, message, SEQ_TRACE_SEND, remote, sender); @@ -905,7 +896,7 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx) erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), "%T", remote); msize = size_object(message); - if (token != NIL && token != am_have_dt_utag) { + if (have_seqtrace(token)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); @@ -915,9 +906,9 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx) if (token != NIL) ctl = TUPLE4(&ctx->ctl_heap[0], - make_small(DOP_SEND_TT), am_Cookie, remote, token); + make_small(DOP_SEND_TT), am_Empty, remote, token); else - ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_SEND), am_Cookie, remote); + ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_SEND), am_Empty, 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, @@ -947,11 +938,7 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message, DTRACE_CHARBUF(receiver_name, 128); #endif - if (SEQ_TRACE_TOKEN(sender) != NIL -#ifdef USE_VM_PROBES - && SEQ_TRACE_TOKEN(sender) != am_have_dt_utag -#endif - ) { + if (have_seqtrace(SEQ_TRACE_TOKEN(sender))) { seq_trace_update_send(sender); token = SEQ_TRACE_TOKEN(sender); seq_trace_output(token, message, SEQ_TRACE_SEND, remote_name, sender); @@ -966,7 +953,7 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message, erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), "{%T,%s}", remote_name, node_name); msize = size_object(message); - if (token != NIL && token != am_have_dt_utag) { + if (have_seqtrace(token)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); @@ -976,10 +963,10 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message, if (token != NIL) ctl = TUPLE5(&ctx->ctl_heap[0], make_small(DOP_REG_SEND_TT), - sender->common.id, am_Cookie, remote_name, token); + sender->common.id, am_Empty, remote_name, token); else ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_REG_SEND), - sender->common.id, am_Cookie, remote_name); + sender->common.id, am_Empty, 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, @@ -1011,11 +998,7 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote, #endif UseTmpHeapNoproc(6); - if (token != NIL -#ifdef USE_VM_PROBES - && token != am_have_dt_utag -#endif - ) { + if (have_seqtrace(token)) { seq_trace_update_send(dsdp->proc); seq_trace_output_exit(token, reason, SEQ_TRACE_SEND, remote, local); ctl = TUPLE5(&ctl_heap[0], @@ -1034,7 +1017,7 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote, "{%T,%s}", remote, node_name); erts_snprintf(reason_str, sizeof(DTRACE_CHARBUF_NAME(reason_str)), "%T", reason); - if (token != NIL && token != am_have_dt_utag) { + if (have_seqtrace(token)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); @@ -1292,7 +1275,7 @@ int erts_net_message(Port *prt, erts_smp_de_links_unlock(dep); if (IS_TRACED_FL(rp, F_TRACE_PROCS)) - trace_proc(NULL, rp, am_getting_linked, from); + trace_proc(NULL, 0, rp, am_getting_linked, from); erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); break; @@ -1317,7 +1300,7 @@ int erts_net_message(Port *prt, lnk = erts_remove_link(&ERTS_P_LINKS(rp), from); if (IS_TRACED_FL(rp, F_TRACE_PROCS) && lnk != NULL) { - trace_proc(NULL, rp, am_getting_unlinked, from); + trace_proc(NULL, 0, rp, am_getting_unlinked, from); } erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); @@ -1466,7 +1449,7 @@ int erts_net_message(Port *prt, ErlOffHeap *ohp; ASSERT(xsize); heap_frag = erts_dist_ext_trailer(ede_copy); - ERTS_INIT_HEAP_FRAG(heap_frag, token_size); + ERTS_INIT_HEAP_FRAG(heap_frag, token_size, token_size); hp = heap_frag->mem; ohp = &heap_frag->off_heap; token = tuple[5]; @@ -1515,7 +1498,7 @@ int erts_net_message(Port *prt, ErlOffHeap *ohp; ASSERT(xsize); heap_frag = erts_dist_ext_trailer(ede_copy); - ERTS_INIT_HEAP_FRAG(heap_frag, token_size); + ERTS_INIT_HEAP_FRAG(heap_frag, token_size, token_size); hp = heap_frag->mem; ohp = &heap_frag->off_heap; token = tuple[4]; @@ -1645,7 +1628,11 @@ int erts_net_message(Port *prt, ERTS_XSIG_FLG_IGN_KILL); if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) { /* We didn't exit the process and it is traced */ - trace_proc(NULL, rp, am_getting_unlinked, from); + if (rp_locks & ERTS_PROC_LOCKS_XSIG_SEND) { + erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_XSIG_SEND); + rp_locks &= ~ERTS_PROC_LOCKS_XSIG_SEND; + } + trace_proc(NULL, 0, rp, am_getting_unlinked, from); } } erts_smp_proc_unlock(rp, rp_locks); @@ -1736,7 +1723,7 @@ decode_error: } data_error: UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE); - erts_deliver_port_exit(prt, dep->cid, am_killed, 0); + erts_deliver_port_exit(prt, dep->cid, am_killed, 0, 1); ERTS_SMP_CHK_NO_PROC_LOCKS; return -1; } @@ -2062,9 +2049,9 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf) } -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) #define ERTS_PORT_REDS_MASK__ 0x003fffffffffffffL -#elif defined(ARCH_32) || HALFWORD_HEAP +#elif defined(ARCH_32) #define ERTS_PORT_REDS_MASK__ 0x003fffff #else # error "Ohh come on ... !?!" @@ -2106,7 +2093,7 @@ erts_dist_command(Port *prt, int reds_limit) erts_smp_de_runlock(dep); if (status & ERTS_DE_SFLG_EXITING) { - erts_deliver_port_exit(prt, prt->common.id, am_killed, 0); + erts_deliver_port_exit(prt, prt->common.id, am_killed, 0, 1); erts_deref_dist_entry(dep); return reds + ERTS_PORT_REDS_DIST_CMD_EXIT; } @@ -3275,11 +3262,16 @@ send_nodes_mon_msg(Process *rp, Uint sz) { Eterm msg; - ErlHeapFragment* bp; + Eterm *hp; + ErtsMessage *mp; ErlOffHeap *ohp; - Eterm *hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, rp_locksp); #ifdef DEBUG - Eterm *hend = hp + sz; + Eterm *hend; +#endif + + mp = erts_alloc_message_heap(rp, rp_locksp, sz, &hp, &ohp); +#ifdef DEBUG + hend = hp + sz; #endif if (!nmp->opts) { @@ -3325,7 +3317,7 @@ send_nodes_mon_msg(Process *rp, } ASSERT(hend == hp); - erts_queue_message(rp, rp_locksp, bp, msg, NIL); + erts_queue_message(rp, rp_locksp, mp, msg); } static void diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h index fb777d9ac1..e82b416286 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -43,6 +43,7 @@ #define DFLAG_INTERNAL_TAGS 0x8000 #define DFLAG_UTF8_ATOMS 0x10000 #define DFLAG_MAP_TAG 0x20000 +#define DFLAG_BIG_CREATION 0x40000 /* All flags that should be enabled when term_to_binary/1 is used. */ #define TERM_TO_BINARY_DFLAGS (DFLAG_EXTENDED_REFERENCES \ @@ -51,7 +52,8 @@ | DFLAG_EXTENDED_PIDS_PORTS \ | DFLAG_EXPORT_PTR_TAG \ | DFLAG_BIT_BINARIES \ - | DFLAG_MAP_TAG) + | DFLAG_MAP_TAG \ + | DFLAG_BIG_CREATION) /* opcodes used in distribution messages */ #define DOP_LINK 1 diff --git a/erts/emulator/beam/dtrace-wrapper.h b/erts/emulator/beam/dtrace-wrapper.h index d343dc5ab0..6f70d5961e 100644 --- a/erts/emulator/beam/dtrace-wrapper.h +++ b/erts/emulator/beam/dtrace-wrapper.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Dustin Sallings, Michal Ptaszek, Scott Lystig Fritchie 2011-2012. + * Copyright Dustin Sallings, Michal Ptaszek, Scott Lystig Fritchie 2011-2016. * All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); diff --git a/erts/emulator/beam/elib_memmove.c b/erts/emulator/beam/elib_memmove.c index d4ca30158e..2f45f69026 100644 --- a/erts/emulator/beam/elib_memmove.c +++ b/erts/emulator/beam/elib_memmove.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_afit_alloc.c b/erts/emulator/beam/erl_afit_alloc.c index 4b0541c10e..eda3ad870a 100644 --- a/erts/emulator/beam/erl_afit_alloc.c +++ b/erts/emulator/beam/erl_afit_alloc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2013. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_afit_alloc.h b/erts/emulator/beam/erl_afit_alloc.h index ef050ff50e..74258e284a 100644 --- a/erts/emulator/beam/erl_afit_alloc.h +++ b/erts/emulator/beam/erl_afit_alloc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2013. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 5f8cd2bbf7..d04977b9ae 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2013. All Rights Reserved. + * Copyright Ericsson AB 2002-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -30,6 +30,7 @@ #endif #define ERTS_ALLOC_C__ #define ERTS_ALC_INTERNAL__ +#define ERTS_WANT_MEM_MAPPERS #include "sys.h" #define ERL_THREADS_EMU_INTERNAL__ #include "erl_threads.h" @@ -103,9 +104,9 @@ static Uint install_debug_functions(void); static int lock_all_physical_memory = 0; -ErtsAllocatorFunctions_t erts_allctrs[ERTS_ALC_A_MAX+1]; +ErtsAllocatorFunctions_t ERTS_WRITE_UNLIKELY(erts_allctrs[ERTS_ALC_A_MAX+1]); ErtsAllocatorInfo_t erts_allctrs_info[ERTS_ALC_A_MAX+1]; -ErtsAllocatorThrSpec_t erts_allctr_thr_spec[ERTS_ALC_A_MAX+1]; +ErtsAllocatorThrSpec_t ERTS_WRITE_UNLIKELY(erts_allctr_thr_spec[ERTS_ALC_A_MAX+1]); #define ERTS_MIN(A, B) ((A) < (B) ? (A) : (B)) #define ERTS_MAX(A, B) ((A) > (B) ? (A) : (B)) @@ -123,10 +124,6 @@ typedef union { static ErtsAllocatorState_t std_alloc_state; static ErtsAllocatorState_t ll_alloc_state; -#if HALFWORD_HEAP -static ErtsAllocatorState_t std_low_alloc_state; -static ErtsAllocatorState_t ll_low_alloc_state; -#endif static ErtsAllocatorState_t sl_alloc_state; static ErtsAllocatorState_t temp_alloc_state; static ErtsAllocatorState_t eheap_alloc_state; @@ -134,6 +131,10 @@ static ErtsAllocatorState_t binary_alloc_state; static ErtsAllocatorState_t ets_alloc_state; static ErtsAllocatorState_t driver_alloc_state; static ErtsAllocatorState_t fix_alloc_state; +static ErtsAllocatorState_t literal_alloc_state; +#ifdef ERTS_ALC_A_EXEC +static ErtsAllocatorState_t exec_alloc_state; +#endif static ErtsAllocatorState_t test_alloc_state; typedef struct { @@ -151,24 +152,10 @@ typedef struct { #define ERTS_ALC_INFO_A_MSEG_ALLOC (ERTS_ALC_A_MAX + 2) #define ERTS_ALC_INFO_A_MAX ERTS_ALC_INFO_A_MSEG_ALLOC -#if !HALFWORD_HEAP ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(aireq, - ErtsAllocInfoReq, - 5, - ERTS_ALC_T_AINFO_REQ) -#else -static ERTS_INLINE ErtsAllocInfoReq * -aireq_alloc(void) -{ - return erts_alloc(ERTS_ALC_T_AINFO_REQ, sizeof(ErtsAllocInfoReq)); -} - -static ERTS_INLINE void -aireq_free(ErtsAllocInfoReq *ptr) -{ - erts_free(ERTS_ALC_T_AINFO_REQ, ptr); -} -#endif + ErtsAllocInfoReq, + 5, + ERTS_ALC_T_AINFO_REQ) ErtsAlcType_t erts_fix_core_allocator_ix; @@ -182,6 +169,8 @@ enum allctr_type { struct au_init { int enable; int thr_spec; + int disable_allowed; + int thr_spec_allowed; int carrier_migration_allowed; enum allctr_type atype; struct { @@ -230,14 +219,12 @@ typedef struct { struct au_init ets_alloc; struct au_init driver_alloc; struct au_init fix_alloc; -#if HALFWORD_HEAP - struct au_init std_low_alloc; - struct au_init ll_low_alloc; -#endif + struct au_init literal_alloc; + struct au_init exec_alloc; struct au_init test_alloc; } erts_alc_hndl_args_init_t; -#define ERTS_AU_INIT__ {0, 0, 1, GOODFIT, DEFAULT_ALLCTR_INIT, {1,1,1,1}} +#define ERTS_AU_INIT__ {0, 0, 1, 1, 1, GOODFIT, DEFAULT_ALLCTR_INIT, {1,1,1,1}} #define SET_DEFAULT_ALLOC_OPTS(IP) \ do { \ @@ -261,10 +248,6 @@ set_default_sl_alloc_opts(struct au_init *ip) #endif ip->init.util.ts = ERTS_ALC_MTA_SHORT_LIVED; ip->init.util.rsbcst = 80; -#if HALFWORD_HEAP - ip->init.util.force = 1; - ip->init.util.low_mem = 1; -#endif ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL; } @@ -300,9 +283,9 @@ set_default_ll_alloc_opts(struct au_init *ip) ip->init.util.name_prefix = "ll_"; ip->init.util.alloc_no = ERTS_ALC_A_LONG_LIVED; #ifndef SMALL_MEMORY - ip->init.util.mmbcs = 2*1024*1024 - 40; /* Main carrier size */ + ip->init.util.mmbcs = 2*1024*1024; /* Main carrier size */ #else - ip->init.util.mmbcs = 1*1024*1024 - 40; /* Main carrier size */ + ip->init.util.mmbcs = 1*1024*1024; /* Main carrier size */ #endif ip->init.util.ts = ERTS_ALC_MTA_LONG_LIVED; ip->init.util.asbcst = 0; @@ -313,6 +296,87 @@ set_default_ll_alloc_opts(struct au_init *ip) } static void +set_default_literal_alloc_opts(struct au_init *ip) +{ + SET_DEFAULT_ALLOC_OPTS(ip); + ip->enable = 1; + ip->thr_spec = 0; + ip->disable_allowed = 0; + ip->thr_spec_allowed = 0; + ip->carrier_migration_allowed = 0; + ip->atype = BESTFIT; + ip->init.bf.ao = 1; + ip->init.util.ramv = 0; + ip->init.util.mmsbc = 0; + ip->init.util.sbct = ~((UWord) 0); + ip->init.util.name_prefix = "literal_"; + ip->init.util.alloc_no = ERTS_ALC_A_LITERAL; +#ifndef SMALL_MEMORY + ip->init.util.mmbcs = 1024*1024; /* Main carrier size */ +#else + ip->init.util.mmbcs = 256*1024; /* Main carrier size */ +#endif + ip->init.util.ts = ERTS_ALC_MTA_LITERAL; + ip->init.util.asbcst = 0; + ip->init.util.rsbcst = 0; + ip->init.util.rsbcmt = 0; + ip->init.util.rmbcmt = 0; + ip->init.util.acul = 0; + +#if defined(ARCH_32) +# if HAVE_ERTS_MSEG + ip->init.util.mseg_alloc = &erts_alcu_literal_32_mseg_alloc; + ip->init.util.mseg_realloc = &erts_alcu_literal_32_mseg_realloc; + ip->init.util.mseg_dealloc = &erts_alcu_literal_32_mseg_dealloc; +# endif + ip->init.util.sys_alloc = &erts_alcu_literal_32_sys_alloc; + ip->init.util.sys_realloc = &erts_alcu_literal_32_sys_realloc; + ip->init.util.sys_dealloc = &erts_alcu_literal_32_sys_dealloc; +#elif defined(ARCH_64) +# ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION + ip->init.util.mseg_alloc = &erts_alcu_mmapper_mseg_alloc; + ip->init.util.mseg_realloc = &erts_alcu_mmapper_mseg_realloc; + ip->init.util.mseg_dealloc = &erts_alcu_mmapper_mseg_dealloc; + ip->init.util.mseg_mmapper = &erts_literal_mmapper; +# endif +#else +# error Unknown architecture +#endif +} + +#ifdef ERTS_ALC_A_EXEC +static void +set_default_exec_alloc_opts(struct au_init *ip) +{ + SET_DEFAULT_ALLOC_OPTS(ip); + ip->enable = 1; + ip->thr_spec = 0; + ip->disable_allowed = 0; + ip->thr_spec_allowed = 0; + ip->carrier_migration_allowed = 0; + ip->atype = BESTFIT; + ip->init.bf.ao = 1; + ip->init.util.ramv = 0; + ip->init.util.mmsbc = 0; + ip->init.util.sbct = ~((UWord) 0); + ip->init.util.name_prefix = "exec_"; + ip->init.util.alloc_no = ERTS_ALC_A_EXEC; + ip->init.util.mmbcs = 0; /* No main carrier */ + ip->init.util.ts = ERTS_ALC_MTA_EXEC; + ip->init.util.asbcst = 0; + ip->init.util.rsbcst = 0; + ip->init.util.rsbcmt = 0; + ip->init.util.rmbcmt = 0; + ip->init.util.acul = 0; + + ip->init.util.mseg_alloc = &erts_alcu_mmapper_mseg_alloc; + ip->init.util.mseg_realloc = &erts_alcu_mmapper_mseg_realloc; + ip->init.util.mseg_dealloc = &erts_alcu_mmapper_mseg_dealloc; + ip->init.util.mseg_mmapper = &erts_exec_mmapper; +} +#endif /* ERTS_ALC_A_EXEC */ + +static void set_default_temp_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); @@ -330,10 +394,6 @@ set_default_temp_alloc_opts(struct au_init *ip) ip->init.util.ts = ERTS_ALC_MTA_TEMPORARY; ip->init.util.rsbcst = 90; ip->init.util.rmbcmt = 100; -#if HALFWORD_HEAP - ip->init.util.force = 1; - ip->init.util.low_mem = 1; -#endif } static void @@ -352,10 +412,6 @@ set_default_eheap_alloc_opts(struct au_init *ip) #endif ip->init.util.ts = ERTS_ALC_MTA_EHEAP; ip->init.util.rsbcst = 50; -#if HALFWORD_HEAP - ip->init.util.force = 1; - ip->init.util.low_mem = 1; -#endif ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC; } @@ -589,18 +645,16 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_PROC)] = sizeof(Process); -#if !HALFWORD_HEAP fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MONITOR_SH)] = ERTS_MONITOR_SH_SIZE * sizeof(Uint); fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_NLINK_SH)] = ERTS_LINK_SH_SIZE * sizeof(Uint); -#endif fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_EV_D_STATE)] = sizeof(ErtsDrvEventDataState); fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_SEL_D_STATE)] = sizeof(ErtsDrvSelectDataState); fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MSG_REF)] - = sizeof(ErlMessage); + = sizeof(ErtsMessageRef); #ifdef ERTS_SMP fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_THR_Q_EL_SL)] = sizeof(ErtsThrQElement_t); @@ -642,6 +696,10 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) set_default_driver_alloc_opts(&init.driver_alloc); set_default_fix_alloc_opts(&init.fix_alloc, fix_type_sizes); + set_default_literal_alloc_opts(&init.literal_alloc); +#ifdef ERTS_ALC_A_EXEC + set_default_exec_alloc_opts(&init.exec_alloc); +#endif set_default_test_alloc_opts(&init.test_alloc); if (argc && argv) @@ -670,6 +728,10 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.ets_alloc.thr_spec = 0; init.driver_alloc.thr_spec = 0; init.fix_alloc.thr_spec = 0; + init.literal_alloc.thr_spec = 0; +#ifdef ERTS_ALC_A_EXEC + init.exec_alloc.thr_spec = 0; +#endif #endif /* Make adjustments for carrier migration support */ @@ -682,6 +744,10 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) adjust_carrier_migration_support(&init.ets_alloc); adjust_carrier_migration_support(&init.driver_alloc); adjust_carrier_migration_support(&init.fix_alloc); + adjust_carrier_migration_support(&init.literal_alloc); +#ifdef ERTS_ALC_A_EXEC + adjust_carrier_migration_support(&init.exec_alloc); +#endif if (init.erts_alloc_config) { /* Adjust flags that erts_alloc_config won't like */ @@ -696,6 +762,10 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.ets_alloc.thr_spec = 0; init.driver_alloc.thr_spec = 0; init.fix_alloc.thr_spec = 0; + init.literal_alloc.thr_spec = 0; +#ifdef ERTS_ALC_A_EXEC + init.exec_alloc.thr_spec = 0; +#endif /* No carrier migration */ init.temp_alloc.init.util.acul = 0; @@ -707,6 +777,10 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.ets_alloc.init.util.acul = 0; init.driver_alloc.init.util.acul = 0; init.fix_alloc.init.util.acul = 0; + init.literal_alloc.init.util.acul = 0; +#ifdef ERTS_ALC_A_EXEC + init.exec_alloc.init.util.acul = 0; +#endif } #ifdef ERTS_SMP @@ -723,6 +797,10 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) adjust_tpref(&init.ets_alloc, erts_no_schedulers); adjust_tpref(&init.driver_alloc, erts_no_schedulers); adjust_tpref(&init.fix_alloc, erts_no_schedulers); + adjust_tpref(&init.literal_alloc, erts_no_schedulers); +#ifdef ERTS_ALC_A_EXEC + adjust_tpref(&init.exec_alloc, erts_no_schedulers); +#endif #else /* No thread specific if not smp */ @@ -741,6 +819,10 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) refuse_af_strategy(&init.ets_alloc); refuse_af_strategy(&init.driver_alloc); refuse_af_strategy(&init.fix_alloc); + refuse_af_strategy(&init.literal_alloc); +#ifdef ERTS_ALC_A_EXEC + refuse_af_strategy(&init.exec_alloc); +#endif #ifdef ERTS_SMP if (!init.temp_alloc.thr_spec) @@ -775,24 +857,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) erts_allctrs[ERTS_ALC_A_SYSTEM].free = erts_sys_free; erts_allctrs_info[ERTS_ALC_A_SYSTEM].enabled = 1; -#if HALFWORD_HEAP - /* Init low memory variants by cloning */ - init.std_low_alloc = init.std_alloc; - init.std_low_alloc.init.util.name_prefix = "std_low_"; - init.std_low_alloc.init.util.alloc_no = ERTS_ALC_A_STANDARD_LOW; - init.std_low_alloc.init.util.force = 1; - init.std_low_alloc.init.util.low_mem = 1; - - init.ll_low_alloc = init.ll_alloc; - init.ll_low_alloc.init.util.name_prefix = "ll_low_"; - init.ll_low_alloc.init.util.alloc_no = ERTS_ALC_A_LONG_LIVED_LOW; - init.ll_low_alloc.init.util.force = 1; - init.ll_low_alloc.init.util.low_mem = 1; - - set_au_allocator(ERTS_ALC_A_STANDARD_LOW, &init.std_low_alloc, ncpu); - set_au_allocator(ERTS_ALC_A_LONG_LIVED_LOW, &init.ll_low_alloc, ncpu); -#endif /* HALFWORD */ - set_au_allocator(ERTS_ALC_A_TEMPORARY, &init.temp_alloc, ncpu); set_au_allocator(ERTS_ALC_A_SHORT_LIVED, &init.sl_alloc, ncpu); set_au_allocator(ERTS_ALC_A_STANDARD, &init.std_alloc, ncpu); @@ -802,6 +866,10 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) set_au_allocator(ERTS_ALC_A_ETS, &init.ets_alloc, ncpu); set_au_allocator(ERTS_ALC_A_DRIVER, &init.driver_alloc, ncpu); set_au_allocator(ERTS_ALC_A_FIXED_SIZE, &init.fix_alloc, ncpu); + set_au_allocator(ERTS_ALC_A_LITERAL, &init.literal_alloc, ncpu); +#ifdef ERTS_ALC_A_EXEC + set_au_allocator(ERTS_ALC_A_EXEC, &init.exec_alloc, ncpu); +#endif set_au_allocator(ERTS_ALC_A_TEST, &init.test_alloc, ncpu); for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { @@ -836,14 +904,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) start_au_allocator(ERTS_ALC_A_LONG_LIVED, &init.ll_alloc, &ll_alloc_state); -#if HALFWORD_HEAP - start_au_allocator(ERTS_ALC_A_LONG_LIVED_LOW, - &init.ll_low_alloc, - &ll_low_alloc_state); - start_au_allocator(ERTS_ALC_A_STANDARD_LOW, - &init.std_low_alloc, - &std_low_alloc_state); -#endif start_au_allocator(ERTS_ALC_A_EHEAP, &init.eheap_alloc, &eheap_alloc_state); @@ -863,7 +923,14 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) start_au_allocator(ERTS_ALC_A_FIXED_SIZE, &init.fix_alloc, &fix_alloc_state); - + start_au_allocator(ERTS_ALC_A_LITERAL, + &init.literal_alloc, + &literal_alloc_state); +#ifdef ERTS_ALC_A_EXEC + start_au_allocator(ERTS_ALC_A_EXEC, + &init.exec_alloc, + &exec_alloc_state); +#endif start_au_allocator(ERTS_ALC_A_TEST, &init.test_alloc, &test_alloc_state); @@ -871,9 +938,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) erts_mtrace_install_wrapper_functions(); extra_block_size += erts_instr_init(init.instr.stat, init.instr.map); -#if !HALFWORD_HEAP init_aireq_alloc(); -#endif #ifdef DEBUG extra_block_size += install_debug_functions(); @@ -971,6 +1036,10 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu) else #endif { +#ifdef ERTS_SMP + erts_exit(ERTS_ABORT_EXIT, "%salloc is not thread safe\n", + init->init.util.name_prefix); +#else af->alloc = erts_alcu_alloc; if (init->init.util.fix_type_size) af->realloc = erts_realloc_fixed_size; @@ -979,6 +1048,7 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu) else af->realloc = erts_alcu_realloc; af->free = erts_alcu_free; +#endif } af->extra = NULL; ai->alloc_util = 1; @@ -1051,7 +1121,7 @@ start_au_allocator(ErtsAlcType_t alctr_n, } for (i = 0; i < size; i++) { - void *as; + Allctr_t *as; atype = init->atype; if (!init->thr_spec) @@ -1088,22 +1158,22 @@ start_au_allocator(ErtsAlcType_t alctr_n, switch (atype) { case GOODFIT: - as = (void *) erts_gfalc_start((GFAllctr_t *) as0, + as = erts_gfalc_start((GFAllctr_t *) as0, &init->init.gf, &init->init.util); break; case BESTFIT: - as = (void *) erts_bfalc_start((BFAllctr_t *) as0, + as = erts_bfalc_start((BFAllctr_t *) as0, &init->init.bf, &init->init.util); break; case AFIT: - as = (void *) erts_afalc_start((AFAllctr_t *) as0, + as = erts_afalc_start((AFAllctr_t *) as0, &init->init.af, &init->init.util); break; case AOFIRSTFIT: - as = (void *) erts_aoffalc_start((AOFFAllctr_t *) as0, + as = erts_aoffalc_start((AOFFAllctr_t *) as0, &init->init.aoff, &init->init.util); break; @@ -1273,9 +1343,6 @@ get_acul_value(struct au_init *auip, char *param_end, char** argv, int* ip) if (sys_strcmp(value, "de") == 0) { switch (auip->init.util.alloc_no) { case ERTS_ALC_A_LONG_LIVED: -#if HALFWORD_HEAP - case ERTS_ALC_A_LONG_LIVED_LOW: -#endif return ERTS_ALC_DEFAULT_ENABLED_ACUL_LL_ALLOC; case ERTS_ALC_A_EHEAP: return ERTS_ALC_DEFAULT_ENABLED_ACUL_EHEAP_ALLOC; @@ -1353,9 +1420,17 @@ handle_au_arg(struct au_init *auip, else goto bad_switch; break; - case 'e': - auip->enable = get_bool_value(sub_param+1, argv, ip); + case 'e': { + int e = get_bool_value(sub_param + 1, argv, ip); + if (!auip->disable_allowed && !e) { + if (!u_switch) + bad_value(param, sub_param + 1, "false"); + else + ASSERT(auip->enable); /* ignore */ + } + else auip->enable = e; break; + } case 'l': if (has_prefix("lmbcs", sub_param)) { auip->default_.lmbcs = 0; @@ -1424,7 +1499,14 @@ handle_au_arg(struct au_init *auip, case 't': { int res = get_bool_value(sub_param+1, argv, ip); if (res > 0) { - auip->thr_spec = 1; + if (!auip->thr_spec_allowed) { + if (!u_switch) + bad_value(param, sub_param + 1, "true"); + else + ASSERT(!auip->thr_spec); /* ignore */ + } + else + auip->thr_spec = 1; break; } else if (res == 0) { @@ -1473,6 +1555,26 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) case 'B': handle_au_arg(&init->binary_alloc, &argv[i][3], argv, &i, 0); break; + case 'I': + if (has_prefix("scs", argv[i]+3)) { +#if HAVE_ERTS_MSEG + init->mseg.literal_mmap.scs = +#endif + get_mb_value(argv[i]+6, argv, &i); + } + else + handle_au_arg(&init->literal_alloc, &argv[i][3], argv, &i, 0); + break; + case 'X': + if (has_prefix("scs", argv[i]+3)) { +#ifdef ERTS_ALC_A_EXEC + init->mseg.exec_mmap.scs = +#endif + get_mb_value(argv[i]+6, argv, &i); + } + else + handle_au_arg(&init->exec_alloc, &argv[i][3], argv, &i, 0); + break; case 'D': handle_au_arg(&init->std_alloc, &argv[i][3], argv, &i, 0); break; @@ -1509,25 +1611,25 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) } else if (has_prefix("scs", argv[i]+3)) { #if HAVE_ERTS_MSEG - init->mseg.mmap.scs = + init->mseg.dflt_mmap.scs = #endif get_mb_value(argv[i]+6, argv, &i); } else if (has_prefix("sco", argv[i]+3)) { #if HAVE_ERTS_MSEG - init->mseg.mmap.sco = + init->mseg.dflt_mmap.sco = #endif get_bool_value(argv[i]+6, argv, &i); } else if (has_prefix("scrpm", argv[i]+3)) { #if HAVE_ERTS_MSEG - init->mseg.mmap.scrpm = + init->mseg.dflt_mmap.scrpm = #endif get_bool_value(argv[i]+8, argv, &i); } else if (has_prefix("scrfsd", argv[i]+3)) { #if HAVE_ERTS_MSEG - init->mseg.mmap.scrfsd = + init->mseg.dflt_mmap.scrfsd = #endif get_amount_value(argv[i]+9, argv, &i); } @@ -1996,48 +2098,6 @@ alcu_size(ErtsAlcType_t ai, ErtsAlcUFixInfo_t *fi, int fisz) return res; } -#if HALFWORD_HEAP -static ERTS_INLINE int -alcu_is_low(ErtsAlcType_t ai) -{ - int is_low = 0; - ASSERT(erts_allctrs_info[ai].enabled); - ASSERT(erts_allctrs_info[ai].alloc_util); - - if (!erts_allctrs_info[ai].thr_spec) { - Allctr_t *allctr = erts_allctrs_info[ai].extra; - is_low = allctr->mseg_opt.low_mem; - } - else { - ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[ai]; - int i; -# ifdef DEBUG - int found_one = 0; -# endif - - ASSERT(tspec->enabled); - - for (i = tspec->size - 1; i >= 0; i--) { - Allctr_t *allctr = tspec->allctr[i]; - if (allctr) { -# ifdef DEBUG - if (!found_one) { - is_low = allctr->mseg_opt.low_mem; - found_one = 1; - } - else ASSERT(is_low == allctr->mseg_opt.low_mem); -# else - is_low = allctr->mseg_opt.low_mem; - break; -# endif - } - } - ASSERT(found_one); - } - return is_low; -} -#endif /* HALFWORD */ - static ERTS_INLINE void add_fix_values(UWord *ap, UWord *up, ErtsAlcUFixInfo_t *fi, ErtsAlcType_t type) { @@ -2067,9 +2127,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) int code; int ets; int maximum; -#if HALFWORD_HEAP - int low; -#endif } want = {0}; struct { UWord total; @@ -2082,9 +2139,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) UWord code; UWord ets; UWord maximum; -#if HALFWORD_HEAP - UWord low; -#endif } size = {0}; Eterm atoms[sizeof(size)/sizeof(UWord)]; UWord *uintps[sizeof(size)/sizeof(UWord)]; @@ -2143,11 +2197,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) atoms[length] = am_maximum; uintps[length++] = &size.maximum; } -#if HALFWORD_HEAP - want.low = 1; - atoms[length] = am_low; - uintps[length++] = &size.low; -#endif } else { DeclareTmpHeapNoproc(tmp_heap,2); @@ -2241,15 +2290,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) return am_badarg; } break; -#if HALFWORD_HEAP - case am_low: - if (!want.low) { - want.low = 1; - atoms[length] = am_low; - uintps[length++] = &size.low; - } - break; -#endif default: UnUseTmpHeapNoproc(2); return am_badarg; @@ -2330,11 +2370,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) if (save) *save = asz; size.total += asz; -#if HALFWORD_HEAP - if (alcu_is_low(ai)) { - size.low += asz; - } -#endif } } } @@ -2361,7 +2396,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) &size.processes_used, fi, ERTS_ALC_T_PROC); -#if !HALFWORD_HEAP add_fix_values(&size.processes, &size.processes_used, fi, @@ -2371,7 +2405,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) &size.processes_used, fi, ERTS_ALC_T_NLINK_SH); -#endif add_fix_values(&size.processes, &size.processes_used, fi, @@ -2810,7 +2843,7 @@ erts_allocator_info(int to, void *arg) erts_mseg_info(i, &to, arg, 0, NULL, NULL); } erts_print(to, arg, "=allocator:mseg_alloc.erts_mmap\n"); - erts_mmap_info(&to, arg, NULL, NULL, &emis); + erts_mmap_info(&erts_dflt_mmapper, &to, arg, NULL, NULL, &emis); } #endif @@ -3036,12 +3069,12 @@ reply_alloc_info(void *vair) int global_instances = air->req_sched == sched_id; ErtsProcLocks rp_locks; Process *rp = air->proc; - Eterm ref_copy = NIL, ai_list, msg; - Eterm *hp = NULL, *hp_end = NULL, *hp_start = NULL; + Eterm ref_copy = NIL, ai_list, msg = NIL; + Eterm *hp = NULL, *hp_start = NULL, *hp_end = NULL; Eterm **hpp; Uint sz, *szp; ErlOffHeap *ohp = NULL; - ErlHeapFragment *bp = NULL; + ErtsMessage *mp = NULL; struct erts_mmap_info_struct emis; int i; Eterm (*info_func)(Allctr_t *, @@ -3162,7 +3195,8 @@ reply_alloc_info(void *vair) ai_list = erts_bld_cons(hpp, szp, ainfo, ai_list); - ainfo = (air->only_sz ? NIL : erts_mmap_info(NULL, NULL, hpp, szp, &emis)); + ainfo = (air->only_sz ? NIL : + erts_mmap_info(&erts_dflt_mmapper, NULL, NULL, hpp, szp, &emis)); ainfo = erts_bld_tuple3(hpp, szp, alloc_atom, erts_bld_atom(hpp,szp,"erts_mmap"), @@ -3242,20 +3276,17 @@ reply_alloc_info(void *vair) if (hpp) break; - hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); hp_start = hp; hp_end = hp + sz; szp = NULL; hpp = &hp; } - if (bp) - bp = erts_resize_message_buffer(bp, hp - hp_start, &msg, 1); - else { - ASSERT(hp); - HRelease(rp, hp_end, hp); - } - erts_queue_message(rp, &rp_locks, bp, msg, NIL); + if (hp != hp_end) + erts_shrink_message_heap(&mp, rp, hp_start, hp, hp_end, &msg, 1); + + erts_queue_message(rp, &rp_locks, mp, msg); if (air->req_sched == sched_id) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -3479,8 +3510,11 @@ UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3) init.enable = 1; init.atype = GOODFIT; init.init.util.name_prefix = (char *) a1; - init.init.util.ts = a2 ? 1 : 0; - +#ifdef ERTS_SMP + init.init.util.ts = 1; +#else + init.init.util.ts = a2 ? 1 : 0; +#endif if ((char **) a3) { char **argv = (char **) a3; int i = 0; diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h index f540bae20d..925a081a02 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2013. All Rights Reserved. + * Copyright Ericsson AB 2002-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -30,6 +30,7 @@ #ifdef USE_THREADS #include "erl_threads.h" #endif +#include "erl_mmap.h" #ifdef DEBUG # undef ERTS_ALC_WANT_INLINE @@ -43,9 +44,11 @@ #if ERTS_CAN_INLINE && ERTS_ALC_WANT_INLINE # define ERTS_ALC_DO_INLINE 1 # define ERTS_ALC_INLINE static ERTS_INLINE +# define ERTS_ALC_FORCE_INLINE static ERTS_FORCE_INLINE #else # define ERTS_ALC_DO_INLINE 0 # define ERTS_ALC_INLINE +# define ERTS_ALC_FORCE_INLINE #endif #define ERTS_ALC_NO_FIXED_SIZES \ @@ -177,6 +180,12 @@ void sys_free(void *) __deprecated; /* erts_free() */ void *sys_alloc(Uint ) __deprecated; /* erts_alloc_fnf() */ void *sys_realloc(void *, Uint) __deprecated; /* erts_realloc_fnf() */ +#undef ERTS_HAVE_IS_IN_LITERAL_RANGE +#if defined(ARCH_32) || defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION) +# define ERTS_HAVE_IS_IN_LITERAL_RANGE +#endif + + /* * erts_alloc[_fnf](), erts_realloc[_fnf](), erts_free() works as * malloc(), realloc(), and free() with the following exceptions: @@ -204,6 +213,9 @@ void erts_free(ErtsAlcType_t type, void *ptr); void *erts_alloc_fnf(ErtsAlcType_t type, Uint size); void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size); int erts_is_allctr_wrapper_prelocked(void); +#ifdef ERTS_HAVE_IS_IN_LITERAL_RANGE +int erts_is_in_literal_range(void* ptr); +#endif #endif /* #if !ERTS_ALC_DO_INLINE */ @@ -221,12 +233,14 @@ ERTS_ALC_INLINE void *erts_alloc(ErtsAlcType_t type, Uint size) { void *res; + ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); res = (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)( - ERTS_ALC_T2N(type), - erts_allctrs[ERTS_ALC_T2A(type)].extra, - size); + ERTS_ALC_T2N(type), + erts_allctrs[ERTS_ALC_T2A(type)].extra, + size); if (!res) erts_alloc_n_enomem(ERTS_ALC_T2N(type), size); + ERTS_MSACC_POP_STATE_X(); return res; } @@ -234,6 +248,7 @@ ERTS_ALC_INLINE void *erts_realloc(ErtsAlcType_t type, void *ptr, Uint size) { void *res; + ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); res = (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)( ERTS_ALC_T2N(type), erts_allctrs[ERTS_ALC_T2A(type)].extra, @@ -241,37 +256,48 @@ void *erts_realloc(ErtsAlcType_t type, void *ptr, Uint size) size); if (!res) erts_realloc_n_enomem(ERTS_ALC_T2N(type), ptr, size); + ERTS_MSACC_POP_STATE_X(); return res; } ERTS_ALC_INLINE void erts_free(ErtsAlcType_t type, void *ptr) { + ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); (*erts_allctrs[ERTS_ALC_T2A(type)].free)( ERTS_ALC_T2N(type), erts_allctrs[ERTS_ALC_T2A(type)].extra, ptr); + ERTS_MSACC_POP_STATE_X(); } ERTS_ALC_INLINE void *erts_alloc_fnf(ErtsAlcType_t type, Uint size) { - return (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)( + void *res; + ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); + res = (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)( ERTS_ALC_T2N(type), erts_allctrs[ERTS_ALC_T2A(type)].extra, size); + ERTS_MSACC_POP_STATE_X(); + return res; } ERTS_ALC_INLINE void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size) { - return (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)( + void *res; + ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); + res = (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)( ERTS_ALC_T2N(type), erts_allctrs[ERTS_ALC_T2A(type)].extra, ptr, size); + ERTS_MSACC_POP_STATE_X(); + return res; } ERTS_ALC_INLINE @@ -281,6 +307,28 @@ int erts_is_allctr_wrapper_prelocked(void) && !!erts_tsd_get(erts_allctr_prelock_tsd_key); /* by me */ } +#ifdef ERTS_HAVE_IS_IN_LITERAL_RANGE + +ERTS_ALC_FORCE_INLINE +int erts_is_in_literal_range(void* ptr) +{ +#if defined(ARCH_32) + Uint ix = (UWord)ptr >> ERTS_MMAP_SUPERALIGNED_BITS; + + return erts_literal_vspace_map[ix / ERTS_VSPACE_WORD_BITS] + & ((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS)); + +#elif defined(ARCH_64) + extern char* erts_literals_start; + extern UWord erts_literals_size; + return ErtsInArea(ptr, erts_literals_start, erts_literals_size); +#else +# error No ARCH_xx +#endif +} + +#endif /* ERTS_HAVE_IS_IN_LITERAL_RANGE */ + #endif /* #if ERTS_ALC_DO_INLINE || defined(ERTS_ALC_INTERNAL__) */ #define ERTS_ALC_GET_THR_IX() ((int) erts_get_scheduler_id()) @@ -516,5 +564,3 @@ NAME##_free(TYPE *p) \ #undef ERTS_ALC_ATTRIBUTES #endif /* #ifndef ERL_ALLOC_H__ */ - - diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 7738531142..ba216c7eb4 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2014. All Rights Reserved. +# Copyright Ericsson AB 2003-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -86,10 +86,9 @@ allocator LONG_LIVED true ll_alloc allocator EHEAP true eheap_alloc allocator ETS true ets_alloc allocator FIXED_SIZE true fix_alloc - -+if halfword -allocator LONG_LIVED_LOW true ll_low_alloc -allocator STANDARD_LOW true std_low_alloc +allocator LITERAL true literal_alloc ++if exec_alloc +allocator EXEC true exec_alloc +endif +else # Non smp build @@ -101,10 +100,9 @@ allocator LONG_LIVED false ll_alloc allocator EHEAP false eheap_alloc allocator ETS false ets_alloc allocator FIXED_SIZE false fix_alloc - -+if halfword -allocator LONG_LIVED_LOW false ll_low_alloc -allocator STANDARD_LOW false std_low_alloc +allocator LITERAL false literal_alloc ++if exec_alloc +allocator EXEC false exec_alloc +endif +endif @@ -160,6 +158,8 @@ type OLD_HEAP EHEAP PROCESSES old_heap type HEAP_FRAG EHEAP PROCESSES heap_frag type TMP_HEAP TEMPORARY PROCESSES tmp_heap type MSG_REF FIXED_SIZE PROCESSES msg_ref +type MSG EHEAP PROCESSES message +type MSGQ_CHNG SHORT_LIVED PROCESSES messages_queue_change type MSG_ROOTS TEMPORARY PROCESSES msg_roots type ROOTSET TEMPORARY PROCESSES root_set type LOADER_TMP TEMPORARY CODE loader_tmp @@ -264,7 +264,6 @@ type PRTSD STANDARD SYSTEM port_specific_data type CPUDATA LONG_LIVED SYSTEM cpu_data type TMP_CPU_IDS SHORT_LIVED SYSTEM tmp_cpu_ids type EXT_TERM_DATA SHORT_LIVED PROCESSES external_term_data -type ZLIB STANDARD SYSTEM zlib type CPU_GRPS_MAP LONG_LIVED SYSTEM cpu_groups_map type AUX_WORK_TMO LONG_LIVED SYSTEM aux_work_timeouts type MISC_AUX_WORK_Q LONG_LIVED SYSTEM misc_aux_work_q @@ -276,6 +275,9 @@ 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 type IOB_REQ SHORT_LIVED SYSTEM io_bytes_request +type TRACER_NIF LONG_LIVED SYSTEM tracer_nif +type TRACE_MSG_QUEUE SHORT_LIVED SYSTEM trace_message_queue +type SCHED_ASYNC_JOB SHORT_LIVED SYSTEM async_calls +if threads_no_smp # Need thread safe allocs, but std_alloc and fix_alloc are not; @@ -294,8 +296,10 @@ type THR_Q_LL LONG_LIVED SYSTEM long_lived_thr_queue +if smp type ASYNC SHORT_LIVED SYSTEM async +type ZLIB STANDARD SYSTEM zlib +else -# sl_alloc is not thread safe in non smp build; therefore, we use driver_alloc +# sl/std_alloc is not thread safe in non smp build; therefore, we use driver_alloc +type ZLIB DRIVER SYSTEM zlib type ASYNC DRIVER SYSTEM async +endif @@ -341,42 +345,27 @@ type SL_MPATHS SHORT_LIVED SYSTEM sl_migration_paths # Currently most hipe code use this type. type HIPE SYSTEM SYSTEM hipe_data ++if exec_alloc +type HIPE_EXEC EXEC CODE hipe_code +endif -+if heap_frag_elim_test - -type SSB SHORT_LIVED PROCESSES ssb - +endif -+if halfword -type DDLL_PROCESS STANDARD_LOW SYSTEM ddll_processes -type MONITOR_LH STANDARD_LOW PROCESSES monitor_lh -type NLINK_LH STANDARD_LOW PROCESSES nlink_lh -type CODE LONG_LIVED_LOW CODE code -type DB_HEIR_DATA STANDARD_LOW ETS db_heir_data -type DB_MS_PSDO_PROC LONG_LIVED_LOW ETS db_match_pseudo_proc -type SCHDLR_DATA LONG_LIVED_LOW SYSTEM scheduler_data -type LL_TEMP_TERM LONG_LIVED_LOW SYSTEM ll_temp_term ++if heap_frag_elim_test -type NIF_TRAP_EXPORT STANDARD_LOW CODE nif_trap_export_entry -type EXPORT LONG_LIVED_LOW CODE export_entry -type MONITOR_SH STANDARD_LOW PROCESSES monitor_sh -type NLINK_SH STANDARD_LOW PROCESSES nlink_sh -type AINFO_REQ STANDARD_LOW SYSTEM alloc_info_request -type SCHED_WTIME_REQ STANDARD_LOW SYSTEM sched_wall_time_request -type GC_INFO_REQ STANDARD_LOW SYSTEM gc_info_request -type PORT_DATA_HEAP STANDARD_LOW SYSTEM port_data_heap -type SYS_CHECK_REQ STANDARD_LOW SYSTEM system_check_request +type SSB SHORT_LIVED PROCESSES ssb -+else # "fullword" ++endif + +type DEBUG SHORT_LIVED SYSTEM debugging type DDLL_PROCESS STANDARD SYSTEM ddll_processes type MONITOR_LH STANDARD PROCESSES monitor_lh type NLINK_LH STANDARD PROCESSES nlink_lh type CODE LONG_LIVED CODE code +type LITERAL LITERAL CODE literal type DB_HEIR_DATA STANDARD ETS db_heir_data type DB_MS_PSDO_PROC LONG_LIVED ETS db_match_pseudo_proc type SCHDLR_DATA LONG_LIVED SYSTEM scheduler_data @@ -390,11 +379,9 @@ type AINFO_REQ SHORT_LIVED SYSTEM alloc_info_request type SCHED_WTIME_REQ SHORT_LIVED SYSTEM sched_wall_time_request type GC_INFO_REQ SHORT_LIVED SYSTEM gc_info_request type PORT_DATA_HEAP STANDARD SYSTEM port_data_heap +type MSACC DRIVER SYSTEM microstate_accounting type SYS_CHECK_REQ SHORT_LIVED SYSTEM system_check_request -+endif - - # # Types used by system specific code # @@ -432,21 +419,6 @@ type SYS_WRITE_BUF BINARY SYSTEM sys_write_buf +endif -+if ose - -type SYS_READ_BUF TEMPORARY SYSTEM sys_read_buf -type FD_TAB LONG_LIVED SYSTEM fd_tab -type FD_ENTRY_BUF STANDARD SYSTEM fd_entry_buf -type FD_SIG_LIST SHORT_LIVED SYSTEM fd_sig_list -type DRV_EV STANDARD SYSTEM driver_event -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 - -+endif - - +if win32 type DRV_DATA_BUF SYSTEM SYSTEM drv_data_buf diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index d9eaa7b32c..2995f2f822 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2013. All Rights Reserved. + * Copyright Ericsson AB 2002-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -52,6 +52,7 @@ #ifdef ERTS_ENABLE_LOCK_COUNT #include "erl_lock_count.h" #endif +#include "lttng-wrapper.h" #if defined(ERTS_ALLOC_UTIL_HARD_DEBUG) && defined(__GNUC__) #warning "* * * * * * * * * *" @@ -751,12 +752,77 @@ internal_free(void *ptr) #endif +#ifdef ARCH_32 + +/* + * Bit vector for the entire 32-bit virtual address space + * with one bit for each super aligned memory segment. + */ + +#define VSPACE_MAP_BITS (1 << (32 - ERTS_MMAP_SUPERALIGNED_BITS)) +#define VSPACE_MAP_SZ (VSPACE_MAP_BITS / ERTS_VSPACE_WORD_BITS) + +static ERTS_INLINE void set_bit(UWord* map, Uint ix) +{ + ASSERT(ix / ERTS_VSPACE_WORD_BITS < VSPACE_MAP_SZ); + map[ix / ERTS_VSPACE_WORD_BITS] + |= ((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS)); +} + +static ERTS_INLINE void clr_bit(UWord* map, Uint ix) +{ + ASSERT(ix / ERTS_VSPACE_WORD_BITS < VSPACE_MAP_SZ); + map[ix / ERTS_VSPACE_WORD_BITS] + &= ~((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS)); +} + +static ERTS_INLINE int is_bit_set(UWord* map, Uint ix) +{ + ASSERT(ix / ERTS_VSPACE_WORD_BITS < VSPACE_MAP_SZ); + return map[ix / ERTS_VSPACE_WORD_BITS] + & ((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS)); +} + +UWord erts_literal_vspace_map[VSPACE_MAP_SZ]; + +static void set_literal_range(void* start, Uint size) +{ + Uint ix = (UWord)start >> ERTS_MMAP_SUPERALIGNED_BITS; + Uint n = size >> ERTS_MMAP_SUPERALIGNED_BITS; + + ASSERT(!((UWord)start & ERTS_INV_SUPERALIGNED_MASK)); + ASSERT(!((UWord)size & ERTS_INV_SUPERALIGNED_MASK)); + ASSERT(n); + while (n--) { + ASSERT(!is_bit_set(erts_literal_vspace_map, ix)); + set_bit(erts_literal_vspace_map, ix); + ix++; + } +} + +static void clear_literal_range(void* start, Uint size) +{ + Uint ix = (UWord)start >> ERTS_MMAP_SUPERALIGNED_BITS; + Uint n = size >> ERTS_MMAP_SUPERALIGNED_BITS; + + ASSERT(!((UWord)start & ERTS_INV_SUPERALIGNED_MASK)); + ASSERT(!((UWord)size & ERTS_INV_SUPERALIGNED_MASK)); + ASSERT(n); + while (n--) { + ASSERT(is_bit_set(erts_literal_vspace_map, ix)); + clr_bit(erts_literal_vspace_map, ix); + ix++; + } +} + +#endif /* ARCH_32 */ + /* mseg ... */ #if HAVE_ERTS_MSEG -static ERTS_INLINE void * -alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags) +void* +erts_alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags) { void *res; UWord size = (UWord) *size_p; @@ -766,8 +832,9 @@ alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags) return res; } -static ERTS_INLINE void * -alcu_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p) +void* +erts_alcu_mseg_realloc(Allctr_t *allctr, void *seg, + Uint old_size, Uint *new_size_p) { void *res; UWord new_size = (UWord) *new_size_p; @@ -778,19 +845,116 @@ alcu_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p) return res; } -static ERTS_INLINE void -alcu_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, Uint flags) +void +erts_alcu_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, Uint flags) { erts_mseg_dealloc_opt(allctr->alloc_no, seg, (UWord) size, flags, &allctr->mseg_opt); INC_CC(allctr->calls.mseg_dealloc); } -#endif -static ERTS_INLINE void * -alcu_sys_alloc(Allctr_t *allctr, Uint size, int superalign) +#if defined(ARCH_32) + +void* +erts_alcu_literal_32_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags) +{ + void* res; + Uint sz = ERTS_SUPERALIGNED_CEILING(*size_p); + ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL && + allctr->t == 0); + ERTS_SMP_LC_ASSERT(allctr->thread_safe); + + res = erts_alcu_mseg_alloc(allctr, &sz, flags); + if (res) { + set_literal_range(res, sz); + *size_p = sz; + } + return res; +} + +void* +erts_alcu_literal_32_mseg_realloc(Allctr_t *allctr, void *seg, + Uint old_size, Uint *new_size_p) +{ + void* res; + Uint new_sz = ERTS_SUPERALIGNED_CEILING(*new_size_p); + ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL && + allctr->t == 0); + ERTS_SMP_LC_ASSERT(allctr->thread_safe); + + if (seg && old_size) + clear_literal_range(seg, old_size); + res = erts_alcu_mseg_realloc(allctr, seg, old_size, &new_sz); + if (res) { + set_literal_range(res, new_sz); + *new_size_p = new_sz; + } + return res; +} + +void +erts_alcu_literal_32_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, + Uint flags) +{ + ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL && + allctr->t == 0); + ERTS_SMP_LC_ASSERT(allctr->thread_safe); + + erts_alcu_mseg_dealloc(allctr, seg, size, flags); + + clear_literal_range(seg, size); +} + +#elif defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION) + +/* Used by literal allocator that has its own mmapper (super carrier) */ +void* +erts_alcu_mmapper_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags) +{ + void* res; + UWord size = (UWord) *size_p; + Uint32 mmap_flags = ERTS_MMAPFLG_SUPERCARRIER_ONLY; + if (flags & ERTS_MSEG_FLG_2POW) + mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED; + + res = erts_mmap(allctr->mseg_mmapper, mmap_flags, &size); + *size_p = (Uint)size; + INC_CC(allctr->calls.mseg_alloc); + return res; +} + +void* +erts_alcu_mmapper_mseg_realloc(Allctr_t *allctr, void *seg, + Uint old_size, Uint *new_size_p) +{ + void *res; + UWord new_size = (UWord) *new_size_p; + res = erts_mremap(allctr->mseg_mmapper, ERTS_MSEG_FLG_NONE, seg, old_size, &new_size); + *new_size_p = (Uint) new_size; + INC_CC(allctr->calls.mseg_realloc); + return res; +} + +void +erts_alcu_mmapper_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, + Uint flags) +{ + Uint32 mmap_flags = ERTS_MMAPFLG_SUPERCARRIER_ONLY; + if (flags & ERTS_MSEG_FLG_2POW) + mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED; + + erts_munmap(allctr->mseg_mmapper, mmap_flags, seg, (UWord)size); + INC_CC(allctr->calls.mseg_dealloc); +} +#endif /* ARCH_64 && ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION */ + +#endif /* HAVE_ERTS_MSEG */ + +void* +erts_alcu_sys_alloc(Allctr_t *allctr, Uint* size_p, int superalign) { void *res; + const Uint size = *size_p; #if ERTS_SA_MB_CARRIERS && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC if (superalign) res = erts_sys_aligned_alloc(ERTS_SACRR_UNIT_SZ, size); @@ -803,10 +967,11 @@ alcu_sys_alloc(Allctr_t *allctr, Uint size, int superalign) return res; } -static ERTS_INLINE void * -alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign) +void* +erts_alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint *size_p, Uint old_size, int superalign) { void *res; + const Uint size = *size_p; #if ERTS_SA_MB_CARRIERS && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC if (superalign) @@ -824,8 +989,8 @@ alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int supe return res; } -static ERTS_INLINE void -alcu_sys_free(Allctr_t *allctr, void *ptr, int superalign) +void +erts_alcu_sys_dealloc(Allctr_t *allctr, void *ptr, Uint size, int superalign) { #if ERTS_SA_MB_CARRIERS && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC if (superalign) @@ -838,6 +1003,59 @@ alcu_sys_free(Allctr_t *allctr, void *ptr, int superalign) erts_mtrace_crr_free(allctr->alloc_no, ERTS_ALC_A_SYSTEM, ptr); } +#ifdef ARCH_32 + +void* +erts_alcu_literal_32_sys_alloc(Allctr_t *allctr, Uint* size_p, int superalign) +{ + void* res; + Uint size = ERTS_SUPERALIGNED_CEILING(*size_p); + ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL && + allctr->t == 0); + ERTS_SMP_LC_ASSERT(allctr->thread_safe); + + res = erts_alcu_sys_alloc(allctr, &size, 1); + if (res) { + set_literal_range(res, size); + *size_p = size; + } + return res; +} + +void* +erts_alcu_literal_32_sys_realloc(Allctr_t *allctr, void *ptr, Uint* size_p, Uint old_size, int superalign) +{ + void* res; + Uint size = ERTS_SUPERALIGNED_CEILING(*size_p); + + ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL && + allctr->t == 0); + ERTS_SMP_LC_ASSERT(allctr->thread_safe); + + if (ptr && old_size) + clear_literal_range(ptr, old_size); + res = erts_alcu_sys_realloc(allctr, ptr, &size, old_size, 1); + if (res) { + set_literal_range(res, size); + *size_p = size; + } + return res; +} + +void +erts_alcu_literal_32_sys_dealloc(Allctr_t *allctr, void *ptr, Uint size, int superalign) +{ + ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL && + allctr->t == 0); + ERTS_SMP_LC_ASSERT(allctr->thread_safe); + + erts_alcu_sys_dealloc(allctr, ptr, size, 1); + + clear_literal_range(ptr, size); +} + +#endif /* ARCH_32 */ + static Uint get_next_mbc_size(Allctr_t *allctr) { @@ -2084,7 +2302,7 @@ mbc_alloc_block(Allctr_t *allctr, Uint size, Uint *blk_szp) if (!blk) { blk = create_carrier(allctr, get_blk_sz, CFLG_MBC); -#if !HALFWORD_HEAP && !ERTS_SUPER_ALIGNED_MSEG_ONLY +#if !ERTS_SUPER_ALIGNED_MSEG_ONLY if (!blk) { /* Emergency! We couldn't create the carrier as we wanted. Try to place it in a sys_alloced sbc. */ @@ -2930,6 +3148,7 @@ cpool_insert(Allctr_t *allctr, Carrier_t *crr) erts_smp_atomic_set_wb(&crr->allctr, ((erts_aint_t) allctr)|ERTS_CRR_ALCTR_FLG_IN_POOL); + LTTNG3(carrier_pool_put, ERTS_ALC_A2AD(allctr->alloc_no), allctr->ix, CARRIER_SZ(crr)); } static void @@ -3045,6 +3264,7 @@ cpool_fetch(Allctr_t *allctr, UWord size) first_old_traitor = allctr->cpool.traitor_list.next; cpool_entrance = NULL; + LTTNG3(carrier_pool_get, ERTS_ALC_A2AD(allctr->alloc_no), allctr->ix, (unsigned long)size); /* * Search my own pooled_list, * i.e my abandoned carriers that were in the pool last time I checked. @@ -3531,8 +3751,7 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) int is_mseg = 0; #endif - if (HALFWORD_HEAP - || (ERTS_SUPER_ALIGNED_MSEG_ONLY && (flags & CFLG_MBC)) + if ((ERTS_SUPER_ALIGNED_MSEG_ONLY && (flags & CFLG_MBC)) || !allow_sys_alloc_carriers) { flags |= CFLG_FORCE_MSEG; flags &= ~CFLG_FORCE_SYS_ALLOC; @@ -3540,6 +3759,8 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) return NULL; #endif } + flags |= allctr->crr_set_flgs; + flags &= ~allctr->crr_clr_flgs; ASSERT((flags & CFLG_SBC && !(flags & CFLG_MBC)) || (flags & CFLG_MBC && !(flags & CFLG_SBC))); @@ -3555,7 +3776,21 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) return NULL; } - blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz); + if (flags & CFLG_MAIN_CARRIER) { + ASSERT(flags & CFLG_MBC); + ASSERT(flags & CFLG_NO_CPOOL); + ASSERT(umem_sz == allctr->main_carrier_size); + ERTS_UNDEF(blk_sz, 0); + + if (allctr->main_carrier_size < allctr->min_mbc_size) + allctr->main_carrier_size = allctr->min_mbc_size; + crr_sz = bcrr_sz = allctr->main_carrier_size; + } + else { + ERTS_UNDEF(bcrr_sz, 0); + ERTS_UNDEF(crr_sz, 0); + blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz); + } #ifdef ERTS_SMP allctr->cpool.disable_abandon = ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON; @@ -3601,13 +3836,15 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) mseg_flags = ERTS_MSEG_FLG_NONE; } else { - crr_sz = (*allctr->get_next_mbc_size)(allctr); - if (crr_sz < MBC_HEADER_SIZE(allctr) + blk_sz) - crr_sz = MBC_HEADER_SIZE(allctr) + blk_sz; - mseg_flags = ERTS_MSEG_FLG_2POW; + if (!(flags & CFLG_MAIN_CARRIER)) { + crr_sz = (*allctr->get_next_mbc_size)(allctr); + if (crr_sz < MBC_HEADER_SIZE(allctr) + blk_sz) + crr_sz = MBC_HEADER_SIZE(allctr) + blk_sz; + } + mseg_flags = ERTS_MSEG_FLG_2POW; } - crr = (Carrier_t *) alcu_mseg_alloc(allctr, &crr_sz, mseg_flags); + crr = (Carrier_t *) allctr->mseg_alloc(allctr, &crr_sz, mseg_flags); if (!crr) { have_tried_mseg = 1; if (!(have_tried_sys_alloc || flags & CFLG_FORCE_MSEG)) @@ -3639,23 +3876,22 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) if (flags & CFLG_SBC) { bcrr_sz = blk_sz + SBC_HEADER_SIZE; } - else { + else if (!(flags & CFLG_MAIN_CARRIER)) { bcrr_sz = MBC_HEADER_SIZE(allctr) + blk_sz; - if (!(flags & CFLG_MAIN_CARRIER) - && bcrr_sz < allctr->smallest_mbc_size) - bcrr_sz = allctr->smallest_mbc_size; + if (bcrr_sz < allctr->smallest_mbc_size) + bcrr_sz = allctr->smallest_mbc_size; } crr_sz = (flags & CFLG_FORCE_SIZE ? UNIT_CEILING(bcrr_sz) : SYS_ALLOC_CARRIER_CEILING(bcrr_sz)); - crr = (Carrier_t *) alcu_sys_alloc(allctr, crr_sz, flags & CFLG_MBC); + crr = (Carrier_t *) allctr->sys_alloc(allctr, &crr_sz, flags & CFLG_MBC); if (!crr) { if (crr_sz > UNIT_CEILING(bcrr_sz)) { crr_sz = UNIT_CEILING(bcrr_sz); - crr = (Carrier_t *) alcu_sys_alloc(allctr, crr_sz, flags & CFLG_MBC); + crr = (Carrier_t *) allctr->sys_alloc(allctr, &crr_sz, flags & CFLG_MBC); } if (!crr) { #if HAVE_ERTS_MSEG @@ -3714,6 +3950,21 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) } +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(carrier_create)) { + lttng_decl_carrier_stats(mbc_stats); + lttng_decl_carrier_stats(sbc_stats); + LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->mbcs), mbc_stats); + LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->sbcs), sbc_stats); + LTTNG5(carrier_create, + ERTS_ALC_A2AD(allctr->alloc_no), + allctr->ix, + crr_sz, + mbc_stats, + sbc_stats); + } +#endif + DEBUG_SAVE_ALIGNMENT(crr); return blk; } @@ -3754,7 +4005,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) new_crr_sz = new_blk_sz + SBC_HEADER_SIZE; new_crr_sz = ERTS_SACRR_UNIT_CEILING(new_crr_sz); - new_crr = (Carrier_t *) alcu_mseg_realloc(allctr, + new_crr = (Carrier_t *) allctr->mseg_realloc(allctr, old_crr, old_crr_sz, &new_crr_sz); @@ -3769,11 +4020,6 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) DEBUG_SAVE_ALIGNMENT(new_crr); return new_blk; } -#if HALFWORD_HEAP - /* Old carrier unchanged; restore stat */ - STAT_MSEG_SBC_ALLOC(allctr, old_crr_sz, old_blk_sz); - return NULL; -#endif create_flags |= CFLG_FORCE_SYS_ALLOC; /* since mseg_realloc() failed */ } @@ -3784,7 +4030,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) (void *) BLK2UMEM(old_blk), MIN(new_blk_sz, old_blk_sz) - ABLK_HDR_SZ); unlink_carrier(&allctr->sbc_list, old_crr); - alcu_mseg_dealloc(allctr, old_crr, old_crr_sz, ERTS_MSEG_FLG_NONE); + allctr->mseg_dealloc(allctr, old_crr, old_crr_sz, ERTS_MSEG_FLG_NONE); } else { /* Old carrier unchanged; restore stat */ @@ -3801,9 +4047,9 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) ? UNIT_CEILING(new_bcrr_sz) : SYS_ALLOC_CARRIER_CEILING(new_bcrr_sz)); - new_crr = (Carrier_t *) alcu_sys_realloc(allctr, + new_crr = (Carrier_t *) allctr->sys_realloc(allctr, (void *) old_crr, - new_crr_sz, + &new_crr_sz, old_crr_sz, 0); if (new_crr) { @@ -3822,9 +4068,9 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) else if (new_crr_sz > UNIT_CEILING(new_bcrr_sz)) { new_crr_sz = new_blk_sz + SBC_HEADER_SIZE; new_crr_sz = UNIT_CEILING(new_crr_sz); - new_crr = (Carrier_t *) alcu_sys_realloc(allctr, + new_crr = (Carrier_t *) allctr->sys_realloc(allctr, (void *) old_crr, - new_crr_sz, + &new_crr_sz, old_crr_sz, 0); if (new_crr) @@ -3845,7 +4091,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) (void *) BLK2UMEM(old_blk), MIN(new_blk_sz, old_blk_sz) - ABLK_HDR_SZ); unlink_carrier(&allctr->sbc_list, old_crr); - alcu_sys_free(allctr, old_crr, 0); + allctr->sys_dealloc(allctr, old_crr, CARRIER_SZ(old_crr), 0); } else { /* Old carrier unchanged; restore... */ @@ -3861,13 +4107,13 @@ dealloc_carrier(Allctr_t *allctr, Carrier_t *crr, int superaligned) { #if HAVE_ERTS_MSEG if (IS_MSEG_CARRIER(crr)) - alcu_mseg_dealloc(allctr, crr, CARRIER_SZ(crr), + allctr->mseg_dealloc(allctr, crr, CARRIER_SZ(crr), (superaligned ? ERTS_MSEG_FLG_2POW : ERTS_MSEG_FLG_NONE)); else #endif - alcu_sys_free(allctr, crr, superaligned); + allctr->sys_dealloc(allctr, crr, CARRIER_SZ(crr), superaligned); } static void @@ -3942,6 +4188,21 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk, Carrier_t **busy_pcrr_pp) allctr->remove_mbc(allctr, crr); } +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(carrier_destroy)) { + lttng_decl_carrier_stats(mbc_stats); + lttng_decl_carrier_stats(sbc_stats); + LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->mbcs), mbc_stats); + LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->sbcs), sbc_stats); + LTTNG5(carrier_destroy, + ERTS_ALC_A2AD(allctr->alloc_no), + allctr->ix, + crr_sz, + mbc_stats, + sbc_stats); + } +#endif + #ifdef ERTS_SMP schedule_dealloc_carrier(allctr, crr); #else @@ -3962,9 +4223,6 @@ static struct { Eterm e; Eterm t; Eterm ramv; -#if HALFWORD_HEAP - Eterm low; -#endif Eterm sbct; #if HAVE_ERTS_MSEG Eterm asbcst; @@ -4055,9 +4313,6 @@ init_atoms(Allctr_t *allctr) AM_INIT(e); AM_INIT(t); AM_INIT(ramv); -#if HALFWORD_HEAP - AM_INIT(low); -#endif AM_INIT(sbct); #if HAVE_ERTS_MSEG AM_INIT(asbcst); @@ -4663,9 +4918,6 @@ info_options(Allctr_t *allctr, "option e: true\n" "option t: %s\n" "option ramv: %s\n" -#if HALFWORD_HEAP - "option low: %s\n" -#endif "option sbct: %beu\n" #if HAVE_ERTS_MSEG "option asbcst: %bpu\n" @@ -4684,9 +4936,6 @@ info_options(Allctr_t *allctr, "option acul: %d\n", topt, allctr->ramv ? "true" : "false", -#if HALFWORD_HEAP - allctr->mseg_opt.low_mem ? "true" : "false", -#endif allctr->sbc_threshold, #if HAVE_ERTS_MSEG allctr->mseg_opt.abs_shrink_th, @@ -4749,9 +4998,6 @@ info_options(Allctr_t *allctr, add_2tup(hpp, szp, &res, am.sbct, bld_uint(hpp, szp, allctr->sbc_threshold)); -#if HALFWORD_HEAP - add_2tup(hpp, szp, &res, am.low, allctr->mseg_opt.low_mem ? am_true : am_false); -#endif add_2tup(hpp, szp, &res, am.ramv, allctr->ramv ? am_true : am_false); add_2tup(hpp, szp, &res, am.t, (allctr->t ? am_true : am_false)); add_2tup(hpp, szp, &res, am.e, am_true); @@ -5146,6 +5392,11 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) void *erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) { void *res; +#ifdef ERTS_SMP + ASSERT(!"This is not thread safe"); +#elif defined(USE_THREADS) + ASSERT(erts_equal_tids(erts_main_thread, erts_thr_self())); +#endif res = do_erts_alcu_alloc(type, extra, size); DEBUG_CHECK_ALIGNMENT(res); return res; @@ -5436,11 +5687,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type, Block_t *new_blk; if(IS_SBC_BLK(blk)) { do_carrier_resize: -#if HALFWORD_HEAP - new_blk = resize_carrier(allctr, blk, size, CFLG_SBC | CFLG_FORCE_MSEG); -#else new_blk = resize_carrier(allctr, blk, size, CFLG_SBC); -#endif res = new_blk ? BLK2UMEM(new_blk) : NULL; } else if (alcu_flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) @@ -5734,11 +5981,8 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) #ifdef ERTS_SMP if (init->tspec || init->tpref) allctr->mseg_opt.sched_spec = 1; -#endif -# if HALFWORD_HEAP - allctr->mseg_opt.low_mem = init->low_mem; -# endif -#endif +#endif /* ERTS_SMP */ +#endif /* HAVE_ERTS_MSEG */ allctr->name_prefix = init->name_prefix; if (!allctr->name_prefix) @@ -5887,17 +6131,53 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) + ABLK_HDR_SZ) - ABLK_HDR_SZ); + if (init->sys_alloc) { + ASSERT(init->sys_realloc && init->sys_dealloc); + allctr->sys_alloc = init->sys_alloc; + allctr->sys_realloc = init->sys_realloc; + allctr->sys_dealloc = init->sys_dealloc; + } + else { + ASSERT(!init->sys_realloc && !init->sys_dealloc); + allctr->sys_alloc = &erts_alcu_sys_alloc; + allctr->sys_realloc = &erts_alcu_sys_realloc; + allctr->sys_dealloc = &erts_alcu_sys_dealloc; + } +#if HAVE_ERTS_MSEG + if (init->mseg_alloc) { + ASSERT(init->mseg_realloc && init->mseg_dealloc); + allctr->mseg_alloc = init->mseg_alloc; + allctr->mseg_realloc = init->mseg_realloc; + allctr->mseg_dealloc = init->mseg_dealloc; + allctr->mseg_mmapper = init->mseg_mmapper; + } + else { + ASSERT(!init->mseg_realloc && !init->mseg_dealloc); + allctr->mseg_alloc = &erts_alcu_mseg_alloc; + allctr->mseg_realloc = &erts_alcu_mseg_realloc; + allctr->mseg_dealloc = &erts_alcu_mseg_dealloc; + } + /* If a custom carrier alloc function is specified, make sure it's used */ + if (init->mseg_alloc && !init->sys_alloc) { + allctr->crr_set_flgs = CFLG_FORCE_MSEG; + allctr->crr_clr_flgs = CFLG_FORCE_SYS_ALLOC; + } + else if (!init->mseg_alloc && init->sys_alloc) { + allctr->crr_set_flgs = CFLG_FORCE_SYS_ALLOC; + allctr->crr_clr_flgs = CFLG_FORCE_MSEG; + } +#endif + if (allctr->main_carrier_size) { Block_t *blk; blk = create_carrier(allctr, allctr->main_carrier_size, - CFLG_MBC + (ERTS_SUPER_ALIGNED_MSEG_ONLY + ? CFLG_FORCE_MSEG : CFLG_FORCE_SYS_ALLOC) + | CFLG_MBC | CFLG_FORCE_SIZE | CFLG_NO_CPOOL -#if !HALFWORD_HEAP && !ERTS_SUPER_ALIGNED_MSEG_ONLY - | CFLG_FORCE_SYS_ALLOC -#endif | CFLG_MAIN_CARRIER); if (!blk) { #ifdef USE_THREADS diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index f4a2ae7ff3..f50f09907a 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2013. All Rights Reserved. + * Copyright Ericsson AB 2002-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -24,6 +24,13 @@ #define ERTS_ALCU_VSN_STR "3.0" #include "erl_alloc_types.h" +#ifdef USE_THREADS +#define ERL_THREADS_EMU_INTERNAL__ +#include "erl_threads.h" +#endif + +#include "erl_mseg.h" +#include "lttng-wrapper.h" #define ERTS_AU_PREF_ALLOC_BITS 11 #define ERTS_AU_MAX_PREF_ALLOC_INSTANCES (1 << ERTS_AU_PREF_ALLOC_BITS) @@ -45,7 +52,6 @@ typedef struct { int tspec; int tpref; int ramv; - int low_mem; /* HALFWORD only */ UWord sbct; UWord asbcst; UWord rsbcst; @@ -61,6 +67,16 @@ typedef struct { void *fix; size_t *fix_type_size; + +#if HAVE_ERTS_MSEG + void* (*mseg_alloc)(Allctr_t*, Uint *size_p, Uint flags); + void* (*mseg_realloc)(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p); + void (*mseg_dealloc)(Allctr_t*, void *seg, Uint size, Uint flags); + ErtsMemMapper *mseg_mmapper; +#endif + void* (*sys_alloc)(Allctr_t *allctr, Uint *size_p, int superalign); + void* (*sys_realloc)(Allctr_t *allctr, void *ptr, Uint *size_p, Uint old_size, int superalign); + void (*sys_dealloc)(Allctr_t *allctr, void *ptr, Uint size, int superalign); } AllctrInit_t; typedef struct { @@ -90,7 +106,6 @@ typedef struct { 0, /* (bool) tspec: thread specific */\ 0, /* (bool) tpref: thread preferred */\ 0, /* (bool) ramv: realloc always moves */\ - 0, /* (bool) low_mem: HALFWORD only */\ 512*1024, /* (bytes) sbct: sbc threshold */\ 2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\ 20, /* (%) rsbcst: rel sbc shrink threshold */\ @@ -125,7 +140,6 @@ typedef struct { 0, /* (bool) tspec: thread specific */\ 0, /* (bool) tpref: thread preferred */\ 0, /* (bool) ramv: realloc always moves */\ - 0, /* (bool) low_mem: HALFWORD only */\ 64*1024, /* (bytes) sbct: sbc threshold */\ 2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\ 20, /* (%) rsbcst: rel sbc shrink threshold */\ @@ -176,20 +190,44 @@ void erts_alcu_check_delayed_dealloc(Allctr_t *, int, int *, ErtsThrPrgrVal * #endif erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t); +#ifdef ARCH_32 +extern UWord erts_literal_vspace_map[]; +# define ERTS_VSPACE_WORD_BITS (sizeof(UWord)*8) +#endif + +void* erts_alcu_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags); +void* erts_alcu_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p); +void erts_alcu_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags); + +#if HAVE_ERTS_MSEG +# if defined(ARCH_32) +void* erts_alcu_literal_32_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags); +void* erts_alcu_literal_32_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p); +void erts_alcu_literal_32_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags); + +# elif defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION) +void* erts_alcu_mmapper_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags); +void* erts_alcu_mmapper_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p); +void erts_alcu_mmapper_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags); +# endif +#endif /* HAVE_ERTS_MSEG */ + +void* erts_alcu_sys_alloc(Allctr_t*, Uint *size_p, int superalign); +void* erts_alcu_sys_realloc(Allctr_t*, void *ptr, Uint *size_p, Uint old_size, int superalign); +void erts_alcu_sys_dealloc(Allctr_t*, void *ptr, Uint size, int superalign); +#ifdef ARCH_32 +void* erts_alcu_literal_32_sys_alloc(Allctr_t*, Uint *size_p, int superalign); +void* erts_alcu_literal_32_sys_realloc(Allctr_t*, void *ptr, Uint *size_p, Uint old_size, int superalign); +void erts_alcu_literal_32_sys_dealloc(Allctr_t*, void *ptr, Uint size, int superalign); #endif +#endif /* !ERL_ALLOC_UTIL__ */ + #if defined(GET_ERL_ALLOC_UTIL_IMPL) && !defined(ERL_ALLOC_UTIL_IMPL__) #define ERL_ALLOC_UTIL_IMPL__ #define ERTS_ALCU_FLG_FAIL_REALLOC_MOVE (((Uint32) 1) << 0) -#ifdef USE_THREADS -#define ERL_THREADS_EMU_INTERNAL__ -#include "erl_threads.h" -#endif - -#include "erl_mseg.h" - #undef ERTS_ALLOC_UTIL_HARD_DEBUG #ifdef DEBUG # if 0 @@ -223,7 +261,7 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t); #if ERTS_HAVE_MSEG_SUPER_ALIGNED \ || (!HAVE_ERTS_MSEG && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC) -# ifndef MSEG_ALIGN_BITS +# ifdef MSEG_ALIGN_BITS # define ERTS_SUPER_ALIGN_BITS MSEG_ALIGN_BITS # else # define ERTS_SUPER_ALIGN_BITS 18 @@ -381,6 +419,18 @@ typedef struct { } blocks; } CarriersStats_t; +#ifdef USE_LTTNG_VM_TRACEPOINTS +#define LTTNG_CARRIER_STATS_TO_LTTNG_STATS(CSP, LSP) \ + do { \ + (LSP)->carriers.size = (CSP)->curr.norm.mseg.size \ + + (CSP)->curr.norm.sys_alloc.size; \ + (LSP)->carriers.no = (CSP)->curr.norm.mseg.no \ + + (CSP)->curr.norm.sys_alloc.no; \ + (LSP)->blocks.size = (CSP)->blocks.curr.size; \ + (LSP)->blocks.no = (CSP)->blocks.curr.no; \ + } while (0) +#endif + #ifdef ERTS_SMP typedef union ErtsAllctrDDBlock_t_ ErtsAllctrDDBlock_t; @@ -501,6 +551,8 @@ struct Allctr_t_ { Uint min_mbc_size; Uint min_mbc_first_free_size; Uint min_block_size; + UWord crr_set_flgs; + UWord crr_clr_flgs; /* Carriers */ CarrierList_t mbc_list; @@ -546,6 +598,16 @@ struct Allctr_t_ { void (*remove_mbc) (Allctr_t *, Carrier_t *); UWord (*largest_fblk_in_mbc) (Allctr_t *, Carrier_t *); +#if HAVE_ERTS_MSEG + void* (*mseg_alloc)(Allctr_t*, Uint *size_p, Uint flags); + void* (*mseg_realloc)(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p); + void (*mseg_dealloc)(Allctr_t*, void *seg, Uint size, Uint flags); + ErtsMemMapper *mseg_mmapper; +#endif + void* (*sys_alloc)(Allctr_t *allctr, Uint *size_p, int superalign); + void* (*sys_realloc)(Allctr_t *allctr, void *ptr, Uint *size_p, Uint old_size, int superalign); + void (*sys_dealloc)(Allctr_t *allctr, void *ptr, Uint size, int superalign); + void (*init_atoms) (void); #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c index 5cd067ff54..fbe4724047 100644 --- a/erts/emulator/beam/erl_ao_firstfit_alloc.c +++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2013. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.h b/erts/emulator/beam/erl_ao_firstfit_alloc.h index 4200f20622..7349c6ab19 100644 --- a/erts/emulator/beam/erl_ao_firstfit_alloc.h +++ b/erts/emulator/beam/erl_ao_firstfit_alloc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2013. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c index b8c5ef9b09..861532f241 100644 --- a/erts/emulator/beam/erl_arith.c +++ b/erts/emulator/beam/erl_arith.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2010. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -42,15 +42,8 @@ # define MAX(x, y) (((x) > (y)) ? (x) : (y)) #endif -#if !HEAP_ON_C_STACK -# define DECLARE_TMP(VariableName,N,P) \ - Eterm *VariableName = ((ERTS_PROC_GET_SCHDATA(P)->erl_arith_tmp_heap) + (2 * N)) -#else -# define DECLARE_TMP(VariableName,N,P) \ - Eterm VariableName[2] -#endif -# define ARG_IS_NOT_TMP(Arg,Tmp) ((Arg) != make_big((Tmp))) - +#define DECLARE_TMP(VariableName,N,P) Eterm VariableName[2] +#define ARG_IS_NOT_TMP(Arg,Tmp) ((Arg) != make_big((Tmp))) static Eterm shift(Process* p, Eterm arg1, Eterm arg2, int right); diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index f071898046..84254af0c2 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2013. All Rights Reserved. + * Copyright Ericsson AB 2000-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -28,6 +28,7 @@ #include "erl_thr_queue.h" #include "erl_async.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #define ERTS_MAX_ASYNC_READY_CALLS_IN_SEQ 20 @@ -167,7 +168,6 @@ async_ready_q(Uint sched_id) #endif - void erts_init_async(void) { @@ -282,6 +282,13 @@ static ERTS_INLINE void async_add(ErtsAsync *a, ErtsAsyncQ* q) #endif erts_thr_q_enqueue(&q->thr_q, a); +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(aio_pool_put)) { + lttng_decl_portbuf(port_str); + lttng_portid_to_str(a->port, port_str); + LTTNG2(aio_pool_put, port_str, -1); + } +#endif #ifdef USE_VM_PROBES if (DTRACE_ENABLED(aio_pool_add)) { DTRACE_CHARBUF(port_str, 16); @@ -318,6 +325,14 @@ static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q, if (saved_fin_deq) erts_thr_q_append_finalize_dequeue_data(&a->q.fin_deq, &fin_deq); #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(aio_pool_get)) { + lttng_decl_portbuf(port_str); + int length = erts_thr_q_length_dirty(q); + lttng_portid_to_str(a->port, port_str); + LTTNG2(aio_pool_get, port_str, length); + } +#endif #ifdef USE_VM_PROBES if (DTRACE_ENABLED(aio_pool_get)) { DTRACE_CHARBUF(port_str, 16); @@ -401,13 +416,19 @@ static ERTS_INLINE void call_async_ready(ErtsAsync *a) ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); #endif if (!p) { - if (a->async_free) + if (a->async_free) { + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_PORT); a->async_free(a->async_data); + ERTS_MSACC_POP_STATE(); + } } else { if (async_ready(p, a->async_data)) { - if (a->async_free) + if (a->async_free) { + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_PORT); a->async_free(a->async_data); + ERTS_MSACC_POP_STATE(); + } } #if ERTS_USE_ASYNC_READY_Q erts_port_release(p); @@ -461,6 +482,8 @@ static erts_tse_t *async_thread_init(ErtsAsyncQ *aq) { ErtsThrQInit_t qinit = ERTS_THR_Q_INIT_DEFAULT; erts_tse_t *tse = erts_tse_fetch(); + ERTS_DECLARE_DUMMY(Uint no); + #ifdef ERTS_SMP ErtsThrPrgrCallbacks callbacks; @@ -484,10 +507,12 @@ static erts_tse_t *async_thread_init(ErtsAsyncQ *aq) /* Inform main thread that we are done initializing... */ erts_mtx_lock(&async->init.data.mtx); - async->init.data.no_initialized++; + no = async->init.data.no_initialized++; erts_cnd_signal(&async->init.data.cnd); erts_mtx_unlock(&async->init.data.mtx); + erts_msacc_init_thread("async", no, 0); + return tse; } @@ -495,6 +520,7 @@ static void *async_main(void* arg) { ErtsAsyncQ *aq = (ErtsAsyncQ *) arg; erts_tse_t *tse = async_thread_init(aq); + ERTS_MSACC_DECLARE_CACHE(); while (1) { ErtsThrQPrepEnQ_t *prep_enq; @@ -502,11 +528,14 @@ static void *async_main(void* arg) if (is_nil(a->port)) break; /* Time to die */ + ERTS_MSACC_UPDATE_CACHE(); + #if ERTS_ASYNC_PRINT_JOB erts_fprintf(stderr, "<- %ld\n", a->async_id); #endif - + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT); a->async_invoke(a->async_data); + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER); async_reply(a, prep_enq); } @@ -629,10 +658,13 @@ long driver_async(ErlDrvPort ix, unsigned int* key, unsigned int qix; #if ERTS_USE_ASYNC_READY_Q Uint sched_id; + ERTS_MSACC_PUSH_STATE(); sched_id = erts_get_scheduler_id(); if (!sched_id) sched_id = 1; +#else + ERTS_MSACC_PUSH_STATE(); #endif prt = erts_drvport2port(ix); @@ -685,12 +717,17 @@ long driver_async(ErlDrvPort ix, unsigned int* key, return id; } #endif - + + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT); (*a->async_invoke)(a->async_data); + ERTS_MSACC_POP_STATE(); if (async_ready(prt, a->async_data)) { - if (a->async_free != NULL) + if (a->async_free != NULL) { + ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT); (*a->async_free)(a->async_data); + ERTS_MSACC_POP_STATE(); + } } erts_free(ERTS_ALC_T_ASYNC, (void *) a); diff --git a/erts/emulator/beam/erl_async.h b/erts/emulator/beam/erl_async.h index 65538bcef0..473c7686e5 100644 --- a/erts/emulator/beam/erl_async.h +++ b/erts/emulator/beam/erl_async.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c index f39a18ac88..379cee39a1 100644 --- a/erts/emulator/beam/erl_bestfit_alloc.c +++ b/erts/emulator/beam/erl_bestfit_alloc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2013. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_bestfit_alloc.h b/erts/emulator/beam/erl_bestfit_alloc.h index b315518b88..3a5f51f5dc 100644 --- a/erts/emulator/beam/erl_bestfit_alloc.h +++ b/erts/emulator/beam/erl_bestfit_alloc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2013. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index 134aa2d396..6e10980b6b 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2013. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -55,10 +55,8 @@ /* Init and local variables */ -static Export binary_match_trap_export; -static BIF_RETTYPE binary_match_trap(BIF_ALIST_3); -static Export binary_matches_trap_export; -static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3); +static Export binary_find_trap_export; +static BIF_RETTYPE binary_find_trap(BIF_ALIST_3); static Export binary_longest_prefix_trap_export; static BIF_RETTYPE binary_longest_prefix_trap(BIF_ALIST_3); static Export binary_longest_suffix_trap_export; @@ -70,19 +68,15 @@ static BIF_RETTYPE binary_copy_trap(BIF_ALIST_2); static Uint max_loop_limit; static BIF_RETTYPE -binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3); +binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Uint flags); static BIF_RETTYPE -binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3); +binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3); void erts_init_bif_binary(void) { - erts_init_trap_export(&binary_match_trap_export, - am_erlang, am_binary_match_trap, 3, - &binary_match_trap); - - erts_init_trap_export(&binary_matches_trap_export, - am_erlang, am_binary_matches_trap, 3, - &binary_matches_trap); + erts_init_trap_export(&binary_find_trap_export, + am_erlang, am_binary_find_trap, 3, + &binary_find_trap); erts_init_trap_export(&binary_longest_prefix_trap_export, am_erlang, am_binary_longest_prefix_trap, 3, @@ -314,8 +308,8 @@ static BMData *create_bmdata(MyAllocator *my, byte *x, Uint len, /* * Aho Corasick - Build a Trie and fill in the failure functions * when all strings are added. - * The algorithm is nicely described by Dieter B�hler of University of - * T�bingen: + * The algorithm is nicely described by Dieter Bühler of University of + * Tübingen: * http://www-sr.informatik.uni-tuebingen.de/~buehler/AC/AC.html */ @@ -537,21 +531,23 @@ static void ac_init_find_all(ACFindAllState *state, ACTrie *act, Sint startpos, state->out = NULL; } -static void ac_restore_find_all(ACFindAllState *state, char *buff) +static void ac_restore_find_all(ACFindAllState *state, + const ACFindAllState *src) { - memcpy(state,buff,sizeof(ACFindAllState)); + memcpy(state, src, sizeof(ACFindAllState)); if (state->allocated > 0) { state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) * (state->allocated)); - memcpy(state->out,buff+sizeof(ACFindAllState),sizeof(FindallData)*state->m); + memcpy(state->out, src+1, sizeof(FindallData)*state->m); } else { state->out = NULL; } } -static void ac_serialize_find_all(ACFindAllState *state, char *buff) +static void ac_serialize_find_all(const ACFindAllState *state, + ACFindAllState *dst) { - memcpy(buff,state,sizeof(ACFindAllState)); - memcpy(buff+sizeof(ACFindAllState),state->out,sizeof(FindallData)*state->m); + memcpy(dst, state, sizeof(ACFindAllState)); + memcpy(dst+1, state->out, sizeof(FindallData)*state->m); } static void ac_clean_find_all(ACFindAllState *state) @@ -565,9 +561,6 @@ static void ac_clean_find_all(ACFindAllState *state) #endif } -#define SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(S) \ - (sizeof(ACFindAllState)+(sizeof(FindallData)*(S).m)) - /* * Differs to the find_first function in that it stores all matches and the values * arte returned only in the state. @@ -814,24 +807,24 @@ static void bm_init_find_all(BMFindAllState *state, Sint startpos, Uint len) state->out = NULL; } -static void bm_restore_find_all(BMFindAllState *state, char *buff) +static void bm_restore_find_all(BMFindAllState *state, + const BMFindAllState *src) { - memcpy(state,buff,sizeof(BMFindAllState)); + memcpy(state, src, sizeof(BMFindAllState)); if (state->allocated > 0) { state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) * (state->allocated)); - memcpy(state->out,buff+sizeof(BMFindAllState), - sizeof(FindallData)*state->m); + memcpy(state->out, src+1, sizeof(FindallData)*state->m); } else { state->out = NULL; } } -static void bm_serialize_find_all(BMFindAllState *state, char *buff) +static void bm_serialize_find_all(const BMFindAllState *state, + BMFindAllState *dst) { - memcpy(buff,state,sizeof(BMFindAllState)); - memcpy(buff+sizeof(BMFindAllState),state->out, - sizeof(FindallData)*state->m); + memcpy(dst, state, sizeof(BMFindAllState)); + memcpy(dst+1, state->out, sizeof(FindallData)*state->m); } static void bm_clean_find_all(BMFindAllState *state) @@ -845,9 +838,6 @@ static void bm_clean_find_all(BMFindAllState *state) #endif } -#define SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(S) \ - (sizeof(BMFindAllState)+(sizeof(FindallData)*(S).m)) - /* * Differs to the find_first function in that it stores all matches and the * values are returned only in the state. @@ -1030,283 +1020,142 @@ BIF_RETTYPE binary_compile_pattern_1(BIF_ALIST_1) #define DO_BIN_MATCH_BADARG -1 #define DO_BIN_MATCH_RESTART -2 -static int do_binary_match(Process *p, Eterm subject, Uint hsstart, Uint hsend, - Eterm type, Binary *bin, Eterm state_term, - Eterm *res_term) -{ - byte *bytes; - Uint bitoffs, bitsize; - byte *temp_alloc = NULL; - - ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize); - if (bitsize != 0) { - goto badarg; - } - if (bitoffs != 0) { - bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc); - } - if (state_term != NIL) { - Eterm *ptr = big_val(state_term); - type = ptr[1]; - } - - if (type == am_bm) { - BMData *bm; - Sint pos; - Eterm ret; - Eterm *hp; - BMFindFirstState state; - Uint reds = get_reds(p, BM_LOOP_FACTOR); - Uint save_reds = reds; - - bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin); -#ifdef HARDDEBUG - dump_bm_data(bm); -#endif - if (state_term == NIL) { - bm_init_find_first_match(&state, hsstart, hsend); - } else { - Eterm *ptr = big_val(state_term); - memcpy(&state,ptr+2,sizeof(state)); - } -#ifdef HARDDEBUG - erts_printf("(bm) state->pos = %ld, state->len = %lu\n",state.pos, - state.len); -#endif - pos = bm_find_first_match(&state, bm, bytes, &reds); - if (pos == BM_NOT_FOUND) { - ret = am_nomatch; - } else if (pos == BM_RESTART) { - int x = (sizeof(BMFindFirstState) / sizeof(Eterm)) + - !!(sizeof(BMFindFirstState) % sizeof(Eterm)); -#ifdef HARDDEBUG - erts_printf("Trap bm!\n"); -#endif - hp = HAlloc(p,x+2); - hp[0] = make_pos_bignum_header(x+1); - hp[1] = type; - memcpy(hp+2,&state,sizeof(state)); - *res_term = make_big(hp); - erts_free_aligned_binary_bytes(temp_alloc); - return DO_BIN_MATCH_RESTART; - } else { - Eterm erlen = erts_make_integer((Uint) bm->len, p); - ret = erts_make_integer(pos,p); - hp = HAlloc(p,3); - ret = TUPLE2(hp, ret, erlen); - } - erts_free_aligned_binary_bytes(temp_alloc); - BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR); - *res_term = ret; - return DO_BIN_MATCH_OK; - } else if (type == am_ac) { - ACTrie *act; - Uint pos, rlen; - int acr; - ACFindFirstState state; - Eterm ret; - Eterm *hp; - Uint reds = get_reds(p, AC_LOOP_FACTOR); - Uint save_reds = reds; +#define BINARY_FIND_ALL 0x01 +#define BINARY_SPLIT_TRIM 0x02 +#define BINARY_SPLIT_TRIM_ALL 0x04 - act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin); -#ifdef HARDDEBUG - dump_ac_trie(act); -#endif - if (state_term == NIL) { - ac_init_find_first_match(&state, act, hsstart, hsend); - } else { - Eterm *ptr = big_val(state_term); - memcpy(&state,ptr+2,sizeof(state)); - } - acr = ac_find_first_match(&state, bytes, &pos, &rlen, &reds); - if (acr == AC_NOT_FOUND) { - ret = am_nomatch; - } else if (acr == AC_RESTART) { - int x = (sizeof(state) / sizeof(Eterm)) + - !!(sizeof(ACFindFirstState) % sizeof(Eterm)); -#ifdef HARDDEBUG - erts_printf("Trap ac!\n"); -#endif - hp = HAlloc(p,x+2); - hp[0] = make_pos_bignum_header(x+1); - hp[1] = type; - memcpy(hp+2,&state,sizeof(state)); - *res_term = make_big(hp); - erts_free_aligned_binary_bytes(temp_alloc); - return DO_BIN_MATCH_RESTART; - } else { - Eterm epos = erts_make_integer(pos,p); - Eterm erlen = erts_make_integer(rlen,p); - hp = HAlloc(p,3); - ret = TUPLE2(hp, epos, erlen); - } - erts_free_aligned_binary_bytes(temp_alloc); - BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR); - *res_term = ret; - return DO_BIN_MATCH_OK; - } - badarg: - return DO_BIN_MATCH_BADARG; -} +typedef struct BinaryFindState { + Eterm type; + Uint flags; + Uint hsstart; + Uint hsend; + Eterm (*not_found_result) (Process *, Eterm, struct BinaryFindState *); + Eterm (*single_result) (Process *, Eterm, struct BinaryFindState *, Sint, Sint); + Eterm (*global_result) (Process *, Eterm, struct BinaryFindState *, FindallData *, Uint); +} BinaryFindState; + +typedef struct BinaryFindState_bignum { + Eterm bignum_hdr; + BinaryFindState bfs; + union { + BMFindFirstState bmffs; + BMFindAllState bmfas; + ACFindFirstState acffs; + ACFindAllState acfas; + } data; +} BinaryFindState_bignum; + +#define SIZEOF_BINARY_FIND_STATE(S) \ + (sizeof(BinaryFindState)+sizeof(S)) + +#define SIZEOF_BINARY_FIND_ALL_STATE(S) \ + (sizeof(BinaryFindState)+sizeof(S)+(sizeof(FindallData)*(S).m)) + +static Eterm do_match_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs); +static Eterm do_match_single_result(Process *p, Eterm subject, BinaryFindState *bfs, + Sint pos, Sint len); +static Eterm do_match_global_result(Process *p, Eterm subject, BinaryFindState *bfs, + FindallData *fad, Uint fad_sz); +static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs); +static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState *bfs, + Sint pos, Sint len); +static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindState *bfs, + FindallData *fad, Uint fad_sz); -static int do_binary_matches(Process *p, Eterm subject, Uint hsstart, - Uint hsend, Eterm type, Binary *bin, - Eterm state_term, Eterm *res_term) +static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp) { - byte *bytes; - Uint bitoffs, bitsize; - byte *temp_alloc = NULL; - - ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize); - if (bitsize != 0) { - goto badarg; - } - if (bitoffs != 0) { - bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc); - } - if (state_term != NIL) { - Eterm *ptr = big_val(state_term); - type = ptr[1]; - } - - if (type == am_bm) { - BMData *bm; - Sint pos; - Eterm ret,tpl; - Eterm *hp; - BMFindAllState state; - Uint reds = get_reds(p, BM_LOOP_FACTOR); - Uint save_reds = reds; - - bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin); -#ifdef HARDDEBUG - dump_bm_data(bm); -#endif - if (state_term == NIL) { - bm_init_find_all(&state, hsstart, hsend); - } else { - Eterm *ptr = big_val(state_term); - bm_restore_find_all(&state,(char *) (ptr+2)); - } - - pos = bm_find_all_non_overlapping(&state, bm, bytes, &reds); - if (pos == BM_NOT_FOUND) { - ret = NIL; - } else if (pos == BM_RESTART) { - int x = - (SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) + - !!(SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm)); -#ifdef HARDDEBUG - erts_printf("Trap bm!\n"); -#endif - hp = HAlloc(p,x+2); - hp[0] = make_pos_bignum_header(x+1); - hp[1] = type; - bm_serialize_find_all(&state, (char *) (hp+2)); - *res_term = make_big(hp); - erts_free_aligned_binary_bytes(temp_alloc); - bm_clean_find_all(&state); - return DO_BIN_MATCH_RESTART; - } else { - FindallData *fad = state.out; - int i; - for (i = 0; i < state.m; ++i) { - fad[i].epos = erts_make_integer(fad[i].pos,p); - fad[i].elen = erts_make_integer(fad[i].len,p); + Eterm *tp; + Uint pos; + Sint len; + if (l == THE_NON_VALUE || l == NIL) { + /* Invalid term or NIL, we're called from binary_match(es)_2 or + have no options*/ + *posp = 0; + *endp = binary_size(bin); + return 0; + } else if (is_list(l)) { + while(is_list(l)) { + Eterm t = CAR(list_val(l)); + Uint orig_size; + if (!is_tuple(t)) { + goto badarg; } - hp = HAlloc(p,state.m * (3 + 2)); - ret = NIL; - for (i = state.m - 1; i >= 0; --i) { - tpl = TUPLE2(hp, fad[i].epos, fad[i].elen); - hp +=3; - ret = CONS(hp,tpl,ret); - hp += 2; + tp = tuple_val(t); + if (arityval(*tp) != 2) { + goto badarg; } - } - erts_free_aligned_binary_bytes(temp_alloc); - bm_clean_find_all(&state); - BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR); - *res_term = ret; - return DO_BIN_MATCH_OK; - } else if (type == am_ac) { - ACTrie *act; - int acr; - ACFindAllState state; - Eterm ret,tpl; - Eterm *hp; - Uint reds = get_reds(p, AC_LOOP_FACTOR); - Uint save_reds = reds; - - act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin); -#ifdef HARDDEBUG - dump_ac_trie(act); -#endif - if (state_term == NIL) { - ac_init_find_all(&state, act, hsstart, hsend); - } else { - Eterm *ptr = big_val(state_term); - ac_restore_find_all(&state,(char *) (ptr+2)); - } - acr = ac_find_all_non_overlapping(&state, bytes, &reds); - if (acr == AC_NOT_FOUND) { - ret = NIL; - } else if (acr == AC_RESTART) { - int x = - (SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) + - !!(SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm)); -#ifdef HARDDEBUG - erts_printf("Trap ac!\n"); -#endif - hp = HAlloc(p,x+2); - hp[0] = make_pos_bignum_header(x+1); - hp[1] = type; - ac_serialize_find_all(&state, (char *) (hp+2)); - *res_term = make_big(hp); - erts_free_aligned_binary_bytes(temp_alloc); - ac_clean_find_all(&state); - return DO_BIN_MATCH_RESTART; - } else { - FindallData *fad = state.out; - int i; - for (i = 0; i < state.m; ++i) { - fad[i].epos = erts_make_integer(fad[i].pos,p); - fad[i].elen = erts_make_integer(fad[i].len,p); + if (tp[1] != am_scope || is_not_tuple(tp[2])) { + goto badarg; } - hp = HAlloc(p,state.m * (3 + 2)); - ret = NIL; - for (i = state.m - 1; i >= 0; --i) { - tpl = TUPLE2(hp, fad[i].epos, fad[i].elen); - hp +=3; - ret = CONS(hp,tpl,ret); - hp += 2; + tp = tuple_val(tp[2]); + if (arityval(*tp) != 2) { + goto badarg; + } + if (!term_to_Uint(tp[1], &pos)) { + goto badarg; } + if (!term_to_Sint(tp[2], &len)) { + goto badarg; + } + if (len < 0) { + Uint lentmp = -(Uint)len; + /* overflow */ + if ((Sint)lentmp < 0) { + goto badarg; + } + len = lentmp; + pos -= len; + } + /* overflow */ + if ((pos + len) < pos || (len > 0 && (pos + len) == pos)) { + goto badarg; + } + *endp = len + pos; + *posp = pos; + if ((orig_size = binary_size(bin)) < pos || + orig_size < (*endp)) { + goto badarg; + } + l = CDR(list_val(l)); } - erts_free_aligned_binary_bytes(temp_alloc); - ac_clean_find_all(&state); - BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR); - *res_term = ret; - return DO_BIN_MATCH_OK; + return 0; + } else { + badarg: + return 1; } - badarg: - return DO_BIN_MATCH_BADARG; } -static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp) +static int parse_split_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp, Uint *optp) { Eterm *tp; Uint pos; Sint len; - if (l == ((Eterm) 0) || l == NIL) { - /* Invalid term or NIL, we're called from binary_match(es)_2 or - have no options*/ - *posp = 0; - *endp = binary_size(bin); + *optp = 0; + *posp = 0; + *endp = binary_size(bin); + if (l == THE_NON_VALUE || l == NIL) { return 0; } else if (is_list(l)) { while(is_list(l)) { Eterm t = CAR(list_val(l)); Uint orig_size; + if (is_atom(t)) { + if (t == am_global) { + *optp |= BINARY_FIND_ALL; + l = CDR(list_val(l)); + continue; + } + if (t == am_trim) { + *optp |= BINARY_SPLIT_TRIM; + l = CDR(list_val(l)); + continue; + } + if (t == am_trim_all) { + *optp |= BINARY_SPLIT_TRIM_ALL; + l = CDR(list_val(l)); + continue; + } + } if (!is_tuple(t)) { goto badarg; } @@ -1355,48 +1204,207 @@ static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp) } } -static BIF_RETTYPE binary_match_trap(BIF_ALIST_3) +static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binary *bin, + Eterm state_term, Eterm *res_term) { - int runres; - Eterm result; - Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val; - runres = do_binary_match(BIF_P,BIF_ARG_1,0,0,NIL,bin,BIF_ARG_2,&result); - if (runres == DO_BIN_MATCH_OK) { - BIF_RET(result); - } else { - BUMP_ALL_REDS(BIF_P); - BIF_TRAP3(&binary_match_trap_export, BIF_P, BIF_ARG_1, result, - BIF_ARG_3); + byte *bytes; + Uint bitoffs, bitsize; + byte *temp_alloc = NULL; + BinaryFindState_bignum *state_ptr = NULL; + + ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize); + if (bitsize != 0) { + goto badarg; + } + if (bitoffs != 0) { + bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc); + } + if (state_term != NIL) { + state_ptr = (BinaryFindState_bignum *)(big_val(state_term)); + bfs = &(state_ptr->bfs); } -} -static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3) -{ - int runres; - Eterm result; - Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val; - runres = do_binary_matches(BIF_P,BIF_ARG_1,0,0,NIL,bin,BIF_ARG_2,&result); - if (runres == DO_BIN_MATCH_OK) { - BIF_RET(result); + if (bfs->flags & BINARY_FIND_ALL) { + if (bfs->type == am_bm) { + BMData *bm; + Sint pos; + BMFindAllState state; + Uint reds = get_reds(p, BM_LOOP_FACTOR); + Uint save_reds = reds; + + bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin); +#ifdef HARDDEBUG + dump_bm_data(bm); +#endif + if (state_term == NIL) { + bm_init_find_all(&state, bfs->hsstart, bfs->hsend); + } else { + bm_restore_find_all(&state, &(state_ptr->data.bmfas)); + } + + pos = bm_find_all_non_overlapping(&state, bm, bytes, &reds); + if (pos == BM_NOT_FOUND) { + *res_term = bfs->not_found_result(p, subject, bfs); + } else if (pos == BM_RESTART) { + int x = + (SIZEOF_BINARY_FIND_ALL_STATE(state) / sizeof(Eterm)) + + !!(SIZEOF_BINARY_FIND_ALL_STATE(state) % sizeof(Eterm)); +#ifdef HARDDEBUG + erts_printf("Trap bm!\n"); +#endif + state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1); + state_ptr->bignum_hdr = make_pos_bignum_header(x); + memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState)); + bm_serialize_find_all(&state, &state_ptr->data.bmfas); + *res_term = make_big(&state_ptr->bignum_hdr); + erts_free_aligned_binary_bytes(temp_alloc); + bm_clean_find_all(&state); + return DO_BIN_MATCH_RESTART; + } else { + *res_term = bfs->global_result(p, subject, bfs, state.out, state.m); + } + erts_free_aligned_binary_bytes(temp_alloc); + bm_clean_find_all(&state); + BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR); + return DO_BIN_MATCH_OK; + } else if (bfs->type == am_ac) { + ACTrie *act; + int acr; + ACFindAllState state; + Uint reds = get_reds(p, AC_LOOP_FACTOR); + Uint save_reds = reds; + + act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin); +#ifdef HARDDEBUG + dump_ac_trie(act); +#endif + if (state_term == NIL) { + ac_init_find_all(&state, act, bfs->hsstart, bfs->hsend); + } else { + ac_restore_find_all(&state, &(state_ptr->data.acfas)); + } + acr = ac_find_all_non_overlapping(&state, bytes, &reds); + if (acr == AC_NOT_FOUND) { + *res_term = bfs->not_found_result(p, subject, bfs); + } else if (acr == AC_RESTART) { + int x = + (SIZEOF_BINARY_FIND_ALL_STATE(state) / sizeof(Eterm)) + + !!(SIZEOF_BINARY_FIND_ALL_STATE(state) % sizeof(Eterm)); +#ifdef HARDDEBUG + erts_printf("Trap ac!\n"); +#endif + state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1); + state_ptr->bignum_hdr = make_pos_bignum_header(x); + memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState)); + ac_serialize_find_all(&state, &state_ptr->data.acfas); + *res_term = make_big(&state_ptr->bignum_hdr); + erts_free_aligned_binary_bytes(temp_alloc); + ac_clean_find_all(&state); + return DO_BIN_MATCH_RESTART; + } else { + *res_term = bfs->global_result(p, subject, bfs, state.out, state.m); + } + erts_free_aligned_binary_bytes(temp_alloc); + ac_clean_find_all(&state); + BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR); + return DO_BIN_MATCH_OK; + } } else { - BUMP_ALL_REDS(BIF_P); - BIF_TRAP3(&binary_matches_trap_export, BIF_P, BIF_ARG_1, result, - BIF_ARG_3); - } -} + if (bfs->type == am_bm) { + BMData *bm; + Sint pos; + BMFindFirstState state; + Uint reds = get_reds(p, BM_LOOP_FACTOR); + Uint save_reds = reds; + + bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin); +#ifdef HARDDEBUG + dump_bm_data(bm); +#endif + if (state_term == NIL) { + bm_init_find_first_match(&state, bfs->hsstart, bfs->hsend); + } else { + memcpy(&state, &state_ptr->data.bmffs, sizeof(BMFindFirstState)); + } -BIF_RETTYPE binary_match_3(BIF_ALIST_3) -{ - return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +#ifdef HARDDEBUG + erts_printf("(bm) state->pos = %ld, state->len = %lu\n",state.pos, + state.len); +#endif + pos = bm_find_first_match(&state, bm, bytes, &reds); + if (pos == BM_NOT_FOUND) { + *res_term = bfs->not_found_result(p, subject, bfs); + } else if (pos == BM_RESTART) { + int x = + (SIZEOF_BINARY_FIND_STATE(state) / sizeof(Eterm)) + + !!(SIZEOF_BINARY_FIND_STATE(state) % sizeof(Eterm)); +#ifdef HARDDEBUG + erts_printf("Trap bm!\n"); +#endif + state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1); + state_ptr->bignum_hdr = make_pos_bignum_header(x); + memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState)); + memcpy(&state_ptr->data.acffs, &state, sizeof(BMFindFirstState)); + *res_term = make_big(&state_ptr->bignum_hdr); + erts_free_aligned_binary_bytes(temp_alloc); + return DO_BIN_MATCH_RESTART; + } else { + *res_term = bfs->single_result(p, subject, bfs, pos, bm->len); + } + erts_free_aligned_binary_bytes(temp_alloc); + BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR); + return DO_BIN_MATCH_OK; + } else if (bfs->type == am_ac) { + ACTrie *act; + Uint pos, rlen; + int acr; + ACFindFirstState state; + Uint reds = get_reds(p, AC_LOOP_FACTOR); + Uint save_reds = reds; + + act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin); +#ifdef HARDDEBUG + dump_ac_trie(act); +#endif + if (state_term == NIL) { + ac_init_find_first_match(&state, act, bfs->hsstart, bfs->hsend); + } else { + memcpy(&state, &state_ptr->data.acffs, sizeof(ACFindFirstState)); + } + acr = ac_find_first_match(&state, bytes, &pos, &rlen, &reds); + if (acr == AC_NOT_FOUND) { + *res_term = bfs->not_found_result(p, subject, bfs); + } else if (acr == AC_RESTART) { + int x = + (SIZEOF_BINARY_FIND_STATE(state) / sizeof(Eterm)) + + !!(SIZEOF_BINARY_FIND_STATE(state) % sizeof(Eterm)); +#ifdef HARDDEBUG + erts_printf("Trap ac!\n"); +#endif + state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1); + state_ptr->bignum_hdr = make_pos_bignum_header(x); + memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState)); + memcpy(&state_ptr->data.acffs, &state, sizeof(ACFindFirstState)); + *res_term = make_big(&state_ptr->bignum_hdr); + erts_free_aligned_binary_bytes(temp_alloc); + return DO_BIN_MATCH_RESTART; + } else { + *res_term = bfs->single_result(p, subject, bfs, pos, rlen); + } + erts_free_aligned_binary_bytes(temp_alloc); + BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR); + return DO_BIN_MATCH_OK; + } + } + badarg: + return DO_BIN_MATCH_BADARG; } static BIF_RETTYPE -binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) +binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Uint flags) { - Uint hsstart; - Uint hsend; + BinaryFindState bfs; Eterm *tp; - Eterm type; Binary *bin; Eterm bin_term = NIL; int runres; @@ -1405,11 +1413,12 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) if (is_not_binary(arg1)) { goto badarg; } - if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) { + bfs.flags = flags; + if (parse_match_opts_list(arg3, arg1, &(bfs.hsstart), &(bfs.hsend))) { goto badarg; } - if (hsend == 0) { - BIF_RET(am_nomatch); + if (bfs.hsend == 0) { + BIF_RET(do_match_not_found_result(p, arg1, &bfs)); } if (is_tuple(arg2)) { tp = tuple_val(arg2); @@ -1420,21 +1429,24 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) { goto badarg; } - type = tp[1]; + bfs.type = tp[1]; bin = ((ProcBin *) binary_val(tp[2]))->val; - if (type == am_bm && + if (bfs.type == am_bm && ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) { goto badarg; } - if (type == am_ac && + if (bfs.type == am_ac && ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) { goto badarg; } bin_term = tp[2]; - } else if (do_binary_match_compile(arg2,&type,&bin)) { + } else if (do_binary_match_compile(arg2, &(bfs.type), &bin)) { goto badarg; } - runres = do_binary_match(p,arg1,hsstart,hsend,type,bin,NIL,&result); + bfs.not_found_result = &do_match_not_found_result; + bfs.single_result = &do_match_single_result; + bfs.global_result = &do_match_global_result; + runres = do_binary_find(p, arg1, &bfs, bin, NIL, &result); if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) { Eterm *hp = HAlloc(p, PROC_BIN_SIZE); bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin); @@ -1446,7 +1458,7 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) BIF_RET(result); case DO_BIN_MATCH_RESTART: BUMP_ALL_REDS(p); - BIF_TRAP3(&binary_match_trap_export, p, arg1, result, bin_term); + BIF_TRAP3(&binary_find_trap_export, p, arg1, result, bin_term); default: goto badarg; } @@ -1454,17 +1466,31 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) BIF_ERROR(p,BADARG); } +BIF_RETTYPE binary_match_2(BIF_ALIST_2) +{ + return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE, 0); +} + +BIF_RETTYPE binary_match_3(BIF_ALIST_3) +{ + return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, 0); +} + +BIF_RETTYPE binary_matches_2(BIF_ALIST_2) +{ + return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE, BINARY_FIND_ALL); +} + BIF_RETTYPE binary_matches_3(BIF_ALIST_3) { - return binary_matches(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, BINARY_FIND_ALL); } static BIF_RETTYPE -binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) +binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) { - Uint hsstart, hsend; + BinaryFindState bfs; Eterm *tp; - Eterm type; Binary *bin; Eterm bin_term = NIL; int runres; @@ -1473,11 +1499,12 @@ binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) if (is_not_binary(arg1)) { goto badarg; } - if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) { + if (parse_split_opts_list(arg3, arg1, &(bfs.hsstart), &(bfs.hsend), &(bfs.flags))) { goto badarg; } - if (hsend == 0) { - BIF_RET(NIL); + if (bfs.hsend == 0) { + result = do_split_not_found_result(p, arg1, &bfs); + BIF_RET(result); } if (is_tuple(arg2)) { tp = tuple_val(arg2); @@ -1488,54 +1515,267 @@ binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3) !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) { goto badarg; } - type = tp[1]; + bfs.type = tp[1]; bin = ((ProcBin *) binary_val(tp[2]))->val; - if (type == am_bm && + if (bfs.type == am_bm && ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) { goto badarg; } - if (type == am_ac && + if (bfs.type == am_ac && ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) { goto badarg; } bin_term = tp[2]; - } else if (do_binary_match_compile(arg2,&type,&bin)) { + } else if (do_binary_match_compile(arg2, &(bfs.type), &bin)) { goto badarg; } - runres = do_binary_matches(p,arg1,hsstart,hsend,type,bin, - NIL,&result); + bfs.not_found_result = &do_split_not_found_result; + bfs.single_result = &do_split_single_result; + bfs.global_result = &do_split_global_result; + runres = do_binary_find(p, arg1, &bfs, bin, NIL, &result); if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) { Eterm *hp = HAlloc(p, PROC_BIN_SIZE); bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin); } else if (bin_term == NIL) { erts_bin_free(bin); } - switch (runres) { + switch(runres) { case DO_BIN_MATCH_OK: BIF_RET(result); case DO_BIN_MATCH_RESTART: - BUMP_ALL_REDS(p); - BIF_TRAP3(&binary_matches_trap_export, p, arg1, result, - bin_term); + BIF_TRAP3(&binary_find_trap_export, p, arg1, result, bin_term); default: goto badarg; } badarg: - BIF_ERROR(p,BADARG); + BIF_ERROR(p, BADARG); } +BIF_RETTYPE binary_split_2(BIF_ALIST_2) +{ + return binary_split(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE); +} -BIF_RETTYPE binary_match_2(BIF_ALIST_2) +BIF_RETTYPE binary_split_3(BIF_ALIST_3) { - return binary_match(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0)); + return binary_split(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +} + +static Eterm do_match_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs) +{ + if (bfs->flags & BINARY_FIND_ALL) { + return NIL; + } else { + return am_nomatch; + } } +static Eterm do_match_single_result(Process *p, Eterm subject, BinaryFindState *bfs, + Sint pos, Sint len) +{ + Eterm erlen; + Eterm *hp; + Eterm ret; -BIF_RETTYPE binary_matches_2(BIF_ALIST_2) + erlen = erts_make_integer((Uint)(len), p); + ret = erts_make_integer(pos, p); + hp = HAlloc(p, 3); + ret = TUPLE2(hp, ret, erlen); + + return ret; +} + +static Eterm do_match_global_result(Process *p, Eterm subject, BinaryFindState *bfs, + FindallData *fad, Uint fad_sz) +{ + Sint i; + Eterm tpl; + Eterm *hp; + Eterm ret; + + for (i = 0; i < fad_sz; ++i) { + fad[i].epos = erts_make_integer(fad[i].pos, p); + fad[i].elen = erts_make_integer(fad[i].len, p); + } + hp = HAlloc(p, fad_sz * (3 + 2)); + ret = NIL; + for (i = fad_sz - 1; i >= 0; --i) { + tpl = TUPLE2(hp, fad[i].epos, fad[i].elen); + hp += 3; + ret = CONS(hp, tpl, ret); + hp += 2; + } + + return ret; +} + +static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs) { - return binary_matches(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0)); + Eterm *hp; + Eterm ret; + + if (bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL) + && binary_size(subject) == 0) { + return NIL; + } + hp = HAlloc(p, 2); + ret = CONS(hp, subject, NIL); + + return ret; } +static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState *bfs, + Sint pos, Sint len) +{ + size_t orig_size; + Eterm orig; + Uint offset; + Uint bit_offset; + Uint bit_size; + ErlSubBin *sb1; + ErlSubBin *sb2; + Eterm *hp; + Eterm ret; + + orig_size = binary_size(subject); + + if ((bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) && + (orig_size - pos - len) == 0) { + if (pos == 0) { + ret = NIL; + } else { + hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2)); + ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size); + sb1 = (ErlSubBin *) hp; + sb1->thing_word = HEADER_SUB_BIN; + sb1->size = pos; + sb1->offs = offset; + sb1->orig = orig; + sb1->bitoffs = bit_offset; + sb1->bitsize = bit_size; + sb1->is_writable = 0; + hp += ERL_SUB_BIN_SIZE; + + ret = CONS(hp, make_binary(sb1), NIL); + hp += 2; + } + } else { + if ((bfs->flags & BINARY_SPLIT_TRIM_ALL) && (pos == 0)) { + hp = HAlloc(p, 1 * (ERL_SUB_BIN_SIZE + 2)); + ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size); + sb1 = NULL; + } else { + hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2)); + ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size); + sb1 = (ErlSubBin *) hp; + sb1->thing_word = HEADER_SUB_BIN; + sb1->size = pos; + sb1->offs = offset; + sb1->orig = orig; + sb1->bitoffs = bit_offset; + sb1->bitsize = 0; + sb1->is_writable = 0; + hp += ERL_SUB_BIN_SIZE; + } + + sb2 = (ErlSubBin *) hp; + sb2->thing_word = HEADER_SUB_BIN; + sb2->size = orig_size - pos - len; + sb2->offs = offset + pos + len; + sb2->orig = orig; + sb2->bitoffs = bit_offset; + sb2->bitsize = bit_size; + sb2->is_writable = 0; + hp += ERL_SUB_BIN_SIZE; + + ret = CONS(hp, make_binary(sb2), NIL); + hp += 2; + if (sb1 != NULL) { + ret = CONS(hp, make_binary(sb1), ret); + hp += 2; + } + } + return ret; +} + +static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindState *bfs, + FindallData *fad, Uint fad_sz) +{ + size_t orig_size; + Eterm orig; + Uint offset; + Uint bit_offset; + Uint bit_size; + ErlSubBin *sb; + Sint i; + Sint tail; + Uint list_size; + Uint end_pos; + Uint do_trim = bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL); + Eterm *hp; + Eterm *hendp; + Eterm ret; + + tail = fad_sz - 1; + list_size = fad_sz + 1; + orig_size = binary_size(subject); + end_pos = (Uint)(orig_size); + + hp = HAlloc(p, list_size * (ERL_SUB_BIN_SIZE + 2)); + hendp = hp + list_size * (ERL_SUB_BIN_SIZE + 2); + ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size); + ASSERT(bit_size == 0); + + ret = NIL; + + for (i = tail; i >= 0; --i) { + sb = (ErlSubBin *)(hp); + sb->size = end_pos - (fad[i].pos + fad[i].len); + if (!(sb->size == 0 && do_trim)) { + sb->thing_word = HEADER_SUB_BIN; + sb->offs = offset + fad[i].pos + fad[i].len; + sb->orig = orig; + sb->bitoffs = bit_offset; + sb->bitsize = 0; + sb->is_writable = 0; + hp += ERL_SUB_BIN_SIZE; + ret = CONS(hp, make_binary(sb), ret); + hp += 2; + do_trim &= ~BINARY_SPLIT_TRIM; + } + end_pos = fad[i].pos; + } + + sb = (ErlSubBin *)(hp); + sb->size = fad[0].pos; + if (!(sb->size == 0 && do_trim)) { + sb->thing_word = HEADER_SUB_BIN; + sb->offs = offset; + sb->orig = orig; + sb->bitoffs = bit_offset; + sb->bitsize = 0; + sb->is_writable = 0; + hp += ERL_SUB_BIN_SIZE; + ret = CONS(hp, make_binary(sb), ret); + hp += 2; + } + HRelease(p, hendp, hp); + return ret; +} + +static BIF_RETTYPE binary_find_trap(BIF_ALIST_3) +{ + int runres; + Eterm result; + Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val; + runres = do_binary_find(BIF_P, BIF_ARG_1, NULL, bin, BIF_ARG_2, &result); + if (runres == DO_BIN_MATCH_OK) { + BIF_RET(result); + } else { + BUMP_ALL_REDS(BIF_P); + BIF_TRAP3(&binary_find_trap_export, BIF_P, BIF_ARG_1, result, BIF_ARG_3); + } +} BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen) { @@ -2550,7 +2790,6 @@ BIF_RETTYPE binary_referenced_byte_size_1(BIF_ALIST_1) } pb = (ProcBin *) binary_val(bin); if (pb->thing_word == HEADER_PROC_BIN) { - /* XXX:PaN - Halfword - orig_size is a long, we should handle that */ res = erts_make_integer((Uint) pb->val->orig_size, BIF_P); } else { /* heap binary */ res = erts_make_integer((Uint) ((ErlHeapBin *) pb)->size, BIF_P); @@ -2568,7 +2807,7 @@ BIF_RETTYPE binary_referenced_byte_size_1(BIF_ALIST_1) #endif static int get_need(Uint u) { -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) if (u > 0xFFFFFFFFUL) { if (u > 0xFFFFFFFFFFFFUL) { if (u > 0xFFFFFFFFFFFFFFUL) { diff --git a/erts/emulator/beam/erl_bif_chksum.c b/erts/emulator/beam/erl_bif_chksum.c index e3074d6309..9417803e14 100644 --- a/erts/emulator/beam/erl_bif_chksum.c +++ b/erts/emulator/beam/erl_bif_chksum.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2013. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index f4ef59993a..1e2db38442 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2013. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -48,6 +48,7 @@ #include "erl_version.h" #include "erl_bif_unique.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #ifdef ERTS_SMP #define DDLL_SMP 1 @@ -1619,6 +1620,7 @@ static int do_unload_driver_entry(DE_Handle *dh, Eterm *save_name) if (q->finish) { int fpe_was_unmasked = erts_block_fpe(); DTRACE1(driver_finish, q->name); + LTTNG1(driver_finish, q->name); (*(q->finish))(); erts_unblock_fpe(fpe_was_unmasked); } @@ -1707,18 +1709,19 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type, Eterm mess; Eterm r; Eterm *hp; - ErlHeapFragment *bp; - ErlOffHeap *ohp; + ErtsMessage *mp; ErtsProcLocks rp_locks = 0; + ErlOffHeap *ohp; ERTS_SMP_CHK_NO_PROC_LOCKS; assert_drv_list_rwlocked(); if (errcode != 0) { int need = load_error_need(errcode); Eterm e; - hp = erts_alloc_message_heap(6 /* tuple */ + 3 /* Error tuple */ + - REF_THING_SIZE + need, &bp, &ohp, - proc, &rp_locks); + mp = erts_alloc_message_heap(proc, &rp_locks, + (6 /* tuple */ + 3 /* Error tuple */ + + REF_THING_SIZE + need), + &hp, &ohp); r = copy_ref(ref,hp); hp += REF_THING_SIZE; e = build_load_error_hp(hp, errcode); @@ -1727,12 +1730,14 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type, hp += 3; mess = TUPLE5(hp,type,r,am_driver,driver_name,mess); } else { - hp = erts_alloc_message_heap(6 /* tuple */ + REF_THING_SIZE, &bp, &ohp, proc, &rp_locks); + mp = erts_alloc_message_heap(proc, &rp_locks, + 6 /* tuple */ + REF_THING_SIZE, + &hp, &ohp); r = copy_ref(ref,hp); hp += REF_THING_SIZE; mess = TUPLE5(hp,type,r,am_driver,driver_name,tag); } - erts_queue_message(proc, &rp_locks, bp, mess, am_undefined); + erts_queue_message(proc, &rp_locks, mp, mess); 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 4a9a6a5fcd..b42d2dc28b 100644 --- a/erts/emulator/beam/erl_bif_guard.c +++ b/erts/emulator/beam/erl_bif_guard.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2011. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index ac7a70c642..99fe847ba2 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2013. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -22,6 +22,7 @@ # include "config.h" #endif +#define ERTS_WANT_MEM_MAPPERS #include "sys.h" #include "erl_vm.h" #include "global.h" @@ -64,6 +65,7 @@ static Export* alloc_sizes_trap = NULL; static Export* gather_io_bytes_trap = NULL; static Export *gather_sched_wall_time_res_trap; +static Export *gather_msacc_res_trap; static Export *gather_gc_info_res_trap; static Export *gather_system_check_res_trap; @@ -74,9 +76,6 @@ static char otp_version[] = ERLANG_OTP_VERSION; static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE "%s" " [erts-" ERLANG_VERSION "]" -#if !HEAP_ON_C_STACK && !HALFWORD_HEAP - " [no-c-stack-objects]" -#endif #ifndef OTP_RELEASE #ifdef ERLANG_GIT_VERSION " [source-" ERLANG_GIT_VERSION "]" @@ -85,12 +84,8 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE #endif #endif #ifdef ARCH_64 -#if HALFWORD_HEAP - " [64-bit halfword]" -#else " [64-bit]" #endif -#endif #ifdef ERTS_SMP " [smp:%beu:%beu]" #endif @@ -132,12 +127,18 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE #ifdef ERTS_FRMPTR " [frame-pointer]" #endif +#ifdef USE_LTTNG + " [lttng]" +#endif #ifdef USE_DTRACE " [dtrace]" #endif #ifdef USE_SYSTEMTAP " [systemtap]" #endif +#ifdef SHCOPY + " [sharing-preserving]" +#endif "\n"); #define ASIZE(a) (sizeof(a)/sizeof(a[0])) @@ -323,13 +324,11 @@ erts_print_system_version(int to, void *arg, Process *c_p) char *ov = otp_version; #ifdef ERTS_SMP Uint total, online, active; -#ifdef ERTS_DIRTY_SCHEDULERS Uint dirty_cpu, dirty_cpu_onln, dirty_io; - (void) erts_schedulers_state(&total, &online, &active, &dirty_cpu, &dirty_cpu_onln, &dirty_io, 0); -#else - (void) erts_schedulers_state(&total, &online, &active, NULL, NULL, NULL, 0); -#endif + erts_schedulers_state(&total, &online, &active, + &dirty_cpu, &dirty_cpu_onln, NULL, + &dirty_io, NULL); #endif for (i = 0; i < sizeof(otp_version)-4; i++) { if (ov[i] == '-' && ov[i+1] == 'r' && ov[i+2] == 'c') @@ -597,6 +596,8 @@ static Eterm pi_args[] = { am_min_bin_vheap_size, am_current_location, am_current_stacktrace, + am_message_queue_data, + am_garbage_collection_info }; #define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(Eterm))) @@ -644,6 +645,8 @@ pi_arg2ix(Eterm arg) case am_min_bin_vheap_size: return 28; case am_current_location: return 29; case am_current_stacktrace: return 30; + case am_message_queue_data: return 31; + case am_garbage_collection_info: return 32; default: return -1; } } @@ -672,18 +675,12 @@ static Eterm pi_1_keys[] = { #define ERTS_PI_1_NO_OF_KEYS (sizeof(pi_1_keys)/sizeof(Eterm)) static Eterm pi_1_keys_list; -#if HEAP_ON_C_STACK static Eterm pi_1_keys_list_heap[2*ERTS_PI_1_NO_OF_KEYS]; -#endif static void process_info_init(void) { -#if HEAP_ON_C_STACK Eterm *hp = &pi_1_keys_list_heap[0]; -#else - Eterm *hp = erts_alloc(ERTS_ALC_T_LL_TEMP_TERM,sizeof(Eterm)*2*ERTS_PI_1_NO_OF_KEYS); -#endif int i; pi_1_keys_list = NIL; @@ -732,9 +729,10 @@ pi_pid2proc(Process *c_p, Eterm pid, ErtsProcLocks info_locks) -BIF_RETTYPE +static BIF_RETTYPE process_info_aux(Process *BIF_P, Process *rp, + ErtsProcLocks rp_locks, Eterm rpid, Eterm item, int always_wrap); @@ -825,10 +823,32 @@ process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap, *fail_type = ERTS_PI_FAIL_TYPE_AWAIT_EXIT; goto done; } - else if (!(locks & ERTS_PROC_LOCK_STATUS)) { - erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); + else { + ErtsProcLocks unlock_locks = 0; + + if (c_p == rp) + locks |= ERTS_PROC_LOCK_MAIN; + + if (!(locks & ERTS_PROC_LOCK_STATUS)) + unlock_locks |= ERTS_PROC_LOCK_STATUS; + + if (locks & ERTS_PROC_LOCK_MSGQ) { + /* + * Move in queue into private queue and + * release msgq lock, enabling others to + * send messages to the process while it + * is being inspected... + */ + ASSERT(locks & ERTS_PROC_LOCK_MAIN); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); + locks &= ~ERTS_PROC_LOCK_MSGQ; + unlock_locks |= ERTS_PROC_LOCK_MSGQ; + } + + if (unlock_locks) + erts_smp_proc_unlock(rp, unlock_locks); + } - /* * We always handle 'messages' first if it should be part @@ -840,7 +860,7 @@ process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap, if (want_messages) { ix = pi_arg2ix(am_messages); ASSERT(part_res[ix] == THE_NON_VALUE); - part_res[ix] = process_info_aux(c_p, rp, pid, am_messages, always_wrap); + part_res[ix] = process_info_aux(c_p, rp, locks, pid, am_messages, always_wrap); ASSERT(part_res[ix] != THE_NON_VALUE); } @@ -848,7 +868,7 @@ process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap, ix = res_elem_ix[res_elem_ix_ix]; if (part_res[ix] == THE_NON_VALUE) { arg = pi_ix2arg(ix); - part_res[ix] = process_info_aux(c_p, rp, pid, arg, always_wrap); + part_res[ix] = process_info_aux(c_p, rp, locks, pid, arg, always_wrap); ASSERT(part_res[ix] != THE_NON_VALUE); } } @@ -979,9 +999,31 @@ BIF_RETTYPE process_info_2(BIF_ALIST_2) ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_undefined); } else { + ErtsProcLocks unlock_locks = 0; + + if (BIF_P == rp) + info_locks |= ERTS_PROC_LOCK_MAIN; + if (!(info_locks & ERTS_PROC_LOCK_STATUS)) - erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); - res = process_info_aux(BIF_P, rp, pid, BIF_ARG_2, 0); + unlock_locks |= ERTS_PROC_LOCK_STATUS; + + if (info_locks & ERTS_PROC_LOCK_MSGQ) { + /* + * Move in queue into private queue and + * release msgq lock, enabling others to + * send messages to the process while it + * is being inspected... + */ + ASSERT(info_locks & ERTS_PROC_LOCK_MAIN); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); + info_locks &= ~ERTS_PROC_LOCK_MSGQ; + unlock_locks |= ERTS_PROC_LOCK_MSGQ; + } + + if (unlock_locks) + erts_smp_proc_unlock(rp, unlock_locks); + + res = process_info_aux(BIF_P, rp, info_locks, pid, BIF_ARG_2, 0); } ASSERT(is_value(res)); @@ -999,6 +1041,7 @@ BIF_RETTYPE process_info_2(BIF_ALIST_2) Eterm process_info_aux(Process *BIF_P, Process *rp, + ErtsProcLocks rp_locks, Eterm rpid, Eterm item, int always_wrap) @@ -1070,171 +1113,55 @@ process_info_aux(Process *BIF_P, break; case am_messages: { - ErlMessage* mp; - int n; - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); - n = rp->msg.len; - - if (n == 0 || ERTS_TRACE_FLAGS(rp) & F_SENSITIVE) { + if (rp->msg.len == 0 || ERTS_TRACE_FLAGS(rp) & F_SENSITIVE) { hp = HAlloc(BIF_P, 3); } else { - int remove_bad_messages = 0; - struct { - Uint copy_struct_size; - ErlMessage* msgp; - } *mq = erts_alloc(ERTS_ALC_T_TMP, n*sizeof(*mq)); - Sint i = 0; - Uint heap_need = 3; + ErtsMessageInfo *mip; + Sint i; + Uint heap_need; +#ifdef DEBUG Eterm *hp_end; +#endif - for (mp = rp->msg.first; mp; mp = mp->next) { - heap_need += 2; - mq[i].msgp = mp; - if (rp != BIF_P) { - Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp); - if (is_value(msg)) { - mq[i].copy_struct_size = (is_immed(msg)? 0 : - size_object(msg)); - } - else if (mq[i].msgp->data.attached) { - mq[i].copy_struct_size - = erts_msg_attached_data_size(mq[i].msgp); - } - else { - /* Bad distribution message; ignore */ - remove_bad_messages = 1; - mq[i].copy_struct_size = 0; - } - heap_need += mq[i].copy_struct_size; - } - else { - mq[i].copy_struct_size = mp->data.attached ? - erts_msg_attached_data_size(mp) : 0; - } - i++; - } + mip = erts_alloc(ERTS_ALC_T_TMP, + rp->msg.len*sizeof(ErtsMessageInfo)); - if (rp != BIF_P) { - hp = HAlloc(BIF_P, heap_need); - hp_end = hp + heap_need; - ASSERT(i == n); - for (i--; i >= 0; i--) { - Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp); - if (is_value(msg)) { - if (mq[i].copy_struct_size) - msg = copy_struct(msg, - mq[i].copy_struct_size, - &hp, - &MSO(BIF_P)); - } - else if (mq[i].msgp->data.attached) { - ErlHeapFragment *hfp; - /* - * Decode it into a message buffer and attach it - * to the message instead of the attached external - * term. - * - * Note that we may not pass a process pointer - * to erts_msg_distext2heap(), since it would then - * try to alter locks on that process. - */ - msg = erts_msg_distext2heap( - NULL, NULL, &hfp, &ERL_MESSAGE_TOKEN(mq[i].msgp), - mq[i].msgp->data.dist_ext); - - ERL_MESSAGE_TERM(mq[i].msgp) = msg; - mq[i].msgp->data.heap_frag = hfp; - - if (is_non_value(msg)) { - ASSERT(!mq[i].msgp->data.heap_frag); - /* Bad distribution message; ignore */ - remove_bad_messages = 1; - continue; - } - else { - /* Make our copy of the message */ - ASSERT(size_object(msg) == erts_used_frag_sz(hfp)); - msg = copy_struct(msg, - erts_used_frag_sz(hfp), - &hp, - &MSO(BIF_P)); - } - } - else { - /* Bad distribution message; ignore */ - remove_bad_messages = 1; - continue; - } - res = CONS(hp, msg, res); - hp += 2; - } - HRelease(BIF_P, hp_end, hp+3); - } - else { - for (i--; i >= 0; i--) { - ErtsHeapFactory factory; - Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp); - - erts_factory_proc_prealloc_init(&factory, BIF_P, - mq[i].copy_struct_size+2); - if (mq[i].msgp->data.attached) { - /* Decode it on the heap */ - erts_move_msg_attached_data_to_heap(&factory, - mq[i].msgp); - msg = ERL_MESSAGE_TERM(mq[i].msgp); - ASSERT(!mq[i].msgp->data.attached); - } - if (is_value(msg)) { - hp = erts_produce_heap(&factory, 2, 0); - res = CONS(hp, msg, res); - } - else { - /* Bad distribution message; ignore */ - remove_bad_messages = 1; - continue; - } - erts_factory_close(&factory); - } - hp = HAlloc(BIF_P, 3); - } - erts_free(ERTS_ALC_T_TMP, mq); - if (remove_bad_messages) { - ErlMessage **mpp; - /* - * We need to remove bad distribution messages from - * the queue, so that the value returned for - * 'message_queue_len' is consistent with the value - * returned for 'messages'. - */ - mpp = &rp->msg.first; - mp = rp->msg.first; - while (mp) { - if (is_value(ERL_MESSAGE_TERM(mp))) { - mpp = &mp->next; - mp = mp->next; - } - else { - ErlMessage* bad_mp = mp; - ASSERT(!mp->data.attached); - if (rp->msg.save == &mp->next) - rp->msg.save = mpp; - if (rp->msg.last == &mp->next) - rp->msg.last = mpp; - *mpp = mp->next; - mp = mp->next; - rp->msg.len--; - free_message(bad_mp); - } - } + /* + * Note that message queue may shrink when calling + * erts_prep_msgq_for_inspection() since it removes + * corrupt distribution messages. + */ + heap_need = erts_prep_msgq_for_inspection(BIF_P, rp, rp_locks, mip); + heap_need += 3; /* top 2-tuple */ + heap_need += rp->msg.len*2; /* Cons cells */ + + hp = HAlloc(BIF_P, heap_need); /* heap_need is exact */ +#ifdef DEBUG + hp_end = hp + heap_need; +#endif + + /* Build list of messages... */ + for (i = rp->msg.len - 1, res = NIL; i >= 0; i--) { + Eterm msg = ERL_MESSAGE_TERM(mip[i].msgp); + Uint sz = mip[i].size; + + if (sz != 0) + msg = copy_struct(msg, sz, &hp, &BIF_P->off_heap); + + res = CONS(hp, msg, res); + hp += 2; } + + ASSERT(hp_end == hp + 3); + + erts_free(ERTS_ALC_T_TMP, mip); } break; } case am_message_queue_len: hp = HAlloc(BIF_P, 3); - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); res = make_small(rp->msg.len); break; @@ -1422,7 +1349,7 @@ process_info_aux(Process *BIF_P, } case am_total_heap_size: { - ErlMessage *mp; + ErtsMessage *mp; Uint total_heap_size; Uint hsz = 3; @@ -1432,11 +1359,10 @@ process_info_aux(Process *BIF_P, total_heap_size += rp->mbuf_sz; - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); - - for (mp = rp->msg.first; mp; mp = mp->next) - if (mp->data.attached) - total_heap_size += erts_msg_attached_data_size(mp); + if (rp->flags & F_ON_HEAP_MSGQ) + for (mp = rp->msg.first; mp; mp = mp->next) + if (mp->data.attached) + total_heap_size += erts_msg_attached_data_size(mp); (void) erts_bld_uint(NULL, &hsz, total_heap_size); hp = HAlloc(BIF_P, hsz); @@ -1455,7 +1381,7 @@ process_info_aux(Process *BIF_P, case am_memory: { /* Memory consumed in bytes */ Uint hsz = 3; - Uint size = erts_process_memory(rp); + Uint size = erts_process_memory(rp, 0); (void) erts_bld_uint(NULL, &hsz, size); hp = HAlloc(BIF_P, hsz); res = erts_bld_uint(&hp, NULL, size); @@ -1480,6 +1406,32 @@ process_info_aux(Process *BIF_P, break; } + case am_garbage_collection_info: { + Uint sz = 0, actual_sz = 0; + + if (rp == BIF_P) { + sz += ERTS_PROCESS_GC_INFO_MAX_SIZE; + } else { + erts_process_gc_info(rp, &sz, NULL); + sz += 3; + } + + hp = HAlloc(BIF_P, sz); + res = erts_process_gc_info(rp, &actual_sz, &hp); + + /* We may have some extra space, fill with 0 tuples */ + if (actual_sz <= sz - 3) { + for (; actual_sz < sz - 3; hp++, actual_sz++) + hp[0] = make_arityval(0); + } else { + for (; actual_sz < sz; hp++, actual_sz++) + hp[0] = make_arityval(0); + hp = HAlloc(BIF_P, 3); + } + + break; + } + case am_group_leader: { int sz = NC_HEAP_SIZE(rp->group_leader); hp = HAlloc(BIF_P, 3 + sz); @@ -1581,6 +1533,25 @@ process_info_aux(Process *BIF_P, break; } + case am_message_queue_data: + switch (rp->flags & (F_OFF_HEAP_MSGQ|F_ON_HEAP_MSGQ)) { + case F_OFF_HEAP_MSGQ: + res = am_off_heap; + break; + case F_ON_HEAP_MSGQ: + res = am_on_heap; + break; + case 0: + res = am_mixed; + break; + default: + res = am_error; + ERTS_INTERNAL_ERROR("Inconsistent message queue management state"); + break; + } + hp = HAlloc(BIF_P, 3); + break; + default: return THE_NON_VALUE; /* will produce badarg */ @@ -1755,7 +1726,7 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */ if (arity == 2) { Eterm res = THE_NON_VALUE; char *buf; - int len = is_string(*tp); + Sint len = is_string(*tp); if (len <= 0) return res; buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1); @@ -1774,7 +1745,7 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */ else { Eterm res = THE_NON_VALUE; char *buf; - int len = is_string(tp[1]); + Sint len = is_string(tp[1]); if (len <= 0) return res; buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1); @@ -2077,12 +2048,18 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) #ifndef ERTS_SMP BIF_RET(am_disabled); #else +#ifndef ERTS_DIRTY_SCHEDULERS if (erts_no_schedulers == 1) BIF_RET(am_disabled); - else { - BIF_RET(erts_is_multi_scheduling_blocked() - ? am_blocked - : am_enabled); + else +#endif + { + int msb = erts_is_multi_scheduling_blocked(); + BIF_RET(!msb + ? am_enabled + : (msb > 0 + ? am_blocked + : am_blocked_normal)); } #endif } else if (BIF_ARG_1 == am_build_type) { @@ -2188,8 +2165,8 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) res = build_snifs_term(&hp, NULL, NIL); BIF_RET(res); } else if (BIF_ARG_1 == am_sequential_tracer) { - val = erts_get_system_seq_tracer(); - ASSERT(is_internal_pid(val) || is_internal_port(val) || val==am_false); + ErtsTracer seq_tracer = erts_get_system_seq_tracer(); + val = erts_tracer_to_term(BIF_P, seq_tracer); hp = HAlloc(BIF_P, 3); res = TUPLE2(hp, am_sequential_tracer, val); BIF_RET(res); @@ -2551,77 +2528,120 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) res = TUPLE3(hp, make_small(1), make_small(1), make_small(1)); BIF_RET(res); #else + Eterm *hp; Uint total, online, active; - switch (erts_schedulers_state(&total, - &online, - &active, - NULL, - NULL, - NULL, - 1)) { - case ERTS_SCHDLR_SSPND_DONE: { - Eterm *hp = HAlloc(BIF_P, 4); - res = TUPLE3(hp, - make_small(total), - make_small(online), - make_small(active)); - BIF_RET(res); + erts_schedulers_state(&total, &online, &active, + NULL, NULL, NULL, NULL, NULL); + hp = HAlloc(BIF_P, 4); + res = TUPLE3(hp, + make_small(total), + make_small(online), + make_small(active)); + BIF_RET(res); +#endif + } else if (ERTS_IS_ATOM_STR("schedulers_state", BIF_ARG_1)) { +#ifndef ERTS_SMP + Eterm *hp = HAlloc(BIF_P, 4); + res = TUPLE3(hp, make_small(1), make_small(1), make_small(1)); + BIF_RET(res); +#else + Eterm *hp; + Uint total, online, active; + erts_schedulers_state(&total, &online, &active, + NULL, NULL, NULL, NULL, NULL); + hp = HAlloc(BIF_P, 4); + res = TUPLE3(hp, + make_small(total), + make_small(online), + make_small(active)); + BIF_RET(res); +#endif + } else if (ERTS_IS_ATOM_STR("all_schedulers_state", BIF_ARG_1)) { +#ifndef ERTS_SMP + Eterm *hp = HAlloc(BIF_P, 2+5); + res = CONS(hp+5, + TUPLE4(hp, + am_normal, + make_small(1), + make_small(1), + make_small(1)), + NIL); + BIF_RET(res); +#else + Eterm *hp, tpl; + Uint sz, total, online, active, + dirty_cpu_total, dirty_cpu_online, dirty_cpu_active, + dirty_io_total, dirty_io_active; + erts_schedulers_state(&total, &online, &active, + &dirty_cpu_total, &dirty_cpu_online, &dirty_cpu_active, + &dirty_io_total, &dirty_io_active); + + sz = 2+5; + if (dirty_cpu_total) + sz += 2+5; + if (dirty_io_total) + sz += 2+5; + + hp = HAlloc(BIF_P, sz); + + res = NIL; + if (dirty_io_total) { + tpl = TUPLE4(hp, + am_dirty_io, + make_small(dirty_io_total), + make_small(dirty_io_total), + make_small(dirty_io_active)); + hp += 5; + res = CONS(hp, tpl, res); + hp += 2; } - case ERTS_SCHDLR_SSPND_YIELD_RESTART: - ERTS_VBUMP_ALL_REDS(BIF_P); - BIF_TRAP1(bif_export[BIF_system_info_1], - BIF_P, BIF_ARG_1); - default: - ASSERT(0); - BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + if (dirty_cpu_total) { + tpl = TUPLE4(hp, + am_dirty_cpu, + make_small(dirty_cpu_total), + make_small(dirty_cpu_online), + make_small(dirty_cpu_active)); + hp += 5; + res = CONS(hp, tpl, res); + hp += 2; } + tpl = TUPLE4(hp, + am_normal, + make_small(total), + make_small(online), + make_small(active)); + hp += 5; + res = CONS(hp, tpl, res); + BIF_RET(res); #endif } else if (ERTS_IS_ATOM_STR("schedulers_online", BIF_ARG_1)) { #ifndef ERTS_SMP BIF_RET(make_small(1)); #else - Uint total, online, active; - switch (erts_schedulers_state(&total, &online, &active, NULL, NULL, NULL, 1)) { - case ERTS_SCHDLR_SSPND_DONE: - BIF_RET(make_small(online)); - case ERTS_SCHDLR_SSPND_YIELD_RESTART: - ERTS_VBUMP_ALL_REDS(BIF_P); - BIF_TRAP1(bif_export[BIF_system_info_1], - BIF_P, BIF_ARG_1); - default: - ASSERT(0); - BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); - } + Uint online; + erts_schedulers_state(NULL, &online, NULL, NULL, NULL, NULL, NULL, NULL); + BIF_RET(make_small(online)); #endif } else if (ERTS_IS_ATOM_STR("schedulers_active", BIF_ARG_1)) { #ifndef ERTS_SMP BIF_RET(make_small(1)); #else - Uint total, online, active; - switch (erts_schedulers_state(&total, &online, &active, NULL, NULL, NULL, 1)) { - case ERTS_SCHDLR_SSPND_DONE: - BIF_RET(make_small(active)); - case ERTS_SCHDLR_SSPND_YIELD_RESTART: - ERTS_VBUMP_ALL_REDS(BIF_P); - BIF_TRAP1(bif_export[BIF_system_info_1], - BIF_P, BIF_ARG_1); - default: - ASSERT(0); - BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); - } + Uint active; + erts_schedulers_state(NULL, NULL, &active, NULL, NULL, NULL, NULL, NULL); + BIF_RET(make_small(active)); #endif #if defined(ERTS_SMP) && defined(ERTS_DIRTY_SCHEDULERS) } else if (ERTS_IS_ATOM_STR("dirty_cpu_schedulers", BIF_ARG_1)) { Uint dirty_cpu; - erts_schedulers_state(NULL, NULL, NULL, &dirty_cpu, NULL, NULL, 1); + erts_schedulers_state(NULL, NULL, NULL, &dirty_cpu, NULL, NULL, NULL, NULL); BIF_RET(make_small(dirty_cpu)); } else if (ERTS_IS_ATOM_STR("dirty_cpu_schedulers_online", BIF_ARG_1)) { Uint dirty_cpu_onln; - erts_schedulers_state(NULL, NULL, NULL, NULL, &dirty_cpu_onln, NULL, 1); + erts_schedulers_state(NULL, NULL, NULL, NULL, &dirty_cpu_onln, NULL, NULL, NULL); BIF_RET(make_small(dirty_cpu_onln)); } else if (ERTS_IS_ATOM_STR("dirty_io_schedulers", BIF_ARG_1)) { Uint dirty_io; - erts_schedulers_state(NULL, NULL, NULL, NULL, NULL, &dirty_io, 1); + erts_schedulers_state(NULL, NULL, NULL, NULL, NULL, NULL, &dirty_io, NULL); BIF_RET(make_small(dirty_io)); #endif } else if (ERTS_IS_ATOM_STR("run_queues", BIF_ARG_1)) { @@ -2675,7 +2695,16 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) if (erts_no_schedulers == 1) BIF_RET(NIL); else - BIF_RET(erts_multi_scheduling_blockers(BIF_P)); + BIF_RET(erts_multi_scheduling_blockers(BIF_P, 0)); +#endif + } else if (ERTS_IS_ATOM_STR("normal_multi_scheduling_blockers", BIF_ARG_1)) { +#ifndef ERTS_SMP + BIF_RET(NIL); +#else + if (erts_no_schedulers == 1) + BIF_RET(NIL); + else + BIF_RET(erts_multi_scheduling_blockers(BIF_P, 1)); #endif } else if (ERTS_IS_ATOM_STR("modified_timing_level", BIF_ARG_1)) { BIF_RET(ERTS_USE_MODIFIED_TIMING() @@ -2725,6 +2754,9 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) #elif defined(USE_SYSTEMTAP) DECL_AM(systemtap); BIF_RET(AM_systemtap); +#elif defined(USE_LTTNG) + DECL_AM(lttng); + BIF_RET(AM_lttng); #else BIF_RET(am_none); #endif @@ -2742,6 +2774,19 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(am_true); } #endif + else if (BIF_ARG_1 == am_message_queue_data) { + switch (erts_default_spo_flags & (SPO_ON_HEAP_MSGQ|SPO_OFF_HEAP_MSGQ)) { + case SPO_OFF_HEAP_MSGQ: + BIF_RET(am_off_heap); + case SPO_ON_HEAP_MSGQ: + BIF_RET(am_on_heap); + case 0: + BIF_RET(am_mixed); + default: + ERTS_INTERNAL_ERROR("Inconsistent message queue management state"); + BIF_RET(am_error); + } + } else if (ERTS_IS_ATOM_STR("compile_info",BIF_ARG_1)) { Uint sz; Eterm res = NIL, tup, text; @@ -2780,6 +2825,20 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) else if (ERTS_IS_ATOM_STR("eager_check_io",BIF_ARG_1)) { BIF_RET(erts_eager_check_io ? am_true : am_false); } + else if (ERTS_IS_ATOM_STR("literal_test",BIF_ARG_1)) { +#ifdef ERTS_HAVE_IS_IN_LITERAL_RANGE +#ifdef ARCH_64 + DECL_AM(range); + BIF_RET(AM_range); +#else /* ARCH_32 */ + DECL_AM(range_bitmask); + BIF_RET(AM_range_bitmask); +#endif /* ARCH_32 */ +#else /* ! ERTS_HAVE_IS_IN_LITERAL_RANGE */ + DECL_AM(tag); + BIF_RET(AM_tag); +#endif + } BIF_ERROR(BIF_P, BADARG); } @@ -3268,6 +3327,14 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1) szp = NULL; hpp = &hp; } +#ifdef ERTS_ENABLE_MSACC + } else if (BIF_ARG_1 == am_microstate_accounting) { + Eterm threads; + res = erts_msacc_request(BIF_P, ERTS_MSACC_GATHER, &threads); + if (is_non_value(res)) + BIF_RET(am_undefined); + BIF_TRAP2(gather_msacc_res_trap, BIF_P, res, threads); +#endif } else if (BIF_ARG_1 == am_context_switches) { Eterm cs = erts_make_integer(erts_get_total_context_switches(), BIF_P); hp = HAlloc(BIF_P, 3); @@ -3488,7 +3555,7 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) BIF_RET(res); } else if (ERTS_IS_ATOM_STR("mmap", BIF_ARG_1)) { - BIF_RET(erts_mmap_debug_info(BIF_P)); + BIF_RET(erts_mmap_debug_info(&erts_dflt_mmapper, 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)); @@ -3910,9 +3977,7 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) BIF_RET(am_false); } else { - FLAGS(rp) |= F_FORCE_GC; - if (BIF_P != rp) - erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); + ERTS_FORCE_GC(BIF_P); BIF_RET(am_true); } } @@ -4131,6 +4196,17 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) BIF_RET(am_ok); } } + else if (ERTS_IS_ATOM_STR("fill_heap", BIF_ARG_1)) { + UWord left = HeapWordsLeft(BIF_P); + if (left > 1) { + Eterm* hp = HAlloc(BIF_P, left); + *hp = make_pos_bignum_header(left - 1); + } + if (BIF_ARG_2 == am_true) { + FLAGS(BIF_P) |= F_NEED_FULLSWEEP; + } + BIF_RET(am_ok); + } } BIF_ERROR(BIF_P, BADARG); @@ -4380,14 +4456,17 @@ static void os_info_init(void) os_flavor(buf, 1024); flav = erts_atom_put((byte *) buf, strlen(buf), ERTS_ATOM_ENC_LATIN1, 1); erts_free(ERTS_ALC_T_TMP, (void *) buf); - hp = erts_alloc(ERTS_ALC_T_LL_TEMP_TERM, (3+4)*sizeof(Eterm)); + hp = erts_alloc(ERTS_ALC_T_LITERAL, (3+4)*sizeof(Eterm)); os_type_tuple = TUPLE2(hp, type, flav); + erts_set_literal_tag(&os_type_tuple, hp, 3); + hp += 3; os_version(&major, &minor, &build); os_version_tuple = TUPLE3(hp, make_small(major), make_small(minor), make_small(build)); + erts_set_literal_tag(&os_version_tuple, hp, 4); } void @@ -4404,6 +4483,8 @@ erts_bif_info_init(void) = erts_export_put(am_erlang, am_gather_gc_info_result, 1); gather_io_bytes_trap = erts_export_put(am_erts_internal, am_gather_io_bytes, 2); + gather_msacc_res_trap + = erts_export_put(am_erts_internal, am_gather_microstate_accounting_result, 2); gather_system_check_res_trap = erts_export_put(am_erts_internal, am_gather_system_check_result, 1); process_info_init(); diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c index 5583dcb371..73d327da3e 100644 --- a/erts/emulator/beam/erl_bif_lists.c +++ b/erts/emulator/beam/erl_bif_lists.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2011. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -40,32 +40,93 @@ static BIF_RETTYPE append(Process* p, Eterm A, Eterm B) Eterm list; Eterm copy; Eterm last; - size_t need; - Eterm* hp; - int i; + Eterm* hp = NULL; + Sint i; - if ((i = erts_list_length(A)) < 0) { - BIF_ERROR(p, BADARG); + list = A; + + if (is_nil(list)) { + BIF_RET(B); } - if (i == 0) { - BIF_RET(B); - } else if (is_nil(B)) { - BIF_RET(A); + + if (is_not_list(list)) { + BIF_ERROR(p, BADARG); } - need = 2*i; - hp = HAlloc(p, need); - list = A; + /* optimistic append on heap first */ + + if ((i = HeapWordsLeft(p) / 2) < 4) { + goto list_tail; + } + + hp = HEAP_TOP(p); copy = last = CONS(hp, CAR(list_val(list)), make_list(hp+2)); list = CDR(list_val(list)); - hp += 2; + hp += 2; + i -= 2; /* don't use the last 2 words (extra i--;) */ + + while(i-- && is_list(list)) { + Eterm* listp = list_val(list); + last = CONS(hp, CAR(listp), make_list(hp+2)); + list = CDR(listp); + hp += 2; + } + + /* A is proper and B is NIL return A as-is, don't update HTOP */ + + if (is_nil(list) && is_nil(B)) { + BIF_RET(A); + } + + if (is_nil(list)) { + HEAP_TOP(p) = hp; + CDR(list_val(last)) = B; + BIF_RET(copy); + } + +list_tail: + + if ((i = erts_list_length(list)) < 0) { + BIF_ERROR(p, BADARG); + } + + /* remaining list was proper and B is NIL */ + if (is_nil(B)) { + BIF_RET(A); + } + + if (hp) { + /* Note: fall through case, already written + * on the heap. + * The last 2 words of the heap is not written yet + */ + Eterm *hp_save = hp; + ASSERT(i != 0); + HEAP_TOP(p) = hp + 2; + if (i == 1) { + hp[0] = CAR(list_val(list)); + hp[1] = B; + BIF_RET(copy); + } + hp = HAlloc(p, 2*(i - 1)); + last = CONS(hp_save, CAR(list_val(list)), make_list(hp)); + } else { + hp = HAlloc(p, 2*i); + copy = last = CONS(hp, CAR(list_val(list)), make_list(hp+2)); + hp += 2; + } + + list = CDR(list_val(list)); i--; + + ASSERT(i > -1); while(i--) { - Eterm* listp = list_val(list); - last = CONS(hp, CAR(listp), make_list(hp+2)); - list = CDR(listp); - hp += 2; + Eterm* listp = list_val(list); + last = CONS(hp, CAR(listp), make_list(hp+2)); + list = CDR(listp); + hp += 2; } + CDR(list_val(last)) = B; BIF_RET(copy); } @@ -99,9 +160,9 @@ static Eterm subtract(Process* p, Eterm A, Eterm B) Eterm small_vec[SMALL_VEC_SIZE]; /* Preallocated memory for small lists */ Eterm* vec_p; Eterm* vp; - int i; - int n; - int m; + Sint i; + Sint n; + Sint m; if ((n = erts_list_length(A)) < 0) { BIF_ERROR(p, BADARG); diff --git a/erts/emulator/beam/erl_bif_op.c b/erts/emulator/beam/erl_bif_op.c index c9192fc420..aecb8bf0c1 100644 --- a/erts/emulator/beam/erl_bif_op.c +++ b/erts/emulator/beam/erl_bif_op.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2013. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -89,22 +89,22 @@ BIF_RETTYPE not_1(BIF_ALIST_1) BIF_RETTYPE sgt_2(BIF_ALIST_2) { - BIF_RET(cmp_gt(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); + BIF_RET(CMP_GT(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); } BIF_RETTYPE sge_2(BIF_ALIST_2) { - BIF_RET(cmp_ge(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); + BIF_RET(CMP_GE(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); } BIF_RETTYPE slt_2(BIF_ALIST_2) { - BIF_RET(cmp_lt(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); + BIF_RET(CMP_LT(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); } BIF_RETTYPE sle_2(BIF_ALIST_2) { - BIF_RET(cmp_le(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); + BIF_RET(CMP_LE(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); } BIF_RETTYPE seq_2(BIF_ALIST_2) @@ -114,7 +114,7 @@ BIF_RETTYPE seq_2(BIF_ALIST_2) BIF_RETTYPE seqeq_2(BIF_ALIST_2) { - BIF_RET(cmp_eq(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); + BIF_RET(CMP_EQ(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); } BIF_RETTYPE sneq_2(BIF_ALIST_2) @@ -124,7 +124,7 @@ BIF_RETTYPE sneq_2(BIF_ALIST_2) BIF_RETTYPE sneqeq_2(BIF_ALIST_2) { - BIF_RET(cmp_ne(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); + BIF_RET(CMP_NE(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); } BIF_RETTYPE is_atom_1(BIF_ALIST_1) @@ -258,7 +258,7 @@ Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2) BIF_RET(am_true); } } else if (is_export(arg1)) { - Export* exp = (Export *) EXPAND_POINTER((export_val(arg1))[1]); + Export* exp = (Export *) (export_val(arg1)[1]); if (exp->code[2] == (Uint) arity) { BIF_RET(am_true); diff --git a/erts/emulator/beam/erl_bif_os.c b/erts/emulator/beam/erl_bif_os.c index 2333ca0851..46777d3aa5 100644 --- a/erts/emulator/beam/erl_bif_os.c +++ b/erts/emulator/beam/erl_bif_os.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2012. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c index 27c24197ea..37f4e1de49 100644 --- a/erts/emulator/beam/erl_bif_port.c +++ b/erts/emulator/beam/erl_bif_port.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -41,6 +41,7 @@ #include "external.h" #include "packet_parser.h" #include "erl_bits.h" +#include "erl_bif_unique.h" #include "dtrace-wrapper.h" static Port *open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump); @@ -50,10 +51,10 @@ static void free_args(char **); char *erts_default_arg0 = "default"; -BIF_RETTYPE open_port_2(BIF_ALIST_2) +BIF_RETTYPE erts_internal_open_port_2(BIF_ALIST_2) { Port *port; - Eterm port_id; + Eterm res; char *str; int err_type, err_num; @@ -61,27 +62,63 @@ BIF_RETTYPE open_port_2(BIF_ALIST_2) if (!port) { if (err_type == -3) { ASSERT(err_num == BADARG || err_num == SYSTEM_LIMIT); - BIF_ERROR(BIF_P, err_num); + if (err_num == BADARG) + res = am_badarg; + else if (err_num == SYSTEM_LIMIT) + res = am_system_limit; + else + /* this is only here to silence gcc, it should not happen */ + BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); } else if (err_type == -2) { str = erl_errno_id(err_num); + res = erts_atom_put((byte *) str, strlen(str), ERTS_ATOM_ENC_LATIN1, 1); } else { - str = "einval"; + res = am_einval; } - BIF_P->fvalue = erts_atom_put((byte *) str, strlen(str), ERTS_ATOM_ENC_LATIN1, 1); - BIF_ERROR(BIF_P, EXC_ERROR); + BIF_RET(res); } - erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK); + if (port->drv_ptr->flags & ERL_DRV_FLAG_USE_INIT_ACK) { + + /* Copied from erl_port_task.c */ + port->async_open_port = erts_alloc(ERTS_ALC_T_PRTSD, + sizeof(*port->async_open_port)); + erts_make_ref_in_array(port->async_open_port->ref); + port->async_open_port->to = BIF_P->common.id; + + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCKS_MSG_RECEIVE | ERTS_PROC_LOCK_LINK); + if (ERTS_PROC_PENDING_EXIT(BIF_P)) { + /* need to exit caller instead */ + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_MSG_RECEIVE | ERTS_PROC_LOCK_LINK); + KILL_CATCHES(BIF_P); + BIF_P->freason = EXC_EXIT; + erts_port_release(port); + BIF_RET(am_badarg); + } + + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(BIF_P); + BIF_P->msg.save = BIF_P->msg.last; + + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_MSG_RECEIVE); + + res = erts_proc_store_ref(BIF_P, port->async_open_port->ref); + } else { + res = port->common.id; + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK); + } - port_id = port->common.id; erts_add_link(&ERTS_P_LINKS(port), LINK_PID, BIF_P->common.id); - erts_add_link(&ERTS_P_LINKS(BIF_P), LINK_PID, port_id); + erts_add_link(&ERTS_P_LINKS(BIF_P), LINK_PID, port->common.id); + + if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS)) + trace_proc(BIF_P, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK, BIF_P, + am_link, port->common.id); erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); erts_port_release(port); - BIF_RET(port_id); + BIF_RET(res); } static ERTS_INLINE Port * @@ -307,8 +344,7 @@ BIF_RETTYPE erts_internal_port_close_1(BIF_ALIST_1) if (!prt) BIF_RET(am_badarg); - - switch (erts_port_exit(BIF_P, 0, prt, prt->common.id, am_normal, &ref)) { + switch (erts_port_exit(BIF_P, 0, prt, BIF_P->common.id, am_normal, &ref)) { case ERTS_PORT_OP_CALLER_EXIT: case ERTS_PORT_OP_BADARG: case ERTS_PORT_OP_DROPPED: @@ -341,7 +377,7 @@ BIF_RETTYPE erts_internal_port_connect_2(BIF_ALIST_2) ref = NIL; #endif - switch (erts_port_connect(BIF_P, 0, prt, prt->common.id, BIF_ARG_2, &ref)) { + switch (erts_port_connect(BIF_P, 0, prt, BIF_P->common.id, BIF_ARG_2, &ref)) { case ERTS_PORT_OP_CALLER_EXIT: case ERTS_PORT_OP_BADARG: case ERTS_PORT_OP_DROPPED: @@ -617,7 +653,7 @@ BIF_RETTYPE port_get_data_1(BIF_ALIST_1) static Port * open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) { - int i; + Sint i; Eterm option; Uint arity; Eterm* tp; @@ -879,7 +915,7 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) } if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { - trace_virtual_sched(p, am_out); + trace_sched(p, ERTS_PROC_LOCK_MAIN, am_out); } @@ -896,21 +932,22 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) DTRACE3(port_open, process_str, name_buf, port_str); } #endif + + if (port && IS_TRACED_FL(port, F_TRACE_PORTS)) + trace_port(port, am_getting_linked, p->common.id); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { + trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in); + } + if (!port) { DEBUGF(("open_driver returned (%d:%d)\n", err_typep ? *err_typep : 4711, err_nump ? *err_nump : 4711)); - if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { - trace_virtual_sched(p, am_in); - } goto do_return; } - - if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { - trace_virtual_sched(p, am_in); - } if (linebuf && port->linebuf == NULL){ port->linebuf = allocate_linebuf(linebuf); @@ -945,14 +982,16 @@ static char **convert_args(Eterm l) { char **pp; char *b; - int n; - int i = 0; + Sint n; + Sint i = 0; Eterm str; if (is_not_list(l) && is_not_nil(l)) { return NULL; } n = erts_list_length(l); + if (n < 0) + return NULL; /* We require at least one element in argv[0] + NULL at end */ pp = erts_alloc(ERTS_ALC_T_TMP, (n + 2) * sizeof(char **)); pp[i++] = erts_default_arg0; @@ -992,7 +1031,7 @@ static byte* convert_environment(Process* p, Eterm env) Eterm* temp_heap; Eterm* hp; Uint heap_size; - int n; + Sint n; Sint size; byte* bytes; int encoding = erts_get_native_filename_encoding(); diff --git a/erts/emulator/beam/erl_bif_re.c b/erts/emulator/beam/erl_bif_re.c index 86951f32b0..f4daecd2a4 100644 --- a/erts/emulator/beam/erl_bif_re.c +++ b/erts/emulator/beam/erl_bif_re.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2013. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -100,7 +100,7 @@ Sint erts_re_set_loop_limit(Sint limit) static int term_to_int(Eterm term, int *sp) { -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) if (is_small(term)) { Uint x = signed_val(term); @@ -151,7 +151,7 @@ static int term_to_int(Eterm term, int *sp) static Eterm make_signed_integer(int x, Process *p) { -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) return make_small(x); #else Eterm* hp; diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index 08807d72c9..ff2018aa27 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2013. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -52,7 +52,7 @@ static int erts_default_trace_pattern_is_on; static Binary *erts_default_match_spec; static Binary *erts_default_meta_match_spec; static struct trace_pattern_flags erts_default_trace_pattern_flags; -static Eterm erts_default_meta_tracer_pid; +static ErtsTracer erts_default_meta_tracer; static struct { /* Protected by code write permission */ int current; @@ -75,8 +75,6 @@ static BIF_RETTYPE system_monitor(Process *p, Eterm monitor_pid, Eterm list); static void new_seq_trace_token(Process* p); /* help func for seq_trace_2*/ -static int already_traced(Process *p, Process *tracee_p, Eterm tracer); -static int port_already_traced(Process *p, Port *tracee_port, Eterm tracer); static Eterm trace_info_pid(Process* p, Eterm pid_spec, Eterm key); static Eterm trace_info_func(Process* p, Eterm pid_spec, Eterm key); static Eterm trace_info_on_load(Process* p, Eterm key); @@ -94,21 +92,15 @@ erts_bif_trace_init(void) erts_default_match_spec = NULL; erts_default_meta_match_spec = NULL; erts_default_trace_pattern_flags = erts_trace_pattern_flags_off; - erts_default_meta_tracer_pid = NIL; + erts_default_meta_tracer = erts_tracer_nil; } /* * Turn on/off call tracing for the given function(s). */ - -Eterm -trace_pattern_2(BIF_ALIST_2) -{ - return trace_pattern(BIF_P, BIF_ARG_1, BIF_ARG_2, NIL); -} Eterm -trace_pattern_3(BIF_ALIST_3) +erts_internal_trace_pattern_3(BIF_ALIST_3) { return trace_pattern(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); } @@ -125,11 +117,10 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) Eterm l; struct trace_pattern_flags flags = erts_trace_pattern_flags_off; int is_global; - Process *meta_tracer_proc = p; - Eterm meta_tracer_pid = p->common.id; + ErtsTracer meta_tracer = erts_tracer_nil; if (!erts_try_seize_code_write_permission(p)) { - ERTS_BIF_YIELD3(bif_export[BIF_trace_pattern_3], p, MFA, Pattern, flaglist); + ERTS_BIF_YIELD3(bif_export[BIF_erts_internal_trace_pattern_3], p, MFA, Pattern, flaglist); } finish_bp.current = -1; @@ -160,31 +151,11 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) is_global = 0; for(l = flaglist; is_list(l); l = CDR(list_val(l))) { if (is_tuple(CAR(list_val(l)))) { - Eterm *tp = tuple_val(CAR(list_val(l))); - - if (arityval(tp[0]) != 2 || tp[1] != am_meta) { - goto error; - } - meta_tracer_pid = tp[2]; - if (is_internal_pid(meta_tracer_pid)) { - meta_tracer_proc = erts_pid2proc(NULL, 0, meta_tracer_pid, 0); - if (!meta_tracer_proc) { - goto error; - } - } else if (is_internal_port(meta_tracer_pid)) { - Port *meta_tracer_port; - meta_tracer_proc = NULL; - meta_tracer_port = (erts_port_lookup( - meta_tracer_pid, - ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP)); - if (!meta_tracer_port) - goto error; - } else { - goto error; - } - if (is_global) { - goto error; - } + meta_tracer = erts_term_to_tracer(am_meta, CAR(list_val(l))); + if (meta_tracer == THE_NON_VALUE) { + meta_tracer = erts_tracer_nil; + goto error; + } flags.breakpoint = 1; flags.meta = 1; } else { @@ -202,6 +173,8 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) } flags.breakpoint = 1; flags.meta = 1; + if (ERTS_TRACER_IS_NIL(meta_tracer)) + meta_tracer = erts_term_to_tracer(THE_NON_VALUE, p->common.id); break; case am_global: if (flags.breakpoint) { @@ -252,14 +225,11 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) MatchSetUnref(erts_default_meta_match_spec); erts_default_meta_match_spec = match_prog_set; MatchSetRef(erts_default_meta_match_spec); - erts_default_meta_tracer_pid = meta_tracer_pid; - if (meta_tracer_proc) { - ERTS_TRACE_FLAGS(meta_tracer_proc) |= F_TRACER; - } + erts_tracer_update(&erts_default_meta_tracer, meta_tracer); } else if (! flags.breakpoint) { MatchSetUnref(erts_default_meta_match_spec); erts_default_meta_match_spec = NULL; - erts_default_meta_tracer_pid = NIL; + ERTS_TRACER_CLEAR(&erts_default_meta_tracer); } if (erts_default_trace_pattern_flags.breakpoint && flags.breakpoint) { @@ -340,20 +310,18 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) if (is_small(mfa[2])) { mfa[2] = signed_val(mfa[2]); } - - if (meta_tracer_proc) { - ERTS_TRACE_FLAGS(meta_tracer_proc) |= F_TRACER; - } matches = erts_set_trace_pattern(p, mfa, specified, match_prog_set, match_prog_set, - on, flags, meta_tracer_pid, 0); + on, flags, meta_tracer, 0); } error: MatchSetUnref(match_prog_set); UnUseTmpHeap(3,p); + ERTS_TRACER_CLEAR(&meta_tracer); + #ifdef ERTS_SMP if (finish_bp.current >= 0) { ASSERT(matches >= 0); @@ -404,7 +372,7 @@ erts_get_default_trace_pattern(int *trace_pattern_is_on, Binary **match_spec, Binary **meta_match_spec, struct trace_pattern_flags *trace_pattern_flags, - Eterm *meta_tracer_pid) + ErtsTracer *meta_tracer) { ERTS_SMP_LC_ASSERT(erts_has_code_write_permission() || erts_smp_thr_progress_is_blocking()); @@ -416,8 +384,8 @@ erts_get_default_trace_pattern(int *trace_pattern_is_on, *meta_match_spec = erts_default_meta_match_spec; if (trace_pattern_flags) *trace_pattern_flags = erts_default_trace_pattern_flags; - if (meta_tracer_pid) - *meta_tracer_pid = erts_default_meta_tracer_pid; + if (meta_tracer) + *meta_tracer = erts_default_meta_tracer; } int erts_is_default_trace_enabled(void) @@ -465,12 +433,12 @@ erts_trace_flag2bit(Eterm flag) ** occurred in the argument list. */ int -erts_trace_flags(Eterm List, - Uint *pMask, Eterm *pTracer, int *pCpuTimestamp) +erts_trace_flags(Eterm List, + Uint *pMask, ErtsTracer *pTracer, int *pCpuTimestamp) { Eterm list = List; Uint mask = 0; - Eterm tracer = NIL; + ErtsTracer tracer = erts_tracer_nil; int cpu_timestamp = 0; while (is_list(list)) { @@ -483,33 +451,73 @@ erts_trace_flags(Eterm List, cpu_timestamp = !0; #endif } else if (is_tuple(item)) { - Eterm* tp = tuple_val(item); - - if (arityval(tp[0]) != 2 || tp[1] != am_tracer) goto error; - if (is_internal_pid(tp[2]) || is_internal_port(tp[2])) { - tracer = tp[2]; - } else goto error; + tracer = erts_term_to_tracer(am_tracer, item); + if (tracer == THE_NON_VALUE) + goto error; } else goto error; list = CDR(list_val(list)); } if (is_not_nil(list)) goto error; - if (pMask && mask) *pMask = mask; - if (pTracer && tracer != NIL) *pTracer = tracer; - if (pCpuTimestamp && cpu_timestamp) *pCpuTimestamp = cpu_timestamp; + if (pMask && mask) *pMask = mask; + if (pTracer && !ERTS_TRACER_IS_NIL(tracer)) *pTracer = tracer; + if (pCpuTimestamp && cpu_timestamp) *pCpuTimestamp = cpu_timestamp; return !0; error: return 0; } -Eterm trace_3(BIF_ALIST_3) +static ERTS_INLINE int +start_trace(Process *c_p, ErtsTracer tracer, + ErtsPTabElementCommon *common, + int on, int mask) +{ + /* We can use the common part of both port+proc without checking what it is + In the code below port is used for both proc and port */ + Port *port = (Port*)common; + + /* + * SMP build assumes that either system is blocked or: + * * main lock is held on c_p + * * all locks are held on port common + */ + + if (!ERTS_TRACER_IS_NIL(tracer)) { + if ((ERTS_TRACE_FLAGS(port) & TRACEE_FLAGS) + && !ERTS_TRACER_COMPARE(ERTS_TRACER(port), tracer)) { + /* This tracee is already being traced, and not by the + * tracer to be */ + if (erts_is_tracer_proc_enabled(c_p, ERTS_PROC_LOCKS_ALL, + common, am_trace_status)) { + /* The tracer is still in use */ + return 1; + } + /* Current tracer now invalid */ + } + } + + if (on) + ERTS_TRACE_FLAGS(port) |= mask; + else + ERTS_TRACE_FLAGS(port) &= ~mask; + + if ((ERTS_TRACE_FLAGS(port) & TRACEE_FLAGS) == 0) { + tracer = erts_tracer_nil; + erts_tracer_replace(common, erts_tracer_nil); + } else if (!ERTS_TRACER_IS_NIL(tracer)) + erts_tracer_replace(common, tracer); + + return 0; +} + +Eterm erts_internal_trace_3(BIF_ALIST_3) { Process* p = BIF_P; Eterm pid_spec = BIF_ARG_1; Eterm how = BIF_ARG_2; Eterm list = BIF_ARG_3; int on; - Eterm tracer = NIL; + ErtsTracer tracer = erts_tracer_nil; int matches = 0; Uint mask = 0; int cpu_ts = 0; @@ -522,41 +530,24 @@ Eterm trace_3(BIF_ALIST_3) } if (!erts_try_seize_code_write_permission(BIF_P)) { - ERTS_BIF_YIELD3(bif_export[BIF_trace_3], BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + ERTS_BIF_YIELD3(bif_export[BIF_erts_internal_trace_3], + BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); } - if (is_nil(tracer) || is_internal_pid(tracer)) { - Process *tracer_proc = erts_pid2proc(p, - ERTS_PROC_LOCK_MAIN, - is_nil(tracer) ? p->common.id : tracer, - ERTS_PROC_LOCKS_ALL); - if (!tracer_proc) - goto error; - ERTS_TRACE_FLAGS(tracer_proc) |= F_TRACER; - erts_smp_proc_unlock(tracer_proc, - (tracer_proc == p - ? ERTS_PROC_LOCKS_ALL_MINOR - : ERTS_PROC_LOCKS_ALL)); - } else if (is_internal_port(tracer)) { - Port *tracer_port = erts_id2port_sflgs(tracer, - p, - ERTS_PROC_LOCK_MAIN, - ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP); - if (!tracer_port) - goto error; - ERTS_TRACE_FLAGS(tracer_port) |= F_TRACER; - erts_port_release(tracer_port); - } else - goto error; - switch (how) { case am_false: on = 0; break; case am_true: on = 1; - if (is_nil(tracer)) - tracer = p->common.id; + if (ERTS_TRACER_IS_NIL(tracer)) + tracer = erts_term_to_tracer(am_tracer, p->common.id); + + if (tracer == THE_NON_VALUE) { + tracer = erts_tracer_nil; + goto error; + } + break; default: goto error; @@ -575,34 +566,20 @@ Eterm trace_3(BIF_ALIST_3) } #endif - if (pid_spec == tracer) - goto error; - tracee_port = erts_id2port_sflgs(pid_spec, p, ERTS_PROC_LOCK_MAIN, ERTS_PORT_SFLGS_INVALID_LOOKUP); + if (!tracee_port) goto error; - - if (tracer != NIL && port_already_traced(p, tracee_port, tracer)) { + + if (start_trace(p, tracer, &tracee_port->common, on, mask)) { erts_port_release(tracee_port); goto already_traced; - } - - if (on) - ERTS_TRACE_FLAGS(tracee_port) |= mask; - else - ERTS_TRACE_FLAGS(tracee_port) &= ~mask; - - if (!ERTS_TRACE_FLAGS(tracee_port)) - ERTS_TRACER_PROC(tracee_port) = NIL; - else if (tracer != NIL) - ERTS_TRACER_PROC(tracee_port) = tracer; - - erts_port_release(tracee_port); - - matches = 1; + } + erts_port_release(tracee_port); + matches = 1; } else if (is_pid(pid_spec)) { Process *tracee_p; @@ -615,33 +592,19 @@ Eterm trace_3(BIF_ALIST_3) * and not about to be tracing. */ - if (pid_spec == tracer) - goto error; - tracee_p = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, pid_spec, ERTS_PROC_LOCKS_ALL); if (!tracee_p) goto error; - if (tracer != NIL && already_traced(p, tracee_p, tracer)) { + if (start_trace(tracee_p, tracer, &tracee_p->common, on, mask)) { erts_smp_proc_unlock(tracee_p, (tracee_p == p ? ERTS_PROC_LOCKS_ALL_MINOR : ERTS_PROC_LOCKS_ALL)); goto already_traced; - } - - if (on) - ERTS_TRACE_FLAGS(tracee_p) |= mask; - else - ERTS_TRACE_FLAGS(tracee_p) &= ~mask; - - if ((ERTS_TRACE_FLAGS(tracee_p) & TRACEE_FLAGS) == 0) - ERTS_TRACER_PROC(tracee_p) = NIL; - else if (tracer != NIL) - ERTS_TRACER_PROC(tracee_p) = tracer; - - erts_smp_proc_unlock(tracee_p, + } + erts_smp_proc_unlock(tracee_p, (tracee_p == p ? ERTS_PROC_LOCKS_ALL_MINOR : ERTS_PROC_LOCKS_ALL)); @@ -692,18 +655,27 @@ Eterm trace_3(BIF_ALIST_3) } #endif - if (pid_spec == am_all || pid_spec == am_existing) { + if (pid_spec == am_all || pid_spec == am_existing || + pid_spec == am_ports || pid_spec == am_processes || + pid_spec == am_existing_ports || pid_spec == am_existing_processes + ) { int i; int procs = 0; int ports = 0; int mods = 0; if (mask & (ERTS_PROC_TRACEE_FLAGS & ~ERTS_TRACEE_MODIFIER_FLAGS)) - procs = 1; + procs = pid_spec != am_ports && pid_spec != am_existing_ports; if (mask & (ERTS_PORT_TRACEE_FLAGS & ~ERTS_TRACEE_MODIFIER_FLAGS)) - ports = 1; - if (mask & ERTS_TRACEE_MODIFIER_FLAGS) - mods = 1; + ports = pid_spec != am_processes && pid_spec != am_existing_processes; + if (mask & ERTS_TRACEE_MODIFIER_FLAGS) { + if (pid_spec == am_ports || pid_spec == am_existing_ports) + ports = 1; + else if (pid_spec == am_processes || pid_spec == am_existing_processes) + procs = 1; + else + mods = 1; + } #ifdef ERTS_SMP erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); @@ -719,22 +691,7 @@ Eterm trace_3(BIF_ALIST_3) Process* tracee_p = erts_pix2proc(i); if (! tracee_p) continue; - if (tracer != NIL) { - if (tracee_p->common.id == tracer) - continue; - if (already_traced(NULL, tracee_p, tracer)) - continue; - } - if (on) { - ERTS_TRACE_FLAGS(tracee_p) |= mask; - } else { - ERTS_TRACE_FLAGS(tracee_p) &= ~mask; - } - if(!(ERTS_TRACE_FLAGS(tracee_p) & TRACEE_FLAGS)) { - ERTS_TRACER_PROC(tracee_p) = NIL; - } else if (tracer != NIL) { - ERTS_TRACER_PROC(tracee_p) = tracer; - } + start_trace(p, tracer, &tracee_p->common, on, mask); matches++; } } @@ -749,33 +706,26 @@ Eterm trace_3(BIF_ALIST_3) state = erts_atomic32_read_nob(&tracee_port->state); if (state & ERTS_PORT_SFLGS_DEAD) continue; - if (tracer != NIL) { - if (tracee_port->common.id == tracer) - continue; - if (port_already_traced(NULL, tracee_port, tracer)) - continue; - } - - if (on) ERTS_TRACE_FLAGS(tracee_port) |= mask; - else ERTS_TRACE_FLAGS(tracee_port) &= ~mask; - - if (!(ERTS_TRACE_FLAGS(tracee_port) & TRACEE_FLAGS)) { - ERTS_TRACER_PROC(tracee_port) = NIL; - } else if (tracer != NIL) { - ERTS_TRACER_PROC(tracee_port) = tracer; - } - /* matches are not counted for ports since it would violate compatibility */ - /* This could be a reason to modify this function or make a new one. */ + start_trace(p, tracer, &tracee_port->common, on, mask); + matches++; } } } - if (pid_spec == am_all || pid_spec == am_new) { - Uint def_flags = mask; - Eterm def_tracer = tracer; + if (pid_spec == am_all || pid_spec == am_new + || pid_spec == am_ports || pid_spec == am_processes + || pid_spec == am_new_ports || pid_spec == am_new_processes + ) { ok = 1; - erts_change_default_tracing(on, &def_flags, &def_tracer); + if (mask & ERTS_PROC_TRACEE_FLAGS && + pid_spec != am_ports && pid_spec != am_new_ports) + erts_change_default_proc_tracing( + on, mask & ERTS_PROC_TRACEE_FLAGS, tracer); + if (mask & ERTS_PORT_TRACEE_FLAGS && + pid_spec != am_processes && pid_spec != am_new_processes) + erts_change_default_port_tracing( + on, mask & ERTS_PORT_TRACEE_FLAGS, tracer); #ifdef HAVE_ERTS_NOW_CPU if (cpu_ts && !on) { @@ -801,6 +751,7 @@ Eterm trace_3(BIF_ALIST_3) } #endif erts_release_code_write_permission(); + ERTS_TRACER_CLEAR(&tracer); BIF_RET(make_small(matches)); @@ -810,6 +761,8 @@ Eterm trace_3(BIF_ALIST_3) error: + ERTS_TRACER_CLEAR(&tracer); + #ifdef ERTS_SMP if (system_blocked) { erts_smp_thr_progress_unblock(); @@ -821,88 +774,6 @@ Eterm trace_3(BIF_ALIST_3) BIF_ERROR(p, BADARG); } -/* Check that the process to be traced is not already traced - * by a valid other tracer than the tracer to be. - */ -static int port_already_traced(Process *c_p, Port *tracee_port, Eterm tracer) -{ - /* - * SMP build assumes that either system is blocked or: - * * main lock is held on c_p - * * all locks are held on port tracee_p - */ - if ((ERTS_TRACE_FLAGS(tracee_port) & TRACEE_FLAGS) - && ERTS_TRACER_PROC(tracee_port) != tracer) { - /* This tracee is already being traced, and not by the - * tracer to be */ - if (is_internal_port(ERTS_TRACER_PROC(tracee_port))) { - if (!erts_is_valid_tracer_port(ERTS_TRACER_PROC(tracee_port))) { - /* Current trace port now invalid - * - discard it and approve the new. */ - goto remove_tracer; - } else - return 1; - } - else if(is_internal_pid(ERTS_TRACER_PROC(tracee_port))) { - Process *tracer_p = erts_proc_lookup(ERTS_TRACER_PROC(tracee_port)); - if (!tracer_p) { - /* Current trace process now invalid - * - discard it and approve the new. */ - goto remove_tracer; - } else - return 1; - } - else { - remove_tracer: - ERTS_TRACE_FLAGS(tracee_port) &= ~TRACEE_FLAGS; - ERTS_TRACER_PROC(tracee_port) = NIL; - } - } - return 0; -} - -/* Check that the process to be traced is not already traced - * by a valid other tracer than the tracer to be. - */ -static int already_traced(Process *c_p, Process *tracee_p, Eterm tracer) -{ - /* - * SMP build assumes that either system is blocked or: - * * main lock is held on c_p - * * all locks multiple are held on tracee_p - */ - if ((ERTS_TRACE_FLAGS(tracee_p) & TRACEE_FLAGS) - && ERTS_TRACER_PROC(tracee_p) != tracer) { - /* This tracee is already being traced, and not by the - * tracer to be */ - if (is_internal_port(ERTS_TRACER_PROC(tracee_p))) { - if (!erts_is_valid_tracer_port(ERTS_TRACER_PROC(tracee_p))) { - /* Current trace port now invalid - * - discard it and approve the new. */ - goto remove_tracer; - } else - return 1; - } - else if(is_internal_pid(ERTS_TRACER_PROC(tracee_p))) { - Process *tracer_p; - - tracer_p = erts_proc_lookup(ERTS_TRACER_PROC(tracee_p)); - if (!tracer_p) { - /* Current trace process now invalid - * - discard it and approve the new. */ - goto remove_tracer; - } else - return 1; - } - else { - remove_tracer: - ERTS_TRACE_FLAGS(tracee_p) &= ~TRACEE_FLAGS; - ERTS_TRACER_PROC(tracee_p) = NIL; - } - } - return 0; -} - /* * Return information about a process or an external function being traced. */ @@ -920,7 +791,7 @@ Eterm trace_info_2(BIF_ALIST_2) if (What == am_on_load) { res = trace_info_on_load(p, Key); - } else if (is_atom(What) || is_pid(What)) { + } else if (is_atom(What) || is_pid(What) || is_port(What)) { res = trace_info_pid(p, What, Key); } else if (is_tuple(What)) { res = trace_info_func(p, What, Key); @@ -936,41 +807,52 @@ static Eterm trace_info_pid(Process* p, Eterm pid_spec, Eterm key) { Eterm tracer; - Uint trace_flags; + Uint trace_flags = am_false; Eterm* hp; - if (pid_spec == am_new) { - erts_get_default_tracing(&trace_flags, &tracer); + if (pid_spec == am_new || pid_spec == am_new_processes) { + ErtsTracer def_tracer; + erts_get_default_proc_tracing(&trace_flags, &def_tracer); + tracer = erts_tracer_to_term(p, def_tracer); + ERTS_TRACER_CLEAR(&def_tracer); + } else if (pid_spec == am_new_ports) { + ErtsTracer def_tracer; + erts_get_default_port_tracing(&trace_flags, &def_tracer); + tracer = erts_tracer_to_term(p, def_tracer); + ERTS_TRACER_CLEAR(&def_tracer); + } else if (is_internal_port(pid_spec)) { + Port *tracee; + tracee = erts_id2port_sflgs(pid_spec, p, ERTS_PROC_LOCK_MAIN, + ERTS_PORT_SFLGS_INVALID_LOOKUP); + + if (!tracee) + return am_undefined; + + if (!ERTS_TRACER_IS_NIL(ERTS_TRACER(tracee))) + erts_is_tracer_proc_enabled(NULL, 0, &tracee->common, am_trace_status); + + tracer = erts_tracer_to_term(p, ERTS_TRACER(tracee)); + trace_flags = ERTS_TRACE_FLAGS(tracee); + + erts_port_release(tracee); + } else if (is_internal_pid(pid_spec)) { Process *tracee; tracee = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, - pid_spec, ERTS_PROC_LOCKS_ALL); + pid_spec, ERTS_PROC_LOCK_MAIN); - if (!tracee) { + if (!tracee) return am_undefined; - } else { - tracer = ERTS_TRACER_PROC(tracee); - trace_flags = ERTS_TRACE_FLAGS(tracee); - } - if (is_internal_pid(tracer)) { - if (!erts_proc_lookup(tracer)) { - reset_tracer: - ERTS_TRACE_FLAGS(tracee) &= ~TRACEE_FLAGS; - trace_flags = ERTS_TRACE_FLAGS(tracee); - tracer = ERTS_TRACER_PROC(tracee) = NIL; - } - } - else if (is_internal_port(tracer)) { - if (!erts_is_valid_tracer_port(tracer)) - goto reset_tracer; - } -#ifdef ERTS_SMP - erts_smp_proc_unlock(tracee, - (tracee == p - ? ERTS_PROC_LOCKS_ALL_MINOR - : ERTS_PROC_LOCKS_ALL)); -#endif + if (!ERTS_TRACER_IS_NIL(ERTS_TRACER(tracee))) + erts_is_tracer_proc_enabled(tracee, ERTS_PROC_LOCK_MAIN, + &tracee->common, am_trace_status); + + tracer = erts_tracer_to_term(p, ERTS_TRACER(tracee)); + trace_flags = ERTS_TRACE_FLAGS(tracee); + + if (tracee != p) + erts_smp_proc_unlock(tracee, ERTS_PROC_LOCK_MAIN); } else if (is_external_pid(pid_spec) && external_pid_dist_entry(pid_spec) == erts_this_dist_entry) { return am_undefined; @@ -1024,8 +906,10 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key) HRelease(p,limit,hp+3); return TUPLE2(hp, key, flag_list); } else if (key == am_tracer) { - hp = HAlloc(p, 3); - return TUPLE2(hp, key, tracer); /* Local pid or port */ + if (tracer == am_false) + tracer = NIL; + hp = HAlloc(p, 3); + return TUPLE2(hp, key, tracer); } else { goto error; } @@ -1054,11 +938,11 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key) */ static int function_is_traced(Process *p, Eterm mfa[3], - Binary **ms, /* out */ - Binary **ms_meta, /* out */ - Eterm *tracer_pid_meta, /* out */ - Uint *count, /* out */ - Eterm *call_time) /* out */ + Binary **ms, /* out */ + Binary **ms_meta, /* out */ + ErtsTracer *tracer_pid_meta, /* out */ + Uint *count, /* out */ + Eterm *call_time) /* out */ { Export e; Export* ep; @@ -1123,7 +1007,7 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) Eterm traced = am_false; Eterm match_spec = am_false; Eterm retval = am_false; - Eterm meta = am_false; + ErtsTracer meta = erts_tracer_nil; Eterm call_time = NIL; int r; @@ -1193,7 +1077,10 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) retval = match_spec; break; case am_meta: - retval = meta; + retval = erts_tracer_to_term(p, meta); + if (retval == am_false) + /* backwards compatibility */ + retval = NIL; break; case am_meta_match_spec: if (r & FUNC_TRACE_META_TRACE) { @@ -1216,7 +1103,8 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) } break; case am_all: { - Eterm match_spec_meta = am_false, c = am_false, t, ct = am_false; + Eterm match_spec_meta = am_false, c = am_false, t, ct = am_false, + m = am_false; if (ms) { match_spec = MatchSetGetSource(ms); @@ -1235,6 +1123,9 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) if (r & FUNC_TRACE_TIME_TRACE) { ct = call_time; } + + m = erts_tracer_to_term(p, meta); + hp = HAlloc(p, (3+2)*6); retval = NIL; t = TUPLE2(hp, am_call_count, c); hp += 3; @@ -1243,7 +1134,7 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) retval = CONS(hp, t, retval); hp += 2; t = TUPLE2(hp, am_meta_match_spec, match_spec_meta); hp += 3; retval = CONS(hp, t, retval); hp += 2; - t = TUPLE2(hp, am_meta, meta); hp += 3; + t = TUPLE2(hp, am_meta, m); hp += 3; retval = CONS(hp, t, retval); hp += 2; t = TUPLE2(hp, am_match_spec, match_spec); hp += 3; retval = CONS(hp, t, retval); hp += 2; @@ -1306,7 +1197,8 @@ trace_info_on_load(Process* p, Eterm key) case am_meta: hp = HAlloc(p, 3); if (erts_default_trace_pattern_flags.meta) { - return TUPLE2(hp, key, erts_default_meta_tracer_pid); + ASSERT(!ERTS_TRACER_IS_NIL(erts_default_meta_tracer)); + return TUPLE2(hp, key, erts_tracer_to_term(p, erts_default_meta_tracer)); } else { return TUPLE2(hp, key, am_false); } @@ -1345,7 +1237,7 @@ trace_info_on_load(Process* p, Eterm key) } case am_all: { - Eterm match_spec = am_false, meta_match_spec = am_false, r = NIL, t; + Eterm match_spec = am_false, meta_match_spec = am_false, r = NIL, t, m; if (erts_default_trace_pattern_flags.local || (! erts_default_trace_pattern_flags.breakpoint)) { @@ -1363,6 +1255,8 @@ trace_info_on_load(Process* p, Eterm key) MatchSetGetSource(erts_default_meta_match_spec); meta_match_spec = copy_object(meta_match_spec, p); } + m = (erts_default_trace_pattern_flags.meta + ? erts_tracer_to_term(p, erts_default_meta_tracer) : am_false); hp = HAlloc(p, (3+2)*5 + 3); t = TUPLE2(hp, am_call_count, (erts_default_trace_pattern_flags.call_count @@ -1370,9 +1264,7 @@ trace_info_on_load(Process* p, Eterm key) r = CONS(hp, t, r); hp += 2; t = TUPLE2(hp, am_meta_match_spec, meta_match_spec); hp += 3; r = CONS(hp, t, r); hp += 2; - t = TUPLE2(hp, am_meta, - (erts_default_trace_pattern_flags.meta - ? erts_default_meta_tracer_pid : am_false)); hp += 3; + t = TUPLE2(hp, am_meta, m); hp += 3; r = CONS(hp, t, r); hp += 2; t = TUPLE2(hp, am_match_spec, match_spec); hp += 3; r = CONS(hp, t, r); hp += 2; @@ -1397,7 +1289,7 @@ int erts_set_trace_pattern(Process*p, Eterm* mfa, int specified, Binary* match_prog_set, Binary *meta_match_prog_set, int on, struct trace_pattern_flags flags, - Eterm meta_tracer_pid, int is_blocking) + ErtsTracer meta_tracer, int is_blocking) { const ErtsCodeIndex code_ix = erts_active_code_ix(); int matches = 0; @@ -1487,7 +1379,7 @@ erts_set_trace_pattern(Process*p, Eterm* mfa, int specified, } if (flags.meta) { erts_set_mtrace_bif(pc, meta_match_prog_set, - meta_tracer_pid); + meta_tracer); m = 1; } if (flags.call_time) { @@ -1527,7 +1419,7 @@ erts_set_trace_pattern(Process*p, Eterm* mfa, int specified, } if (flags.meta) { erts_set_mtrace_break(&finish_bp.f, meta_match_prog_set, - meta_tracer_pid); + meta_tracer); } if (flags.call_count) { erts_set_count_break(&finish_bp.f, on); @@ -1887,11 +1779,7 @@ new_seq_trace_token(Process* p) { Eterm* hp; - if (SEQ_TRACE_TOKEN(p) == NIL -#ifdef USE_VM_PROBES - || SEQ_TRACE_TOKEN(p) == am_have_dt_utag -#endif - ) { + if (have_no_seqtrace(SEQ_TRACE_TOKEN(p))) { hp = HAlloc(p, 6); SEQ_TRACE_TOKEN(p) = TUPLE5(hp, make_small(0), /* Flags */ make_small(0), /* Label */ @@ -1911,12 +1799,8 @@ BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item) BIF_ERROR(p, BADARG); } - if (SEQ_TRACE_TOKEN(p) == NIL -#ifdef USE_VM_PROBES - || SEQ_TRACE_TOKEN(p) == am_have_dt_utag -#endif - ) { - if ((item == am_send) || (item == am_receive) || + if (have_no_seqtrace(SEQ_TRACE_TOKEN(p))) { + if ((item == am_send) || (item == am_receive) || (item == am_print) || (item == am_timestamp) || (item == am_monotonic_timestamp) || (item == am_strict_monotonic_timestamp)) { @@ -1978,11 +1862,7 @@ BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1) */ BIF_RETTYPE seq_trace_print_1(BIF_ALIST_1) { - if (SEQ_TRACE_TOKEN(BIF_P) == NIL -#ifdef USE_VM_PROBES - || SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag -#endif - ) { + if (have_no_seqtrace(SEQ_TRACE_TOKEN(BIF_P))) { BIF_RET(am_false); } seq_trace_update_send(BIF_P); @@ -2001,11 +1881,7 @@ BIF_RETTYPE seq_trace_print_1(BIF_ALIST_1) */ BIF_RETTYPE seq_trace_print_2(BIF_ALIST_2) { - if (SEQ_TRACE_TOKEN(BIF_P) == NIL -#ifdef USE_VM_PROBES - || SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag -#endif - ) { + if (have_no_seqtrace(SEQ_TRACE_TOKEN(BIF_P))) { BIF_RET(am_false); } if (!(is_atom(BIF_ARG_1) || is_small(BIF_ARG_1))) { @@ -2352,50 +2228,86 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2) } /* End: Trace for System Profiling */ -BIF_RETTYPE -trace_delivered_1(BIF_ALIST_1) +/* Trace delivered send an aux work message to all schedulers + and when all schedulers have acknowledged that they have seen + the message the message is sent to the requesting process. + + IMPORTANT: We have to make sure that the all messages sent + using enif_send have been delivered before we send the message + to the caller. + + There used to be a separate implementation for when only a pid + is passed in, but since this is not performance critical code + we now use the same approach for both. +*/ + +typedef struct { + Process *proc; + Eterm ref; + Eterm ref_heap[REF_THING_SIZE]; + Eterm target; + erts_smp_atomic32_t refc; +} ErtsTraceDeliveredAll; + +static void +reply_trace_delivered_all(void *vtdarp) { - DECL_AM(trace_delivered); -#ifdef ERTS_SMP - ErlHeapFragment *bp; -#else - ErtsProcLocks locks = 0; -#endif - Eterm *hp; - Eterm msg, ref, msg_ref; - Process *p; - if (BIF_ARG_1 == am_all) { - p = NULL; - } else if (! (p = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, - BIF_ARG_1, ERTS_PROC_LOCKS_ALL))) { - if (is_not_internal_pid(BIF_ARG_1)) { - BIF_ERROR(BIF_P, BADARG); - } - } - - ref = erts_make_ref(BIF_P); + ErtsTraceDeliveredAll *tdarp = (ErtsTraceDeliveredAll *) vtdarp; + if (erts_smp_atomic32_dec_read_nob(&tdarp->refc) == 0) { + Eterm ref_copy, msg; + Process *rp = tdarp->proc; + Eterm *hp = NULL; + ErlOffHeap *ohp; #ifdef ERTS_SMP - bp = new_message_buffer(REF_THING_SIZE + 4); - hp = &bp->mem[0]; - msg_ref = STORE_NC(&hp, &bp->off_heap, ref); + ErlHeapFragment *bp; + bp = new_message_buffer(4 + NC_HEAP_SIZE(tdarp->ref)); + hp = &bp->mem[0]; + ohp = &bp->off_heap; #else - hp = HAlloc(BIF_P, 4); - msg_ref = ref; + ErtsProcLocks rp_locks = 0; + ErtsMessage *mp; + mp = erts_alloc_message_heap( + rp, &rp_locks, 4 + NC_HEAP_SIZE(tdarp->ref), &hp, &ohp); #endif - msg = TUPLE3(hp, AM_trace_delivered, BIF_ARG_1, msg_ref); + ref_copy = STORE_NC(&hp, ohp, tdarp->ref); + msg = TUPLE3(hp, am_trace_delivered, tdarp->target, ref_copy); #ifdef ERTS_SMP - erts_send_sys_msg_proc(BIF_P->common.id, BIF_P->common.id, msg, bp); - if (p) - erts_smp_proc_unlock(p, - (BIF_P == p - ? ERTS_PROC_LOCKS_ALL_MINOR - : ERTS_PROC_LOCKS_ALL)); + erts_send_sys_msg_proc(rp->common.id, rp->common.id, msg, bp); #else - erts_send_message(BIF_P, BIF_P, &locks, msg, ERTS_SND_FLG_NO_SEQ_TRACE); + erts_queue_message(rp, &rp_locks, mp, msg); #endif - BIF_RET(ref); + erts_free(ERTS_ALC_T_MISC_AUX_WORK, vtdarp); + erts_proc_dec_refc(rp); + } +} + +BIF_RETTYPE +trace_delivered_1(BIF_ALIST_1) +{ + + if (BIF_ARG_1 == am_all || is_internal_pid(BIF_ARG_1)) { + Eterm *hp, ref; + ErtsTraceDeliveredAll *tdarp = + erts_alloc(ERTS_ALC_T_MISC_AUX_WORK, sizeof(ErtsTraceDeliveredAll)); + + tdarp->proc = BIF_P; + ref = erts_make_ref(BIF_P); + hp = &tdarp->ref_heap[0]; + tdarp->ref = STORE_NC(&hp, NULL, ref); + tdarp->target = BIF_ARG_1; + erts_smp_atomic32_init_nob(&tdarp->refc, + (erts_aint32_t) erts_no_schedulers); + erts_proc_add_refc(BIF_P, 1); + erts_schedule_multi_misc_aux_work(0, + erts_no_schedulers, + reply_trace_delivered_all, + (void *) tdarp); + BIF_RET(ref); + } else { + BIF_ERROR(BIF_P, BADARG); + } } diff --git a/erts/emulator/beam/erl_bif_unique.c b/erts/emulator/beam/erl_bif_unique.c index 5eca09c5a6..1e57e9fa53 100644 --- a/erts/emulator/beam/erl_bif_unique.c +++ b/erts/emulator/beam/erl_bif_unique.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2014. All Rights Reserved. + * Copyright Ericsson AB 2014-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -266,17 +266,19 @@ static ERTS_INLINE Eterm unique_integer_bif(Process *c_p, int positive) } Uint -erts_raw_unique_integer_heap_size(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES]) +erts_raw_unique_integer_heap_size(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES], + int positive) { Uint sz; - bld_unique_integer_term(NULL, &sz, val[0], val[1], 0); + bld_unique_integer_term(NULL, &sz, val[0], val[1], positive); return sz; } Eterm -erts_raw_make_unique_integer(Eterm **hpp, Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES]) +erts_raw_make_unique_integer(Eterm **hpp, Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES], + int positive) { - return bld_unique_integer_term(hpp, NULL, val[0], val[1], 0); + return bld_unique_integer_term(hpp, NULL, val[0], val[1], positive); } void @@ -338,7 +340,7 @@ static struct { } w; } raw_unique_monotonic_integer erts_align_attribute(ERTS_CACHE_LINE_SIZE); -#if defined(ARCH_32) || HALFWORD_HEAP +#if defined(ARCH_32) # define ERTS_UNIQUE_MONOTONIC_OFFSET ERTS_SINT64_MIN #else # define ERTS_UNIQUE_MONOTONIC_OFFSET MIN_SMALL @@ -368,7 +370,7 @@ get_unique_monotonic_integer_heap_size(Uint64 raw, int positive) Sint64 value = ((Sint64) raw) + ERTS_UNIQUE_MONOTONIC_OFFSET; if (IS_SSMALL(value)) return 0; -#if defined(ARCH_32) || HALFWORD_HEAP +#if defined(ARCH_32) return ERTS_SINT64_HEAP_SIZE(value); #else return ERTS_UINT64_HEAP_SIZE((Uint64) value); @@ -393,7 +395,7 @@ make_unique_monotonic_integer_value(Eterm *hp, Uint hsz, Uint64 raw, int positiv if (hsz == 0) res = make_small(value); else { -#if defined(ARCH_32) || HALFWORD_HEAP +#if defined(ARCH_32) res = erts_sint64_to_big(value, &hp); #else res = erts_uint64_to_big((Uint64) value, &hp); @@ -426,16 +428,16 @@ erts_raw_get_unique_monotonic_integer(void) } Uint -erts_raw_unique_monotonic_integer_heap_size(Sint64 raw) +erts_raw_unique_monotonic_integer_heap_size(Sint64 raw, int positive) { - return get_unique_monotonic_integer_heap_size(raw, 0); + return get_unique_monotonic_integer_heap_size(raw, positive); } Eterm -erts_raw_make_unique_monotonic_integer_value(Eterm **hpp, Sint64 raw) +erts_raw_make_unique_monotonic_integer_value(Eterm **hpp, Sint64 raw, int positive) { - Uint hsz = get_unique_monotonic_integer_heap_size(raw, 0); - Eterm res = make_unique_monotonic_integer_value(*hpp, hsz, raw, 0); + Uint hsz = get_unique_monotonic_integer_heap_size(raw, positive); + Eterm res = make_unique_monotonic_integer_value(*hpp, hsz, raw, positive); *hpp += hsz; return res; } diff --git a/erts/emulator/beam/erl_bif_unique.h b/erts/emulator/beam/erl_bif_unique.h index 37d5d91c39..c6481864d0 100644 --- a/erts/emulator/beam/erl_bif_unique.h +++ b/erts/emulator/beam/erl_bif_unique.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2014. All Rights Reserved. + * Copyright Ericsson AB 2014-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -41,8 +41,9 @@ void erts_make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]); * 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); +Uint erts_raw_unique_monotonic_integer_heap_size(Sint64 raw, int positive); +Eterm erts_raw_make_unique_monotonic_integer_value(Eterm **hpp, Sint64 raw, + int positive); Sint64 erts_get_min_unique_monotonic_integer(void); @@ -53,8 +54,11 @@ Eterm erts_debug_get_unique_monotonic_integer_state(Process *c_p); #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]); +Uint erts_raw_unique_integer_heap_size(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES], + int positive); +Eterm erts_raw_make_unique_integer(Eterm **hpp, + Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES], + int postive); void erts_raw_get_unique_integer(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES]); Sint64 erts_get_min_unique_integer(void); diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index ea01bf08f0..fdc5efea98 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2013. All Rights Reserved. + * Copyright Ericsson AB 2000-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -72,7 +72,6 @@ typedef struct erl_heap_bin { */ #define binary_size(Bin) (binary_val(Bin)[1]) -#define binary_size_rel(Bin,BasePtr) (binary_val_rel(Bin,BasePtr)[1]) #define binary_bitsize(Bin) \ ((*binary_val(Bin) == HEADER_SUB_BIN) ? \ @@ -95,12 +94,9 @@ typedef struct erl_heap_bin { * Bitsize: output variable (Uint) */ -#define ERTS_GET_BINARY_BYTES(Bin,Bytep,Bitoffs,Bitsize) \ - ERTS_GET_BINARY_BYTES_REL(Bin,Bytep,Bitoffs,Bitsize,NULL) - -#define ERTS_GET_BINARY_BYTES_REL(Bin,Bytep,Bitoffs,Bitsize,BasePtr) \ +#define ERTS_GET_BINARY_BYTES(Bin,Bytep,Bitoffs,Bitsize) \ do { \ - Eterm* _real_bin = binary_val_rel(Bin,BasePtr); \ + Eterm* _real_bin = binary_val(Bin); \ Uint _offs = 0; \ Bitoffs = Bitsize = 0; \ if (*_real_bin == HEADER_SUB_BIN) { \ @@ -108,7 +104,7 @@ do { \ _offs = _sb->offs; \ Bitoffs = _sb->bitoffs; \ Bitsize = _sb->bitsize; \ - _real_bin = binary_val_rel(_sb->orig,BasePtr); \ + _real_bin = binary_val(_sb->orig); \ } \ if (*_real_bin == HEADER_PROC_BIN) { \ Bytep = ((ProcBin *) _real_bin)->bytes + _offs; \ @@ -131,11 +127,8 @@ do { \ */ #define ERTS_GET_REAL_BIN(Bin, RealBin, ByteOffset, BitOffset, BitSize) \ - ERTS_GET_REAL_BIN_REL(Bin, RealBin, ByteOffset, BitOffset, BitSize, NULL) - -#define ERTS_GET_REAL_BIN_REL(Bin, RealBin, ByteOffset, BitOffset, BitSize, BasePtr) \ do { \ - ErlSubBin* _sb = (ErlSubBin *) binary_val_rel(Bin,BasePtr); \ + ErlSubBin* _sb = (ErlSubBin *) binary_val(Bin); \ if (_sb->thing_word == HEADER_SUB_BIN) { \ RealBin = _sb->orig; \ ByteOffset = _sb->offs; \ diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c index 01734c55d7..6bf52fb303 100644 --- a/erts/emulator/beam/erl_bits.c +++ b/erts/emulator/beam/erl_bits.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2013. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -282,7 +282,7 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff * Simply shift whole bytes into the result. */ switch (BYTE_OFFSET(n)) { -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) case 7: w = (w << 8) | *bp++; case 6: w = (w << 8) | *bp++; case 5: w = (w << 8) | *bp++; @@ -387,7 +387,7 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff case 3: v32 = LSB[0] + (LSB[1]<<8) + (LSB[2]<<16); goto big_small; -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) case 4: v32 = (LSB[0] + (LSB[1]<<8) + (LSB[2]<<16) + (LSB[3]<<24)); if (!IS_USMALL(sgn, v32)) { diff --git a/erts/emulator/beam/erl_bits.h b/erts/emulator/beam/erl_bits.h index 8b7807fbd9..1c2a090f07 100644 --- a/erts/emulator/beam/erl_bits.h +++ b/erts/emulator/beam/erl_bits.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2011. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_cpu_topology.c b/erts/emulator/beam/erl_cpu_topology.c index c263eebfcc..28aaeeb479 100644 --- a/erts/emulator/beam/erl_cpu_topology.c +++ b/erts/emulator/beam/erl_cpu_topology.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2013. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_cpu_topology.h b/erts/emulator/beam/erl_cpu_topology.h index f3fbfc6da0..45324ac4a0 100644 --- a/erts/emulator/beam/erl_cpu_topology.h +++ b/erts/emulator/beam/erl_cpu_topology.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2013. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 870b556851..615d23402b 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -1773,15 +1773,9 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1) * (it looks like an continuation pointer), but that is will crash the * emulator if this BIF is call traced. */ -#if HALFWORD_HEAP - Eterm *hp = HAlloc(BIF_P, 3); - hp[0] = make_pos_bignum_header(2); - *((UWord *) (UWord) (hp+1)) = (UWord) tb; -#else Eterm *hp = HAlloc(BIF_P, 2); hp[0] = make_pos_bignum_header(1); hp[1] = (Eterm) tb; -#endif BIF_TRAP1(&ets_delete_continue_exp, BIF_P, make_big(hp)); } else { @@ -1837,7 +1831,7 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3) tb->common.id, from_pid, BIF_ARG_3), - 0); + 0); erts_smp_proc_unlock(to_proc, to_locks); UnUseTmpHeap(5,BIF_P); BIF_RET(am_true); @@ -2839,7 +2833,7 @@ BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3) BIF_TRAP3(bif_export[BIF_ets_match_spec_run_r_3], BIF_P,lst,BIF_ARG_2,ret); } - res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), NULL, NULL, 0, + res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), NULL, 0, ERTS_PAM_COPY_RESULT, &dummy); if (is_value(res)) { hp = HAlloc(BIF_P, 2); @@ -3216,7 +3210,7 @@ retry: tb->common.id, p->common.id, heir_data), - 0); + 0); erts_smp_proc_unlock(to_proc, to_locks); return !0; } @@ -3651,11 +3645,8 @@ static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1) Eterm* ptr = big_val(cont); DbTable *tb = *((DbTable **) (UWord) (ptr + 1)); -#if HALFWORD_HEAP - ASSERT(*ptr == make_pos_bignum_header(2)); -#else ASSERT(*ptr == make_pos_bignum_header(1)); -#endif + db_lock(tb, LCK_WRITE); trap = free_table_cont(p, tb, 0, 1); db_unlock(tb, LCK_WRITE); diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h index a589af784c..1d26c49652 100644 --- a/erts/emulator/beam/erl_db.h +++ b/erts/emulator/beam/erl_db.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index fa925c94a5..74979f984a 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2012. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -469,9 +469,6 @@ static ERTS_INLINE void try_shrink(DbTableHash* tb) } } -#define EQ_REL(x,y,y_base) \ - (is_same(x,NULL,y,y_base) || (is_not_both_immed((x),(y)) && eq_rel((x),NULL,(y),y_base))) - /* Is this a live object (not pseodo-deleted) with the specified key? */ static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b, @@ -481,7 +478,7 @@ static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b, else { Eterm itemKey = GETKEY(tb, b->dbterm.tpl); ASSERT(!is_header(itemKey)); - return EQ_REL(key, itemKey, b->dbterm.tpl); + return EQ(key, itemKey); } } @@ -494,7 +491,7 @@ static ERTS_INLINE int has_key(DbTableHash* tb, HashDbTerm* b, else { Eterm itemKey = GETKEY(tb, b->dbterm.tpl); ASSERT(!is_header(itemKey)); - return EQ_REL(key, itemKey, b->dbterm.tpl); + return EQ(key, itemKey); } } @@ -2204,11 +2201,11 @@ static void db_print_hash(int to, void *to_arg, int show, DbTable *tbl) erts_print(to, to_arg, "*"); if (tb->common.compress) { Eterm key = GETKEY(tb, list->dbterm.tpl); - erts_print(to, to_arg, "key=%R", key, list->dbterm.tpl); + erts_print(to, to_arg, "key=%T", key); } else { - Eterm obj = make_tuple_rel(list->dbterm.tpl,list->dbterm.tpl); - erts_print(to, to_arg, "%R", obj, list->dbterm.tpl); + Eterm obj = make_tuple(list->dbterm.tpl); + erts_print(to, to_arg, "%T", obj); } if (list->next != 0) erts_print(to, to_arg, ","); @@ -2899,9 +2896,6 @@ Ldone: 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; } diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h index 66d8ec71d9..e654363cd5 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-2014. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 61293fbf9a..02d211a4bb 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2013. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -280,7 +280,7 @@ struct select_delete_context { /* ** Forward declarations */ -static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key, Eterm* key_base); +static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key); static TreeDbTerm *linkout_object_tree(DbTableTree *tb, Eterm object); static int do_free_tree_cont(DbTableTree *tb, int num_left); @@ -291,15 +291,15 @@ static int delsub(TreeDbTerm **this); static TreeDbTerm *slot_search(Process *p, DbTableTree *tb, Sint slot); static TreeDbTerm *find_node(DbTableTree *tb, Eterm key); static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key); -static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key, Eterm* kbase); -static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key, Eterm* kbase); +static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key); +static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key); static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack*, Eterm key); static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack*, Eterm key); static void traverse_backwards(DbTableTree *tb, DbTreeStack*, - Eterm lastkey, Eterm* lk_base, + Eterm lastkey, int (*doit)(DbTableTree *tb, TreeDbTerm *, void *, @@ -307,7 +307,7 @@ static void traverse_backwards(DbTableTree *tb, void *context); static void traverse_forward(DbTableTree *tb, DbTreeStack*, - Eterm lastkey, Eterm* lk_base, + Eterm lastkey, int (*doit)(DbTableTree *tb, TreeDbTerm *, void *, @@ -315,8 +315,8 @@ static void traverse_forward(DbTableTree *tb, void *context); static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, Eterm *partly_bound_key); -static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_base); -static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done); +static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key); +static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done); static int analyze_pattern(DbTableTree *tb, Eterm pattern, struct mp_info *mpi); @@ -517,7 +517,7 @@ static int db_next_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) if (is_atom(key) && key == am_EOT) return DB_ERROR_BADKEY; stack = get_any_stack(tb); - this = find_next(tb, stack, key, NULL); + this = find_next(tb, stack, key); release_stack(tb,stack); if (this == NULL) { *ret = am_EOT; @@ -563,7 +563,7 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) if (is_atom(key) && key == am_EOT) return DB_ERROR_BADKEY; stack = get_any_stack(tb); - this = find_prev(tb, stack, key, NULL); + this = find_prev(tb, stack, key); release_stack(tb,stack); if (this == NULL) { *ret = am_EOT; @@ -573,19 +573,13 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) return DB_ERROR_NONE; } -static ERTS_INLINE Sint cmp_key(DbTableTree* tb, Eterm key, Eterm* key_base, - TreeDbTerm* obj) -{ - return cmp_rel(key, key_base, - GETKEY(tb,obj->dbterm.tpl), obj->dbterm.tpl); +static ERTS_INLINE Sint cmp_key(DbTableTree* tb, Eterm key, TreeDbTerm* obj) { + return CMP(key, GETKEY(tb,obj->dbterm.tpl)); } -static ERTS_INLINE int cmp_key_eq(DbTableTree* tb, Eterm key, Eterm* key_base, - TreeDbTerm* obj) -{ +static ERTS_INLINE int cmp_key_eq(DbTableTree* tb, Eterm key, TreeDbTerm* obj) { Eterm obj_key = GETKEY(tb,obj->dbterm.tpl); - return is_same(key, key_base, obj_key, obj->dbterm.tpl) - || cmp_rel(key, key_base, obj_key, obj->dbterm.tpl) == 0; + return is_same(key, obj_key) || CMP(key, obj_key) == 0; } static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail) @@ -619,7 +613,7 @@ static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail) (*this)->balance = 0; (*this)->left = (*this)->right = NULL; break; - } else if ((c = cmp_key(tb, key, NULL, *this)) < 0) { + } else if ((c = cmp_key(tb, key, *this)) < 0) { /* go lefts */ dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; @@ -774,7 +768,7 @@ static int db_erase_tree(DbTable *tbl, Eterm key, Eterm *ret) *ret = am_true; - if ((res = linkout_tree(tb, key, NULL)) != NULL) { + if ((res = linkout_tree(tb, key)) != NULL) { free_term(tb, res); } return DB_ERROR_NONE; @@ -970,15 +964,15 @@ static int db_select_continue_tree(Process *p, stack = get_any_stack(tb); if (chunk_size) { if (reverse) { - traverse_backwards(tb, stack, lastkey, NULL, &doit_select_chunk, &sc); + traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc); } else { - traverse_forward(tb, stack, lastkey, NULL, &doit_select_chunk, &sc); + traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc); } } else { if (reverse) { - traverse_forward(tb, stack, lastkey, NULL, &doit_select, &sc); + traverse_forward(tb, stack, lastkey, &doit_select, &sc); } else { - traverse_backwards(tb, stack, lastkey, NULL, &doit_select, &sc); + traverse_backwards(tb, stack, lastkey, &doit_select, &sc); } } release_stack(tb,stack); @@ -1003,9 +997,9 @@ static int db_select_continue_tree(Process *p, } key = GETKEY(tb, sc.lastobj); - sz = size_object_rel(key,sc.lastobj); + sz = size_object(key); hp = HAlloc(p, 9 + sz); - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); continuation = TUPLE8 (hp, tptr[1], @@ -1026,8 +1020,8 @@ static int db_select_continue_tree(Process *p, key = GETKEY(tb, sc.lastobj); if (chunk_size) { if (end_condition != NIL && - ((!reverse && cmp_partly_bound(end_condition,key,sc.lastobj) < 0) || - (reverse && cmp_partly_bound(end_condition,key,sc.lastobj) > 0))) { + ((!reverse && cmp_partly_bound(end_condition,key) < 0) || + (reverse && cmp_partly_bound(end_condition,key) > 0))) { /* done anyway */ if (!sc.got) { RET_TO_BIF(am_EOT, DB_ERROR_NONE); @@ -1039,16 +1033,16 @@ static int db_select_continue_tree(Process *p, } } else { if (end_condition != NIL && - ((!reverse && cmp_partly_bound(end_condition,key,sc.lastobj) > 0) || - (reverse && cmp_partly_bound(end_condition,key,sc.lastobj) < 0))) { + ((!reverse && cmp_partly_bound(end_condition,key) > 0) || + (reverse && cmp_partly_bound(end_condition,key) < 0))) { /* done anyway */ RET_TO_BIF(sc.accum,DB_ERROR_NONE); } } /* Not done yet, let's trap. */ - sz = size_object_rel(key,sc.lastobj); + sz = size_object(key); hp = HAlloc(p, 9 + sz); - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); continuation = TUPLE8 (hp, tptr[1], @@ -1075,7 +1069,6 @@ static int db_select_tree(Process *p, DbTable *tbl, struct select_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; - Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1127,20 +1120,18 @@ static int db_select_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); - lk_base = this->dbterm.tpl; } sc.end_condition = mpi.most; } - traverse_forward(tb, stack, lastkey, lk_base, &doit_select, &sc); + traverse_forward(tb, stack, lastkey, &doit_select, &sc); } else { if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); - lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - traverse_backwards(tb, stack, lastkey, lk_base, &doit_select, &sc); + traverse_backwards(tb, stack, lastkey, &doit_select, &sc); } release_stack(tb,stack); #ifdef HARDDEBUG @@ -1153,9 +1144,9 @@ static int db_select_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object_rel(key, sc.lastobj); + sz = size_object(key); hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; mpb=db_make_mp_binary(p,mpi.mp,&hp); @@ -1236,7 +1227,7 @@ static int db_select_count_continue_tree(Process *p, } stack = get_any_stack(tb); - traverse_backwards(tb, stack, lastkey, NULL, &doit_select_count, &sc); + traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc); release_stack(tb,stack); BUMP_REDS(p, 1000 - sc.max); @@ -1246,12 +1237,12 @@ static int db_select_count_continue_tree(Process *p, } key = GETKEY(tb, sc.lastobj); if (end_condition != NIL && - (cmp_partly_bound(end_condition,key,sc.lastobj) > 0)) { + (cmp_partly_bound(end_condition,key) > 0)) { /* done anyway */ RET_TO_BIF(make_small(sc.got),DB_ERROR_NONE); } /* Not done yet, let's trap. */ - sz = size_object_rel(key, sc.lastobj); + sz = size_object(key); if (IS_USMALL(0, sc.got)) { hp = HAlloc(p, sz + 6); egot = make_small(sc.got); @@ -1261,7 +1252,7 @@ static int db_select_count_continue_tree(Process *p, egot = uint_to_big(sc.got, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); continuation = TUPLE5 (hp, tptr[1], @@ -1284,7 +1275,6 @@ static int db_select_count_tree(Process *p, DbTable *tbl, struct select_count_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; - Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1334,12 +1324,11 @@ static int db_select_count_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); - lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - traverse_backwards(tb, stack, lastkey, lk_base, &doit_select_count, &sc); + traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc); release_stack(tb,stack); BUMP_REDS(p, 1000 - sc.max); if (sc.max > 0) { @@ -1347,7 +1336,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object_rel(key, sc.lastobj); + sz = size_object(key); if (IS_USMALL(0, sc.got)) { hp = HAlloc(p, sz + PROC_BIN_SIZE + 6); egot = make_small(sc.got); @@ -1357,7 +1346,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl, egot = uint_to_big(sc.got, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; mpb = db_make_mp_binary(p,mpi.mp,&hp); @@ -1388,7 +1377,6 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, struct select_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; - Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1445,20 +1433,18 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); - lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - traverse_backwards(tb, stack, lastkey, lk_base, &doit_select_chunk, &sc); + traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc); } else { if (mpi.some_limitation) { if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); - lk_base = this->dbterm.tpl; } sc.end_condition = mpi.most; } - traverse_forward(tb, stack, lastkey, lk_base, &doit_select_chunk, &sc); + traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc); } release_stack(tb,stack); @@ -1483,9 +1469,9 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object_rel(key, sc.lastobj); + sz = size_object(key); hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; mpb = db_make_mp_binary(p,mpi.mp,&hp); @@ -1508,9 +1494,9 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object_rel(key, sc.lastobj); + sz = size_object(key); hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; @@ -1586,7 +1572,7 @@ static int db_select_delete_continue_tree(Process *p, sc.keypos = tb->common.keypos; ASSERT(!erts_smp_atomic_read_nob(&tb->is_stack_busy)); - traverse_backwards(tb, &tb->static_stack, lastkey, NULL, &doit_select_delete, &sc); + traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc); BUMP_REDS(p, 1000 - sc.max); @@ -1595,11 +1581,11 @@ static int db_select_delete_continue_tree(Process *p, } key = GETKEY(tb, (sc.lastterm)->dbterm.tpl); if (end_condition != NIL && - cmp_partly_bound(end_condition,key,sc.lastterm->dbterm.tpl) > 0) { /* done anyway */ + cmp_partly_bound(end_condition,key) > 0) { /* done anyway */ RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE); } /* Not done yet, let's trap. */ - sz = size_object_rel(key, sc.lastterm->dbterm.tpl); + sz = size_object(key); if (IS_USMALL(0, sc.accum)) { hp = HAlloc(p, sz + 6); eaccsum = make_small(sc.accum); @@ -1609,7 +1595,7 @@ static int db_select_delete_continue_tree(Process *p, eaccsum = uint_to_big(sc.accum, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastterm->dbterm.tpl, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); continuation = TUPLE5 (hp, tptr[1], @@ -1630,7 +1616,6 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, struct select_delete_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; - Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1683,12 +1668,11 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, &tb->static_stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); - lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - traverse_backwards(tb, &tb->static_stack, lastkey, lk_base, &doit_select_delete, &sc); + traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc); BUMP_REDS(p, 1000 - sc.max); if (sc.max > 0) { @@ -1696,7 +1680,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, (sc.lastterm)->dbterm.tpl); - sz = size_object_rel(key, sc.lastterm->dbterm.tpl); + sz = size_object(key); if (IS_USMALL(0, sc.accum)) { hp = HAlloc(p, sz + PROC_BIN_SIZE + 6); eaccsum = make_small(sc.accum); @@ -1706,7 +1690,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, eaccsum = uint_to_big(sc.accum, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastterm->dbterm.tpl, NULL); + key = copy_struct(key, sz, &hp, &MSO(p)); mpb = db_make_mp_binary(p,mpi.mp,&hp); continuation = TUPLE5 @@ -1734,7 +1718,7 @@ static int db_take_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) TreeDbTerm *this; *ret = NIL; - this = linkout_tree(tb, key, NULL); + this = linkout_tree(tb, key); if (this) { Eterm copy, *hp, *hend; @@ -1845,9 +1829,7 @@ do_db_tree_foreach_offheap(TreeDbTerm *tdbt, do_db_tree_foreach_offheap(tdbt->right, func, arg); } -static TreeDbTerm *linkout_tree(DbTableTree *tb, - Eterm key, Eterm* key_base) -{ +static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key) { TreeDbTerm **tstack[STACK_NEED]; int tpos = 0; int dstack[STACK_NEED+1]; @@ -1869,7 +1851,7 @@ static TreeDbTerm *linkout_tree(DbTableTree *tb, for (;;) { if (!*this) { /* Failure */ return NULL; - } else if ((c = cmp_key(tb, key, key_base, *this)) < 0) { + } else if ((c = cmp_key(tb, key, *this)) < 0) { dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; this = &((*this)->left); @@ -1933,7 +1915,7 @@ static TreeDbTerm *linkout_object_tree(DbTableTree *tb, for (;;) { if (!*this) { /* Failure */ return NULL; - } else if ((c = cmp_key(tb,key,NULL,*this)) < 0) { + } else if ((c = cmp_key(tb,key,*this)) < 0) { dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; this = &((*this)->left); @@ -2319,15 +2301,13 @@ done: * Find next and previous in sort order */ -static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, - Eterm key, Eterm* key_base) -{ +static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, Eterm key) { TreeDbTerm *this; TreeDbTerm *tmp; Sint c; if(( this = TOP_NODE(stack)) != NULL) { - if (!cmp_key_eq(tb,key,key_base,this)) { + if (!cmp_key_eq(tb,key,this)) { /* Start from the beginning */ stack->pos = stack->slot = 0; } @@ -2337,7 +2317,7 @@ static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp_key(tb,key,key_base,this) ) > 0) { + if (( c = cmp_key(tb,key,this) ) > 0) { if (this->right == NULL) /* We are at the previos and the element does not exist */ @@ -2377,15 +2357,13 @@ static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, return this; } -static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, - Eterm key, Eterm* key_base) -{ +static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, Eterm key) { TreeDbTerm *this; TreeDbTerm *tmp; Sint c; if(( this = TOP_NODE(stack)) != NULL) { - if (!cmp_key_eq(tb,key,key_base,this)) { + if (!cmp_key_eq(tb,key,this)) { /* Start from the beginning */ stack->pos = stack->slot = 0; } @@ -2395,7 +2373,7 @@ static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp_key(tb,key,key_base,this) ) < 0) { + if (( c = cmp_key(tb,key,this) ) < 0) { if (this->left == NULL) /* We are at the next and the element does not exist */ @@ -2448,8 +2426,7 @@ static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack* stack, return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl), - this->dbterm.tpl) ) >= 0) { + if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl))) >= 0) { if (this->right == NULL) { do { tmp = POP_NODE(stack); @@ -2482,8 +2459,7 @@ static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack* stack, return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl), - this->dbterm.tpl) ) <= 0) { + if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl))) <= 0) { if (this->left == NULL) { do { tmp = POP_NODE(stack); @@ -2514,10 +2490,10 @@ static TreeDbTerm *find_node(DbTableTree *tb, Eterm key) DbTreeStack* stack = get_static_stack(tb); if(!stack || EMPTY_NODE(stack) - || !cmp_key_eq(tb, key, NULL, (this=TOP_NODE(stack)))) { + || !cmp_key_eq(tb, key, (this=TOP_NODE(stack)))) { this = tb->root; - while (this != NULL && (res = cmp_key(tb,key,NULL,this)) != 0) { + while (this != NULL && (res = cmp_key(tb,key,this)) != 0) { if (res < 0) this = this->left; else @@ -2539,7 +2515,7 @@ static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key) Sint res; this = &tb->root; - while ((*this) != NULL && (res = cmp_key(tb, key, NULL, *this)) != 0) { + while ((*this) != NULL && (res = cmp_key(tb, key, *this)) != 0) { if (res < 0) this = &((*this)->left); else @@ -2589,9 +2565,6 @@ db_lookup_dbterm_tree(Process *p, DbTable *tbl, Eterm key, Eterm obj, handle->flags = flags; handle->bp = (void**) pp; handle->new_size = (*pp)->dbterm.size; -#if HALFWORD_HEAP - handle->abs_vec = NULL; -#endif return 1; } @@ -2622,7 +2595,7 @@ db_finalize_dbterm_tree(int cret, DbUpdateHandle *handle) */ static void traverse_backwards(DbTableTree *tb, DbTreeStack* stack, - Eterm lastkey, Eterm* lk_base, + Eterm lastkey, int (*doit)(DbTableTree *, TreeDbTerm *, void *, @@ -2641,16 +2614,15 @@ static void traverse_backwards(DbTableTree *tb, this = this->right; } this = TOP_NODE(stack); - next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl), - this->dbterm.tpl); + next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl)); if (!((*doit)(tb, this, context, 0))) return; } else { - next = find_prev(tb, stack, lastkey, lk_base); + next = find_prev(tb, stack, lastkey); } while ((this = next) != NULL) { - next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl); + next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl)); if (!((*doit)(tb, this, context, 0))) return; } @@ -2661,7 +2633,7 @@ static void traverse_backwards(DbTableTree *tb, */ static void traverse_forward(DbTableTree *tb, DbTreeStack* stack, - Eterm lastkey, Eterm* lk_base, + Eterm lastkey, int (*doit)(DbTableTree *, TreeDbTerm *, void *, @@ -2680,15 +2652,15 @@ static void traverse_forward(DbTableTree *tb, this = this->left; } this = TOP_NODE(stack); - next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl); + next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl)); if (!((*doit)(tb, this, context, 1))) return; } else { - next = find_next(tb, stack, lastkey, lk_base); + next = find_next(tb, stack, lastkey); } while ((this = next) != NULL) { - next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl); + next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl)); if (!((*doit)(tb, this, context, 1))) return; } @@ -2725,7 +2697,7 @@ static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, -static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) +static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done) { Eterm* aa; Eterm* bb; @@ -2739,44 +2711,44 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) *done = 1; return 0; } - if (is_same(a,NULL,b,b_base)) + if (is_same(a,b)) return 0; switch (a & _TAG_PRIMARY_MASK) { case TAG_PRIMARY_LIST: if (!is_list(b)) { - return cmp_rel(a,NULL,b,b_base); + return CMP(a,b); } aa = list_val(a); - bb = list_val_rel(b,b_base); + bb = list_val(b); while (1) { - if ((j = do_cmp_partly_bound(*aa++, *bb++, b_base, done)) != 0 || *done) + if ((j = do_cmp_partly_bound(*aa++, *bb++, done)) != 0 || *done) return j; - if (is_same(*aa, NULL, *bb, b_base)) + if (is_same(*aa, *bb)) return 0; if (is_not_list(*aa) || is_not_list(*bb)) - return do_cmp_partly_bound(*aa, *bb, b_base, done); + return do_cmp_partly_bound(*aa, *bb, done); aa = list_val(*aa); - bb = list_val_rel(*bb,b_base); + bb = list_val(*bb); } case TAG_PRIMARY_BOXED: if ((b & _TAG_PRIMARY_MASK) != TAG_PRIMARY_BOXED) { - return cmp_rel(a,NULL,b,b_base); + return CMP(a,b); } a_hdr = ((*boxed_val(a)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; - b_hdr = ((*boxed_val_rel(b,b_base)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; + b_hdr = ((*boxed_val(b)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; if (a_hdr != b_hdr) { - return cmp_rel(a, NULL, b, b_base); + return CMP(a,b); } if (a_hdr == (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE)) { aa = tuple_val(a); - bb = tuple_val_rel(b, b_base); + bb = tuple_val(b); /* compare the arities */ i = arityval(*aa); /* get the arity*/ if (i < arityval(*bb)) return(-1); if (i > arityval(*bb)) return(1); while (i--) { - if ((j = do_cmp_partly_bound(*++aa, *++bb, b_base, done)) != 0 + if ((j = do_cmp_partly_bound(*++aa, *++bb, done)) != 0 || *done) return j; } @@ -2784,14 +2756,13 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) } /* Drop through */ default: - return cmp_rel(a, NULL, b, b_base); + return CMP(a,b); } } -static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_base) -{ +static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key) { int done = 0; - Sint ret = do_cmp_partly_bound(partly_bound_key, bound_key, bk_base, &done); + Sint ret = do_cmp_partly_bound(partly_bound_key, bound_key, &done); #ifdef HARDDEBUG erts_fprintf(stderr,"\ncmp_partly_bound: %T", partly_bound_key); if (ret < 0) @@ -2800,7 +2771,7 @@ static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_ erts_fprintf(stderr," > "); else erts_fprintf(stderr," == "); - erts_fprintf(stderr,"%R\n", bound_key, bk_base); + erts_fprintf(stderr,"%T\n", bound_key); #endif return ret; } @@ -3017,12 +2988,10 @@ static int doit_select(DbTableTree *tb, TreeDbTerm *this, void *ptr, if (sc->end_condition != NIL && ((forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), - this->dbterm.tpl) < 0) || + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) < 0) || (!forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), - this->dbterm.tpl) > 0))) { + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0))) { return 0; } ret = db_match_dbterm(&tb->common,sc->p,sc->mp,sc->all_objects, @@ -3054,8 +3023,7 @@ static int doit_select_count(DbTableTree *tb, TreeDbTerm *this, void *ptr, /* Always backwards traversing */ if (sc->end_condition != NIL && (cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), - this->dbterm.tpl) > 0)) { + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0)) { return 0; } ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0, @@ -3081,12 +3049,10 @@ static int doit_select_chunk(DbTableTree *tb, TreeDbTerm *this, void *ptr, if (sc->end_condition != NIL && ((forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), - this->dbterm.tpl) < 0) || + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) < 0) || (!forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), - this->dbterm.tpl) > 0))) { + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0))) { return 0; } @@ -3124,14 +3090,13 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr, if (sc->end_condition != NIL && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), - this->dbterm.tpl) > 0) + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0) return 0; ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0, &this->dbterm, NULL, 0); if (ret == am_true) { key = GETKEY(sc->tb, this->dbterm.tpl); - linkout_tree(sc->tb, key, this->dbterm.tpl); + linkout_tree(sc->tb, key); sc->erase_lastterm = 1; ++sc->accum; } @@ -3157,11 +3122,10 @@ static void do_dump_tree2(DbTableTree* tb, int to, void *to_arg, int show, } else { prefix = ""; - term = make_tuple_rel(t->dbterm.tpl,t->dbterm.tpl); + term = make_tuple(t->dbterm.tpl); } - erts_print(to, to_arg, "%*s%s%R (addr = %p, bal = %d)\n", - offset, "", prefix, term, t->dbterm.tpl, - t, t->balance); + erts_print(to, to_arg, "%*s%s%T (addr = %p, bal = %d)\n", + offset, "", prefix, term, t, t->balance); } do_dump_tree2(tb, to, to_arg, show, t->left, offset + 4); } diff --git a/erts/emulator/beam/erl_db_tree.h b/erts/emulator/beam/erl_db_tree.h index 6098387f5d..72749ead1e 100644 --- a/erts/emulator/beam/erl_db_tree.h +++ b/erts/emulator/beam/erl_db_tree.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index af5b611afd..76b96637ae 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2014. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -135,21 +135,22 @@ get_proc(Process *cp, Uint32 cp_locks, Eterm id, Uint32 id_locks) static Eterm -set_tracee_flags(Process *tracee_p, Eterm tracer, Uint d_flags, Uint e_flags) { +set_tracee_flags(Process *tracee_p, ErtsTracer tracer, + Uint d_flags, Uint e_flags) { Eterm ret; Uint flags; - if (tracer == NIL) { + if (ERTS_TRACER_IS_NIL(tracer)) { flags = ERTS_TRACE_FLAGS(tracee_p) & ~TRACEE_FLAGS; } else { flags = ((ERTS_TRACE_FLAGS(tracee_p) & ~d_flags) | e_flags); - if (! flags) tracer = NIL; + if (! flags) tracer = erts_tracer_nil; } - ret = ((ERTS_TRACER_PROC(tracee_p) != tracer + ret = ((!ERTS_TRACER_COMPARE(ERTS_TRACER(tracee_p),tracer) || ERTS_TRACE_FLAGS(tracee_p) != flags) ? am_true : am_false); - ERTS_TRACER_PROC(tracee_p) = tracer; + erts_tracer_replace(&tracee_p->common, tracer); ERTS_TRACE_FLAGS(tracee_p) = flags; return ret; } @@ -163,40 +164,16 @@ set_tracee_flags(Process *tracee_p, Eterm tracer, Uint d_flags, Uint e_flags) { ** returns fail_term on failure. Fails if tracer pid or port is invalid. */ static Eterm -set_match_trace(Process *tracee_p, Eterm fail_term, Eterm tracer, +set_match_trace(Process *tracee_p, Eterm fail_term, ErtsTracer tracer, Uint d_flags, Uint e_flags) { - Eterm ret = fail_term; - Process *tracer_p; - - ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCKS_ALL == - erts_proc_lc_my_proc_locks(tracee_p)); - - if (is_internal_pid(tracer) - && (tracer_p = - erts_pid2proc(tracee_p, ERTS_PROC_LOCKS_ALL, - tracer, ERTS_PROC_LOCKS_ALL))) { - if (tracee_p != tracer_p) { - ret = set_tracee_flags(tracee_p, tracer, d_flags, e_flags); - ERTS_TRACE_FLAGS(tracer_p) |= (ERTS_TRACE_FLAGS(tracee_p) - ? F_TRACER - : 0); - erts_smp_proc_unlock(tracer_p, ERTS_PROC_LOCKS_ALL); - } - } else if (is_internal_port(tracer)) { - Port *tracer_port = - erts_id2port_sflgs(tracer, - tracee_p, - ERTS_PROC_LOCKS_ALL, - ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP); - if (tracer_port) { - ret = set_tracee_flags(tracee_p, tracer, d_flags, e_flags); - erts_port_release(tracer_port); - } - } else { - ASSERT(is_nil(tracer)); - ret = set_tracee_flags(tracee_p, tracer, d_flags, e_flags); - } - return ret; + + ERTS_SMP_LC_ASSERT( + ERTS_PROC_LOCKS_ALL == erts_proc_lc_my_proc_locks(tracee_p) + || erts_thr_progress_is_blocking()); + + if (ERTS_TRACER_IS_NIL(tracer) || erts_is_tracer_enabled(tracee_p, tracer)) + return set_tracee_flags(tracee_p, tracer, d_flags, e_flags); + return fail_term; } /* @@ -239,11 +216,7 @@ typedef enum { matchCall2, matchCall3, matchPushV, -#if HALFWORD_HEAP - matchPushVGuard, /* First guard-only variable reference */ -#endif - matchPushVResult, /* First variable reference in result, or (if HALFWORD) - in guard if also referenced in result */ + matchPushVResult, /* First variable reference in result */ matchPushExpr, /* Push the whole expression we're matching ('$_') */ matchPushArrayAsList, /* Only when parameter is an Array and not an erlang term (DCOMP_TRACE) */ @@ -310,9 +283,6 @@ DMC_DECLARE_STACK_TYPE(unsigned); typedef struct DMCVariable { int is_bound; int is_in_body; -#if HALFWORD_HEAP - int first_guard_label; /* to maybe change from PushVGuard to PushVResult */ -#endif } DMCVariable; typedef struct DMCHeap { @@ -374,7 +344,6 @@ typedef struct MatchVariable { Eterm term; #ifdef DEBUG Process* proc; - Eterm* base; #endif } MatchVariable; @@ -415,7 +384,7 @@ cleanup_match_pseudo_process(ErtsMatchPseudoProcess *mpsp, int keep_heap) else { int i; for (i = 0; i < ERTS_DEFAULT_MS_HEAP_SIZE; i++) { -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) mpsp->default_heap[i] = (Eterm) 0xdeadbeefdeadbeef; #else mpsp->default_heap[i] = (Eterm) 0xdeadbeef; @@ -1240,7 +1209,7 @@ Eterm erts_match_set_run(Process *p, Binary *mpsp, { Eterm ret; - ret = db_prog_match(p, mpsp, NIL, NULL, args, num_args, + ret = db_prog_match(p, mpsp, NIL, args, num_args, in_flags, return_flags); #if defined(HARDDEBUG) if (is_non_value(ret)) { @@ -1265,7 +1234,7 @@ static Eterm erts_match_set_run_ets(Process *p, Binary *mpsp, { Eterm ret; - ret = db_prog_match(p, mpsp, args, NULL, NULL, num_args, + ret = db_prog_match(p, mpsp, args, NULL, num_args, ERTS_PAM_COPY_RESULT, return_flags); #if defined(HARDDEBUG) @@ -1755,71 +1724,6 @@ static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity) return ret; } - -#if HALFWORD_HEAP -struct heap_checkpoint_t -{ - Process *p; - Eterm* htop; - ErlHeapFragment* mbuf; - unsigned used_size; - ErlOffHeap off_heap; -}; - -static void heap_checkpoint_init(Process* p, struct heap_checkpoint_t* hcp) -{ - hcp->p = p; - hcp->htop = HEAP_TOP(p); - hcp->mbuf = MBUF(p); - hcp->used_size = hcp->mbuf ? hcp->mbuf->used_size : 0; - hcp->off_heap = MSO(p); -} - -static void heap_checkpoint_revert(struct heap_checkpoint_t* hcp) -{ - struct erl_off_heap_header* oh = MSO(hcp->p).first; - - if (oh != hcp->off_heap.first) { - ASSERT(oh != NULL); - if (hcp->off_heap.first) { - while (oh->next != hcp->off_heap.first) { - oh = oh->next; - } - oh->next = NULL; - } - erts_cleanup_offheap(&MSO(hcp->p)); - MSO(hcp->p) = hcp->off_heap; - } - if (MBUF(hcp->p) != hcp->mbuf) { - ErlHeapFragment* hf = MBUF(hcp->p); - ASSERT(hf != NULL); - if (hcp->mbuf) { - while (hf->next != hcp->mbuf) { - hf = hf->next; - } - hf->next = NULL; - } - free_message_buffer(MBUF(hcp->p)); - MBUF(hcp->p) = hcp->mbuf; - } - if (hcp->mbuf != NULL && hcp->mbuf->used_size != hcp->used_size) { - hcp->mbuf->used_size = hcp->used_size; - } - HEAP_TOP(hcp->p) = hcp->htop; -} -#endif /* HALFWORD_HEAP */ - -static ERTS_INLINE Eterm copy_object_rel(Process* p, Eterm term, Eterm* base) -{ - if (!is_immed(term)) { - Uint sz = size_object_rel(term, base); - Eterm* top = HAllocX(p, sz, HEAP_XTRA); - return copy_struct_rel(term, sz, &top, &MSO(p), base, NULL); - } - return term; -} - - /* ** Execution of the match program, this is Pam. ** May return THE_NON_VALUE, which is a bailout. @@ -1827,7 +1731,7 @@ static ERTS_INLINE Eterm copy_object_rel(Process* p, Eterm term, Eterm* base) ** i.e. 'DCOMP_TRACE' was specified */ Eterm db_prog_match(Process *c_p, Binary *bprog, - Eterm term, Eterm* base, + Eterm term, Eterm *termp, int arity, enum erts_pam_run_flags in_flags, @@ -1855,17 +1759,12 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm bif_args[3]; int fail_label; int atomic_trace; -#if HALFWORD_HEAP - struct heap_checkpoint_t c_p_checkpoint = {}; -#endif #ifdef DMC_DEBUG Uint *heap_fence; Uint *stack_fence; Uint save_op; #endif /* DMC_DEBUG */ - ASSERT(base==NULL || HALFWORD_HEAP); - mpsp = get_match_pseudo_process(c_p, prog->heap_size); psp = &mpsp->process; @@ -1916,11 +1815,7 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, do_catch != 0 */ *return_flags = 0U; - variables = mpsp->u.variables; -#if HALFWORD_HEAP - c_p_checkpoint.p = NULL; -#endif restart: ep = &term; @@ -1931,14 +1826,12 @@ restart: fail_label = -1; build_proc = psp; esdp->current_process = psp; - ASSERT_HALFWORD(!c_p_checkpoint.p); #ifdef DEBUG ASSERT(variables == mpsp->u.variables); for (i=0; i<prog->num_bindings; i++) { variables[i].term = THE_NON_VALUE; variables[i].proc = NULL; - variables[i].base = base; } #endif @@ -1974,9 +1867,9 @@ restart: variables[n].term = dpm_array_to_list(psp, termp, arity); break; case matchTuple: /* *ep is a tuple of arity n */ - if (!is_tuple_rel(*ep,base)) + if (!is_tuple(*ep)) FAIL(); - ep = tuple_val_rel(*ep,base); + ep = tuple_val(*ep); n = *pc++; if (arityval(*ep) != n) FAIL(); @@ -1984,9 +1877,9 @@ restart: break; case matchPushT: /* *ep is a tuple of arity n, push ptr to first element */ - if (!is_tuple_rel(*ep,base)) + if (!is_tuple(*ep)) FAIL(); - tp = tuple_val_rel(*ep,base); + tp = tuple_val(*ep); n = *pc++; if (arityval(*tp) != n) FAIL(); @@ -1996,51 +1889,51 @@ restart: case matchList: if (!is_list(*ep)) FAIL(); - ep = list_val_rel(*ep,base); + ep = list_val(*ep); break; case matchPushL: if (!is_list(*ep)) FAIL(); - *sp++ = list_val_rel(*ep,base); + *sp++ = list_val(*ep); ++ep; break; case matchMap: - if (!is_map_rel(*ep, base)) { + if (!is_map(*ep)) { FAIL(); } n = *pc++; - if (is_flatmap_rel(*ep,base)) { - if (flatmap_get_size(flatmap_val_rel(*ep, base)) < n) { + if (is_flatmap(*ep)) { + if (flatmap_get_size(flatmap_val(*ep)) < n) { FAIL(); } } else { - ASSERT(is_hashmap_rel(*ep,base)); - if (hashmap_size_rel(*ep, base) < n) { + ASSERT(is_hashmap(*ep)); + if (hashmap_size(*ep) < n) { FAIL(); } } - ep = flatmap_val_rel(*ep, base); + ep = flatmap_val(*ep); break; case matchPushM: - if (!is_map_rel(*ep, base)) { + if (!is_map(*ep)) { FAIL(); } n = *pc++; - if (is_flatmap_rel(*ep,base)) { - if (flatmap_get_size(flatmap_val_rel(*ep, base)) < n) { + if (is_flatmap(*ep)) { + if (flatmap_get_size(flatmap_val(*ep)) < n) { FAIL(); } } else { - ASSERT(is_hashmap_rel(*ep,base)); - if (hashmap_size_rel(*ep, base) < n) { + ASSERT(is_hashmap(*ep)); + if (hashmap_size(*ep) < n) { FAIL(); } } - *sp++ = flatmap_val_rel(*ep++, base); + *sp++ = flatmap_val(*ep++); break; case matchKey: t = (Eterm) *pc++; - tp = erts_maps_get_rel(t, make_boxed_rel(ep, base), base); + tp = erts_maps_get(t, make_boxed(ep)); if (!tp) { FAIL(); } @@ -2061,29 +1954,29 @@ restart: break; case matchCmp: n = *pc++; - if (!eq_rel(variables[n].term, base, *ep, base)) + if (!EQ(variables[n].term, *ep)) FAIL(); ++ep; break; case matchEqBin: t = (Eterm) *pc++; - if (!eq_rel(t,NULL,*ep,base)) + if (!EQ(t,*ep)) FAIL(); ++ep; break; case matchEqFloat: - if (!is_float_rel(*ep,base)) + if (!is_float(*ep)) FAIL(); - if (memcmp(float_val_rel(*ep,base) + 1, pc, sizeof(double))) + if (memcmp(float_val(*ep) + 1, pc, sizeof(double))) FAIL(); pc += TermWords(2); ++ep; break; case matchEqRef: { Eterm* epc = (Eterm*)pc; - if (!is_ref_rel(*ep,base)) + if (!is_ref(*ep)) FAIL(); - if (!eq_rel(make_internal_ref_rel(epc, epc), epc, *ep, base)) { + if (!EQ(make_internal_ref(epc), *ep)) { FAIL(); } i = thing_arityval(*epc); @@ -2092,9 +1985,9 @@ restart: break; } case matchEqBig: - if (!is_big_rel(*ep,base)) + if (!is_big(*ep)) FAIL(); - tp = big_val_rel(*ep,base); + tp = big_val(*ep); { Eterm *epc = (Eterm *) pc; if (*tp != *epc) @@ -2236,62 +2129,36 @@ restart: esp -= 2; esp[-1] = t; break; - - #if HALFWORD_HEAP - case matchPushVGuard: - if (!base) goto case_matchPushV; - /* Build NULL-based copy on pseudo heap for easy disposal */ - n = *pc++; - ASSERT(is_value(variables[n].term)); - ASSERT(!variables[n].proc); - variables[n].term = copy_object_rel(psp, variables[n].term, base); - *esp++ = variables[n].term; - #ifdef DEBUG - variables[n].proc = psp; - variables[n].base = NULL; - #endif - break; - #endif case matchPushVResult: if (!(in_flags & ERTS_PAM_COPY_RESULT)) goto case_matchPushV; - - /* Build (NULL-based) copy on callers heap */ - #if HALFWORD_HEAP - if (!do_catch && !c_p_checkpoint.p) { - heap_checkpoint_init(c_p, &c_p_checkpoint); - } - #endif + /* Build copy on callers heap */ n = *pc++; ASSERT(is_value(variables[n].term)); ASSERT(!variables[n].proc); - variables[n].term = copy_object_rel(c_p, variables[n].term, base); + variables[n].term = copy_object_x(variables[n].term, c_p, HEAP_XTRA); *esp++ = variables[n].term; #ifdef DEBUG variables[n].proc = c_p; - variables[n].base = NULL; #endif break; case matchPushV: case_matchPushV: n = *pc++; ASSERT(is_value(variables[n].term)); - ASSERT(!variables[n].base); *esp++ = variables[n].term; break; case matchPushExpr: if (in_flags & ERTS_PAM_COPY_RESULT) { Uint sz; Eterm* top; - sz = size_object_rel(term, base); + sz = size_object(term); top = HAllocX(build_proc, sz, HEAP_XTRA); if (in_flags & ERTS_PAM_CONTIGUOUS_TUPLE) { - ASSERT(is_tuple_rel(term,base)); - *esp++ = copy_shallow_rel(tuple_val_rel(term,base), sz, - &top, &MSO(build_proc), base); + ASSERT(is_tuple(term)); + *esp++ = copy_shallow(tuple_val(term), sz, &top, &MSO(build_proc)); } else { - *esp++ = copy_struct_rel(term, sz, &top, &MSO(build_proc), - base, NULL); + *esp++ = copy_struct(term, sz, &top, &MSO(build_proc)); } } else { @@ -2299,7 +2166,6 @@ restart: } break; case matchPushArrayAsList: - ASSERT_HALFWORD(base == NULL); n = arity; /* Only happens when 'term' is an array */ tp = termp; ehp = HAllocX(build_proc, n*2, HEAP_XTRA); @@ -2315,7 +2181,6 @@ restart: break; case matchPushArrayAsListU: /* This instruction is NOT efficient. */ - ASSERT_HALFWORD(base == NULL); *esp++ = dpm_array_to_list(build_proc, termp, arity); break; case matchTrue: @@ -2420,11 +2285,7 @@ restart: *esp++ = am_true; break; case matchIsSeqTrace: - if (SEQ_TRACE_TOKEN(c_p) != NIL -#ifdef USE_VM_PROBES - && SEQ_TRACE_TOKEN(c_p) != am_have_dt_utag -#endif - ) + if (have_seqtrace(SEQ_TRACE_TOKEN(c_p))) *esp++ = am_true; else *esp++ = am_false; @@ -2448,11 +2309,7 @@ restart: --esp; break; case matchGetSeqToken: - if (SEQ_TRACE_TOKEN(c_p) == NIL -#ifdef USE_VM_PROBES - || SEQ_TRACE_TOKEN(c_p) == am_have_dt_utag -#endif - ) + if (have_no_seqtrace(SEQ_TRACE_TOKEN(c_p))) *esp++ = NIL; else { Eterm sender = SEQ_TRACE_TOKEN_SENDER(c_p); @@ -2478,7 +2335,7 @@ restart: case matchEnableTrace: if ( (n = erts_trace_flag2bit(esp[-1]))) { BEGIN_ATOMIC_TRACE(c_p); - set_tracee_flags(c_p, ERTS_TRACER_PROC(c_p), 0, n); + set_tracee_flags(c_p, ERTS_TRACER(c_p), 0, n); esp[-1] = am_true; } else { esp[-1] = FAIL_TERM; @@ -2491,7 +2348,7 @@ restart: BEGIN_ATOMIC_TRACE(c_p); if ( (tmpp = get_proc(c_p, 0, esp[0], 0))) { /* Always take over the tracer of the current process */ - set_tracee_flags(tmpp, ERTS_TRACER_PROC(c_p), 0, n); + set_tracee_flags(tmpp, ERTS_TRACER(c_p), 0, n); esp[-1] = am_true; } } @@ -2499,7 +2356,7 @@ restart: case matchDisableTrace: if ( (n = erts_trace_flag2bit(esp[-1]))) { BEGIN_ATOMIC_TRACE(c_p); - set_tracee_flags(c_p, ERTS_TRACER_PROC(c_p), n, 0); + set_tracee_flags(c_p, ERTS_TRACER(c_p), n, 0); esp[-1] = am_true; } else { esp[-1] = FAIL_TERM; @@ -2512,7 +2369,7 @@ restart: BEGIN_ATOMIC_TRACE(c_p); if ( (tmpp = get_proc(c_p, 0, esp[0], 0))) { /* Always take over the tracer of the current process */ - set_tracee_flags(tmpp, ERTS_TRACER_PROC(c_p), n, 0); + set_tracee_flags(tmpp, ERTS_TRACER(c_p), n, 0); esp[-1] = am_true; } } @@ -2548,7 +2405,7 @@ restart: { /* disable enable */ Uint d_flags = 0, e_flags = 0; /* process trace flags */ - Eterm tracer = ERTS_TRACER_PROC(c_p); + ErtsTracer tracer = erts_tracer_nil; /* XXX Atomicity note: Not fully atomic. Default tracer * is sampled from current process but applied to * tracee and tracer later after releasing main @@ -2560,29 +2417,34 @@ restart: * {trace,[],[{{tracer,Tracer}}]} is much, much older. */ int cputs = 0; + erts_tracer_update(&tracer, ERTS_TRACER(c_p)); if (! erts_trace_flags(esp[-1], &d_flags, &tracer, &cputs) || ! erts_trace_flags(esp[-2], &e_flags, &tracer, &cputs) || cputs ) { (--esp)[-1] = FAIL_TERM; + ERTS_TRACER_CLEAR(&tracer); break; } erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); (--esp)[-1] = set_match_trace(c_p, FAIL_TERM, tracer, d_flags, e_flags); erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + ERTS_TRACER_CLEAR(&tracer); } break; case matchTrace3: { /* disable enable */ Uint d_flags = 0, e_flags = 0; /* process trace flags */ - Eterm tracer = ERTS_TRACER_PROC(c_p); + ErtsTracer tracer = erts_tracer_nil; /* XXX Atomicity note. Not fully atomic. See above. * Above it could possibly be solved, but not here. */ int cputs = 0; Eterm tracee = (--esp)[0]; + + erts_tracer_update(&tracer, ERTS_TRACER(c_p)); if (! erts_trace_flags(esp[-1], &d_flags, &tracer, &cputs) || ! erts_trace_flags(esp[-2], &e_flags, &tracer, &cputs) || @@ -2590,6 +2452,7 @@ restart: ! (tmpp = get_proc(c_p, ERTS_PROC_LOCK_MAIN, tracee, ERTS_PROC_LOCKS_ALL))) { (--esp)[-1] = FAIL_TERM; + ERTS_TRACER_CLEAR(&tracer); break; } if (tmpp == c_p) { @@ -2603,6 +2466,7 @@ restart: erts_smp_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL); erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); } + ERTS_TRACER_CLEAR(&tracer); } break; case matchCatch: /* Match success, now build result */ @@ -2619,13 +2483,6 @@ restart: } } fail: -#if HALFWORD_HEAP - if (c_p_checkpoint.p) { - /* Dispose garbage built by guards on caller heap */ - heap_checkpoint_revert(&c_p_checkpoint); - c_p_checkpoint.p = NULL; - } -#endif *return_flags = 0U; if (fail_label >= 0) { /* We failed during a "TryMeElse", lets restart, with the next match @@ -2788,13 +2645,6 @@ Wterm db_do_read_element(DbUpdateHandle* handle, Sint position) { Eterm elem = handle->dbterm->tpl[position]; if (!is_header(elem)) { -#if HALFWORD_HEAP - if (!is_immed(elem) - && !handle->tb->common.compress - && !(handle->abs_vec && handle->abs_vec[position])) { - return rterm2wterm(elem, handle->dbterm->tpl); - } -#endif return elem; } @@ -2822,9 +2672,6 @@ void db_do_update_element(DbUpdateHandle* handle, Eterm* oldp; Uint newval_sz; Uint oldval_sz; -#if HALFWORD_HEAP - Eterm* old_base; -#endif if (is_both_immed(newval,oldval)) { handle->dbterm->tpl[position] = newval; @@ -2841,15 +2688,8 @@ void db_do_update_element(DbUpdateHandle* handle, handle->dbterm); handle->flags |= DB_MUST_RESIZE; oldval = handle->dbterm->tpl[position]; - #if HALFWORD_HEAP - old_base = NULL; - #endif } else { - #if HALFWORD_HEAP - ASSERT(!handle->abs_vec); - old_base = handle->dbterm->tpl; - #endif if (is_boxed(newval)) { newp = boxed_val(newval); switch (*newp & _TAG_HEADER_MASK) { @@ -2859,7 +2699,7 @@ void db_do_update_element(DbUpdateHandle* handle, case _TAG_HEADER_HEAP_BIN: newval_sz = header_arity(*newp) + 1; if (is_boxed(oldval)) { - oldp = boxed_val_rel(oldval,old_base); + oldp = boxed_val(oldval); switch (*oldp & _TAG_HEADER_MASK) { case _TAG_HEADER_POS_BIG: case _TAG_HEADER_NEG_BIG: @@ -2879,20 +2719,13 @@ void db_do_update_element(DbUpdateHandle* handle, } } } -#if HALFWORD_HEAP - else { - old_base = (handle->tb->common.compress - || (handle->abs_vec && handle->abs_vec[position])) ? - NULL : handle->dbterm->tpl; - } -#endif /* Not possible for simple memcpy or dbterm is already non-contiguous, */ /* need to realloc... */ newval_sz = is_immed(newval) ? 0 : size_object(newval); new_size_set: - oldval_sz = is_immed(oldval) ? 0 : size_object_rel(oldval,old_base); + oldval_sz = is_immed(oldval) ? 0 : size_object(oldval); both_size_set: handle->new_size = handle->new_size - oldval_sz + newval_sz; @@ -2900,19 +2733,6 @@ both_size_set: /* write new value in old dbterm, finalize will make a flat copy */ handle->dbterm->tpl[position] = newval; handle->flags |= DB_MUST_RESIZE; - -#if HALFWORD_HEAP - if (old_base && newval_sz > 0) { - ASSERT(!handle->tb->common.compress); - if (!handle->abs_vec) { - int i = header_arity(handle->dbterm->tpl[0]); - handle->abs_vec = erts_alloc(ERTS_ALC_T_TMP, (i+1)*sizeof(char)); - sys_memset(handle->abs_vec, 0, i+1); - /* abs_vec[0] not used */ - } - handle->abs_vec[position] = 1; - } -#endif } static ERTS_INLINE byte* db_realloc_term(DbTableCommon* tb, void* old, @@ -3011,7 +2831,7 @@ static void* copy_to_comp(DbTableCommon* tb, Eterm obj, DbTerm* dest, tpl[arity + 1] = alloc_size; tmp_offheap.first = NULL; - tpl[tb->keypos] = copy_struct_rel(key, size_object(key), &top.ep, &tmp_offheap, NULL, tpl); + tpl[tb->keypos] = copy_struct(key, size_object(key), &top.ep, &tmp_offheap); dest->first_oh = tmp_offheap.first; for (i=1; i<=arity; i++) { if (i != tb->keypos) { @@ -3030,7 +2850,7 @@ static void* copy_to_comp(DbTableCommon* tb, Eterm obj, DbTerm* dest, Eterm* dbg_top = erts_alloc(ERTS_ALC_T_DB_TERM, dest->size * sizeof(Eterm)); dest->debug_clone = dbg_top; tmp_offheap.first = dest->first_oh; - copy_struct_rel(obj, dest->size, &dbg_top, &tmp_offheap, NULL, dbg_top); + copy_struct(obj, dest->size, &dbg_top, &tmp_offheap); dest->first_oh = tmp_offheap.first; ASSERT(dbg_top == dest->debug_clone + dest->size); } @@ -3077,7 +2897,7 @@ void* db_store_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) newp->size = size; top = newp->tpl; tmp_offheap.first = NULL; - copy_struct_rel(obj, size, &top, &tmp_offheap, NULL, top); + copy_struct(obj, size, &top, &tmp_offheap); newp->first_oh = tmp_offheap.first; #ifdef DEBUG_CLONE newp->debug_clone = NULL; @@ -3160,29 +2980,8 @@ void db_finalize_resize(DbUpdateHandle* handle, Uint offset) tmp_offheap.first = NULL; - #if HALFWORD_HEAP - if (handle->abs_vec) { - int i, arity = header_arity(handle->dbterm->tpl[0]); - - top[0] = tpl[0]; - top += arity + 1; - for (i=1; i<=arity; i++) { - Eterm* src_base = handle->abs_vec[i] ? NULL : tpl; - - newDbTerm->tpl[i] = copy_struct_rel(tpl[i], - size_object_rel(tpl[i],src_base), - &top, &tmp_offheap, src_base, - newDbTerm->tpl); - } - newDbTerm->first_oh = tmp_offheap.first; - ASSERT((byte*)top <= (newp + alloc_sz)); - erts_free(ERTS_ALC_T_TMP, handle->abs_vec); - } - else - #endif /* HALFWORD_HEAP */ { - copy_struct_rel(make_tuple_rel(tpl,tpl), handle->new_size, &top, - &tmp_offheap, tpl, top); + copy_struct(make_tuple(tpl), handle->new_size, &top, &tmp_offheap); newDbTerm->first_oh = tmp_offheap.first; ASSERT((byte*)top == (newp + alloc_sz)); } @@ -3199,9 +2998,9 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, hp[0] = bp->tpl[0]; *hpp += arity + 1; - hp[tb->keypos] = copy_struct_rel(bp->tpl[tb->keypos], - size_object_rel(bp->tpl[tb->keypos], bp->tpl), - hpp, off_heap, bp->tpl, NULL); + hp[tb->keypos] = copy_struct(bp->tpl[tb->keypos], + size_object(bp->tpl[tb->keypos]), + hpp, off_heap); erts_factory_static_init(&factory, *hpp, bp->size - (arity+1), off_heap); @@ -3221,7 +3020,7 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, ASSERT((*hpp - hp) <= bp->size); #ifdef DEBUG_CLONE - ASSERT(eq_rel(make_tuple(hp),NULL,make_tuple(bp->debug_clone),bp->debug_clone)); + ASSERT(EQ(make_tuple(hp),make_tuple(bp->debug_clone))); #endif return make_tuple(hp); } @@ -3245,14 +3044,14 @@ Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p, *hpp = erts_produce_heap(&factory, extra, 0); erts_factory_close(&factory); #ifdef DEBUG_CLONE - ASSERT(eq_rel(copy, NULL, obj->debug_clone[pos], obj->debug_clone)); + ASSERT(EQ(copy, obj->debug_clone[pos])); #endif return copy; } else { - Uint sz = size_object_rel(obj->tpl[pos], obj->tpl); + Uint sz = size_object(obj->tpl[pos]); *hpp = HAlloc(p, sz + extra); - return copy_struct_rel(obj->tpl[pos], sz, hpp, &MSO(p), obj->tpl, NULL); + return copy_struct(obj->tpl[pos], sz, hpp, &MSO(p)); } } @@ -3599,26 +3398,10 @@ static DMCRet dmc_one_term(DMCContext *context, { Eterm* ref_val = internal_ref_val(c); DMC_PUSH(*text, matchEqRef); -#if HALFWORD_HEAP - { - union { - UWord u; - Uint t[2]; - } fiddle; - ASSERT(thing_arityval(ref_val[0]) == 3); - fiddle.t[0] = ref_val[0]; - fiddle.t[1] = ref_val[1]; - DMC_PUSH(*text, fiddle.u); - fiddle.t[0] = ref_val[2]; - fiddle.t[1] = ref_val[3]; - DMC_PUSH(*text, fiddle.u); - } -#else n = thing_arityval(ref_val[0]); for (i = 0; i <= n; ++i) { DMC_PUSH(*text, ref_val[i]); } -#endif break; } case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): @@ -3627,53 +3410,19 @@ static DMCRet dmc_one_term(DMCContext *context, Eterm* bval = big_val(c); n = thing_arityval(bval[0]); DMC_PUSH(*text, matchEqBig); -#if HALFWORD_HEAP - { - union { - UWord u; - Uint t[2]; - } fiddle; - ASSERT(n >= 1); - fiddle.t[0] = bval[0]; - fiddle.t[1] = bval[1]; - DMC_PUSH(*text, fiddle.u); - for (i = 2; i <= n; ++i) { - fiddle.t[0] = bval[i]; - if (++i <= n) { - fiddle.t[1] = bval[i]; - } else { - fiddle.t[1] = (Uint) 0; - } - DMC_PUSH(*text, fiddle.u); - } - } -#else for (i = 0; i <= n; ++i) { DMC_PUSH(*text, (Uint) bval[i]); } -#endif break; } case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): DMC_PUSH(*text,matchEqFloat); -#if HALFWORD_HEAP - { - union { - UWord u; - Uint t[2]; - } fiddle; - fiddle.t[0] = float_val(c)[1]; - fiddle.t[1] = float_val(c)[2]; - DMC_PUSH(*text, fiddle.u); - } -#else DMC_PUSH(*text, (Uint) float_val(c)[1]); #ifdef ARCH_64 DMC_PUSH(*text, (Uint) 0); #else DMC_PUSH(*text, (Uint) float_val(c)[2]); #endif -#endif break; default: /* BINARY, FUN, VECTOR, or EXTERNAL */ DMC_PUSH(*text, matchEqBin); @@ -3997,24 +3746,8 @@ static void dmc_add_pushv_variant(DMCContext *context, DMCHeap *heap, MatchOps instr = matchPushV; ASSERT(n < heap->vars_used && v->is_bound); - if (context->is_guard) { - #if HALFWORD_HEAP - if (!v->first_guard_label) { - v->first_guard_label = DMC_STACK_NUM(*text); - ASSERT(v->first_guard_label); - instr = matchPushVGuard; /* may be changed to PushVResult below */ - } - #endif - } - else { /* body */ - #if HALFWORD_HEAP - if (v->first_guard_label) { - /* Avoid double-copy, copy to result heap at first encounter in guard */ - DMC_POKE(*text, v->first_guard_label, matchPushVResult); - v->is_in_body = 1; - } - #endif - if (!v->is_in_body) { + if (!context->is_guard) { + if(!v->is_in_body) { instr = matchPushVResult; v->is_in_body = 1; } @@ -5335,7 +5068,7 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace) lint_res = db_match_set_lint(p, spec, DCOMP_TABLE | DCOMP_FAKE_DESTRUCTIVE); mps = db_match_set_compile(p, spec, DCOMP_TABLE | DCOMP_FAKE_DESTRUCTIVE); } - + if (mps == NULL) { hp = HAlloc(p,3); ret = TUPLE2(hp, am_error, lint_res); @@ -5443,16 +5176,13 @@ Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, int all, DbTerm* obj, Eterm** hpp, Uint extra) { Uint32 dummy; - Eterm* base; Eterm res; if (tb->compress) { obj = db_alloc_tmp_uncompressed(tb, obj); - base = NULL; } - else base = HALFWORD_HEAP ? obj->tpl : NULL; - res = db_prog_match(c_p, bprog, make_tuple_rel(obj->tpl,base), base, NULL, 0, + res = db_prog_match(c_p, bprog, make_tuple(obj->tpl), NULL, 0, ERTS_PAM_COPY_RESULT|ERTS_PAM_CONTIGUOUS_TUPLE, &dummy); if (is_value(res) && hpp!=NULL) { @@ -5573,7 +5303,7 @@ void db_match_dis(Binary *bp) first = 0; else erts_printf(", "); -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) erts_printf("0x%016bex", rt->data.ui[ri]); #else erts_printf("0x%08bex", rt->data.ui[ri]); @@ -5597,7 +5327,7 @@ void db_match_dis(Binary *bp) first = 0; else erts_printf(", "); -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) erts_printf("0x%016bex", *et); #else erts_printf("0x%08bex", *et); @@ -5720,13 +5450,6 @@ void db_match_dis(Binary *bp) ++t; erts_printf("PushV\t%beu\n", n); break; - #if HALFWORD_HEAP - case matchPushVGuard: - n = (Uint) *++t; - ++t; - erts_printf("PushVGuard\t%beu\n", n); - break; - #endif case matchPushVResult: n = (Uint) *++t; ++t; diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 0903a40460..5d7946a525 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2013. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -90,9 +90,6 @@ typedef struct { Uint new_size; int flags; void* lck; -#if HALFWORD_HEAP - unsigned char* abs_vec; /* [i] true if dbterm->tpl[i] is absolute Eterm */ -#endif } DbUpdateHandle; @@ -290,10 +287,10 @@ ERTS_GLB_INLINE Eterm db_copy_key(Process* p, DbTable* tb, DbTerm* obj) Eterm key = GETKEY(tb, obj->tpl); if IS_CONST(key) return key; else { - Uint size = size_object_rel(key, obj->tpl); + Uint size = size_object(key); Eterm* hp = HAlloc(p, size); - Eterm res = copy_struct_rel(key, size, &hp, &MSO(p), obj->tpl, NULL); - ASSERT(eq_rel(res,NULL,key,obj->tpl)); + Eterm res = copy_struct(key, size, &hp, &MSO(p)); + ASSERT(EQ(res,key)); return res; } } @@ -305,14 +302,14 @@ ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp, return db_copy_from_comp(tb, bp, hpp, off_heap); } else { - return copy_shallow_rel(bp->tpl, bp->size, hpp, off_heap, bp->tpl); + return copy_shallow(bp->tpl, bp->size, hpp, off_heap); } } ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b) { if (!tb->compress) { - return eq_rel(a, NULL, make_tuple_rel(b->tpl,b->tpl), b->tpl); + return EQ(a, make_tuple(b->tpl)); } else { return db_eq_comp(tb, a, b); @@ -438,7 +435,7 @@ Binary *db_match_compile(Eterm *matchexpr, Eterm *guards, Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, int all, DbTerm* obj, Eterm** hpp, Uint extra); -Eterm db_prog_match(Process *p, Binary *prog, Eterm term, Eterm* base, +Eterm db_prog_match(Process *p, Binary *prog, Eterm term, Eterm *termp, int arity, enum erts_pam_run_flags in_flags, Uint32 *return_flags /* Zeroed on enter */); diff --git a/erts/emulator/beam/erl_debug.c b/erts/emulator/beam/erl_debug.c index 4928aae9c2..3e3bfa03a2 100644 --- a/erts/emulator/beam/erl_debug.c +++ b/erts/emulator/beam/erl_debug.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2013. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -312,6 +312,8 @@ void erts_check_for_holes(Process* p) p->last_htop = HEAP_TOP(p); for (hf = MBUF(p); hf != 0; hf = hf->next) { + if (hf == p->heap_hfrag) + continue; if (hf == p->last_mbuf) { break; } @@ -402,7 +404,7 @@ void verify_process(Process *p) erts_exit(ERTS_ERROR_EXIT,"Wild pointer found in " name " of %T!\n",p->common.id); } - ErlMessage* mp = p->msg.first; + ErtsMessage* mp = p->msg.first; VERBOSE(DEBUG_MEMORY,("Verify process: %T...\n",p->common.id)); @@ -416,7 +418,7 @@ void verify_process(Process *p) erts_check_heap(p); if (p->dictionary) - VERIFY_AREA("dictionary",p->dictionary->data, p->dictionary->used); + VERIFY_AREA("dictionary", ERTS_PD_START(p->dictionary), ERTS_PD_SIZE(p->dictionary)); VERIFY_ETERM("seq trace token",p->seq_trace_token); VERIFY_ETERM("group leader",p->group_leader); VERIFY_ETERM("fvalue",p->fvalue); @@ -531,7 +533,7 @@ static void print_process_memory(Process *p) PTR_SIZE, "PCB", dashes, dashes, dashes, dashes); if (p->msg.first != NULL) { - ErlMessage* mp; + ErtsMessage* mp; erts_printf(" Message Queue:\n"); mp = p->msg.first; while (mp != NULL) { @@ -542,8 +544,8 @@ static void print_process_memory(Process *p) } if (p->dictionary != NULL) { - int n = p->dictionary->used; - Eterm *ptr = p->dictionary->data; + int n = ERTS_PD_SIZE(p->dictionary); + Eterm *ptr = ERTS_PD_START(p->dictionary); erts_printf(" Dictionary: "); while (n--) erts_printf("0x%0*lx ",PTR_SIZE,(unsigned long)ptr++); erts_printf("\n"); @@ -631,29 +633,4 @@ void print_memory_info(Process *p) } erts_printf("+-----------------%s-%s-%s-%s-+\n",dashes,dashes,dashes,dashes); } -#if !HEAP_ON_C_STACK && defined(DEBUG) -Eterm *erts_debug_allocate_tmp_heap(int size, Process *p) -{ - ErtsSchedulerData *sd = ((p == NULL) ? erts_get_scheduler_data() : ERTS_PROC_GET_SCHDATA(p)); - int offset = sd->num_tmp_heap_used; - - ASSERT(offset+size <= TMP_HEAP_SIZE); - return (sd->tmp_heap)+offset; -} -void erts_debug_use_tmp_heap(int size, Process *p) -{ - ErtsSchedulerData *sd = ((p == NULL) ? erts_get_scheduler_data() : ERTS_PROC_GET_SCHDATA(p)); - - sd->num_tmp_heap_used += size; - ASSERT(sd->num_tmp_heap_used <= TMP_HEAP_SIZE); -} -void erts_debug_unuse_tmp_heap(int size, Process *p) -{ - ErtsSchedulerData *sd = ((p == NULL) ? erts_get_scheduler_data() : ERTS_PROC_GET_SCHDATA(p)); - - sd->num_tmp_heap_used -= size; - ASSERT(sd->num_tmp_heap_used >= 0); -} -#endif #endif - diff --git a/erts/emulator/beam/erl_debug.h b/erts/emulator/beam/erl_debug.h index 4905e64f07..029320691d 100644 --- a/erts/emulator/beam/erl_debug.h +++ b/erts/emulator/beam/erl_debug.h @@ -48,6 +48,7 @@ #define DEBUG_THREADS 0x0010 /* Thread-related stuff */ #define DEBUG_PROCESSES 0x0020 /* Process creation and removal */ #define DEBUG_MEMORY 0x0040 /* Display results of memory checks */ +#define DEBUG_SHCOPY 0x0080 /* Sharing-preserving copying of terms */ extern Uint32 verbose; @@ -92,10 +93,4 @@ extern void print_tagged_memory(Eterm *start, Eterm *end); extern void print_untagged_memory(Eterm *start, Eterm *end); extern void print_memory(Process *p); extern void print_memory_info(Process *p); -#if defined(DEBUG) && !HEAP_ON_C_STACK -extern Eterm *erts_debug_allocate_tmp_heap(int, Process *); -extern void erts_debug_use_tmp_heap(int, Process *); -extern void erts_debug_unuse_tmp_heap(int, Process *); -#endif - #endif /* _ERL_DEBUG_H_ */ diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index 7ab58e336b..97a69140c3 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2014. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -37,11 +37,6 @@ # endif #endif -/* This is OK to override by the NIF/driver implementor */ -#if defined(HALFWORD_HEAP_EMULATOR_SAVED__) && !defined(HALFWORD_HEAP_EMULATOR) -#define HALFWORD_HEAP_EMULATOR HALFWORD_HEAP_EMULATOR_SAVED__ -#endif - #include "erl_drv_nif.h" #include <stdlib.h> @@ -131,6 +126,7 @@ typedef struct { #define ERL_DRV_FLAG_USE_PORT_LOCKING (1 << 0) #define ERL_DRV_FLAG_SOFT_BUSY (1 << 1) #define ERL_DRV_FLAG_NO_BUSY_MSGQ (1 << 2) +#define ERL_DRV_FLAG_USE_INIT_ACK (1 << 3) /* * Integer types @@ -340,22 +336,23 @@ typedef struct erl_drv_entry { #ifdef STATIC_ERLANG_DRIVER # define ERLANG_DRIVER_NAME(NAME) NAME ## _driver_init +# define ERL_DRIVER_EXPORT #else # define ERLANG_DRIVER_NAME(NAME) driver_init +# if defined(__GNUC__) && __GNUC__ >= 4 +# define ERL_DRIVER_EXPORT __attribute__ ((visibility("default"))) +# elif defined (__SUNPRO_C) && (__SUNPRO_C >= 0x550) +# define ERL_DRIVER_EXPORT __global +# else +# define ERL_DRIVER_EXPORT +# endif #endif -/* For windows dynamic drivers */ #ifndef ERL_DRIVER_TYPES_ONLY -#if defined(__WIN32__) -# define DRIVER_INIT(DRIVER_NAME) \ - __declspec(dllexport) ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void); \ - __declspec(dllexport) ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void) -#else -# define DRIVER_INIT(DRIVER_NAME) \ - ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void); \ - ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void) -#endif +#define DRIVER_INIT(DRIVER_NAME) \ + ERL_DRIVER_EXPORT ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void); \ + ERL_DRIVER_EXPORT ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void) #define ERL_DRV_BUSY_MSGQ_DISABLED (~((ErlDrvSizeT) 0)) #define ERL_DRV_BUSY_MSGQ_READ_ONLY ((ErlDrvSizeT) 0) @@ -661,15 +658,11 @@ EXTERN char *driver_dl_error(void); EXTERN int erl_drv_putenv(const char *key, char *value); EXTERN int erl_drv_getenv(const char *key, char *value, size_t *value_size); -#ifdef __OSE__ -typedef ErlDrvUInt ErlDrvOseEventId; -EXTERN union SIGNAL *erl_drv_ose_get_signal(ErlDrvEvent ev); -EXTERN ErlDrvEvent erl_drv_ose_event_alloc(SIGSELECT sig, ErlDrvOseEventId handle, - ErlDrvOseEventId (*resolve_signal)(union SIGNAL *sig), void *extra); -EXTERN void erl_drv_ose_event_free(ErlDrvEvent ev); -EXTERN void erl_drv_ose_event_fetch(ErlDrvEvent ev, SIGSELECT *sig, - ErlDrvOseEventId *handle, void **extra); -#endif +/* spawn start init ack */ +EXTERN void erl_drv_init_ack(ErlDrvPort ix, ErlDrvData res); + +/* set the pid seen in port_info */ +EXTERN void erl_drv_set_os_pid(ErlDrvPort ix, ErlDrvSInt pid); #endif /* !ERL_DRIVER_TYPES_ONLY */ diff --git a/erts/emulator/beam/erl_drv_nif.h b/erts/emulator/beam/erl_drv_nif.h index f6b946ae82..2700b62854 100644 --- a/erts/emulator/beam/erl_drv_nif.h +++ b/erts/emulator/beam/erl_drv_nif.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_drv_thread.c b/erts/emulator/beam/erl_drv_thread.c index 184f8e8931..92edce5176 100644 --- a/erts/emulator/beam/erl_drv_thread.c +++ b/erts/emulator/beam/erl_drv_thread.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2007-2011. All Rights Reserved. + * Copyright Ericsson AB 2007-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c index 2f13aa364f..6ce1376c81 100644 --- a/erts/emulator/beam/erl_fun.c +++ b/erts/emulator/beam/erl_fun.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2010. All Rights Reserved. + * Copyright Ericsson AB 2000-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -66,6 +66,9 @@ erts_init_fun_table(void) f.cmp = (HCMP_FUN) fun_cmp; f.alloc = (HALLOC_FUN) fun_alloc; f.free = (HFREE_FUN) fun_free; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; hash_init(ERTS_ALC_T_FUN_TABLE, &erts_fun_table, "fun_table", 16, f); } diff --git a/erts/emulator/beam/erl_fun.h b/erts/emulator/beam/erl_fun.h index 0024b1ff71..8c4deea7a0 100644 --- a/erts/emulator/beam/erl_fun.h +++ b/erts/emulator/beam/erl_fun.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2012. All Rights Reserved. + * Copyright Ericsson AB 2000-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index f48c46ca33..cf54f1e384 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2014. All Rights Reserved. + * Copyright Ericsson AB 2002-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -47,6 +47,17 @@ #define ERTS_INACT_WR_PB_LEAVE_LIMIT 10 #define ERTS_INACT_WR_PB_LEAVE_PERCENTAGE 10 +#if defined(DEBUG) || 0 +#define ERTS_GC_DEBUG +#else +#undef ERTS_GC_DEBUG +#endif +#ifdef ERTS_GC_DEBUG +# define ERTS_GC_ASSERT ASSERT +#else +# define ERTS_GC_ASSERT(B) ((void) 1) +#endif + /* * Returns number of elements in an array. */ @@ -67,10 +78,10 @@ #define ErtsGcQuickSanityCheck(P) \ do { \ ASSERT((P)->heap < (P)->hend); \ - ASSERT((P)->heap_sz == (P)->hend - (P)->heap); \ + ASSERT((p)->abandoned_heap || (P)->heap_sz == (P)->hend - (P)->heap); \ ASSERT((P)->heap <= (P)->htop && (P)->htop <= (P)->hend); \ ASSERT((P)->heap <= (P)->stop && (P)->stop <= (P)->hend); \ - ASSERT((P)->heap <= (P)->high_water && (P)->high_water <= (P)->hend);\ + ASSERT((p)->abandoned_heap || ((P)->heap <= (P)->high_water && (P)->high_water <= (P)->hend)); \ OverRunCheck((P)); \ } while (0) #else @@ -98,18 +109,33 @@ typedef struct { static Uint setup_rootset(Process*, Eterm*, int, Rootset*); static void cleanup_rootset(Rootset *rootset); -static Uint combined_message_size(Process* p); static void remove_message_buffers(Process* p); -static int major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl); -static int minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl); -static void do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj); -static Eterm* sweep_rootset(Rootset *rootset, Eterm* htop, char* src, Uint src_size); -static Eterm* sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size); -static Eterm* sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, - char* src, Uint src_size); -static Eterm* collect_heap_frags(Process* p, Eterm* heap, - Eterm* htop, Eterm* objv, int nobj); -static void adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj); +static Eterm *full_sweep_heaps(Process *p, + int hibernate, + Eterm *n_heap, Eterm* n_htop, + char *oh, Uint oh_size, + Eterm *objv, int nobj); +static int garbage_collect(Process* p, ErlHeapFragment *live_hf_end, + int need, Eterm* objv, int nobj); +static int major_collection(Process* p, ErlHeapFragment *live_hf_end, + int need, Eterm* objv, int nobj, Uint *recl); +static int minor_collection(Process* p, ErlHeapFragment *live_hf_end, + int need, Eterm* objv, int nobj, Uint *recl); +static void do_minor(Process *p, ErlHeapFragment *live_hf_end, + char *mature, Uint mature_size, + Uint new_sz, Eterm* objv, int nobj); +static Eterm *sweep_new_heap(Eterm *n_hp, Eterm *n_htop, + char* old_heap, Uint old_heap_size); +static Eterm *sweep_heaps(Eterm *n_hp, Eterm *n_htop, + char* old_heap, Uint old_heap_size); +static Eterm* sweep_literal_area(Eterm* n_hp, Eterm* n_htop, + char* old_heap, Uint old_heap_size, + char* src, Uint src_size); +static Eterm* sweep_literals_to_old_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, + char* src, Uint src_size); +static Eterm* collect_live_heap_frags(Process* p, ErlHeapFragment *live_hf_end, + Eterm* heap, Eterm* htop, Eterm* objv, int nobj); +static int adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj); static void shrink_new_heap(Process *p, Uint new_sz, Eterm *objv, int nobj); static void grow_new_heap(Process *p, Uint new_sz, Eterm* objv, int nobj); static void sweep_off_heap(Process *p, int fullsweep); @@ -119,16 +145,16 @@ static void offset_rootset(Process *p, Sint offs, char* area, Uint area_size, Eterm* objv, int nobj); static void offset_off_heap(Process* p, Sint offs, char* area, Uint area_size); static void offset_mqueue(Process *p, Sint offs, char* area, Uint area_size); +static void move_msgq_to_heap(Process *p); static void init_gc_info(ErtsGCInfo *gcip); #ifdef HARDDEBUG static void disallow_heap_frag_ref_in_heap(Process* p); static void disallow_heap_frag_ref_in_old_heap(Process* p); -static void disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj); #endif -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) # define MAX_HEAP_SIZES 154 #else # define MAX_HEAP_SIZES 59 @@ -147,26 +173,24 @@ typedef struct { erts_smp_atomic32_t refc; } ErtsGCInfoReq; -#if !HALFWORD_HEAP -ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(gcireq, - ErtsGCInfoReq, - 5, - ERTS_ALC_T_GC_INFO_REQ) -#else -static ERTS_INLINE ErtsGCInfoReq * -gcireq_alloc(void) +static ERTS_INLINE int +gc_cost(Uint gc_moved_live_words, Uint resize_moved_words) { - return erts_alloc(ERTS_ALC_T_GC_INFO_REQ, - sizeof(ErtsGCInfoReq)); -} + Sint reds; -static ERTS_INLINE void -gcireq_free(ErtsGCInfoReq *ptr) -{ - erts_free(ERTS_ALC_T_GC_INFO_REQ, ptr); + reds = gc_moved_live_words/10; + reds += resize_moved_words/100; + if (reds < 1) + return 1; + if (reds > INT_MAX) + return INT_MAX; + return (int) reds; } -#endif +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(gcireq, + ErtsGCInfoReq, + 5, + ERTS_ALC_T_GC_INFO_REQ) /* * Initialize GC global data. */ @@ -208,7 +232,7 @@ erts_init_gc(void) } - /* for 32 bit we want max_heap_size to be MAX(32bit) / 4 [words] (and halfword) + /* for 32 bit we want max_heap_size to be MAX(32bit) / 4 [words] * for 64 bit we want max_heap_size to be MAX(52bit) / 8 [words] */ @@ -232,10 +256,7 @@ erts_init_gc(void) init_gc_info(&esdp->gc_info); } -#if !HALFWORD_HEAP init_gcireq_alloc(); -#endif - } /* @@ -351,10 +372,19 @@ erts_offset_off_heap(ErlOffHeap *ohp, Sint offs, Eterm* low, Eterm* high) #undef ptr_within Eterm -erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity) +erts_gc_after_bif_call_lhf(Process* p, ErlHeapFragment *live_hf_end, + Eterm result, Eterm* regs, Uint arity) { int cost; + if (p->flags & F_HIBERNATE_SCHED) { + /* + * We just hibernated. We do *not* want to mess + * up the hibernation by an ordinary GC... + */ + return result; + } + if (is_non_value(result)) { if (p->freason == TRAP) { #if HIPE @@ -362,21 +392,28 @@ erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity) regs = ERTS_PROC_GET_SCHDATA(p)->x_reg_array; } #endif - cost = erts_garbage_collect(p, 0, regs, p->arity); + cost = garbage_collect(p, live_hf_end, 0, regs, p->arity); } else { - cost = erts_garbage_collect(p, 0, regs, arity); + cost = garbage_collect(p, live_hf_end, 0, regs, arity); } } else { Eterm val[1]; val[0] = result; - cost = erts_garbage_collect(p, 0, val, 1); + cost = garbage_collect(p, live_hf_end, 0, val, 1); result = val[0]; } BUMP_REDS(p, cost); return result; } +Eterm +erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity) +{ + return erts_gc_after_bif_call_lhf(p, ERTS_INVALID_HFRAG_PTR, + result, regs, arity); +} + static ERTS_INLINE void reset_active_writer(Process *p) { struct erl_off_heap_header* ptr; @@ -390,6 +427,139 @@ static ERTS_INLINE void reset_active_writer(Process *p) } } +#define ERTS_DELAY_GC_EXTRA_FREE 40 +#define ERTS_ABANDON_HEAP_COST 10 + +static int +delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need) +{ + ErlHeapFragment *hfrag; + Eterm *orig_heap, *orig_hend, *orig_htop, *orig_stop; + Eterm *stop, *hend; + Uint hsz, ssz; + int reds_left; + + ERTS_HOLE_CHECK(p); + + if ((p->flags & F_DISABLE_GC) + && p->live_hf_end == ERTS_INVALID_HFRAG_PTR) { + /* + * A BIF yielded with disabled GC. Remember + * heap fragments created by the BIF until we + * do next GC. + */ + p->live_hf_end = live_hf_end; + } + + if (need == 0) + return 1; + + /* + * Satisfy need in a heap fragment... + */ + ASSERT(need > 0); + + orig_heap = p->heap; + orig_hend = p->hend; + orig_htop = p->htop; + orig_stop = p->stop; + + ssz = orig_hend - orig_stop; + hsz = ssz + need + ERTS_DELAY_GC_EXTRA_FREE; + + hfrag = new_message_buffer(hsz); + hfrag->next = p->mbuf; + p->mbuf = hfrag; + p->mbuf_sz += hsz; + p->heap = p->htop = &hfrag->mem[0]; + p->hend = hend = &hfrag->mem[hsz]; + p->stop = stop = hend - ssz; + sys_memcpy((void *) stop, (void *) orig_stop, ssz * sizeof(Eterm)); + + if (p->abandoned_heap) { + /* Active heap already in a fragment; adjust it... */ + ErlHeapFragment *hfrag = ((ErlHeapFragment *) + (((char *) orig_heap) + - offsetof(ErlHeapFragment, mem))); + Uint unused = orig_hend - orig_htop; + ASSERT(hfrag->used_size == hfrag->alloc_size); + ASSERT(hfrag->used_size >= unused); + hfrag->used_size -= unused; + p->mbuf_sz -= unused; + } + else { + /* Do not leave a hole in the abandoned heap... */ + if (orig_htop < orig_hend) { + *orig_htop = make_pos_bignum_header(orig_hend-orig_htop-1); + if (orig_htop + 1 < orig_hend) { + orig_hend[-1] = (Uint) (orig_htop - orig_heap); + p->flags |= F_ABANDONED_HEAP_USE; + } + } + p->abandoned_heap = orig_heap; + } + +#ifdef CHECK_FOR_HOLES + p->last_htop = p->htop; + p->heap_hfrag = hfrag; +#endif + + /* Make sure that we do a proper GC as soon as possible... */ + p->flags |= F_FORCE_GC; + reds_left = ERTS_BIF_REDS_LEFT(p); + if (reds_left > ERTS_ABANDON_HEAP_COST) { + int vreds = reds_left - ERTS_ABANDON_HEAP_COST; + ERTS_VBUMP_REDS(p, vreds); + } + return ERTS_ABANDON_HEAP_COST; +} + +static ERTS_FORCE_INLINE Uint +young_gen_usage(Process *p) +{ + Uint hsz; + Eterm *aheap; + + hsz = p->mbuf_sz; + + if (p->flags & F_ON_HEAP_MSGQ) { + ErtsMessage *mp; + for (mp = p->msg.first; mp; mp = mp->next) + if (mp->data.attached) + hsz += erts_msg_attached_data_size(mp); + } + + aheap = p->abandoned_heap; + if (!aheap) + hsz += p->htop - p->heap; + else { + /* used in orig heap */ + if (p->flags & F_ABANDONED_HEAP_USE) + hsz += aheap[p->heap_sz-1]; + else + hsz += p->heap_sz; + /* Remove unused part in latest fragment */ + hsz -= p->hend - p->htop; + } + return hsz; +} + +#define ERTS_GET_ORIG_HEAP(Proc, Heap, HTop) \ + do { \ + Eterm *aheap__ = (Proc)->abandoned_heap; \ + if (!aheap__) { \ + (Heap) = (Proc)->heap; \ + (HTop) = (Proc)->htop; \ + } \ + else { \ + (Heap) = aheap__; \ + if ((Proc)->flags & F_ABANDONED_HEAP_USE) \ + (HTop) = aheap__ + aheap__[(Proc)->heap_sz-1]; \ + else \ + (HTop) = aheap__ + (Proc)->heap_sz; \ + } \ + } while (0) + /* * Garbage collect a process. * @@ -398,38 +568,39 @@ static ERTS_INLINE void reset_active_writer(Process *p) * objv: Array of terms to add to rootset; that is to preserve. * nobj: Number of objects in objv. */ -int -erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) +static int +garbage_collect(Process* p, ErlHeapFragment *live_hf_end, + int need, Eterm* objv, int nobj) { Uint reclaimed_now = 0; - int done = 0; + int reds; ErtsMonotonicTime start_time = 0; /* Shut up faulty warning... */ ErtsSchedulerData *esdp; + ERTS_MSACC_PUSH_STATE_M(); #ifdef USE_VM_PROBES DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE); #endif - if (p->flags & F_DISABLE_GC) { - ASSERT(need == 0); - return 1; - } + if (p->flags & (F_DISABLE_GC|F_DELAY_GC)) + return delay_garbage_collection(p, live_hf_end, need); - esdp = erts_get_scheduler_data(); + if (p->abandoned_heap) + live_hf_end = ERTS_INVALID_HFRAG_PTR; + else if (p->live_hf_end != ERTS_INVALID_HFRAG_PTR) + live_hf_end = p->live_hf_end; - if (IS_TRACED_FL(p, F_TRACE_GC)) { - trace_gc(p, am_gc_start); - } + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_GC); + + esdp = erts_get_scheduler_data(); - (void) erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); + 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); ErtsGcQuickSanityCheck(p); - if (GEN_GCS(p) >= MAX_GEN_GCS(p)) { - FLAGS(p) |= F_NEED_FULLSWEEP; - } + #ifdef USE_VM_PROBES *pidbuf = '\0'; if (DTRACE_ENABLED(gc_major_start) @@ -442,17 +613,34 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) /* * Test which type of GC to do. */ - while (!done) { - if ((FLAGS(p) & F_NEED_FULLSWEEP) != 0) { - DTRACE2(gc_major_start, pidbuf, need); - done = major_collection(p, need, objv, nobj, &reclaimed_now); - DTRACE2(gc_major_end, pidbuf, reclaimed_now); - } else { - DTRACE2(gc_minor_start, pidbuf, need); - done = minor_collection(p, need, objv, nobj, &reclaimed_now); - DTRACE2(gc_minor_end, pidbuf, reclaimed_now); - } + + if (GEN_GCS(p) < MAX_GEN_GCS(p) && !(FLAGS(p) & F_NEED_FULLSWEEP)) { + if (IS_TRACED_FL(p, F_TRACE_GC)) { + trace_gc(p, am_gc_minor_start, need); + } + DTRACE2(gc_minor_start, pidbuf, need); + reds = minor_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); + DTRACE2(gc_minor_end, pidbuf, reclaimed_now); + if (IS_TRACED_FL(p, F_TRACE_GC)) { + trace_gc(p, am_gc_minor_end, reclaimed_now); + } + if (reds < 0) + goto do_major_collection; + } else { +do_major_collection: + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC_FULL); + if (IS_TRACED_FL(p, F_TRACE_GC)) { + trace_gc(p, am_gc_major_start, need); + } + DTRACE2(gc_major_start, pidbuf, need); + reds = major_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); + DTRACE2(gc_major_end, pidbuf, reclaimed_now); + if (IS_TRACED_FL(p, F_TRACE_GC)) { + trace_gc(p, am_gc_major_end, reclaimed_now); + } + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC); } + reset_active_writer(p); /* @@ -465,10 +653,6 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC); - if (IS_TRACED_FL(p, F_TRACE_GC)) { - trace_gc(p, am_gc_end); - } - if (erts_system_monitor_long_gc != 0) { ErtsMonotonicTime end_time; Uint gc_time; @@ -491,6 +675,9 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) esdp->gc_info.reclaimed += reclaimed_now; FLAGS(p) &= ~F_FORCE_GC; + p->live_hf_end = ERTS_INVALID_HFRAG_PTR; + + ERTS_MSACC_POP_STATE_M(); #ifdef CHECK_FOR_HOLES /* @@ -512,15 +699,20 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) p->last_old_htop = p->old_htop; #endif - /* FIXME: This function should really return an Sint, i.e., a possibly - 64 bit wide signed integer, but that requires updating all the code - that calls it. For now, we just return INT_MAX if the result is too - large for an int. */ - { - Sint result = (HEAP_TOP(p) - HEAP_START(p)) / 10; - if (result >= INT_MAX) return INT_MAX; - else return (int) result; - } + return reds; +} + +int +erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj) +{ + return garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj); +} + +void +erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) +{ + int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj); + BUMP_REDS(p, reds); } /* @@ -533,13 +725,11 @@ erts_garbage_collect_hibernate(Process* p) Uint heap_size; Eterm* heap; Eterm* htop; - Rootset rootset; - char* src; - Uint src_size; Uint actual_size; char* area; Uint area_size; Sint offs; + int reds; if (p->flags & F_DISABLE_GC) ERTS_INTERNAL_ERROR("GC disabled"); @@ -549,8 +739,6 @@ erts_garbage_collect_hibernate(Process* p) */ erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); ErtsGcQuickSanityCheck(p); - ASSERT(p->mbuf_sz == 0); - ASSERT(p->mbuf == 0); ASSERT(p->stop == p->hend); /* Stack must be empty. */ /* @@ -558,46 +746,25 @@ erts_garbage_collect_hibernate(Process* p) */ - heap_size = p->heap_sz + (p->old_htop - p->old_heap); + heap_size = p->heap_sz + (p->old_htop - p->old_heap) + p->mbuf_sz; heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_TMP_HEAP, sizeof(Eterm)*heap_size); htop = heap; - (void) setup_rootset(p, p->arg_reg, p->arity, &rootset); -#if HIPE - hipe_empty_nstack(p); -#endif - - src = (char *) p->heap; - src_size = (char *) p->htop - src; - htop = sweep_rootset(&rootset, htop, src, src_size); - htop = sweep_one_area(heap, htop, src, src_size); - - if (p->old_heap) { - src = (char *) p->old_heap; - src_size = (char *) p->old_htop - src; - htop = sweep_rootset(&rootset, htop, src, src_size); - htop = sweep_one_area(heap, htop, src, src_size); - } - - cleanup_rootset(&rootset); - - if (MSO(p).first) { - sweep_off_heap(p, 1); - } + htop = full_sweep_heaps(p, + 1, + heap, + htop, + (char *) p->old_heap, + (char *) p->old_htop - (char *) p->old_heap, + p->arg_reg, + p->arity); - /* - * Update all pointers. - */ ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, - (void*)HEAP_START(p), - HEAP_SIZE(p) * sizeof(Eterm)); - if (p->old_heap) { - ERTS_HEAP_FREE(ERTS_ALC_T_OLD_HEAP, - (void*)p->old_heap, - (p->old_hend - p->old_heap) * sizeof(Eterm)); - p->old_heap = p->old_htop = p->old_hend = 0; - } + (p->abandoned_heap + ? p->abandoned_heap + : p->heap), + p->heap_sz * sizeof(Eterm)); p->heap = heap; p->high_water = htop; @@ -612,6 +779,7 @@ erts_garbage_collect_hibernate(Process* p) } FLAGS(p) &= ~F_FORCE_GC; + p->live_hf_end = ERTS_INVALID_HFRAG_PTR; /* * Move the heap to its final destination. @@ -631,6 +799,8 @@ erts_garbage_collect_hibernate(Process* p) sys_memcpy((void *) heap, (void *) p->heap, actual_size*sizeof(Eterm)); ERTS_HEAP_FREE(ERTS_ALC_T_TMP_HEAP, p->heap, p->heap_sz*sizeof(Eterm)); + remove_message_buffers(p); + p->stop = p->hend = heap + heap_size; offs = heap - p->heap; @@ -659,15 +829,18 @@ erts_garbage_collect_hibernate(Process* p) ErtsGcQuickSanityCheck(p); erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC); + + reds = gc_cost(actual_size, actual_size); + BUMP_REDS(p, reds); } void erts_garbage_collect_literals(Process* p, Eterm* literals, - Uint lit_size, + Uint byte_lit_size, struct erl_off_heap_header* oh) { - Uint byte_lit_size = sizeof(Eterm)*lit_size; + Uint lit_size = byte_lit_size / sizeof(Eterm); Uint old_heap_size; Eterm* temp_lit; Sint offs; @@ -743,7 +916,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, if (IS_MOVED_BOXED(val)) { ASSERT(is_boxed(val)); *g_ptr++ = val; - } else if (in_area(ptr, area, area_size)) { + } else if (ErtsInArea(ptr, area, area_size)) { MOVE_BOXED(ptr,val,old_htop,g_ptr++); } else { g_ptr++; @@ -754,7 +927,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, val = *ptr; if (IS_MOVED_CONS(val)) { /* Moved */ *g_ptr++ = ptr[1]; - } else if (in_area(ptr, area, area_size)) { + } else if (ErtsInArea(ptr, area, area_size)) { MOVE_CONS(ptr,val,old_htop,g_ptr++); } else { g_ptr++; @@ -774,8 +947,10 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, * Now we'll have to go through all heaps updating all other references. */ - old_htop = sweep_one_heap(p->heap, p->htop, old_htop, area, area_size); - old_htop = sweep_one_area(p->old_heap, old_htop, area, area_size); + old_htop = sweep_literals_to_old_heap(p->heap, p->htop, old_htop, area, area_size); + old_htop = sweep_literal_area(p->old_heap, old_htop, + (char *) p->old_heap, sizeof(Eterm)*old_heap_size, + area, area_size); ASSERT(p->old_htop <= old_htop && old_htop <= p->old_hend); p->old_htop = old_htop; @@ -834,15 +1009,18 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, } static int -minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) +minor_collection(Process* p, ErlHeapFragment *live_hf_end, + int need, Eterm* objv, int nobj, Uint *recl) { - Uint mature = HIGH_WATER(p) - HEAP_START(p); + Eterm *mature = p->abandoned_heap ? p->abandoned_heap : p->heap; + Uint mature_size = p->high_water - mature; + Uint size_before = young_gen_usage(p); /* * Allocate an old heap if we don't have one and if we'll need one. */ - if (OLD_HEAP(p) == NULL && mature != 0) { + if (OLD_HEAP(p) == NULL && mature_size != 0) { Eterm* n_old; /* Note: We choose a larger heap size than strictly needed, @@ -850,7 +1028,7 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) * This improved Estone by more than 1200 estones on my computer * (Ultra Sparc 10). */ - Uint new_sz = erts_next_heap_size(HEAP_TOP(p) - HEAP_START(p), 1); + Uint new_sz = erts_next_heap_size(size_before, 1); /* Create new, empty old_heap */ n_old = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_OLD_HEAP, @@ -866,41 +1044,32 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) */ if (OLD_HEAP(p) && - ((mature <= OLD_HEND(p) - OLD_HTOP(p)) && - ((BIN_VHEAP_MATURE(p) < ( BIN_OLD_VHEAP_SZ(p) - BIN_OLD_VHEAP(p)))) && - ((BIN_OLD_VHEAP_SZ(p) > BIN_OLD_VHEAP(p))) ) ) { - ErlMessage *msgp; - Uint size_after; - Uint need_after; - const Uint stack_size = STACK_SZ_ON_HEAP(p); - const Uint size_before = MBUF_SIZE(p) + (HEAP_TOP(p) - HEAP_START(p)); - Uint new_sz = HEAP_SIZE(p) + MBUF_SIZE(p) + combined_message_size(p); + ((mature_size <= OLD_HEND(p) - OLD_HTOP(p)) && + ((BIN_OLD_VHEAP_SZ(p) > BIN_OLD_VHEAP(p))) ) ) { + Eterm *prev_old_htop; + Uint stack_size, size_after, adjust_size, need_after, new_sz, new_mature; + + stack_size = p->hend - p->stop; + new_sz = stack_size + size_before; new_sz = next_heap_size(p, new_sz, 0); - do_minor(p, new_sz, objv, nobj); + prev_old_htop = p->old_htop; + do_minor(p, live_hf_end, (char *) mature, mature_size*sizeof(Eterm), + new_sz, objv, nobj); + + if (p->flags & F_ON_HEAP_MSGQ) + move_msgq_to_heap(p); - size_after = HEAP_TOP(p) - HEAP_START(p); + new_mature = p->old_htop - prev_old_htop; + + size_after = new_mature; + size_after += HEAP_TOP(p) - HEAP_START(p) + p->mbuf_sz; *recl += (size_before - size_after); - /* - * Copy newly received message onto the end of the new heap. - */ - ErtsGcQuickSanityCheck(p); - for (msgp = p->msg.first; msgp; msgp = msgp->next) { - if (msgp->data.attached) { - ErtsHeapFactory factory; - erts_factory_proc_prealloc_init(&factory, p, - erts_msg_attached_data_size(msgp)); - erts_move_msg_attached_data_to_heap(&factory, msgp); - erts_factory_close(&factory); - ErtsGcQuickSanityCheck(p); - } - } ErtsGcQuickSanityCheck(p); GEN_GCS(p)++; need_after = ((HEAP_TOP(p) - HEAP_START(p)) - + erts_used_frag_sz(MBUF(p)) + need + stack_size); @@ -913,6 +1082,8 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) * the heap size is substantial, we don't want to shrink. */ + adjust_size = 0; + if ((HEAP_SIZE(p) > 3000) && (4 * need_after < HEAP_SIZE(p)) && ((HEAP_SIZE(p) > 8000) || (HEAP_SIZE(p) > (OLD_HEND(p) - OLD_HEAP(p))))) { @@ -934,28 +1105,33 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) : next_heap_size(p, wanted, 0); if (wanted < HEAP_SIZE(p)) { shrink_new_heap(p, wanted, objv, nobj); + adjust_size = p->htop - p->heap; } - ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0)); - ASSERT(MBUF(p) == NULL); - return 1; /* We are done. */ + goto done; } if (HEAP_SIZE(p) >= need_after) { /* * The heap size turned out to be just right. We are done. */ - ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0)); - ASSERT(MBUF(p) == NULL); - return 1; + goto done; } + + grow_new_heap(p, next_heap_size(p, need_after, 0), objv, nobj); + adjust_size = p->htop - p->heap; + + done: + ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0)); + ASSERT(MBUF(p) == NULL); + + return gc_cost(size_after, adjust_size); } /* - * Still not enough room after minor collection. Must force a major collection. + * Not enough room for a minor collection. Must force a major collection. */ - FLAGS(p) |= F_NEED_FULLSWEEP; - return 0; + return -1; } /* @@ -1009,7 +1185,9 @@ static ERTS_INLINE void offset_nstack(Process* p, Sint offs, #endif /* HIPE */ static void -do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) +do_minor(Process *p, ErlHeapFragment *live_hf_end, + char *mature, Uint mature_size, + Uint new_sz, Eterm* objv, int nobj) { Rootset rootset; /* Rootset for GC (stack, dictionary, etc). */ Roots* roots; @@ -1018,17 +1196,24 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) Eterm* ptr; Eterm val; Eterm gval; - char* heap = (char *) HEAP_START(p); - Uint heap_size = (char *) HEAP_TOP(p) - heap; - Uint mature_size = (char *) HIGH_WATER(p) - heap; Eterm* old_htop = OLD_HTOP(p); Eterm* n_heap; + char* oh = (char *) OLD_HEAP(p); + Uint oh_size = (char *) OLD_HTOP(p) - oh; + + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] MINOR GC: %p %p %p %p\n", p->common.id, + HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p))); n_htop = n_heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm)*new_sz); - if (MBUF(p) != NULL) { - n_htop = collect_heap_frags(p, n_heap, n_htop, objv, nobj); + if (live_hf_end != ERTS_INVALID_HFRAG_PTR) { + /* + * Move heap frags that we know are completely live + * directly into the new young heap generation. + */ + n_htop = collect_live_heap_frags(p, live_hf_end, n_heap, n_htop, + objv, nobj); } n = setup_rootset(p, objv, nobj, &rootset); @@ -1051,9 +1236,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) if (IS_MOVED_BOXED(val)) { ASSERT(is_boxed(val)); *g_ptr++ = val; - } else if (in_area(ptr, heap, mature_size)) { + } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_BOXED(ptr,val,old_htop,g_ptr++); - } else if (in_area(ptr, heap, heap_size)) { + } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) { MOVE_BOXED(ptr,val,n_htop,g_ptr++); } else { g_ptr++; @@ -1066,9 +1251,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) val = *ptr; if (IS_MOVED_CONS(val)) { /* Moved */ *g_ptr++ = ptr[1]; - } else if (in_area(ptr, heap, mature_size)) { + } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_CONS(ptr,val,old_htop,g_ptr++); - } else if (in_area(ptr, heap, heap_size)) { + } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) { MOVE_CONS(ptr,val,n_htop,g_ptr++); } else { g_ptr++; @@ -1093,7 +1278,7 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) */ if (mature_size == 0) { - n_htop = sweep_one_area(n_heap, n_htop, heap, heap_size); + n_htop = sweep_new_heap(n_heap, n_htop, oh, oh_size); } else { Eterm* n_hp = n_heap; Eterm* ptr; @@ -1110,9 +1295,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) if (IS_MOVED_BOXED(val)) { ASSERT(is_boxed(val)); *n_hp++ = val; - } else if (in_area(ptr, heap, mature_size)) { + } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_BOXED(ptr,val,old_htop,n_hp++); - } else if (in_area(ptr, heap, heap_size)) { + } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) { MOVE_BOXED(ptr,val,n_htop,n_hp++); } else { n_hp++; @@ -1124,9 +1309,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) val = *ptr; if (IS_MOVED_CONS(val)) { *n_hp++ = ptr[1]; - } else if (in_area(ptr, heap, mature_size)) { + } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_CONS(ptr,val,old_htop,n_hp++); - } else if (in_area(ptr, heap, heap_size)) { + } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) { MOVE_CONS(ptr,val,n_htop,n_hp++); } else { n_hp++; @@ -1146,10 +1331,10 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) if (IS_MOVED_BOXED(val)) { *origptr = val; mb->base = binary_bytes(val); - } else if (in_area(ptr, heap, mature_size)) { + } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_BOXED(ptr,val,old_htop,origptr); mb->base = binary_bytes(mb->orig); - } else if (in_area(ptr, heap, heap_size)) { + } else if (ErtsInYoungGen(*origptr, ptr, oh, oh_size)) { MOVE_BOXED(ptr,val,n_htop,origptr); mb->base = binary_bytes(mb->orig); } @@ -1170,9 +1355,8 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) * may point to the old (soon to be deleted) new_heap. */ - if (OLD_HTOP(p) < old_htop) { - old_htop = sweep_one_area(OLD_HTOP(p), old_htop, heap, heap_size); - } + if (OLD_HTOP(p) < old_htop) + old_htop = sweep_new_heap(OLD_HTOP(p), old_htop, oh, oh_size); OLD_HTOP(p) = old_htop; HIGH_WATER(p) = n_htop; @@ -1204,8 +1388,12 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) #endif ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, - (void*)HEAP_START(p), + (p->abandoned_heap + ? p->abandoned_heap + : HEAP_START(p)), HEAP_SIZE(p) * sizeof(Eterm)); + p->abandoned_heap = NULL; + p->flags &= ~F_ABANDONED_HEAP_USE; HEAP_START(p) = n_heap; HEAP_TOP(p) = n_htop; HEAP_SIZE(p) = new_sz; @@ -1222,31 +1410,30 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) */ static int -major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) +major_collection(Process* p, ErlHeapFragment *live_hf_end, + int need, Eterm* objv, int nobj, Uint *recl) { - Rootset rootset; - Roots* roots; - const Uint size_before = ((HEAP_TOP(p) - HEAP_START(p)) - + (OLD_HTOP(p) - OLD_HEAP(p)) - + MBUF_SIZE(p)); + Uint size_before, size_after, stack_size; Eterm* n_heap; Eterm* n_htop; - char* src = (char *) HEAP_START(p); - Uint src_size = (char *) HEAP_TOP(p) - src; char* oh = (char *) OLD_HEAP(p); Uint oh_size = (char *) OLD_HTOP(p) - oh; - Uint n; - Uint new_sz; - int done; + Uint new_sz, stk_sz; + int adjusted; + + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] MAJOR GC: %p %p %p %p\n", p->common.id, + HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p))); /* * Do a fullsweep GC. First figure out the size of the heap * to receive all live data. */ - new_sz = (HEAP_SIZE(p) + MBUF_SIZE(p) - + combined_message_size(p) - + (OLD_HTOP(p) - OLD_HEAP(p))); + size_before = young_gen_usage(p); + size_before += p->old_htop - p->old_heap; + stack_size = p->hend - p->stop; + + new_sz = stack_size + size_before; new_sz = next_heap_size(p, new_sz, 0); /* @@ -1260,13 +1447,76 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) n_htop = n_heap = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm)*new_sz); - /* - * Get rid of heap fragments. - */ + if (live_hf_end != ERTS_INVALID_HFRAG_PTR) { + /* + * Move heap frags that we know are completely live + * directly into the heap. + */ + n_htop = collect_live_heap_frags(p, live_hf_end, n_heap, n_htop, + objv, nobj); + } - if (MBUF(p) != NULL) { - n_htop = collect_heap_frags(p, n_heap, n_htop, objv, nobj); + n_htop = full_sweep_heaps(p, 0, n_heap, n_htop, oh, oh_size, objv, nobj); + + /* Move the stack to the end of the heap */ + stk_sz = HEAP_END(p) - p->stop; + sys_memcpy(n_heap + new_sz - stk_sz, p->stop, stk_sz * sizeof(Eterm)); + p->stop = n_heap + new_sz - stk_sz; + +#ifdef USE_VM_PROBES + if (HEAP_SIZE(p) != new_sz && DTRACE_ENABLED(process_heap_grow)) { + DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE); + + dtrace_proc_str(p, pidbuf); + DTRACE3(process_heap_grow, pidbuf, HEAP_SIZE(p), new_sz); } +#endif + + ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, + (p->abandoned_heap + ? p->abandoned_heap + : HEAP_START(p)), + p->heap_sz * sizeof(Eterm)); + p->abandoned_heap = NULL; + p->flags &= ~F_ABANDONED_HEAP_USE; + HEAP_START(p) = n_heap; + HEAP_TOP(p) = n_htop; + HEAP_SIZE(p) = new_sz; + HEAP_END(p) = n_heap + new_sz; + GEN_GCS(p) = 0; + + HIGH_WATER(p) = HEAP_TOP(p); + + remove_message_buffers(p); + + if (p->flags & F_ON_HEAP_MSGQ) + move_msgq_to_heap(p); + + ErtsGcQuickSanityCheck(p); + + size_after = HEAP_TOP(p) - HEAP_START(p) + p->mbuf_sz; + *recl += size_before - size_after; + + adjusted = adjust_after_fullsweep(p, need, objv, nobj); + +#ifdef HARDDEBUG + disallow_heap_frag_ref_in_heap(p); +#endif + ErtsGcQuickSanityCheck(p); + + return gc_cost(size_after, adjusted ? size_after : 0); +} + +static Eterm * +full_sweep_heaps(Process *p, + int hibernate, + Eterm *n_heap, Eterm* n_htop, + char *oh, Uint oh_size, + Eterm *objv, int nobj) +{ + Rootset rootset; + Roots *roots; + Uint n; /* * Copy all top-level terms directly referenced by the rootset to @@ -1274,7 +1524,14 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) */ n = setup_rootset(p, objv, nobj, &rootset); - n_htop = fullsweep_nstack(p, n_htop); + +#ifdef HIPE + if (hibernate) + hipe_empty_nstack(p); + else + n_htop = fullsweep_nstack(p, n_htop); +#endif + roots = rootset.roots; while (n--) { Eterm* g_ptr = roots->v; @@ -1294,7 +1551,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) if (IS_MOVED_BOXED(val)) { ASSERT(is_boxed(val)); *g_ptr++ = val; - } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) { + } else if (!erts_is_literal(gval, ptr)) { MOVE_BOXED(ptr,val,n_htop,g_ptr++); } else { g_ptr++; @@ -1307,7 +1564,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) val = *ptr; if (IS_MOVED_CONS(val)) { *g_ptr++ = ptr[1]; - } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) { + } else if (!erts_is_literal(gval, ptr)) { MOVE_CONS(ptr,val,n_htop,g_ptr++); } else { g_ptr++; @@ -1332,74 +1589,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) * until all is copied. */ - if (oh_size == 0) { - n_htop = sweep_one_area(n_heap, n_htop, src, src_size); - } else { - Eterm* n_hp = n_heap; - - while (n_hp != n_htop) { - Eterm* ptr; - Eterm val; - Eterm gval = *n_hp; - - switch (primary_tag(gval)) { - case TAG_PRIMARY_BOXED: { - ptr = boxed_val(gval); - val = *ptr; - if (IS_MOVED_BOXED(val)) { - ASSERT(is_boxed(val)); - *n_hp++ = val; - } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) { - MOVE_BOXED(ptr,val,n_htop,n_hp++); - } else { - n_hp++; - } - break; - } - case TAG_PRIMARY_LIST: { - ptr = list_val(gval); - val = *ptr; - if (IS_MOVED_CONS(val)) { - *n_hp++ = ptr[1]; - } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) { - MOVE_CONS(ptr,val,n_htop,n_hp++); - } else { - n_hp++; - } - break; - } - case TAG_PRIMARY_HEADER: { - if (!header_is_thing(gval)) - n_hp++; - else { - if (header_is_bin_matchstate(gval)) { - ErlBinMatchState *ms = (ErlBinMatchState*) n_hp; - ErlBinMatchBuffer *mb = &(ms->mb); - Eterm* origptr; - origptr = &(mb->orig); - ptr = boxed_val(*origptr); - val = *ptr; - if (IS_MOVED_BOXED(val)) { - *origptr = val; - mb->base = binary_bytes(*origptr); - } else if (in_area(ptr, src, src_size) || - in_area(ptr, oh, oh_size)) { - MOVE_BOXED(ptr,val,n_htop,origptr); - mb->base = binary_bytes(*origptr); - ptr = boxed_val(*origptr); - val = *ptr; - } - } - n_hp += (thing_arityval(gval)+1); - } - break; - } - default: - n_hp++; - break; - } - } - } + n_htop = sweep_heaps(n_heap, n_htop, oh, oh_size); if (MSO(p).first) { sweep_off_heap(p, 1); @@ -1412,75 +1602,13 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) OLD_HEAP(p) = OLD_HTOP(p) = OLD_HEND(p) = NULL; } - /* Move the stack to the end of the heap */ - n = HEAP_END(p) - p->stop; - sys_memcpy(n_heap + new_sz - n, p->stop, n * sizeof(Eterm)); - p->stop = n_heap + new_sz - n; - -#ifdef USE_VM_PROBES - if (HEAP_SIZE(p) != new_sz && DTRACE_ENABLED(process_heap_grow)) { - DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE); - - dtrace_proc_str(p, pidbuf); - DTRACE3(process_heap_grow, pidbuf, HEAP_SIZE(p), new_sz); - } -#endif - - ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, - (void *) HEAP_START(p), - (HEAP_END(p) - HEAP_START(p)) * sizeof(Eterm)); - HEAP_START(p) = n_heap; - HEAP_TOP(p) = n_htop; - HEAP_SIZE(p) = new_sz; - HEAP_END(p) = n_heap + new_sz; - GEN_GCS(p) = 0; - - HIGH_WATER(p) = HEAP_TOP(p); - - ErtsGcQuickSanityCheck(p); - - *recl += size_before - (HEAP_TOP(p) - HEAP_START(p)); - - remove_message_buffers(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) { - ErtsHeapFactory factory; - erts_factory_proc_prealloc_init(&factory, p, - erts_msg_attached_data_size(msgp)); - erts_move_msg_attached_data_to_heap(&factory, msgp); - erts_factory_close(&factory); - ErtsGcQuickSanityCheck(p); - } - } - } - - if (MBUF(p)) { - /* This is a very rare case when distributed messages copied above - * contained maps so big they did not fit on the heap causing the - * factory to create heap frags. - * Solution: Trigger a minor gc (without tenuring) - */ - HIGH_WATER(p) = HEAP_START(p); - done = 0; - } else { - adjust_after_fullsweep(p, need, objv, nobj); - done = 1; - } - - ErtsGcQuickSanityCheck(p); - return done; + return n_htop; } -static void +static int adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj) { + int adjusted = 0; Uint wanted, sz, need_after; Uint stack_size = STACK_SZ_ON_HEAP(p); @@ -1493,6 +1621,7 @@ adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj) /* Too small - grow to match requested need */ sz = next_heap_size(p, need_after, 0); grow_new_heap(p, sz, objv, nobj); + adjusted = 1; } else if (3 * HEAP_SIZE(p) < 4 * need_after){ /* Need more than 75% of current, postpone to next GC.*/ FLAGS(p) |= F_HEAP_GROW; @@ -1509,25 +1638,10 @@ adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj) if (sz < HEAP_SIZE(p)) { shrink_new_heap(p, sz, objv, nobj); + adjusted = 1; } } -} - -/* - * Return the size of all message buffers that are NOT linked in the - * mbuf list. - */ -static Uint -combined_message_size(Process* p) -{ - Uint sz; - ErlMessage *msgp; - - for (sz = 0, msgp = p->msg.first; msgp; msgp = msgp->next) { - if (msgp->data.attached) - sz += erts_msg_attached_data_size(msgp); - } - return sz; + return adjusted; } /* @@ -1540,6 +1654,10 @@ remove_message_buffers(Process* p) free_message_buffer(MBUF(p)); MBUF(p) = NULL; } + if (p->msg_frag) { + erts_cleanup_messages(p->msg_frag); + p->msg_frag = NULL; + } MBUF_SIZE(p) = 0; } #ifdef HARDDEBUG @@ -1551,64 +1669,6 @@ remove_message_buffers(Process* p) * For performance reasons, we use _unchecked_list_val(), _unchecked_boxed_val(), * and so on to avoid a function call. */ - -static void -disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj) -{ - ErlHeapFragment* mbuf; - ErlHeapFragment* qb; - Eterm gval; - Eterm* ptr; - Eterm val; - - ASSERT(p->htop != NULL); - mbuf = MBUF(p); - - while (nobj--) { - gval = *objv; - - switch (primary_tag(gval)) { - - case TAG_PRIMARY_BOXED: { - ptr = _unchecked_boxed_val(gval); - val = *ptr; - if (IS_MOVED_BOXED(val)) { - ASSERT(is_boxed(val)); - objv++; - } else { - for (qb = mbuf; qb != NULL; qb = qb->next) { - if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) { - abort(); - } - } - objv++; - } - break; - } - - case TAG_PRIMARY_LIST: { - ptr = _unchecked_list_val(gval); - val = *ptr; - if (IS_MOVED_CONS(val)) { - objv++; - } else { - for (qb = mbuf; qb != NULL; qb = qb->next) { - if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) { - abort(); - } - } - objv++; - } - break; - } - - default: { - objv++; - break; - } - } - } -} static void disallow_heap_frag_ref_in_heap(Process* p) @@ -1636,9 +1696,9 @@ disallow_heap_frag_ref_in_heap(Process* p) switch (primary_tag(val)) { case TAG_PRIMARY_BOXED: ptr = _unchecked_boxed_val(val); - if (!in_area(ptr, heap, heap_size)) { + if (!ErtsInArea(ptr, heap, heap_size)) { for (qb = MBUF(p); qb != NULL; qb = qb->next) { - if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) { + if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) { abort(); } } @@ -1646,9 +1706,9 @@ disallow_heap_frag_ref_in_heap(Process* p) break; case TAG_PRIMARY_LIST: ptr = _unchecked_list_val(val); - if (!in_area(ptr, heap, heap_size)) { + if (!ErtsInArea(ptr, heap, heap_size)) { for (qb = MBUF(p); qb != NULL; qb = qb->next) { - if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) { + if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) { abort(); } } @@ -1690,26 +1750,26 @@ disallow_heap_frag_ref_in_old_heap(Process* p) val = *hp++; switch (primary_tag(val)) { case TAG_PRIMARY_BOXED: - ptr = (Eterm *) EXPAND_POINTER(val); - if (!in_area(ptr, old_heap, old_heap_size)) { - if (in_area(ptr, new_heap, new_heap_size)) { + ptr = (Eterm *) val; + if (!ErtsInArea(ptr, old_heap, old_heap_size)) { + if (ErtsInArea(ptr, new_heap, new_heap_size)) { abort(); } for (qb = MBUF(p); qb != NULL; qb = qb->next) { - if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) { + if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) { abort(); } } } break; case TAG_PRIMARY_LIST: - ptr = (Eterm *) EXPAND_POINTER(val); - if (!in_area(ptr, old_heap, old_heap_size)) { - if (in_area(ptr, new_heap, new_heap_size)) { + ptr = (Eterm *) val; + if (!ErtsInArea(ptr, old_heap, old_heap_size)) { + if (ErtsInArea(ptr, new_heap, new_heap_size)) { abort(); } for (qb = MBUF(p); qb != NULL; qb = qb->next) { - if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) { + if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) { abort(); } } @@ -1718,7 +1778,7 @@ disallow_heap_frag_ref_in_old_heap(Process* p) case TAG_PRIMARY_HEADER: if (header_is_thing(val)) { hp += _unchecked_thing_arityval(val); - if (!in_area(hp, old_heap, old_heap_size+1)) { + if (!ErtsInArea(hp, old_heap, old_heap_size+1)) { abort(); } } @@ -1728,66 +1788,30 @@ disallow_heap_frag_ref_in_old_heap(Process* p) } #endif -static Eterm* -sweep_rootset(Rootset* rootset, Eterm* htop, char* src, Uint src_size) +typedef enum { + ErtsSweepNewHeap, + ErtsSweepHeaps, + ErtsSweepLiteralArea +} ErtsSweepType; + +static ERTS_FORCE_INLINE Eterm * +sweep(Eterm *n_hp, Eterm *n_htop, + ErtsSweepType type, + char *oh, Uint ohsz, + char *src, Uint src_size) { - Roots* roots = rootset->roots; - Uint n = rootset->num_roots; Eterm* ptr; - Eterm gval; Eterm val; + Eterm gval; - while (n--) { - Eterm* g_ptr = roots->v; - Uint g_sz = roots->sz; - - roots++; - while (g_sz--) { - gval = *g_ptr; - - switch (primary_tag(gval)) { - case TAG_PRIMARY_BOXED: { - ptr = boxed_val(gval); - val = *ptr; - if (IS_MOVED_BOXED(val)) { - ASSERT(is_boxed(val)); - *g_ptr++ = val; - } else if (in_area(ptr, src, src_size)) { - MOVE_BOXED(ptr,val,htop,g_ptr++); - } else { - g_ptr++; - } - break; - } - case TAG_PRIMARY_LIST: { - ptr = list_val(gval); - val = *ptr; - if (IS_MOVED_CONS(val)) { - *g_ptr++ = ptr[1]; - } else if (in_area(ptr, src, src_size)) { - MOVE_CONS(ptr,val,htop,g_ptr++); - } else { - g_ptr++; - } - break; - } - - default: - g_ptr++; - break; - } - } - } - return htop; -} - +#undef ERTS_IS_IN_SWEEP_AREA -static Eterm* -sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size) -{ - Eterm* ptr; - Eterm val; - Eterm gval; +#define ERTS_IS_IN_SWEEP_AREA(TPtr, Ptr) \ + (type == ErtsSweepHeaps \ + ? !erts_is_literal((TPtr), (Ptr)) \ + : (type == ErtsSweepNewHeap \ + ? ErtsInYoungGen((TPtr), (Ptr), oh, ohsz) \ + : ErtsInArea((Ptr), src, src_size))) while (n_hp != n_htop) { ASSERT(n_hp < n_htop); @@ -1799,7 +1823,7 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size) if (IS_MOVED_BOXED(val)) { ASSERT(is_boxed(val)); *n_hp++ = val; - } else if (in_area(ptr, src, src_size)) { + } else if (ERTS_IS_IN_SWEEP_AREA(gval, ptr)) { MOVE_BOXED(ptr,val,n_htop,n_hp++); } else { n_hp++; @@ -1811,7 +1835,7 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size) val = *ptr; if (IS_MOVED_CONS(val)) { *n_hp++ = ptr[1]; - } else if (in_area(ptr, src, src_size)) { + } else if (ERTS_IS_IN_SWEEP_AREA(gval, ptr)) { MOVE_CONS(ptr,val,n_htop,n_hp++); } else { n_hp++; @@ -1832,7 +1856,7 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size) if (IS_MOVED_BOXED(val)) { *origptr = val; mb->base = binary_bytes(*origptr); - } else if (in_area(ptr, src, src_size)) { + } else if (ERTS_IS_IN_SWEEP_AREA(*origptr, ptr)) { MOVE_BOXED(ptr,val,n_htop,origptr); mb->base = binary_bytes(*origptr); } @@ -1847,10 +1871,41 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size) } } return n_htop; +#undef ERTS_IS_IN_SWEEP_AREA +} + +static Eterm * +sweep_new_heap(Eterm *n_hp, Eterm *n_htop, char* old_heap, Uint old_heap_size) +{ + return sweep(n_hp, n_htop, + ErtsSweepNewHeap, + old_heap, old_heap_size, + NULL, 0); +} + +static Eterm * +sweep_heaps(Eterm *n_hp, Eterm *n_htop, char* old_heap, Uint old_heap_size) +{ + return sweep(n_hp, n_htop, + ErtsSweepHeaps, + old_heap, old_heap_size, + NULL, 0); +} + +static Eterm * +sweep_literal_area(Eterm *n_hp, Eterm *n_htop, + char* old_heap, Uint old_heap_size, + char* src, Uint src_size) +{ + return sweep(n_hp, n_htop, + ErtsSweepLiteralArea, + old_heap, old_heap_size, + src, src_size); } static Eterm* -sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint src_size) +sweep_literals_to_old_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, + char* src, Uint src_size) { while (heap_ptr < heap_end) { Eterm* ptr; @@ -1864,7 +1919,7 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr if (IS_MOVED_BOXED(val)) { ASSERT(is_boxed(val)); *heap_ptr++ = val; - } else if (in_area(ptr, src, src_size)) { + } else if (ErtsInArea(ptr, src, src_size)) { MOVE_BOXED(ptr,val,htop,heap_ptr++); } else { heap_ptr++; @@ -1876,7 +1931,7 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr val = *ptr; if (IS_MOVED_CONS(val)) { *heap_ptr++ = ptr[1]; - } else if (in_area(ptr, src, src_size)) { + } else if (ErtsInArea(ptr, src, src_size)) { MOVE_CONS(ptr,val,htop,heap_ptr++); } else { heap_ptr++; @@ -1897,7 +1952,7 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr if (IS_MOVED_BOXED(val)) { *origptr = val; mb->base = binary_bytes(*origptr); - } else if (in_area(ptr, src, src_size)) { + } else if (ErtsInArea(ptr, src, src_size)) { MOVE_BOXED(ptr,val,htop,origptr); mb->base = binary_bytes(*origptr); } @@ -1948,43 +2003,21 @@ move_one_area(Eterm* n_htop, char* src, Uint src_size) */ static Eterm* -collect_heap_frags(Process* p, Eterm* n_hstart, Eterm* n_htop, - Eterm* objv, int nobj) +collect_live_heap_frags(Process* p, ErlHeapFragment *live_hf_end, + Eterm* n_hstart, Eterm* n_htop, + Eterm* objv, int nobj) { ErlHeapFragment* qb; char* frag_begin; Uint frag_size; /* - * We don't allow references to a heap fragments from the stack, heap, - * or process dictionary. - */ -#ifdef HARDDEBUG - disallow_heap_frag_ref(p, n_htop, p->stop, STACK_START(p) - p->stop); - if (p->dictionary != NULL) { - disallow_heap_frag_ref(p, n_htop, p->dictionary->data, p->dictionary->used); - } - /* OTP-18: Actually we do allow references from heap to heap fragments now. - This can happen when doing "binary_to_term" with a "fat" map contained - in another term. A "fat" map is a hashmap with higher heap demand than - first estimated by "binary_to_term" causing the factory to allocate - additional heap (fragments) for the hashmap tree nodes. - Run map_SUITE:t_gc_rare_map_overflow to provoke this. - - Inverted references like this does not matter however. The copy done - below by move_one_area() with move markers in the fragments and the - sweeping done later by the GC should make everything ok in the end. - */ - /***disallow_heap_frag_ref_in_heap(p);***/ -#endif - - /* * Move the heap fragments to the new heap. Note that no GC is done on * the heap fragments. Any garbage will thus be moved as well and survive * until next GC. */ qb = MBUF(p); - while (qb != NULL) { + while (qb != live_hf_end) { ASSERT(!qb->off_heap.first); /* process fragments use the MSO(p) list */ frag_size = qb->used_size * sizeof(Eterm); if (frag_size != 0) { @@ -1996,12 +2029,195 @@ collect_heap_frags(Process* p, Eterm* n_hstart, Eterm* n_htop, return n_htop; } +static ERTS_INLINE void +copy_one_frag(Eterm** hpp, ErlOffHeap* off_heap, + ErlHeapFragment *bp, Eterm *refs, int nrefs) +{ + Uint sz; + int i; + Sint offs; + struct erl_off_heap_header* oh; + Eterm *fhp, *hp; + + OH_OVERHEAD(off_heap, bp->off_heap.overhead); + sz = bp->used_size; + + fhp = bp->mem; + hp = *hpp; + offs = hp - fhp; + + oh = NULL; + while (sz--) { + Uint cpy_sz; + Eterm val = *fhp++; + + switch (primary_tag(val)) { + case TAG_PRIMARY_IMMED1: + *hp++ = val; + break; + case TAG_PRIMARY_LIST: +#ifdef SHCOPY_SEND + if (erts_is_literal(val,list_val(val))) { + *hp++ = val; + } else { + *hp++ = offset_ptr(val, offs); + } +#else + *hp++ = offset_ptr(val, offs); +#endif + break; + case TAG_PRIMARY_BOXED: +#ifdef SHCOPY_SEND + if (erts_is_literal(val,boxed_val(val))) { + *hp++ = val; + } else { + *hp++ = offset_ptr(val, offs); + } +#else + *hp++ = offset_ptr(val, offs); +#endif + break; + case TAG_PRIMARY_HEADER: + *hp++ = val; + switch (val & _HEADER_SUBTAG_MASK) { + case ARITYVAL_SUBTAG: + break; + case REFC_BINARY_SUBTAG: + case FUN_SUBTAG: + case EXTERNAL_PID_SUBTAG: + case EXTERNAL_PORT_SUBTAG: + case EXTERNAL_REF_SUBTAG: + oh = (struct erl_off_heap_header*) (hp-1); + cpy_sz = thing_arityval(val); + goto cpy_words; + default: + cpy_sz = header_arity(val); + + cpy_words: + ASSERT(sz >= cpy_sz); + sz -= cpy_sz; + while (cpy_sz >= 8) { + cpy_sz -= 8; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + } + switch (cpy_sz) { + case 7: *hp++ = *fhp++; + case 6: *hp++ = *fhp++; + case 5: *hp++ = *fhp++; + case 4: *hp++ = *fhp++; + case 3: *hp++ = *fhp++; + case 2: *hp++ = *fhp++; + case 1: *hp++ = *fhp++; + default: break; + } + if (oh) { + /* Add to offheap list */ + oh->next = off_heap->first; + off_heap->first = oh; + ASSERT(*hpp <= (Eterm*)oh); + ASSERT(hp > (Eterm*)oh); + oh = NULL; + } + break; + } + break; + } + } + + ASSERT(bp->used_size == hp - *hpp); + *hpp = hp; + + for (i = 0; i < nrefs; i++) { + if (is_not_immed(refs[i])) + refs[i] = offset_ptr(refs[i], offs); + } + bp->off_heap.first = NULL; +} + +static void +move_msgq_to_heap(Process *p) +{ + ErtsMessage **mpp = &p->msg.first; + + while (*mpp) { + ErtsMessage *mp = *mpp; + + if (mp->data.attached) { + ErlHeapFragment *bp; + ErtsHeapFactory factory; + + erts_factory_proc_prealloc_init(&factory, p, + erts_msg_attached_data_size(mp)); + + if (is_non_value(ERL_MESSAGE_TERM(mp))) { + if (mp->data.dist_ext) { + ASSERT(mp->data.dist_ext->heap_size >= 0); + if (is_not_nil(ERL_MESSAGE_TOKEN(mp))) { + bp = erts_dist_ext_trailer(mp->data.dist_ext); + ERL_MESSAGE_TOKEN(mp) = copy_struct(ERL_MESSAGE_TOKEN(mp), + bp->used_size, + &factory.hp, + factory.off_heap); + erts_cleanup_offheap(&bp->off_heap); + } + ERL_MESSAGE_TERM(mp) = erts_decode_dist_ext(&factory, + mp->data.dist_ext); + erts_free_dist_ext_copy(mp->data.dist_ext); + mp->data.dist_ext = NULL; + } + } + else { + + if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG) + bp = &mp->hfrag; + else + bp = mp->data.heap_frag; + + if (bp->next) + erts_move_multi_frags(&factory.hp, factory.off_heap, bp, + mp->m, ERL_MESSAGE_REF_ARRAY_SZ, 0); + else + copy_one_frag(&factory.hp, factory.off_heap, bp, + mp->m, ERL_MESSAGE_REF_ARRAY_SZ); + + if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG) { + mp->data.heap_frag = NULL; + free_message_buffer(bp); + } + else { + ErtsMessage *tmp = erts_alloc_message(0, NULL); + sys_memcpy((void *) tmp->m, (void *) mp->m, + sizeof(Eterm)*ERL_MESSAGE_REF_ARRAY_SZ); + tmp->next = mp->next; + if (p->msg.save == &mp->next) + p->msg.save = &tmp->next; + if (p->msg.last == &mp->next) + p->msg.last = &tmp->next; + *mpp = tmp; + mp->next = NULL; + erts_cleanup_messages(mp); + mp = tmp; + } + } + + erts_factory_close(&factory); + } + + mpp = &(*mpp)->next; + } +} + static Uint setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) { - Uint avail; Roots* roots; - ErlMessage* mp; Uint n; n = 0; @@ -2013,8 +2229,8 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) ++n; if (p->dictionary != NULL) { - roots[n].v = p->dictionary->data; - roots[n].sz = p->dictionary->used; + roots[n].v = ERTS_PD_START(p->dictionary); + roots[n].sz = ERTS_PD_SIZE(p->dictionary); ++n; } if (nobj > 0) { @@ -2024,7 +2240,7 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) } ASSERT((is_nil(p->seq_trace_token) || - is_tuple(follow_moved(p->seq_trace_token)) || + is_tuple(follow_moved(p->seq_trace_token, (Eterm) 0)) || is_atom(p->seq_trace_token))); if (is_not_immed(p->seq_trace_token)) { roots[n].v = &p->seq_trace_token; @@ -2038,11 +2254,9 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) n++; } #endif - ASSERT(is_nil(ERTS_TRACER_PROC(p)) || - is_internal_pid(ERTS_TRACER_PROC(p)) || - is_internal_port(ERTS_TRACER_PROC(p))); + ASSERT(IS_TRACER_VALID(ERTS_TRACER(p))); - ASSERT(is_pid(follow_moved(p->group_leader))); + ASSERT(is_pid(follow_moved(p->group_leader, (Eterm) 0))); if (is_not_immed(p->group_leader)) { roots[n].v = &p->group_leader; roots[n].sz = 1; @@ -2079,31 +2293,47 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) ASSERT(n <= rootset->size); - mp = p->msg.first; - avail = rootset->size - n; - while (mp != NULL) { - if (avail == 0) { - Uint new_size = 2*rootset->size; - if (roots == rootset->def) { - roots = erts_alloc(ERTS_ALC_T_ROOTSET, - new_size*sizeof(Roots)); - sys_memcpy(roots, rootset->def, sizeof(rootset->def)); - } else { - roots = erts_realloc(ERTS_ALC_T_ROOTSET, - (void *) roots, - new_size*sizeof(Roots)); - } + switch (p->flags & (F_OFF_HEAP_MSGQ|F_OFF_HEAP_MSGQ_CHNG)) { + case F_OFF_HEAP_MSGQ|F_OFF_HEAP_MSGQ_CHNG: + (void) erts_move_messages_off_heap(p); + case F_OFF_HEAP_MSGQ: + break; + case F_OFF_HEAP_MSGQ_CHNG: + case 0: { + /* + * We do not have off heap message queue enabled, i.e. we + * need to add message queue to rootset... + */ + ErtsMessage *mp; + + /* Ensure large enough rootset... */ + if (n + p->msg.len > rootset->size) { + Uint new_size = n + p->msg.len; + ERTS_GC_ASSERT(roots == rootset->def); + roots = erts_alloc(ERTS_ALC_T_ROOTSET, + new_size*sizeof(Roots)); + sys_memcpy(roots, rootset->def, n*sizeof(Roots)); rootset->size = new_size; - avail = new_size - n; } - if (mp->data.attached == NULL) { - roots[n].v = mp->m; - roots[n].sz = 2; - n++; - avail--; + + for (mp = p->msg.first; mp; mp = mp->next) { + + if (!mp->data.attached) { + /* + * Message may refer data on heap; + * add it to rootset... + */ + roots[n].v = mp->m; + roots[n].sz = ERL_MESSAGE_REF_ARRAY_SZ; + n++; + } } - mp = mp->next; + break; + } } + + ASSERT(rootset->size >= n); + rootset->roots = roots; rootset->num_roots = n; return n; @@ -2343,11 +2573,11 @@ sweep_off_heap(Process *p, int fullsweep) */ while (ptr) { if (IS_MOVED_BOXED(ptr->thing_word)) { - ASSERT(!in_area(ptr, oheap, oheap_sz)); + ASSERT(!ErtsInArea(ptr, oheap, oheap_sz)); *prev = ptr = (struct erl_off_heap_header*) boxed_val(ptr->thing_word); ASSERT(!IS_MOVED_BOXED(ptr->thing_word)); if (ptr->thing_word == HEADER_PROC_BIN) { - int to_new_heap = !in_area(ptr, oheap, oheap_sz); + int to_new_heap = !ErtsInArea(ptr, oheap, oheap_sz); ASSERT(to_new_heap == !seen_mature || (!to_new_heap && (seen_mature=1))); if (to_new_heap) { bin_vheap += ptr->size / sizeof(Eterm); @@ -2361,7 +2591,7 @@ sweep_off_heap(Process *p, int fullsweep) ptr = ptr->next; } } - else if (!in_area(ptr, oheap, oheap_sz)) { + else if (!ErtsInArea(ptr, oheap, oheap_sz)) { /* garbage */ switch (thing_subtag(ptr->thing_word)) { case REFC_BINARY_SUBTAG: @@ -2393,7 +2623,7 @@ sweep_off_heap(Process *p, int fullsweep) * generational collection - keep objects in list. */ while (ptr) { - ASSERT(in_area(ptr, oheap, oheap_sz)); + ASSERT(ErtsInArea(ptr, oheap, oheap_sz)); ASSERT(!IS_MOVED_BOXED(ptr->thing_word)); if (ptr->thing_word == HEADER_PROC_BIN) { BIN_OLD_VHEAP(p) += ptr->size / sizeof(Eterm); /* for binary gc (words)*/ @@ -2412,7 +2642,6 @@ sweep_off_heap(Process *p, int fullsweep) } BIN_VHEAP_SZ(p) = next_vheap_size(p, bin_vheap, BIN_VHEAP_SZ(p)); MSO(p).overhead = bin_vheap; - BIN_VHEAP_MATURE(p) = bin_vheap; /* * If we got any shrink candidates, check them out. @@ -2483,7 +2712,7 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size) switch (primary_tag(val)) { case TAG_PRIMARY_LIST: case TAG_PRIMARY_BOXED: - if (in_area(ptr_val(val), area, area_size)) { + if (ErtsInArea(ptr_val(val), area, area_size)) { *hp = offset_ptr(val, offs); } hp++; @@ -2505,7 +2734,7 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size) { struct erl_off_heap_header* oh = (struct erl_off_heap_header*) hp; - if (in_area(oh->next, area, area_size)) { + if (ErtsInArea(oh->next, area, area_size)) { Eterm** uptr = (Eterm **) (void *) &oh->next; *uptr += offs; /* Patch the mso chain */ } @@ -2515,7 +2744,7 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size) { ErlBinMatchState *ms = (ErlBinMatchState*) hp; ErlBinMatchBuffer *mb = &(ms->mb); - if (in_area(ptr_val(mb->orig), area, area_size)) { + if (ErtsInArea(ptr_val(mb->orig), area, area_size)) { mb->orig = offset_ptr(mb->orig, offs); mb->base = binary_bytes(mb->orig); } @@ -2545,7 +2774,7 @@ offset_heap_ptr(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size) switch (primary_tag(val)) { case TAG_PRIMARY_LIST: case TAG_PRIMARY_BOXED: - if (in_area(ptr_val(val), area, area_size)) { + if (ErtsInArea(ptr_val(val), area, area_size)) { *hp = offset_ptr(val, offs); } hp++; @@ -2560,7 +2789,7 @@ offset_heap_ptr(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size) static void offset_off_heap(Process* p, Sint offs, char* area, Uint area_size) { - if (MSO(p).first && in_area((Eterm *)MSO(p).first, area, area_size)) { + if (MSO(p).first && ErtsInArea((Eterm *)MSO(p).first, area, area_size)) { Eterm** uptr = (Eterm**) (void *) &MSO(p).first; *uptr += offs; } @@ -2572,35 +2801,39 @@ offset_off_heap(Process* p, Sint offs, char* area, Uint area_size) static void offset_mqueue(Process *p, Sint offs, char* area, Uint area_size) { - ErlMessage* mp = p->msg.first; - - while (mp != NULL) { - Eterm mesg = ERL_MESSAGE_TERM(mp); - if (is_value(mesg)) { - switch (primary_tag(mesg)) { - case TAG_PRIMARY_LIST: - case TAG_PRIMARY_BOXED: - if (in_area(ptr_val(mesg), area, area_size)) { - ERL_MESSAGE_TERM(mp) = offset_ptr(mesg, offs); + ErtsMessage* mp = p->msg.first; + + if ((p->flags & (F_OFF_HEAP_MSGQ|F_OFF_HEAP_MSGQ_CHNG)) != F_OFF_HEAP_MSGQ) { + + while (mp != NULL) { + Eterm mesg = ERL_MESSAGE_TERM(mp); + if (is_value(mesg)) { + switch (primary_tag(mesg)) { + case TAG_PRIMARY_LIST: + case TAG_PRIMARY_BOXED: + if (ErtsInArea(ptr_val(mesg), area, area_size)) { + ERL_MESSAGE_TERM(mp) = offset_ptr(mesg, offs); + } + break; } - break; } - } - mesg = ERL_MESSAGE_TOKEN(mp); - if (is_boxed(mesg) && in_area(ptr_val(mesg), area, area_size)) { - ERL_MESSAGE_TOKEN(mp) = offset_ptr(mesg, offs); - } + mesg = ERL_MESSAGE_TOKEN(mp); + if (is_boxed(mesg) && ErtsInArea(ptr_val(mesg), area, area_size)) { + ERL_MESSAGE_TOKEN(mp) = offset_ptr(mesg, offs); + } #ifdef USE_VM_PROBES - mesg = ERL_MESSAGE_DT_UTAG(mp); - if (is_boxed(mesg) && in_area(ptr_val(mesg), area, area_size)) { - ERL_MESSAGE_DT_UTAG(mp) = offset_ptr(mesg, offs); - } + mesg = ERL_MESSAGE_DT_UTAG(mp); + if (is_boxed(mesg) && ErtsInArea(ptr_val(mesg), area, area_size)) { + ERL_MESSAGE_DT_UTAG(mp) = offset_ptr(mesg, offs); + } #endif - ASSERT((is_nil(ERL_MESSAGE_TOKEN(mp)) || - is_tuple(ERL_MESSAGE_TOKEN(mp)) || - is_atom(ERL_MESSAGE_TOKEN(mp)))); - mp = mp->next; + ASSERT((is_nil(ERL_MESSAGE_TOKEN(mp)) || + is_tuple(ERL_MESSAGE_TOKEN(mp)) || + is_atom(ERL_MESSAGE_TOKEN(mp)))); + mp = mp->next; + } + } } @@ -2609,8 +2842,8 @@ offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size, Eterm* objv, int nobj) { if (p->dictionary) { - offset_heap(p->dictionary->data, - p->dictionary->used, + offset_heap(ERTS_PD_START(p->dictionary), + ERTS_PD_SIZE(p->dictionary), offs, area, area_size); } @@ -2659,7 +2892,7 @@ reply_gc_info(void *vgcirp) Eterm **hpp; Uint sz, *szp; ErlOffHeap *ohp = NULL; - ErlHeapFragment *bp = NULL; + ErtsMessage *mp = NULL; ASSERT(esdp); @@ -2685,12 +2918,13 @@ reply_gc_info(void *vgcirp) if (hpp) break; - hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); + szp = NULL; hpp = &hp; } - erts_queue_message(rp, &rp_locks, bp, msg, NIL); + erts_queue_message(rp, &rp_locks, mp, msg); if (gcirp->req_sched == esdp->no) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -2737,41 +2971,125 @@ erts_gc_info_request(Process *c_p) return ref; } +Eterm +erts_process_gc_info(Process *p, Uint *sizep, Eterm **hpp) +{ + ERTS_DECL_AM(bin_vheap_size); + ERTS_DECL_AM(bin_vheap_block_size); + ERTS_DECL_AM(bin_old_vheap_size); + ERTS_DECL_AM(bin_old_vheap_block_size); + Eterm tags[] = { + /* If you increase the number of elements here, make sure to update + any call sites as they may have stack allocations that depend + on the number of elements here. */ + am_old_heap_block_size, + am_heap_block_size, + am_mbuf_size, + am_recent_size, + am_stack_size, + am_old_heap_size, + am_heap_size, + AM_bin_vheap_size, + AM_bin_vheap_block_size, + AM_bin_old_vheap_size, + AM_bin_old_vheap_block_size + }; + UWord values[] = { + OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0, + HEAP_SIZE(p), + MBUF_SIZE(p), + HIGH_WATER(p) - HEAP_START(p), + STACK_START(p) - p->stop, + OLD_HEAP(p) ? OLD_HTOP(p) - OLD_HEAP(p) : 0, + HEAP_TOP(p) - HEAP_START(p), + MSO(p).overhead, + BIN_VHEAP_SZ(p), + BIN_OLD_VHEAP(p), + BIN_OLD_VHEAP_SZ(p) + }; + + Eterm res = THE_NON_VALUE; + ErtsMessage *mp; + + ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(*tags)); + ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == ERTS_PROCESS_GC_INFO_MAX_TERMS); + + if (p->abandoned_heap) { + Eterm *htop, *heap; + ERTS_GET_ORIG_HEAP(p, heap, htop); + values[3] = HIGH_WATER(p) - heap; + values[6] = htop - heap; + } + + if (p->flags & F_ON_HEAP_MSGQ) { + /* If on heap messages in the internal queue are counted + as being part of the heap, so we have to add them to the + am_mbuf_size value. process_info(total_heap_size) should + be the same as adding old_heap_block_size + heap_block_size + + mbuf_size. + */ + for (mp = p->msg.first; mp; mp = mp->next) + if (mp->data.attached) + values[2] += erts_msg_attached_data_size(mp); + } + + res = erts_bld_atom_uword_2tup_list(hpp, + sizep, + sizeof(values)/sizeof(*values), + tags, + values); + + return res; +} + #if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG) static int within2(Eterm *ptr, Process *p, Eterm *real_htop) { - ErlHeapFragment* bp = MBUF(p); - ErlMessage* mp = p->msg.first; - Eterm *htop = real_htop ? real_htop : HEAP_TOP(p); + ErlHeapFragment* bp; + ErtsMessage* mp; + Eterm *htop, *heap; + + if (p->abandoned_heap) + ERTS_GET_ORIG_HEAP(p, heap, htop); + else { + heap = p->heap; + htop = real_htop ? real_htop : HEAP_TOP(p); + } if (OLD_HEAP(p) && (OLD_HEAP(p) <= ptr && ptr < OLD_HEND(p))) { return 1; } - if (HEAP_START(p) <= ptr && ptr < htop) { + if (heap <= ptr && ptr < htop) { return 1; } - while (bp != NULL) { - if (bp->mem <= ptr && ptr < bp->mem + bp->used_size) { - return 1; - } - bp = bp->next; - } + + mp = p->msg_frag; + bp = p->mbuf; + + if (bp) + goto search_heap_frags; + while (mp) { - if (mp->data.attached) { - ErlHeapFragment *hfp; - if (is_value(ERL_MESSAGE_TERM(mp))) - hfp = mp->data.heap_frag; - else if (is_not_nil(ERL_MESSAGE_TOKEN(mp))) - hfp = erts_dist_ext_trailer(mp->data.dist_ext); - else - hfp = NULL; - if (hfp && hfp->mem <= ptr && ptr < hfp->mem + hfp->used_size) + + if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG) + bp = &mp->hfrag; + else + bp = mp->data.heap_frag; + + mp = mp->next; + + search_heap_frags: + + while (bp) { + if (bp->mem <= ptr && ptr < bp->mem + bp->used_size) { return 1; + } + bp = bp->next; } - mp = mp->next; } + return 0; } @@ -2793,11 +3111,11 @@ do { \ __FILE__, __LINE__, #EXP); \ } while (0) + #ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_LIST # define ERTS_OFFHEAP_VISITED_BIT ((Eterm) 1 << 31) #endif - void erts_check_off_heap2(Process *p, Eterm *htop) { @@ -2826,7 +3144,7 @@ erts_check_off_heap2(Process *p, Eterm *htop) } ERTS_CHK_OFFHEAP_ASSERT(refc >= 1); #ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_LIST - ERTS_CHK_OFFHEAP_ASSERT(!(u.hdr->thing_word & ERTS_EXTERNAL_VISITED_BIT)); + ERTS_CHK_OFFHEAP_ASSERT(!(u.hdr->thing_word & ERTS_OFFHEAP_VISITED_BIT)); u.hdr->thing_word |= ERTS_OFFHEAP_VISITED_BIT; #endif if (old) { @@ -2839,7 +3157,7 @@ erts_check_off_heap2(Process *p, Eterm *htop) } } -#ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_EXTERNAL_LIST +#ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_LIST for (u.hdr = MSO(p).first; u.hdr; u.hdr = u.hdr->next) u.hdr->thing_word &= ~ERTS_OFFHEAP_VISITED_BIT; #endif diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h index ecd1bf4d22..40b7c5d12c 100644 --- a/erts/emulator/beam/erl_gc.h +++ b/erts/emulator/beam/erl_gc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2007-2011. All Rights Reserved. + * Copyright Ericsson AB 2007-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -69,17 +69,18 @@ do { \ while (nelts--) *HTOP++ = *PTR++; \ } while(0) -#define in_area(ptr,start,nbytes) \ - ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes)) - #if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG) int within(Eterm *ptr, Process *p); #endif -ERTS_GLB_INLINE Eterm follow_moved(Eterm term); +#define ErtsInYoungGen(TPtr, Ptr, OldHeap, OldHeapSz) \ + (!erts_is_literal((TPtr), (Ptr)) \ + & !ErtsInArea((Ptr), (OldHeap), (OldHeapSz))) + +ERTS_GLB_INLINE Eterm follow_moved(Eterm term, Eterm xptr_tag); #if ERTS_GLB_INLINE_INCL_FUNC_DEF -ERTS_GLB_INLINE Eterm follow_moved(Eterm term) +ERTS_GLB_INLINE Eterm follow_moved(Eterm term, Eterm xptr_tag) { Eterm* ptr; switch (primary_tag(term)) { @@ -87,17 +88,18 @@ ERTS_GLB_INLINE Eterm follow_moved(Eterm term) break; case TAG_PRIMARY_BOXED: ptr = boxed_val(term); - if (IS_MOVED_BOXED(*ptr)) term = *ptr; + if (IS_MOVED_BOXED(*ptr)) term = (*ptr) | xptr_tag; break; case TAG_PRIMARY_LIST: ptr = list_val(term); - if (IS_MOVED_CONS(ptr[0])) term = ptr[1]; + if (IS_MOVED_CONS(ptr[0])) term = (ptr[1]) | xptr_tag; break; default: ASSERT(!"strange tag in follow_moved"); } return term; } + #endif #endif /* ERL_GC_C__ || HIPE_GC_C__ */ @@ -106,6 +108,23 @@ ERTS_GLB_INLINE Eterm follow_moved(Eterm term) * Global exported */ +#define ERTS_IS_GC_DESIRED_INTERNAL(Proc, HTop, STop) \ + ((((STop) - (HTop) < (Proc)->mbuf_sz)) \ + | ((Proc)->off_heap.overhead > (Proc)->bin_vheap_sz) \ + | !!((Proc)->flags & F_FORCE_GC)) + +#define ERTS_IS_GC_DESIRED(Proc) \ + ERTS_IS_GC_DESIRED_INTERNAL((Proc), (Proc)->htop, (Proc)->stop) + +#define ERTS_FORCE_GC_INTERNAL(Proc, FCalls) \ + do { \ + (Proc)->flags |= F_FORCE_GC; \ + ERTS_VBUMP_ALL_REDS_INTERNAL((Proc), (FCalls)); \ + } while (0) + +#define ERTS_FORCE_GC(Proc) \ + ERTS_FORCE_GC_INTERNAL((Proc), (Proc)->fcalls) + extern Uint erts_test_long_gc_sleep; typedef struct { @@ -113,10 +132,18 @@ typedef struct { Uint64 garbage_cols; } ErtsGCInfo; +#define ERTS_PROCESS_GC_INFO_MAX_TERMS (11) /* number of elements in process_gc_info*/ +#define ERTS_PROCESS_GC_INFO_MAX_SIZE \ + (ERTS_PROCESS_GC_INFO_MAX_TERMS * (2/*cons*/ + 3/*2-tuple*/ + BIG_UINT_HEAP_SIZE)) +Eterm erts_process_gc_info(struct process*, Uint *, Eterm **); + void erts_gc_info(ErtsGCInfo *gcip); void erts_init_gc(void); -int erts_garbage_collect(struct process*, int, Eterm*, int); +int erts_garbage_collect_nobump(struct process*, int, Eterm*, int); +void erts_garbage_collect(struct process*, int, Eterm*, int); void erts_garbage_collect_hibernate(struct process* p); +Eterm erts_gc_after_bif_call_lhf(struct process* p, ErlHeapFragment *live_hf_end, + Eterm result, Eterm* regs, Uint arity); 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, diff --git a/erts/emulator/beam/erl_goodfit_alloc.c b/erts/emulator/beam/erl_goodfit_alloc.c index 9b4aad9d91..223ba193da 100644 --- a/erts/emulator/beam/erl_goodfit_alloc.c +++ b/erts/emulator/beam/erl_goodfit_alloc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2013. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_goodfit_alloc.h b/erts/emulator/beam/erl_goodfit_alloc.h index ababdbd0a1..76dd558234 100644 --- a/erts/emulator/beam/erl_goodfit_alloc.h +++ b/erts/emulator/beam/erl_goodfit_alloc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2013. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c index fb6d249145..8e201d5711 100644 --- a/erts/emulator/beam/erl_hl_timer.c +++ b/erts/emulator/beam/erl_hl_timer.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2015. All Rights Reserved. + * Copyright Ericsson AB 2015-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -1245,8 +1245,10 @@ hlt_bif_timer_timeout(ErtsHLTimer *tmr, Uint32 roflgs) * the middle of tree destruction). */ if (!ERTS_PROC_IS_EXITING(proc)) { - erts_queue_message(proc, &proc_locks, tmr->btm.bp, - tmr->btm.message, NIL); + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = tmr->btm.bp; + erts_queue_message(proc, &proc_locks, mp, + tmr->btm.message); erts_smp_proc_unlock(proc, ERTS_PROC_LOCKS_MSG_SEND); queued_message = 1; proc_locks &= ~ERTS_PROC_LOCKS_MSG_SEND; @@ -1926,36 +1928,31 @@ access_sched_local_btm(Process *c_p, Eterm pid, if (proc) { Uint hsz; - ErlOffHeap *ohp; - ErlHeapFragment* bp; + ErtsMessage *mp; Eterm *hp, msg, ref, result; + ErlOffHeap *ohp; + Uint32 *refn; #ifdef ERTS_HLT_DEBUG Eterm *hp_end; #endif - hsz = 3; /* 2-tuple */ - if (!async) - hsz += REF_THING_SIZE; + hsz = REF_THING_SIZE; + if (async) { + refn = trefn; /* timer ref */ + hsz += 4; /* 3-tuple */ + } else { - if (is_non_value(tref) || proc != c_p) - hsz += REF_THING_SIZE; - hsz += 1; /* upgrade to 3-tuple */ + refn = rrefn; /* request ref */ + hsz += 3; /* 2-tuple */ } + + ERTS_HLT_ASSERT(refn); + 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); - } + mp = erts_alloc_message_heap(proc, &proc_locks, + hsz, &hp, &ohp); #ifdef ERTS_HLT_DEBUG hp_end = hp + hsz; @@ -1968,35 +1965,22 @@ access_sched_local_btm(Process *c_p, Eterm pid, 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); + write_ref_thing(hp, + refn[0], + refn[1], + refn[2]); + ref = make_internal_ref(hp); + hp += REF_THING_SIZE; - 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); + msg = (async + ? TUPLE3(hp, (cancel + ? am_cancel_timer + : am_read_timer), ref, result) + : TUPLE2(hp, ref, result)); - ERTS_HLT_ASSERT(hp + 4 == hp_end); + ERTS_HLT_ASSERT(hp + (async ? 4 : 3) == hp_end); - } - erts_queue_message(proc, &proc_locks, bp, msg, NIL); + erts_queue_message(proc, &proc_locks, mp, msg); if (c_p) proc_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -2034,7 +2018,7 @@ bif_timer_access_request(void *vreq) static int try_access_sched_remote_btm(ErtsSchedulerData *esdp, Process *c_p, Uint32 sid, - Eterm tref, Uint32 *trefn, + Uint32 *trefn, int async, int cancel, int info, Eterm *resp) { @@ -2093,21 +2077,31 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp, } } else { - Eterm tag, res, msg; + ErtsMessage *mp; + Eterm tag, res, msg, tref; Uint hsz; Eterm *hp; ErtsProcLocks proc_locks = ERTS_PROC_LOCK_MAIN; + ErlOffHeap *ohp; - hsz = 4; + hsz = 4 + REF_THING_SIZE; if (time_left > (Sint64) MAX_SMALL) hsz += ERTS_SINT64_HEAP_SIZE(time_left); - hp = HAlloc(c_p, hsz); + mp = erts_alloc_message_heap(c_p, &proc_locks, + hsz, &hp, &ohp); if (cancel) tag = am_cancel_timer; else tag = am_read_timer; + write_ref_thing(hp, + trefn[0], + trefn[1], + trefn[2]); + tref = make_internal_ref(hp); + hp += REF_THING_SIZE; + if (time_left < 0) res = am_false; else if (time_left <= (Sint64) MAX_SMALL) @@ -2117,7 +2111,7 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp, msg = TUPLE3(hp, tag, tref, res); - erts_queue_message(c_p, &proc_locks, NULL, msg, NIL); + erts_queue_message(c_p, &proc_locks, mp, msg); proc_locks &= ~ERTS_PROC_LOCK_MAIN; if (proc_locks) @@ -2158,8 +2152,8 @@ access_bif_timer(Process *c_p, Eterm tref, int cancel, int async, int info) info); ERTS_BIF_PREP_RET(ret, res); } - else if (try_access_sched_remote_btm(esdp, c_p, sid, - tref, trefn, + else if (try_access_sched_remote_btm(esdp, c_p, + sid, trefn, async, cancel, info, &res)) { ERTS_BIF_PREP_RET(ret, res); diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index e729574ec7..2fd1eeb785 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2013. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -91,11 +91,6 @@ const int etp_arch_bits = 32; #else # error "Not 64-bit, nor 32-bit arch" #endif -#if HALFWORD_HEAP -const int etp_halfword = 1; -#else -const int etp_halfword = 0; -#endif #ifdef HIPE const int etp_hipe = 1; #else @@ -157,7 +152,7 @@ volatile int erts_writing_erl_crash_dump = 0; int erts_initialized = 0; #if defined(USE_THREADS) && !defined(ERTS_SMP) -static erts_tid_t main_thread; +erts_tid_t erts_main_thread; #endif int erts_use_sender_punish; @@ -197,7 +192,7 @@ Uint32 verbose; /* See erl_debug.h for information about verbose */ int erts_atom_table_size = ATOM_LIMIT; /* Maximum number of atoms */ -int erts_pd_initial_size = 10; +int erts_pd_initial_size = 8; /* must be power of 2 */ int erts_modified_timing_level; @@ -393,11 +388,13 @@ erl_init(int ncpu, erts_mseg_late_init(); /* Must be after timer (erts_init_time()) and thread initializations */ #endif + erl_sys_late_init(); #ifdef HIPE hipe_mode_switch_init(); /* Must be after init_load/beam_catches/init */ #endif packet_parser_init(); erl_nif_init(); + erts_msacc_init(); } static Eterm @@ -436,13 +433,36 @@ erl_first_process_otp(char* modname, void* code, unsigned size, int argc, char** hp += 2; args = CONS(hp, env, args); - so.flags = SPO_SYSTEM_PROC; + so.flags = erts_default_spo_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; } +static Eterm +erl_system_process_otp(Eterm parent_pid, char* modname) +{ + Eterm start_mod; + Process* parent; + ErlSpawnOpts so; + Eterm res; + + start_mod = erts_atom_put((byte *) modname, sys_strlen(modname), ERTS_ATOM_ENC_LATIN1, 1); + if (erts_find_function(start_mod, am_start, 0, + erts_active_code_ix()) == NULL) { + erts_exit(ERTS_ERROR_EXIT, "No function %s:start/0\n", modname); + } + + parent = erts_pid2proc(NULL, 0, parent_pid, ERTS_PROC_LOCK_MAIN); + + so.flags = erts_default_spo_flags|SPO_SYSTEM_PROC; + res = erl_create_process(parent, start_mod, am_start, NIL, &so); + erts_smp_proc_unlock(parent, ERTS_PROC_LOCK_MAIN); + return res; +} + + Eterm erts_preloaded(Process* p) { @@ -558,6 +578,8 @@ void erts_usage(void) VH_DEFAULT_SIZE); erts_fprintf(stderr, "-hpds size initial process dictionary size (default %d)\n", erts_pd_initial_size); + erts_fprintf(stderr, "-hmqd val set default message queue data flag for processes,\n"); + erts_fprintf(stderr, " valid values are: off_heap | on_heap | mixed\n"); /* erts_fprintf(stderr, "-i module set the boot module (default init)\n"); */ @@ -723,6 +745,10 @@ early_init(int *argc, char **argv) /* char envbuf[21]; /* enough for any 64-bit integer */ size_t envbufsz; +#if defined(USE_THREADS) && !defined(ERTS_SMP) + erts_main_thread = erts_thr_self(); +#endif + erts_save_emu_args(*argc, argv); erts_sched_compact_load = 1; @@ -776,9 +802,6 @@ early_init(int *argc, char **argv) /* (erts_aint32_t) ((Uint16) -1)); erts_pre_init_process(); -#if defined(USE_THREADS) && !defined(ERTS_SMP) - main_thread = erts_thr_self(); -#endif /* * We need to know the number of schedulers to use before we @@ -1172,6 +1195,7 @@ early_init(int *argc, char **argv) /* erts_thr_late_init(&elid); } #endif + erts_msacc_early_init(); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_late_init(); @@ -1236,6 +1260,7 @@ erl_start(int argc, char **argv) ErtsTimeWarpMode time_warp_mode; int node_tab_delete_delay = ERTS_NODE_TAB_DELAY_GC_DEFAULT; ErtsDbSpinCount db_spin_count = ERTS_DB_SPNCNT_NORMAL; + Eterm otp_ring0_pid; set_default_time_adj(&time_correction, &time_warp_mode); @@ -1405,6 +1430,7 @@ erl_start(int argc, char **argv) case 't': verbose |= DEBUG_THREADS; break; case 'p': verbose |= DEBUG_PROCESSES; break; case 'm': verbose |= DEBUG_MESSAGES; break; + case 'c': verbose |= DEBUG_SHCOPY; break; default : erts_fprintf(stderr,"Unknown verbose option: %c\n",*ch); } } @@ -1417,6 +1443,7 @@ erl_start(int argc, char **argv) if (verbose & DEBUG_THREADS) erts_printf("THREADS "); if (verbose & DEBUG_PROCESSES) erts_printf("PROCESSES "); if (verbose & DEBUG_MESSAGES) erts_printf("MESSAGES "); + if (verbose & DEBUG_SHCOPY) erts_printf("SHCOPY "); erts_printf("\n"); #else erts_fprintf(stderr, "warning: -v (only in debug compiled code)\n"); @@ -1460,6 +1487,7 @@ erl_start(int argc, char **argv) * h|ms - min_heap_size * h|mbs - min_bin_vheap_size * h|pds - erts_pd_initial_size + * h|mqd - message_queue_data * */ if (has_prefix("mbs", sub_param)) { @@ -1479,12 +1507,29 @@ erl_start(int argc, char **argv) VERBOSE(DEBUG_SYSTEM, ("using minimum heap size %d\n", H_MIN_SIZE)); } else if (has_prefix("pds", sub_param)) { arg = get_arg(sub_param+3, argv[i+1], &i); - if ((erts_pd_initial_size = atoi(arg)) <= 0) { + if (!erts_pd_set_initial_size(atoi(arg))) { erts_fprintf(stderr, "bad initial process dictionary size %s\n", arg); erts_usage(); } VERBOSE(DEBUG_SYSTEM, ("using initial process dictionary size %d\n", erts_pd_initial_size)); + } else if (has_prefix("mqd", sub_param)) { + arg = get_arg(sub_param+3, argv[i+1], &i); + if (sys_strcmp(arg, "mixed") == 0) + erts_default_spo_flags &= ~(SPO_ON_HEAP_MSGQ|SPO_OFF_HEAP_MSGQ); + else if (sys_strcmp(arg, "on_heap") == 0) { + erts_default_spo_flags &= ~SPO_OFF_HEAP_MSGQ; + erts_default_spo_flags |= SPO_ON_HEAP_MSGQ; + } + else if (sys_strcmp(arg, "off_heap") == 0) { + erts_default_spo_flags &= ~SPO_ON_HEAP_MSGQ; + erts_default_spo_flags |= SPO_OFF_HEAP_MSGQ; + } + else { + erts_fprintf(stderr, + "Invalid message_queue_data flag: %s\n", arg); + erts_usage(); + } } else { /* backward compatibility */ arg = get_arg(argv[i]+2, argv[i+1], &i); @@ -2073,7 +2118,8 @@ erl_start(int argc, char **argv) "Invalid ets busy wait threshold: %s\n", arg); erts_usage(); } - } else { + } + else { erts_fprintf(stderr, "bad -z option %s\n", argv[i]); erts_usage(); } @@ -2134,6 +2180,7 @@ erl_start(int argc, char **argv) init_break_handler(); if (replace_intr) erts_replace_intr(); + sys_init_suspend_handler(); #endif boot_argc = argc - i; /* Number of arguments to init */ @@ -2156,8 +2203,10 @@ erl_start(int argc, char **argv) erts_initialized = 1; - (void) erl_first_process_otp("otp_ring0", NULL, 0, - boot_argc, boot_argv); + otp_ring0_pid = erl_first_process_otp("otp_ring0", NULL, 0, + boot_argc, boot_argv); + + (void) erl_system_process_otp(otp_ring0_pid, "erts_code_purger"); #ifdef ERTS_SMP erts_start_schedulers(); @@ -2167,6 +2216,7 @@ erl_start(int argc, char **argv) #else { ErtsSchedulerData *esdp = erts_get_scheduler_data(); + erts_msacc_init_thread("scheduler", 1, 1); erts_thr_set_main_status(1, 1); #if ERTS_USE_ASYNC_READY_Q esdp->aux_work_data.async_ready.queue @@ -2232,7 +2282,7 @@ system_cleanup(int flush_async) if (!flush_async || !erts_initialized #if defined(USE_THREADS) && !defined(ERTS_SMP) - || !erts_equal_tids(main_thread, erts_thr_self()) + || !erts_equal_tids(erts_main_thread, erts_thr_self()) #endif ) return; diff --git a/erts/emulator/beam/erl_instrument.c b/erts/emulator/beam/erl_instrument.c index 12a72ad839..f84c63e7a4 100644 --- a/erts/emulator/beam/erl_instrument.c +++ b/erts/emulator/beam/erl_instrument.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2013. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_instrument.h b/erts/emulator/beam/erl_instrument.h index cb3b1920d3..1f04c91d5e 100644 --- a/erts/emulator/beam/erl_instrument.h +++ b/erts/emulator/beam/erl_instrument.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 3b3b247020..39c0617143 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2013. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -97,6 +97,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "dist_entry_links", "address" }, { "code_write_permission", NULL }, { "proc_status", "pid" }, + { "proc_trace", "pid" }, { "ports_snapshot", NULL }, { "meta_name_tab", "address" }, { "meta_main_tab_slot", "address" }, @@ -113,9 +114,6 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "environ", NULL }, #endif { "efile_drv", "address" }, -#if defined(ENABLE_CHILD_WAITER_THREAD) || defined(ERTS_SMP) - { "child_status", NULL }, -#endif { "drv_ev_state_grow", NULL, }, { "drv_ev_state", "address" }, { "safe_hash", "address" }, @@ -140,6 +138,8 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "mmap_init_atoms", NULL }, { "drv_tsd", NULL }, { "async_enq_mtx", NULL }, + { "msacc_list_mutex", NULL }, + { "msacc_unmanaged_mutex", NULL }, #ifdef ERTS_SMP { "atom_tab", NULL }, { "misc_op_list_pre_alloc_lock", "address" }, @@ -149,6 +149,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "dist_entry_out_queue", "address" }, { "port_sched_lock", "port_id" }, { "sys_msg_q", NULL }, + { "tracer_mtx", NULL }, { "port_table", NULL }, #endif { "mtrace_op", NULL }, @@ -156,17 +157,11 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "instr", NULL }, { "alcu_allocator", "index" }, { "mseg", NULL }, -#if HALFWORD_HEAP - { "pmmap", NULL }, -#endif #ifdef ERTS_SMP { "port_task_pre_alloc_lock", "address" }, { "proclist_pre_alloc_lock", "address" }, { "xports_list_pre_alloc_lock", "address" }, { "inet_buffer_stack_lock", NULL }, - { "gc_info", NULL }, - { "io_wake", NULL }, - { "timer_wheel", NULL }, { "system_block", NULL }, { "timeofday", NULL }, { "get_time", NULL }, diff --git a/erts/emulator/beam/erl_lock_check.h b/erts/emulator/beam/erl_lock_check.h index 66251ef4e8..18296d1fec 100644 --- a/erts/emulator/beam/erl_lock_check.h +++ b/erts/emulator/beam/erl_lock_check.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2012. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_lock_count.c b/erts/emulator/beam/erl_lock_count.c index bd00480ba2..a00e0f0fff 100644 --- a/erts/emulator/beam/erl_lock_count.c +++ b/erts/emulator/beam/erl_lock_count.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2012. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_lock_count.h b/erts/emulator/beam/erl_lock_count.h index 4cc6a5c695..3e8dcefe69 100644 --- a/erts/emulator/beam/erl_lock_count.h +++ b/erts/emulator/beam/erl_lock_count.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2012. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index 3c066cea7b..8efc983f04 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2014. All Rights Reserved. + * Copyright Ericsson AB 2014-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -54,6 +54,7 @@ * - maps:new/0 * - maps:put/3 * - maps:remove/2 + * - maps:take/2 * - maps:to_list/1 * - maps:update/3 * - maps:values/1 @@ -93,7 +94,7 @@ static Uint hashmap_subtree_size(Eterm node); 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 hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm node, Eterm *value); 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); @@ -172,26 +173,22 @@ BIF_RETTYPE maps_to_list_1(BIF_ALIST_1) { */ 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)) { + if (is_flatmap(map)) { Eterm *ks, *vs; flatmap_t *mp; Uint n, i; - mp = (flatmap_t *)flatmap_val_rel(map, map_base); + mp = (flatmap_t *)flatmap_val(map); n = flatmap_get_size(mp); if (n == 0) { return NULL; } - ks = (Eterm *)tuple_val_rel(mp->keys, map_base) + 1; + ks = (Eterm *)tuple_val(mp->keys) + 1; vs = flatmap_get_values(mp); if (is_immed(key)) { @@ -200,19 +197,19 @@ erts_maps_get(Eterm key, Eterm map) return &vs[i]; } } - } - - for (i = 0; i < n; i++) { - if (eq_rel(ks[i], map_base, key, NULL)) { - return &vs[i]; - } - } + } else { + for (i = 0; i < n; i++) { + if (EQ(ks[i], key)) { + return &vs[i]; + } + } + } return NULL; } - ASSERT(is_hashmap_rel(map, map_base)); + ASSERT(is_hashmap(map)); hx = hashmap_make_hash(key); - return erts_hashmap_get_rel(hx, key, map, map_base); + return erts_hashmap_get(hx, key, map); } BIF_RETTYPE maps_find_2(BIF_ALIST_2) { @@ -1525,10 +1522,45 @@ BIF_RETTYPE maps_put_3(BIF_ALIST_3) { BIF_ERROR(BIF_P, BADMAP); } -/* maps:remove/3 */ +/* maps:take/2 */ + +BIF_RETTYPE maps_take_2(BIF_ALIST_2) { + if (is_map(BIF_ARG_2)) { + Eterm res, map, val; + if (erts_maps_take(BIF_P, BIF_ARG_1, BIF_ARG_2, &map, &val)) { + Eterm *hp = HAlloc(BIF_P, 3); + res = make_tuple(hp); + *hp++ = make_arityval(2); + *hp++ = val; + *hp++ = map; + BIF_RET(res); + } + BIF_RET(am_error); + } + BIF_P->fvalue = BIF_ARG_2; + BIF_ERROR(BIF_P, BADMAP); +} + +/* maps:remove/2 */ -int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { +BIF_RETTYPE maps_remove_2(BIF_ALIST_2) { + if (is_map(BIF_ARG_2)) { + Eterm res; + (void) erts_maps_take(BIF_P, BIF_ARG_1, BIF_ARG_2, &res, NULL); + BIF_RET(res); + } + BIF_P->fvalue = BIF_ARG_2; + BIF_ERROR(BIF_P, BADMAP); +} + +/* erts_maps_take + * return 1 if key is found, otherwise 0 + * If the key is not found res (output map) will be map (input map) + */ +int erts_maps_take(Process *p, Eterm key, Eterm map, + Eterm *res, Eterm *value) { Uint32 hx; + Eterm ret; if (is_flatmap(map)) { Sint n; Uint need; @@ -1541,7 +1573,7 @@ int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { if (n == 0) { *res = map; - return 1; + return 0; } ks = flatmap_get_keys(mp); @@ -1568,6 +1600,7 @@ int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { if (is_immed(key)) { while (1) { if (*ks == key) { + if (value) *value = *vs; goto found_key; } else if (--n) { *mhp++ = *vs++; @@ -1578,6 +1611,7 @@ int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { } else { while(1) { if (EQ(*ks, key)) { + if (value) *value = *vs; goto found_key; } else if (--n) { *mhp++ = *vs++; @@ -1593,7 +1627,7 @@ int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { HRelease(p, hp_start + need, hp_start); *res = map; - return 1; + return 0; found_key: /* Copy rest of keys and values */ @@ -1605,19 +1639,13 @@ found_key: } ASSERT(is_hashmap(map)); hx = hashmap_make_hash(key); - *res = hashmap_delete(p, hx, key, map); - return 1; -} - -BIF_RETTYPE maps_remove_2(BIF_ALIST_2) { - if (is_map(BIF_ARG_2)) { - Eterm res; - if (erts_maps_remove(BIF_P, BIF_ARG_1, BIF_ARG_2, &res)) { - BIF_RET(res); - } + ret = hashmap_delete(p, hx, key, map, value); + if (is_value(ret)) { + *res = ret; + return 1; } - BIF_P->fvalue = BIF_ARG_2; - BIF_ERROR(BIF_P, BADMAP); + *res = map; + return 0; } int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res) { @@ -1998,11 +2026,7 @@ Eterm* hashmap_iterator_prev(ErtsWStack* s) { } const Eterm * -#if HALFWORD_HEAP -erts_hashmap_get_rel(Uint32 hx, Eterm key, Eterm node, Eterm *map_base) -#else erts_hashmap_get(Uint32 hx, Eterm key, Eterm node) -#endif { Eterm *ptr, hdr, *res; Uint ix, lvl = 0; @@ -2011,7 +2035,7 @@ erts_hashmap_get(Uint32 hx, Eterm key, Eterm node) UseTmpHeapNoproc(2); ASSERT(is_boxed(node)); - ptr = boxed_val_rel(node, map_base); + ptr = boxed_val(node); hdr = *ptr; ASSERT(is_header(hdr)); ASSERT(is_hashmap_header_head(hdr)); @@ -2032,15 +2056,15 @@ erts_hashmap_get(Uint32 hx, Eterm key, Eterm node) 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; + ptr = list_val(node); + res = EQ(CAR(ptr), key) ? &(CDR(ptr)) : NULL; break; } hx = hashmap_shift_hash(th,hx,lvl,key); ASSERT(is_boxed(node)); - ptr = boxed_val_rel(node, map_base); + ptr = boxed_val(node); hdr = *ptr; ASSERT(is_header(hdr)); ASSERT(!is_hashmap_header_head(hdr)); @@ -2330,7 +2354,8 @@ static Eterm hashmap_values(Process* p, Eterm node) { return res; } -static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm map) { +static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, + Eterm map, Eterm *value) { Eterm *hp = NULL, *nhp = NULL, *hp_end = NULL; Eterm *ptr; Eterm hdr, res = map, node = map; @@ -2345,8 +2370,12 @@ static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm map) { switch(primary_tag(node)) { case TAG_PRIMARY_LIST: if (EQ(CAR(list_val(node)), key)) { + if (value) { + *value = CDR(list_val(node)); + } goto unroll; } + res = THE_NON_VALUE; goto not_found; case TAG_PRIMARY_BOXED: ptr = boxed_val(node); @@ -2373,6 +2402,7 @@ static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm map) { n = hashmap_bitcount(hval); } else { /* not occupied */ + res = THE_NON_VALUE; goto not_found; } @@ -2402,6 +2432,7 @@ static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm map) { break; } /* not occupied */ + res = THE_NON_VALUE; goto not_found; default: erts_exit(ERTS_ERROR_EXIT, "bad header tag %ld\r\n", hdr & _HEADER_MAP_SUBTAG_MASK); @@ -2706,32 +2737,88 @@ BIF_RETTYPE erts_internal_map_to_tuple_keys_1(BIF_ALIST_1) { } /* - * erts_internal:map_type/1 + * erts_internal:term_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: - erts_exit(ERTS_ERROR_EXIT, "bad header"); +BIF_RETTYPE erts_internal_term_type_1(BIF_ALIST_1) { + Eterm obj = BIF_ARG_1; + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: + BIF_RET(ERTS_MAKE_AM("list")); + case TAG_PRIMARY_BOXED: { + Eterm hdr = *boxed_val(obj); + ASSERT(is_header(hdr)); + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: + BIF_RET(ERTS_MAKE_AM("tuple")); + case EXPORT_SUBTAG: + BIF_RET(ERTS_MAKE_AM("export")); + case FUN_SUBTAG: + BIF_RET(ERTS_MAKE_AM("fun")); + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : + BIF_RET(ERTS_MAKE_AM("flatmap")); + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + BIF_RET(ERTS_MAKE_AM("hashmap")); + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : + BIF_RET(ERTS_MAKE_AM("hashmap_node")); + default: + erts_exit(ERTS_ABORT_EXIT, "term_type: bad map header type %d\n", MAP_HEADER_TYPE(hdr)); + } + case REFC_BINARY_SUBTAG: + BIF_RET(ERTS_MAKE_AM("refc_binary")); + case HEAP_BINARY_SUBTAG: + BIF_RET(ERTS_MAKE_AM("heap_binary")); + case SUB_BINARY_SUBTAG: + BIF_RET(ERTS_MAKE_AM("sub_binary")); + case BIN_MATCHSTATE_SUBTAG: + BIF_RET(ERTS_MAKE_AM("matchstate")); + case POS_BIG_SUBTAG: + case NEG_BIG_SUBTAG: + BIF_RET(ERTS_MAKE_AM("bignum")); + case REF_SUBTAG: + BIF_RET(ERTS_MAKE_AM("reference")); + case EXTERNAL_REF_SUBTAG: + BIF_RET(ERTS_MAKE_AM("external_reference")); + case EXTERNAL_PID_SUBTAG: + BIF_RET(ERTS_MAKE_AM("external_pid")); + case EXTERNAL_PORT_SUBTAG: + BIF_RET(ERTS_MAKE_AM("external_port")); + case FLOAT_SUBTAG: + BIF_RET(ERTS_MAKE_AM("hfloat")); + default: + erts_exit(ERTS_ABORT_EXIT, "term_type: Invalid tag (0x%X)\n", hdr); + } } + case TAG_PRIMARY_IMMED1: + switch (obj & _TAG_IMMED1_MASK) { + case _TAG_IMMED1_SMALL: + BIF_RET(ERTS_MAKE_AM("fixnum")); + case _TAG_IMMED1_PID: + BIF_RET(ERTS_MAKE_AM("pid")); + case _TAG_IMMED1_PORT: + BIF_RET(ERTS_MAKE_AM("port")); + case _TAG_IMMED1_IMMED2: + switch (obj & _TAG_IMMED2_MASK) { + case _TAG_IMMED2_ATOM: + BIF_RET(ERTS_MAKE_AM("atom")); + case _TAG_IMMED2_CATCH: + BIF_RET(ERTS_MAKE_AM("catch")); + case _TAG_IMMED2_NIL: + BIF_RET(ERTS_MAKE_AM("nil")); + default: + erts_exit(ERTS_ABORT_EXIT, "term_type: Invalid tag (0x%X)\n", obj); + } + default: + erts_exit(ERTS_ABORT_EXIT, "term_type: Invalid tag (0x%X)\n", obj); + } + default: + erts_exit(ERTS_ABORT_EXIT, "term_type: Invalid tag (0x%X)\n", obj); } - BIF_P->fvalue = BIF_ARG_1; - BIF_ERROR(BIF_P, BADMAP); } /* diff --git a/erts/emulator/beam/erl_map.h b/erts/emulator/beam/erl_map.h index 4d9d74bc37..8b5c9582ba 100644 --- a/erts/emulator/beam/erl_map.h +++ b/erts/emulator/beam/erl_map.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2014. All Rights Reserved. + * Copyright Ericsson AB 2014-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -57,7 +57,6 @@ typedef struct flatmap_s { #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) \ @@ -67,7 +66,7 @@ typedef struct flatmap_s { /* erl_term.h stuff */ -#define flatmap_get_values(x) (((Eterm *)(x)) + 3) +#define flatmap_get_values(x) (((Eterm *)(x)) + sizeof(flatmap_t)/sizeof(Eterm)) #define flatmap_get_keys(x) (((Eterm *)tuple_val(((flatmap_t *)(x))->keys)) + 1) #define flatmap_get_size(x) (((flatmap_t*)(x))->size) @@ -83,6 +82,7 @@ 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); +int erts_maps_take(Process *p, Eterm key, Eterm map, Eterm *res, Eterm *value); Eterm erts_hashmap_insert(Process *p, Uint32 hx, Eterm key, Eterm value, Eterm node, int is_update); @@ -104,23 +104,9 @@ Eterm erts_hashmap_from_array(ErtsHeapFactory*, Eterm *leafs, Uint n, int rejec 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 *erts_maps_get(Eterm key, Eterm map); -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 +const Eterm *erts_hashmap_get(Uint32 hx, Eterm key, Eterm map); /* hamt nodes v2.0 * diff --git a/erts/emulator/beam/erl_math.c b/erts/emulator/beam/erl_math.c index b46cc37495..fc0aaed18a 100644 --- a/erts/emulator/beam/erl_math.c +++ b/erts/emulator/beam/erl_math.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index fa6b2fc613..9beff52835 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2012. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -33,8 +33,8 @@ #include "erl_binary.h" #include "dtrace-wrapper.h" -ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message, - ErlMessage, +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message_ref, + ErtsMessageRef, ERL_MESSAGE_BUF_SZ, ERTS_ALC_T_MSG_REF) @@ -44,27 +44,20 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message, #undef HARD_DEBUG #endif - - - -#ifdef DEBUG -static ERTS_INLINE int in_heapfrag(const Eterm* ptr, const ErlHeapFragment *bp) +void +init_message(void) { - return ((unsigned)(ptr - bp->mem) < bp->used_size); + init_message_ref_alloc(); } -#endif - -void -init_message(void) +void *erts_alloc_message_ref(void) { - init_message_alloc(); + return (void *) message_ref_alloc(); } -void -free_message(ErlMessage* mp) +void erts_free_message_ref(void *mp) { - message_free(mp); + message_ref_free((ErtsMessageRef *) mp); } /* Allocate message buffer (size in words) */ @@ -74,7 +67,8 @@ new_message_buffer(Uint size) ErlHeapFragment* bp; bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP_FRAG, ERTS_HEAP_FRAG_SIZE(size)); - ERTS_INIT_HEAP_FRAG(bp, size); + ERTS_INIT_HEAP_FRAG(bp, size, size); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] new message buffer %p\n", erts_get_current_pid(), bp->mem)); return bp; } @@ -203,83 +197,57 @@ free_message_buffer(ErlHeapFragment* bp) }while (bp != NULL); } -static ERTS_INLINE void -link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp) +void +erts_cleanup_messages(ErtsMessage *msgp) { - if (bp) { - /* Link the message buffer */ - bp->next = MBUF(proc); - MBUF(proc) = bp; - MBUF_SIZE(proc) += bp->used_size; - FLAGS(proc) |= F_FORCE_GC; - - /* Move any off_heap's into the process */ - if (bp->off_heap.first != NULL) { - struct erl_off_heap_header** next_p = &bp->off_heap.first; - while (*next_p != NULL) { - next_p = &((*next_p)->next); + ErtsMessage *mp = msgp; + while (mp) { + ErtsMessage *fmp; + ErlHeapFragment *bp; + if (is_non_value(ERL_MESSAGE_TERM(mp))) { + if (is_not_immed(ERL_MESSAGE_TOKEN(mp))) { + bp = (ErlHeapFragment *) mp->data.dist_ext->ext_endp; + erts_cleanup_offheap(&bp->off_heap); + } + if (mp->data.dist_ext) + erts_free_dist_ext_copy(mp->data.dist_ext); + } + else { + if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG) + bp = mp->data.heap_frag; + else { + bp = mp->hfrag.next; + erts_cleanup_offheap(&mp->hfrag.off_heap); } - *next_p = MSO(proc).first; - MSO(proc).first = bp->off_heap.first; - bp->off_heap.first = NULL; - OH_OVERHEAD(&(MSO(proc)), bp->off_heap.overhead); + if (bp) + free_message_buffer(bp); } + fmp = mp; + mp = mp->next; + erts_free_message(fmp); } } -Eterm -erts_msg_distext2heap(Process *pp, - ErtsProcLocks *plcksp, - ErlHeapFragment **bpp, - Eterm *tokenp, - ErtsDistExternal *dist_extp) +ErtsMessage * +erts_realloc_shrink_message(ErtsMessage *mp, Uint sz, Eterm *brefs, Uint brefs_size) { - Eterm msg; - Uint tok_sz = 0; - Eterm *hp = NULL; - ErtsHeapFactory factory; - Sint sz; - - *bpp = NULL; - sz = erts_decode_dist_ext_size(dist_extp); - if (sz < 0) - goto decode_error; - if (is_not_nil(*tokenp)) { - ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp); - tok_sz = heap_frag->used_size; - sz += tok_sz; - } - if (pp) { - ErlOffHeap *ohp; - hp = erts_alloc_message_heap(sz, bpp, &ohp, pp, plcksp); - } - else { - *bpp = new_message_buffer(sz); - hp = (*bpp)->mem; - } - erts_factory_message_init(&factory, pp, hp, *bpp); - msg = erts_decode_dist_ext(&factory, dist_extp); - if (is_non_value(msg)) - goto decode_error; - if (is_not_nil(*tokenp)) { - ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp); - hp = erts_produce_heap(&factory, tok_sz, 0); - *tokenp = copy_struct(*tokenp, tok_sz, &hp, factory.off_heap); - erts_cleanup_offheap(&heap_frag->off_heap); + ErtsMessage *nmp = erts_realloc(ERTS_ALC_T_MSG, mp, + sizeof(ErtsMessage) + (sz - 1)*sizeof(Eterm)); + if (nmp != mp) { + Eterm *sp = &mp->hfrag.mem[0]; + Eterm *ep = sp + sz; + Sint offs = &nmp->hfrag.mem[0] - sp; + erts_offset_off_heap(&nmp->hfrag.off_heap, offs, sp, ep); + erts_offset_heap(&nmp->hfrag.mem[0], sz, offs, sp, ep); + if (brefs && brefs_size) + erts_offset_heap_ptr(brefs, brefs_size, offs, sp, ep); } - erts_free_dist_ext_copy(dist_extp); - erts_factory_close(&factory); - return msg; - decode_error: - if (is_not_nil(*tokenp)) { - ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp); - erts_cleanup_offheap(&heap_frag->off_heap); - } - erts_free_dist_ext_copy(dist_extp); - *bpp = NULL; - return THE_NON_VALUE; - } + nmp->hfrag.used_size = sz; + nmp->hfrag.alloc_size = sz; + + return nmp; +} void erts_queue_dist_message(Process *rcvr, @@ -287,7 +255,7 @@ erts_queue_dist_message(Process *rcvr, ErtsDistExternal *dist_ext, Eterm token) { - ErlMessage* mp; + ErtsMessage* mp; #ifdef USE_VM_PROBES Sint tok_label = 0; Sint tok_lastcnt = 0; @@ -299,7 +267,17 @@ erts_queue_dist_message(Process *rcvr, ERTS_SMP_LC_ASSERT(*rcvr_locks == erts_proc_lc_my_proc_locks(rcvr)); - mp = message_alloc(); + mp = erts_alloc_message(0, NULL); + mp->data.dist_ext = dist_ext; + + ERL_MESSAGE_TERM(mp) = THE_NON_VALUE; +#ifdef USE_VM_PROBES + ERL_MESSAGE_DT_UTAG(mp) = NIL; + if (token == am_have_dt_utag) + ERL_MESSAGE_TOKEN(mp) = NIL; + else +#endif + ERL_MESSAGE_TOKEN(mp) = token; #ifdef ERTS_SMP if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ)) { @@ -318,64 +296,46 @@ erts_queue_dist_message(Process *rcvr, if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ)) erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ); /* Drop message if receiver is exiting or has a pending exit ... */ - if (is_not_nil(token)) { - ErlHeapFragment *heap_frag; - heap_frag = erts_dist_ext_trailer(mp->data.dist_ext); - erts_cleanup_offheap(&heap_frag->off_heap); - } - erts_free_dist_ext_copy(dist_ext); - message_free(mp); + erts_cleanup_messages(mp); } else #endif if (IS_TRACED_FL(rcvr, F_TRACE_RECEIVE)) { /* Ahh... need to decode it in order to trace it... */ - ErlHeapFragment *mbuf; - Eterm msg; if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ)) erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ); - message_free(mp); - msg = erts_msg_distext2heap(rcvr, rcvr_locks, &mbuf, &token, dist_ext); - if (is_value(msg)) + if (!erts_decode_dist_message(rcvr, *rcvr_locks, mp, 0)) + erts_free_message(mp); + else { + Eterm msg = ERL_MESSAGE_TERM(mp); + token = ERL_MESSAGE_TOKEN(mp); #ifdef USE_VM_PROBES - if (DTRACE_ENABLED(message_queued)) { - DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); - - dtrace_proc_str(rcvr, receiver_name); - if (token != NIL && token != am_have_dt_utag) { - tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); - tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); - tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); - } - DTRACE6(message_queued, - receiver_name, size_object(msg), rcvr->msg.len, - tok_label, tok_lastcnt, tok_serial); - } + if (DTRACE_ENABLED(message_queued)) { + DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); + + dtrace_proc_str(rcvr, receiver_name); + if (have_seqtrace(token)) { + tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); + tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); + tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); + } + DTRACE6(message_queued, + receiver_name, size_object(msg), rcvr->msg.len, + tok_label, tok_lastcnt, tok_serial); + } #endif - erts_queue_message(rcvr, rcvr_locks, mbuf, msg, token); + erts_queue_message(rcvr, rcvr_locks, mp, msg); + } } else { /* Enqueue message on external format */ - ERL_MESSAGE_TERM(mp) = THE_NON_VALUE; -#ifdef USE_VM_PROBES - ERL_MESSAGE_DT_UTAG(mp) = NIL; - if (token == am_have_dt_utag) { - ERL_MESSAGE_TOKEN(mp) = NIL; - } else { -#endif - ERL_MESSAGE_TOKEN(mp) = token; -#ifdef USE_VM_PROBES - } -#endif - mp->next = NULL; - #ifdef USE_VM_PROBES if (DTRACE_ENABLED(message_queued)) { DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); dtrace_proc_str(rcvr, receiver_name); - if (token != NIL && token != am_have_dt_utag) { + if (have_seqtrace(token)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); @@ -388,8 +348,8 @@ erts_queue_dist_message(Process *rcvr, tok_label, tok_lastcnt, tok_serial); } #endif - mp->data.dist_ext = dist_ext; - LINK_MESSAGE(rcvr, mp); + + LINK_MESSAGE(rcvr, mp, &mp->next, 1); if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ)) erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ); @@ -404,46 +364,42 @@ erts_queue_dist_message(Process *rcvr, } } -/* Add a message last in message queue */ +/* Add messages last in message queue */ static Sint -queue_message(Process *c_p, - Process* receiver, - ErtsProcLocks *receiver_locks, - erts_aint32_t *receiver_state, - ErlHeapFragment* bp, - Eterm message, - Eterm seq_trace_token -#ifdef USE_VM_PROBES - , Eterm dt_utag -#endif - ) +queue_messages(Process *c_p, + Process* receiver, + erts_aint32_t *receiver_state, + ErtsProcLocks *receiver_locks, + ErtsMessage* first, + ErtsMessage** last, + Uint len) { Sint res; - ErlMessage* mp; int locked_msgq = 0; - erts_aint_t state; + erts_aint32_t state; -#ifndef ERTS_SMP - ASSERT(bp != NULL || receiver->mbuf == NULL); -#endif - - ERTS_SMP_LC_ASSERT(*receiver_locks == erts_proc_lc_my_proc_locks(receiver)); - - mp = message_alloc(); - - if (receiver_state) - state = *receiver_state; - else - state = erts_smp_atomic32_read_acqb(&receiver->state); + ASSERT(is_value(ERL_MESSAGE_TERM(first))); + ASSERT(ERL_MESSAGE_TOKEN(first) == am_undefined || + ERL_MESSAGE_TOKEN(first) == NIL || + is_tuple(ERL_MESSAGE_TOKEN(first))); #ifdef ERTS_SMP - - if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT)) - goto exiting; +#ifdef ERTS_ENABLE_LOCK_CHECK + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(receiver) < ERTS_PROC_LOCK_MSGQ || + *receiver_locks == erts_proc_lc_my_proc_locks(receiver)); +#endif if (!(*receiver_locks & ERTS_PROC_LOCK_MSGQ)) { if (erts_smp_proc_trylock(receiver, ERTS_PROC_LOCK_MSGQ) == EBUSY) { - ErtsProcLocks need_locks = ERTS_PROC_LOCK_MSGQ; + ErtsProcLocks need_locks = ERTS_PROC_LOCK_MSGQ; + + if (receiver_state) + state = *receiver_state; + else + state = erts_smp_atomic32_read_nob(&receiver->state); + if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT)) + goto exiting; + if (*receiver_locks & ERTS_PROC_LOCK_STATUS) { erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_STATUS); need_locks |= ERTS_PROC_LOCK_STATUS; @@ -451,13 +407,12 @@ queue_message(Process *c_p, erts_smp_proc_lock(receiver, need_locks); } locked_msgq = 1; - state = erts_smp_atomic32_read_nob(&receiver->state); - if (receiver_state) - *receiver_state = state; } #endif + state = erts_smp_atomic32_read_nob(&receiver->state); + if (state & (ERTS_PSFLG_PENDING_EXIT|ERTS_PSFLG_EXITING)) { #ifdef ERTS_SMP exiting: @@ -465,24 +420,12 @@ queue_message(Process *c_p, /* Drop message if receiver is exiting or has a pending exit... */ if (locked_msgq) erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ); - if (bp) - free_message_buffer(bp); - message_free(mp); + erts_cleanup_messages(first); return 0; } - ERL_MESSAGE_TERM(mp) = message; - ERL_MESSAGE_TOKEN(mp) = seq_trace_token; -#ifdef USE_VM_PROBES - ERL_MESSAGE_DT_UTAG(mp) = dt_utag; -#endif - mp->next = NULL; - mp->data.heap_frag = bp; - -#ifndef ERTS_SMP res = receiver->msg.len; -#else - res = receiver->msg_inq.len; +#ifdef ERTS_SMP if (*receiver_locks & ERTS_PROC_LOCK_MAIN) { /* * We move 'in queue' to 'private queue' and place @@ -492,319 +435,119 @@ queue_message(Process *c_p, * we don't need to include the 'in queue' in * the root set when garbage collecting. */ - res += receiver->msg.len; + res += receiver->msg_inq.len; ERTS_SMP_MSGQ_MV_INQ2PRIVQ(receiver); - LINK_MESSAGE_PRIVQ(receiver, mp); + LINK_MESSAGE_PRIVQ(receiver, first, last, len); } else #endif { - LINK_MESSAGE(receiver, mp); + LINK_MESSAGE(receiver, first, last, len); } + if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) { + ErtsMessage *msg = first; + #ifdef USE_VM_PROBES - if (DTRACE_ENABLED(message_queued)) { - DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); - Sint tok_label = 0; - Sint tok_lastcnt = 0; - Sint tok_serial = 0; - - dtrace_proc_str(receiver, receiver_name); - if (seq_trace_token != NIL && is_tuple(seq_trace_token)) { - tok_label = signed_val(SEQ_TRACE_T_LABEL(seq_trace_token)); - tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(seq_trace_token)); - tok_serial = signed_val(SEQ_TRACE_T_SERIAL(seq_trace_token)); + if (DTRACE_ENABLED(message_queued)) { + DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); + Sint tok_label = 0; + Sint tok_lastcnt = 0; + Sint tok_serial = 0; + Eterm seq_trace_token = ERL_MESSAGE_TOKEN(msg); + + dtrace_proc_str(receiver, receiver_name); + if (seq_trace_token != NIL && is_tuple(seq_trace_token)) { + tok_label = signed_val(SEQ_TRACE_T_LABEL(seq_trace_token)); + tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(seq_trace_token)); + tok_serial = signed_val(SEQ_TRACE_T_SERIAL(seq_trace_token)); + } + DTRACE6(message_queued, + receiver_name, size_object(ERL_MESSAGE_TERM(msg)), + receiver->msg.len, + tok_label, tok_lastcnt, tok_serial); } - DTRACE6(message_queued, - receiver_name, size_object(message), receiver->msg.len, - tok_label, tok_lastcnt, tok_serial); - } #endif - if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) - trace_receive(receiver, message); + while (msg) { + trace_receive(receiver, ERL_MESSAGE_TERM(msg)); + msg = msg->next; + } + + } if (locked_msgq) erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ); - erts_proc_notify_new_message(receiver, #ifdef ERTS_SMP - *receiver_locks + erts_proc_notify_new_message(receiver, *receiver_locks); #else - 0 -#endif - ); - -#ifndef ERTS_SMP + erts_proc_notify_new_message(receiver, 0); ERTS_HOLE_CHECK(receiver); #endif return res; } -void -#ifdef USE_VM_PROBES -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 +static Sint +queue_message(Process *c_p, + Process* receiver, + erts_aint32_t *receiver_state, + ErtsProcLocks *receiver_locks, + ErtsMessage* mp, Eterm msg) { - queue_message(NULL, - receiver, - receiver_locks, - NULL, - bp, - message, - seq_trace_token -#ifdef USE_VM_PROBES - , dt_utag -#endif - ); + ERL_MESSAGE_TERM(mp) = msg; + return queue_messages(c_p, receiver, receiver_state, receiver_locks, + mp, &mp->next, 1 ); } -void -erts_link_mbuf_to_proc(struct process *proc, ErlHeapFragment *bp) +Sint +erts_queue_message(Process* receiver, ErtsProcLocks *receiver_locks, + ErtsMessage* mp, Eterm msg) { - Eterm* htop = HEAP_TOP(proc); + return queue_message(NULL, receiver, NULL, receiver_locks, mp, msg); +} - link_mbuf_to_proc(proc, bp); - if (htop < HEAP_LIMIT(proc)) { - *htop = make_pos_bignum_header(HEAP_LIMIT(proc)-htop-1); - HEAP_TOP(proc) = HEAP_LIMIT(proc); - } + +Sint +erts_queue_messages(Process* receiver, ErtsProcLocks *receiver_locks, + ErtsMessage* first, ErtsMessage** last, Uint len) +{ + return queue_messages(NULL, receiver, NULL, receiver_locks, + first, last, len); } -/* - * Moves content of message buffer attached to a message into a heap. - * The message buffer is deallocated. - */ void -erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg) +erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *first_bp) { - struct erl_off_heap_header* oh; - Eterm term, token, *fhp, *hp; - Sint offs; - Uint sz; - ErlHeapFragment *bp; -#ifdef USE_VM_PROBES - Eterm utag; -#endif - -#ifdef HARD_DEBUG - struct erl_off_heap_header* dbg_oh_start = off_heap->first; - Eterm dbg_term, dbg_token; - ErlHeapFragment *dbg_bp; - Uint *dbg_hp, *dbg_thp_start; - Uint dbg_term_sz, dbg_token_sz; -#ifdef USE_VM_PROBES - Eterm dbg_utag; - Uint dbg_utag_sz; -#endif -#endif - - bp = msg->data.heap_frag; - term = ERL_MESSAGE_TERM(msg); - token = ERL_MESSAGE_TOKEN(msg); -#ifdef USE_VM_PROBES - utag = ERL_MESSAGE_DT_UTAG(msg); -#endif - if (!bp) { -#ifdef USE_VM_PROBES - ASSERT(is_immed(term) && is_immed(token) && is_immed(utag)); -#else - ASSERT(is_immed(term) && is_immed(token)); -#endif - return; - } - -#ifdef HARD_DEBUG - dbg_term_sz = size_object(term); - dbg_token_sz = size_object(token); - dbg_bp = new_message_buffer(dbg_term_sz + dbg_token_sz); -#ifdef USE_VM_PROBES - dbg_utag_sz = size_object(utag); - dbg_bp = new_message_buffer(dbg_term_sz + dbg_token_sz + dbg_utag_sz ); -#endif - /*ASSERT(dbg_term_sz + dbg_token_sz == erts_msg_used_frag_sz(msg)); - Copied size may be smaller due to removed SubBins's or garbage. - Copied size may be larger due to duplicated shared terms. - */ - dbg_hp = dbg_bp->mem; - dbg_term = copy_struct(term, dbg_term_sz, &dbg_hp, &dbg_bp->off_heap); - dbg_token = copy_struct(token, dbg_token_sz, &dbg_hp, &dbg_bp->off_heap); -#ifdef USE_VM_PROBES - dbg_utag = copy_struct(utag, dbg_utag_sz, &dbg_hp, &dbg_bp->off_heap); -#endif - dbg_thp_start = *hpp; -#endif - - if (bp->next != NULL) { - move_multi_frags(hpp, off_heap, bp, msg->m, -#ifdef USE_VM_PROBES - 3 -#else - 2 -#endif - ); - goto copy_done; - } - - OH_OVERHEAD(off_heap, bp->off_heap.overhead); - sz = bp->used_size; - - ASSERT(is_immed(term) || in_heapfrag(ptr_val(term),bp)); - ASSERT(is_immed(token) || in_heapfrag(ptr_val(token),bp)); - - fhp = bp->mem; - hp = *hpp; - offs = hp - fhp; - - oh = NULL; - while (sz--) { - Uint cpy_sz; - Eterm val = *fhp++; - - switch (primary_tag(val)) { - case TAG_PRIMARY_IMMED1: - *hp++ = val; - break; - case TAG_PRIMARY_LIST: - case TAG_PRIMARY_BOXED: - ASSERT(in_heapfrag(ptr_val(val), bp)); - *hp++ = offset_ptr(val, offs); - break; - case TAG_PRIMARY_HEADER: - *hp++ = val; - switch (val & _HEADER_SUBTAG_MASK) { - case ARITYVAL_SUBTAG: - break; - case REFC_BINARY_SUBTAG: - case FUN_SUBTAG: - case EXTERNAL_PID_SUBTAG: - case EXTERNAL_PORT_SUBTAG: - case EXTERNAL_REF_SUBTAG: - oh = (struct erl_off_heap_header*) (hp-1); - cpy_sz = thing_arityval(val); - goto cpy_words; - default: - cpy_sz = header_arity(val); - - cpy_words: - ASSERT(sz >= cpy_sz); - sz -= cpy_sz; - while (cpy_sz >= 8) { - cpy_sz -= 8; - *hp++ = *fhp++; - *hp++ = *fhp++; - *hp++ = *fhp++; - *hp++ = *fhp++; - *hp++ = *fhp++; - *hp++ = *fhp++; - *hp++ = *fhp++; - *hp++ = *fhp++; - } - switch (cpy_sz) { - case 7: *hp++ = *fhp++; - case 6: *hp++ = *fhp++; - case 5: *hp++ = *fhp++; - case 4: *hp++ = *fhp++; - case 3: *hp++ = *fhp++; - case 2: *hp++ = *fhp++; - case 1: *hp++ = *fhp++; - default: break; + if (first_bp) { + ErlHeapFragment *bp = first_bp; + + while (1) { + /* Move any off_heap's into the process */ + if (bp->off_heap.first != NULL) { + struct erl_off_heap_header** next_p = &bp->off_heap.first; + while (*next_p != NULL) { + next_p = &((*next_p)->next); } - if (oh) { - /* Add to offheap list */ - oh->next = off_heap->first; - off_heap->first = oh; - ASSERT(*hpp <= (Eterm*)oh); - ASSERT(hp > (Eterm*)oh); - oh = NULL; - } - break; + *next_p = MSO(proc).first; + MSO(proc).first = bp->off_heap.first; + bp->off_heap.first = NULL; + OH_OVERHEAD(&(MSO(proc)), bp->off_heap.overhead); } - break; + MBUF_SIZE(proc) += bp->used_size; + if (!bp->next) + break; + bp = bp->next; } - } - - ASSERT(bp->used_size == hp - *hpp); - *hpp = hp; - - if (is_not_immed(token)) { - ASSERT(in_heapfrag(ptr_val(token), bp)); - ERL_MESSAGE_TOKEN(msg) = offset_ptr(token, offs); -#ifdef HARD_DEBUG - ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TOKEN(msg))); - ASSERT(hp > ptr_val(ERL_MESSAGE_TOKEN(msg))); -#endif - } - - if (is_not_immed(term)) { - ASSERT(in_heapfrag(ptr_val(term),bp)); - ERL_MESSAGE_TERM(msg) = offset_ptr(term, offs); -#ifdef HARD_DEBUG - ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TERM(msg))); - ASSERT(hp > ptr_val(ERL_MESSAGE_TERM(msg))); -#endif - } -#ifdef USE_VM_PROBES - if (is_not_immed(utag)) { - ASSERT(in_heapfrag(ptr_val(utag), bp)); - ERL_MESSAGE_DT_UTAG(msg) = offset_ptr(utag, offs); -#ifdef HARD_DEBUG - ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_DT_UTAG(msg))); - ASSERT(hp > ptr_val(ERL_MESSAGE_DT_UTAG(msg))); -#endif - } -#endif -copy_done: - -#ifdef HARD_DEBUG - { - int i, j; - ErlHeapFragment* frag; - { - struct erl_off_heap_header* dbg_oh = off_heap->first; - i = j = 0; - while (dbg_oh != dbg_oh_start) { - dbg_oh = dbg_oh->next; - i++; - } - for (frag=bp; frag; frag=frag->next) { - dbg_oh = frag->off_heap.first; - while (dbg_oh) { - dbg_oh = dbg_oh->next; - j++; - } - } - ASSERT(i == j); - } + /* Link the message buffer */ + bp->next = MBUF(proc); + MBUF(proc) = first_bp; } -#endif - - - bp->off_heap.first = NULL; - free_message_buffer(bp); - msg->data.heap_frag = NULL; - -#ifdef HARD_DEBUG - ASSERT(eq(ERL_MESSAGE_TERM(msg), dbg_term)); - ASSERT(eq(ERL_MESSAGE_TOKEN(msg), dbg_token)); -#ifdef USE_VM_PROBES - ASSERT(eq(ERL_MESSAGE_DT_UTAG(msg), dbg_utag)); -#endif - free_message_buffer(dbg_bp); -#endif - } - Uint -erts_msg_attached_data_size_aux(ErlMessage *msg) +erts_msg_attached_data_size_aux(ErtsMessage *msg) { Sint sz; ASSERT(is_non_value(ERL_MESSAGE_TERM(msg))); @@ -833,29 +576,87 @@ erts_msg_attached_data_size_aux(ErlMessage *msg) return sz; } -void -erts_move_msg_attached_data_to_heap(ErtsHeapFactory* factory, - ErlMessage *msg) +ErtsMessage * +erts_try_alloc_message_on_heap(Process *pp, + erts_aint32_t *psp, + ErtsProcLocks *plp, + Uint sz, + Eterm **hpp, + ErlOffHeap **ohpp, + int *on_heap_p) { - if (is_value(ERL_MESSAGE_TERM(msg))) - erts_move_msg_mbuf_to_heap(&factory->hp, factory->off_heap, msg); - else if (msg->data.dist_ext) { - ASSERT(msg->data.dist_ext->heap_size >= 0); - if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) { - ErlHeapFragment *heap_frag; - heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); - ERL_MESSAGE_TOKEN(msg) = copy_struct(ERL_MESSAGE_TOKEN(msg), - heap_frag->used_size, - &factory->hp, - factory->off_heap); - erts_cleanup_offheap(&heap_frag->off_heap); +#ifdef ERTS_SMP + int locked_main = 0; +#endif + ErtsMessage *mp; + + ASSERT(!(*psp & ERTS_PSFLG_OFF_HEAP_MSGQ)); + + if ( +#if defined(ERTS_SMP) + *plp & ERTS_PROC_LOCK_MAIN +#else + pp +#endif + ) { +#ifdef ERTS_SMP + try_on_heap: +#endif + if ((*psp & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT)) + || (pp->flags & F_DISABLE_GC) + || HEAP_LIMIT(pp) - HEAP_TOP(pp) <= sz) { + /* + * The heap is either potentially in an inconsistent + * state, or not large enough. + */ +#ifdef ERTS_SMP + if (locked_main) { + *plp &= ~ERTS_PROC_LOCK_MAIN; + erts_smp_proc_unlock(pp, ERTS_PROC_LOCK_MAIN); + } +#endif + goto in_message_fragment; } - ERL_MESSAGE_TERM(msg) = erts_decode_dist_ext(factory, - msg->data.dist_ext); - erts_free_dist_ext_copy(msg->data.dist_ext); - msg->data.dist_ext = NULL; + + *hpp = HEAP_TOP(pp); + HEAP_TOP(pp) = *hpp + sz; + *ohpp = &MSO(pp); + mp = erts_alloc_message(0, NULL); + mp->data.attached = NULL; + *on_heap_p = !0; + } +#ifdef ERTS_SMP + else if (pp && erts_smp_proc_trylock(pp, ERTS_PROC_LOCK_MAIN) == 0) { + locked_main = 1; + *psp = erts_smp_atomic32_read_nob(&pp->state); + *plp |= ERTS_PROC_LOCK_MAIN; + goto try_on_heap; } - /* else: bad external detected when calculating size */ +#endif + else { + in_message_fragment: + if (!((*psp) & ERTS_PSFLG_ON_HEAP_MSGQ)) { + mp = erts_alloc_message(sz, hpp); + *ohpp = sz == 0 ? NULL : &mp->hfrag.off_heap; + } + else { + mp = erts_alloc_message(0, NULL); + if (!sz) { + *hpp = NULL; + *ohpp = NULL; + } + else { + ErlHeapFragment *bp; + bp = new_message_buffer(sz); + *hpp = &bp->mem[0]; + mp->data.heap_frag = bp; + *ohpp = &bp->off_heap; + } + } + *on_heap_p = 0; + } + + return mp; } /* @@ -870,7 +671,8 @@ erts_send_message(Process* sender, unsigned flags) { Uint msize; - ErlHeapFragment* bp = NULL; + ErtsMessage* mp; + ErlOffHeap *ohp; Eterm token = NIL; Sint res = 0; #ifdef USE_VM_PROBES @@ -879,80 +681,99 @@ erts_send_message(Process* sender, Sint tok_label = 0; Sint tok_lastcnt = 0; Sint tok_serial = 0; + Eterm utag = NIL; +#endif + erts_aint32_t receiver_state; +#ifdef SHCOPY_SEND + erts_shcopy_t info; #endif BM_STOP_TIMER(system); BM_MESSAGE(message,sender,receiver); BM_START_TIMER(send); - #ifdef USE_VM_PROBES +#ifdef USE_VM_PROBES *sender_name = *receiver_name = '\0'; - if (DTRACE_ENABLED(message_send)) { + if (DTRACE_ENABLED(message_send)) { erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), "%T", sender->common.id); erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), "%T", receiver->common.id); } #endif + + receiver_state = erts_smp_atomic32_read_nob(&receiver->state); + if (SEQ_TRACE_TOKEN(sender) != NIL && !(flags & ERTS_SND_FLG_NO_SEQ_TRACE)) { Eterm* hp; Eterm stoken = SEQ_TRACE_TOKEN(sender); Uint seq_trace_size = 0; #ifdef USE_VM_PROBES Uint dt_utag_size = 0; - Eterm utag = NIL; -#endif - - BM_SWAP_TIMER(send,size); - msize = size_object(message); - BM_SWAP_TIMER(size,send); - -#ifdef USE_VM_PROBES - if (stoken != am_have_dt_utag) { #endif - + BM_SWAP_TIMER(send,size); + + /* SHCOPY corrupts the heap between + * copy_shared_calculate, and + * copy_shared_perform. (it inserts move_markers like the gc). + * Make sure we don't use the heap between those instances. + */ + if (have_seqtrace(stoken)) { seq_trace_update_send(sender); seq_trace_output(stoken, message, SEQ_TRACE_SEND, receiver->common.id, sender); seq_trace_size = 6; /* TUPLE5 */ -#ifdef USE_VM_PROBES - } - if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) { - dt_utag_size = size_object(DT_UTAG(sender)); - } else if (stoken == am_have_dt_utag ) { - stoken = NIL; } +#ifdef USE_VM_PROBES + if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) { + dt_utag_size = size_object(DT_UTAG(sender)); + } else if (stoken == am_have_dt_utag ) { + stoken = NIL; + } +#endif + +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + msize = copy_shared_calculate(message, &info); +#else + msize = size_object(message); #endif + BM_SWAP_TIMER(size,send); - bp = new_message_buffer(msize + seq_trace_size + mp = erts_alloc_message_heap_state(receiver, + &receiver_state, + receiver_locks, + (msize #ifdef USE_VM_PROBES - + dt_utag_size + + dt_utag_size #endif - ); - hp = bp->mem; + + seq_trace_size), + &hp, + &ohp); BM_SWAP_TIMER(send,copy); - token = copy_struct(stoken, - seq_trace_size, - &hp, - &bp->off_heap); - message = copy_struct(message, msize, &hp, &bp->off_heap); -#ifdef USE_VM_PROBES - if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) { - utag = copy_struct(DT_UTAG(sender), dt_utag_size, &hp, &bp->off_heap); -#ifdef DTRACE_TAG_HARDDEBUG - erts_fprintf(stderr, - "Dtrace -> (%T) Spreading tag (%T) with " - "message %T!\r\n",sender->common.id, utag, message); -#endif - } +#ifdef SHCOPY_SEND + if (is_not_immed(message)) + message = copy_shared_perform(message, msize, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else + if (is_not_immed(message)) + message = copy_struct(message, msize, &hp, ohp); #endif - BM_MESSAGE_COPIED(msize); - BM_SWAP_TIMER(copy,send); + if (is_immed(stoken)) + token = stoken; + else + token = copy_struct(stoken, seq_trace_size, &hp, ohp); #ifdef USE_VM_PROBES + if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) { + if (is_immed(DT_UTAG(sender))) + utag = DT_UTAG(sender); + else + utag = copy_struct(DT_UTAG(sender), dt_utag_size, &hp, ohp); + } if (DTRACE_ENABLED(message_send)) { - if (stoken != NIL && stoken != am_have_dt_utag) { + if (have_seqtrace(stoken)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(stoken)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(stoken)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(stoken)); @@ -961,103 +782,66 @@ erts_send_message(Process* sender, msize, tok_label, tok_lastcnt, tok_serial); } #endif - res = queue_message(NULL, - receiver, - receiver_locks, - NULL, - bp, - message, - token -#ifdef USE_VM_PROBES - , utag -#endif - ); - BM_SWAP_TIMER(send,system); - } else if (sender == receiver) { - /* Drop message if receiver has a pending exit ... */ -#ifdef ERTS_SMP - ErtsProcLocks need_locks = (~(*receiver_locks) - & (ERTS_PROC_LOCK_MSGQ - | ERTS_PROC_LOCK_STATUS)); - if (need_locks) { - *receiver_locks |= need_locks; - if (erts_smp_proc_trylock(receiver, need_locks) == EBUSY) { - if (need_locks == ERTS_PROC_LOCK_MSGQ) { - erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_STATUS); - need_locks = ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS; - } - erts_smp_proc_lock(receiver, need_locks); - } + BM_MESSAGE_COPIED(msize); + BM_SWAP_TIMER(copy,send); + + } else { + Eterm *hp; + + if (receiver == sender && !(receiver_state & ERTS_PSFLG_OFF_HEAP_MSGQ)) { + mp = erts_alloc_message(0, NULL); + msize = 0; } - if (!ERTS_PROC_PENDING_EXIT(receiver)) + else { + BM_SWAP_TIMER(send,size); +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + msize = copy_shared_calculate(message, &info); +#else + msize = size_object(message); #endif - { - ErlMessage* mp = message_alloc(); - - DTRACE6(message_send, sender_name, receiver_name, - size_object(message), tok_label, tok_lastcnt, tok_serial); - mp->data.attached = NULL; - ERL_MESSAGE_TERM(mp) = message; - ERL_MESSAGE_TOKEN(mp) = NIL; -#ifdef USE_VM_PROBES - ERL_MESSAGE_DT_UTAG(mp) = NIL; + BM_SWAP_TIMER(size,send); + + mp = erts_alloc_message_heap_state(receiver, + &receiver_state, + receiver_locks, + msize, + &hp, + &ohp); + BM_SWAP_TIMER(send,copy); +#ifdef SHCOPY_SEND + if (is_not_immed(message)) + message = copy_shared_perform(message, msize, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else + if (is_not_immed(message)) + message = copy_struct(message, msize, &hp, ohp); #endif - mp->next = NULL; - /* - * We move 'in queue' to 'private queue' and place - * message at the end of 'private queue' in order - * to ensure that the 'in queue' doesn't contain - * references into the heap. By ensuring this, - * we don't need to include the 'in queue' in - * the root set when garbage collecting. - */ - - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(receiver); - LINK_MESSAGE_PRIVQ(receiver, mp); - - res = receiver->msg.len; - - if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) { - trace_receive(receiver, message); - } + BM_MESSAGE_COPIED(msz); + BM_SWAP_TIMER(copy,send); } - BM_SWAP_TIMER(send,system); - } else { - ErlOffHeap *ohp; - Eterm *hp; - erts_aint32_t state; - - BM_SWAP_TIMER(send,size); - msize = size_object(message); - BM_SWAP_TIMER(size,send); - hp = erts_alloc_message_heap_state(msize, - &bp, - &ohp, - receiver, - receiver_locks, - &state); - BM_SWAP_TIMER(send,copy); - message = copy_struct(message, msize, &hp, ohp); - BM_MESSAGE_COPIED(msz); - BM_SWAP_TIMER(copy,send); +#ifdef USE_VM_PROBES DTRACE6(message_send, sender_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); - res = queue_message(sender, - receiver, - receiver_locks, - &state, - bp, - message, - token -#ifdef USE_VM_PROBES - , NIL #endif - ); - BM_SWAP_TIMER(send,system); } - return res; + + ERL_MESSAGE_TOKEN(mp) = token; +#ifdef USE_VM_PROBES + ERL_MESSAGE_DT_UTAG(mp) = utag; +#endif + res = queue_message(sender, + receiver, + &receiver_state, + receiver_locks, + mp, message); + + BM_SWAP_TIMER(send,system); + + return res; } + /* * This function delivers an EXIT message to a process * which is trapping EXITs. @@ -1075,46 +859,573 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp, Uint sz_from; Eterm* hp; Eterm temptoken; - ErlHeapFragment* bp = NULL; - - if (token != NIL -#ifdef USE_VM_PROBES - && token != am_have_dt_utag + ErtsMessage* mp; + ErlOffHeap *ohp; +#ifdef SHCOPY_SEND + erts_shcopy_t info; #endif - ) { + if (have_seqtrace(token)) { ASSERT(is_tuple(token)); - sz_reason = size_object(reason); sz_token = size_object(token); sz_from = size_object(from); - bp = new_message_buffer(sz_reason + sz_from + sz_token + 4); - hp = bp->mem; - mess = copy_struct(reason, sz_reason, &hp, &bp->off_heap); - from_copy = copy_struct(from, sz_from, &hp, &bp->off_heap); +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + sz_reason = copy_shared_calculate(reason, &info); +#else + sz_reason = size_object(reason); +#endif + mp = erts_alloc_message_heap(to, to_locksp, + sz_reason + sz_from + sz_token + 4, + &hp, &ohp); +#ifdef SHCOPY_SEND + mess = copy_shared_perform(reason, sz_reason, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else + mess = copy_struct(reason, sz_reason, &hp, ohp); +#endif + from_copy = copy_struct(from, sz_from, &hp, ohp); save = TUPLE3(hp, am_EXIT, from_copy, mess); hp += 4; /* 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); + temptoken = copy_struct(token, sz_token, &hp, ohp); + ERL_MESSAGE_TOKEN(mp) = temptoken; + erts_queue_message(to, to_locksp, mp, save); } else { - ErlOffHeap *ohp; - sz_reason = size_object(reason); sz_from = IS_CONST(from) ? 0 : size_object(from); +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + sz_reason = copy_shared_calculate(reason, &info); +#else + sz_reason = size_object(reason); +#endif + mp = erts_alloc_message_heap(to, to_locksp, + sz_reason+sz_from+4, &hp, &ohp); - hp = erts_alloc_message_heap(sz_reason+sz_from+4, - &bp, - &ohp, - to, - to_locksp); - +#ifdef SHCOPY_SEND + mess = copy_shared_perform(reason, sz_reason, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else mess = copy_struct(reason, sz_reason, &hp, ohp); +#endif from_copy = (IS_CONST(from) ? 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); + erts_queue_message(to, to_locksp, mp, save); + } +} + +void erts_save_message_in_proc(Process *p, ErtsMessage *msgp) +{ + ErlHeapFragment *hfp; + + if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) + hfp = &msgp->hfrag; + else if (msgp->data.attached) { + hfp = msgp->data.heap_frag; + } + else { + erts_free_message(msgp); + return; /* Nothing to save */ + } + + while (1) { + struct erl_off_heap_header *ohhp = hfp->off_heap.first; + if (ohhp) { + for ( ; ohhp->next; ohhp = ohhp->next) + ; + ohhp->next = p->off_heap.first; + p->off_heap.first = hfp->off_heap.first; + hfp->off_heap.first = NULL; + } + p->off_heap.overhead += hfp->off_heap.overhead; + hfp->off_heap.overhead = 0; + p->mbuf_sz += hfp->used_size; + + if (!hfp->next) + break; + hfp = hfp->next; + } + + msgp->next = p->msg_frag; + p->msg_frag = msgp; +} + +Sint +erts_move_messages_off_heap(Process *c_p) +{ + int reds = 1; + /* + * Move all messages off heap. This *only* occurs when the + * process had off heap message disabled and just enabled + * it... + */ + ErtsMessage *mp; + + reds += c_p->msg.len / 10; + + ASSERT(erts_smp_atomic32_read_nob(&c_p->state) + & ERTS_PSFLG_OFF_HEAP_MSGQ); + ASSERT(c_p->flags & F_OFF_HEAP_MSGQ_CHNG); + + for (mp = c_p->msg.first; mp; mp = mp->next) { + Uint msg_sz, token_sz; +#ifdef USE_VM_PROBES + Uint utag_sz; +#endif + Eterm *hp; + ErlHeapFragment *hfrag; + + if (mp->data.attached) + continue; + + if (is_immed(ERL_MESSAGE_TERM(mp)) +#ifdef USE_VM_PROBES + && is_immed(ERL_MESSAGE_DT_UTAG(mp)) +#endif + && is_not_immed(ERL_MESSAGE_TOKEN(mp))) + continue; + + /* + * The message refers into the heap. Copy the message + * from the heap into a heap fragment and attach + * it to the message... + */ + msg_sz = size_object(ERL_MESSAGE_TERM(mp)); +#ifdef USE_VM_PROBES + utag_sz = size_object(ERL_MESSAGE_DT_UTAG(mp)); +#endif + token_sz = size_object(ERL_MESSAGE_TOKEN(mp)); + + hfrag = new_message_buffer(msg_sz +#ifdef USE_VM_PROBES + + utag_sz +#endif + + token_sz); + hp = hfrag->mem; + if (is_not_immed(ERL_MESSAGE_TERM(mp))) + ERL_MESSAGE_TERM(mp) = copy_struct(ERL_MESSAGE_TERM(mp), + msg_sz, &hp, + &hfrag->off_heap); + if (is_not_immed(ERL_MESSAGE_TOKEN(mp))) + ERL_MESSAGE_TOKEN(mp) = copy_struct(ERL_MESSAGE_TOKEN(mp), + token_sz, &hp, + &hfrag->off_heap); +#ifdef USE_VM_PROBES + if (is_not_immed(ERL_MESSAGE_DT_UTAG(mp))) + ERL_MESSAGE_DT_UTAG(mp) = copy_struct(ERL_MESSAGE_DT_UTAG(mp), + utag_sz, &hp, + &hfrag->off_heap); +#endif + mp->data.heap_frag = hfrag; + reds += 1; + } + + return reds; +} + +Sint +erts_complete_off_heap_message_queue_change(Process *c_p) +{ + int reds = 1; + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p)); + ASSERT(c_p->flags & F_OFF_HEAP_MSGQ_CHNG); + ASSERT(erts_smp_atomic32_read_nob(&c_p->state) & ERTS_PSFLG_OFF_HEAP_MSGQ); + + /* + * This job was first initiated when the process changed to off heap + * message queue management. Since then ERTS_PSFLG_OFF_HEAP_MSGQ + * has been set. However, the management state might have been changed + * again (multiple times) since then. Check users last requested state + * (the flags F_OFF_HEAP_MSGQ, and F_ON_HEAP_MSGQ), and make the state + * consistent with that. + */ + + if (!(c_p->flags & F_OFF_HEAP_MSGQ)) + erts_smp_atomic32_read_band_nob(&c_p->state, + ~ERTS_PSFLG_OFF_HEAP_MSGQ); + else { + reds += 2; + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ); + reds += erts_move_messages_off_heap(c_p); } + c_p->flags &= ~F_OFF_HEAP_MSGQ_CHNG; + return reds; +} + +typedef struct { + Eterm pid; + ErtsThrPrgrLaterOp lop; +} ErtsChangeOffHeapMessageQueue; + +static void +change_off_heap_msgq(void *vcohmq) +{ + ErtsChangeOffHeapMessageQueue *cohmq; + /* + * Now we've waited thread progress which ensures that all + * messages to the process are enqueued off heap. Schedule + * completion of this change as a system task on the process + * itself. This in order to avoid lock contention on its + * main lock. We will be called in + * erts_complete_off_heap_message_queue_change() (above) when + * the system task has been selected for execution. + */ + cohmq = (ErtsChangeOffHeapMessageQueue *) vcohmq; + erts_schedule_complete_off_heap_message_queue_change(cohmq->pid); + erts_free(ERTS_ALC_T_MSGQ_CHNG, vcohmq); +} + +Eterm +erts_change_message_queue_management(Process *c_p, Eterm new_state) +{ + Eterm res; + +#ifdef DEBUG + if (c_p->flags & F_OFF_HEAP_MSGQ) { + ASSERT(erts_smp_atomic32_read_nob(&c_p->state) + & ERTS_PSFLG_OFF_HEAP_MSGQ); + } + else { + if (c_p->flags & F_OFF_HEAP_MSGQ_CHNG) { + ASSERT(erts_smp_atomic32_read_nob(&c_p->state) + & ERTS_PSFLG_OFF_HEAP_MSGQ); + } + else { + ASSERT(!(erts_smp_atomic32_read_nob(&c_p->state) + & ERTS_PSFLG_OFF_HEAP_MSGQ)); + } + } +#endif + + switch (c_p->flags & (F_OFF_HEAP_MSGQ|F_ON_HEAP_MSGQ)) { + + case F_OFF_HEAP_MSGQ: + res = am_off_heap; + + switch (new_state) { + case am_off_heap: + break; + case am_on_heap: + c_p->flags |= F_ON_HEAP_MSGQ; + erts_smp_atomic32_read_bor_nob(&c_p->state, + ERTS_PSFLG_ON_HEAP_MSGQ); + /* fall through */ + case am_mixed: + c_p->flags &= ~F_OFF_HEAP_MSGQ; + /* + * We are not allowed to clear ERTS_PSFLG_OFF_HEAP_MSGQ + * if a off heap change is ongoing. It will be adjusted + * when the change completes... + */ + if (!(c_p->flags & F_OFF_HEAP_MSGQ_CHNG)) { + /* Safe to clear ERTS_PSFLG_OFF_HEAP_MSGQ... */ + erts_smp_atomic32_read_band_nob(&c_p->state, + ~ERTS_PSFLG_OFF_HEAP_MSGQ); + } + break; + default: + res = THE_NON_VALUE; /* badarg */ + break; + } + break; + + case F_ON_HEAP_MSGQ: + res = am_on_heap; + + switch (new_state) { + case am_on_heap: + break; + case am_mixed: + c_p->flags &= ~F_ON_HEAP_MSGQ; + erts_smp_atomic32_read_band_nob(&c_p->state, + ~ERTS_PSFLG_ON_HEAP_MSGQ); + break; + case am_off_heap: + c_p->flags &= ~F_ON_HEAP_MSGQ; + erts_smp_atomic32_read_band_nob(&c_p->state, + ~ERTS_PSFLG_ON_HEAP_MSGQ); + goto change_to_off_heap; + default: + res = THE_NON_VALUE; /* badarg */ + break; + } + break; + + case 0: + res = am_mixed; + + switch (new_state) { + case am_mixed: + break; + case am_on_heap: + c_p->flags |= F_ON_HEAP_MSGQ; + erts_smp_atomic32_read_bor_nob(&c_p->state, + ERTS_PSFLG_ON_HEAP_MSGQ); + break; + case am_off_heap: + goto change_to_off_heap; + default: + res = THE_NON_VALUE; /* badarg */ + break; + } + break; + + default: + res = am_error; + ERTS_INTERNAL_ERROR("Inconsistent message queue management state"); + break; + } + + return res; + +change_to_off_heap: + + c_p->flags |= F_OFF_HEAP_MSGQ; + + /* + * We do not have to schedule a change if + * we have an ongoing off heap change... + */ + if (!(c_p->flags & F_OFF_HEAP_MSGQ_CHNG)) { + ErtsChangeOffHeapMessageQueue *cohmq; + /* + * Need to set ERTS_PSFLG_OFF_HEAP_MSGQ and wait + * thread progress before completing the change in + * order to ensure that all senders observe that + * messages should be passed off heap. When the + * change has completed, GC does not need to inspect + * the message queue at all. + */ + erts_smp_atomic32_read_bor_nob(&c_p->state, + ERTS_PSFLG_OFF_HEAP_MSGQ); + c_p->flags |= F_OFF_HEAP_MSGQ_CHNG; + cohmq = erts_alloc(ERTS_ALC_T_MSGQ_CHNG, + sizeof(ErtsChangeOffHeapMessageQueue)); + cohmq->pid = c_p->common.id; + erts_schedule_thr_prgr_later_op(change_off_heap_msgq, + (void *) cohmq, + &cohmq->lop); + } + + return res; +} + +int +erts_decode_dist_message(Process *proc, ErtsProcLocks proc_locks, + ErtsMessage *msgp, int force_off_heap) +{ + ErtsHeapFactory factory; + Eterm msg; + ErlHeapFragment *bp; + Sint need; + int decode_in_heap_frag; + + decode_in_heap_frag = (force_off_heap + || !(proc_locks & ERTS_PROC_LOCK_MAIN) + || (proc->flags & F_OFF_HEAP_MSGQ)); + + if (msgp->data.dist_ext->heap_size >= 0) + need = msgp->data.dist_ext->heap_size; + else { + need = erts_decode_dist_ext_size(msgp->data.dist_ext); + if (need < 0) { + /* bad msg; remove it... */ + if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) { + bp = erts_dist_ext_trailer(msgp->data.dist_ext); + erts_cleanup_offheap(&bp->off_heap); + } + erts_free_dist_ext_copy(msgp->data.dist_ext); + msgp->data.dist_ext = NULL; + return 0; + } + + msgp->data.dist_ext->heap_size = need; + } + + if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) { + bp = erts_dist_ext_trailer(msgp->data.dist_ext); + need += bp->used_size; + } + + if (decode_in_heap_frag) + erts_factory_heap_frag_init(&factory, new_message_buffer(need)); + else + erts_factory_proc_prealloc_init(&factory, proc, need); + + ASSERT(msgp->data.dist_ext->heap_size >= 0); + if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) { + ErlHeapFragment *heap_frag; + heap_frag = erts_dist_ext_trailer(msgp->data.dist_ext); + ERL_MESSAGE_TOKEN(msgp) = copy_struct(ERL_MESSAGE_TOKEN(msgp), + heap_frag->used_size, + &factory.hp, + factory.off_heap); + erts_cleanup_offheap(&heap_frag->off_heap); + } + + msg = erts_decode_dist_ext(&factory, msgp->data.dist_ext); + ERL_MESSAGE_TERM(msgp) = msg; + erts_free_dist_ext_copy(msgp->data.dist_ext); + msgp->data.attached = NULL; + + if (is_non_value(msg)) { + erts_factory_undo(&factory); + return 0; + } + + erts_factory_trim_and_close(&factory, msgp->m, + ERL_MESSAGE_REF_ARRAY_SZ); + + ASSERT(!msgp->data.heap_frag); + + if (decode_in_heap_frag) + msgp->data.heap_frag = factory.heap_frags; + + return 1; +} + +/* + * ERTS_INSPECT_MSGQ_KEEP_OH_MSGS == 0 will move off heap messages + * into the heap of the inspected process if off_heap_message_queue + * is false when process_info(_, messages) is called. That is, the + * following GC will have more data in the rootset compared to the + * scenario when process_info(_, messages) had not been called. + * + * ERTS_INSPECT_MSGQ_KEEP_OH_MSGS != 0 will keep off heap messages + * off heap when process_info(_, messages) is called regardless of + * the off_heap_message_queue setting of the process. That is, it + * will change the following execution of the process as little as + * possible. + */ +#define ERTS_INSPECT_MSGQ_KEEP_OH_MSGS 1 + +Uint +erts_prep_msgq_for_inspection(Process *c_p, Process *rp, + ErtsProcLocks rp_locks, ErtsMessageInfo *mip) +{ + Uint tot_heap_size; + ErtsMessage* mp; + Sint i; + int self_on_heap; + + /* + * Prepare the message queue for inspection + * by process_info(). + * + * + * - Decode all messages on external format + * - Remove all corrupt dist messages from queue + * - Save pointer to, and heap size need of each + * message in the mip array. + * - Return total heap size need for all messages + * that needs to be copied. + * + * If ERTS_INSPECT_MSGQ_KEEP_OH_MSGS == 0: + * - In case off heap messages is disabled and + * we are inspecting our own queue, move all + * off heap data into the heap. + */ + + self_on_heap = c_p == rp && !(c_p->flags & F_OFF_HEAP_MSGQ); + + tot_heap_size = 0; + i = 0; + mp = rp->msg.first; + while (mp) { + Eterm msg = ERL_MESSAGE_TERM(mp); + + mip[i].size = 0; + + if (is_non_value(msg)) { + /* Dist message on external format; decode it... */ + if (mp->data.attached) + erts_decode_dist_message(rp, rp_locks, mp, + ERTS_INSPECT_MSGQ_KEEP_OH_MSGS); + + msg = ERL_MESSAGE_TERM(mp); + + if (is_non_value(msg)) { + ErtsMessage **mpp; + ErtsMessage *bad_mp = mp; + /* + * Bad distribution message; remove + * it from the queue... + */ + ASSERT(!mp->data.attached); + + mpp = i == 0 ? &rp->msg.first : &mip[i-1].msgp->next; + + if (rp->msg.save == &bad_mp->next) + rp->msg.save = mpp; + if (rp->msg.last == &bad_mp->next) + rp->msg.last = mpp; + mp = mp->next; + *mpp = mp; + rp->msg.len--; + bad_mp->next = NULL; + erts_cleanup_messages(bad_mp); + continue; + } + } + + ASSERT(is_value(msg)); + +#if ERTS_INSPECT_MSGQ_KEEP_OH_MSGS + if (is_not_immed(msg) && (!self_on_heap || mp->data.attached)) { + Uint sz = size_object(msg); + mip[i].size = sz; + tot_heap_size += sz; + } +#else + if (self_on_heap) { + if (mp->data.attached) { + ErtsMessage *tmp = NULL; + if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG) { + erts_link_mbuf_to_proc(rp, mp->data.heap_frag); + mp->data.attached = NULL; + } + else { + /* + * Need to replace the message reference since + * we will get references to the message data + * from the heap... + */ + ErtsMessage **mpp; + tmp = erts_alloc_message(0, NULL); + sys_memcpy((void *) tmp->m, (void *) mp->m, + sizeof(Eterm)*ERL_MESSAGE_REF_ARRAY_SZ); + mpp = i == 0 ? &rp->msg.first : &mip[i-1].msgp->next; + tmp->next = mp->next; + if (rp->msg.save == &mp->next) + rp->msg.save = &tmp->next; + if (rp->msg.last == &mp->next) + rp->msg.last = &tmp->next; + *mpp = tmp; + erts_save_message_in_proc(rp, mp); + mp = tmp; + } + } + } + else if (is_not_immed(msg)) { + Uint sz = size_object(msg); + mip[i].size = sz; + tot_heap_size += sz; + } + +#endif + + mip[i].msgp = mp; + i++; + mp = mp->next; + } + + return tot_heap_size; } void erts_factory_proc_init(ErtsHeapFactory* factory, @@ -1127,47 +1438,138 @@ void erts_factory_proc_prealloc_init(ErtsHeapFactory* factory, Process* p, Sint size) { + ErlHeapFragment *bp = p->mbuf; factory->mode = FACTORY_HALLOC; factory->p = p; factory->hp_start = HAlloc(p, size); factory->hp = factory->hp_start; factory->hp_end = factory->hp_start + size; factory->off_heap = &p->off_heap; + factory->message = NULL; factory->off_heap_saved.first = p->off_heap.first; factory->off_heap_saved.overhead = p->off_heap.overhead; - factory->heap_frags_saved = p->mbuf; + factory->heap_frags_saved = bp; + factory->heap_frags_saved_used = bp ? bp->used_size : 0; factory->heap_frags = NULL; /* not used */ factory->alloc_type = 0; /* not used */ } -void erts_factory_message_init(ErtsHeapFactory* factory, - Process* rp, - Eterm* hp, - ErlHeapFragment* bp) +void erts_factory_heap_frag_init(ErtsHeapFactory* factory, + ErlHeapFragment* bp) +{ + factory->mode = FACTORY_HEAP_FRAGS; + factory->p = NULL; + factory->hp_start = bp->mem; + factory->hp = bp->mem; + factory->hp_end = bp->mem + bp->alloc_size; + factory->off_heap = &bp->off_heap; + factory->message = NULL; + factory->heap_frags = bp; + factory->heap_frags_saved = NULL; + factory->heap_frags_saved_used = 0; + factory->alloc_type = ERTS_ALC_T_HEAP_FRAG; + ASSERT(!bp->next); + factory->off_heap_saved.first = factory->off_heap->first; + factory->off_heap_saved.overhead = factory->off_heap->overhead; + + ASSERT(factory->hp >= factory->hp_start && factory->hp <= factory->hp_end); +} + + +ErtsMessage * +erts_factory_message_create(ErtsHeapFactory* factory, + Process *proc, + ErtsProcLocks *proc_locksp, + Uint sz) { - if (bp) { - factory->mode = FACTORY_HEAP_FRAGS; - factory->p = NULL; - factory->hp_start = bp->mem; - factory->hp = hp ? hp : bp->mem; - factory->hp_end = bp->mem + bp->alloc_size; - factory->off_heap = &bp->off_heap; - factory->heap_frags = bp; - factory->heap_frags_saved = bp; - factory->alloc_type = ERTS_ALC_T_HEAP_FRAG; - ASSERT(!bp->next); + Eterm *hp; + ErlOffHeap *ohp; + ErtsMessage *msgp; + int on_heap; + erts_aint32_t state; + + state = proc ? erts_smp_atomic32_read_nob(&proc->state) : 0; + + if (state & ERTS_PSFLG_OFF_HEAP_MSGQ) { + msgp = erts_alloc_message(sz, &hp); + ohp = sz == 0 ? NULL : &msgp->hfrag.off_heap; + on_heap = 0; + } + else { + msgp = erts_try_alloc_message_on_heap(proc, &state, + proc_locksp, + sz, &hp, &ohp, + &on_heap); + } + + if (on_heap) { + ERTS_SMP_ASSERT(*proc_locksp & ERTS_PROC_LOCK_MAIN); + ASSERT(ohp == &proc->off_heap); + factory->mode = FACTORY_HALLOC; + factory->p = proc; + factory->heap_frags_saved = proc->mbuf; + factory->heap_frags_saved_used = proc->mbuf ? proc->mbuf->used_size : 0; } else { - factory->mode = FACTORY_HALLOC; - factory->p = rp; - factory->hp_start = hp; - factory->hp = hp; - factory->hp_end = HEAP_TOP(rp); - factory->off_heap = &rp->off_heap; - factory->heap_frags_saved = rp->mbuf; - factory->heap_frags = NULL; /* not used */ - factory->alloc_type = 0; /* not used */ + factory->mode = FACTORY_MESSAGE; + factory->p = NULL; + factory->heap_frags_saved = NULL; + factory->heap_frags_saved_used = 0; + + if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) { + ASSERT(!msgp->hfrag.next); + factory->heap_frags = NULL; + } + else { + ASSERT(!msgp->data.heap_frag + || !msgp->data.heap_frag->next); + factory->heap_frags = msgp->data.heap_frag; + } } + factory->hp_start = hp; + factory->hp = hp; + factory->hp_end = hp + sz; + factory->message = msgp; + factory->off_heap = ohp; + factory->alloc_type = ERTS_ALC_T_HEAP_FRAG; + if (ohp) { + factory->off_heap_saved.first = ohp->first; + factory->off_heap_saved.overhead = ohp->overhead; + } + else { + factory->off_heap_saved.first = NULL; + factory->off_heap_saved.overhead = 0; + } + + ASSERT(factory->hp >= factory->hp_start && factory->hp <= factory->hp_end); + + return msgp; +} + +void erts_factory_selfcontained_message_init(ErtsHeapFactory* factory, + ErtsMessage *msgp, + Eterm *hp) +{ + ErlHeapFragment* bp; + if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) { + bp = &msgp->hfrag; + factory->heap_frags = NULL; + } + else { + bp = msgp->data.heap_frag; + factory->heap_frags = bp; + } + factory->mode = FACTORY_MESSAGE; + factory->p = NULL; + factory->hp_start = bp->mem; + factory->hp = hp; + factory->hp_end = bp->mem + bp->alloc_size; + factory->message = msgp; + factory->off_heap = &bp->off_heap; + factory->heap_frags_saved = NULL; + factory->heap_frags_saved_used = 0; + factory->alloc_type = ERTS_ALC_T_HEAP_FRAG; + ASSERT(!bp->next); factory->off_heap_saved.first = factory->off_heap->first; factory->off_heap_saved.overhead = factory->off_heap->overhead; @@ -1250,9 +1652,17 @@ static void reserve_heap(ErtsHeapFactory* factory, Uint need, Uint xtra) factory->hp_end = factory->hp + need; return; - case FACTORY_HEAP_FRAGS: - case FACTORY_TMP: - bp = factory->heap_frags; + case FACTORY_MESSAGE: + if (!factory->heap_frags) { + ASSERT(factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG); + bp = &factory->message->hfrag; + } + else { + /* Fall through */ + case FACTORY_HEAP_FRAGS: + case FACTORY_TMP: + bp = factory->heap_frags; + } if (bp) { ASSERT(factory->hp > bp->mem); @@ -1290,8 +1700,23 @@ void erts_factory_close(ErtsHeapFactory* factory) HRelease(factory->p, factory->hp_end, factory->hp); break; - case FACTORY_HEAP_FRAGS: - bp = factory->heap_frags; + case FACTORY_MESSAGE: + if (!factory->heap_frags) { + if (factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG) + bp = &factory->message->hfrag; + else + bp = NULL; + } + else { + if (factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG) + factory->message->hfrag.next = factory->heap_frags; + else + factory->message->data.heap_frag = factory->heap_frags; + + /* Fall through */ + case FACTORY_HEAP_FRAGS: + bp = factory->heap_frags; + } if (bp) { ASSERT(factory->hp >= bp->mem); @@ -1315,17 +1740,47 @@ void erts_factory_close(ErtsHeapFactory* factory) void erts_factory_trim_and_close(ErtsHeapFactory* factory, Eterm *brefs, Uint brefs_size) { - if (factory->mode == FACTORY_HEAP_FRAGS) { - ErlHeapFragment* bp = factory->heap_frags; + ErlHeapFragment *bp; + + switch (factory->mode) { + case FACTORY_MESSAGE: { + ErtsMessage *mp = factory->message; + if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG) { + if (!mp->hfrag.next) { + Uint sz = factory->hp - factory->hp_start; + mp = erts_shrink_message(mp, sz, brefs, brefs_size); + factory->message = mp; + factory->mode = FACTORY_CLOSED; + return; + } + /*else we don't trim multi fragmented messages for now (off_heap...) */ + break; + } + /* Fall through... */ + } + case FACTORY_HEAP_FRAGS: + bp = factory->heap_frags; + if (!bp) + break; if (bp->next == NULL) { Uint used_sz = factory->hp - bp->mem; ASSERT(used_sz <= bp->alloc_size); - factory->heap_frags = erts_resize_message_buffer(bp, used_sz, - brefs, brefs_size); + if (used_sz > 0) + bp = erts_resize_message_buffer(bp, used_sz, + brefs, brefs_size); + else { + free_message_buffer(bp); + bp = NULL; + } + factory->heap_frags = bp; + if (factory->mode == FACTORY_MESSAGE) + factory->message->data.heap_frag = bp; factory->mode = FACTORY_CLOSED; return; } - /*else we don't trim multi fragmented messages for now */ + /*else we don't trim multi fragmented messages for now (off_heap...) */ + default: + break; } erts_factory_close(factory); } @@ -1373,28 +1828,33 @@ void erts_factory_undo(ErtsHeapFactory* factory) /* Rollback heap top */ - if (factory->heap_frags_saved == NULL) { /* No heap frags when we started */ - ASSERT(factory->hp_start >= HEAP_START(factory->p)); - ASSERT(factory->hp_start <= HEAP_LIMIT(factory->p)); - HEAP_TOP(factory->p) = factory->hp_start; - } - else { + if (HEAP_START(factory->p) <= factory->hp_start + && factory->hp_start <= HEAP_LIMIT(factory->p)) { + HEAP_TOP(factory->p) = factory->hp_start; + } + + /* Fix last heap frag */ + if (factory->heap_frags_saved) { ASSERT(factory->heap_frags_saved == factory->p->mbuf); - if (factory->hp_start == factory->heap_frags_saved->mem) { + if (factory->hp_start != factory->heap_frags_saved->mem) + factory->heap_frags_saved->used_size = factory->heap_frags_saved_used; + else { factory->p->mbuf = factory->p->mbuf->next; ERTS_HEAP_FREE(ERTS_ALC_T_HEAP_FRAG, factory->heap_frags_saved, ERTS_HEAP_FRAG_SIZE(factory->heap_frags_saved->alloc_size)); } - else if (factory->hp_start != factory->hp_end) { - unsigned remains = factory->hp_start - factory->heap_frags_saved->mem; - ASSERT(remains > 0 && remains < factory->heap_frags_saved->used_size); - factory->heap_frags_saved->used_size = remains; - } } } break; + case FACTORY_MESSAGE: + if (factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG) + factory->message->hfrag.next = factory->heap_frags; + else + factory->message->data.heap_frag = factory->heap_frags; + erts_cleanup_messages(factory->message); + break; case FACTORY_TMP: case FACTORY_HEAP_FRAGS: erts_cleanup_offheap(factory->off_heap); @@ -1422,4 +1882,3 @@ void erts_factory_undo(ErtsHeapFactory* factory) factory->heap_frags = NULL; #endif } - diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index 92ba3e571c..608cf552a2 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2012. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -24,6 +24,8 @@ struct proc_bin; struct external_thing_; +typedef struct erl_mesg ErtsMessage; + /* * This struct represents data that must be updated by structure copy, * but is stored outside of any heap. @@ -32,9 +34,6 @@ struct external_thing_; struct erl_off_heap_header { Eterm thing_word; Uint size; -#if HALFWORD_HEAP - void* dummy_ptr_padding__; -#endif struct erl_off_heap_header* next; }; @@ -57,6 +56,7 @@ typedef struct { enum { FACTORY_CLOSED = 0, FACTORY_HALLOC, + FACTORY_MESSAGE, FACTORY_HEAP_FRAGS, FACTORY_STATIC, FACTORY_TMP @@ -65,8 +65,10 @@ typedef struct { Eterm* hp_start; Eterm* hp; Eterm* hp_end; + ErtsMessage *message; struct erl_heap_fragment* heap_frags; struct erl_heap_fragment* heap_frags_saved; + Uint heap_frags_saved_used; ErlOffHeap* off_heap; ErlOffHeap off_heap_saved; Uint32 alloc_type; @@ -74,7 +76,10 @@ typedef struct { void erts_factory_proc_init(ErtsHeapFactory*, Process*); void erts_factory_proc_prealloc_init(ErtsHeapFactory*, Process*, Sint size); -void erts_factory_message_init(ErtsHeapFactory*, Process*, Eterm* hp, struct erl_heap_fragment*); +void erts_factory_heap_frag_init(ErtsHeapFactory*, struct erl_heap_fragment*); +ErtsMessage *erts_factory_message_create(ErtsHeapFactory *, Process *, + ErtsProcLocks *, Uint sz); +void erts_factory_selfcontained_message_init(ErtsHeapFactory*, ErtsMessage *, Eterm *); void erts_factory_static_init(ErtsHeapFactory*, Eterm* hp, Uint size, ErlOffHeap*); void erts_factory_tmp_init(ErtsHeapFactory*, Eterm* hp, Uint size, Uint32 atype); void erts_factory_dummy_init(ErtsHeapFactory*); @@ -96,6 +101,8 @@ void erts_factory_undo(ErtsHeapFactory*); #include "external.h" #include "erl_process.h" +#define ERTS_INVALID_HFRAG_PTR ((ErlHeapFragment *) ~((UWord) 7)) + /* * This struct represents a heap fragment, which is used when there * isn't sufficient room in the process heap and we can't do a GC. @@ -110,33 +117,53 @@ struct erl_heap_fragment { Eterm mem[1]; /* Data */ }; -typedef struct erl_mesg { - struct erl_mesg* next; /* Next message */ - union { - ErtsDistExternal *dist_ext; - ErlHeapFragment *heap_frag; - void *attached; - } data; +/* m[0] = message, m[1] = seq trace token */ +#define ERL_MESSAGE_REF_ARRAY_SZ 2 +#define ERL_MESSAGE_TERM(mp) ((mp)->m[0]) +#define ERL_MESSAGE_TOKEN(mp) ((mp)->m[1]) + #ifdef USE_VM_PROBES - Eterm m[3]; /* m[0] = message, m[1] = seq trace token, m[3] = dynamic trace user tag */ +/* m[2] = dynamic trace user tag */ +#undef ERL_MESSAGE_REF_ARRAY_SZ +#define ERL_MESSAGE_REF_ARRAY_SZ 3 +#define ERL_MESSAGE_DT_UTAG(mp) ((mp)->m[2]) #else - Eterm m[2]; /* m[0] = message, m[1] = seq trace token */ #endif -} ErlMessage; -#define ERL_MESSAGE_TERM(mp) ((mp)->m[0]) -#define ERL_MESSAGE_TOKEN(mp) ((mp)->m[1]) #ifdef USE_VM_PROBES -#define ERL_MESSAGE_DT_UTAG(mp) ((mp)->m[2]) +#define have_no_seqtrace(T) ((T) == NIL || (T) == am_have_dt_utag) +#else +#define have_no_seqtrace(T) ((T) == NIL) #endif +#define have_seqtrace(T) (!have_no_seqtrace(T)) + +#define ERL_MESSAGE_REF_FIELDS__ \ + ErtsMessage *next; /* Next message */ \ + union { \ + ErtsDistExternal *dist_ext; \ + ErlHeapFragment *heap_frag; \ + void *attached; \ + } data; \ + Eterm m[ERL_MESSAGE_REF_ARRAY_SZ] + + +typedef struct erl_msg_ref__ { + ERL_MESSAGE_REF_FIELDS__; +} ErtsMessageRef; + +struct erl_mesg { + ERL_MESSAGE_REF_FIELDS__; + + ErlHeapFragment hfrag; +}; /* Size of default message buffer (erl_message.c) */ #define ERL_MESSAGE_BUF_SZ 500 typedef struct { - ErlMessage* first; - ErlMessage** last; /* point to the last next pointer */ - ErlMessage** save; + ErtsMessage* first; + ErtsMessage** last; /* point to the last next pointer */ + ErtsMessage** save; Sint len; /* queue length */ /* @@ -144,65 +171,81 @@ typedef struct { * recv_set/1 instructions. */ BeamInstr* mark; /* address to rec_loop/2 instruction */ - ErlMessage** saved_last; /* saved last pointer */ + ErtsMessage** saved_last; /* saved last pointer */ } ErlMessageQueue; #ifdef ERTS_SMP typedef struct { - ErlMessage* first; - ErlMessage** last; /* point to the last next pointer */ + ErtsMessage* first; + ErtsMessage** last; /* point to the last next pointer */ Sint len; /* queue length */ } ErlMessageInQueue; +typedef struct erl_trace_message_queue__ { + struct erl_trace_message_queue__ *next; /* point to the next receiver */ + Eterm receiver; + ErtsMessage* first; + ErtsMessage** last; /* point to the last next pointer */ + Sint len; /* queue length */ +} ErlTraceMessageQueue; + #endif /* Get "current" message */ #define PEEK_MESSAGE(p) (*(p)->msg.save) +#ifdef USE_VM_PROBES +#define LINK_MESSAGE_DTAG(mp, dt) ERL_MESSAGE_DT_UTAG(mp) = dt +#else +#define LINK_MESSAGE_DTAG(mp, dt) +#endif -/* Add message last in private message queue */ -#define LINK_MESSAGE_PRIVQ(p, mp) do { \ - *(p)->msg.last = (mp); \ - (p)->msg.last = &(mp)->next; \ - (p)->msg.len++; \ -} while (0) - +#define LINK_MESSAGE_IMPL(p, first_msg, last_msg, num_msgs, where) do { \ + *(p)->where.last = (first_msg); \ + (p)->where.last = (last_msg); \ + (p)->where.len += (num_msgs); \ + } while(0) #ifdef ERTS_SMP -/* Move in message queue to end of private message queue */ -#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(P) \ -do { \ - if ((P)->msg_inq.first) { \ - *(P)->msg.last = (P)->msg_inq.first; \ - (P)->msg.last = (P)->msg_inq.last; \ - (P)->msg.len += (P)->msg_inq.len; \ - (P)->msg_inq.first = NULL; \ - (P)->msg_inq.last = &(P)->msg_inq.first; \ - (P)->msg_inq.len = 0; \ - } \ -} while (0) - -/* Add message last in message queue */ -#define LINK_MESSAGE(p, mp) do { \ - *(p)->msg_inq.last = (mp); \ - (p)->msg_inq.last = &(mp)->next; \ - (p)->msg_inq.len++; \ -} while(0) +/* Add message last in private message queue */ +#define LINK_MESSAGE_PRIVQ(p, first_msg, last_msg, len) \ + do { \ + LINK_MESSAGE_IMPL(p, first_msg, last_msg, len, msg); \ + } while (0) + +/* Add message last_msg in message queue */ +#define LINK_MESSAGE(p, first_msg, last_msg, len) \ + LINK_MESSAGE_IMPL(p, first_msg, last_msg, len, msg_inq) + +#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p) \ + do { \ + if (p->msg_inq.first) { \ + *p->msg.last = p->msg_inq.first; \ + p->msg.last = p->msg_inq.last; \ + p->msg.len += p->msg_inq.len; \ + p->msg_inq.first = NULL; \ + p->msg_inq.last = &p->msg_inq.first; \ + p->msg_inq.len = 0; \ + } \ + } while (0) #else -#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(P) +#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p) -/* Add message last in message queue */ -#define LINK_MESSAGE(p, mp) LINK_MESSAGE_PRIVQ((p), (mp)) +/* Add message last_msg in message queue */ +#define LINK_MESSAGE(p, first_msg, last_msg, len) \ + do { \ + LINK_MESSAGE_IMPL(p, first_msg, last_msg, len, msg); \ + } while(0) #endif /* Unlink current message */ #define UNLINK_MESSAGE(p,msgp) do { \ - ErlMessage* __mp = (msgp)->next; \ + ErtsMessage* __mp = (msgp)->next; \ *(p)->msg.save = __mp; \ (p)->msg.len--; \ if (__mp == NULL) \ @@ -218,98 +261,180 @@ do { \ #define SAVE_MESSAGE(p) \ (p)->msg.save = &(*(p)->msg.save)->next -/* - * ErtsMoveMsgAttachmentIntoProc() moves data attached to a message - * onto the heap of a process. The attached data is the content of - * the the message either on the internal format or on the external - * format, and also possibly a seq trace token on the internal format. - * If the message content is on the external format, the decode might - * fail. If the decoding fails, ERL_MESSAGE_TERM(M) will contain - * THE_NON_VALUE. That is, ERL_MESSAGE_TERM(M) *has* to be checked - * afterwards and taken care of appropriately. - * - * ErtsMoveMsgAttachmentIntoProc() will shallow copy to heap if - * possible; otherwise, move to heap via garbage collection. - * - * ErtsMoveMsgAttachmentIntoProc() is used when receiveing messages - * in process_main() and in hipe_check_get_msg(). - */ - -#define ErtsMoveMsgAttachmentIntoProc(M, P, ST, HT, FC, SWPO, SWPI) \ -do { \ - if ((M)->data.attached) { \ - Uint need__ = erts_msg_attached_data_size((M)); \ - { SWPO ; } \ - if ((ST) - (HT) >= need__) { \ - ErtsHeapFactory factory__; \ - erts_factory_proc_prealloc_init(&factory__, (P), need__); \ - erts_move_msg_attached_data_to_heap(&factory__, (M)); \ - erts_factory_close(&factory__); \ - if ((P)->mbuf != NULL) { \ - /* Heap was exhausted by messages. This is a rare case */ \ - /* that can currently (OTP 18) only happen if hamts are */ \ - /* far exceeding the estimated heap size. Do GC. */ \ - (FC) -= erts_garbage_collect((P), 0, NULL, 0); \ - } \ - } \ - else { \ - (FC) -= erts_garbage_collect((P), 0, NULL, 0); \ - } \ - { SWPI ; } \ - ASSERT(!(M)->data.attached); \ - } \ -} while (0) - #define ERTS_SND_FLG_NO_SEQ_TRACE (((unsigned) 1) << 0) #define ERTS_HEAP_FRAG_SIZE(DATA_WORDS) \ (sizeof(ErlHeapFragment) - sizeof(Eterm) + (DATA_WORDS)*sizeof(Eterm)) -#define ERTS_INIT_HEAP_FRAG(HEAP_FRAG_P, DATA_WORDS) \ -do { \ - (HEAP_FRAG_P)->next = NULL; \ - (HEAP_FRAG_P)->alloc_size = (DATA_WORDS); \ - (HEAP_FRAG_P)->used_size = (DATA_WORDS); \ - (HEAP_FRAG_P)->off_heap.first = NULL; \ - (HEAP_FRAG_P)->off_heap.overhead = 0; \ -} while (0) +#define ERTS_INIT_HEAP_FRAG(HEAP_FRAG_P, USED_WORDS, DATA_WORDS) \ + do { \ + (HEAP_FRAG_P)->next = NULL; \ + (HEAP_FRAG_P)->alloc_size = (DATA_WORDS); \ + (HEAP_FRAG_P)->used_size = (USED_WORDS); \ + (HEAP_FRAG_P)->off_heap.first = NULL; \ + (HEAP_FRAG_P)->off_heap.overhead = 0; \ + } while (0) + +#ifdef USE_VM_PROBES +#define ERL_MESSAGE_DT_UTAG_INIT(MP) ERL_MESSAGE_DT_UTAG(MP) = NIL +#else +#define ERL_MESSAGE_DT_UTAG_INIT(MP) do{ } while (0) +#endif + +#define ERTS_INIT_MESSAGE(MP) \ + do { \ + (MP)->next = NULL; \ + ERL_MESSAGE_TERM(MP) = THE_NON_VALUE; \ + ERL_MESSAGE_TOKEN(MP) = NIL; \ + ERL_MESSAGE_DT_UTAG_INIT(MP); \ + MP->data.attached = NULL; \ + } while (0) void init_message(void); -void free_message(ErlMessage *); ErlHeapFragment* new_message_buffer(Uint); ErlHeapFragment* erts_resize_message_buffer(ErlHeapFragment *, Uint, Eterm *, Uint); void free_message_buffer(ErlHeapFragment *); void erts_queue_dist_message(Process*, ErtsProcLocks*, ErtsDistExternal *, Eterm); -#ifdef USE_VM_PROBES -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 +Sint erts_queue_message(Process*, ErtsProcLocks*,ErtsMessage*, Eterm); +Sint erts_queue_messages(Process*, ErtsProcLocks*, + ErtsMessage*, ErtsMessage**, Uint); 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); -void erts_move_msg_mbuf_to_heap(Eterm**, ErlOffHeap*, ErlMessage *); - -Uint erts_msg_attached_data_size_aux(ErlMessage *msg); -void erts_move_msg_attached_data_to_heap(ErtsHeapFactory*, ErlMessage *); -Eterm erts_msg_distext2heap(Process *, ErtsProcLocks *, ErlHeapFragment **, - Eterm *, ErtsDistExternal *); +Uint erts_msg_attached_data_size_aux(ErtsMessage *msg); void erts_cleanup_offheap(ErlOffHeap *offheap); +void erts_save_message_in_proc(Process *p, ErtsMessage *msg); +Sint erts_move_messages_off_heap(Process *c_p); +Sint erts_complete_off_heap_message_queue_change(Process *c_p); +Eterm erts_change_message_queue_management(Process *c_p, Eterm new_state); + +int erts_decode_dist_message(Process *, ErtsProcLocks, ErtsMessage *, int); + +void erts_cleanup_messages(ErtsMessage *mp); + +typedef struct { + Uint size; + ErtsMessage *msgp; +} ErtsMessageInfo; + +Uint erts_prep_msgq_for_inspection(Process *c_p, + Process *rp, + ErtsProcLocks rp_locks, + ErtsMessageInfo *mip); + +void *erts_alloc_message_ref(void); +void erts_free_message_ref(void *); +#define ERTS_SMALL_FIX_MSG_SZ 10 +#define ERTS_MEDIUM_FIX_MSG_SZ 20 +#define ERTS_LARGE_FIX_MSG_SZ 30 +void *erts_alloc_small_message(void); +void erts_free_small_message(void *mp); + +typedef struct { + ErtsMessage m; + Eterm data[ERTS_SMALL_FIX_MSG_SZ-1]; +} ErtsSmallFixSzMessage; + +typedef struct { + ErtsMessage m; + Eterm data[ERTS_MEDIUM_FIX_MSG_SZ-1]; +} ErtsMediumFixSzMessage; + +typedef struct { + ErtsMessage m; + Eterm data[ERTS_LARGE_FIX_MSG_SZ-1]; +} ErtsLargeFixSzMessage; + +ErtsMessage *erts_try_alloc_message_on_heap(Process *pp, + erts_aint32_t *psp, + ErtsProcLocks *plp, + Uint sz, + Eterm **hpp, + ErlOffHeap **ohpp, + int *on_heap_p); +ErtsMessage *erts_realloc_shrink_message(ErtsMessage *mp, Uint sz, + Eterm *brefs, Uint brefs_size); + +ERTS_GLB_FORCE_INLINE ErtsMessage *erts_alloc_message(Uint sz, Eterm **hpp); +ERTS_GLB_FORCE_INLINE ErtsMessage *erts_shrink_message(ErtsMessage *mp, Uint sz, + Eterm *brefs, Uint brefs_size); +ERTS_GLB_FORCE_INLINE void erts_free_message(ErtsMessage *mp); ERTS_GLB_INLINE Uint erts_used_frag_sz(const ErlHeapFragment*); -ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErlMessage *msg); +ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErtsMessage *msg); + +#define ERTS_MSG_COMBINED_HFRAG ((void *) 0x1) #if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_FORCE_INLINE ErtsMessage *erts_alloc_message(Uint sz, Eterm **hpp) +{ + ErtsMessage *mp; + + if (sz == 0) { + mp = erts_alloc_message_ref(); + ERTS_INIT_MESSAGE(mp); + if (hpp) + *hpp = NULL; + return mp; + } + + mp = erts_alloc(ERTS_ALC_T_MSG, + sizeof(ErtsMessage) + (sz - 1)*sizeof(Eterm)); + + ERTS_INIT_MESSAGE(mp); + mp->data.attached = ERTS_MSG_COMBINED_HFRAG; + ERTS_INIT_HEAP_FRAG(&mp->hfrag, sz, sz); + + if (hpp) + *hpp = &mp->hfrag.mem[0]; + + return mp; +} + +ERTS_GLB_FORCE_INLINE ErtsMessage * +erts_shrink_message(ErtsMessage *mp, Uint sz, Eterm *brefs, Uint brefs_size) +{ + if (sz == 0) { + ErtsMessage *nmp; + if (!mp->data.attached) + return mp; + ASSERT(mp->data.attached == ERTS_MSG_COMBINED_HFRAG); + nmp = erts_alloc_message_ref(); +#ifdef DEBUG + if (brefs && brefs_size) { + int i; + for (i = 0; i < brefs_size; i++) + ASSERT(is_non_value(brefs[i]) || is_immed(brefs[i])); + } +#endif + erts_free(ERTS_ALC_T_MSG, mp); + return nmp; + } + + ASSERT(mp->data.attached == ERTS_MSG_COMBINED_HFRAG); + ASSERT(mp->hfrag.used_size >= sz); + + if (sz >= (mp->hfrag.alloc_size - mp->hfrag.alloc_size / 16)) { + mp->hfrag.used_size = sz; + return mp; + } + + return erts_realloc_shrink_message(mp, sz, brefs, brefs_size); +} + +ERTS_GLB_FORCE_INLINE void erts_free_message(ErtsMessage *mp) +{ + if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG) + erts_free_message_ref(mp); + else + erts_free(ERTS_ALC_T_MSG, mp); +} + ERTS_GLB_INLINE Uint erts_used_frag_sz(const ErlHeapFragment* bp) { Uint sz = 0; @@ -319,11 +444,17 @@ ERTS_GLB_INLINE Uint erts_used_frag_sz(const ErlHeapFragment* bp) return sz; } -ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErlMessage *msg) +ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErtsMessage *msg) { ASSERT(msg->data.attached); - if (is_value(ERL_MESSAGE_TERM(msg))) - return erts_used_frag_sz(msg->data.heap_frag); + if (is_value(ERL_MESSAGE_TERM(msg))) { + ErlHeapFragment *bp; + if (msg->data.attached == ERTS_MSG_COMBINED_HFRAG) + bp = &msg->hfrag; + else + bp = msg->data.heap_frag; + return erts_used_frag_sz(bp); + } else if (msg->data.dist_ext->heap_size < 0) return erts_msg_attached_data_size_aux(msg); else { diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c index bd899fa2f9..910598690d 100644 --- a/erts/emulator/beam/erl_monitors.c +++ b/erts/emulator/beam/erl_monitors.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2013. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_monitors.h b/erts/emulator/beam/erl_monitors.h index 901ed8940b..9e2beedea3 100644 --- a/erts/emulator/beam/erl_monitors.h +++ b/erts/emulator/beam/erl_monitors.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2013. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_msacc.c b/erts/emulator/beam/erl_msacc.c new file mode 100644 index 0000000000..d0f305900a --- /dev/null +++ b/erts/emulator/beam/erl_msacc.c @@ -0,0 +1,486 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014-2015. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: Microstate accounting. + * + * We keep track of the different states that the + * Erlang VM threads are in, in order to provide + * performance/debugging statistics. There is a + * small overhead in enabling this, but in the big + * scheme of things it should be negligible. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#define ERTS_MSACC_STATE_STRINGS 1 + +#include "sys.h" +#include "global.h" +#include "erl_threads.h" +#include "erl_bif_unique.h" +#include "erl_map.h" +#include "erl_msacc.h" + +#if ERTS_ENABLE_MSACC + +static Eterm erts_msacc_gather_stats(ErtsMsAcc *msacc, Eterm **hpp, Uint *szp); +static void erts_msacc_reset(ErtsMsAcc *msacc); +static ErtsMsAcc* get_msacc(void); + +#ifdef USE_THREADS +erts_tsd_key_t ERTS_WRITE_UNLIKELY(erts_msacc_key); +#else +ErtsMsAcc *ERTS_WRITE_UNLIKELY(erts_msacc) = NULL; +#endif +int ERTS_WRITE_UNLIKELY(erts_msacc_enabled); + +static Eterm *erts_msacc_state_atoms = NULL; +static erts_rwmtx_t msacc_mutex; +static ErtsMsAcc *msacc_managed = NULL; +#ifdef USE_THREADS +static ErtsMsAcc *msacc_unmanaged = NULL; +static Uint msacc_unmanaged_count = 0; +#endif + +/* we have to split initiation as atoms are not inited in early init */ +void erts_msacc_early_init(void) { +#ifndef ERTS_MSACC_ALWAYS_ON + erts_msacc_enabled = 0; +#endif + erts_rwmtx_init(&msacc_mutex,"msacc_list_mutex"); +#ifdef USE_THREADS + erts_tsd_key_create(&erts_msacc_key,"erts_msacc_key"); +#else + erts_msacc = NULL; +#endif +} + +void erts_msacc_init(void) { + int i; + erts_msacc_state_atoms = erts_alloc(ERTS_ALC_T_MSACC, + sizeof(Eterm)*ERTS_MSACC_STATE_COUNT); + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) { + erts_msacc_state_atoms[i] = am_atom_put(erts_msacc_states[i], + strlen(erts_msacc_states[i])); + } +} + +void erts_msacc_init_thread(char *type, int id, int managed) { + ErtsMsAcc *msacc; + + msacc = erts_alloc(ERTS_ALC_T_MSACC, sizeof(ErtsMsAcc)); + + msacc->type = strdup(type); + msacc->id = make_small(id); + msacc->unmanaged = !managed; + msacc->tid = erts_thr_self(); + msacc->perf_counter = 0; + +#ifdef USE_THREADS + erts_rwmtx_rwlock(&msacc_mutex); + if (!managed) { + erts_mtx_init(&msacc->mtx,"msacc_unmanaged_mutex"); + msacc->next = msacc_unmanaged; + msacc_unmanaged = msacc; + msacc_unmanaged_count++; + ERTS_MSACC_TSD_SET(msacc); + } else { + msacc->next = msacc_managed; + msacc_managed = msacc; + } + erts_rwmtx_rwunlock(&msacc_mutex); +#else + msacc_managed = msacc; +#endif + + erts_msacc_reset(msacc); + +#ifdef ERTS_MSACC_ALWAYS_ON + ERTS_MSACC_TSD_SET(msacc); + msacc->perf_counter = erts_sys_perf_counter(); + msacc->state = ERTS_MSACC_STATE_OTHER; +#endif +} + +/* + * Creates a structure looking like this + * #{ type => scheduler, id => 1, counters => #{ State1 => Counter1 ... StateN => CounterN}} + */ +static +Eterm erts_msacc_gather_stats(ErtsMsAcc *msacc, Eterm **hpp, Uint *szp) { + int i; + Eterm *hp; + Eterm key, state_key, state_map; + Eterm res = THE_NON_VALUE; + flatmap_t *map; + + if (szp) { + *szp += MAP_HEADER_FLATMAP_SZ + 1 + 2*(3); + *szp += MAP_HEADER_FLATMAP_SZ + 1 + 2*(ERTS_MSACC_STATE_COUNT); + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) { + (void)erts_bld_sint64(NULL,szp,(Sint64)msacc->perf_counters[i]); +#ifdef ERTS_MSACC_STATE_COUNTERS + (void)erts_bld_uint64(NULL,szp,msacc->state_counters[i]); + *szp += 3; /* tuple to put state+perf counter in */ +#endif + } + } + + if (hpp) { + Eterm counters[ERTS_MSACC_STATE_COUNT]; + hp = *hpp; + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) { + Eterm counter = erts_bld_sint64(&hp,NULL,(Sint64)msacc->perf_counters[i]); +#ifdef ERTS_MSACC_STATE_COUNTERS + Eterm counter__ = erts_bld_uint64(&hp,NULL,msacc->state_counters[i]); + counters[i] = TUPLE2(hp,counter,counter__); + hp += 3; +#else + counters[i] = counter; +#endif + } + + key = TUPLE3(hp,am_counters,am_id,am_type); + hp += 4; + + state_key = make_tuple(hp); + hp[0] = make_arityval(ERTS_MSACC_STATE_COUNT); + + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) + hp[1+i] = erts_msacc_state_atoms[i]; + hp += 1 + ERTS_MSACC_STATE_COUNT; + + map = (flatmap_t*)hp; + hp += MAP_HEADER_FLATMAP_SZ; + map->thing_word = MAP_HEADER_FLATMAP; + map->size = ERTS_MSACC_STATE_COUNT; + map->keys = state_key; + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) + hp[i] = counters[i]; + hp += ERTS_MSACC_STATE_COUNT; + state_map = make_flatmap(map); + + map = (flatmap_t*)hp; + hp += MAP_HEADER_FLATMAP_SZ; + map->thing_word = MAP_HEADER_FLATMAP; + map->size = 3; + map->keys = key; + hp[0] = state_map; + hp[1] = msacc->id; + hp[2] = am_atom_put(msacc->type,strlen(msacc->type)); + hp += 3; + + *hpp = hp; + res = make_flatmap(map); + } + + return res; +} + +typedef struct { + int action; + Process *proc; + Eterm ref; + Eterm ref_heap[REF_THING_SIZE]; + Uint req_sched; + erts_smp_atomic32_t refc; +} ErtsMSAccReq; + +static ErtsMsAcc* get_msacc(void) { + ErtsMsAcc *msacc; + erts_rwmtx_rlock(&msacc_mutex); + msacc = msacc_managed; + while (!erts_equal_tids(msacc->tid,erts_thr_self())) { + msacc = msacc->next; + ASSERT(msacc != NULL); + } + erts_rwmtx_runlock(&msacc_mutex); + return msacc; +} + +static void send_reply(ErtsMsAcc *msacc, ErtsMSAccReq *msaccrp) { + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + Process *rp = msaccrp->proc; + ErtsMessage *msgp = NULL; + Eterm **hpp, *hp; + Eterm ref_copy = NIL, msg; + Uint sz, *szp; + ErlOffHeap *ohp = NULL; + ErtsProcLocks rp_locks = (esdp && msaccrp->req_sched == esdp->no + ? ERTS_PROC_LOCK_MAIN : 0); + + sz = 0; + hpp = NULL; + szp = &sz; + + if (msacc->unmanaged) erts_mtx_lock(&msacc->mtx); + + while (1) { + if (hpp) + ref_copy = STORE_NC(hpp, ohp, msaccrp->ref); + else + *szp += REF_THING_SIZE; + + if (msaccrp->action != ERTS_MSACC_GATHER) + msg = ref_copy; + else { + msg = erts_msacc_gather_stats(msacc, hpp, szp); + msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg); + } + if (hpp) + break; + + msgp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); + hpp = &hp; + szp = NULL; + } + + if (msacc->unmanaged) erts_mtx_unlock(&msacc->mtx); + + erts_queue_message(rp, &rp_locks, msgp, msg); + + if (esdp && msaccrp->req_sched == esdp->no) + rp_locks &= ~ERTS_PROC_LOCK_MAIN; + + if (rp_locks) + erts_smp_proc_unlock(rp, rp_locks); + +} + +static void +reply_msacc(void *vmsaccrp) +{ + ErtsMsAcc *msacc = ERTS_MSACC_TSD_GET(); + ErtsMSAccReq *msaccrp = (ErtsMSAccReq *) vmsaccrp; + + ASSERT(!msacc || !msacc->unmanaged); + + if (msaccrp->action == ERTS_MSACC_ENABLE && !msacc) { + msacc = get_msacc(); + + msacc->perf_counter = erts_sys_perf_counter(); + + msacc->state = ERTS_MSACC_STATE_OTHER; + + ERTS_MSACC_TSD_SET(msacc); + + } else if (msaccrp->action == ERTS_MSACC_DISABLE && msacc) { + ERTS_MSACC_TSD_SET(NULL); + } else if (msaccrp->action == ERTS_MSACC_RESET) { + msacc = msacc ? msacc : get_msacc(); + erts_msacc_reset(msacc); + } else if (msaccrp->action == ERTS_MSACC_GATHER && !msacc) { + msacc = get_msacc(); + } + + ASSERT(!msacc || !msacc->unmanaged); + + send_reply(msacc, msaccrp); + + erts_proc_dec_refc(msaccrp->proc); + + if (erts_smp_atomic32_dec_read_nob(&msaccrp->refc) == 0) + erts_free(ERTS_ALC_T_MSACC, vmsaccrp); +} + +static void erts_msacc_reset(ErtsMsAcc *msacc) { + int i; + if (msacc->unmanaged) erts_mtx_lock(&msacc->mtx); + + for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) { + msacc->perf_counters[i] = 0; +#ifdef ERTS_MSACC_STATE_COUNTERS + msacc->state_counters[i] = 0; +#endif + } + + if (msacc->unmanaged) erts_mtx_unlock(&msacc->mtx); +} + +#endif /* ERTS_ENABLE_MSACC */ + + +/* + * This function is responsible for enabling, disabling, resetting and + * gathering data related to microstate accounting. + * + * Managed threads and unmanaged threads are handled differently. + * - managed threads get a misc_aux job telling them to switch on msacc + * - unmanaged have some fields protected by a mutex that has to be taken + * before any values can be updated + * + * For performance reasons there is also a global value erts_msacc_enabled + * that controls the state of all threads. Statistics gathering is only on + * if erts_msacc_enabled && msacc is true. + */ +Eterm +erts_msacc_request(Process *c_p, int action, Eterm *threads) +{ +#ifdef ERTS_ENABLE_MSACC + ErtsMsAcc *msacc = ERTS_MSACC_TSD_GET(); + ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p); + Eterm ref; + ErtsMSAccReq *msaccrp; + Eterm *hp; + + +#ifdef ERTS_MSACC_ALWAYS_ON + if (action == ERTS_MSACC_ENABLE || action == ERTS_MSACC_DISABLE) + return THE_NON_VALUE; +#else + /* take care of double enable, and double disable here */ + if (msacc && action == ERTS_MSACC_ENABLE) { + return THE_NON_VALUE; + } else if (!msacc && action == ERTS_MSACC_DISABLE) { + return THE_NON_VALUE; + } +#endif + + ref = erts_make_ref(c_p); + + msaccrp = erts_alloc(ERTS_ALC_T_MSACC, sizeof(ErtsMSAccReq)); + hp = &msaccrp->ref_heap[0]; + + msaccrp->action = action; + msaccrp->proc = c_p; + msaccrp->ref = STORE_NC(&hp, NULL, ref); + msaccrp->req_sched = esdp->no; + +#ifdef ERTS_SMP + *threads = erts_no_schedulers; + *threads += 1; /* aux thread */ +#else + *threads = 1; +#endif + + erts_smp_atomic32_init_nob(&msaccrp->refc,(erts_aint32_t)*threads); + + erts_proc_add_refc(c_p, *threads); + + if (erts_no_schedulers > 1) + erts_schedule_multi_misc_aux_work(1, + erts_no_schedulers, + reply_msacc, + (void *) msaccrp); +#ifdef ERTS_SMP + /* aux thread */ + erts_schedule_misc_aux_work(0, reply_msacc, (void *) msaccrp); +#endif + +#ifdef USE_THREADS + /* Manage unmanaged threads */ + switch (action) { + case ERTS_MSACC_GATHER: { + Uint unmanaged_count; + ErtsMsAcc *msacc, **unmanaged; + int i = 0; + + /* we copy a list of pointers here so that we do not have to have + the msacc_mutex when sending messages */ + erts_rwmtx_rlock(&msacc_mutex); + unmanaged_count = msacc_unmanaged_count; + unmanaged = erts_alloc(ERTS_ALC_T_MSACC, + sizeof(ErtsMsAcc*)*unmanaged_count); + + for (i = 0, msacc = msacc_unmanaged; + i < unmanaged_count; + i++, msacc = msacc->next) { + unmanaged[i] = msacc; + } + erts_rwmtx_runlock(&msacc_mutex); + + for (i = 0; i < unmanaged_count; i++) { + erts_mtx_lock(&unmanaged[i]->mtx); + if (unmanaged[i]->perf_counter) { + ErtsSysPerfCounter perf_counter; + /* if enabled update stats */ + perf_counter = erts_sys_perf_counter(); + unmanaged[i]->perf_counters[unmanaged[i]->state] += + perf_counter - unmanaged[i]->perf_counter; + unmanaged[i]->perf_counter = perf_counter; + } + erts_mtx_unlock(&unmanaged[i]->mtx); + send_reply(unmanaged[i],msaccrp); + } + erts_free(ERTS_ALC_T_MSACC,unmanaged); + /* We have just sent unmanaged_count messages, so bump no of threads */ + *threads += unmanaged_count; + break; + } + case ERTS_MSACC_RESET: { + ErtsMsAcc *msacc; + erts_rwmtx_rlock(&msacc_mutex); + for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next) + erts_msacc_reset(msacc); + erts_rwmtx_runlock(&msacc_mutex); + break; + } + case ERTS_MSACC_ENABLE: { + erts_rwmtx_rlock(&msacc_mutex); + for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next) { + erts_mtx_lock(&msacc->mtx); + msacc->perf_counter = erts_sys_perf_counter(); + /* we assume the unmanaged thread is sleeping */ + msacc->state = ERTS_MSACC_STATE_SLEEP; + erts_mtx_unlock(&msacc->mtx); + } + erts_rwmtx_runlock(&msacc_mutex); + break; + } + case ERTS_MSACC_DISABLE: { + ErtsSysPerfCounter perf_counter; + erts_rwmtx_rlock(&msacc_mutex); + /* make sure to update stats with latest results */ + for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next) { + erts_mtx_lock(&msacc->mtx); + perf_counter = erts_sys_perf_counter(); + msacc->perf_counters[msacc->state] += perf_counter - msacc->perf_counter; + msacc->perf_counter = 0; + erts_mtx_unlock(&msacc->mtx); + } + erts_rwmtx_runlock(&msacc_mutex); + break; + } + default: { ASSERT(0); } + } + +#endif + + *threads = make_small(*threads); + + reply_msacc((void *) msaccrp); + +#ifndef ERTS_MSACC_ALWAYS_ON + /* enable/disable the global value */ + if (action == ERTS_MSACC_ENABLE) { + erts_msacc_enabled = 1; + } else if (action == ERTS_MSACC_DISABLE) { + erts_msacc_enabled = 0; + } +#endif + + return ref; +#else + return THE_NON_VALUE; +#endif +} diff --git a/erts/emulator/beam/erl_msacc.h b/erts/emulator/beam/erl_msacc.h new file mode 100644 index 0000000000..284388f7aa --- /dev/null +++ b/erts/emulator/beam/erl_msacc.h @@ -0,0 +1,409 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014-2015. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_MSACC_H__ +#define ERL_MSACC_H__ + +/* Can be enabled/disabled via configure */ +#if ERTS_ENABLE_MSACC == 2 +#define ERTS_MSACC_EXTENDED_STATES 1 +#endif + +/* Uncomment this to also count the number of + transitions to a state. This will add a count + to the counter map. */ +/* #define ERTS_MSACC_STATE_COUNTERS 1 */ + +/* Uncomment this to make msacc to always be on, + this reduces overhead a little bit when profiling */ +/* #define ERTS_MSACC_ALWAYS_ON 1 */ + +#define ERTS_MSACC_DISABLE 0 +#define ERTS_MSACC_ENABLE 1 +#define ERTS_MSACC_RESET 2 +#define ERTS_MSACC_GATHER 3 + +/* + * When adding a new state, you have to: + * * Add it here + * * Increment ERTS_MSACC_STATE_COUNT + * * Add string value to erts_msacc_states + * * Have to be in alphabetical order! + * * Only add states to the non-extended section after + * careful benchmarking to make sure the overhead + * when disabled is minimal. + */ + +#ifndef ERTS_MSACC_EXTENDED_STATES +#define ERTS_MSACC_STATE_AUX 0 +#define ERTS_MSACC_STATE_CHECK_IO 1 +#define ERTS_MSACC_STATE_EMULATOR 2 +#define ERTS_MSACC_STATE_GC 3 +#define ERTS_MSACC_STATE_OTHER 4 +#define ERTS_MSACC_STATE_PORT 5 +#define ERTS_MSACC_STATE_SLEEP 6 + +#define ERTS_MSACC_STATE_COUNT 7 + +#if ERTS_MSACC_STATE_STRINGS && ERTS_ENABLE_MSACC +static char *erts_msacc_states[] = { + "aux", + "check_io", + "emulator", + "gc", + "other", + "port", + "sleep" +}; +#endif + +#else + +#define ERTS_MSACC_STATE_ALLOC 0 +#define ERTS_MSACC_STATE_AUX 1 +#define ERTS_MSACC_STATE_BIF 2 +#define ERTS_MSACC_STATE_BUSY_WAIT 3 +#define ERTS_MSACC_STATE_CHECK_IO 4 +#define ERTS_MSACC_STATE_EMULATOR 5 +#define ERTS_MSACC_STATE_ETS 6 +#define ERTS_MSACC_STATE_GC 7 +#define ERTS_MSACC_STATE_GC_FULL 8 +#define ERTS_MSACC_STATE_NIF 9 +#define ERTS_MSACC_STATE_OTHER 10 +#define ERTS_MSACC_STATE_PORT 11 +#define ERTS_MSACC_STATE_SEND 12 +#define ERTS_MSACC_STATE_SLEEP 13 +#define ERTS_MSACC_STATE_TIMERS 14 + +#define ERTS_MSACC_STATE_COUNT 15 + +#if ERTS_MSACC_STATE_STRINGS +static char *erts_msacc_states[] = { + "alloc", + "aux", + "bif", + "busy_wait", + "check_io", + "emulator", + "ets", + "gc", + "gc_full", + "nif", + "other", + "port", + "send", + "sleep", + "timers" +}; +#endif + +#endif + +typedef struct erl_msacc_t_ ErtsMsAcc; + +struct erl_msacc_t_ { + + /* the the values below are protected by mtx iff unmanaged = 1 */ + ErtsSysPerfCounter perf_counter; + ErtsSysPerfCounter perf_counters[ERTS_MSACC_STATE_COUNT]; +#ifdef ERTS_MSACC_STATE_COUNTERS + Uint64 state_counters[ERTS_MSACC_STATE_COUNT]; +#endif + Uint state; + + /* protected by msacc_mutex in erl_msacc.c, and should be constant */ + int unmanaged; + erts_mtx_t mtx; + ErtsMsAcc *next; + erts_tid_t tid; + Eterm id; + char *type; +}; + +#if ERTS_ENABLE_MSACC + +#define ERTS_MSACC_INLINE ERTS_GLB_INLINE + +#ifdef USE_THREADS +extern erts_tsd_key_t erts_msacc_key; +#else +extern ErtsMsAcc *erts_msacc; +#endif + +#ifdef ERTS_MSACC_ALWAYS_ON +#define erts_msacc_enabled 1 +#else +extern int erts_msacc_enabled; +#endif + +#ifdef USE_THREADS +#define ERTS_MSACC_TSD_GET() erts_tsd_get(erts_msacc_key) +#define ERTS_MSACC_TSD_SET(tsd) erts_tsd_set(erts_msacc_key,tsd) +#else +#define ERTS_MSACC_TSD_GET() erts_msacc +#define ERTS_MSACC_TSD_SET(tsd) erts_msacc = tsd +#endif + +void erts_msacc_early_init(void); +void erts_msacc_init(void); +void erts_msacc_init_thread(char *type, int id, int liberty); + +/* The defines below are used to instrument the vm code + * with different state changes. There are two variants + * of each define. One that has a cached ErtsMsAcc * + * that it can use, and one that does not. + * The cached values are necessary to have in order to get + * low enough overhead when running without msacc enabled. + * + * The two most common patterns to use the function with are: + * + * ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_NEWSTATE); + * ... call other function in new state ... + * ERTS_MSACC_POP_STATE(); + * + * Note that the erts_msacc_push* function declare new variables, so + * to conform with C89 we have to call it in the beginning of a function. + * We might not want to change state it the beginning though, so we use this: + * + * ERTS_MSACC_PUSH_STATE(); + * ... some other code ... + * ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_NEWSTATE); + * ... call other function in new state ... + * ERTS_MSACC_POP_STATE(); + * + * Notice that we used the cached version of set_state as push_state already + * read the erts_msacc_enabled to the cache. + * + * Most macros also have other variants with the suffix _m which means that + * they are known to only be called in managed threads, or with the _x suffix + * which means that it should only be used in an emulator compiled with + * extended states. + * + * Here is a listing of the entire api: + * + * void ERTS_MSACC_DECLARE_CACHE() + * void ERTS_MSACC_UPDATE_CACHE() + * void ERTS_MSACC_IS_ENABLED() + * void ERTS_MSACC_IS_ENABLED_CACHED() + * + * void ERTS_MSACC_PUSH_STATE() + * void ERTS_MSACC_SET_STATE(int state) + * void ERTS_MSACC_PUSH_AND_SET_STATE(int state) + * + * void ERTS_MSACC_PUSH_STATE_CACHED() + * void ERTS_MSACC_SET_STATE_CACHED(int state) + * void ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(int state) + * void ERTS_MSACC_POP_STATE() + * + * void ERTS_MSACC_PUSH_STATE_M() + * void ERTS_MSACC_PUSH_STATE_CACHED_M() + * void ERTS_MSACC_SET_STATE_CACHED_M(int state) + * void ERTS_MSACC_SET_STATE_M(int state) + * void ERTS_MSACC_POP_STATE_M() + * void ERTS_MSACC_PUSH_AND_SET_STATE_M(int state) + * + * Most functions are also available with an _x suffix that are only enabled + * when using the extra states. If they are not, just add them to the end + * of this file. + */ + +/* cache handling functions */ +#define ERTS_MSACC_IS_ENABLED() ERTS_UNLIKELY(erts_msacc_enabled) +#define ERTS_MSACC_DECLARE_CACHE() \ + ErtsMsAcc *ERTS_MSACC_UPDATE_CACHE(); \ + ERTS_DECLARE_DUMMY(Uint __erts_msacc_state) = ERTS_MSACC_STATE_OTHER; +#define ERTS_MSACC_IS_ENABLED_CACHED() ERTS_UNLIKELY(__erts_msacc_cache != NULL) +#define ERTS_MSACC_UPDATE_CACHE() \ + __erts_msacc_cache = erts_msacc_enabled ? ERTS_MSACC_TSD_GET() : NULL + + +/* The defines below implicitly declare and load a new cache */ +#define ERTS_MSACC_PUSH_STATE() \ + ERTS_MSACC_DECLARE_CACHE(); \ + ERTS_MSACC_PUSH_STATE_CACHED() +#define ERTS_MSACC_SET_STATE(state) \ + ERTS_MSACC_DECLARE_CACHE(); \ + ERTS_MSACC_SET_STATE_CACHED(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE(state) \ + ERTS_MSACC_PUSH_STATE(); ERTS_MSACC_SET_STATE_CACHED(state) + +/* The defines below need an already declared cache to work */ +#define ERTS_MSACC_PUSH_STATE_CACHED() \ + __erts_msacc_state = ERTS_MSACC_IS_ENABLED_CACHED() ? \ + erts_msacc_get_state_um__(__erts_msacc_cache) : ERTS_MSACC_STATE_OTHER +#define ERTS_MSACC_SET_STATE_CACHED(state) \ + if (ERTS_MSACC_IS_ENABLED_CACHED()) \ + erts_msacc_set_state_um__(__erts_msacc_cache, state, 1) +#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(state) \ + ERTS_MSACC_PUSH_STATE_CACHED(); ERTS_MSACC_SET_STATE_CACHED(state) +#define ERTS_MSACC_POP_STATE() \ + if (ERTS_MSACC_IS_ENABLED_CACHED()) \ + erts_msacc_set_state_um__(__erts_msacc_cache, __erts_msacc_state, 0) + +/* Only use these defines when we know that we have in a managed thread */ +#define ERTS_MSACC_PUSH_STATE_M() \ + ERTS_MSACC_DECLARE_CACHE(); \ + ERTS_MSACC_PUSH_STATE_CACHED_M() +#define ERTS_MSACC_PUSH_STATE_CACHED_M() \ + __erts_msacc_state = ERTS_MSACC_IS_ENABLED_CACHED() ? \ + erts_msacc_get_state_m__(__erts_msacc_cache) : ERTS_MSACC_STATE_OTHER +#define ERTS_MSACC_SET_STATE_M(state) \ + ERTS_MSACC_DECLARE_CACHE(); \ + ERTS_MSACC_SET_STATE_CACHED_M(state) +#define ERTS_MSACC_SET_STATE_CACHED_M(state) \ + if (ERTS_MSACC_IS_ENABLED_CACHED()) \ + erts_msacc_set_state_m__(__erts_msacc_cache, state, 1) +#define ERTS_MSACC_POP_STATE_M() \ + if (ERTS_MSACC_IS_ENABLED_CACHED()) \ + erts_msacc_set_state_m__(__erts_msacc_cache, __erts_msacc_state, 0) +#define ERTS_MSACC_PUSH_AND_SET_STATE_M(state) \ + ERTS_MSACC_PUSH_STATE_M(); ERTS_MSACC_SET_STATE_CACHED_M(state) + +ERTS_MSACC_INLINE +void erts_msacc_set_state_um__(ErtsMsAcc *msacc,Uint state,int increment); +ERTS_MSACC_INLINE +void erts_msacc_set_state_m__(ErtsMsAcc *msacc,Uint state,int increment); + +ERTS_MSACC_INLINE +Uint erts_msacc_get_state_um__(ErtsMsAcc *msacc); +ERTS_MSACC_INLINE +Uint erts_msacc_get_state_m__(ErtsMsAcc *msacc); + + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_MSACC_INLINE +Uint erts_msacc_get_state_um__(ErtsMsAcc *msacc) { + Uint state; + if (msacc->unmanaged) + erts_mtx_lock(&msacc->mtx); + state = msacc->state; + if (msacc->unmanaged) + erts_mtx_unlock(&msacc->mtx); + return state; +} + +ERTS_MSACC_INLINE +Uint erts_msacc_get_state_m__(ErtsMsAcc *msacc) { + return msacc->state; +} + +ERTS_MSACC_INLINE +void erts_msacc_set_state_um__(ErtsMsAcc *msacc, Uint new_state, int increment) { + if (ERTS_UNLIKELY(msacc->unmanaged)) { + erts_mtx_lock(&msacc->mtx); + msacc->state = new_state; + if (ERTS_LIKELY(!msacc->perf_counter)) { + erts_mtx_unlock(&msacc->mtx); + return; + } + } + + erts_msacc_set_state_m__(msacc,new_state,increment); + + if (ERTS_UNLIKELY(msacc->unmanaged)) + erts_mtx_unlock(&msacc->mtx); +} + +ERTS_MSACC_INLINE +void erts_msacc_set_state_m__(ErtsMsAcc *msacc, Uint new_state, int increment) { + ErtsSysPerfCounter prev_perf_counter; + Sint64 diff; + + if (new_state == msacc->state) + return; + + prev_perf_counter = msacc->perf_counter; + msacc->perf_counter = erts_sys_perf_counter(); + diff = msacc->perf_counter - prev_perf_counter; + ASSERT(diff >= 0); + msacc->perf_counters[msacc->state] += diff; +#ifdef ERTS_MSACC_STATE_COUNTERS + msacc->state_counters[new_state] += increment; +#endif + msacc->state = new_state; +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#else + +#define ERTS_MSACC_IS_ENABLED() 0 +#define erts_msacc_early_init() +#define erts_msacc_init() +#define erts_msacc_init_thread(type, id, liberty) +#define ERTS_MSACC_PUSH_STATE() +#define ERTS_MSACC_PUSH_STATE_CACHED() +#define ERTS_MSACC_POP_STATE() +#define ERTS_MSACC_SET_STATE(state) +#define ERTS_MSACC_SET_STATE_CACHED(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(state) +#define ERTS_MSACC_UPDATE_CACHE() +#define ERTS_MSACC_IS_ENABLED_CACHED() +#define ERTS_MSACC_DECLARE_CACHE() +#define ERTS_MSACC_PUSH_STATE_M() +#define ERTS_MSACC_PUSH_STATE_CACHED_M() +#define ERTS_MSACC_SET_STATE_CACHED_M(state) +#define ERTS_MSACC_POP_STATE_M() +#define ERTS_MSACC_PUSH_AND_SET_STATE_M(state) + + +#endif /* ERTS_ENABLE_MSACC */ + +#ifndef ERTS_MSACC_EXTENDED_STATES + +#define ERTS_MSACC_PUSH_STATE_X() +#define ERTS_MSACC_POP_STATE_X() +#define ERTS_MSACC_SET_STATE_X(state) +#define ERTS_MSACC_SET_STATE_M_X(state) +#define ERTS_MSACC_SET_STATE_CACHED_X(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE_X(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(state) +#define ERTS_MSACC_UPDATE_CACHE_X() +#define ERTS_MSACC_IS_ENABLED_CACHED_X() 0 +#define ERTS_MSACC_DECLARE_CACHE_X() +#define ERTS_MSACC_PUSH_STATE_M_X() +#define ERTS_MSACC_PUSH_STATE_CACHED_M_X() +#define ERTS_MSACC_SET_STATE_CACHED_M_X(state) +#define ERTS_MSACC_POP_STATE_M_X() +#define ERTS_MSACC_PUSH_AND_SET_STATE_M_X(state) + +#else + +#define ERTS_MSACC_PUSH_STATE_X() ERTS_MSACC_PUSH_STATE() +#define ERTS_MSACC_POP_STATE_X() ERTS_MSACC_POP_STATE() +#define ERTS_MSACC_SET_STATE_X(state) ERTS_MSACC_SET_STATE(state) +#define ERTS_MSACC_SET_STATE_M_X(state) ERTS_MSACC_SET_STATE_M(state) +#define ERTS_MSACC_SET_STATE_CACHED_X(state) ERTS_MSACC_SET_STATE_CACHED(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE_X(state) ERTS_MSACC_PUSH_AND_SET_STATE(state) +#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(state) ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(state) +#define ERTS_MSACC_UPDATE_CACHE_X() ERTS_MSACC_UPDATE_CACHE() +#define ERTS_MSACC_IS_ENABLED_CACHED_X() ERTS_MSACC_IS_ENABLED_CACHED() +#define ERTS_MSACC_DECLARE_CACHE_X() ERTS_MSACC_DECLARE_CACHE() +#define ERTS_MSACC_PUSH_STATE_M_X() ERTS_MSACC_PUSH_STATE_M() +#define ERTS_MSACC_PUSH_STATE_CACHED_M_X() ERTS_MSACC_PUSH_STATE_CACHED_M() +#define ERTS_MSACC_SET_STATE_CACHED_M_X(state) ERTS_MSACC_SET_STATE_CACHED_M(state) +#define ERTS_MSACC_POP_STATE_M_X() ERTS_MSACC_POP_STATE_M() +#define ERTS_MSACC_PUSH_AND_SET_STATE_M_X(state) ERTS_MSACC_PUSH_AND_SET_STATE_M(state) + +#endif /* !ERTS_MSACC_EXTENDED_STATES */ + +#endif /* ERL_MSACC_H__ */ diff --git a/erts/emulator/beam/erl_mtrace.c b/erts/emulator/beam/erl_mtrace.c index fdaf02f37a..e275867928 100644 --- a/erts/emulator/beam/erl_mtrace.c +++ b/erts/emulator/beam/erl_mtrace.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2013. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_mtrace.h b/erts/emulator/beam/erl_mtrace.h index b34eab3c4a..776c70a819 100644 --- a/erts/emulator/beam/erl_mtrace.h +++ b/erts/emulator/beam/erl_mtrace.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 1097916c97..941f44b9ec 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2014. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -92,11 +92,12 @@ static ERTS_INLINE Eterm* alloc_heap(ErlNifEnv* env, unsigned need) } static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need, Eterm* hp) -{ +{ env->hp = hp; - if (env->heap_frag == NULL) { + if (env->heap_frag == NULL) { ASSERT(HEAP_LIMIT(env->proc) == env->hp_end); - HEAP_TOP(env->proc) = env->hp; + ASSERT(env->hp + need > env->hp_end); + HEAP_TOP(env->proc) = env->hp; } else { env->heap_frag->used_size = hp - env->heap_frag->mem; @@ -120,7 +121,8 @@ static ERTS_INLINE void ensure_heap(ErlNifEnv* env, unsigned may_need) } #endif -void erts_pre_nif(ErlNifEnv* env, Process* p, struct erl_module_nif* mod_nif) +void erts_pre_nif(ErlNifEnv* env, Process* p, struct erl_module_nif* mod_nif, + Process* tracee) { env->mod_nif = mod_nif; env->proc = p; @@ -130,17 +132,7 @@ void erts_pre_nif(ErlNifEnv* env, Process* p, struct erl_module_nif* mod_nif) 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) -{ - env->mod_nif = mod_nif; - env->proc = NULL; - env->hp = NULL; - env->hp_end = NULL; - env->heap_frag = NULL; - env->fpe_was_unmasked = erts_block_fpe(); - env->tmp_obj_list = NULL; + env->tracee = tracee; } /* Temporary object header, auto-deallocated when NIF returns @@ -180,13 +172,6 @@ void erts_post_nif(ErlNifEnv* env) free_tmp_objs(env); } -static void post_nif_noproc(ErlNifEnv* env) -{ - erts_unblock_fpe(env->fpe_was_unmasked); - free_tmp_objs(env); -} - - /* Flush out our cached heap pointers to allow an ordinary HAlloc */ static void flush_env(ErlNifEnv* env) @@ -209,6 +194,7 @@ static void flush_env(ErlNifEnv* env) */ static void cache_env(ErlNifEnv* env) { + env->heap_frag = MBUF(env->proc); if (env->heap_frag == NULL) { ASSERT(env->hp_end == HEAP_LIMIT(env->proc)); ASSERT(env->hp <= HEAP_TOP(env->proc)); @@ -216,10 +202,6 @@ static void cache_env(ErlNifEnv* env) env->hp = HEAP_TOP(env->proc); } else { - ASSERT(env->hp_end != HEAP_LIMIT(env->proc)); - ASSERT(env->hp_end - env->hp <= env->heap_frag->alloc_size); - env->heap_frag = MBUF(env->proc); - ASSERT(env->heap_frag != NULL); env->hp = env->heap_frag->mem + env->heap_frag->used_size; env->hp_end = env->heap_frag->mem + env->heap_frag->alloc_size; } @@ -250,18 +232,20 @@ struct enif_msg_environment_t Process phony_proc; }; -ErlNifEnv* enif_alloc_env(void) +static ERTS_INLINE void +setup_nif_env(struct enif_msg_environment_t* msg_env, + struct erl_module_nif* mod, + Process* tracee) { - struct enif_msg_environment_t* msg_env = - erts_alloc_fnf(ERTS_ALC_T_NIF, sizeof(struct enif_msg_environment_t)); Eterm* phony_heap = (Eterm*) msg_env; /* dummy non-NULL ptr */ - - msg_env->env.hp = phony_heap; + + msg_env->env.hp = phony_heap; msg_env->env.hp_end = phony_heap; msg_env->env.heap_frag = NULL; - msg_env->env.mod_nif = NULL; + msg_env->env.mod_nif = mod; msg_env->env.tmp_obj_list = NULL; msg_env->env.proc = &msg_env->phony_proc; + msg_env->env.exception_thrown = 0; memset(&msg_env->phony_proc, 0, sizeof(Process)); HEAP_START(&msg_env->phony_proc) = phony_heap; HEAP_TOP(&msg_env->phony_proc) = phony_heap; @@ -273,6 +257,14 @@ ErlNifEnv* enif_alloc_env(void) msg_env->phony_proc.space_verified = 0; msg_env->phony_proc.space_verified_from = NULL; #endif + msg_env->env.tracee = tracee; +} + +ErlNifEnv* enif_alloc_env(void) +{ + struct enif_msg_environment_t* msg_env = + erts_alloc_fnf(ERTS_ALC_T_NIF, sizeof(struct enif_msg_environment_t)); + setup_nif_env(msg_env, NULL, NULL); return &msg_env->env; } void enif_free_env(ErlNifEnv* env) @@ -281,6 +273,20 @@ void enif_free_env(ErlNifEnv* env) erts_free(ERTS_ALC_T_NIF, env); } +static ERTS_INLINE void pre_nif_noproc(struct enif_msg_environment_t* msg_env, + struct erl_module_nif* mod, + Process* tracee) +{ + setup_nif_env(msg_env, mod, tracee); + msg_env->env.fpe_was_unmasked = erts_block_fpe(); +} + +static ERTS_INLINE void post_nif_noproc(struct enif_msg_environment_t* msg_env) +{ + erts_unblock_fpe(msg_env->env.fpe_was_unmasked); + enif_clear_env(&msg_env->env); +} + static ERTS_INLINE void clear_offheap(ErlOffHeap* oh) { oh->first = NULL; @@ -307,22 +313,111 @@ void enif_clear_env(ErlNifEnv* env) ASSERT(!is_offheap(&MSO(p))); free_tmp_objs(env); } -int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, - ErlNifEnv* msg_env, ERL_NIF_TERM msg) + +#ifdef ERTS_SMP +#ifdef DEBUG +static int enif_send_delay = 0; +#define ERTS_FORCE_ENIF_SEND_DELAY() (enif_send_delay++ % 2 == 0) +#else +#ifdef ERTS_PROC_LOCK_OWN_IMPL +#define ERTS_FORCE_ENIF_SEND_DELAY() 0 +#else +/* + * We always schedule messages if we do not use our own + * process lock implementation, as if we try to do a trylock on + * a lock that might already be locked by the same thread. + * And what happens then with different mutex implementations + * is not always guaranteed. + */ +#define ERTS_FORCE_ENIF_SEND_DELAY() 1 +#endif +#endif + +int erts_flush_trace_messages(Process *c_p, ErtsProcLocks c_p_locks) +{ + ErlTraceMessageQueue *msgq, **last_msgq; + int reds = 0; + + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_TRACE); + + msgq = c_p->trace_msg_q; + + if (!msgq) + goto error; + + do { + Process* rp; + ErtsProcLocks rp_locks; + ErtsMessage *first, **last; + Uint len; + + first = msgq->first; + last = msgq->last; + len = msgq->len; + msgq->first = NULL; + msgq->last = &msgq->first; + msgq->len = 0; + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_TRACE); + + ASSERT(len != 0); + + rp = erts_proc_lookup(msgq->receiver); + if (rp) { + rp_locks = 0; + if (rp->common.id == c_p->common.id) + rp_locks = c_p_locks; + erts_queue_messages(rp, &rp_locks, first, last, len); + if (rp->common.id == c_p->common.id) + rp_locks &= ~c_p_locks; + if (rp_locks) + erts_smp_proc_unlock(rp, rp_locks); + reds += len; + } else { + erts_cleanup_messages(first); + } + reds += 1; + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_TRACE); + msgq = msgq->next; + } while (msgq); + + last_msgq = &c_p->trace_msg_q; + + while (*last_msgq) { + msgq = *last_msgq; + if (msgq->len == 0) { + *last_msgq = msgq->next; + erts_free(ERTS_ALC_T_TRACE_MSG_QUEUE, msgq); + } else { + last_msgq = &msgq->next; + } + } + +error: + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_TRACE); + + return reds; +} + +#endif + +int +enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, + ErlNifEnv* msg_env, ERL_NIF_TERM msg) { struct enif_msg_environment_t* menv = (struct enif_msg_environment_t*)msg_env; - ErtsProcLocks rp_locks = 0; + ErtsProcLocks rp_locks = 0, lc_locks = 0, c_p_locks = ERTS_PROC_LOCK_MAIN; Process* rp; Process* c_p; - ErlHeapFragment* frags; + ErtsMessage *mp; Eterm receiver = to_pid->pid; int flush_me = 0; - int scheduler = erts_get_scheduler_id() != 0; + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + int scheduler = esdp ? esdp->no : 0; if (env != NULL) { c_p = env->proc; if (receiver == c_p->common.id) { - rp_locks = ERTS_PROC_LOCK_MAIN; + rp_locks = c_p_locks; flush_me = 1; } } @@ -332,38 +427,124 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, #else erts_exit(ERTS_ABORT_EXIT,"enif_send: env==NULL on non-SMP VM"); #endif - } + } rp = (scheduler ? erts_proc_lookup(receiver) : erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN, receiver, rp_locks, ERTS_P2P_FLG_INC_REFC)); + if (rp == NULL) { ASSERT(env == NULL || receiver != c_p->common.id); return 0; } - flush_env(msg_env); - frags = menv->env.heap_frag; - ASSERT(frags == MBUF(&menv->phony_proc)); - if (frags != NULL) { - /* Move all offheap's from phony proc to the first fragment. - Quick and dirty, but erts_move_msg_mbuf_to_heap doesn't care. */ - ASSERT(!is_offheap(&frags->off_heap)); - frags->off_heap = MSO(&menv->phony_proc); - clear_offheap(&MSO(&menv->phony_proc)); - menv->env.heap_frag = NULL; - MBUF(&menv->phony_proc) = NULL; + if (menv) { + flush_env(msg_env); + mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = menv->env.heap_frag; + ASSERT(mp->data.heap_frag == MBUF(&menv->phony_proc)); + if (mp->data.heap_frag != NULL) { + /* Move all offheap's from phony proc to the first fragment. + Quick and dirty... */ + ASSERT(!is_offheap(&mp->data.heap_frag->off_heap)); + mp->data.heap_frag->off_heap = MSO(&menv->phony_proc); + clear_offheap(&MSO(&menv->phony_proc)); + menv->env.heap_frag = NULL; + MBUF(&menv->phony_proc) = NULL; + } + } else { + Uint sz = size_object(msg); + Eterm *hp; + mp = erts_alloc_message(sz, &hp); + msg = copy_struct(msg, sz, &hp, &mp->hfrag.off_heap); + ASSERT(hp == mp->hfrag.mem+mp->hfrag.used_size); } - ASSERT(!is_offheap(&MSO(&menv->phony_proc))); - if (flush_me) { - flush_env(env); /* Needed for ERTS_HOLE_CHECK */ + ERL_MESSAGE_TERM(mp) = msg; + + if (flush_me) { + flush_env(env); /* Needed for ERTS_HOLE_CHECK */ + } + + if (!env || !env->tracee) { + + if (c_p && IS_TRACED_FL(c_p, F_TRACE_SEND)) + trace_send(c_p, receiver, msg); + +#ifndef ERTS_SMP + } +#endif + + erts_queue_message(rp, &rp_locks, mp, msg); +#ifdef ERTS_SMP + } + else { + /* This clause is taken when the nif is called in the context + of a traced process. We do not know which locks we have + so we have to do a try lock and if that fails we enqueue + the message in a special trace message output queue of the + tracee */ + ErlTraceMessageQueue *msgq; + Process *t_p = env->tracee; + + + erts_smp_proc_lock(t_p, ERTS_PROC_LOCK_TRACE); + + msgq = t_p->trace_msg_q; + + while (msgq != NULL) { + if (msgq->receiver == receiver) { + break; + } + msgq = msgq->next; + } + +#ifdef ERTS_ENABLE_LOCK_CHECK + lc_locks = erts_proc_lc_my_proc_locks(rp); + rp_locks |= lc_locks; + if (receiver == c_p->common.id) + c_p_locks |= lc_locks; +#endif + if (ERTS_FORCE_ENIF_SEND_DELAY() || msgq || + rp_locks & ERTS_PROC_LOCK_MSGQ || + erts_smp_proc_trylock(rp, ERTS_PROC_LOCK_MSGQ) == EBUSY) { + + if (!msgq) { + + msgq = erts_alloc(ERTS_ALC_T_TRACE_MSG_QUEUE, + sizeof(ErlTraceMessageQueue)); + msgq->receiver = receiver; + msgq->first = mp; + msgq->last = &mp->next; + msgq->len = 1; + + /* Insert in linked list */ + msgq->next = t_p->trace_msg_q; + t_p->trace_msg_q = msgq; + + erts_smp_proc_unlock(t_p, ERTS_PROC_LOCK_TRACE); + + erts_schedule_flush_trace_messages(t_p->common.id); + + } else { + msgq->len++; + *msgq->last = mp; + msgq->last = &mp->next; + erts_smp_proc_unlock(t_p, ERTS_PROC_LOCK_TRACE); + } + } else { + erts_smp_proc_unlock(t_p, ERTS_PROC_LOCK_TRACE); + rp_locks &= ~ERTS_PROC_LOCK_TRACE; + rp_locks |= ERTS_PROC_LOCK_MSGQ; + erts_queue_message(rp, &rp_locks, mp, msg); + } } - erts_queue_message(rp, &rp_locks, frags, msg, am_undefined); +#endif + if (c_p == rp) rp_locks &= ~ERTS_PROC_LOCK_MAIN; - if (rp_locks) - erts_smp_proc_unlock(rp, rp_locks); + if (rp_locks & ~lc_locks) + erts_smp_proc_unlock(rp, rp_locks & ~lc_locks); if (!scheduler) erts_proc_dec_refc(rp); if (flush_me) { @@ -372,13 +553,49 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, return 1; } +int +enif_port_command(ErlNifEnv *env, const ErlNifPort* to_port, + ErlNifEnv *msg_env, ERL_NIF_TERM msg) +{ + + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + int scheduler = esdp ? esdp->no : 0; + Port *prt; + + if (scheduler == 0 || !env) + return 0; + + prt = erts_port_lookup(to_port->port_id, + (erts_port_synchronous_ops + ? ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP + : ERTS_PORT_SFLGS_INVALID_LOOKUP)); + + if (!prt) + return 0; + + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, env->proc->common.id, am_command, msg); + + return erts_port_output_async(prt, env->proc->common.id, msg); +} + ERL_NIF_TERM enif_make_copy(ErlNifEnv* dst_env, ERL_NIF_TERM src_term) { Uint sz; Eterm* hp; +#ifdef SHCOPY + erts_shcopy_t info; + INITIALIZE_SHCOPY(info); + sz = copy_shared_calculate(src_term, &info); + hp = alloc_heap(dst_env, sz); + src_term = copy_shared_perform(src_term, sz, &info, &hp, &MSO(dst_env->proc)); + DESTROY_SHCOPY(info); + return src_term; +#else sz = size_object(src_term); hp = alloc_heap(dst_env, sz); return copy_struct(src_term, sz, &hp, &MSO(dst_env->proc)); +#endif } @@ -391,12 +608,28 @@ static int is_offheap(const ErlOffHeap* oh) ErlNifPid* enif_self(ErlNifEnv* caller_env, ErlNifPid* pid) { + if (caller_env->proc->common.id == ERTS_INVALID_PID) + return NULL; pid->pid = caller_env->proc->common.id; return pid; } + int enif_get_local_pid(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifPid* pid) { - return is_internal_pid(term) ? (pid->pid=term, 1) : 0; + if (is_internal_pid(term)) { + pid->pid=term; + return 1; + } + return 0; +} + +int enif_get_local_port(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifPort* port) +{ + if (is_internal_port(term)) { + port->port_id=term; + return 1; + } + return 0; } int enif_is_atom(ErlNifEnv* env, ERL_NIF_TERM term) @@ -609,6 +842,68 @@ unsigned char* enif_make_new_binary(ErlNifEnv* env, size_t size, return binary_bytes(*termp); } +int enif_term_to_binary(ErlNifEnv *dst_env, ERL_NIF_TERM term, + ErlNifBinary *bin) +{ + Sint size; + byte *bp; + Binary* refbin; + + size = erts_encode_ext_size(term); + if (!enif_alloc_binary(size, bin)) + return 0; + + refbin = bin->ref_bin; + + bp = bin->data; + + erts_encode_ext(term, &bp); + + bin->size = bp - bin->data; + refbin->orig_size = bin->size; + + ASSERT(bin->data + bin->size == bp); + + return 1; +} + +size_t enif_binary_to_term(ErlNifEnv *dst_env, + const unsigned char* data, + size_t data_sz, + ERL_NIF_TERM *term, + ErlNifBinaryToTerm opts) +{ + Sint size; + ErtsHeapFactory factory; + byte *bp = (byte*) data; + + ERTS_CT_ASSERT(ERL_NIF_BIN2TERM_SAFE == ERTS_DIST_EXT_BTT_SAFE); + + if (opts & ~ERL_NIF_BIN2TERM_SAFE) { + return 0; + } + if ((size = erts_decode_ext_size(bp, data_sz)) < 0) + return 0; + + if (size > 0) { + flush_env(dst_env); + erts_factory_proc_prealloc_init(&factory, dst_env->proc, size); + } else { + erts_factory_dummy_init(&factory); + } + + *term = erts_decode_ext(&factory, &bp, (Uint32)opts); + + if (is_non_value(*term)) { + return 0; + } + erts_factory_close(&factory); + cache_env(dst_env); + + ASSERT(bp > data); + return bp - data; +} + int enif_is_identical(Eterm lhs, Eterm rhs) { return EQ(lhs,rhs); @@ -898,8 +1193,13 @@ int enif_get_list_cell(ErlNifEnv* env, Eterm term, Eterm* head, Eterm* tail) int enif_get_list_length(ErlNifEnv* env, Eterm term, unsigned* len) { - if (is_not_list(term) && is_not_nil(term)) return 0; - *len = erts_list_length(term); + Sint i; + Uint u; + + if ((i = erts_list_length(term)) < 0) return 0; + u = (Uint)i; + if ((unsigned)u != u) return 0; + *len = u; return 1; } @@ -1140,6 +1440,103 @@ int enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM *list return 1; } +int enif_is_process_alive(ErlNifEnv* env, ErlNifPid *proc) +{ + ErtsProcLocks rp_locks = 0; /* We don't need any locks, + just to check if it is alive */ + Eterm target = proc->pid; + Process* rp; + Process* c_p; + int scheduler = erts_get_scheduler_id() != 0; + + if (env != NULL) { + c_p = env->proc; + if (target == c_p->common.id) { + /* We are alive! */ + return 1; + } + } + else { +#ifdef ERTS_SMP + c_p = NULL; +#else + erts_exit(ERTS_ABORT_EXIT,"enif_is_process_alive: " + "env==NULL on non-SMP VM"); +#endif + } + + rp = (scheduler + ? erts_proc_lookup(target) + : erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN, + target, rp_locks, ERTS_P2P_FLG_INC_REFC)); + if (rp == NULL) { + ASSERT(env == NULL || target != c_p->common.id); + return 0; + } else { + if (!scheduler) + erts_proc_dec_refc(rp); + return 1; + } +} + +int enif_is_port_alive(ErlNifEnv *env, ErlNifPort *port) +{ + /* only allowed if called from scheduler */ + if (erts_get_scheduler_id() == 0) + erts_exit(ERTS_ABORT_EXIT,"enif_is_port_alive: called from non-scheduler"); + + return erts_port_lookup( + port->port_id, + (erts_port_synchronous_ops + ? ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP + : ERTS_PORT_SFLGS_INVALID_LOOKUP)) != NULL; +} + +ERL_NIF_TERM +enif_now_time(ErlNifEnv *env) +{ + Uint mega, sec, micro; + Eterm *hp; + get_now(&mega, &sec, µ); + hp = alloc_heap(env, 4); + return TUPLE3(hp, make_small(mega), make_small(sec), make_small(micro)); +} + +ERL_NIF_TERM +enif_cpu_time(ErlNifEnv *env) +{ +#ifdef HAVE_ERTS_NOW_CPU + Uint mega, sec, micro; + Eterm *hp; + erts_get_now_cpu(&mega, &sec, µ); + hp = alloc_heap(env, 4); + return TUPLE3(hp, make_small(mega), make_small(sec), make_small(micro)); +#else + return enif_make_badarg(env); +#endif +} + +ERL_NIF_TERM +enif_make_unique_integer(ErlNifEnv *env, ErlNifUniqueInteger properties) +{ + int monotonic = properties & ERL_NIF_UNIQUE_MONOTONIC; + int positive = properties & ERL_NIF_UNIQUE_POSITIVE; + Eterm *hp; + Uint hsz; + + if (monotonic) { + Sint64 raw_unique = erts_raw_get_unique_monotonic_integer(); + hsz = erts_raw_unique_monotonic_integer_heap_size(raw_unique, positive); + hp = alloc_heap(env, hsz); + return erts_raw_make_unique_monotonic_integer_value(&hp, raw_unique, positive); + } else { + Uint64 raw_unique[ERTS_UNIQUE_INT_RAW_VALUES]; + erts_raw_get_unique_integer(raw_unique); + hsz = erts_raw_unique_integer_heap_size(raw_unique, positive); + hp = alloc_heap(env, hsz); + return erts_raw_make_unique_integer(&hp, raw_unique, positive); + } +} ErlNifMutex* enif_mutex_create(char *name) { return erl_drv_mutex_create(name); } void enif_mutex_destroy(ErlNifMutex *mtx) { erl_drv_mutex_destroy(mtx); } @@ -1266,10 +1663,10 @@ static void close_lib(struct erl_module_nif* lib) ASSERT(erts_refc_read(&lib->rt_dtor_cnt,0) == 0); if (lib->entry != NULL && lib->entry->unload != NULL) { - ErlNifEnv env; - pre_nif_noproc(&env, lib); - lib->entry->unload(&env, lib->priv_data); - post_nif_noproc(&env); + struct enif_msg_environment_t msg_env; + pre_nif_noproc(&msg_env, lib, NULL); + lib->entry->unload(&msg_env.env, lib->priv_data); + post_nif_noproc(&msg_env); } if (!erts_is_static_nif(lib->handle)) erts_sys_ddll_close(lib->handle); @@ -1415,10 +1812,10 @@ static void nif_resource_dtor(Binary* bin) ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == &nif_resource_dtor); if (type->dtor != NULL) { - ErlNifEnv env; - pre_nif_noproc(&env, type->owner); - type->dtor(&env,resource->data); - post_nif_noproc(&env); + struct enif_msg_environment_t msg_env; + pre_nif_noproc(&msg_env, type->owner, NULL); + type->dtor(&msg_env.env, resource->data); + post_nif_noproc(&msg_env); } if (erts_refc_dectest(&type->refc, 0) == 0) { ASSERT(type->next == NULL); @@ -1635,7 +2032,7 @@ allocate_nif_sched_data(Process* proc, int argc) ep->exp.addressv[i] = &ep->exp.code[3]; } ep->exp.code[3] = (BeamInstr) em_call_nif; - (void) ERTS_PROC_SET_NIF_TRAP_EXPORT(proc, ERTS_PROC_LOCK_MAIN, ep); + (void) ERTS_PROC_SET_NIF_TRAP_EXPORT(proc, ep); return ep; } @@ -1792,12 +2189,10 @@ execute_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); ASSERT(ep); ep->fp = NULL; + erts_smp_atomic32_read_band_mb(&proc->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_IO_PROC)); result = (*fp)(env, argc, argv); - erts_smp_atomic32_read_band_mb(&proc->state, - ~(ERTS_PSFLG_DIRTY_CPU_PROC - |ERTS_PSFLG_DIRTY_IO_PROC - |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q - |ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)); + if (erts_refc_dectest(&env->mod_nif->rt_dtor_cnt, 0) == 0 && env->mod_nif->mod == NULL) close_lib(env->mod_nif); /* @@ -1845,13 +2240,6 @@ schedule_dirty_nif(ErlNifEnv* env, int flags, int argc, const ERL_NIF_TERM argv[ a = erts_smp_atomic32_read_acqb(&proc->state); while (1) { n = state = a; - /* - * clear any current dirty flags and dirty queue indicators, - * in case the application is shifting a job from one type - * of dirty scheduler to the other - */ - n &= ~(ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC - |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q); if (flags == ERL_NIF_DIRTY_JOB_CPU_BOUND) n |= ERTS_PSFLG_DIRTY_CPU_PROC; else @@ -2055,14 +2443,13 @@ int enif_make_map_remove(ErlNifEnv* env, Eterm key, Eterm *map_out) { - int res; if (!is_map(map_in)) { return 0; } flush_env(env); - res = erts_maps_remove(env->proc, key, map_in, map_out); + (void) erts_maps_take(env->proc, key, map_in, map_out, NULL); cache_env(env); - return res; + return 1; } int enif_map_iterator_create(ErlNifEnv *env, @@ -2251,17 +2638,17 @@ int enif_map_iterator_get_pair(ErlNifEnv *env, ***************************************************************************/ -static BeamInstr** get_func_pp(BeamInstr* mod_code, Eterm f_atom, unsigned arity) +static BeamInstr** get_func_pp(BeamCodeHeader* mod_code, Eterm f_atom, unsigned arity) { - int n = (int) mod_code[MI_NUM_FUNCTIONS]; + int n = (int) mod_code->num_functions; int j; for (j = 0; j < n; ++j) { - BeamInstr* code_ptr = (BeamInstr*) mod_code[MI_FUNCTIONS+j]; + BeamInstr* code_ptr = (BeamInstr*) mod_code->functions[j]; ASSERT(code_ptr[0] == (BeamInstr) BeamOp(op_i_func_info_IaaI)); if (f_atom == ((Eterm) code_ptr[3]) && arity == ((unsigned) code_ptr[4])) { - return (BeamInstr**) &mod_code[MI_FUNCTIONS+j]; + return (BeamInstr**) &mod_code->functions[j]; } } return NULL; @@ -2444,8 +2831,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) if (init_func != NULL) handle = init_func; - if (!in_area(caller, mod->curr.code, mod->curr.code_length)) { - ASSERT(in_area(caller, mod->old.code, mod->old.code_length)); + if (!in_area(caller, mod->curr.code_hdr, mod->curr.code_length)) { + ASSERT(in_area(caller, mod->old.code_hdr, mod->old.code_length)); ret = load_nif_error(BIF_P, "old_code", "Calling load_nif from old " "module '%T' not allowed", mod_atom); @@ -2499,7 +2886,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) for (i=0; i < entry->num_of_funcs && ret==am_ok; i++) { BeamInstr** code_pp; if (!erts_atom_get(f->name, sys_strlen(f->name), &f_atom, ERTS_ATOM_ENC_LATIN1) - || (code_pp = get_func_pp(mod->curr.code, f_atom, f->arity))==NULL) { + || (code_pp = get_func_pp(mod->curr.code_hdr, f_atom, f->arity))==NULL) { ret = load_nif_error(BIF_P,bad_lib,"Function not found %T:%s/%u", mod_atom, f->name, f->arity); } @@ -2587,7 +2974,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) } old_func = next_func(mod->curr.nif->entry, &old_incr, old_func); } - erts_pre_nif(&env, BIF_P, lib); + erts_pre_nif(&env, BIF_P, lib, NULL); veto = entry->reload(&env, &lib->priv_data, BIF_ARG_2); erts_post_nif(&env); if (veto) { @@ -2608,7 +2995,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) ret = load_nif_error(BIF_P, upgrade, "Upgrade not supported by this NIF library."); goto error; } - erts_pre_nif(&env, BIF_P, lib); + erts_pre_nif(&env, BIF_P, lib, NULL); veto = entry->upgrade(&env, &lib->priv_data, &mod->old.nif->priv_data, BIF_ARG_2); erts_post_nif(&env); if (veto) { @@ -2619,7 +3006,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) commit_opened_resource_types(lib); } else if (entry->load != NULL) { /********* Initial load ***********/ - erts_pre_nif(&env, BIF_P, lib); + erts_pre_nif(&env, BIF_P, lib, NULL); veto = entry->load(&env, &lib->priv_data, BIF_ARG_2); erts_post_nif(&env); if (veto) { @@ -2642,7 +3029,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) { BeamInstr* code_ptr; erts_atom_get(f->name, sys_strlen(f->name), &f_atom, ERTS_ATOM_ENC_LATIN1); - code_ptr = *get_func_pp(mod->curr.code, f_atom, f->arity); + code_ptr = *get_func_pp(mod->curr.code_hdr, f_atom, f->arity); if (code_ptr[1] == 0) { code_ptr[5+0] = (BeamInstr) BeamOp(op_call_nif); @@ -2706,6 +3093,9 @@ erts_unload_nif(struct erl_module_nif* lib) ASSERT(erts_smp_thr_progress_is_blocking()); ASSERT(lib != NULL); ASSERT(lib->mod != NULL); + + erts_tracer_nif_clear(); + for (rt = resource_type_list.next; rt != &resource_type_list; rt = next) { @@ -2748,6 +3138,76 @@ void erl_nif_init() resource_type_list.owner = NULL; resource_type_list.module = THE_NON_VALUE; resource_type_list.name = THE_NON_VALUE; + +} + +int erts_nif_get_funcs(struct erl_module_nif* mod, + ErlNifFunc **funcs) +{ + *funcs = mod->entry->funcs; + return mod->entry->num_of_funcs; +} + +Eterm erts_nif_call_function(Process *p, Process *tracee, + struct erl_module_nif* mod, + ErlNifFunc *fun, int argc, Eterm *argv) +{ + Eterm nif_result; +#ifdef DEBUG + /* Verify that function is part of this module */ + int i; + for (i = 0; i < mod->entry->num_of_funcs; i++) + if (fun == &(mod->entry->funcs[i])) + break; + ASSERT(i < mod->entry->num_of_funcs); + if (p) + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(p) & ERTS_PROC_LOCK_MAIN + || erts_smp_thr_progress_is_blocking()); +#endif + if (p) { + /* This is almost a normal nif call like in beam_emu, + except that any heap fragment created in the nif will be + discarded without checking if anything in it is live. + This is because we cannot do a GC here as we don't know + the number of live registers that have to be preserved. + This means that any heap part of the returned term may + not be used outside this function. */ + struct enif_environment_t env; + ErlHeapFragment *orig_hf = MBUF(p); + ErlOffHeap orig_oh = MSO(p); + ASSERT(is_internal_pid(p->common.id)); + MBUF(p) = NULL; + clear_offheap(&MSO(p)); + + erts_pre_nif(&env, p, mod, tracee); + nif_result = (*fun->fptr)(&env, argc, argv); + if (env.exception_thrown) + nif_result = THE_NON_VALUE; + erts_post_nif(&env); + + /* Free any offheap and heap fragments created in nif */ + if (MSO(p).first) { + erts_cleanup_offheap(&MSO(p)); + clear_offheap(&MSO(p)); + } + if (MBUF(p)) + free_message_buffer(MBUF(p)); + + /* restore original heap fragment list */ + MBUF(p) = orig_hf; + MSO(p) = orig_oh; + } else { + /* Nif call was done without a process context, + so we create a phony one. */ + struct enif_msg_environment_t msg_env; + pre_nif_noproc(&msg_env, mod, tracee); + nif_result = (*fun->fptr)(&msg_env.env, argc, argv); + if (msg_env.env.exception_thrown) + nif_result = THE_NON_VALUE; + post_nif_noproc(&msg_env); + } + + return nif_result; } #ifdef USE_VM_PROBES diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 75070ad901..3964f7f679 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2014. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -77,13 +77,8 @@ typedef ErlNapiSInt64 ErlNifSInt64; typedef ErlNapiUInt ErlNifUInt; typedef ErlNapiSInt ErlNifSInt; -#ifdef HALFWORD_HEAP_EMULATOR -# define ERL_NIF_VM_VARIANT "beam.halfword" -typedef unsigned int ERL_NIF_TERM; -#else # define ERL_NIF_VM_VARIANT "beam.vanilla" typedef ErlNifUInt ERL_NIF_TERM; -#endif typedef ERL_NIF_TERM ERL_NIF_UINT; @@ -92,16 +87,16 @@ typedef ErlNifSInt64 ErlNifTime; #define ERL_NIF_TIME_ERROR ((ErlNifSInt64) ERTS_NAPI_TIME_ERROR__) typedef enum { - ERL_NIF_SEC = ERTS_NAPI_SEC__, - ERL_NIF_MSEC = ERTS_NAPI_MSEC__, - ERL_NIF_USEC = ERTS_NAPI_USEC__, - ERL_NIF_NSEC = ERTS_NAPI_NSEC__ + ERL_NIF_SEC = ERTS_NAPI_SEC__, + ERL_NIF_MSEC = ERTS_NAPI_MSEC__, + ERL_NIF_USEC = ERTS_NAPI_USEC__, + ERL_NIF_NSEC = ERTS_NAPI_NSEC__ } ErlNifTimeUnit; struct enif_environment_t; typedef struct enif_environment_t ErlNifEnv; -typedef struct +typedef struct enif_func_t { const char* name; unsigned arity; @@ -155,7 +150,12 @@ typedef enum typedef struct { ERL_NIF_TERM pid; /* internal, may change */ -}ErlNifPid; +} ErlNifPid; + +typedef struct +{ + ERL_NIF_TERM port_id; /* internal, may change */ +}ErlNifPort; typedef ErlDrvSysInfo ErlNifSysInfo; @@ -202,6 +202,15 @@ typedef enum { ERL_NIF_MAP_ITERATOR_TAIL = ERL_NIF_MAP_ITERATOR_LAST } ErlNifMapIteratorEntry; +typedef enum { + ERL_NIF_UNIQUE_POSITIVE = (1 << 0), + ERL_NIF_UNIQUE_MONOTONIC = (1 << 1) +} ErlNifUniqueInteger; + +typedef enum { + ERL_NIF_BIN2TERM_SAFE = 0x20000000 +} ErlNifBinaryToTerm; + #if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) # define ERL_NIF_API_FUNC_DECL(RET_TYPE, NAME, ARGS) RET_TYPE (*NAME) ARGS typedef struct { @@ -226,22 +235,28 @@ extern TWinDynNifCallbacks WinDynNifCallbacks; #if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) # define ERL_NIF_INIT_GLOB TWinDynNifCallbacks WinDynNifCallbacks; -# ifdef STATIC_ERLANG_NIF -# define ERL_NIF_INIT_DECL(MODNAME) __declspec(dllexport) ErlNifEntry* MODNAME ## _nif_init(TWinDynNifCallbacks* callbacks) -# else -# define ERL_NIF_INIT_DECL(MODNAME) __declspec(dllexport) ErlNifEntry* nif_init(TWinDynNifCallbacks* callbacks) -# endif +# define ERL_NIF_INIT_ARGS TWinDynNifCallbacks* callbacks # define ERL_NIF_INIT_BODY memcpy(&WinDynNifCallbacks,callbacks,sizeof(TWinDynNifCallbacks)) +# define ERL_NIF_INIT_EXPORT __declspec(dllexport) #else # define ERL_NIF_INIT_GLOB +# define ERL_NIF_INIT_ARGS void # define ERL_NIF_INIT_BODY -# ifdef STATIC_ERLANG_NIF -# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* MODNAME ## _nif_init(void) +# if defined(__GNUC__) && __GNUC__ >= 4 +# define ERL_NIF_INIT_EXPORT __attribute__ ((visibility("default"))) +# elif defined (__SUNPRO_C) && (__SUNPRO_C >= 0x550) +# define ERL_NIF_INIT_EXPORT __global # else -# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* nif_init(void) +# define ERL_NIF_INIT_EXPORT # endif #endif +#ifdef STATIC_ERLANG_NIF +# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* MODNAME ## _nif_init(ERL_NIF_INIT_ARGS) +#else +# define ERL_NIF_INIT_DECL(MODNAME) ERL_NIF_INIT_EXPORT ErlNifEntry* nif_init(ERL_NIF_INIT_ARGS) +#endif + #ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT # define ERL_NIF_ENTRY_OPTIONS ERL_NIF_DIRTY_NIF_OPTION #else diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index 1448a508a2..a5acd86551 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2014. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -163,6 +163,15 @@ ERL_NIF_API_FUNC_DECL(int,enif_getenv,(const char* key, char* value, size_t* val ERL_NIF_API_FUNC_DECL(ErlNifTime, enif_monotonic_time, (ErlNifTimeUnit)); ERL_NIF_API_FUNC_DECL(ErlNifTime, enif_time_offset, (ErlNifTimeUnit)); ERL_NIF_API_FUNC_DECL(ErlNifTime, enif_convert_time_unit, (ErlNifTime, ErlNifTimeUnit, ErlNifTimeUnit)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_now_time, (ErlNifEnv *env)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_cpu_time, (ErlNifEnv *env)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_make_unique_integer, (ErlNifEnv *env, ErlNifUniqueInteger properties)); +ERL_NIF_API_FUNC_DECL(int, enif_is_process_alive, (ErlNifEnv *env, ErlNifPid *pid)); +ERL_NIF_API_FUNC_DECL(int, enif_is_port_alive, (ErlNifEnv *env, ErlNifPort *port_id)); +ERL_NIF_API_FUNC_DECL(int, enif_get_local_port, (ErlNifEnv* env, ERL_NIF_TERM, ErlNifPort* port_id)); +ERL_NIF_API_FUNC_DECL(int, enif_term_to_binary, (ErlNifEnv *env, ERL_NIF_TERM term, ErlNifBinary *bin)); +ERL_NIF_API_FUNC_DECL(size_t, enif_binary_to_term, (ErlNifEnv *env, const unsigned char* data, size_t sz, ERL_NIF_TERM *term, unsigned int opts)); +ERL_NIF_API_FUNC_DECL(int, enif_port_command, (ErlNifEnv *env, const ErlNifPort* to_port, ErlNifEnv *msg_env, ERL_NIF_TERM msg)); /* ** ADD NEW ENTRIES HERE (before this comment) !!! @@ -318,6 +327,15 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_on_dirty_scheduler,(ErlNifEnv*)); # define enif_monotonic_time ERL_NIF_API_FUNC_MACRO(enif_monotonic_time) # define enif_time_offset ERL_NIF_API_FUNC_MACRO(enif_time_offset) # define enif_convert_time_unit ERL_NIF_API_FUNC_MACRO(enif_convert_time_unit) +# define enif_now_time ERL_NIF_API_FUNC_MACRO(enif_now_time) +# define enif_cpu_time ERL_NIF_API_FUNC_MACRO(enif_cpu_time) +# define enif_make_unique_integer ERL_NIF_API_FUNC_MACRO(enif_make_unique_integer) +# define enif_is_process_alive ERL_NIF_API_FUNC_MACRO(enif_is_process_alive) +# define enif_is_port_alive ERL_NIF_API_FUNC_MACRO(enif_is_port_alive) +# define enif_get_local_port ERL_NIF_API_FUNC_MACRO(enif_get_local_port) +# define enif_term_to_binary ERL_NIF_API_FUNC_MACRO(enif_term_to_binary) +# define enif_binary_to_term ERL_NIF_API_FUNC_MACRO(enif_binary_to_term) +# define enif_port_command ERL_NIF_API_FUNC_MACRO(enif_port_command) /* ** ADD NEW ENTRIES HERE (before this comment) diff --git a/erts/emulator/beam/erl_node_container_utils.h b/erts/emulator/beam/erl_node_container_utils.h index 211b1a0090..0c76c6fe7d 100644 --- a/erts/emulator/beam/erl_node_container_utils.h +++ b/erts/emulator/beam/erl_node_container_utils.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -255,7 +255,7 @@ extern ErtsPTab erts_port; * Refs * \* */ -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) #define internal_ref_no_of_numbers(x) \ (internal_ref_data((x))[0]) @@ -328,8 +328,6 @@ extern ErtsPTab erts_port; : external_ref_channel_no((x))) #define is_ref(x) (is_internal_ref((x)) \ || is_external_ref((x))) -#define is_ref_rel(x,Base) (is_internal_ref_rel((x),Base) \ - || is_external_ref_rel((x),Base)) #define is_not_ref(x) (!is_ref(x)) #endif diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index e69bd49c42..646f786651 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -497,31 +497,7 @@ node_table_hash(void *venp) Uint32 cre = ((ErlNode *) venp)->creation; HashValue h = atom_tab(atom_val(((ErlNode *) venp)->sysname))->slot.bucket.hvalue; - h *= PRIME0; - h += cre & 0xff; - -#if MAX_CREATION >= (1 << 8) - h *= PRIME1; - h += (cre >> 8) & 0xff; -#endif - -#if MAX_CREATION >= (1 << 16) - h *= PRIME2; - h += (cre >> 16) & 0xff; -#endif - -#if MAX_CREATION >= (1 << 24) - h *= PRIME3; - h += (cre >> 24) & 0xff; -#endif - -#if 0 -/* XXX Problems in older versions of GCC */ - #if MAX_CREATION >= (1UL << 32) - #error "MAX_CREATION larger than size of expected creation storage (Uint32)" - #endif -#endif - return h; + return (h + cre) * PRIME0; } static int @@ -599,7 +575,7 @@ erts_node_table_info(int to, void *to_arg) } -ErlNode *erts_find_or_insert_node(Eterm sysname, Uint creation) +ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation) { ErlNode *res; ErlNode ne; @@ -787,10 +763,13 @@ void erts_init_node_tables(int dd_sec) erts_smp_rwmtx_init_opt(&erts_node_table_rwmtx, &rwmtx_opt, "node_table"); erts_smp_rwmtx_init_opt(&erts_dist_table_rwmtx, &rwmtx_opt, "dist_table"); - f.hash = (H_FUN) dist_table_hash; - f.cmp = (HCMP_FUN) dist_table_cmp; - f.alloc = (HALLOC_FUN) dist_table_alloc; - f.free = (HFREE_FUN) dist_table_free; + f.hash = (H_FUN) dist_table_hash; + f.cmp = (HCMP_FUN) dist_table_cmp; + f.alloc = (HALLOC_FUN) dist_table_alloc; + f.free = (HFREE_FUN) dist_table_free; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; hash_init(ERTS_ALC_T_DIST_TABLE, &erts_dist_table, "dist_table", 11, f); f.hash = (H_FUN) node_table_hash; @@ -1157,23 +1136,11 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id) break; } if (insert_bin) { -#if HALFWORD_HEAP - UWord val = (UWord) u.pb->val; - DeclareTmpHeapNoproc(id_heap,BIG_UINT_HEAP_SIZE*2); /* extra place allocated */ -#else DeclareTmpHeapNoproc(id_heap,BIG_UINT_HEAP_SIZE); -#endif Uint *hp = &id_heap[0]; InsertedBin *nib; -#if HALFWORD_HEAP - int actual_need = BIG_UWORD_HEAP_SIZE(val); - ASSERT(actual_need <= (BIG_UINT_HEAP_SIZE*2)); - UseTmpHeapNoproc(actual_need); - a.id = erts_bld_uword(&hp, NULL, (UWord) val); -#else UseTmpHeapNoproc(BIG_UINT_HEAP_SIZE); a.id = erts_bld_uint(&hp, NULL, (Uint) u.pb->val); -#endif erts_match_prog_foreach_offheap(u.pb->val, insert_offheap2, (void *) &a); @@ -1181,11 +1148,7 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id) nib->bin_val = u.pb->val; nib->next = inserted_bins; inserted_bins = nib; -#if HALFWORD_HEAP - UnUseTmpHeapNoproc(actual_need); -#else UnUseTmpHeapNoproc(BIG_UINT_HEAP_SIZE); -#endif } } break; @@ -1371,56 +1334,50 @@ setup_reference_table(void) for (i = 0; i < max; i++) { Process *proc = erts_pix2proc(i); if (proc) { - ErlMessage *msg; + int mli; + ErtsMessage *msg_list[] = { + proc->msg.first, +#ifdef ERTS_SMP + proc->msg_inq.first, +#endif + proc->msg_frag}; /* Insert Heap */ insert_offheap(&(proc->off_heap), HEAP_REF, proc->common.id); - /* Insert message buffers */ + /* Insert heap fragments buffers */ for(hfp = proc->mbuf; hfp; hfp = hfp->next) insert_offheap(&(hfp->off_heap), HEAP_REF, proc->common.id); - /* Insert msg msg buffers */ - for (msg = proc->msg.first; msg; msg = msg->next) { - ErlHeapFragment *heap_frag = NULL; - if (msg->data.attached) { - if (is_value(ERL_MESSAGE_TERM(msg))) - heap_frag = msg->data.heap_frag; - else { - if (msg->data.dist_ext->dep) - insert_dist_entry(msg->data.dist_ext->dep, - HEAP_REF, proc->common.id, 0); - if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) - heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); + + /* Insert msg buffers */ + for (mli = 0; mli < sizeof(msg_list)/sizeof(msg_list[0]); mli++) { + ErtsMessage *msg; + for (msg = msg_list[mli]; msg; msg = msg->next) { + ErlHeapFragment *heap_frag = NULL; + if (msg->data.attached) { + if (msg->data.attached == ERTS_MSG_COMBINED_HFRAG) + heap_frag = &msg->hfrag; + else if (is_value(ERL_MESSAGE_TERM(msg))) + heap_frag = msg->data.heap_frag; + else { + if (msg->data.dist_ext->dep) + insert_dist_entry(msg->data.dist_ext->dep, + HEAP_REF, proc->common.id, 0); + if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) + heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); + } } - } - if (heap_frag) - insert_offheap(&(heap_frag->off_heap), - HEAP_REF, - proc->common.id); - } -#ifdef ERTS_SMP - for (msg = proc->msg_inq.first; msg; msg = msg->next) { - ErlHeapFragment *heap_frag = NULL; - if (msg->data.attached) { - if (is_value(ERL_MESSAGE_TERM(msg))) - heap_frag = msg->data.heap_frag; - else { - if (msg->data.dist_ext->dep) - insert_dist_entry(msg->data.dist_ext->dep, - HEAP_REF, proc->common.id, 0); - if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) - heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); + while (heap_frag) { + insert_offheap(&(heap_frag->off_heap), + HEAP_REF, + proc->common.id); + heap_frag = heap_frag->next; } } - if (heap_frag) - insert_offheap(&(heap_frag->off_heap), - HEAP_REF, - proc->common.id); } -#endif /* Insert links */ if (ERTS_P_LINKS(proc)) insert_links(ERTS_P_LINKS(proc), proc->common.id); diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h index 694ac84232..7a4434acbf 100644 --- a/erts/emulator/beam/erl_node_tables.h +++ b/erts/emulator/beam/erl_node_tables.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2012. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -41,6 +41,7 @@ #include "sys.h" #include "hash.h" +#include "erl_alloc.h" #include "erl_process.h" #include "erl_monitors.h" #include "erl_smp.h" @@ -66,7 +67,7 @@ #define ERTS_DE_QFLGS_ALL (ERTS_DE_QFLG_BUSY \ | ERTS_DE_QFLG_EXIT) -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) #define ERTS_DIST_OUTPUT_BUF_DBG_PATTERN ((Uint) 0xf713f713f713f713UL) #else #define ERTS_DIST_OUTPUT_BUF_DBG_PATTERN ((Uint) 0xf713f713) @@ -181,7 +182,7 @@ Uint erts_dist_table_size(void); void erts_dist_table_info(int, void *); void erts_set_dist_entry_not_connected(DistEntry *); void erts_set_dist_entry_connected(DistEntry *, Eterm, Uint); -ErlNode *erts_find_or_insert_node(Eterm, Uint); +ErlNode *erts_find_or_insert_node(Eterm, Uint32); void erts_schedule_delete_node(ErlNode *); void erts_set_this_node(Eterm, Uint); Uint erts_node_table_size(void); diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h index acd68ef0ad..c2588e718d 100644 --- a/erts/emulator/beam/erl_port.h +++ b/erts/emulator/beam/erl_port.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012-2013. All Rights Reserved. + * Copyright Ericsson AB 2012-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -185,8 +185,13 @@ struct _erl_drv_port { int control_flags; /* Flags for port_control() */ ErlDrvPDL port_data_lock; - ErtsPrtSD *psd; /* Port specific data */ + erts_smp_atomic_t psd; /* Port specific data */ int reds; /* Only used while executing driver callbacks */ + + struct { + Eterm to; + Uint32 ref[ERTS_MAX_REF_NUMBERS]; + } *async_open_port; /* Reference used with async open port */ }; @@ -247,22 +252,51 @@ ERTS_GLB_INLINE void *erts_prtsd_set(Port *p, int ix, void *new); ERTS_GLB_INLINE void * erts_prtsd_get(Port *prt, int ix) { - return prt->psd ? prt->psd->data[ix] : NULL; + ErtsPrtSD *psd = (ErtsPrtSD *) erts_smp_atomic_read_nob(&prt->psd); + if (!psd) + return NULL; + ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER; + return psd->data[ix]; } ERTS_GLB_INLINE void * erts_prtsd_set(Port *prt, int ix, void *data) { - if (prt->psd) { - void *old = prt->psd->data[ix]; - prt->psd->data[ix] = data; + ErtsPrtSD *psd, *new_psd; + void *old; + int i; + + psd = (ErtsPrtSD *) erts_smp_atomic_read_nob(&prt->psd); + + if (psd) { +#ifdef ERTS_SMP +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_MEMBAR(ETHR_LoadStore|ETHR_StoreStore); +#else + ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore|ETHR_StoreStore); +#endif +#endif + old = psd->data[ix]; + psd->data[ix] = data; return old; } - else { - prt->psd = erts_alloc(ERTS_ALC_T_PRTSD, sizeof(ErtsPrtSD)); - prt->psd->data[ix] = data; + + if (!data) return NULL; - } + + new_psd = erts_alloc(ERTS_ALC_T_PRTSD, sizeof(ErtsPrtSD)); + for (i = 0; i < ERTS_PRTSD_SIZE; i++) + new_psd->data[i] = NULL; + psd = (ErtsPrtSD *) erts_smp_atomic_cmpxchg_mb(&prt->psd, + (erts_aint_t) new_psd, + (erts_aint_t) NULL); + if (psd) + erts_free(ERTS_ALC_T_PRTSD, new_psd); + else + psd = new_psd; + old = psd->data[ix]; + psd->data[ix] = data; + return old; } #endif @@ -687,7 +721,7 @@ erts_drvport2port_state(ErlDrvPort drvport, erts_aint32_t *statep) Port *prt = ERTS_ErlDrvPort2Port(drvport); erts_aint32_t state; ASSERT(prt); - ERTS_LC_ASSERT(erts_lc_is_emu_thr()); +// ERTS_LC_ASSERT(erts_lc_is_emu_thr()); if (prt == ERTS_INVALID_ERL_DRV_PORT) return ERTS_INVALID_ERL_DRV_PORT; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt) @@ -910,7 +944,7 @@ erts_schedule_proc2port_signal(Process *, ErtsPortTaskHandle *, ErtsProc2PortSigCallback); -int erts_deliver_port_exit(Port *, Eterm, Eterm, int); +int erts_deliver_port_exit(Port *, Eterm, Eterm, int, int); /* * Port signal flags @@ -944,4 +978,11 @@ ErtsPortOpResult erts_port_control(Process *, Port *, unsigned int, Eterm, Eterm ErtsPortOpResult erts_port_call(Process *, Port *, unsigned int, Eterm, Eterm *); ErtsPortOpResult erts_port_info(Process *, Port *, Eterm, Eterm *); +int erts_port_output_async(Port *, Eterm, Eterm); + +/* + * Signals from ports to ports. Used by sys drivers. + */ +int erl_drv_port_control(Eterm, char, char*, ErlDrvSizeT); + #endif diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index ddcca06b0a..3102e44c11 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2013. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -35,6 +35,7 @@ #include "dist.h" #include "erl_check_io.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #include <stdarg.h> /* @@ -69,6 +70,18 @@ static void chk_task_queues(Port *pp, ErtsPortTask *execq, int processing_busy_q #else #define DTRACE_DRIVER(PROBE_NAME, PP) do {} while(0) #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS +#define LTTNG_DRIVER(TRACEPOINT, PP) \ + if (LTTNG_ENABLED(TRACEPOINT)) { \ + lttng_decl_portbuf(port_str); \ + lttng_decl_procbuf(proc_str); \ + lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(PP), proc_str); \ + lttng_port_to_str((PP), port_str); \ + LTTNG3(TRACEPOINT, proc_str, port_str, (PP)->name); \ + } +#else +#define LTTNG_DRIVER(TRACEPOINT, PP) do {} while(0) +#endif #define ERTS_SMP_LC_VERIFY_RQ(RQ, PP) \ do { \ @@ -180,10 +193,9 @@ p2p_sig_data_to_task(ErtsProc2PortSigData *sigdp) return ptp; } -ErtsProc2PortSigData * -erts_port_task_alloc_p2p_sig_data(void) +static ERTS_INLINE ErtsProc2PortSigData * +p2p_sig_data_init(ErtsPortTask *ptp) { - ErtsPortTask *ptp = port_task_alloc(); ptp->type = ERTS_PORT_TASK_PROC_SIG; ptp->u.alive.flags = ERTS_PT_FLG_SIG_DEP; @@ -194,6 +206,31 @@ erts_port_task_alloc_p2p_sig_data(void) return &ptp->u.alive.td.psig.data; } +ErtsProc2PortSigData * +erts_port_task_alloc_p2p_sig_data(void) +{ + ErtsPortTask *ptp = port_task_alloc(); + + return p2p_sig_data_init(ptp); +} + +ErtsProc2PortSigData * +erts_port_task_alloc_p2p_sig_data_extra(size_t extra, void **extra_ptr) +{ + ErtsPortTask *ptp = erts_alloc(ERTS_ALC_T_PORT_TASK, + sizeof(ErtsPortTask) + extra); + + *extra_ptr = ptp+1; + + return p2p_sig_data_init(ptp); +} + +void +erts_port_task_free_p2p_sig_data(ErtsProc2PortSigData *sigdp) +{ + schedule_port_task_free(p2p_sig_data_to_task(sigdp)); +} + static ERTS_INLINE Eterm task_caller(ErtsPortTask *ptp) { @@ -1648,6 +1685,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) int active; Uint64 start_time = 0; ErtsSchedulerData *esdp = runq->scheduler; + ERTS_MSACC_PUSH_STATE_M(); ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); @@ -1690,6 +1728,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) state = erts_atomic32_read_nob(&pp->state); pp->reds = ERTS_PORT_REDS_EXECUTE; + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); goto begin_handle_tasks; while (1) { @@ -1726,6 +1765,9 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) reds = ERTS_PORT_REDS_TIMEOUT; if (!(state & ERTS_PORT_SFLGS_DEAD)) { DTRACE_DRIVER(driver_timeout, pp); + LTTNG_DRIVER(driver_timeout, pp); + if (IS_TRACED_FL(pp, F_TRACE_RECEIVE)) + trace_port(pp, am_receive, am_timeout); (*pp->drv_ptr->timeout)((ErlDrvData) pp->drv_data); } } @@ -1734,7 +1776,8 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) reds = ERTS_PORT_REDS_INPUT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_ready_input, pp); - /* NOTE some windows/ose drivers use ->ready_input + LTTNG_DRIVER(driver_ready_input, pp); + /* NOTE some windows drivers use ->ready_input for input and output */ (*pp->drv_ptr->ready_input)((ErlDrvData) pp->drv_data, ptp->u.alive.td.io.event); @@ -1745,6 +1788,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) reds = ERTS_PORT_REDS_OUTPUT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_ready_output, pp); + LTTNG_DRIVER(driver_ready_output, pp); (*pp->drv_ptr->ready_output)((ErlDrvData) pp->drv_data, ptp->u.alive.td.io.event); reset_executed_io_task_handle(ptp); @@ -1754,6 +1798,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) reds = ERTS_PORT_REDS_EVENT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_event, pp); + LTTNG_DRIVER(driver_event, pp); (*pp->drv_ptr->event)((ErlDrvData) pp->drv_data, ptp->u.alive.td.io.event, ptp->u.alive.td.io.event_data); @@ -1822,6 +1867,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) } erts_unblock_fpe(fpe_was_unmasked); + ERTS_MSACC_POP_STATE_M(); if (io_tasks_executed) { diff --git a/erts/emulator/beam/erl_port_task.h b/erts/emulator/beam/erl_port_task.h index 335f7a77d5..2a6bd165a3 100644 --- a/erts/emulator/beam/erl_port_task.h +++ b/erts/emulator/beam/erl_port_task.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2013. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -269,6 +269,8 @@ int erts_port_task_schedule(Eterm, void erts_port_task_free_port(Port *); int erts_port_is_scheduled(Port *); ErtsProc2PortSigData *erts_port_task_alloc_p2p_sig_data(void); +ErtsProc2PortSigData *erts_port_task_alloc_p2p_sig_data_extra(size_t extra, void **extra_ptr); +void erts_port_task_free_p2p_sig_data(ErtsProc2PortSigData *sigdp); #ifdef ERTS_SMP void erts_enqueue_port(ErtsRunQueue *rq, Port *pp); diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c index 2917d58932..1a579704a8 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-2014. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -117,13 +117,12 @@ do { \ /* return 0 if list is not a non-empty flat list of printable characters */ static int -is_printable_string(Eterm list, Eterm* base) -{ +is_printable_string(Eterm list) { int len = 0; int c; while(is_list(list)) { - Eterm* consp = list_val_rel(list, base); + Eterm* consp = list_val(list); Eterm hd = CAR(consp); if (!is_byte(hd)) @@ -260,9 +259,7 @@ static char *format_binary(Uint16 x, char *b) { #endif static int -print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, - Eterm* obj_base) /* ignored if !HALFWORD_HEAP */ -{ +print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) { DECLARE_WSTACK(s); int res; int i; @@ -308,7 +305,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, obj = (Eterm) popped.word; L_print_one_cons: { - Eterm* cons = list_val_rel(obj, obj_base); + Eterm* cons = list_val(obj); Eterm tl; obj = CAR(cons); @@ -344,11 +341,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, PRINT_CHAR(res, fn, arg, '>'); goto L_done; } -#if HALFWORD_HEAP - wobj = is_immed(obj) ? (Wterm)obj : rterm2wterm(obj, obj_base); -#else wobj = (Wterm)obj; -#endif switch (tag_val_def(wobj)) { case NIL_DEF: PRINT_STRING(res, fn, arg, "[]"); @@ -424,10 +417,10 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, PRINT_CHAR(res, fn, arg, '>'); break; case LIST_DEF: - if (is_printable_string(obj, obj_base)) { + if (is_printable_string(obj)) { int c; PRINT_CHAR(res, fn, arg, '"'); - nobj = list_val_rel(obj, obj_base); + nobj = list_val(obj); while (1) { if ((*dcount)-- <= 0) goto L_done; @@ -441,7 +434,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, } if (is_not_list(*nobj)) break; - nobj = list_val_rel(*nobj, obj_base); + nobj = list_val(*nobj); } PRINT_CHAR(res, fn, arg, '"'); } else { @@ -469,11 +462,11 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, case BINARY_DEF: { byte* bytep; - Uint bytesize = binary_size_rel(obj,obj_base); + Uint bytesize = binary_size(obj); Uint bitoffs; Uint bitsize; byte octet; - ERTS_GET_BINARY_BYTES_REL(obj, bytep, bitoffs, bitsize, obj_base); + ERTS_GET_BINARY_BYTES(obj, bytep, bitoffs, bitsize); if (bitsize || !bytesize || !is_printable_ascii(bytep, bytesize, bitoffs)) { @@ -648,13 +641,11 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, int -erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision, - ErlPfEterm* term_base) -{ +erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision) { int res; ERTS_CT_ASSERT(sizeof(ErlPfEterm) == sizeof(Eterm)); - res = print_term(fn, arg, (Eterm)term, &precision, (Eterm*)term_base); + res = print_term(fn, arg, (Eterm)term, &precision); if (res < 0) return res; if (precision <= 0) diff --git a/erts/emulator/beam/erl_printf_term.h b/erts/emulator/beam/erl_printf_term.h index 87618a36d7..8a30286fd8 100644 --- a/erts/emulator/beam/erl_printf_term.h +++ b/erts/emulator/beam/erl_printf_term.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2013. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -22,6 +22,5 @@ #define ERL_PRINTF_TERM_H__ #include "erl_printf_format.h" -int erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision, - ErlPfEterm* term_base); +int erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision); #endif diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 4ec98d5cc7..d485affa3b 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -43,6 +43,7 @@ #include "erl_thr_queue.h" #include "erl_async.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #include "erl_ptab.h" #include "erl_bif_unique.h" #define ERTS_WANT_TIMER_WHEEL_API @@ -58,11 +59,7 @@ #define ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST (CONTEXT_REDS/10) -#ifndef ERTS_SCHED_MIN_SPIN #define ERTS_SCHED_SPIN_UNTIL_YIELD 100 -#else -#define ERTS_SCHED_SPIN_UNTIL_YIELD 1 -#endif #define ERTS_SCHED_SYS_SLEEP_SPINCOUNT_VERY_LONG 40 #define ERTS_SCHED_AUX_WORK_SLEEP_SPINCOUNT_FACT_VERY_LONG 1000 @@ -119,7 +116,7 @@ #define RUNQ_SET_RQ(X, RQ) erts_smp_atomic_set_nob((X), (erts_aint_t) (RQ)) #ifdef DEBUG -# if defined(ARCH_64) && !HALFWORD_HEAP +# if defined(ARCH_64) # define ERTS_DBG_SET_INVALID_RUNQP(RQP, N) \ (RUNQ_SET_RQ((RQP), (0xdeadbeefdead0003LL | ((N) << 4))) # define ERTS_DBG_VERIFY_VALID_RUNQP(RQP) \ @@ -152,19 +149,13 @@ extern BeamInstr beam_apply[]; extern BeamInstr beam_exit[]; extern BeamInstr beam_continue_exit[]; -#ifdef __OSE__ -/* Eager check I/O not supported on OSE yet. */ -int erts_eager_check_io = 0; -#else -int erts_eager_check_io = 1; -#endif -int erts_sched_compact_load; -int erts_sched_balance_util = 0; -Uint erts_no_schedulers; -#ifdef ERTS_DIRTY_SCHEDULERS -Uint erts_no_dirty_cpu_schedulers; -Uint erts_no_dirty_io_schedulers; -#endif +int ERTS_WRITE_UNLIKELY(erts_default_spo_flags) = 0; +int ERTS_WRITE_UNLIKELY(erts_eager_check_io) = 1; +int ERTS_WRITE_UNLIKELY(erts_sched_compact_load); +int ERTS_WRITE_UNLIKELY(erts_sched_balance_util) = 0; +Uint ERTS_WRITE_UNLIKELY(erts_no_schedulers); +Uint ERTS_WRITE_UNLIKELY(erts_no_dirty_cpu_schedulers) = 0; +Uint ERTS_WRITE_UNLIKELY(erts_no_dirty_io_schedulers) = 0; static char *erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_NO_FLAGS] = {0}; int erts_aux_work_no_flags = ERTS_SSI_AUX_WORK_NO_FLAGS; @@ -196,84 +187,176 @@ int erts_disable_proc_not_running_opt; static ErtsAuxWorkData *aux_thread_aux_work_data; -#define ERTS_SCHDLR_SSPND_CHNG_WAITER (((erts_aint32_t) 1) << 0) +#define ERTS_SCHDLR_SSPND_CHNG_NMSB (((erts_aint32_t) 1) << 0) #define ERTS_SCHDLR_SSPND_CHNG_MSB (((erts_aint32_t) 1) << 1) #define ERTS_SCHDLR_SSPND_CHNG_ONLN (((erts_aint32_t) 1) << 2) +#define ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN (((erts_aint32_t) 1) << 3) -#ifndef DEBUG +typedef enum { + ERTS_SCHED_NORMAL, + ERTS_SCHED_DIRTY_CPU, + ERTS_SCHED_DIRTY_IO +} ErtsSchedType; -#define ERTS_SCHDLR_SSPND_CHNG_SET(VAL, OLD_VAL) \ - erts_smp_atomic32_set_nob(&schdlr_sspnd.changing, (VAL)) +typedef struct { + int ongoing; + ErtsProcList *blckrs; + ErtsProcList *chngq; +} ErtsMultiSchedulingBlock; -#ifdef ERTS_DIRTY_SCHEDULERS -#define ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(VAL, OLD_VAL) \ - erts_smp_atomic32_set_nob(&schdlr_sspnd.dirty_cpu_changing, (VAL)) -#define ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(VAL, OLD_VAL) \ - erts_smp_atomic32_set_nob(&schdlr_sspnd.dirty_io_changing, (VAL)) -#endif +static struct { + erts_smp_mtx_t mtx; + Uint32 online; + Uint32 curr_online; + Uint32 active; + erts_smp_atomic32_t changing; + ErtsProcList *chngq; + Eterm changer; + ErtsMultiSchedulingBlock nmsb; /* Normal multi Scheduling Block */ + ErtsMultiSchedulingBlock msb; /* Multi Scheduling Block */ +} schdlr_sspnd; -#else +#define ERTS_SCHDLR_SSPND_S_BITS 10 +#define ERTS_SCHDLR_SSPND_DCS_BITS 11 +#define ERTS_SCHDLR_SSPND_DIS_BITS 11 -#define ERTS_SCHDLR_SSPND_CHNG_SET(VAL, OLD_VAL) \ -do { \ - erts_aint32_t old_val__; \ - old_val__ = erts_smp_atomic32_xchg_nob(&schdlr_sspnd.changing, \ - (VAL)); \ - ASSERT(old_val__ == (OLD_VAL)); \ -} while (0) +#define ERTS_SCHDLR_SSPND_S_MASK ((1 << ERTS_SCHDLR_SSPND_S_BITS)-1) +#define ERTS_SCHDLR_SSPND_DCS_MASK ((1 << ERTS_SCHDLR_SSPND_DCS_BITS)-1) +#define ERTS_SCHDLR_SSPND_DIS_MASK ((1 << ERTS_SCHDLR_SSPND_DIS_BITS)-1) -#ifdef ERTS_DIRTY_SCHEDULERS -#define ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(VAL, OLD_VAL) \ -do { \ - erts_aint32_t old_val__; \ - old_val__ = erts_smp_atomic32_xchg_nob(&schdlr_sspnd.dirty_cpu_changing, \ - (VAL)); \ - ASSERT(old_val__ == (OLD_VAL)); \ -} while (0) -#define ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(VAL, OLD_VAL) \ -do { \ - erts_aint32_t old_val__; \ - old_val__ = erts_smp_atomic32_xchg_nob(&schdlr_sspnd.dirty_io_changing, \ - (VAL)); \ - ASSERT(old_val__ == (OLD_VAL)); \ -} while (0) -#endif +#define ERTS_SCHDLR_SSPND_S_SHIFT 0 +#define ERTS_SCHDLR_SSPND_DCS_SHIFT (ERTS_SCHDLR_SSPND_S_SHIFT \ + + ERTS_SCHDLR_SSPND_S_BITS) +#define ERTS_SCHDLR_SSPND_DIS_SHIFT (ERTS_SCHDLR_SSPND_DCS_SHIFT \ + + ERTS_SCHDLR_SSPND_DCS_BITS) +#if (ERTS_SCHDLR_SSPND_S_BITS \ + + ERTS_SCHDLR_SSPND_DCS_BITS \ + + ERTS_SCHDLR_SSPND_DIS_BITS) > 32 +# error Wont fit in Uint32 #endif - -static struct { - erts_smp_mtx_t mtx; - erts_smp_cnd_t cnd; - int online; - int curr_online; - int wait_curr_online; -#ifdef ERTS_DIRTY_SCHEDULERS - int dirty_cpu_online; - int dirty_cpu_curr_online; - int dirty_cpu_wait_curr_online; - int dirty_io_online; - int dirty_io_curr_online; - int dirty_io_wait_curr_online; +#if (ERTS_MAX_NO_OF_SCHEDULERS-1) > ERTS_SCHDLR_SSPND_S_MASK +# error Max no schedulers wont fit in its bit-field #endif - erts_smp_atomic32_t changing; - erts_smp_atomic32_t active; -#ifdef ERTS_DIRTY_SCHEDULERS - erts_smp_atomic32_t dirty_cpu_changing; - erts_smp_atomic32_t dirty_cpu_active; - erts_smp_atomic32_t dirty_io_changing; - erts_smp_atomic32_t dirty_io_active; +#if ERTS_MAX_NO_OF_DIRTY_CPU_SCHEDULERS > ERTS_SCHDLR_SSPND_DCS_MASK +# error Max no dirty cpu schedulers wont fit in its bit-field #endif - struct { - int ongoing; - long wait_active; -#ifdef ERTS_DIRTY_SCHEDULERS - long dirty_cpu_wait_active; - long dirty_io_wait_active; +#if ERTS_MAX_NO_OF_DIRTY_IO_SCHEDULERS > ERTS_SCHDLR_SSPND_DIS_MASK +# error Max no dirty io schedulers wont fit in its bit-field #endif - ErtsProcList *procs; - } msb; /* Multi Scheduling Block */ -} schdlr_sspnd; + +#define ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(S, DCS, DIS) \ + ((((Uint32) (((S) & ERTS_SCHDLR_SSPND_S_MASK))-1) \ + << ERTS_SCHDLR_SSPND_S_SHIFT) \ + | ((((Uint32) ((DCS) & ERTS_SCHDLR_SSPND_DCS_MASK)) \ + << ERTS_SCHDLR_SSPND_DCS_SHIFT)) \ + | ((((Uint32) ((DIS) & ERTS_SCHDLR_SSPND_DIS_MASK)) \ + << ERTS_SCHDLR_SSPND_DIS_SHIFT))) + +static void init_scheduler_suspend(void); + +static ERTS_INLINE Uint32 +schdlr_sspnd_get_nscheds(Uint32 *valp, ErtsSchedType type) +{ + Uint32 res = (Uint32) (*valp); + switch (type) { + case ERTS_SCHED_NORMAL: + res >>= ERTS_SCHDLR_SSPND_S_SHIFT; + res &= (Uint32) ERTS_SCHDLR_SSPND_S_MASK; + res++; + break; + case ERTS_SCHED_DIRTY_CPU: + res >>= ERTS_SCHDLR_SSPND_DCS_SHIFT; + res &= (Uint32) ERTS_SCHDLR_SSPND_DCS_MASK; + break; + case ERTS_SCHED_DIRTY_IO: + res >>= ERTS_SCHDLR_SSPND_DIS_SHIFT; + res &= (Uint32) ERTS_SCHDLR_SSPND_DIS_MASK; + break; + default: + ERTS_INTERNAL_ERROR("Invalid scheduler type"); + return 0; + } + + return res; +} + +static ERTS_INLINE void +schdlr_sspnd_dec_nscheds(Uint32 *valp, ErtsSchedType type) +{ + ASSERT(schdlr_sspnd_get_nscheds(valp, type) > 0); + + switch (type) { + case ERTS_SCHED_NORMAL: + *valp -= ((Uint32) 1) << ERTS_SCHDLR_SSPND_S_SHIFT; + break; + case ERTS_SCHED_DIRTY_CPU: + *valp -= ((Uint32) 1) << ERTS_SCHDLR_SSPND_DCS_SHIFT; + break; + case ERTS_SCHED_DIRTY_IO: + *valp -= ((Uint32) 1) << ERTS_SCHDLR_SSPND_DIS_SHIFT; + break; + default: + ERTS_INTERNAL_ERROR("Invalid scheduler type"); + } +} + +static ERTS_INLINE void +schdlr_sspnd_inc_nscheds(Uint32 *valp, ErtsSchedType type) +{ + switch (type) { + case ERTS_SCHED_NORMAL: + ASSERT(schdlr_sspnd_get_nscheds(valp, type) + < ERTS_MAX_NO_OF_SCHEDULERS-1); + *valp += ((Uint32) 1) << ERTS_SCHDLR_SSPND_S_SHIFT; + break; + case ERTS_SCHED_DIRTY_CPU: + ASSERT(schdlr_sspnd_get_nscheds(valp, type) + < ERTS_MAX_NO_OF_DIRTY_CPU_SCHEDULERS); + *valp += ((Uint32) 1) << ERTS_SCHDLR_SSPND_DCS_SHIFT; + break; + case ERTS_SCHED_DIRTY_IO: + ASSERT(schdlr_sspnd_get_nscheds(valp, type) + < ERTS_MAX_NO_OF_DIRTY_IO_SCHEDULERS); + *valp += ((Uint32) 1) << ERTS_SCHDLR_SSPND_DIS_SHIFT; + break; + default: + ERTS_INTERNAL_ERROR("Invalid scheduler type"); + } +} + +static ERTS_INLINE void +schdlr_sspnd_set_nscheds(Uint32 *valp, ErtsSchedType type, Uint32 no) +{ + Uint32 val = *valp; + + switch (type) { + case ERTS_SCHED_NORMAL: + ASSERT(no > 0); + val &= ~(((Uint32) ERTS_SCHDLR_SSPND_S_MASK) + << ERTS_SCHDLR_SSPND_S_SHIFT); + val |= (((no-1) & ((Uint32) ERTS_SCHDLR_SSPND_S_MASK)) + << ERTS_SCHDLR_SSPND_S_SHIFT); + break; + case ERTS_SCHED_DIRTY_CPU: + val &= ~(((Uint32) ERTS_SCHDLR_SSPND_DCS_MASK) + << ERTS_SCHDLR_SSPND_DCS_SHIFT); + val |= ((no & ((Uint32) ERTS_SCHDLR_SSPND_DCS_MASK)) + << ERTS_SCHDLR_SSPND_DCS_SHIFT); + break; + case ERTS_SCHED_DIRTY_IO: + val &= ~(((Uint32) ERTS_SCHDLR_SSPND_DIS_MASK) + << ERTS_SCHDLR_SSPND_DIS_SHIFT); + val |= ((no & ((Uint32) ERTS_SCHDLR_SSPND_DIS_MASK)) + << ERTS_SCHDLR_SSPND_DIS_SHIFT); + break; + default: + ERTS_INTERNAL_ERROR("Invalid scheduler type"); + } + + *valp = val; +} static struct { erts_smp_mtx_t update_mtx; @@ -303,7 +386,7 @@ do { \ erts_sched_stat_t erts_sched_stat; #ifdef USE_THREADS -static erts_tsd_key_t sched_data_key; +static erts_tsd_key_t ERTS_WRITE_UNLIKELY(sched_data_key); #endif static erts_smp_atomic32_t function_calls; @@ -343,11 +426,10 @@ static ErtsAlignedSchedulerSleepInfo *aligned_dirty_io_sched_sleep_info; static Uint last_reductions; static Uint last_exact_reductions; -Uint erts_default_process_flags; -Eterm erts_system_monitor; -Eterm erts_system_monitor_long_gc; -Uint erts_system_monitor_long_schedule; -Eterm erts_system_monitor_large_heap; +Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor); +Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor_long_gc); +Uint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_schedule); +Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor_large_heap); struct erts_system_monitor_flags_t erts_system_monitor_flags; /* system performance monitor */ @@ -361,7 +443,9 @@ int erts_system_profile_ts_type = ERTS_TRACE_FLG_NOW_TIMESTAMP; typedef enum { ERTS_PSTT_GC, /* Garbage Collect */ - ERTS_PSTT_CPC /* Check Process Code */ + ERTS_PSTT_CPC, /* Check Process Code */ + ERTS_PSTT_COHMQ, /* Change off heap message queue */ + ERTS_PSTT_FTMQ /* Flush trace msg queue */ } ErtsProcSysTaskType; #define ERTS_MAX_PROC_SYS_TASK_ARGS 2 @@ -434,8 +518,10 @@ do { \ do { \ ErtsRunQueue *RQVAR; \ int ix__; \ + int online__ = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, \ + ERTS_SCHED_NORMAL); \ ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&schdlr_sspnd.mtx)); \ - for (ix__ = 0; ix__ < schdlr_sspnd.online; ix__++) { \ + for (ix__ = 0; ix__ < online__; ix__++) { \ RQVAR = ERTS_RUNQ_IX(ix__); \ erts_smp_runq_lock(RQVAR); \ { DO; } \ @@ -507,9 +593,6 @@ dbg_chk_aux_work_val(erts_aint32_t value) #if HAVE_ERTS_MSEG valid |= ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK; #endif -#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN - valid |= ERTS_SSI_AUX_WORK_CHECK_CHILDREN; -#endif #ifdef ERTS_SSI_AUX_WORK_REAP_PORTS valid |= ERTS_SSI_AUX_WORK_REAP_PORTS; #endif @@ -596,8 +679,6 @@ erts_pre_init_process(void) = "MISC_THR_PRGR"; erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_MISC_IX] = "MISC"; - erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_CHECK_CHILDREN_IX] - = "CHECK_CHILDREN"; erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_SET_TMO_IX] = "SET_TMO"; erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX] @@ -608,45 +689,36 @@ erts_pre_init_process(void) = "DEBUG_WAIT_COMPLETED"; #ifdef ERTS_ENABLE_LOCK_CHECK - { - int ix; - erts_psd_required_locks[ERTS_PSD_ERROR_HANDLER].get_locks - = ERTS_PSD_ERROR_HANDLER_BUF_GET_LOCKS; - erts_psd_required_locks[ERTS_PSD_ERROR_HANDLER].set_locks - = ERTS_PSD_ERROR_HANDLER_BUF_SET_LOCKS; + erts_psd_required_locks[ERTS_PSD_ERROR_HANDLER].get_locks + = ERTS_PSD_ERROR_HANDLER_BUF_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_ERROR_HANDLER].set_locks + = ERTS_PSD_ERROR_HANDLER_BUF_SET_LOCKS; - erts_psd_required_locks[ERTS_PSD_SAVED_CALLS_BUF].get_locks - = ERTS_PSD_SAVED_CALLS_BUF_GET_LOCKS; - erts_psd_required_locks[ERTS_PSD_SAVED_CALLS_BUF].set_locks - = ERTS_PSD_SAVED_CALLS_BUF_SET_LOCKS; + erts_psd_required_locks[ERTS_PSD_SAVED_CALLS_BUF].get_locks + = ERTS_PSD_SAVED_CALLS_BUF_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_SAVED_CALLS_BUF].set_locks + = ERTS_PSD_SAVED_CALLS_BUF_SET_LOCKS; - erts_psd_required_locks[ERTS_PSD_SCHED_ID].get_locks - = ERTS_PSD_SCHED_ID_GET_LOCKS; - erts_psd_required_locks[ERTS_PSD_SCHED_ID].set_locks - = ERTS_PSD_SCHED_ID_SET_LOCKS; + erts_psd_required_locks[ERTS_PSD_SCHED_ID].get_locks + = ERTS_PSD_SCHED_ID_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_SCHED_ID].set_locks + = ERTS_PSD_SCHED_ID_SET_LOCKS; - erts_psd_required_locks[ERTS_PSD_CALL_TIME_BP].get_locks - = ERTS_PSD_CALL_TIME_BP_GET_LOCKS; - erts_psd_required_locks[ERTS_PSD_CALL_TIME_BP].set_locks - = ERTS_PSD_CALL_TIME_BP_SET_LOCKS; + erts_psd_required_locks[ERTS_PSD_CALL_TIME_BP].get_locks + = ERTS_PSD_CALL_TIME_BP_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_CALL_TIME_BP].set_locks + = ERTS_PSD_CALL_TIME_BP_SET_LOCKS; - erts_psd_required_locks[ERTS_PSD_DELAYED_GC_TASK_QS].get_locks - = ERTS_PSD_DELAYED_GC_TASK_QS_GET_LOCKS; - erts_psd_required_locks[ERTS_PSD_DELAYED_GC_TASK_QS].set_locks - = ERTS_PSD_DELAYED_GC_TASK_QS_SET_LOCKS; + erts_psd_required_locks[ERTS_PSD_DELAYED_GC_TASK_QS].get_locks + = ERTS_PSD_DELAYED_GC_TASK_QS_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_DELAYED_GC_TASK_QS].set_locks + = ERTS_PSD_DELAYED_GC_TASK_QS_SET_LOCKS; - erts_psd_required_locks[ERTS_PSD_NIF_TRAP_EXPORT].get_locks - = ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS; - erts_psd_required_locks[ERTS_PSD_NIF_TRAP_EXPORT].set_locks - = ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS; - - /* Check that we have locks for all entries */ - for (ix = 0; ix < ERTS_PSD_SIZE; ix++) { - ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].get_locks); - ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].set_locks); - } - } + erts_psd_required_locks[ERTS_PSD_NIF_TRAP_EXPORT].get_locks + = ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_NIF_TRAP_EXPORT].set_locks + = ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS; #endif } @@ -685,7 +757,6 @@ erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab) last_reductions = 0; last_exact_reductions = 0; - erts_default_process_flags = 0; } void @@ -955,6 +1026,12 @@ sched_wall_time_change(ErtsSchedulerData *esdp, int working) } } } + if (!working) { + ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_BUSY_WAIT); + } else { + ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_OTHER); + } + } typedef struct { @@ -976,7 +1053,6 @@ typedef struct { } ErtsSystemCheckReq; -#if !HALFWORD_HEAP ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(swtreq, ErtsSchedWallTimeReq, 5, @@ -986,33 +1062,6 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(screq, ErtsSystemCheckReq, 5, ERTS_ALC_T_SYS_CHECK_REQ) -#else -static ERTS_INLINE ErtsSchedWallTimeReq * -swtreq_alloc(void) -{ - return erts_alloc(ERTS_ALC_T_SCHED_WTIME_REQ, - sizeof(ErtsSchedWallTimeReq)); -} - -static ERTS_INLINE void -swtreq_free(ErtsSchedWallTimeReq *ptr) -{ - erts_free(ERTS_ALC_T_SCHED_WTIME_REQ, ptr); -} - -static ERTS_INLINE ErtsSystemCheckReq * -screq_alloc(void) -{ - return erts_alloc(ERTS_ALC_T_SYS_CHECK_REQ, - sizeof(ErtsSystemCheckReq)); -} - -static ERTS_INLINE void -screq_free(ErtsSystemCheckReq *ptr) -{ - erts_free(ERTS_ALC_T_SYS_CHECK_REQ, ptr); -} -#endif static void reply_sched_wall_time(void *vswtrp) @@ -1029,7 +1078,7 @@ reply_sched_wall_time(void *vswtrp) Eterm **hpp; Uint sz, *szp; ErlOffHeap *ohp = NULL; - ErlHeapFragment *bp = NULL; + ErtsMessage *mp = NULL; ASSERT(esdp); #ifdef ERTS_DIRTY_SCHEDULERS @@ -1085,12 +1134,12 @@ reply_sched_wall_time(void *vswtrp) if (hpp) break; - hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); szp = NULL; hpp = &hp; } - erts_queue_message(rp, &rp_locks, bp, msg, NIL); + erts_queue_message(rp, &rp_locks, mp, msg); if (swtrp->req_sched == esdp->no) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -1157,7 +1206,7 @@ reply_system_check(void *vscrp) Eterm **hpp; Uint sz; ErlOffHeap *ohp = NULL; - ErlHeapFragment *bp = NULL; + ErtsMessage *mp = NULL; ASSERT(esdp); #ifdef ERTS_DIRTY_SCHEDULERS @@ -1165,11 +1214,11 @@ reply_system_check(void *vscrp) #endif sz = REF_THING_SIZE; - hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); hpp = &hp; msg = STORE_NC(hpp, ohp, scrp->ref); - erts_queue_message(rp, &rp_locks, bp, msg, NIL); + erts_queue_message(rp, &rp_locks, mp, msg); if (scrp->req_sched == esdp->no) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -1224,6 +1273,15 @@ proclist_create(Process *p) return plp; } +static ERTS_INLINE ErtsProcList * +proclist_copy(ErtsProcList *plp0) +{ + ErtsProcList *plp1 = proclist_alloc(); + plp1->pid = plp0->pid; + plp1->started_interval = plp0->started_interval; + return plp1; +} + static ERTS_INLINE void proclist_destroy(ErtsProcList *plp) { @@ -1231,6 +1289,12 @@ proclist_destroy(ErtsProcList *plp) } ErtsProcList * +erts_proclist_copy(ErtsProcList *plp) +{ + return proclist_copy(plp); +} + +ErtsProcList * erts_proclist_create(Process *p) { return proclist_create(p); @@ -1243,46 +1307,25 @@ erts_proclist_destroy(ErtsProcList *plp) } void * -erts_psd_set_init(Process *p, ErtsProcLocks plocks, int ix, void *data) +erts_psd_set_init(Process *p, int ix, void *data) { void *old; - ErtsProcLocks xplocks; - int refc = 0; - ErtsPSD *psd = erts_alloc(ERTS_ALC_T_PSD, sizeof(ErtsPSD)); + ErtsPSD *psd, *new_psd; int i; - for (i = 0; i < ERTS_PSD_SIZE; i++) - psd->data[i] = NULL; - ERTS_SMP_LC_ASSERT(plocks); - ERTS_SMP_LC_ASSERT(plocks == erts_proc_lc_my_proc_locks(p)); + new_psd = erts_alloc(ERTS_ALC_T_PSD, sizeof(ErtsPSD)); + for (i = 0; i < ERTS_PSD_SIZE; i++) + new_psd->data[i] = NULL; - xplocks = ERTS_PROC_LOCKS_ALL; - xplocks &= ~plocks; - if (xplocks && erts_smp_proc_trylock(p, xplocks) == EBUSY) { - if (xplocks & ERTS_PROC_LOCK_MAIN) { - erts_proc_inc_refc(p); - erts_smp_proc_unlock(p, plocks); - erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL); - refc = 1; - } - else { - if (plocks & ERTS_PROC_LOCKS_ALL_MINOR) - erts_smp_proc_unlock(p, plocks & ERTS_PROC_LOCKS_ALL_MINOR); - erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); - } - } - if (!p->psd) - p->psd = psd; - if (xplocks) - erts_smp_proc_unlock(p, xplocks); - if (refc) - erts_proc_dec_refc(p); - ASSERT(p->psd); - if (p->psd != psd) - erts_free(ERTS_ALC_T_PSD, psd); - old = p->psd->data[ix]; - p->psd->data[ix] = data; - ERTS_SMP_LC_ASSERT(plocks == erts_proc_lc_my_proc_locks(p)); + psd = (ErtsPSD *) erts_smp_atomic_cmpxchg_mb(&p->psd, + (erts_aint_t) new_psd, + (erts_aint_t) NULL); + if (psd) + erts_free(ERTS_ALC_T_PSD, new_psd); + else + psd = new_psd; + old = psd->data[ix]; + psd->data[ix] = data; return old; } @@ -1821,15 +1864,17 @@ handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waitin int need_thr_progress = 0; ErtsThrPrgrVal wakeup = ERTS_THR_PRGR_INVALID; int more_work = 0; - + ERTS_MSACC_PUSH_STATE_M_X(); #ifdef ERTS_DIRTY_SCHEDULERS ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); #endif unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_ALLOC); erts_alloc_scheduler_handle_delayed_dealloc((void *) awdp->esdp, &need_thr_progress, &wakeup, &more_work); + ERTS_MSACC_POP_STATE_M_X(); if (more_work) { if (set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD) & ERTS_SSI_AUX_WORK_DD_THR_PRGR) { @@ -2138,8 +2183,7 @@ setup_thr_debug_wait_completed(void *vproc) if (debug_wait_completed_flags & ERTS_DEBUG_WAIT_COMPLETED_DEALLOCATIONS) { erts_alloc_fix_alloc_shrink(awdp->sched_id, 0); wait_flags |= (ERTS_SSI_AUX_WORK_DD - | ERTS_SSI_AUX_WORK_DD_THR_PRGR - | ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP); + | ERTS_SSI_AUX_WORK_DD_THR_PRGR); #ifdef ERTS_SMP aux_work_flags |= ERTS_SSI_AUX_WORK_DD; #endif @@ -2147,8 +2191,7 @@ setup_thr_debug_wait_completed(void *vproc) if (debug_wait_completed_flags & ERTS_DEBUG_WAIT_COMPLETED_TIMER_CANCELLATIONS) { wait_flags |= (ERTS_SSI_AUX_WORK_CNCLD_TMRS - | ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR - | ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP); + | ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR); #ifdef ERTS_SMP if (awdp->esdp && !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)) aux_work_flags |= ERTS_SSI_AUX_WORK_CNCLD_TMRS; @@ -2162,26 +2205,42 @@ setup_thr_debug_wait_completed(void *vproc) awdp->debug.wait_completed.arg = vproc; } -static void -prep_setup_thr_debug_wait_completed(void *vproc) +struct debug_lop { + ErtsThrPrgrLaterOp lop; + Process *proc; +}; + +static void later_thr_debug_wait_completed(void *vlop) { + struct debug_lop *lop = vlop; erts_aint32_t count = (erts_aint32_t) erts_no_schedulers; #ifdef ERTS_SMP count += 1; /* aux thread */ #endif if (erts_atomic32_dec_read_mb(&debug_wait_completed_count) == count) { - /* scheduler threads */ - erts_schedule_multi_misc_aux_work(0, - erts_no_schedulers, - setup_thr_debug_wait_completed, - vproc); + /* scheduler threads */ + erts_schedule_multi_misc_aux_work(0, + erts_no_schedulers, + setup_thr_debug_wait_completed, + lop->proc); #ifdef ERTS_SMP - /* aux_thread */ - erts_schedule_misc_aux_work(0, - setup_thr_debug_wait_completed, - vproc); + /* aux_thread */ + erts_schedule_misc_aux_work(0, + setup_thr_debug_wait_completed, + lop->proc); #endif } + erts_free(ERTS_ALC_T_DEBUG, lop); +} + + +static void +init_thr_debug_wait_completed(void *vproc) +{ + struct debug_lop* lop = erts_alloc(ERTS_ALC_T_DEBUG, + sizeof(struct debug_lop)); + lop->proc = vproc; + erts_schedule_thr_prgr_later_op(later_thr_debug_wait_completed, lop, &lop->lop); } @@ -2191,7 +2250,7 @@ erts_debug_wait_completed(Process *c_p, int flags) /* Only one process at a time can do this */ erts_aint32_t count = (erts_aint32_t) (2*erts_no_schedulers); #ifdef ERTS_SMP - count += 2; /* aux thread */ + count += 1; /* aux thread */ #endif if (0 == erts_atomic32_cmpxchg_mb(&debug_wait_completed_count, count, @@ -2199,51 +2258,18 @@ erts_debug_wait_completed(Process *c_p, int flags) debug_wait_completed_flags = flags; erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); erts_proc_inc_refc(c_p); - /* scheduler threads */ + + /* First flush later-ops on all scheduler threads */ erts_schedule_multi_misc_aux_work(0, erts_no_schedulers, - prep_setup_thr_debug_wait_completed, + init_thr_debug_wait_completed, (void *) c_p); -#ifdef ERTS_SMP - /* aux_thread */ - erts_schedule_misc_aux_work(0, - prep_setup_thr_debug_wait_completed, - (void *) c_p); -#endif return 1; } return 0; } -#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN -void -erts_smp_notify_check_children_needed(void) -{ - int i; - for (i = 0; i < erts_no_schedulers; i++) - set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(i), - ERTS_SSI_AUX_WORK_CHECK_CHILDREN); -#ifdef ERTS_DIRTY_SCHEDULERS - for (i = 0; i < erts_no_dirty_cpu_schedulers; i++) - set_aux_work_flags_wakeup_nob(ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(i), - ERTS_SSI_AUX_WORK_CHECK_CHILDREN); - for (i = 0; i < erts_no_dirty_io_schedulers; i++) - set_aux_work_flags_wakeup_nob(ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(i), - ERTS_SSI_AUX_WORK_CHECK_CHILDREN); -#endif -} - -static ERTS_INLINE erts_aint32_t -handle_check_children(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) -{ - unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_CHECK_CHILDREN); - erts_check_children(); - return aux_work & ~ERTS_SSI_AUX_WORK_CHECK_CHILDREN; -} - -#endif - static void notify_reap_ports_relb(void) { @@ -2286,7 +2312,7 @@ handle_reap_ports(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) ERTS_PORT_SFLG_HALT); erts_smp_atomic32_inc_nob(&erts_halt_progress); if (!(state & (ERTS_PORT_SFLG_EXITING|ERTS_PORT_SFLG_CLOSING))) - erts_deliver_port_exit(prt, prt->common.id, am_killed, 0); + erts_deliver_port_exit(prt, prt->common.id, am_killed, 0, 1); } erts_port_release(prt); @@ -2329,12 +2355,15 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting) ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); \ if (!(aux_work & ~ignore)) { \ ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); \ + ERTS_MSACC_UPDATE_CACHE(); \ + ERTS_MSACC_POP_STATE_M(); \ return aux_work; \ } \ } erts_aint32_t aux_work = orig_aux_work; erts_aint32_t ignore = 0; + ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_AUX); ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); #ifdef ERTS_SMP @@ -2398,10 +2427,6 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting) HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_MISC, handle_misc_aux_work); -#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN - HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_CHECK_CHILDREN, - handle_check_children); -#endif HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_SET_TMO, handle_setup_aux_work_timer); @@ -2429,6 +2454,8 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting) haw_thr_prgr_current_check_progress(awdp); #endif + ERTS_MSACC_UPDATE_CACHE(); + ERTS_MSACC_POP_STATE_M(); return aux_work; #undef HANDLE_AUX_WORK @@ -2629,19 +2656,10 @@ try_set_sys_scheduling(void) #endif static ERTS_INLINE int -prepare_for_sys_schedule(ErtsSchedulerData *esdp, int non_blocking) +prepare_for_sys_schedule(int non_blocking) { if (non_blocking && erts_eager_check_io) { #ifdef ERTS_SMP -#ifdef ERTS_SCHED_ONLY_POLL_SCHED_1 - if (esdp->no != 1) { - /* If we are not scheduler 1 and ERTS_SCHED_ONLY_POLL_SCHED_1 is used - then we make sure to wake scheduler 1 */ - ErtsRunQueue *rq = ERTS_RUNQ_IX(0); - wake_scheduler(rq); - return 0; - } -#endif return try_set_sys_scheduling(); #else return 1; @@ -2651,16 +2669,6 @@ prepare_for_sys_schedule(ErtsSchedulerData *esdp, int non_blocking) #ifdef ERTS_SMP while (!erts_port_task_have_outstanding_io_tasks() && try_set_sys_scheduling()) { -#ifdef ERTS_SCHED_ONLY_POLL_SCHED_1 - if (esdp->no != 1) { - /* If we are not scheduler 1 and ERTS_SCHED_ONLY_POLL_SCHED_1 is used - then we make sure to wake scheduler 1 */ - ErtsRunQueue *rq = ERTS_RUNQ_IX(0); - clear_sys_scheduling(); - wake_scheduler(rq); - return 0; - } -#endif if (!erts_port_task_have_outstanding_io_tasks()) return 1; clear_sys_scheduling(); @@ -2712,13 +2720,6 @@ sched_active(Uint no, ErtsRunQueue *rq) profile_scheduler(make_small(no), am_active); } -static int ERTS_INLINE -ongoing_multi_scheduling_block(void) -{ - ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&schdlr_sspnd.mtx)); - return schdlr_sspnd.msb.ongoing; -} - static ERTS_INLINE void empty_runq_aux(ErtsRunQueue *rq, Uint32 old_flags) { @@ -2955,6 +2956,8 @@ aux_thread(void *unused) ssi->event = erts_tse_fetch(); + erts_msacc_init_thread("aux", 1, 1); + callbacks.arg = (void *) ssi; callbacks.wakeup = thr_prgr_wakeup; callbacks.prepare_wait = thr_prgr_prep_wait; @@ -2965,6 +2968,7 @@ aux_thread(void *unused) init_aux_work_data(awdp, NULL, NULL); awdp->ssi = ssi; + sched_prep_spin_wait(ssi); while (1) { @@ -2984,8 +2988,6 @@ aux_thread(void *unused) erts_thr_progress_active(NULL, thr_prgr_active = 0); erts_thr_progress_prepare_wait(NULL); - ERTS_SCHED_FAIR_YIELD(); - flgs = sched_spin_wait(ssi, 0); if (flgs & ERTS_SSI_FLG_SLEEPING) { @@ -3020,6 +3022,9 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) #ifdef ERTS_SMP int thr_prgr_active = 1; erts_aint32_t flgs; +#endif + ERTS_MSACC_PUSH_STATE_M(); +#ifdef ERTS_SMP ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); @@ -3053,7 +3058,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) * be waiting in erl_sys_schedule() */ - if (ERTS_SCHEDULER_IS_DIRTY(esdp) || !prepare_for_sys_schedule(esdp, 0)) { + if (ERTS_SCHEDULER_IS_DIRTY(esdp) || !prepare_for_sys_schedule(0)) { sched_waiting(esdp->no, rq); @@ -3067,7 +3072,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) sched_wall_time_change(esdp, thr_prgr_active); while (1) { - ErtsMonotonicTime current_time; + ErtsMonotonicTime current_time = 0; aux_work = erts_atomic32_read_acqb(&ssi->aux_work); if (aux_work && !ERTS_SCHEDULER_IS_DIRTY(esdp)) { @@ -3076,6 +3081,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) sched_wall_time_change(esdp, 1); } aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1); + ERTS_MSACC_UPDATE_CACHE(); if (aux_work && erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); } @@ -3100,8 +3106,10 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) timeout_time = erts_check_next_timeout_time(esdp); current_time = erts_get_monotonic_time(esdp); do_timeout = (current_time >= timeout_time); - } else + } else { + current_time = 0; timeout_time = ERTS_MONOTONIC_TIME_MAX; + } if (do_timeout) { if (!thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 1); @@ -3117,8 +3125,6 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erts_thr_progress_prepare_wait(esdp); } - ERTS_SCHED_FAIR_YIELD(); - flgs = sched_spin_wait(ssi, spincount); if (flgs & ERTS_SSI_FLG_SLEEPING) { ASSERT(flgs & ERTS_SSI_FLG_WAITING); @@ -3139,7 +3145,9 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) - 1) + 1; } else timeout = -1; + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); res = erts_tse_twait(ssi->event, timeout); + ERTS_MSACC_POP_STATE_M(); current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 : erts_get_monotonic_time(esdp); } while (res == EINTR); @@ -3189,13 +3197,8 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) #ifdef ERTS_DIRTY_SCHEDULERS ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp)); #endif - -#ifdef ERTS_SCHED_ONLY_POLL_SCHED_1 - ASSERT(esdp->no == 1); -#endif sched_waiting_sys(esdp->no, rq); - erts_smp_runq_unlock(rq); ASSERT(working); @@ -3213,9 +3216,14 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) if (working) sched_wall_time_change(esdp, working = 0); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); + ASSERT(!erts_port_task_have_outstanding_io_tasks()); + LTTNG2(scheduler_poll, esdp->no, 1); erl_sys_schedule(1); /* Might give us something to do */ + ERTS_MSACC_POP_STATE_M(); + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { current_time = erts_get_monotonic_time(esdp); if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) @@ -3236,6 +3244,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erts_thr_progress_active(esdp, thr_prgr_active = 1); #endif aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1); + ERTS_MSACC_UPDATE_CACHE(); #ifdef ERTS_SMP if (aux_work && erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); @@ -3262,7 +3271,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) * Got to check that we still got I/O tasks; otherwise * we have to continue checking for I/O... */ - if (!prepare_for_sys_schedule(esdp, 0)) { + if (!prepare_for_sys_schedule(0)) { spincount *= ERTS_SCHED_TSE_SLEEP_SPINCOUNT_FACT; goto tse_wait; } @@ -3284,7 +3293,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) * Got to check that we still got I/O tasks; otherwise * we have to wait in erl_sys_schedule() after all... */ - if (!prepare_for_sys_schedule(esdp, 0)) { + if (!prepare_for_sys_schedule(0)) { /* * Not allowed to wait in erl_sys_schedule; * do tse wait instead... @@ -3333,8 +3342,13 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) ASSERT(!erts_port_task_have_outstanding_io_tasks()); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); + LTTNG2(scheduler_poll, esdp->no, 0); + erl_sys_schedule(0); + ERTS_MSACC_POP_STATE_M(); + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { ErtsMonotonicTime current_time = erts_get_monotonic_time(esdp); if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) @@ -3404,7 +3418,8 @@ wake_scheduler(ErtsRunQueue *rq) * so all code *should* handle this without having * the lock on the run queue. */ - ERTS_SMP_LC_ASSERT(!erts_smp_lc_runq_is_locked(rq)); + ERTS_SMP_LC_ASSERT(!erts_smp_lc_runq_is_locked(rq) + || ERTS_RUNQ_IX_IS_DIRTY(rq->ix)); ssi = rq->scheduler->ssi; @@ -3729,6 +3744,13 @@ check_requeue_process(ErtsRunQueue *rq, int prio_q) return 0; } +static ERTS_INLINE void +free_proxy_proc(Process *proxy) +{ + ASSERT(erts_smp_atomic32_read_nob(&proxy->state) & ERTS_PSFLG_PROXY); + erts_free(ERTS_ALC_T_PROC, proxy); +} + #ifdef ERTS_SMP static ErtsRunQueue * @@ -3900,24 +3922,33 @@ static ERTS_INLINE void resume_run_queue(ErtsRunQueue *rq) { int pix; + Uint32 oflgs; erts_smp_runq_lock(rq); - (void) ERTS_RUNQ_FLGS_READ_BSET(rq, - (ERTS_RUNQ_FLG_OUT_OF_WORK - | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK - | ERTS_RUNQ_FLG_SUSPENDED), - (ERTS_RUNQ_FLG_OUT_OF_WORK - | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK)); + oflgs = ERTS_RUNQ_FLGS_READ_BSET(rq, + (ERTS_RUNQ_FLG_OUT_OF_WORK + | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK + | ERTS_RUNQ_FLG_SUSPENDED), + (ERTS_RUNQ_FLG_OUT_OF_WORK + | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK)); + + if (oflgs & ERTS_RUNQ_FLG_SUSPENDED) { + erts_aint32_t len; + + rq->check_balance_reds = ERTS_RUNQ_CALL_CHECK_BALANCE_REDS; + for (pix = 0; pix < ERTS_NO_PROC_PRIO_LEVELS; pix++) { + len = erts_smp_atomic32_read_dirty(&rq->procs.prio_info[pix].len); + rq->procs.prio_info[pix].max_len = len; + rq->procs.prio_info[pix].reds = 0; + } + len = erts_smp_atomic32_read_dirty(&rq->ports.info.len); + rq->ports.info.max_len = len; + rq->ports.info.reds = 0; + len = erts_smp_atomic32_read_dirty(&rq->len); + rq->max_len = len; - rq->check_balance_reds = ERTS_RUNQ_CALL_CHECK_BALANCE_REDS; - for (pix = 0; pix < ERTS_NO_PROC_PRIO_LEVELS; pix++) { - rq->procs.prio_info[pix].max_len = 0; - rq->procs.prio_info[pix].reds = 0; } - rq->ports.info.max_len = 0; - rq->ports.info.reds = 0; - rq->max_len = 0; erts_smp_runq_unlock(rq); @@ -4043,9 +4074,6 @@ evacuate_run_queue(ErtsRunQueue *rq, erts_aint32_t state; Process *proc; int notify = 0; -#ifdef ERTS_DIRTY_SCHEDULERS - int requeue; -#endif to_rq = NULL; #ifdef ERTS_DIRTY_SCHEDULERS @@ -4060,49 +4088,94 @@ evacuate_run_queue(ErtsRunQueue *rq, proc = dequeue_process(rq, prio_q, &state); while (proc) { -#ifdef ERTS_DIRTY_SCHEDULERS - requeue = 1; + Process *real_proc; + int prio; + erts_aint32_t max_qbit, qbit, real_state; + + prio = ERTS_PSFLGS_GET_PRQ_PRIO(state); + qbit = ((erts_aint32_t) 1) << prio; + + if (!(state & ERTS_PSFLG_PROXY)) { + real_proc = proc; + real_state = state; + } + else { + real_proc = erts_proc_lookup_raw(proc->common.id); + if (!real_proc) { + free_proxy_proc(proc); + goto handle_next_proc; + } + real_state = erts_smp_atomic32_read_acqb(&real_proc->state); + } + + max_qbit = (state >> ERTS_PSFLGS_IN_PRQ_MASK_OFFSET); + max_qbit &= ERTS_PSFLGS_QMASK; + max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS; + max_qbit &= -max_qbit; + + if (qbit > max_qbit) { + /* Process already queued with higher prio; drop it... */ + if (real_proc != proc) + free_proxy_proc(proc); + else { + erts_aint32_t clr_bits; +#ifdef DEBUG + erts_aint32_t old; #endif - if (ERTS_PSFLG_BOUND & state) { - /* Bound processes get stuck here... */ - proc->next = NULL; - if (sbpp->last) - sbpp->last->next = proc; - else - sbpp->first = proc; - sbpp->last = proc; -#ifdef ERTS_DIRTY_SCHEDULERS - requeue = 0; + + clr_bits = ERTS_PSFLG_IN_RUNQ; + clr_bits |= qbit << ERTS_PSFLGS_IN_PRQ_MASK_OFFSET; + +#ifdef DEBUG + old = +#else + (void) #endif + erts_smp_atomic32_read_band_mb(&proc->state, + ~clr_bits); + ASSERT((old & clr_bits) == clr_bits); + + } + + goto handle_next_proc; } + #ifdef ERTS_DIRTY_SCHEDULERS - else if (state & ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q) { + + if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) { + erts_aint32_t dqbit = qbit; #ifdef DEBUG - erts_aint32_t old = -#else - (void) + erts_aint32_t old_dqbit; #endif - erts_smp_atomic32_read_band_nob(&proc->state, - ~(ERTS_PSFLG_DIRTY_CPU_PROC - | ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q)); - /* assert that no other dirty flags are set */ - ASSERT(!(old & (ERTS_PSFLG_DIRTY_IO_PROC|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q))); - } else if (state & ERTS_PSFLG_DIRTY_IO_PROC_IN_Q) { + + if (rq == ERTS_DIRTY_CPU_RUNQ) + dqbit <<= ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET; + else { + ASSERT(rq == ERTS_DIRTY_IO_RUNQ); + dqbit <<= ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET; + } + #ifdef DEBUG - erts_aint32_t old = + old_dqbit = (int) #else - (void) + (void) #endif - erts_smp_atomic32_read_band_nob(&proc->state, - ~(ERTS_PSFLG_DIRTY_IO_PROC - | ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)); - /* assert that no other dirty flags are set */ - ASSERT(!(old & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q))); + erts_smp_atomic32_read_band_mb(&real_proc->dirty_state, + ~dqbit); + ASSERT(old_dqbit & dqbit); } - if (requeue) { -#else - else { #endif + + if (ERTS_PSFLG_BOUND & real_state) { + /* Bound processes get stuck here... */ + proc->next = NULL; + if (sbpp->last) + sbpp->last->next = proc; + else + sbpp->first = proc; + sbpp->last = proc; + } + else { int prio = (int) ERTS_PSFLGS_GET_PRQ_PRIO(state); erts_smp_runq_unlock(rq); @@ -4125,6 +4198,8 @@ evacuate_run_queue(ErtsRunQueue *rq, erts_smp_runq_lock(rq); } + + handle_next_proc: proc = dequeue_process(rq, prio_q, &state); } if (notify) @@ -5405,17 +5480,11 @@ erts_early_init_scheduling(int no_schedulers) wakeup_other.threshold = ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_MEDIUM; wakeup_other.type = ERTS_SCHED_WAKEUP_OTHER_TYPE_DEFAULT; #endif -#ifndef ERTS_SCHED_MIN_SPIN sched_busy_wait.sys_schedule = ERTS_SCHED_SYS_SLEEP_SPINCOUNT_MEDIUM; sched_busy_wait.tse = (ERTS_SCHED_SYS_SLEEP_SPINCOUNT_MEDIUM * ERTS_SCHED_TSE_SLEEP_SPINCOUNT_FACT); sched_busy_wait.aux_work = (ERTS_SCHED_SYS_SLEEP_SPINCOUNT_MEDIUM * ERTS_SCHED_AUX_WORK_SLEEP_SPINCOUNT_FACT_MEDIUM); -#else - sched_busy_wait.sys_schedule = ERTS_SCHED_SYS_SLEEP_SPINCOUNT_NONE; - sched_busy_wait.tse = ERTS_SCHED_SYS_SLEEP_SPINCOUNT_NONE; - sched_busy_wait.aux_work = ERTS_SCHED_SYS_SLEEP_SPINCOUNT_NONE; -#endif } int @@ -5599,9 +5668,6 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, esdp->f_reg_array = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_BEAM_REGISTER, MAX_REG * sizeof(FloatDef)); -#if !HEAP_ON_C_STACK - esdp->num_tmp_heap_used = 0; -#endif #ifdef ERTS_DIRTY_SCHEDULERS if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) { esdp->no = 0; @@ -5661,6 +5727,9 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online char *daww_ptr; size_t daww_sz; size_t size_runqs; +#ifdef ERTS_SMP + erts_aint32_t set_schdlr_sspnd_change_flags; +#endif init_misc_op_list_alloc(); init_proc_sys_task_queues_alloc(); @@ -5886,10 +5955,8 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online #endif init_misc_aux_work(); -#if !HALFWORD_HEAP init_swtreq_alloc(); init_screq_alloc(); -#endif erts_atomic32_init_nob(&debug_wait_completed_count, 0); /* debug only */ debug_wait_completed_flags = 0; @@ -5900,25 +5967,6 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_DATA, sizeof(ErtsAuxWorkData)); - erts_smp_mtx_init(&schdlr_sspnd.mtx, "schdlr_sspnd"); - erts_smp_cnd_init(&schdlr_sspnd.cnd); - - erts_smp_atomic32_init_nob(&schdlr_sspnd.changing, 0); - schdlr_sspnd.online = no_schedulers_online; - schdlr_sspnd.curr_online = no_schedulers; - schdlr_sspnd.msb.ongoing = 0; - erts_smp_atomic32_init_nob(&schdlr_sspnd.active, no_schedulers); -#ifdef ERTS_DIRTY_SCHEDULERS - erts_smp_atomic32_init_nob(&schdlr_sspnd.dirty_cpu_changing, 0); - schdlr_sspnd.dirty_cpu_online = no_dirty_cpu_schedulers_online; - schdlr_sspnd.dirty_cpu_curr_online = no_dirty_cpu_schedulers; - erts_smp_atomic32_init_nob(&schdlr_sspnd.dirty_cpu_active, no_dirty_cpu_schedulers); - erts_smp_atomic32_init_nob(&schdlr_sspnd.dirty_io_changing, 0); - schdlr_sspnd.dirty_io_online = no_dirty_io_schedulers; - schdlr_sspnd.dirty_io_curr_online = no_dirty_io_schedulers; - erts_smp_atomic32_init_nob(&schdlr_sspnd.dirty_io_active, no_dirty_io_schedulers); -#endif - schdlr_sspnd.msb.procs = NULL; init_no_runqs(no_schedulers_online, no_schedulers_online); balance_info.last_active_runqs = no_schedulers; erts_smp_mtx_init(&balance_info.update_mtx, "migration_info_update"); @@ -5933,32 +5981,66 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online init_migration_paths(); - if (no_schedulers_online < no_schedulers) { + init_scheduler_suspend(); + + set_schdlr_sspnd_change_flags = 0; + + schdlr_sspnd_set_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_NORMAL, + no_schedulers_online); + schdlr_sspnd_set_nscheds(&schdlr_sspnd.curr_online, + ERTS_SCHED_NORMAL, + no_schedulers); + schdlr_sspnd_set_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_NORMAL, + no_schedulers); + + if (no_schedulers_online != no_schedulers) { + ASSERT(no_schedulers_online < no_schedulers); + set_schdlr_sspnd_change_flags |= ERTS_SCHDLR_SSPND_CHNG_ONLN; + schdlr_sspnd.changer = am_init; change_no_used_runqs(no_schedulers_online); for (ix = no_schedulers_online; ix < erts_no_run_queues; ix++) suspend_run_queue(ERTS_RUNQ_IX(ix)); } - schdlr_sspnd.wait_curr_online = no_schedulers_online; - schdlr_sspnd.curr_online *= 2; /* Boot strapping... */ - ERTS_SCHDLR_SSPND_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN - | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); #ifdef ERTS_DIRTY_SCHEDULERS - schdlr_sspnd.dirty_cpu_wait_curr_online = no_dirty_cpu_schedulers_online; - schdlr_sspnd.dirty_cpu_curr_online *= 2; - ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN - | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); - for (ix = no_dirty_cpu_schedulers_online; ix < no_dirty_cpu_schedulers; ix++) { - ErtsSchedulerData* esdp = ERTS_DIRTY_CPU_SCHEDULER_IX(ix); - erts_smp_atomic32_read_bor_nob(&esdp->ssi->flags, ERTS_SSI_FLG_SUSPENDED); + + schdlr_sspnd_set_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_DIRTY_CPU, + no_dirty_cpu_schedulers_online); + schdlr_sspnd_set_nscheds(&schdlr_sspnd.curr_online, + ERTS_SCHED_DIRTY_CPU, + no_dirty_cpu_schedulers); + schdlr_sspnd_set_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_DIRTY_CPU, + no_dirty_cpu_schedulers); + + if (no_dirty_cpu_schedulers_online != no_dirty_cpu_schedulers) { + ASSERT(no_dirty_cpu_schedulers_online < no_dirty_cpu_schedulers); + set_schdlr_sspnd_change_flags |= ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN; + for (ix = no_dirty_cpu_schedulers_online; ix < no_dirty_cpu_schedulers; ix++) { + ErtsSchedulerData* esdp = ERTS_DIRTY_CPU_SCHEDULER_IX(ix); + erts_smp_atomic32_read_bor_nob(&esdp->ssi->flags, ERTS_SSI_FLG_SUSPENDED); + } } - schdlr_sspnd.dirty_io_wait_curr_online = no_dirty_io_schedulers; - schdlr_sspnd.dirty_io_curr_online *= 2; - ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN - | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); + schdlr_sspnd_set_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_DIRTY_IO, + no_dirty_io_schedulers); + schdlr_sspnd_set_nscheds(&schdlr_sspnd.curr_online, + ERTS_SCHED_DIRTY_IO, + no_dirty_io_schedulers); + schdlr_sspnd_set_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_DIRTY_IO, + no_dirty_io_schedulers); + #endif + if (set_schdlr_sspnd_change_flags) + erts_smp_atomic32_set_nob(&schdlr_sspnd.changing, + set_schdlr_sspnd_change_flags); + erts_smp_atomic32_init_nob(&doing_sys_schedule, 0); init_misc_aux_work(); @@ -5973,11 +6055,9 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online #endif } erts_no_schedulers = 1; -#ifdef ERTS_DIRTY_SCHEDULERS erts_no_dirty_cpu_schedulers = 0; erts_no_dirty_io_schedulers = 0; #endif -#endif erts_smp_atomic32_init_nob(&function_calls, 0); @@ -6069,19 +6149,96 @@ make_proxy_proc(Process *prev_proxy, Process *proc, erts_aint32_t prio) return proxy; } -static ERTS_INLINE void -free_proxy_proc(Process *proxy) -{ - ASSERT(erts_smp_atomic32_read_nob(&proxy->state) & ERTS_PSFLG_PROXY); - erts_free(ERTS_ALC_T_PROC, proxy); -} - #define ERTS_ENQUEUE_NOT 0 #define ERTS_ENQUEUE_NORMAL_QUEUE 1 -#ifdef ERTS_DIRTY_SCHEDULERS #define ERTS_ENQUEUE_DIRTY_CPU_QUEUE 2 #define ERTS_ENQUEUE_DIRTY_IO_QUEUE 3 + +#ifdef ERTS_DIRTY_SCHEDULERS + +static int +check_dirty_enqueue_in_prio_queue(Process *c_p, + erts_aint32_t *newp, + erts_aint32_t actual, + erts_aint32_t aprio, + erts_aint32_t qbit) +{ + int queue; + erts_aint32_t dact, max_qbit; + + /* Termination should be done on an ordinary scheduler */ + if (actual & ERTS_PSFLG_EXITING) { + *newp &= ~ERTS_PSFLGS_DIRTY_WORK; + return ERTS_ENQUEUE_NORMAL_QUEUE; + } + + /* + * If we have system tasks, we enqueue on ordinary run-queue + * and take care of those system tasks first. + */ + if (actual & ERTS_PSFLG_ACTIVE_SYS) + return ERTS_ENQUEUE_NORMAL_QUEUE; + + dact = erts_smp_atomic32_read_mb(&c_p->dirty_state); + if (actual & (ERTS_PSFLG_DIRTY_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_CPU_PROC)) { + max_qbit = ((dact >> ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET) + & ERTS_PDSFLGS_QMASK); + queue = ERTS_ENQUEUE_DIRTY_CPU_QUEUE; + } + else { + ASSERT(actual & ERTS_PSFLG_DIRTY_IO_PROC); + max_qbit = ((dact >> ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET) + & ERTS_PDSFLGS_QMASK); + queue = ERTS_ENQUEUE_DIRTY_IO_QUEUE; + } + + max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS; + max_qbit &= -max_qbit; + + if (qbit >= max_qbit) + return ERTS_ENQUEUE_NOT; /* Already queued in higher or equal prio */ + if ((actual & (ERTS_PSFLG_IN_RUNQ|ERTS_PSFLGS_USR_PRIO_MASK)) + != (aprio << ERTS_PSFLGS_USR_PRIO_OFFSET)) { + /* + * Process struct already enqueued, or actual prio not + * equal to user prio, i.e., enqueue using proxy. + */ + return -1*queue; + } + + *newp |= ERTS_PSFLG_IN_RUNQ; + return queue; +} + +static ERTS_INLINE int +fin_dirty_enq_s_change(Process *p, + int pstruct_reserved, + erts_aint32_t enq_prio, + int qmask_offset) +{ + erts_aint32_t qbit = 1 << enq_prio; + qbit <<= qmask_offset; + + if (qbit & erts_smp_atomic32_read_bor_mb(&p->dirty_state, qbit)) { + /* Already enqueue by someone else... */ + if (pstruct_reserved) { + /* We reserved process struct for enqueue; clear it... */ +#ifdef DEBUG + erts_aint32_t old = +#else + (void) #endif + erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_IN_RUNQ); + ASSERT(old & ERTS_PSFLG_IN_RUNQ); + } + return 0; + } + + return !0; +} + +#endif /* ERTS_DIRTY_SCHEDULERS */ static ERTS_INLINE int check_enqueue_in_prio_queue(Process *c_p, @@ -6097,61 +6254,14 @@ check_enqueue_in_prio_queue(Process *c_p, *prq_prio_p = aprio; #ifdef ERTS_DIRTY_SCHEDULERS - if (actual & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) { - /* - * If we have system tasks of a priority higher - * or equal to the user priority, we enqueue - * on ordinary run-queue and take care of - * those system tasks first. - */ - if (actual & ERTS_PSFLG_ACTIVE_SYS) { - erts_aint32_t uprio, stprio, qmask; - uprio = (actual >> ERTS_PSFLGS_USR_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK; - if (aprio < uprio) - goto enqueue_normal_runq; /* system tasks with higher prio */ - erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS); - qmask = c_p->sys_task_qs->qmask; - erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS); - switch (qmask & -qmask) { - case MAX_BIT: - stprio = PRIORITY_MAX; - break; - case HIGH_BIT: - stprio = PRIORITY_HIGH; - break; - case NORMAL_BIT: - stprio = PRIORITY_NORMAL; - break; - case LOW_BIT: - stprio = PRIORITY_LOW; - break; - default: - stprio = PRIORITY_LOW+1; - break; - } - if (stprio <= uprio) - goto enqueue_normal_runq; /* system tasks with higher prio */ - } - - /* Enqueue in dirty run queue if not already enqueued */ - if (actual & (ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)) - return ERTS_ENQUEUE_NOT; /* already in queue */ - if (actual & ERTS_PSFLG_DIRTY_CPU_PROC) { - *newp |= ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q; - if (actual & ERTS_PSFLG_IN_RUNQ) - return -ERTS_ENQUEUE_DIRTY_CPU_QUEUE; /* use proxy */ - *newp |= ERTS_PSFLG_IN_RUNQ; - return ERTS_ENQUEUE_DIRTY_CPU_QUEUE; - } - *newp |= ERTS_PSFLG_DIRTY_IO_PROC_IN_Q; - if (actual & ERTS_PSFLG_IN_RUNQ) - return -ERTS_ENQUEUE_DIRTY_IO_QUEUE; /* use proxy */ - *newp |= ERTS_PSFLG_IN_RUNQ; - return ERTS_ENQUEUE_DIRTY_IO_QUEUE; + if (actual & ERTS_PSFLGS_DIRTY_WORK) { + int res = check_dirty_enqueue_in_prio_queue(c_p, newp, actual, + aprio, qbit); + if (res != ERTS_ENQUEUE_NORMAL_QUEUE) + return res; } - - enqueue_normal_runq: #endif + max_qbit = (actual >> ERTS_PSFLGS_IN_PRQ_MASK_OFFSET) & ERTS_PSFLGS_QMASK; max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS; max_qbit &= -max_qbit; @@ -6183,6 +6293,65 @@ check_enqueue_in_prio_queue(Process *c_p, return ERTS_ENQUEUE_NORMAL_QUEUE; } +static ERTS_INLINE ErtsRunQueue * +select_enqueue_run_queue(int enqueue, int enq_prio, Process *p, erts_aint32_t state) +{ + + switch (enqueue) { + + case ERTS_ENQUEUE_NOT: + + return NULL; + +#ifdef ERTS_DIRTY_SCHEDULERS + + case ERTS_ENQUEUE_DIRTY_CPU_QUEUE: + case -ERTS_ENQUEUE_DIRTY_CPU_QUEUE: + + if (fin_dirty_enq_s_change(p, enqueue > 0, enq_prio, + ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET)) + return ERTS_DIRTY_CPU_RUNQ; + + return NULL; + + + case ERTS_ENQUEUE_DIRTY_IO_QUEUE: + case -ERTS_ENQUEUE_DIRTY_IO_QUEUE: + + if (fin_dirty_enq_s_change(p, enqueue > 0, enq_prio, + ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET)) + return ERTS_DIRTY_IO_RUNQ; + + return NULL; + +#endif + + default: { + ErtsRunQueue* runq; + + ASSERT(enqueue == ERTS_ENQUEUE_NORMAL_QUEUE + || enqueue == -ERTS_ENQUEUE_NORMAL_QUEUE); + + runq = erts_get_runq_proc(p); + +#ifdef ERTS_SMP + if (!(ERTS_PSFLG_BOUND & state)) { + ErtsRunQueue *new_runq = erts_check_emigration_need(runq, enq_prio); + if (new_runq) { + RUNQ_SET_RQ(&p->run_queue, new_runq); + runq = new_runq; + } + } +#endif + + ASSERT(runq); + + return runq; + } + } +} + + /* * schedule_out_process() return with c_rq locked. */ @@ -6191,11 +6360,7 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces { erts_aint32_t a, e, n, enq_prio = -1; int enqueue; /* < 0 -> use proxy */ - Process* sched_p; ErtsRunQueue* runq; -#ifdef ERTS_SMP - int check_emigration_need; -#endif a = state; @@ -6207,7 +6372,7 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces enqueue = ERTS_ENQUEUE_NOT; n &= ~(ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS); - if (a & ERTS_PSFLG_ACTIVE_SYS + if (a & (ERTS_PSFLG_ACTIVE_SYS|ERTS_PSFLG_DIRTY_ACTIVE_SYS) || (a & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_SUSPENDED)) == ERTS_PSFLG_ACTIVE) { enqueue = check_enqueue_in_prio_queue(p, &enq_prio, &n, a); } @@ -6216,16 +6381,17 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces break; } - switch (enqueue) { - case ERTS_ENQUEUE_NOT: + runq = select_enqueue_run_queue(enqueue, enq_prio, p, n); + + if (!runq) { + if (erts_system_profile_flags.runnable_procs) { /* Status lock prevents out of order "runnable proc" trace msgs */ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); - if (!(a & ERTS_PSFLG_ACTIVE_SYS) - && (!(a & ERTS_PSFLG_ACTIVE) - || (a & ERTS_PSFLG_SUSPENDED))) { + if (!(a & (ERTS_PSFLG_ACTIVE_SYS|ERTS_PSFLG_DIRTY_ACTIVE_SYS)) + && (!(a & ERTS_PSFLG_ACTIVE) || (a & ERTS_PSFLG_SUSPENDED))) { /* Process inactive */ profile_runnable_proc(p, am_inactive); } @@ -6238,98 +6404,76 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces return 0; -#ifdef ERTS_DIRTY_SCHEDULERS -#ifdef ERTS_SMP - case ERTS_ENQUEUE_DIRTY_CPU_QUEUE: - case -ERTS_ENQUEUE_DIRTY_CPU_QUEUE: - runq = ERTS_DIRTY_CPU_RUNQ; - ASSERT(ERTS_SCHEDULER_IS_DIRTY_CPU(runq->scheduler)); -#ifdef ERTS_SMP - check_emigration_need = 0; -#endif - break; + } + else { + Process* sched_p; - case ERTS_ENQUEUE_DIRTY_IO_QUEUE: - case -ERTS_ENQUEUE_DIRTY_IO_QUEUE: - runq = ERTS_DIRTY_IO_RUNQ; - ASSERT(ERTS_SCHEDULER_IS_DIRTY_IO(runq->scheduler)); -#ifdef ERTS_SMP - check_emigration_need = 0; -#endif - break; -#endif -#endif + ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & (ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_ACTIVE_SYS))); - default: - ASSERT(enqueue == ERTS_ENQUEUE_NORMAL_QUEUE - || enqueue == -ERTS_ENQUEUE_NORMAL_QUEUE); + if (enqueue < 0) + sched_p = make_proxy_proc(proxy, p, enq_prio); + else { + sched_p = p; + if (proxy) + free_proxy_proc(proxy); + } - runq = erts_get_runq_proc(p); -#ifdef ERTS_SMP - check_emigration_need = !(ERTS_PSFLG_BOUND & n); -#endif - break; - } + ASSERT(runq); - ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & ERTS_PSFLG_ACTIVE_SYS)); + erts_smp_runq_lock(runq); - if (enqueue < 0) - sched_p = make_proxy_proc(proxy, p, enq_prio); - else { - sched_p = p; - if (proxy) - free_proxy_proc(proxy); - } + /* Enqueue the process */ + enqueue_process(runq, (int) enq_prio, sched_p); -#ifdef ERTS_SMP - if (check_emigration_need) { - ErtsRunQueue *new_runq = erts_check_emigration_need(runq, enq_prio); - if (new_runq) { - RUNQ_SET_RQ(&sched_p->run_queue, new_runq); - runq = new_runq; - } - } -#endif + if (runq == c_rq) + return 1; - ASSERT(runq); + erts_smp_runq_unlock(runq); - erts_smp_runq_lock(runq); + smp_notify_inc_runq(runq); - /* Enqueue the process */ - enqueue_process(runq, (int) enq_prio, sched_p); + erts_smp_runq_lock(c_rq); - if (runq == c_rq) return 1; - erts_smp_runq_unlock(runq); - smp_notify_inc_runq(runq); - erts_smp_runq_lock(c_rq); - return 1; + } + } static ERTS_INLINE void -add2runq(Process *p, erts_aint32_t state, erts_aint32_t prio) +add2runq(int enqueue, erts_aint32_t prio, + Process *proc, erts_aint32_t state, + Process **proxy) { - ErtsRunQueue *runq = erts_get_runq_proc(p); + ErtsRunQueue *runq; -#ifdef ERTS_SMP - if (!(ERTS_PSFLG_BOUND & state)) { - ErtsRunQueue *new_runq = erts_check_emigration_need(runq, (int) prio); - if (new_runq) { - RUNQ_SET_RQ(&p->run_queue, new_runq); - runq = new_runq; - } - } -#endif - ASSERT(runq); + runq = select_enqueue_run_queue(enqueue, prio, proc, state); - erts_smp_runq_lock(runq); + if (runq) { + Process *sched_p; - /* Enqueue the process */ - enqueue_process(runq, (int) prio, p); + if (enqueue > 0) + sched_p = proc; + else { + Process *pxy; - erts_smp_runq_unlock(runq); - smp_notify_inc_runq(runq); + if (!proxy) + pxy = NULL; + else { + pxy = *proxy; + *proxy = NULL; + } + sched_p = make_proxy_proc(pxy, proc, prio); + } + + erts_smp_runq_lock(runq); + + /* Enqueue the process */ + enqueue_process(runq, (int) prio, sched_p); + erts_smp_runq_unlock(runq); + smp_notify_inc_runq(runq); + } } static ERTS_INLINE int @@ -6435,10 +6579,7 @@ schedule_process(Process *p, erts_aint32_t in_state, ErtsProcLocks locks) &state, &enq_prio, locks); - if (enqueue != ERTS_ENQUEUE_NOT) - add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), - state, - enq_prio); + add2runq(enqueue, enq_prio, p, state, NULL); } void @@ -6447,22 +6588,99 @@ erts_schedule_process(Process *p, erts_aint32_t state, ErtsProcLocks locks) schedule_process(p, state, locks); } -static void -schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) +static int +schedule_process_sys_task(Process *p, erts_aint32_t prio, ErtsProcSysTask *st) { - /* - * Expects status lock to be locked when called, and - * returns with status lock unlocked... - */ - erts_aint32_t a = state, n, enq_prio = -1; + int res; + int locked; + ErtsProcSysTaskQs *stqs, *free_stqs; + erts_aint32_t state, a, n, enq_prio; int enqueue; /* < 0 -> use proxy */ - unsigned int prof_runnable_procs = erts_system_profile_flags.runnable_procs; + unsigned int prof_runnable_procs; + + res = 1; /* prepare for success */ + st->next = st->prev = st; /* Prep for empty prio queue */ + state = erts_smp_atomic32_read_nob(&p->state); + prof_runnable_procs = erts_system_profile_flags.runnable_procs; + locked = 0; + free_stqs = NULL; + if (state & ERTS_PSFLG_ACTIVE_SYS) + stqs = NULL; + else { + alloc_qs: + stqs = proc_sys_task_queues_alloc(); + stqs->qmask = 1 << prio; + stqs->ncount = 0; + stqs->q[PRIORITY_MAX] = NULL; + stqs->q[PRIORITY_HIGH] = NULL; + stqs->q[PRIORITY_NORMAL] = NULL; + stqs->q[PRIORITY_LOW] = NULL; + stqs->q[prio] = st; + } + + if (!locked) { + locked = 1; + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + + state = erts_smp_atomic32_read_nob(&p->state); + if (state & ERTS_PSFLG_EXITING) { + free_stqs = stqs; + res = 0; + goto cleanup; + } + } + + if (!p->sys_task_qs) { + if (stqs) + p->sys_task_qs = stqs; + else + goto alloc_qs; + } + else { + free_stqs = stqs; + stqs = p->sys_task_qs; + if (!stqs->q[prio]) { + stqs->q[prio] = st; + stqs->qmask |= 1 << prio; + } + else { + st->next = stqs->q[prio]; + st->prev = stqs->q[prio]->prev; + st->next->prev = st; + st->prev->next = st; + ASSERT(stqs->qmask & (1 << prio)); + } + } + + if (ERTS_PSFLGS_GET_ACT_PRIO(state) > prio) { + erts_aint32_t n, a, e; + /* Need to elevate actual prio */ + + a = state; + do { + if (ERTS_PSFLGS_GET_ACT_PRIO(a) <= prio) { + n = a; + break; + } + n = e = a; + n &= ~ERTS_PSFLGS_ACT_PRIO_MASK; + n |= (prio << ERTS_PSFLGS_ACT_PRIO_OFFSET); + a = erts_smp_atomic32_cmpxchg_nob(&p->state, n, e); + } while (a != e); + state = n; + } + + + a = state; + enq_prio = -1; /* Status lock prevents out of order "runnable proc" trace msgs */ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); - if (!prof_runnable_procs) + if (!prof_runnable_procs) { erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + locked = 0; + } ASSERT(!(state & ERTS_PSFLG_PROXY)); @@ -6470,8 +6688,10 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) erts_aint32_t e; n = e = a; - if (a & ERTS_PSFLG_FREE) + if (a & ERTS_PSFLG_FREE) { + res = 0; goto cleanup; /* We don't want to schedule free processes... */ + } enqueue = ERTS_ENQUEUE_NOT; n |= ERTS_PSFLG_ACTIVE_SYS; @@ -6495,29 +6715,22 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) } erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - prof_runnable_procs = 0; + locked = 0; } - if (enqueue != ERTS_ENQUEUE_NOT) { - Process *sched_p; - if (enqueue > 0) - sched_p = p; - else { - sched_p = make_proxy_proc(proxy, p, enq_prio); - proxy = NULL; - } - add2runq(sched_p, n, enq_prio); - } + add2runq(enqueue, enq_prio, p, n, NULL); cleanup: - if (prof_runnable_procs) + if (locked) erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - if (proxy) - free_proxy_proc(proxy); + if (free_stqs) + proc_sys_task_queues_free(free_stqs); ERTS_SMP_LC_ASSERT(!(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p))); + + return res; } static ERTS_INLINE int @@ -6600,23 +6813,7 @@ resume_process(Process *p, ErtsProcLocks locks) &state, &enq_prio, locks); - if (enqueue) - add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), - state, - enq_prio); -} - -int -erts_get_max_no_executing_schedulers(void) -{ -#ifdef ERTS_SMP - if (erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)) - return (int) erts_no_schedulers; - ERTS_THR_MEMORY_BARRIER; - return (int) erts_smp_atomic32_read_nob(&schdlr_sspnd.active); -#else - return 1; -#endif + add2runq(enqueue, enq_prio, p, state, NULL); } #ifdef ERTS_SMP @@ -6721,42 +6918,82 @@ sched_set_suspended_sleeptype(ErtsSchedulerSleepInfo *ssi) } } -#ifdef ERTS_DIRTY_SCHEDULERS +static void +init_scheduler_suspend(void) +{ + erts_smp_mtx_init(&schdlr_sspnd.mtx, "schdlr_sspnd"); + schdlr_sspnd.online = ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0); + schdlr_sspnd.curr_online = ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0); + schdlr_sspnd.active = ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0); + erts_smp_atomic32_init_nob(&schdlr_sspnd.changing, 0); + schdlr_sspnd.chngq = NULL; + schdlr_sspnd.changer = am_false; + schdlr_sspnd.nmsb.ongoing = 0; + schdlr_sspnd.nmsb.blckrs = NULL; + schdlr_sspnd.nmsb.chngq = NULL; + schdlr_sspnd.msb.ongoing = 0; + schdlr_sspnd.msb.blckrs = NULL; + schdlr_sspnd.msb.chngq = NULL; +} + +typedef struct { + struct { + Eterm chngr; + Eterm nxt; + } onln; + struct { + ErtsProcList *chngrs; + } msb; +} ErtsSchdlrSspndResume; + +static void +schdlr_sspnd_resume_proc(Eterm pid) +{ + Process *p = erts_pid2proc(NULL, 0, pid, ERTS_PROC_LOCK_STATUS); + if (p) { + resume_process(p, ERTS_PROC_LOCK_STATUS); + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + } +} + +static ERTS_INLINE void +schdlr_sspnd_resume_procs(ErtsSchedType sched_type, + ErtsSchdlrSspndResume *resume) +{ + if (is_internal_pid(resume->onln.chngr)) { + schdlr_sspnd_resume_proc(resume->onln.chngr); + resume->onln.chngr = NIL; + } + if (is_internal_pid(resume->onln.nxt)) { + schdlr_sspnd_resume_proc(resume->onln.nxt); + resume->onln.nxt = NIL; + } + while (resume->msb.chngrs) { + ErtsProcList *plp = resume->msb.chngrs; + resume->msb.chngrs = plp->next; + schdlr_sspnd_resume_proc(plp->pid); + proclist_destroy(plp); + } +} static void suspend_scheduler(ErtsSchedulerData *esdp) { erts_aint32_t flgs; erts_aint32_t changing; -#ifdef ERTS_DIRTY_SCHEDULERS - long no = (long) (ERTS_SCHEDULER_IS_DIRTY(esdp) - ? ERTS_DIRTY_SCHEDULER_NO(esdp) - : esdp->no); -#else - long no = (long) esdp->no; -#endif + long no; ErtsSchedulerSleepInfo *ssi = esdp->ssi; - long active_schedulers; int curr_online = 1; - int wake = 0; + ErtsSchdlrSspndResume resume = {{NIL, NIL}, {NULL}}; erts_aint32_t aux_work; int thr_prgr_active = 1; ErtsStuckBoundProcesses sbp = {NULL, NULL}; - int* ss_onlinep; - int* ss_curr_onlinep; - int* ss_wait_curr_onlinep; - long* ss_wait_activep; - long ss_wait_active_target; - erts_smp_atomic32_t* ss_changingp; - erts_smp_atomic32_t* ss_activep; + ErtsSchedType sched_type; + erts_aint32_t online_flag; /* * Schedulers may be suspended in two different ways: * - A scheduler may be suspended since it is not online. - * All schedulers with scheduler ids greater than - * schdlr_sspnd.online are suspended; same for dirty - * schedulers and schdlr_sspnd.dirty_cpu_online and - * schdlr_sspnd.dirty_io_online. * - Multi scheduling is blocked. All schedulers except the * scheduler with scheduler id 1 are suspended, and all * dirty CPU and dirty I/O schedulers are suspended. @@ -6764,27 +7001,43 @@ suspend_scheduler(ErtsSchedulerData *esdp) * Regardless of why a scheduler is suspended, it ends up here. */ - ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp) || no != 1); - #ifdef ERTS_DIRTY_SCHEDULERS if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { + no = ERTS_DIRTY_SCHEDULER_NO(esdp); + if (ERTS_RUNQ_IS_DIRTY_CPU_RUNQ(esdp->run_queue)) { + online_flag = ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN; + sched_type = ERTS_SCHED_DIRTY_CPU; + } + else { + online_flag = 0; + sched_type = ERTS_SCHED_DIRTY_IO; + } + } + else +#endif + { + online_flag = ERTS_SCHDLR_SSPND_CHNG_ONLN; + no = esdp->no; + sched_type = ERTS_SCHED_NORMAL; + } + + ASSERT(sched_type != ERTS_SCHED_NORMAL || no != 1); + + if (sched_type != ERTS_SCHED_NORMAL) { if (erts_smp_mtx_trylock(&schdlr_sspnd.mtx) == EBUSY) { erts_smp_runq_unlock(esdp->run_queue); erts_smp_mtx_lock(&schdlr_sspnd.mtx); erts_smp_runq_lock(esdp->run_queue); } - if (ongoing_multi_scheduling_block()) + if (schdlr_sspnd.msb.ongoing) evacuate_run_queue(esdp->run_queue, &sbp); - } else -#endif + erts_smp_runq_unlock(esdp->run_queue); + } + else { evacuate_run_queue(esdp->run_queue, &sbp); - erts_smp_runq_unlock(esdp->run_queue); + erts_smp_runq_unlock(esdp->run_queue); -#ifdef ERTS_DIRTY_SCHEDULERS - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) -#endif - { erts_sched_check_cpu_bind_prep_suspend(esdp); if (erts_system_profile_flags.scheduler) @@ -6798,318 +7051,115 @@ suspend_scheduler(ErtsSchedulerData *esdp) flgs = sched_prep_spin_suspended(ssi, ERTS_SSI_FLG_SUSPENDED); if (flgs & ERTS_SSI_FLG_SUSPENDED) { -#ifdef ERTS_DIRTY_SCHEDULERS - if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { - if (ERTS_RUNQ_IS_DIRTY_CPU_RUNQ(esdp->run_queue)) { - active_schedulers = erts_smp_atomic32_dec_read_nob(&schdlr_sspnd.dirty_cpu_active); - ASSERT(active_schedulers >= 0); - changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_changing); - ss_onlinep = &schdlr_sspnd.dirty_cpu_online; - ss_curr_onlinep = &schdlr_sspnd.dirty_cpu_curr_online; - ss_wait_curr_onlinep = &schdlr_sspnd.dirty_cpu_wait_curr_online; - ss_changingp = &schdlr_sspnd.dirty_cpu_changing; - ss_wait_activep = &schdlr_sspnd.msb.dirty_cpu_wait_active; - ss_activep = &schdlr_sspnd.dirty_cpu_active; - } else { - active_schedulers = erts_smp_atomic32_dec_read_nob(&schdlr_sspnd.dirty_io_active); - ASSERT(active_schedulers >= 0); - changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_changing); - ss_onlinep = &schdlr_sspnd.dirty_io_online; - ss_curr_onlinep = &schdlr_sspnd.dirty_io_curr_online; - ss_wait_curr_onlinep = &schdlr_sspnd.dirty_io_wait_curr_online; - ss_changingp = &schdlr_sspnd.dirty_io_changing; - ss_wait_activep = &schdlr_sspnd.msb.dirty_io_wait_active; - ss_activep = &schdlr_sspnd.dirty_io_active; - } - ss_wait_active_target = 0; - } - else -#endif - { - active_schedulers = erts_smp_atomic32_dec_read_nob(&schdlr_sspnd.active); - ASSERT(active_schedulers >= 1); - changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); - ss_onlinep = &schdlr_sspnd.online; - ss_curr_onlinep = &schdlr_sspnd.curr_online; - ss_wait_curr_onlinep = &schdlr_sspnd.wait_curr_online; - ss_changingp = &schdlr_sspnd.changing; - ss_wait_activep = &schdlr_sspnd.msb.wait_active; - ss_activep = &schdlr_sspnd.active; - ss_wait_active_target = 1; - } - if (changing & ERTS_SCHDLR_SSPND_CHNG_MSB) { - if (active_schedulers == *ss_wait_activep) - wake = 1; - if (active_schedulers == ss_wait_active_target) { - changing = erts_smp_atomic32_read_band_nob(ss_changingp, - ~ERTS_SCHDLR_SSPND_CHNG_MSB); - changing &= ~ERTS_SCHDLR_SSPND_CHNG_MSB; - } - } - - while (1) { - if (changing & ERTS_SCHDLR_SSPND_CHNG_ONLN) { - int changed = 0; - if (no > *ss_onlinep && curr_online) { - (*ss_curr_onlinep)--; - curr_online = 0; - changed = 1; - } - else if (no <= *ss_onlinep && !curr_online) { - (*ss_curr_onlinep)++; - curr_online = 1; - changed = 1; - } - if (changed - && *ss_curr_onlinep == *ss_wait_curr_onlinep) - wake = 1; - if (*ss_onlinep == *ss_curr_onlinep) { - changing = erts_smp_atomic32_read_band_nob(ss_changingp, - ~ERTS_SCHDLR_SSPND_CHNG_ONLN); - changing &= ~ERTS_SCHDLR_SSPND_CHNG_ONLN; - } - } - - if (wake) { - erts_smp_cnd_signal(&schdlr_sspnd.cnd); - wake = 0; - } + schdlr_sspnd_dec_nscheds(&schdlr_sspnd.active, sched_type); - if (curr_online && !ongoing_multi_scheduling_block()) { - flgs = erts_smp_atomic32_read_acqb(&ssi->flags); - if (!(flgs & ERTS_SSI_FLG_SUSPENDED)) - break; - } - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + ASSERT(schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_NORMAL) >= 1); - while (1) { - erts_aint32_t qmask; - erts_aint32_t flgs; + changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); - qmask = (ERTS_RUNQ_FLGS_GET(esdp->run_queue) - & ERTS_RUNQ_FLGS_QMASK); - aux_work = erts_atomic32_read_acqb(&ssi->aux_work); - if (aux_work|qmask) { - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { - if (!thr_prgr_active) { - erts_thr_progress_active(esdp, thr_prgr_active = 1); - sched_wall_time_change(esdp, 1); - } - if (aux_work) - aux_work = handle_aux_work(&esdp->aux_work_data, - aux_work, - 1); + while (1) { - if (aux_work && erts_thr_progress_update(esdp)) - erts_thr_progress_leader_update(esdp); + if (changing & (ERTS_SCHDLR_SSPND_CHNG_NMSB + | ERTS_SCHDLR_SSPND_CHNG_MSB)) { + int i = 0; + ErtsMultiSchedulingBlock *msb[3] = {0}; + if (changing & ERTS_SCHDLR_SSPND_CHNG_NMSB) + msb[i++] = &schdlr_sspnd.nmsb; + if (changing & ERTS_SCHDLR_SSPND_CHNG_MSB) + msb[i++] = &schdlr_sspnd.msb; + + for (i = 0; msb[i]; i++) { + erts_aint32_t clr_flg = 0; + + if (msb[i] == &schdlr_sspnd.nmsb + && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_NORMAL) == 1) { + clr_flg = ERTS_SCHDLR_SSPND_CHNG_NMSB; } - if (qmask) { -#ifdef ERTS_DIRTY_SCHEDULERS - if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - erts_smp_runq_lock(esdp->run_queue); - if (ongoing_multi_scheduling_block()) - evacuate_run_queue(esdp->run_queue, &sbp); - erts_smp_runq_unlock(esdp->run_queue); - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - } else -#endif - { - erts_smp_runq_lock(esdp->run_queue); - evacuate_run_queue(esdp->run_queue, &sbp); - erts_smp_runq_unlock(esdp->run_queue); - } + else if (schdlr_sspnd.active + == ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0)) { + clr_flg = ERTS_SCHDLR_SSPND_CHNG_MSB; } - } - if (!aux_work) { -#ifdef ERTS_DIRTY_SCHEDULERS - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) -#endif - { - if (thr_prgr_active) { - erts_thr_progress_active(esdp, thr_prgr_active = 0); - sched_wall_time_change(esdp, 0); + if (clr_flg) { + ErtsProcList *plp, *end_plp; + changing = erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, + ~clr_flg); + changing &= ~clr_flg; + (void) erts_proclist_fetch(&msb[i]->chngq, &end_plp); + /* resume processes that initiated the multi scheduling block... */ + plp = msb[i]->chngq; + while (plp) { + erts_proclist_store_last(&msb[i]->blckrs, + proclist_copy(plp)); + plp = plp->next; } - erts_thr_progress_prepare_wait(esdp); + if (end_plp) + end_plp->next = resume.msb.chngrs; + resume.msb.chngrs = msb[i]->chngq; + msb[i]->chngq = NULL; } - 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); - 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_twait(ssi->event, -1); - } while (res == EINTR); - } - } -#ifdef ERTS_DIRTY_SCHEDULERS - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) -#endif - erts_thr_progress_finalize_wait(esdp); } - - flgs = sched_prep_spin_suspended(ssi, (ERTS_SSI_FLG_WAITING - | ERTS_SSI_FLG_SUSPENDED)); - if (!(flgs & ERTS_SSI_FLG_SUSPENDED)) - break; - changing = erts_smp_atomic32_read_nob(ss_changingp); - if (changing & ~ERTS_SCHDLR_SSPND_CHNG_WAITER) - break; } - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - changing = erts_smp_atomic32_read_nob(ss_changingp); - } - - active_schedulers = erts_smp_atomic32_inc_read_nob(ss_activep); - changing = erts_smp_atomic32_read_nob(ss_changingp); - if ((changing & ERTS_SCHDLR_SSPND_CHNG_MSB) - && *ss_onlinep == active_schedulers) { - erts_smp_atomic32_read_band_nob(ss_changingp, - ~ERTS_SCHDLR_SSPND_CHNG_MSB); - } - -#ifdef ERTS_DIRTY_SCHEDULERS - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) -#endif - ASSERT(no <= *ss_onlinep); - ASSERT(!ongoing_multi_scheduling_block()); - - } - - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - - ASSERT(curr_online); - -#ifdef ERTS_DIRTY_SCHEDULERS - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) -#endif - { - if (erts_system_profile_flags.scheduler) - profile_scheduler(make_small(esdp->no), am_active); - - if (!thr_prgr_active) { - erts_thr_progress_active(esdp, thr_prgr_active = 1); - sched_wall_time_change(esdp, 1); - } - } - - 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); - -#ifdef ERTS_DIRTY_SCHEDULERS - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) -#endif - { - schedule_bound_processes(esdp->run_queue, &sbp); - - erts_sched_check_cpu_bind_post_suspend(esdp); - } -} - -#else /* !ERTS_DIRTY_SCHEDULERS */ - -static void -suspend_scheduler(ErtsSchedulerData *esdp) -{ - erts_aint32_t flgs; - erts_aint32_t changing; - long no = (long) esdp->no; - ErtsSchedulerSleepInfo *ssi = esdp->ssi; - long active_schedulers; - int curr_online = 1; - int wake = 0; - erts_aint32_t aux_work; - int thr_prgr_active = 1; - ErtsStuckBoundProcesses sbp = {NULL, NULL}; - - /* - * Schedulers may be suspended in two different ways: - * - A scheduler may be suspended since it is not online. - * All schedulers with scheduler ids greater than - * schdlr_sspnd.online are suspended. - * - Multi scheduling is blocked. All schedulers except the - * scheduler with scheduler id 1 are suspended. - * - * Regardless of why a scheduler is suspended, it ends up here. - */ - - ASSERT(no != 1); - - evacuate_run_queue(esdp->run_queue, &sbp); - - erts_smp_runq_unlock(esdp->run_queue); - - erts_sched_check_cpu_bind_prep_suspend(esdp); - - if (erts_system_profile_flags.scheduler) - profile_scheduler(make_small(esdp->no), am_inactive); - - sched_wall_time_change(esdp, 0); - - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - - flgs = sched_prep_spin_suspended(ssi, ERTS_SSI_FLG_SUSPENDED); - if (flgs & ERTS_SSI_FLG_SUSPENDED) { - - active_schedulers = erts_smp_atomic32_dec_read_nob(&schdlr_sspnd.active); - ASSERT(active_schedulers >= 1); - changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); - if (changing & ERTS_SCHDLR_SSPND_CHNG_MSB) { - if (active_schedulers == schdlr_sspnd.msb.wait_active) - wake = 1; - if (active_schedulers == 1) { - changing = erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, - ~ERTS_SCHDLR_SSPND_CHNG_MSB); - changing &= ~ERTS_SCHDLR_SSPND_CHNG_MSB; - } - } - - while (1) { - if (changing & ERTS_SCHDLR_SSPND_CHNG_ONLN) { + if (changing & online_flag) { int changed = 0; - if (no > schdlr_sspnd.online && curr_online) { - schdlr_sspnd.curr_online--; + Uint32 st_online; + + st_online = schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, + sched_type); + if (no > st_online && curr_online) { + schdlr_sspnd_dec_nscheds(&schdlr_sspnd.curr_online, + sched_type); curr_online = 0; changed = 1; } - else if (no <= schdlr_sspnd.online && !curr_online) { - schdlr_sspnd.curr_online++; + else if (no <= st_online && !curr_online) { + schdlr_sspnd_inc_nscheds(&schdlr_sspnd.curr_online, + sched_type); curr_online = 1; changed = 1; } if (changed - && schdlr_sspnd.curr_online == schdlr_sspnd.wait_curr_online) - wake = 1; - if (schdlr_sspnd.online == schdlr_sspnd.curr_online) { + && (schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, + sched_type) + == schdlr_sspnd_get_nscheds(&schdlr_sspnd.curr_online, + sched_type))) { + ErtsProcList *plp; changing = erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, - ~ERTS_SCHDLR_SSPND_CHNG_ONLN); - changing &= ~ERTS_SCHDLR_SSPND_CHNG_ONLN; + ~online_flag); + changing &= ~online_flag; + if (sched_type == ERTS_SCHED_NORMAL) { + ASSERT(is_internal_pid(schdlr_sspnd.changer) + || schdlr_sspnd.changer == am_init); + /* resume process that initiated this change... */ + resume.onln.chngr = schdlr_sspnd.changer; + plp = erts_proclist_peek_first(schdlr_sspnd.chngq); + if (!plp) + schdlr_sspnd.changer = am_false; + else { + schdlr_sspnd.changer = am_true; /* change right in transit */ + /* resume process that is queued for next change... */ + resume.onln.nxt = plp->pid; + ASSERT(is_internal_pid(resume.onln.nxt)); + } + } } } - if (wake) { - erts_smp_cnd_signal(&schdlr_sspnd.cnd); - wake = 0; - } - - if (curr_online && !ongoing_multi_scheduling_block()) { + if (curr_online + && (sched_type == ERTS_SCHED_NORMAL + ? !(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing) + : !schdlr_sspnd.msb.ongoing)) { flgs = erts_smp_atomic32_read_acqb(&ssi->flags); if (!(flgs & ERTS_SSI_FLG_SUSPENDED)) break; } erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + schdlr_sspnd_resume_procs(sched_type, &resume); + while (1) { ErtsMonotonicTime current_time; erts_aint32_t qmask; @@ -7117,9 +7167,23 @@ suspend_scheduler(ErtsSchedulerData *esdp) qmask = (ERTS_RUNQ_FLGS_GET(esdp->run_queue) & ERTS_RUNQ_FLGS_QMASK); - aux_work = erts_atomic32_read_acqb(&ssi->aux_work); - if (aux_work|qmask) { - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + + if (sched_type != ERTS_SCHED_NORMAL) { + if (qmask) { + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + erts_smp_runq_lock(esdp->run_queue); + if (schdlr_sspnd.msb.ongoing) + evacuate_run_queue(esdp->run_queue, &sbp); + erts_smp_runq_unlock(esdp->run_queue); + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + } + aux_work = 0; + } + else { + + aux_work = erts_atomic32_read_acqb(&ssi->aux_work); + + if (aux_work|qmask) { if (!thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 1); sched_wall_time_change(esdp, 1); @@ -7128,45 +7192,53 @@ suspend_scheduler(ErtsSchedulerData *esdp) aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1); + if (aux_work && erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); + if (qmask) { + erts_smp_runq_lock(esdp->run_queue); + evacuate_run_queue(esdp->run_queue, &sbp); + erts_smp_runq_unlock(esdp->run_queue); + } } - if (qmask) { - erts_smp_runq_lock(esdp->run_queue); - evacuate_run_queue(esdp->run_queue, &sbp); - erts_smp_runq_unlock(esdp->run_queue); - } + } 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); + ASSERT(sched_type == ERTS_SCHED_NORMAL); + 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)) { + int do_timeout; + + if (sched_type == ERTS_SCHED_NORMAL) { timeout_time = erts_check_next_timeout_time(esdp); current_time = erts_get_monotonic_time(esdp); do_timeout = (current_time >= timeout_time); - } else + } + else { timeout_time = ERTS_MONOTONIC_TIME_MAX; + current_time = 0; + do_timeout = 0; + } + if (do_timeout) { + ASSERT(sched_type == ERTS_SCHED_NORMAL); 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 (sched_type == ERTS_SCHED_NORMAL) { if (thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 0); sched_wall_time_change(esdp, 0); @@ -7185,30 +7257,39 @@ suspend_scheduler(ErtsSchedulerData *esdp) | ERTS_SSI_FLG_SUSPENDED)) { int res; - current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 : - erts_get_monotonic_time(esdp); + if (sched_type == ERTS_SCHED_NORMAL) + current_time = erts_get_monotonic_time(esdp); + else + current_time = 0; + do { Sint64 timeout; if (current_time >= timeout_time) break; - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + if (sched_type != ERTS_SCHED_NORMAL) + timeout = -1; + else 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); + + if (sched_type == ERTS_SCHED_NORMAL) + current_time = erts_get_monotonic_time(esdp); + else + current_time = 0; + } while (res == EINTR); } } - if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) + if (sched_type == ERTS_SCHED_NORMAL) erts_thr_progress_finalize_wait(esdp); } - if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && current_time >= timeout_time) + if (current_time >= timeout_time) { + ASSERT(sched_type == ERTS_SCHED_NORMAL); erts_bump_timers(esdp->timer_wheel, current_time); + } } flgs = sched_prep_spin_suspended(ssi, (ERTS_SSI_FLG_WAITING @@ -7216,7 +7297,7 @@ suspend_scheduler(ErtsSchedulerData *esdp) if (!(flgs & ERTS_SSI_FLG_SUSPENDED)) break; changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); - if (changing & ~ERTS_SCHDLR_SSPND_CHNG_WAITER) + if (changing) break; } @@ -7224,612 +7305,494 @@ suspend_scheduler(ErtsSchedulerData *esdp) changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); } - active_schedulers = erts_smp_atomic32_inc_read_nob(&schdlr_sspnd.active); + schdlr_sspnd_inc_nscheds(&schdlr_sspnd.active, sched_type); changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); if ((changing & ERTS_SCHDLR_SSPND_CHNG_MSB) - && schdlr_sspnd.online == active_schedulers) { + && schdlr_sspnd.online == schdlr_sspnd.active) { erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, ~ERTS_SCHDLR_SSPND_CHNG_MSB); } - ASSERT(no <= schdlr_sspnd.online); - ASSERT(!ongoing_multi_scheduling_block()); - + ASSERT(no <= schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, sched_type)); + ASSERT((sched_type == ERTS_SCHED_NORMAL + ? !(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing) + : !schdlr_sspnd.msb.ongoing)); } erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + ASSERT(!resume.msb.chngrs); + schdlr_sspnd_resume_procs(sched_type, &resume); + ASSERT(curr_online); - if (erts_system_profile_flags.scheduler) - profile_scheduler(make_small(esdp->no), am_active); + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + if (erts_system_profile_flags.scheduler) + profile_scheduler(make_small(esdp->no), am_active); - if (!thr_prgr_active) { - erts_thr_progress_active(esdp, thr_prgr_active = 1); - sched_wall_time_change(esdp, 1); + if (!thr_prgr_active) { + erts_thr_progress_active(esdp, thr_prgr_active = 1); + sched_wall_time_change(esdp, 1); + } } + if (sched_type == ERTS_SCHED_NORMAL) + (void) erts_get_monotonic_time(esdp); erts_smp_runq_lock(esdp->run_queue); non_empty_runq(esdp->run_queue); - schedule_bound_processes(esdp->run_queue, &sbp); + if (sched_type == ERTS_SCHED_NORMAL) { + schedule_bound_processes(esdp->run_queue, &sbp); - erts_sched_check_cpu_bind_post_suspend(esdp); + erts_sched_check_cpu_bind_post_suspend(esdp); + } } -#endif - -ErtsSchedSuspendResult +void erts_schedulers_state(Uint *total, Uint *online, Uint *active, Uint *dirty_cpu, Uint *dirty_cpu_online, + Uint *dirty_cpu_active, Uint *dirty_io, - int yield_allowed) + Uint *dirty_io_active) { - int res = ERTS_SCHDLR_SSPND_EINVAL; - erts_aint32_t changing; - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); -#ifdef ERTS_DIRTY_SCHEDULERS - changing |= (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_changing) - | erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_changing)); -#endif - if (yield_allowed && (changing & ~ERTS_SCHDLR_SSPND_CHNG_WAITER)) - res = ERTS_SCHDLR_SSPND_YIELD_RESTART; - else { + if (active || online || dirty_cpu_online + || dirty_cpu_active || dirty_io_active) { + erts_smp_mtx_lock(&schdlr_sspnd.mtx); if (active) - *active = schdlr_sspnd.online; + *active = schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_NORMAL); if (online) - *online = schdlr_sspnd.online; - if (ongoing_multi_scheduling_block() && active) - *active = 1; -#ifdef ERTS_DIRTY_SCHEDULERS + *online = schdlr_sspnd_get_nscheds(&schdlr_sspnd.curr_online, + ERTS_SCHED_NORMAL); + if (dirty_cpu_active) + *dirty_cpu_active = schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_DIRTY_CPU); if (dirty_cpu_online) - *dirty_cpu_online = schdlr_sspnd.dirty_cpu_online; -#endif - res = ERTS_SCHDLR_SSPND_DONE; + *dirty_cpu_online = schdlr_sspnd_get_nscheds(&schdlr_sspnd.curr_online, + ERTS_SCHED_DIRTY_CPU); + if (dirty_io_active) + *dirty_io_active = schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_DIRTY_IO); + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); } - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + if (total) *total = erts_no_schedulers; -#ifdef ERTS_DIRTY_SCHEDULERS if (dirty_cpu) *dirty_cpu = erts_no_dirty_cpu_schedulers; if (dirty_io) *dirty_io = erts_no_dirty_io_schedulers; -#endif - return res; } -#ifdef ERTS_DIRTY_SCHEDULERS +static void +abort_sched_onln_chng_waitq(Process *p) +{ + Eterm resume = NIL; + + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + +#ifdef DEBUG + { + int found_it = 0; + ErtsProcList *plp = erts_proclist_peek_first(schdlr_sspnd.chngq); + while (plp) { + if (erts_proclist_same(plp, p)) + found_it++; + plp = erts_proclist_peek_next(schdlr_sspnd.chngq, plp); + } + ASSERT(found_it == !!(p->flags & F_SCHDLR_ONLN_WAITQ)); + } +#endif + + if (p->flags & F_SCHDLR_ONLN_WAITQ) { + ErtsProcList *plp = NULL; + + plp = erts_proclist_peek_first(schdlr_sspnd.chngq); + if (plp) { + if (erts_proclist_same(plp, p) + && schdlr_sspnd.changer == am_true) { + p->flags &= ~F_SCHDLR_ONLN_WAITQ; + /* + * Change right was in transit to us; + * transfer it to the next process by + * resuming it... + */ + erts_proclist_remove(&schdlr_sspnd.chngq, plp); + proclist_destroy(plp); + plp = erts_proclist_peek_first(schdlr_sspnd.chngq); + if (plp) + resume = plp->pid; + else + schdlr_sspnd.changer = am_false; + } + else { + do { + if (erts_proclist_same(plp, p)) { + p->flags &= ~F_SCHDLR_ONLN_WAITQ; + erts_proclist_remove(&schdlr_sspnd.chngq, plp); + proclist_destroy(plp); + break; + } + plp = erts_proclist_peek_next(schdlr_sspnd.chngq, plp); + } while (plp); + } + } + } + + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + + if (is_internal_pid(resume)) + schdlr_sspnd_resume_proc(resume); +} ErtsSchedSuspendResult erts_set_schedulers_online(Process *p, ErtsProcLocks plocks, Sint new_no, - Sint *old_no -#ifdef ERTS_DIRTY_SCHEDULERS - , int dirty_only -#endif - ) + Sint *old_no, + int dirty_only) { - ErtsSchedulerData *esdp; - int ix, res = -1, no, have_unlocked_plocks, end_wait; - erts_aint32_t changing = 0; + int resume_proc, ix, res = -1, no, have_unlocked_plocks; + erts_aint32_t changing = 0, change_flags; + int online, increase; + ErtsProcList *plp; #ifdef ERTS_DIRTY_SCHEDULERS - ErtsSchedulerSleepInfo* ssi; - int dirty_no, change_dirty; + int dirty_no, change_dirty, dirty_online; +#else + ASSERT(!dirty_only); #endif if (new_no < 1) return ERTS_SCHDLR_SSPND_EINVAL; -#ifdef ERTS_DIRTY_SCHEDULERS else if (dirty_only && erts_no_dirty_cpu_schedulers < new_no) return ERTS_SCHDLR_SSPND_EINVAL; -#endif else if (erts_no_schedulers < new_no) return ERTS_SCHDLR_SSPND_EINVAL; - esdp = ERTS_PROC_GET_SCHDATA(p); - end_wait = 0; +#ifdef ERTS_DIRTY_SCHEDULERS + if (dirty_only) + resume_proc = 0; + else +#endif + { + resume_proc = 1; + /* + * If we suspend current process we need to suspend before + * requesting the change; otherwise, we got a resume/suspend + * race... + */ + if (!(plocks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + suspend_process(p, p); + if (!(plocks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + } erts_smp_mtx_lock(&schdlr_sspnd.mtx); + change_flags = 0; have_unlocked_plocks = 0; no = (int) new_no; #ifdef ERTS_DIRTY_SCHEDULERS - ASSERT(schdlr_sspnd.dirty_cpu_online <= erts_no_dirty_cpu_schedulers); + if (!dirty_only) +#endif + { + changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); + if (changing & ERTS_SCHDLR_SSPND_CHNG_ONLN) { + enqueue_wait: + p->flags |= F_SCHDLR_ONLN_WAITQ; + plp = proclist_create(p); + erts_proclist_store_last(&schdlr_sspnd.chngq, plp); + resume_proc = 0; + res = ERTS_SCHDLR_SSPND_YIELD_RESTART; + goto done; + } + plp = erts_proclist_peek_first(schdlr_sspnd.chngq); + if (!plp) { + ASSERT(schdlr_sspnd.changer == am_false); + } + else { + ASSERT(schdlr_sspnd.changer == am_true); + if (!erts_proclist_same(plp, p)) + goto enqueue_wait; + p->flags &= ~F_SCHDLR_ONLN_WAITQ; + erts_proclist_remove(&schdlr_sspnd.chngq, plp); + proclist_destroy(plp); + } + } + + *old_no = online = schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_NORMAL); +#ifndef ERTS_DIRTY_SCHEDULERS + if (no == online) { + res = ERTS_SCHDLR_SSPND_DONE; + goto done; + } +#else /* ERTS_DIRTY_SCHEDULERS */ + dirty_online = schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_DIRTY_CPU); + if (dirty_only) + *old_no = dirty_online; + + ASSERT(dirty_online <= erts_no_dirty_cpu_schedulers); + if (dirty_only) { - if (no > schdlr_sspnd.online) { - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - return ERTS_SCHDLR_SSPND_EINVAL; + if (no > online) { + res = ERTS_SCHDLR_SSPND_EINVAL; + goto done; } dirty_no = no; + if (dirty_no == dirty_online) { + res = ERTS_SCHDLR_SSPND_DONE; + goto done; + } + change_dirty = 1; } else { /* * Adjust the number of dirty CPU schedulers online relative to the * adjustment made to the number of normal schedulers online. */ int total_pct = erts_no_dirty_cpu_schedulers*100/erts_no_schedulers; - int onln_pct = no*total_pct/schdlr_sspnd.online; - dirty_no = schdlr_sspnd.dirty_cpu_online*onln_pct/100; + int onln_pct = no*total_pct/online; + dirty_no = dirty_online*onln_pct/100; if (dirty_no == 0) dirty_no = 1; ASSERT(dirty_no <= erts_no_dirty_cpu_schedulers); - } -#endif - changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); -#ifdef ERTS_DIRTY_SCHEDULERS - changing |= erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_changing); -#endif - if (changing) { - res = ERTS_SCHDLR_SSPND_YIELD_RESTART; - } - else { - int online = *old_no = schdlr_sspnd.online; -#ifdef ERTS_DIRTY_SCHEDULERS - int dirty_online = schdlr_sspnd.dirty_cpu_online; - if (dirty_only) { - *old_no = schdlr_sspnd.dirty_cpu_online; - if (dirty_no == schdlr_sspnd.dirty_cpu_online) { + if (no != online) + change_dirty = (dirty_no != dirty_online); + else { + dirty_only = 1; + if (dirty_no == dirty_online) { res = ERTS_SCHDLR_SSPND_DONE; + goto done; } change_dirty = 1; - } else { -#endif - if (no == schdlr_sspnd.online) { -#ifdef ERTS_DIRTY_SCHEDULERS - dirty_only = 1; - if (dirty_no == schdlr_sspnd.dirty_cpu_online) -#endif - res = ERTS_SCHDLR_SSPND_DONE; -#ifdef ERTS_DIRTY_SCHEDULERS - else - change_dirty = 1; -#endif - } -#ifdef ERTS_DIRTY_SCHEDULERS - else - change_dirty = (dirty_no != schdlr_sspnd.dirty_cpu_online); } -#endif - if (res == -1) - { - int increase = (no > online); -#ifdef ERTS_DIRTY_SCHEDULERS - if (!dirty_only) { -#endif - ERTS_SCHDLR_SSPND_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN - | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); - schdlr_sspnd.online = no; -#ifdef ERTS_DIRTY_SCHEDULERS - } else - increase = (dirty_no > dirty_online); - if (change_dirty) { - ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN - | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); - schdlr_sspnd.dirty_cpu_online = dirty_no; - } -#endif - if (increase) { - int ix; -#ifdef ERTS_DIRTY_SCHEDULERS - if (!dirty_only) { -#endif - schdlr_sspnd.wait_curr_online = no; - if (ongoing_multi_scheduling_block()) { - for (ix = online; ix < no; ix++) - erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(ix)); - } - else { - if (plocks) { - have_unlocked_plocks = 1; - erts_smp_proc_unlock(p, plocks); - } - change_no_used_runqs(no); + } + if (change_dirty) { + change_flags |= ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN; + schdlr_sspnd_set_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_DIRTY_CPU, + dirty_no); + } - for (ix = online; ix < no; ix++) - resume_run_queue(ERTS_RUNQ_IX(ix)); + if (dirty_only) + increase = (dirty_no > dirty_online); + else +#endif /* ERTS_DIRTY_SCHEDULERS */ + { + change_flags |= ERTS_SCHDLR_SSPND_CHNG_ONLN; + schdlr_sspnd_set_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_NORMAL, + no); + increase = (no > online); + } - for (ix = no; ix < erts_no_run_queues; ix++) - suspend_run_queue(ERTS_RUNQ_IX(ix)); - } + erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing, change_flags); + + res = ERTS_SCHDLR_SSPND_DONE; + if (increase) { + int ix; #ifdef ERTS_DIRTY_SCHEDULERS + if (change_dirty) { + ErtsSchedulerSleepInfo* ssi; + if (schdlr_sspnd.msb.ongoing) { + for (ix = dirty_online; ix < dirty_no; ix++) { + ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); + erts_sched_poke(ssi); } - if (change_dirty) { - schdlr_sspnd.dirty_cpu_wait_curr_online = dirty_no; - ASSERT(schdlr_sspnd.dirty_cpu_curr_online != - schdlr_sspnd.dirty_cpu_wait_curr_online); - if (ongoing_multi_scheduling_block()) { - for (ix = dirty_online; ix < dirty_no; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - erts_sched_poke(ssi); - } - } else { - for (ix = dirty_online; ix < dirty_no; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - scheduler_ssi_resume_wake(ssi); - erts_smp_atomic32_read_band_nob(&ssi->flags, - ~ERTS_SSI_FLG_SUSPENDED); - } - wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); - } + } else { + for (ix = dirty_online; ix < dirty_no; ix++) { + ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); + scheduler_ssi_resume_wake(ssi); } -#endif - res = ERTS_SCHDLR_SSPND_DONE; } - else /* if (no < online) */ { -#ifdef ERTS_DIRTY_SCHEDULERS - if (change_dirty) { - schdlr_sspnd.dirty_cpu_wait_curr_online = dirty_no; - ASSERT(schdlr_sspnd.dirty_cpu_curr_online != - schdlr_sspnd.dirty_cpu_wait_curr_online); - if (ongoing_multi_scheduling_block()) { - for (ix = dirty_no; ix < dirty_online; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - erts_sched_poke(ssi); - } - } else { - for (ix = dirty_no; ix < dirty_online; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - erts_smp_atomic32_read_bor_nob(&ssi->flags, - ERTS_SSI_FLG_SUSPENDED); - } - wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); - } - } - if (dirty_only) { - res = ERTS_SCHDLR_SSPND_DONE; - } - else + } + if (!dirty_only) #endif - { - if (p->scheduler_data->no <= no) { - res = ERTS_SCHDLR_SSPND_DONE; - schdlr_sspnd.wait_curr_online = no; - } - else { - /* - * Yield! Current process needs to migrate - * before bif returns. - */ - res = ERTS_SCHDLR_SSPND_YIELD_DONE; - schdlr_sspnd.wait_curr_online = no+1; - } - - if (ongoing_multi_scheduling_block()) { - for (ix = no; ix < online; ix++) - erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(ix)); - } - else { - if (plocks) { - have_unlocked_plocks = 1; - erts_smp_proc_unlock(p, plocks); - } - - change_no_used_runqs(no); - for (ix = no; ix < erts_no_run_queues; ix++) - suspend_run_queue(ERTS_RUNQ_IX(ix)); - - for (ix = no; ix < online; ix++) { - ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); - wake_scheduler(rq); - } - } - } + { + if (schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing) { + for (ix = online; ix < no; ix++) + erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(ix)); } - -#ifdef ERTS_DIRTY_SCHEDULERS - if (change_dirty) { - while (schdlr_sspnd.dirty_cpu_curr_online != schdlr_sspnd.dirty_cpu_wait_curr_online) - erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); - ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); - erts_smp_atomic32_read_band_nob(&schdlr_sspnd.dirty_cpu_changing, - ~ERTS_SCHDLR_SSPND_CHNG_WAITER); - } - if (!dirty_only) -#endif - { - if (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) { - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - if (plocks && !have_unlocked_plocks) { - have_unlocked_plocks = 1; - erts_smp_proc_unlock(p, plocks); - } - erts_thr_progress_active(esdp, 0); - erts_thr_progress_prepare_wait(esdp); - end_wait = 1; - erts_smp_mtx_lock(&schdlr_sspnd.mtx); + else { + if (plocks) { + have_unlocked_plocks = 1; + erts_smp_proc_unlock(p, plocks); } + change_no_used_runqs(no); - while (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) - erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); + for (ix = online; ix < no; ix++) + resume_run_queue(ERTS_RUNQ_IX(ix)); - ASSERT(res != ERTS_SCHDLR_SSPND_DONE - ? (ERTS_SCHDLR_SSPND_CHNG_WAITER - & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)) - : (ERTS_SCHDLR_SSPND_CHNG_WAITER - == erts_smp_atomic32_read_nob(&schdlr_sspnd.changing))); - erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, - ~ERTS_SCHDLR_SSPND_CHNG_WAITER); + for (ix = no; ix < erts_no_run_queues; ix++) + suspend_run_queue(ERTS_RUNQ_IX(ix)); } } } - - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + else /* if decrease */ { #ifdef ERTS_DIRTY_SCHEDULERS - ASSERT(schdlr_sspnd.dirty_cpu_online <= schdlr_sspnd.online); - if (!dirty_only) -#endif - { - if (end_wait) { - erts_thr_progress_finalize_wait(esdp); - erts_thr_progress_active(esdp, 1); - } - if (have_unlocked_plocks) - erts_smp_proc_lock(p, plocks); - } - - return res; -} - -#else /* !ERTS_DIRTY_SCHEDULERS */ - -ErtsSchedSuspendResult -erts_set_schedulers_online(Process *p, - ErtsProcLocks plocks, - Sint new_no, - Sint *old_no) -{ - ErtsSchedulerData *esdp; - int ix, res, no, have_unlocked_plocks, end_wait; - erts_aint32_t changing; - - if (new_no < 1 || erts_no_schedulers < new_no) - return ERTS_SCHDLR_SSPND_EINVAL; - - esdp = ERTS_PROC_GET_SCHDATA(p); - end_wait = 0; - - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - - have_unlocked_plocks = 0; - no = (int) new_no; - - changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); - if (changing) { - res = ERTS_SCHDLR_SSPND_YIELD_RESTART; - } - else { - int online = *old_no = schdlr_sspnd.online; - if (no == schdlr_sspnd.online) { - res = ERTS_SCHDLR_SSPND_DONE; - } - else { - ERTS_SCHDLR_SSPND_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN - | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); - schdlr_sspnd.online = no; - if (no > online) { - int ix; - schdlr_sspnd.wait_curr_online = no; - if (ongoing_multi_scheduling_block()) { - for (ix = online; ix < no; ix++) - erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(ix)); + if (change_dirty) { + ErtsSchedulerSleepInfo* ssi; + if (schdlr_sspnd.msb.ongoing) { + for (ix = dirty_no; ix < dirty_online; ix++) { + ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); + erts_sched_poke(ssi); } - else { - if (plocks) { - have_unlocked_plocks = 1; - erts_smp_proc_unlock(p, plocks); - } - change_no_used_runqs(no); - - for (ix = online; ix < no; ix++) - resume_run_queue(ERTS_RUNQ_IX(ix)); - - for (ix = no; ix < erts_no_run_queues; ix++) - suspend_run_queue(ERTS_RUNQ_IX(ix)); + } else { + for (ix = dirty_no; ix < dirty_online; ix++) { + ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); + erts_smp_atomic32_read_bor_nob(&ssi->flags, + ERTS_SSI_FLG_SUSPENDED); } - res = ERTS_SCHDLR_SSPND_DONE; + wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); } - else /* if (no < online) */ { - if (p->scheduler_data->no <= no) { - res = ERTS_SCHDLR_SSPND_DONE; - schdlr_sspnd.wait_curr_online = no; - } - else { - /* - * Yield! Current process needs to migrate - * before bif returns. - */ - res = ERTS_SCHDLR_SSPND_YIELD_DONE; - schdlr_sspnd.wait_curr_online = no+1; - } - - if (ongoing_multi_scheduling_block()) { - for (ix = no; ix < online; ix++) - erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(ix)); - } - else { - if (plocks) { - have_unlocked_plocks = 1; - erts_smp_proc_unlock(p, plocks); - } - - change_no_used_runqs(no); - for (ix = no; ix < erts_no_run_queues; ix++) - suspend_run_queue(ERTS_RUNQ_IX(ix)); - - for (ix = no; ix < online; ix++) { - ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); - wake_scheduler(rq); - } - } + } + if (!dirty_only) +#endif + { + if (schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing) { + for (ix = no; ix < online; ix++) + erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(ix)); } - - if (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) { - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - if (plocks && !have_unlocked_plocks) { + else { + if (plocks) { have_unlocked_plocks = 1; erts_smp_proc_unlock(p, plocks); } - erts_thr_progress_active(esdp, 0); - erts_thr_progress_prepare_wait(esdp); - end_wait = 1; - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - } - while (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) - erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); - - ASSERT(res != ERTS_SCHDLR_SSPND_DONE - ? (ERTS_SCHDLR_SSPND_CHNG_WAITER - & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)) - : (ERTS_SCHDLR_SSPND_CHNG_WAITER - == erts_smp_atomic32_read_nob(&schdlr_sspnd.changing))); - erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, - ~ERTS_SCHDLR_SSPND_CHNG_WAITER); + change_no_used_runqs(no); + for (ix = no; ix < erts_no_run_queues; ix++) + suspend_run_queue(ERTS_RUNQ_IX(ix)); + for (ix = no; ix < online; ix++) { + ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); + wake_scheduler(rq); + } + } } } - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - if (end_wait) { - erts_thr_progress_finalize_wait(esdp); - erts_thr_progress_active(esdp, 1); + if (change_flags & ERTS_SCHDLR_SSPND_CHNG_ONLN) { + /* Suspend and wait for requested change to complete... */ + schdlr_sspnd.changer = p->common.id; + resume_proc = 0; + res = ERTS_SCHDLR_SSPND_YIELD_DONE; } + +done: + + ASSERT(schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_DIRTY_CPU) + <= schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_NORMAL)); + + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + if (have_unlocked_plocks) erts_smp_proc_lock(p, plocks); + if (resume_proc) { + if (!(plocks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + resume_process(p, plocks|ERTS_PROC_LOCK_STATUS); + if (!(plocks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + } + return res; } -#endif - ErtsSchedSuspendResult -erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all) +erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal, int all) { - int ix, res, have_unlocked_plocks = 0, online; - erts_aint32_t changing; + int resume_proc, ix, res, have_unlocked_plocks = 0; ErtsProcList *plp; #ifdef ERTS_DIRTY_SCHEDULERS ErtsSchedulerSleepInfo* ssi; #endif + ErtsMultiSchedulingBlock *msbp; + erts_aint32_t chng_flg; + int have_blckd_flg; - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing); -#ifdef ERTS_DIRTY_SCHEDULERS - changing |= (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_changing) - | erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_changing)); -#endif - if (changing) { - res = ERTS_SCHDLR_SSPND_YIELD_RESTART; /* Yield */ + if (normal) { + chng_flg = ERTS_SCHDLR_SSPND_CHNG_NMSB; + have_blckd_flg = F_HAVE_BLCKD_NMSCHED; + msbp = &schdlr_sspnd.nmsb; + } + else { + chng_flg = ERTS_SCHDLR_SSPND_CHNG_MSB; + have_blckd_flg = F_HAVE_BLCKD_MSCHED; + msbp = &schdlr_sspnd.msb; + } + + /* + * If we suspend current process we need to suspend before + * requesting the change; otherwise, we got a resume/suspend + * race... + */ + if (!on) { + /* We never suspend current process when unblocking... */ + resume_proc = 0; + } + else { + resume_proc = 1; + if (!(plocks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + suspend_process(p, p); + if (!(plocks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); } - else if (on) { /* ------ BLOCK ------ */ - if (schdlr_sspnd.msb.procs) { + + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + if (on) { /* ------ BLOCK ------ */ + if (msbp->chngq) { + ASSERT(msbp->ongoing); + p->flags |= have_blckd_flg; + goto wait_until_msb; + } + else if (msbp->blckrs) { + ASSERT(msbp->ongoing); plp = proclist_create(p); - erts_proclist_store_last(&schdlr_sspnd.msb.procs, plp); - p->flags |= F_HAVE_BLCKD_MSCHED; - ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.active) == 1); -#ifdef ERTS_DIRTY_SCHEDULERS - ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_active) == 0); - ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_active) == 0); -#endif + erts_proclist_store_last(&msbp->blckrs, plp); + p->flags |= have_blckd_flg; + ASSERT(schdlr_sspnd.active == ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0)); ASSERT(p->scheduler_data->no == 1); - res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; - } else { - int online = schdlr_sspnd.online; - p->flags |= F_HAVE_BLCKD_MSCHED; + if (schdlr_sspnd.msb.ongoing) + res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; + else + res = ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED; + } + else { + int online = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_NORMAL); + ASSERT(!msbp->ongoing); + p->flags |= have_blckd_flg; if (plocks) { have_unlocked_plocks = 1; erts_smp_proc_unlock(p, plocks); } - ASSERT(!ongoing_multi_scheduling_block()); - schdlr_sspnd.msb.ongoing = 1; - if (online == 1) { - res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; - ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.active) == 1); -#ifdef ERTS_DIRTY_SCHEDULERS - ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_active) == 1); - ASSERT(!(erts_smp_atomic32_read_nob(&ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(0)->flags) - & ERTS_SSI_FLG_SUSPENDED)); - schdlr_sspnd.msb.dirty_cpu_wait_active = 0; - ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_MSB - | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(0); - erts_smp_atomic32_read_bor_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); - wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); - while (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_active) - != schdlr_sspnd.msb.dirty_cpu_wait_active) - erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); - ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); - - schdlr_sspnd.msb.dirty_io_wait_active = 0; - ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_MSB - | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); - for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { - ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix); - erts_smp_atomic32_read_bor_nob(&ssi->flags, - ERTS_SSI_FLG_SUSPENDED); - } - wake_dirty_schedulers(ERTS_DIRTY_IO_RUNQ, 0); - while (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_active) - != schdlr_sspnd.msb.dirty_io_wait_active) - erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); - ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); -#endif + ASSERT(!msbp->ongoing); + msbp->ongoing = 1; + if (schdlr_sspnd.active == ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0) + || (normal && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_NORMAL) == 1)) { ASSERT(p->scheduler_data->no == 1); + plp = proclist_create(p); + erts_proclist_store_last(&msbp->blckrs, plp); + if (schdlr_sspnd.msb.ongoing) + res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; + else + res = ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED; } else { - ERTS_SCHDLR_SSPND_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_MSB - | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); - if (p->scheduler_data->no == 1) { - res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; - schdlr_sspnd.msb.wait_active = 1; - } - else { - /* - * Yield! Current process needs to migrate - * before bif returns. - */ - res = ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED; - schdlr_sspnd.msb.wait_active = 2; - } - -#ifdef ERTS_DIRTY_SCHEDULERS - schdlr_sspnd.msb.dirty_cpu_wait_active = 0; - ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_MSB - | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); - for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - erts_smp_atomic32_read_bor_nob(&ssi->flags, - ERTS_SSI_FLG_SUSPENDED); - } - wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); - while (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_active) - != schdlr_sspnd.msb.dirty_cpu_wait_active) - erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); - ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); - ASSERT(schdlr_sspnd.dirty_cpu_curr_online == schdlr_sspnd.dirty_cpu_online); - - schdlr_sspnd.msb.dirty_io_wait_active = 0; - ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_MSB - | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0); - for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { - ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix); - erts_smp_atomic32_read_bor_nob(&ssi->flags, - ERTS_SSI_FLG_SUSPENDED); - } - wake_dirty_schedulers(ERTS_DIRTY_IO_RUNQ, 0); - while (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_active) - != schdlr_sspnd.msb.dirty_io_wait_active) - erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); - ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); - ASSERT(schdlr_sspnd.dirty_io_curr_online == schdlr_sspnd.dirty_io_online); -#endif + erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing, + chng_flg); change_no_used_runqs(1); for (ix = 1; ix < erts_no_run_queues; ix++) suspend_run_queue(ERTS_RUNQ_IX(ix)); @@ -7839,84 +7802,84 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all) wake_scheduler(rq); } - if (erts_smp_atomic32_read_nob(&schdlr_sspnd.active) - != schdlr_sspnd.msb.wait_active) { - ErtsSchedulerData *esdp; - - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - - if (plocks && !have_unlocked_plocks) { - have_unlocked_plocks = 1; - erts_smp_proc_unlock(p, plocks); +#ifdef ERTS_DIRTY_SCHEDULERS + if (!normal) { + for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) { + ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); + erts_smp_atomic32_read_bor_nob(&ssi->flags, + ERTS_SSI_FLG_SUSPENDED); } + wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); - esdp = ERTS_PROC_GET_SCHDATA(p); - - erts_thr_progress_active(esdp, 0); - erts_thr_progress_prepare_wait(esdp); - - erts_smp_mtx_lock(&schdlr_sspnd.mtx); + for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { + ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix); + erts_smp_atomic32_read_bor_nob(&ssi->flags, + ERTS_SSI_FLG_SUSPENDED); + } + wake_dirty_schedulers(ERTS_DIRTY_IO_RUNQ, 0); + } +#endif - while (erts_smp_atomic32_read_nob(&schdlr_sspnd.active) - != schdlr_sspnd.msb.wait_active) - erts_smp_cnd_wait(&schdlr_sspnd.cnd, - &schdlr_sspnd.mtx); - - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - - erts_thr_progress_active(esdp, 1); - erts_thr_progress_finalize_wait(esdp); + wait_until_msb: - erts_smp_mtx_lock(&schdlr_sspnd.mtx); + ASSERT(chng_flg & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)); - } - - ASSERT(res != ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED - ? (ERTS_SCHDLR_SSPND_CHNG_WAITER - & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)) - : (ERTS_SCHDLR_SSPND_CHNG_WAITER - == erts_smp_atomic32_read_nob(&schdlr_sspnd.changing))); - erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, - ~ERTS_SCHDLR_SSPND_CHNG_WAITER); + plp = proclist_create(p); + erts_proclist_store_last(&msbp->chngq, plp); + resume_proc = 0; + if (schdlr_sspnd.msb.ongoing) + res = ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED; + else + res = ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED; } - plp = proclist_create(p); - erts_proclist_store_last(&schdlr_sspnd.msb.procs, plp); ASSERT(p->scheduler_data); } } - else if (!ongoing_multi_scheduling_block()) { - /* unblock not ongoing */ - ASSERT(!schdlr_sspnd.msb.procs); - res = ERTS_SCHDLR_SSPND_DONE; + else if (!msbp->ongoing) { + ASSERT(!msbp->blckrs); + goto unblock_res; } else { /* ------ UNBLOCK ------ */ - if (p->flags & F_HAVE_BLCKD_MSCHED) { - ErtsProcList *plp = erts_proclist_peek_first(schdlr_sspnd.msb.procs); - - while (plp) { - ErtsProcList *tmp_plp = plp; - plp = erts_proclist_peek_next(schdlr_sspnd.msb.procs, plp); - if (erts_proclist_same(tmp_plp, p)) { - erts_proclist_remove(&schdlr_sspnd.msb.procs, tmp_plp); - proclist_destroy(tmp_plp); - if (!all) - break; + if (p->flags & have_blckd_flg) { + ErtsProcList *plps[2]; + ErtsProcList *plp; + int limit = 0; + + plps[limit++] = erts_proclist_peek_first(msbp->blckrs); + if (all) + plps[limit++] = erts_proclist_peek_first(msbp->chngq); + + for (ix = 0; ix < limit; ix++) { + plp = plps[ix]; + while (plp) { + ErtsProcList *tmp_plp = plp; + plp = erts_proclist_peek_next(msbp->blckrs, plp); + if (erts_proclist_same(tmp_plp, p)) { + erts_proclist_remove(&msbp->blckrs, tmp_plp); + proclist_destroy(tmp_plp); + if (!all) + break; + } } } } - if (schdlr_sspnd.msb.procs) - res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; - else { - ERTS_SCHDLR_SSPND_CHNG_SET(ERTS_SCHDLR_SSPND_CHNG_MSB, 0); - p->flags &= ~F_HAVE_BLCKD_MSCHED; - schdlr_sspnd.msb.ongoing = 0; - if (schdlr_sspnd.online == 1) { + if (!msbp->blckrs && !msbp->chngq) { + int online = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_NORMAL); + erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing, + chng_flg); + p->flags &= ~have_blckd_flg; + msbp->ongoing = 0; + if (online == 1) { /* No normal schedulers to resume */ - ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.active) == 1); - ERTS_SCHDLR_SSPND_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_MSB); + ASSERT(schdlr_sspnd_get_nscheds(&schdlr_sspnd.active, + ERTS_SCHED_NORMAL) == 1); +#ifndef ERTS_DIRTY_SCHEDULERS + erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, + ~chng_flg); +#endif } - else { - online = schdlr_sspnd.online; + else if (!(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing)) { if (plocks) { have_unlocked_plocks = 1; erts_smp_proc_unlock(p, plocks); @@ -7932,83 +7895,91 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all) suspend_run_queue(ERTS_RUNQ_IX(ix)); } #ifdef ERTS_DIRTY_SCHEDULERS - ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(ERTS_SCHDLR_SSPND_CHNG_MSB, 0); - schdlr_sspnd.msb.dirty_cpu_wait_active = schdlr_sspnd.dirty_cpu_online; - for (ix = 0; ix < schdlr_sspnd.dirty_cpu_online; ix++) { - ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); - scheduler_ssi_resume_wake(ssi); - erts_smp_atomic32_read_band_nob(&ssi->flags, - ~ERTS_SSI_FLG_SUSPENDED); - } - wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0); - - ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(ERTS_SCHDLR_SSPND_CHNG_MSB, 0); - schdlr_sspnd.msb.dirty_io_wait_active = erts_no_dirty_io_schedulers; - for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { - ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix); - scheduler_ssi_resume_wake(ssi); - erts_smp_atomic32_read_band_nob(&ssi->flags, - ~ERTS_SSI_FLG_SUSPENDED); - } - wake_dirty_schedulers(ERTS_DIRTY_IO_RUNQ, 0); + if (!normal) { + ASSERT(!schdlr_sspnd.msb.ongoing); + online = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, + ERTS_SCHED_DIRTY_CPU); + for (ix = 0; ix < online; ix++) { + ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix); + scheduler_ssi_resume_wake(ssi); + } + + for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) { + ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix); + scheduler_ssi_resume_wake(ssi); + } + } #endif - res = ERTS_SCHDLR_SSPND_DONE; } + + unblock_res: + if (schdlr_sspnd.msb.ongoing) + res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; + else if (schdlr_sspnd.nmsb.ongoing) + res = ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED; + else + res = ERTS_SCHDLR_SSPND_DONE; } erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + if (have_unlocked_plocks) erts_smp_proc_lock(p, plocks); - return res; -} -#ifdef DEBUG -void -erts_dbg_multi_scheduling_return_trap(Process *p, Eterm return_value) -{ - if (return_value == am_blocked) { - erts_aint32_t active = erts_smp_atomic32_read_nob(&schdlr_sspnd.active); - ASSERT(1 <= active && active <= 2); - ASSERT(ERTS_PROC_GET_SCHDATA(p)->no == 1); + if (resume_proc) { + if (!(plocks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + resume_process(p, plocks|ERTS_PROC_LOCK_STATUS); + if (!(plocks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); } + + return res; } -#endif int erts_is_multi_scheduling_blocked(void) { int res; erts_smp_mtx_lock(&schdlr_sspnd.mtx); - res = schdlr_sspnd.msb.procs != NULL; + if (schdlr_sspnd.msb.blckrs) + res = 1; + else if (schdlr_sspnd.nmsb.blckrs) + res = -1; + else + res = 0; erts_smp_mtx_unlock(&schdlr_sspnd.mtx); return res; } Eterm -erts_multi_scheduling_blockers(Process *p) +erts_multi_scheduling_blockers(Process *p, int normal) { Eterm res = NIL; + ErtsMultiSchedulingBlock *msbp; + + msbp = normal ? &schdlr_sspnd.nmsb : &schdlr_sspnd.msb; erts_smp_mtx_lock(&schdlr_sspnd.mtx); - if (!erts_proclist_is_empty(schdlr_sspnd.msb.procs)) { + if (!erts_proclist_is_empty(msbp->blckrs)) { Eterm *hp, *hp_end; ErtsProcList *plp1, *plp2; Uint max_size = 0; - for (plp1 = erts_proclist_peek_first(schdlr_sspnd.msb.procs); + for (plp1 = erts_proclist_peek_first(msbp->blckrs); plp1; - plp1 = erts_proclist_peek_next(schdlr_sspnd.msb.procs, plp1)) { + plp1 = erts_proclist_peek_next(msbp->blckrs, plp1)) { max_size += 2; } ASSERT(max_size); hp = HAlloc(p, max_size); hp_end = hp + max_size; - for (plp1 = erts_proclist_peek_first(schdlr_sspnd.msb.procs); + for (plp1 = erts_proclist_peek_first(msbp->blckrs); plp1; - plp1 = erts_proclist_peek_next(schdlr_sspnd.msb.procs, plp1)) { - for (plp2 = erts_proclist_peek_first(schdlr_sspnd.msb.procs); + plp1 = erts_proclist_peek_next(msbp->blckrs, plp1)) { + for (plp2 = erts_proclist_peek_first(msbp->blckrs); plp2->pid != plp1->pid; - plp2 = erts_proclist_peek_next(schdlr_sspnd.msb.procs, plp2)); + plp2 = erts_proclist_peek_next(msbp->blckrs, plp2)); if (plp2 == plp1) { res = CONS(hp, plp1->pid, res); hp += 2; @@ -8046,6 +8017,8 @@ sched_thread_func(void *vesdp) callbacks.wait = thr_prgr_wait; callbacks.finalize_wait = thr_prgr_fin_wait; + erts_msacc_init_thread("scheduler", no, 1); + erts_thr_progress_register_managed_thread(esdp, &callbacks, 0); erts_alloc_register_scheduler(vesdp); #endif @@ -8075,39 +8048,6 @@ sched_thread_func(void *vesdp) #endif erts_thread_init_float(); - if (no == 1) { - erts_thr_progress_active(esdp, 0); - erts_thr_progress_prepare_wait(esdp); - } - - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - - ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.changing) - & ERTS_SCHDLR_SSPND_CHNG_ONLN); - - if (--schdlr_sspnd.curr_online == schdlr_sspnd.wait_curr_online) { - erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing, - ~ERTS_SCHDLR_SSPND_CHNG_ONLN); - if (no != 1) -#ifdef ERTS_DIRTY_SCHEDULERS - erts_smp_cnd_broadcast(&schdlr_sspnd.cnd); -#else - erts_smp_cnd_signal(&schdlr_sspnd.cnd); -#endif - } - - if (no == 1) { - while (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) - erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); - ERTS_SCHDLR_SSPND_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); - } - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - - if (no == 1) { - erts_thr_progress_finalize_wait(esdp); - erts_thr_progress_active(esdp, 1); - } - #ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC esdp->verify_unused_temp_alloc = erts_alloc_get_verify_unused_temp_alloc( @@ -8162,24 +8102,6 @@ sched_dirty_cpu_thread_func(void *vesdp) #endif erts_thread_init_float(); - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_changing) - & ERTS_SCHDLR_SSPND_CHNG_ONLN); - - if (--schdlr_sspnd.dirty_cpu_curr_online == schdlr_sspnd.dirty_cpu_wait_curr_online) { - erts_smp_atomic32_read_band_nob(&schdlr_sspnd.dirty_cpu_changing, - ~ERTS_SCHDLR_SSPND_CHNG_ONLN); - if (no != 1) - erts_smp_cnd_broadcast(&schdlr_sspnd.cnd); - } - - if (no == 1) { - while (schdlr_sspnd.dirty_cpu_curr_online != schdlr_sspnd.dirty_cpu_wait_curr_online) - erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); - ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); - } - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - process_main(); /* No schedulers should *ever* terminate */ erts_exit(ERTS_ABORT_EXIT, @@ -8225,24 +8147,6 @@ sched_dirty_io_thread_func(void *vesdp) #endif erts_thread_init_float(); - erts_smp_mtx_lock(&schdlr_sspnd.mtx); - ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_changing) - & ERTS_SCHDLR_SSPND_CHNG_ONLN); - - if (--schdlr_sspnd.dirty_io_curr_online == schdlr_sspnd.dirty_io_wait_curr_online) { - erts_smp_atomic32_read_band_nob(&schdlr_sspnd.dirty_io_changing, - ~ERTS_SCHDLR_SSPND_CHNG_ONLN); - if (no != 1) - erts_smp_cnd_broadcast(&schdlr_sspnd.cnd); - } - - if (no == 1) { - while (schdlr_sspnd.dirty_io_curr_online != schdlr_sspnd.dirty_io_wait_curr_online) - erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); - ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER); - } - erts_smp_mtx_unlock(&schdlr_sspnd.mtx); - process_main(); /* No schedulers should *ever* terminate */ erts_exit(ERTS_ABORT_EXIT, @@ -8301,18 +8205,12 @@ erts_start_schedulers(void) erts_snprintf(opts.name, 16, "%lu_scheduler", actual + 1); -#ifdef __OSE__ - /* This should be done in the bind strategy */ - opts.coreNo = (actual+1) % ose_num_cpus(); -#endif - res = ethr_thr_create(&esdp->tid, sched_thread_func, (void*)esdp, &opts); if (res != 0) { break; } } - erts_no_schedulers = actual; #ifdef ERTS_DIRTY_SCHEDULERS @@ -8341,10 +8239,6 @@ erts_start_schedulers(void) erts_snprintf(opts.name, 16, "aux"); -#ifdef __OSE__ - opts.coreNo = 0; -#endif /* __OSE__ */ - res = ethr_thr_create(&aux_tid, aux_thread, NULL, &opts); if (res != 0) erts_exit(ERTS_ERROR_EXIT, "Failed to create aux thread\n"); @@ -8364,7 +8258,6 @@ erts_start_schedulers(void) actual, actual == 1 ? " was" : "s were"); erts_send_error_to_logger_nogl(dsbufp); } - } #endif /* ERTS_SMP */ @@ -8383,7 +8276,7 @@ add_pend_suspend(Process *suspendee, sizeof(ErtsPendingSuspend)); psp->next = NULL; #ifdef DEBUG -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) psp->end = (ErtsPendingSuspend *) 0xdeaddeaddeaddead; #else psp->end = (ErtsPendingSuspend *) 0xdeaddead; @@ -9378,6 +9271,8 @@ Process *schedule(Process *p, int calls) Uint32 flags; erts_aint32_t state = 0; /* Supress warning... */ + ERTS_MSACC_DECLARE_CACHE(); + #ifdef USE_VM_PROBES if (p != NULL && DTRACE_ENABLED(process_unscheduled)) { DTRACE_CHARBUF(process_buf, DTRACE_TERM_BUF_SIZE); @@ -9421,6 +9316,7 @@ Process *schedule(Process *p, int calls) esdp = erts_scheduler_data; ASSERT(esdp->current_process == p); #endif + reds = actual_reds = calls - esdp->virtual_reds; if (reds < ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST) reds = ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST; @@ -9433,27 +9329,39 @@ Process *schedule(Process *p, int calls) p->reds += actual_reds; - erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); +#ifdef ERTS_SMP + erts_smp_proc_lock(p, ERTS_PROC_LOCK_TRACE); + if (p->trace_msg_q) { + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_TRACE); + erts_schedule_flush_trace_messages(p->common.id); + } else + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_TRACE); +#endif - state = erts_smp_atomic32_read_acqb(&p->state); + state = erts_smp_atomic32_read_nob(&p->state); if (IS_TRACED(p)) { if (IS_TRACED_FL(p, F_TRACE_CALLS) && !(state & ERTS_PSFLG_FREE)) erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_OUT); - if (state & (ERTS_PSFLG_FREE|ERTS_PSFLG_EXITING)) { + if ((state & (ERTS_PSFLG_FREE|ERTS_PSFLG_EXITING)) == ERTS_PSFLG_EXITING) { if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT)) - trace_sched(p, ((state & ERTS_PSFLG_FREE) - ? am_out_exited - : am_out_exiting)); + trace_sched(p, ERTS_PROC_LOCK_MAIN, + ((state & ERTS_PSFLG_FREE) + ? am_out_exited + : am_out_exiting)); } else { - if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED)) - trace_sched(p, am_out); - else if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS)) - trace_virtual_sched(p, am_out); + if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED) || + ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS)) + trace_sched(p, ERTS_PROC_LOCK_MAIN, am_out); } } + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + + /* have to re-read state after taking lock */ + state = erts_smp_atomic32_read_nob(&p->state); + #ifdef ERTS_SMP if (state & ERTS_PSFLG_PENDING_EXIT) erts_handle_pending_exit(p, (ERTS_PROC_LOCK_MAIN @@ -9480,6 +9388,8 @@ Process *schedule(Process *p, int calls) erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER); + if (state & ERTS_PSFLG_FREE) { #ifdef ERTS_SMP ASSERT(esdp->free_process == p); @@ -9516,15 +9426,16 @@ Process *schedule(Process *p, int calls) #ifdef ERTS_SMP ErtsMigrationPaths *mps; ErtsMigrationPath *mp; - ErtsProcList *pnd_xtrs = rq->procs.pending_exiters; - if (erts_proclist_fetch(&pnd_xtrs, NULL)) { - rq->procs.pending_exiters = NULL; - erts_smp_runq_unlock(rq); - handle_pending_exiters(pnd_xtrs); - erts_smp_runq_lock(rq); - } if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + ErtsProcList *pnd_xtrs = rq->procs.pending_exiters; + if (erts_proclist_fetch(&pnd_xtrs, NULL)) { + rq->procs.pending_exiters = NULL; + erts_smp_runq_unlock(rq); + handle_pending_exiters(pnd_xtrs); + erts_smp_runq_lock(rq); + } + if (rq->check_balance_reds <= 0) check_balance(rq); @@ -9568,12 +9479,10 @@ Process *schedule(Process *p, int calls) erts_aint32_t aux_work; int leader_update = erts_thr_progress_update(esdp); aux_work = erts_atomic32_read_acqb(&esdp->ssi->aux_work); - if (aux_work | leader_update | ERTS_SCHED_FAIR) { + if (aux_work | leader_update) { erts_smp_runq_unlock(rq); if (leader_update) erts_thr_progress_leader_update(esdp); - else if (ERTS_SCHED_FAIR) - ERTS_SCHED_FAIR_YIELD(); if (aux_work) handle_aux_work(&esdp->aux_work_data, aux_work, 0); erts_smp_runq_lock(rq); @@ -9642,7 +9551,7 @@ Process *schedule(Process *p, int calls) scheduler_wait(&fcalls, esdp, rq); flags = ERTS_RUNQ_FLGS_SET_NOB(rq, ERTS_RUNQ_FLG_EXEC); flags |= ERTS_RUNQ_FLG_EXEC; - + ERTS_MSACC_UPDATE_CACHE(); #ifdef ERTS_SMP non_empty_runq(rq); #endif @@ -9651,12 +9560,14 @@ Process *schedule(Process *p, int calls) } else if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && (fcalls > input_reductions && - prepare_for_sys_schedule(esdp, !0))) { + prepare_for_sys_schedule(!0))) { ErtsMonotonicTime current_time; /* * Schedule system-level activities. */ + ERTS_MSACC_PUSH_STATE_CACHED_M(); + erts_smp_atomic32_set_relb(&function_calls, 0); fcalls = 0; @@ -9664,7 +9575,12 @@ Process *schedule(Process *p, int calls) erts_sys_schedule_interrupt(0); #endif erts_smp_runq_unlock(rq); + + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); + LTTNG2(scheduler_poll, esdp->no, 1); + erl_sys_schedule(1); + ERTS_MSACC_POP_STATE_M(); current_time = erts_get_monotonic_time(esdp); if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) @@ -9722,11 +9638,12 @@ Process *schedule(Process *p, int calls) pick_next_process: { erts_aint32_t psflg_band_mask; int prio_q; - int qmask; + int qmask, qbit; flags = ERTS_RUNQ_FLGS_GET_NOB(rq); qmask = (int) (flags & ERTS_RUNQ_FLGS_PROCS_QMASK); - switch (qmask & -qmask) { + qbit = qmask & -qmask; + switch (qbit) { case MAX_BIT: prio_q = PRIORITY_MAX; break; @@ -9742,9 +9659,12 @@ Process *schedule(Process *p, int calls) case 0: /* No process at all */ default: ASSERT(qmask == 0); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER); goto check_activities_to_run; } + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_EMULATOR); + BM_START_TIMER(system); /* @@ -9754,20 +9674,11 @@ Process *schedule(Process *p, int calls) ASSERT(p); /* Wrong qmask in rq->flags? */ - psflg_band_mask = ~(((erts_aint32_t) 1) << (ERTS_PSFLGS_GET_PRQ_PRIO(state) - + ERTS_PSFLGS_IN_PRQ_MASK_OFFSET)); - -#ifdef ERTS_DIRTY_SCHEDULERS - ASSERT((state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) != - (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)); - if (state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) { - ASSERT((ERTS_SCHEDULER_IS_DIRTY_CPU(esdp) && (state & ERTS_PSFLG_DIRTY_CPU_PROC)) || - (ERTS_SCHEDULER_IS_DIRTY_IO(esdp) && (state & ERTS_PSFLG_DIRTY_IO_PROC))); - if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !(state & ERTS_PSFLG_ACTIVE_SYS)) - goto pick_next_process; - state &= ~(ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q); - } -#endif + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) + psflg_band_mask = ~((erts_aint32_t) 0); + else + psflg_band_mask = ~(((erts_aint32_t) 1) << (ERTS_PSFLGS_GET_PRQ_PRIO(state) + + ERTS_PSFLGS_IN_PRQ_MASK_OFFSET)); if (!(state & ERTS_PSFLG_PROXY)) psflg_band_mask &= ~ERTS_PSFLG_IN_RUNQ; @@ -9790,9 +9701,11 @@ Process *schedule(Process *p, int calls) | ERTS_PSFLG_RUNNING_SYS))) { tmp = state & (ERTS_PSFLG_SUSPENDED | ERTS_PSFLG_PENDING_EXIT - | ERTS_PSFLG_ACTIVE_SYS); + | ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_ACTIVE_SYS); if (tmp != ERTS_PSFLG_SUSPENDED) { - if (state & ERTS_PSFLG_ACTIVE_SYS) + if (state & (ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) new |= ERTS_PSFLG_RUNNING_SYS; else new |= ERTS_PSFLG_RUNNING; @@ -9805,7 +9718,8 @@ Process *schedule(Process *p, int calls) | ERTS_PSFLG_FREE)) || ((state & (ERTS_PSFLG_SUSPENDED | ERTS_PSFLG_PENDING_EXIT - | ERTS_PSFLG_ACTIVE_SYS)) + | ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) == ERTS_PSFLG_SUSPENDED)) { if (proxy_p) { free_proxy_proc(proxy_p); @@ -9826,10 +9740,42 @@ Process *schedule(Process *p, int calls) esdp->current_process = p; + + reds = context_reds; + +#ifdef ERTS_SMP + + erts_smp_runq_unlock(rq); + +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_SCHEDULER_IS_DIRTY(esdp)) { +#ifdef DEBUG + int old_dqbit; +#endif + int dqbit = qbit; + + if (rq == ERTS_DIRTY_CPU_RUNQ) + dqbit <<= ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET; + else { + ASSERT(rq == ERTS_DIRTY_IO_RUNQ); + dqbit <<= ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET; + } + +#ifdef DEBUG + old_dqbit = (int) +#else + (void) +#endif + erts_smp_atomic32_read_band_mb(&p->dirty_state, ~dqbit); + ASSERT(old_dqbit & dqbit); + } +#endif /* ERTS_DIRTY_SCHEDULERS */ + +#endif /* ERTS_SMP */ + } #ifdef ERTS_SMP - erts_smp_runq_unlock(rq); if (flags & ERTS_RUNQ_FLG_PROTECTED) (void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED); @@ -9842,10 +9788,7 @@ Process *schedule(Process *p, int calls) if (erts_sched_stat.enabled) { int prio; - UWord old = ERTS_PROC_SCHED_ID(p, - (ERTS_PROC_LOCK_MAIN - | ERTS_PROC_LOCK_STATUS), - (UWord) esdp->no); + UWord old = ERTS_PROC_SCHED_ID(p, (UWord) esdp->no); int migrated = old && old != esdp->no; #ifdef ERTS_DIRTY_SCHEDULERS @@ -9864,48 +9807,99 @@ Process *schedule(Process *p, int calls) erts_smp_spin_unlock(&erts_sched_stat.lock); } - if (ERTS_PROC_PENDING_EXIT(p)) { + ASSERT(!p->scheduler_data); + p->scheduler_data = esdp; + + state = erts_smp_atomic32_read_nob(&p->state); + +#ifdef ERTS_DIRTY_SCHEDULERS + if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) { + if (!!(state & ERTS_PSFLGS_DIRTY_WORK) + & !(state & ERTS_PSFLG_ACTIVE_SYS)) { + /* Migrate to dirty scheduler... */ + sunlock_sched_out_proc: + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + p->fcalls = reds; + goto sched_out_proc; + + } + } + else { + if (state & (ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_PENDING_EXIT + | ERTS_PSFLG_EXITING)) { + /* Migrate to normal scheduler... */ + goto sunlock_sched_out_proc; + } + if ((state & ERTS_PSFLG_DIRTY_ACTIVE_SYS) + && rq == ERTS_DIRTY_IO_RUNQ) { + /* Migrate to dirty cpu scheduler... */ + goto sunlock_sched_out_proc; + } + + ASSERT((state & ERTS_PSFLG_DIRTY_ACTIVE_SYS) + || *p->i == (BeamInstr) em_call_nif); + + ASSERT(rq == ERTS_DIRTY_CPU_RUNQ + ? (state & (ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) + : (rq == ERTS_DIRTY_IO_RUNQ + && (state & ERTS_PSFLG_DIRTY_IO_PROC))); + } +#endif + + if (state & ERTS_PSFLG_PENDING_EXIT) { erts_handle_pending_exit(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); state = erts_smp_atomic32_read_nob(&p->state); } - ASSERT(!p->scheduler_data); - p->scheduler_data = esdp; -#endif - reds = context_reds; + +#endif /* ERTS_SMP */ + + p->fcalls = reds; + + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); if (IS_TRACED(p)) { if (state & ERTS_PSFLG_EXITING) { if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT)) - trace_sched(p, am_in_exiting); + trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in_exiting); } else { - if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED)) - trace_sched(p, am_in); - else if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS)) - trace_virtual_sched(p, am_in); + if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED) || + ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS)) + trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in); } if (IS_TRACED_FL(p, F_TRACE_CALLS)) { erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_IN); } } - erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); #ifdef ERTS_SMP - if (is_not_nil(ERTS_TRACER_PROC(p))) - erts_check_my_tracer_proc(p); + /* Clears tracer if it has been removed */ + (void)ERTS_TRACER_PROC_IS_ENABLED(p); #endif if (state & ERTS_PSFLG_RUNNING_SYS) { - reds -= execute_sys_tasks(p, &state, reds); - if (reds <= 0 + /* + * GC is normally never delayed when a process + * is scheduled out, but might be when executing + * hand written beam assembly in + * prim_eval:'receive'. If GC is delayed we are + * not allowed to execute system tasks. + */ + if (!(p->flags & F_DELAY_GC)) { + reds -= execute_sys_tasks(p, &state, reds); + if (reds <= 0 #ifdef ERTS_DIRTY_SCHEDULERS - || (state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) + || ERTS_SCHEDULER_IS_DIRTY(esdp) + || (state & ERTS_PSFLGS_DIRTY_WORK) #endif - ) { - p->fcalls = reds; - goto sched_out_proc; + ) { + p->fcalls = reds; + goto sched_out_proc; + } } ASSERT(state & ERTS_PSFLG_RUNNING_SYS); @@ -9934,13 +9928,13 @@ Process *schedule(Process *p, int calls) } } - if (!(state & ERTS_PSFLG_EXITING) - && ((FLAGS(p) & F_FORCE_GC) - || (MSO(p).overhead > BIN_VHEAP_SZ(p)))) { - reds -= erts_garbage_collect(p, 0, p->arg_reg, p->arity); - if (reds <= 0) { - p->fcalls = reds; - goto sched_out_proc; + if (ERTS_IS_GC_DESIRED(p)) { + if (!(state & ERTS_PSFLG_EXITING) && !(p->flags & (F_DELAY_GC|F_DISABLE_GC))) { + reds -= erts_garbage_collect_nobump(p, 0, p->arg_reg, p->arity); + if (reds <= 0) { + p->fcalls = reds; + goto sched_out_proc; + } } } @@ -9949,7 +9943,6 @@ Process *schedule(Process *p, int calls) proxy_p = NULL; } - p->fcalls = reds; ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); /* Never run a suspended process */ @@ -9980,7 +9973,7 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result) if (rp) { ErtsProcLocks rp_locks; ErlOffHeap *ohp; - ErlHeapFragment* bp; + ErtsMessage *mp; Eterm *hp, msg, req_id, result; Uint st_result_sz, hsz; #ifdef DEBUG @@ -9992,11 +9985,7 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result) st_result_sz = is_immed(st_result) ? 0 : size_object(st_result); hsz = st->req_id_sz + st_result_sz + 4 /* 3-tuple */; - hp = erts_alloc_message_heap(hsz, - &bp, - &ohp, - rp, - &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, hsz, &hp, &ohp); #ifdef DEBUG hp_start = hp; @@ -10021,7 +10010,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); + erts_queue_message(rp, &rp_locks, mp, msg); if (c_p == rp) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -10189,8 +10178,7 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) { int garbage_collected = 0; erts_aint32_t state = *statep; - int max_reds = in_reds; - int reds = 0; + int reds = in_reds; int qmask = 0; ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN); @@ -10218,31 +10206,44 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) if (c_p->flags & F_DISABLE_GC) { save_gc_task(c_p, st, st_prio); st = NULL; - reds++; + reds--; } else { if (!garbage_collected) { FLAGS(c_p) |= F_NEED_FULLSWEEP; - reds += erts_garbage_collect(c_p, - 0, - c_p->arg_reg, - c_p->arity); + reds -= erts_garbage_collect_nobump(c_p, + 0, + c_p->arg_reg, + c_p->arity); garbage_collected = 1; } st_res = am_true; } break; - case ERTS_PSTT_CPC: + case ERTS_PSTT_CPC: { + int cpc_reds = 0; st_res = erts_check_process_code(c_p, st->arg[0], - st->arg[1] == am_true, - &reds); + unsigned_val(st->arg[1]), + &cpc_reds); + reds -= cpc_reds; if (is_non_value(st_res)) { /* Needed gc, but gc was disabled */ save_gc_task(c_p, st, st_prio); st = NULL; } break; + } + case ERTS_PSTT_COHMQ: + reds -= erts_complete_off_heap_message_queue_change(c_p); + st_res = am_true; + break; +#ifdef ERTS_SMP + case ERTS_PSTT_FTMQ: + reds -= erts_flush_trace_messages(c_p, ERTS_PROC_LOCK_MAIN); + st_res = am_true; + break; +#endif default: ERTS_INTERNAL_ERROR("Invalid process sys task type"); st_res = am_false; @@ -10252,11 +10253,11 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) reds += notify_sys_task_executed(c_p, st, st_res); state = erts_smp_atomic32_read_acqb(&c_p->state); - } while (qmask && reds < max_reds); + } while (qmask && reds > 0); *statep = state; - return reds; + return in_reds - reds; } static int @@ -10285,6 +10286,15 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds) case ERTS_PSTT_CPC: st_res = am_false; break; + case ERTS_PSTT_COHMQ: + st_res = am_false; + break; +#ifdef ERTS_SMP + case ERTS_PSTT_FTMQ: + reds -= erts_flush_trace_messages(c_p, ERTS_PROC_LOCK_MAIN); + st_res = am_true; + break; +#endif default: ERTS_INTERNAL_ERROR("Invalid process sys task type"); st_res = am_false; @@ -10303,10 +10313,8 @@ BIF_RETTYPE erts_internal_request_system_task_3(BIF_ALIST_3) { Process *rp = erts_proc_lookup(BIF_ARG_1); - ErtsProcSysTaskQs *stqs, *free_stqs = NULL; ErtsProcSysTask *st = NULL; - erts_aint32_t prio, rp_state; - int rp_locked; + erts_aint32_t prio; Eterm noproc_res, req_type; if (!rp && !is_internal_pid(BIF_ARG_1)) { @@ -10363,7 +10371,6 @@ erts_internal_request_system_task_3(BIF_ALIST_3) } st = erts_alloc(ERTS_ALC_T_PROC_SYS_TSK, ERTS_PROC_SYS_TASK_SIZE(tot_sz)); - st->next = st->prev = st; /* Prep for empty prio queue */ ERTS_INIT_OFF_HEAP(&st->off_heap); hp = &st->heap[0]; @@ -10395,7 +10402,7 @@ erts_internal_request_system_task_3(BIF_ALIST_3) case am_check_process_code: if (is_not_atom(st->arg[0])) goto badarg; - if (st->arg[1] != am_true && st->arg[1] != am_false) + if (is_not_small(st->arg[1]) || (unsigned_val(st->arg[1]) & ~ERTS_CPC_ALL)) goto badarg; noproc_res = am_false; st->type = ERTS_PSTT_CPC; @@ -10407,95 +10414,11 @@ erts_internal_request_system_task_3(BIF_ALIST_3) goto badarg; } - rp_state = erts_smp_atomic32_read_nob(&rp->state); - - rp_locked = 0; - - free_stqs = NULL; - if (rp_state & ERTS_PSFLG_ACTIVE_SYS) - stqs = NULL; - else { - alloc_qs: - stqs = proc_sys_task_queues_alloc(); - stqs->qmask = 1 << prio; - stqs->ncount = 0; - stqs->q[PRIORITY_MAX] = NULL; - stqs->q[PRIORITY_HIGH] = NULL; - stqs->q[PRIORITY_NORMAL] = NULL; - stqs->q[PRIORITY_LOW] = NULL; - stqs->q[prio] = st; - } - - if (!rp_locked) { - rp_locked = 1; - erts_smp_proc_lock(rp, ERTS_PROC_LOCK_STATUS); - - rp_state = erts_smp_atomic32_read_nob(&rp->state); - if (rp_state & ERTS_PSFLG_EXITING) { - erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); - rp = NULL; - free_stqs = stqs; - goto noproc; - } - } - - if (!rp->sys_task_qs) { - if (stqs) - rp->sys_task_qs = stqs; - else - goto alloc_qs; - } - else { - if (stqs) - free_stqs = stqs; - stqs = rp->sys_task_qs; - if (!stqs->q[prio]) { - stqs->q[prio] = st; - stqs->qmask |= 1 << prio; - } - else { - st->next = stqs->q[prio]; - st->prev = stqs->q[prio]->prev; - st->next->prev = st; - st->prev->next = st; - ASSERT(stqs->qmask & (1 << prio)); - } - } - - if (ERTS_PSFLGS_GET_ACT_PRIO(rp_state) > prio) { - erts_aint32_t n, a, e; - /* Need to elevate actual prio */ - - a = rp_state; - do { - if (ERTS_PSFLGS_GET_ACT_PRIO(a) <= prio) { - n = a; - break; - } - n = e = a; - n &= ~ERTS_PSFLGS_ACT_PRIO_MASK; - n |= (prio << ERTS_PSFLGS_ACT_PRIO_OFFSET); - a = erts_smp_atomic32_cmpxchg_nob(&rp->state, n, e); - } while (a != e); - rp_state = n; + if (!schedule_process_sys_task(rp, prio, st)) { + noproc: + notify_sys_task_executed(BIF_P, st, noproc_res); } - /* - * schedule_process_sys_task() unlocks status - * lock on process. - */ - schedule_process_sys_task(rp, rp_state, NULL); - - if (free_stqs) - proc_sys_task_queues_free(free_stqs); - - BIF_RET(am_ok); - -noproc: - - notify_sys_task_executed(BIF_P, st, noproc_res); - if (free_stqs) - proc_sys_task_queues_free(free_stqs); BIF_RET(am_ok); badarg: @@ -10504,12 +10427,48 @@ badarg: erts_cleanup_offheap(&st->off_heap); erts_free(ERTS_ALC_T_PROC_SYS_TSK, st); } - if (free_stqs) - proc_sys_task_queues_free(free_stqs); BIF_ERROR(BIF_P, BADARG); } static void +erts_schedule_generic_sys_task(Eterm pid, ErtsProcSysTaskType type) +{ + Process *rp = erts_proc_lookup(pid); + if (rp) { + ErtsProcSysTask *st; + erts_aint32_t state; + int i; + + st = erts_alloc(ERTS_ALC_T_PROC_SYS_TSK, + ERTS_PROC_SYS_TASK_SIZE(0)); + st->type = type; + st->requester = NIL; + st->reply_tag = NIL; + st->req_id = NIL; + st->req_id_sz = 0; + for (i = 0; i < ERTS_MAX_PROC_SYS_TASK_ARGS; i++) + st->arg[i] = NIL; + ERTS_INIT_OFF_HEAP(&st->off_heap); + state = erts_smp_atomic32_read_nob(&rp->state); + + if (!schedule_process_sys_task(rp, ERTS_PSFLGS_GET_USR_PRIO(state), st)) + erts_free(ERTS_ALC_T_PROC_SYS_TSK, st); + } +} + +void +erts_schedule_complete_off_heap_message_queue_change(Eterm pid) +{ + erts_schedule_generic_sys_task(pid, ERTS_PSTT_COHMQ); +} + +void +erts_schedule_flush_trace_messages(Eterm pid) +{ + erts_schedule_generic_sys_task(pid, ERTS_PSTT_FTMQ); +} + +static void save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio) { erts_aint32_t state; @@ -10528,7 +10487,7 @@ save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio) qs->q[PRIORITY_NORMAL] = NULL; qs->q[PRIORITY_LOW] = NULL; qs->q[prio] = st; - (void) ERTS_PROC_SET_DELAYED_GC_TASK_QS(c_p, ERTS_PROC_LOCK_MAIN, qs); + (void) ERTS_PROC_SET_DELAYED_GC_TASK_QS(c_p, qs); } else { if (!qs->q[prio]) { @@ -10675,7 +10634,7 @@ erts_set_gc_state(Process *c_p, int enable) erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS); - (void) ERTS_PROC_SET_DELAYED_GC_TASK_QS(c_p, ERTS_PROC_LOCK_MAIN, NULL); + (void) ERTS_PROC_SET_DELAYED_GC_TASK_QS(c_p, NULL); if (dgc_tsk_qs) proc_sys_task_queues_free(dgc_tsk_qs); @@ -10894,6 +10853,9 @@ static void early_init_process_struct(void *varg, Eterm data) Process *proc = arg->proc; proc->common.id = make_internal_pid(data); +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_atomic32_init_nob(&proc->dirty_state, 0); +#endif erts_smp_atomic32_init_relb(&proc->state, arg->state); #ifdef ERTS_SMP @@ -10954,6 +10916,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). Eterm args, /* Arguments for function (must be well-formed list). */ ErlSpawnOpts* so) /* Options for spawn. */ { + Uint flags = 0; ErtsRunQueue *rq = NULL; Process *p; Sint arity; /* Number of arguments. */ @@ -10963,10 +10926,13 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). Eterm res = THE_NON_VALUE; erts_aint32_t state = 0; erts_aint32_t prio = (erts_aint32_t) PRIORITY_NORMAL; + ErtsProcLocks locks = ERTS_PROC_LOCKS_ALL; +#ifdef SHCOPY_SPAWN + erts_shcopy_t info; + INITIALIZE_SHCOPY(info); +#endif -#ifdef ERTS_SMP erts_smp_proc_lock(parent, ERTS_PROC_LOCKS_ALL_MINOR); -#endif /* * Check for errors. @@ -10991,6 +10957,15 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). state |= (((prio & ERTS_PSFLGS_PRIO_MASK) << ERTS_PSFLGS_ACT_PRIO_OFFSET) | ((prio & ERTS_PSFLGS_PRIO_MASK) << ERTS_PSFLGS_USR_PRIO_OFFSET)); + if (so->flags & SPO_OFF_HEAP_MSGQ) { + state |= ERTS_PSFLG_OFF_HEAP_MSGQ; + flags |= F_OFF_HEAP_MSGQ; + } + else if (so->flags & SPO_ON_HEAP_MSGQ) { + state |= ERTS_PSFLG_ON_HEAP_MSGQ; + flags |= F_ON_HEAP_MSGQ; + } + if (!rq) rq = erts_get_runq_proc(parent); @@ -11009,11 +10984,15 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). BM_COUNT(processes_spawned); BM_SWAP_TIMER(system,size); +#ifdef SHCOPY_SPAWN + arg_size = copy_shared_calculate(args, &info); +#else arg_size = size_object(args); +#endif BM_SWAP_TIMER(size,system); heap_need = arg_size; - p->flags = erts_default_process_flags; + p->flags = flags; p->static_flags = 0; if (so->flags & SPO_SYSTEM_PROC) @@ -11062,12 +11041,13 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->stop = p->hend = p->heap + sz; p->htop = p->heap; p->heap_sz = sz; + p->abandoned_heap = NULL; + p->live_hf_end = ERTS_INVALID_HFRAG_PTR; p->catches = 0; p->bin_vheap_sz = p->min_vheap_size; p->bin_old_vheap_sz = p->min_vheap_size; p->bin_old_vheap = 0; - p->bin_vheap_mature = 0; p->sys_task_qs = NULL; @@ -11086,7 +11066,12 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). BM_MESSAGE(args,p,parent); BM_START_TIMER(system); BM_SWAP_TIMER(system,copy); +#ifdef SHCOPY_SPAWN + p->arg_reg[2] = copy_shared_perform(args, arg_size, &info, &p->htop, &p->off_heap); + DESTROY_SHCOPY(info); +#else p->arg_reg[2] = copy_struct(args, arg_size, &p->htop, &p->off_heap); +#endif BM_MESSAGE_COPIED(arg_size); BM_SWAP_TIMER(copy,system); p->arity = 3; @@ -11116,7 +11101,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). : STORE_NC(&p->htop, &p->off_heap, parent->group_leader); } - erts_get_default_tracing(&ERTS_TRACE_FLAGS(p), &ERTS_TRACER_PROC(p)); + erts_get_default_proc_tracing(&ERTS_TRACE_FLAGS(p), &ERTS_TRACER(p)); p->msg.first = NULL; p->msg.last = &p->msg.first; @@ -11132,8 +11117,9 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->accessor_bif_timers = NULL; #endif p->mbuf = NULL; + p->msg_frag = NULL; p->mbuf_sz = 0; - p->psd = NULL; + erts_smp_atomic_init_nob(&p->psd, (erts_aint_t) NULL); p->dictionary = NULL; p->seq_trace_lastcnt = 0; p->seq_trace_clock = 0; @@ -11151,21 +11137,60 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->last_old_htop = NULL; #endif +#ifdef ERTS_SMP + p->trace_msg_q = NULL; + p->scheduler_data = NULL; + p->suspendee = NIL; + p->pending_suspenders = NULL; + p->pending_exit.reason = THE_NON_VALUE; + p->pending_exit.bp = NULL; +#endif + +#if !defined(NO_FPE_SIGNALS) || defined(HIPE) + p->fp_exception = 0; +#endif + if (IS_TRACED(parent)) { if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOS) { ERTS_TRACE_FLAGS(p) |= (ERTS_TRACE_FLAGS(parent) & TRACEE_FLAGS); - ERTS_TRACER_PROC(p) = ERTS_TRACER_PROC(parent); + erts_tracer_replace(&p->common, ERTS_TRACER(parent)); } - if (ARE_TRACE_FLAGS_ON(parent, F_TRACE_PROCS)) { - trace_proc_spawn(parent, p->common.id, mod, func, args); - } - if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOS1) { + if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOS1) { /* Overrides TRACE_CHILDREN */ ERTS_TRACE_FLAGS(p) |= (ERTS_TRACE_FLAGS(parent) & TRACEE_FLAGS); - ERTS_TRACER_PROC(p) = ERTS_TRACER_PROC(parent); + erts_tracer_replace(&p->common, ERTS_TRACER(parent)); ERTS_TRACE_FLAGS(p) &= ~(F_TRACE_SOS1 | F_TRACE_SOS); ERTS_TRACE_FLAGS(parent) &= ~(F_TRACE_SOS1 | F_TRACE_SOS); } + if (so->flags & SPO_LINK && ERTS_TRACE_FLAGS(parent) & (F_TRACE_SOL|F_TRACE_SOL1)) { + ERTS_TRACE_FLAGS(p) |= (ERTS_TRACE_FLAGS(parent)&TRACEE_FLAGS); + erts_tracer_replace(&p->common, ERTS_TRACER(parent)); + if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOL1) {/*maybe override*/ + ERTS_TRACE_FLAGS(p) &= ~(F_TRACE_SOL1 | F_TRACE_SOL); + ERTS_TRACE_FLAGS(parent) &= ~(F_TRACE_SOL1 | F_TRACE_SOL); + } + } + if (ARE_TRACE_FLAGS_ON(parent, F_TRACE_PROCS)) { + locks &= ~(ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + erts_smp_proc_unlock(parent, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + trace_proc_spawn(parent, am_spawn, p->common.id, mod, func, args); + if (so->flags & SPO_LINK) + trace_proc(parent, locks, parent, am_link, p->common.id); + } + } + + if (IS_TRACED_FL(p, F_TRACE_PROCS)) { + if ((locks & (ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE)) + == (ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE)) { + /* This happens when parent was not traced, but child is */ + locks &= ~(ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + erts_smp_proc_unlock(parent, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + } + trace_proc_spawn(p, am_spawned, parent->common.id, mod, func, args); + if (so->flags & SPO_LINK) + trace_proc(p, locks, p, am_getting_linked, parent->common.id); } /* @@ -11176,10 +11201,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). #ifdef DEBUG int ret; #endif - if (IS_TRACED_FL(parent, F_TRACE_PROCS)) { - trace_proc(parent, parent, am_link, p->common.id); - } - #ifdef DEBUG ret = erts_add_link(&ERTS_P_LINKS(parent), LINK_PID, p->common.id); ASSERT(ret == 0); @@ -11190,17 +11211,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). erts_add_link(&ERTS_P_LINKS(p), LINK_PID, parent->common.id); #endif - if (IS_TRACED(parent)) { - if (ERTS_TRACE_FLAGS(parent) & (F_TRACE_SOL|F_TRACE_SOL1)) { - ERTS_TRACE_FLAGS(p) |= (ERTS_TRACE_FLAGS(parent)&TRACEE_FLAGS); - ERTS_TRACER_PROC(p) = ERTS_TRACER_PROC(parent); /*maybe steal*/ - - if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOL1) {/*maybe override*/ - ERTS_TRACE_FLAGS(p) &= ~(F_TRACE_SOL1 | F_TRACE_SOL); - ERTS_TRACE_FLAGS(parent) &= ~(F_TRACE_SOL1 | F_TRACE_SOL); - } - } - } } /* @@ -11215,19 +11225,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). so->mref = mref; } -#ifdef ERTS_SMP - p->scheduler_data = NULL; - p->suspendee = NIL; - p->pending_suspenders = NULL; - p->pending_exit.reason = THE_NON_VALUE; - p->pending_exit.bp = NULL; -#endif - -#if !defined(NO_FPE_SIGNALS) || defined(HIPE) - p->fp_exception = 0; -#endif - - erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL); + erts_smp_proc_unlock(p, locks); res = p->common.id; @@ -11235,6 +11233,8 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). * Schedule process for execution. */ + erts_smp_proc_unlock(parent, locks & ERTS_PROC_LOCKS_ALL_MINOR); + schedule_process(p, state, 0); VERBOSE(DEBUG_PROCESSES, ("Created a new process: %T\n",p->common.id)); @@ -11248,10 +11248,11 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). DTRACE2(process_spawn, process_name, mfa); } #endif + return res; error: - erts_smp_proc_unlock(parent, ERTS_PROC_LOCKS_ALL_MINOR); + erts_smp_proc_unlock(parent, locks & ERTS_PROC_LOCKS_ALL_MINOR); return res; } @@ -11267,6 +11268,8 @@ void erts_init_empty_process(Process *p) p->stop = NULL; p->hend = NULL; p->heap = NULL; + p->abandoned_heap = NULL; + p->live_hf_end = ERTS_INVALID_HFRAG_PTR; p->gen_gcs = 0; p->max_gen_gcs = 0; p->min_heap_size = 0; @@ -11274,7 +11277,7 @@ void erts_init_empty_process(Process *p) p->rcount = 0; p->common.id = ERTS_INVALID_PID; p->reds = 0; - ERTS_TRACER_PROC(p) = NIL; + ERTS_TRACER(p) = erts_tracer_nil; ERTS_TRACE_FLAGS(p) = F_INITIAL_TRACE_FLAGS; p->group_leader = ERTS_INVALID_PID; p->flags = 0; @@ -11287,7 +11290,6 @@ void erts_init_empty_process(Process *p) p->bin_old_vheap_sz = BIN_VH_MIN_SIZE; p->bin_old_vheap = 0; p->sys_task_qs = NULL; - p->bin_vheap_mature = 0; ERTS_PTMR_INIT(p); p->next = NULL; p->off_heap.first = NULL; @@ -11299,8 +11301,9 @@ void erts_init_empty_process(Process *p) p->old_htop = NULL; p->old_heap = NULL; p->mbuf = NULL; + p->msg_frag = NULL; p->mbuf_sz = 0; - p->psd = NULL; + erts_smp_atomic_init_nob(&p->psd, (erts_aint_t) NULL); ERTS_P_MONITORS(p) = NULL; ERTS_P_LINKS(p) = NULL; /* List of links */ p->nodes_monitors = NULL; @@ -11356,6 +11359,9 @@ void erts_init_empty_process(Process *p) p->last_old_htop = NULL; #endif +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_atomic32_init_nob(&p->dirty_state, 0); +#endif erts_smp_atomic32_init_nob(&p->state, (erts_aint32_t) PRIORITY_NORMAL); #ifdef ERTS_SMP @@ -11387,9 +11393,11 @@ erts_debug_verify_clean_empty_process(Process* p) ASSERT(p->htop == NULL); ASSERT(p->stop == NULL); ASSERT(p->hend == NULL); + ASSERT(p->abandoned_heap == NULL); + ASSERT(p->live_hf_end == ERTS_INVALID_HFRAG_PTR); ASSERT(p->heap == NULL); ASSERT(p->common.id == ERTS_INVALID_PID); - ASSERT(ERTS_TRACER_PROC(p) == NIL); + ASSERT(ERTS_TRACER_IS_NIL(ERTS_TRACER(p))); ASSERT(ERTS_TRACE_FLAGS(p) == F_INITIAL_TRACE_FLAGS); ASSERT(p->group_leader == ERTS_INVALID_PID); ASSERT(p->next == NULL); @@ -11464,14 +11472,18 @@ erts_cleanup_empty_process(Process* p) static void delete_process(Process* p) { - ErlMessage* mp; - + Eterm *heap; + ErtsPSD *psd; VERBOSE(DEBUG_PROCESSES, ("Removing process: %T\n",p->common.id)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] delete process: %p %p %p %p\n", p->common.id, + HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p))); /* Cleanup psd */ - if (p->psd) - erts_free(ERTS_ALC_T_PSD, p->psd); + psd = (ErtsPSD *) erts_smp_atomic_read_nob(&p->psd); + + if (psd) + erts_free(ERTS_ALC_T_PSD, psd); /* Clean binaries and funs */ erts_cleanup_offheap(&p->off_heap); @@ -11490,16 +11502,17 @@ delete_process(Process* p) * Release heaps. Clobber contents in DEBUG build. */ - -#ifdef DEBUG - sys_memset(p->heap, DEBUG_BAD_BYTE, p->heap_sz*sizeof(Eterm)); -#endif - #ifdef HIPE hipe_delete_process(&p->hipe); #endif - ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, (void*) p->heap, p->heap_sz*sizeof(Eterm)); + heap = p->abandoned_heap ? p->abandoned_heap : p->heap; + +#ifdef DEBUG + sys_memset(heap, DEBUG_BAD_BYTE, p->heap_sz*sizeof(Eterm)); +#endif + + ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, (void*) heap, p->heap_sz*sizeof(Eterm)); if (p->old_heap != NULL) { #ifdef DEBUG @@ -11518,27 +11531,14 @@ delete_process(Process* p) free_message_buffer(p->mbuf); } + if (p->msg_frag) + erts_cleanup_messages(p->msg_frag); + erts_erase_dicts(p); /* free all pending messages */ - mp = p->msg.first; - while(mp != NULL) { - ErlMessage* next_mp = mp->next; - if (mp->data.attached) { - if (is_value(mp->m[0])) - free_message_buffer(mp->data.heap_frag); - else { - if (is_not_nil(mp->m[1])) { - ErlHeapFragment *heap_frag; - heap_frag = (ErlHeapFragment *) mp->data.dist_ext->ext_endp; - erts_cleanup_offheap(&heap_frag->off_heap); - } - erts_free_dist_ext_copy(mp->data.dist_ext); - } - } - free_message(mp); - mp = next_mp; - } + erts_cleanup_messages(p->msg.first); + p->msg.first = NULL; ASSERT(!p->nodes_monitors); ASSERT(!p->suspend_monitors); @@ -11557,7 +11557,9 @@ set_proc_exiting(Process *p, ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(p) == ERTS_PROC_LOCKS_ALL); enqueue = change_proc_schedule_state(p, - ERTS_PSFLG_SUSPENDED|ERTS_PSFLG_PENDING_EXIT, + (ERTS_PSFLG_SUSPENDED + | ERTS_PSFLG_PENDING_EXIT + | ERTS_PSFLGS_DIRTY_WORK), ERTS_PSFLG_EXITING|ERTS_PSFLG_ACTIVE, &state, &enq_prio, @@ -11591,10 +11593,7 @@ set_proc_exiting(Process *p, } #endif - if (enqueue) - add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), - state, - enq_prio); + add2runq(enqueue, enq_prio, p, state, NULL); } static ERTS_INLINE erts_aint32_t @@ -11697,6 +11696,11 @@ save_pending_exiter(Process *p) else rq = esdp->run_queue; +#ifdef ERTS_DIRTY_SCHEDULERS + if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) + rq = ERTS_RUNQ_IX(0); /* Handle on ordinary scheduler */ +#endif + plp = proclist_create(p); erts_smp_runq_lock(rq); @@ -11706,13 +11710,8 @@ save_pending_exiter(Process *p) non_empty_runq(rq); erts_smp_runq_unlock(rq); -#ifdef ERTS_DIRTY_SCHEDULERS - if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) - wake_dirty_schedulers(rq, 0); - else -#endif - wake_scheduler(rq); + wake_scheduler(rq); } #endif @@ -11726,35 +11725,47 @@ static ERTS_INLINE void send_exit_message(Process *to, ErtsProcLocks *to_locksp, Eterm exit_term, Uint term_size, Eterm token) { - if (token == NIL -#ifdef USE_VM_PROBES - || token == am_have_dt_utag -#endif - ) { - Eterm* hp; - Eterm mess; - ErlHeapFragment* bp; - ErlOffHeap *ohp; - - hp = erts_alloc_message_heap(term_size, &bp, &ohp, to, to_locksp); + ErtsMessage *mp; + ErlOffHeap *ohp; + Eterm* hp; + Eterm mess; +#ifdef SHCOPY_SEND + erts_shcopy_t info; +#endif + + if (!have_seqtrace(token)) { +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + term_size = copy_shared_calculate(exit_term, &info); + mp = erts_alloc_message_heap(to, to_locksp, term_size, &hp, &ohp); + mess = copy_shared_perform(exit_term, term_size, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else + mp = erts_alloc_message_heap(to, to_locksp, term_size, &hp, &ohp); mess = copy_struct(exit_term, term_size, &hp, ohp); - erts_queue_message(to, to_locksp, bp, mess, NIL); +#endif + erts_queue_message(to, to_locksp, mp, mess); } else { - ErlHeapFragment* bp; - Eterm* hp; - Eterm mess; Eterm temp_token; Uint sz_token; ASSERT(is_tuple(token)); sz_token = size_object(token); - bp = new_message_buffer(term_size+sz_token); - hp = bp->mem; - mess = copy_struct(exit_term, term_size, &hp, &bp->off_heap); +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + term_size = copy_shared_calculate(exit_term, &info); + mp = erts_alloc_message_heap(to, to_locksp, term_size+sz_token, &hp, &ohp); + mess = copy_shared_perform(exit_term, term_size, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else + mp = erts_alloc_message_heap(to, to_locksp, term_size+sz_token, &hp, &ohp); + mess = copy_struct(exit_term, term_size, &hp, ohp); +#endif /* 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); + seq_trace_output(token, mess, SEQ_TRACE_SEND, to->common.id, to); + temp_token = copy_struct(token, sz_token, &hp, ohp); + ERL_MESSAGE_TOKEN(mp) = temp_token; + erts_queue_message(to, to_locksp, mp, mess); } } @@ -11863,11 +11874,10 @@ send_exit_signal(Process *c_p, /* current process if and only if ((state & ERTS_PSFLG_TRAP_EXIT) && (reason != am_kill || (flags & ERTS_XSIG_FLG_IGN_KILL))) { - if (is_not_nil(token) -#ifdef USE_VM_PROBES - && token != am_have_dt_utag -#endif - && token_update) + /* have to release the status lock in order to send the exit message */ + erts_smp_proc_unlock(rp, *rp_locks & ERTS_PROC_LOCKS_XSIG_SEND); + *rp_locks &= ~ERTS_PROC_LOCKS_XSIG_SEND; + if (have_seqtrace(token) && token_update) seq_trace_update_send(token_update); if (is_value(exit_tuple)) send_exit_message(rp, rp_locks, exit_tuple, exit_tuple_sz, token); @@ -12164,6 +12174,7 @@ static void doit_exit_link(ErtsLink *lnk, void *vpcontext) DistEntry *dep; Process *rp; + switch(lnk->type) { case LINK_PID: if(is_internal_port(item)) { @@ -12211,7 +12222,11 @@ static void doit_exit_link(ErtsLink *lnk, void *vpcontext) if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) { /* We didn't exit the process and it is traced */ if (IS_TRACED_FL(rp, F_TRACE_PROCS)) { - trace_proc(p, rp, am_getting_unlinked, p->common.id); + if (rp_locks & ERTS_PROC_LOCKS_XSIG_SEND) { + erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_XSIG_SEND); + rp_locks &= ~ERTS_PROC_LOCKS_XSIG_SEND; + } + trace_proc(NULL, 0, rp, am_getting_unlinked, p->common.id); } } } @@ -12328,8 +12343,6 @@ erts_do_exit_process(Process* p, Eterm reason) if (IS_TRACED_FL(p, F_TRACE_CALLS)) erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_EXITING); - if (IS_TRACED_FL(p,F_TRACE_PROCS)) - trace_proc(p, p, am_exit, reason); } erts_trace_check_exiting(p->common.id); @@ -12345,6 +12358,10 @@ erts_do_exit_process(Process* p, Eterm reason) erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); + if (IS_TRACED_FL(p,F_TRACE_PROCS)) + trace_proc(p, ERTS_PROC_LOCK_MAIN, p, am_exit, reason); + + /* * p->u.initial of this process can *not* be used anymore; * will be overwritten by misc termination data. @@ -12399,14 +12416,39 @@ erts_continue_exit_process(Process *p) #endif #ifdef ERTS_SMP + if (p->flags & F_SCHDLR_ONLN_WAITQ) + abort_sched_onln_chng_waitq(p); + if (p->flags & F_HAVE_BLCKD_MSCHED) { ErtsSchedSuspendResult ssr; - ssr = erts_block_multi_scheduling(p, ERTS_PROC_LOCK_MAIN, 0, 1); + ssr = erts_block_multi_scheduling(p, ERTS_PROC_LOCK_MAIN, 0, 0, 1); switch (ssr) { case ERTS_SCHDLR_SSPND_YIELD_RESTART: goto yield; case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED: + case ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED: case ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED: + case ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED: + case ERTS_SCHDLR_SSPND_DONE: + case ERTS_SCHDLR_SSPND_YIELD_DONE: + p->flags &= ~F_HAVE_BLCKD_MSCHED; + break; + case ERTS_SCHDLR_SSPND_EINVAL: + default: + erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error: %d\n", + __FILE__, __LINE__, (int) ssr); + } + } + if (p->flags & F_HAVE_BLCKD_NMSCHED) { + ErtsSchedSuspendResult ssr; + ssr = erts_block_multi_scheduling(p, ERTS_PROC_LOCK_MAIN, 0, 1, 1); + switch (ssr) { + case ERTS_SCHDLR_SSPND_YIELD_RESTART: + goto yield; + case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED: + case ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED: + case ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED: + case ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED: case ERTS_SCHDLR_SSPND_DONE: case ERTS_SCHDLR_SSPND_YIELD_DONE: p->flags &= ~F_HAVE_BLCKD_MSCHED; @@ -12459,6 +12501,9 @@ erts_continue_exit_process(Process *p) ASSERT(!p->common.u.alive.reg); } + if (IS_TRACED_FL(p, F_TRACE_SCHED_EXIT)) + trace_sched(p, curr_locks, am_out_exited); + erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); curr_locks = ERTS_PROC_LOCKS_ALL; @@ -12531,9 +12576,9 @@ erts_continue_exit_process(Process *p) } dep = (p->flags & F_DISTRIBUTION) ? erts_this_dist_entry : NULL; - scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, ERTS_PROC_LOCKS_ALL, NULL); - pbt = ERTS_PROC_SET_CALL_TIME(p, ERTS_PROC_LOCKS_ALL, NULL); - nif_export = ERTS_PROC_SET_NIF_TRAP_EXPORT(p, ERTS_PROC_LOCKS_ALL, NULL); + scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, NULL); + pbt = ERTS_PROC_SET_CALL_TIME(p, NULL); + nif_export = ERTS_PROC_SET_NIF_TRAP_EXPORT(p, NULL); erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL); #ifdef BM_COUNTERS @@ -12582,6 +12627,12 @@ erts_continue_exit_process(Process *p) if (nif_export) erts_destroy_nif_export(nif_export); +#ifdef ERTS_SMP + erts_flush_trace_messages(p, 0); +#endif + + ERTS_TRACER_CLEAR(&ERTS_TRACER(p)); + delete_process(p); #ifdef ERTS_SMP @@ -12700,7 +12751,7 @@ stack_element_dump(int to, void *to_arg, Eterm* sp, int yreg) } if (is_CP(x)) { - erts_print(to, to_arg, "Return addr %p (", (Eterm *) EXPAND_POINTER(x)); + erts_print(to, to_arg, "Return addr %p (", (Eterm *) x); print_function_from_pc(to, to_arg, cp_val(x)); erts_print(to, to_arg, ")\n"); yreg = 0; diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index b536426b0f..1c01d705a7 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -79,10 +79,8 @@ struct ErtsNodesMonitor_; #define ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT 0 #define ERTS_MAX_NO_OF_SCHEDULERS 1024 -#ifdef ERTS_DIRTY_SCHEDULERS #define ERTS_MAX_NO_OF_DIRTY_CPU_SCHEDULERS ERTS_MAX_NO_OF_SCHEDULERS #define ERTS_MAX_NO_OF_DIRTY_IO_SCHEDULERS ERTS_MAX_NO_OF_SCHEDULERS -#endif #define ERTS_DEFAULT_MAX_PROCESSES (1 << 18) @@ -246,7 +244,9 @@ extern int erts_sched_thread_suggested_stack_size; typedef enum { ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED, + ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED, ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED, + ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED, ERTS_SCHDLR_SSPND_DONE, ERTS_SCHDLR_SSPND_YIELD_RESTART, ERTS_SCHDLR_SSPND_YIELD_DONE, @@ -304,7 +304,6 @@ typedef enum { ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN_IX, ERTS_SSI_AUX_WORK_MISC_THR_PRGR_IX, ERTS_SSI_AUX_WORK_MISC_IX, - ERTS_SSI_AUX_WORK_CHECK_CHILDREN_IX, ERTS_SSI_AUX_WORK_SET_TMO_IX, ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX, ERTS_SSI_AUX_WORK_REAP_PORTS_IX, @@ -337,8 +336,6 @@ typedef enum { (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_MISC_THR_PRGR_IX) #define ERTS_SSI_AUX_WORK_MISC \ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_MISC_IX) -#define ERTS_SSI_AUX_WORK_CHECK_CHILDREN \ - (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_CHECK_CHILDREN_IX) #define ERTS_SSI_AUX_WORK_SET_TMO \ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_SET_TMO_IX) #define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK \ @@ -643,12 +640,6 @@ struct ErtsSchedulerData_ { Process *free_process; ErtsThrPrgrData thr_progress_data; #endif -#if !HEAP_ON_C_STACK - Eterm tmp_heap[TMP_HEAP_SIZE]; - int num_tmp_heap_used; - Eterm beam_emu_tmp_heap[BEAM_EMU_TMP_HEAP_SIZE]; - Eterm erl_arith_tmp_heap[ERL_ARITH_TMP_HEAP_SIZE]; -#endif ErtsSchedulerSleepInfo *ssi; Process *current_process; Uint no; /* Scheduler number for normal schedulers */ @@ -702,13 +693,6 @@ extern ErtsAlignedSchedulerData *erts_aligned_dirty_io_scheduler_data; extern ErtsSchedulerData *erts_scheduler_data; #endif -#ifdef ERTS_SCHED_FAIR -#define ERTS_SCHED_FAIR_YIELD() ETHR_YIELD() -#else -#define ERTS_SCHED_FAIR 0 -#define ERTS_SCHED_FAIR_YIELD() -#endif - #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) int erts_smp_lc_runq_is_locked(ErtsRunQueue *); #endif @@ -834,8 +818,8 @@ typedef struct { #define ERTS_PSD_ERROR_HANDLER_BUF_GET_LOCKS ERTS_PROC_LOCK_MAIN #define ERTS_PSD_ERROR_HANDLER_BUF_SET_LOCKS ERTS_PROC_LOCK_MAIN -#define ERTS_PSD_SAVED_CALLS_BUF_GET_LOCKS ERTS_PROC_LOCK_MAIN -#define ERTS_PSD_SAVED_CALLS_BUF_SET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_SAVED_CALLS_BUF_GET_LOCKS ((ErtsProcLocks) 0) +#define ERTS_PSD_SAVED_CALLS_BUF_SET_LOCKS ((ErtsProcLocks) 0) #define ERTS_PSD_SCHED_ID_GET_LOCKS ERTS_PROC_LOCK_STATUS #define ERTS_PSD_SCHED_ID_SET_LOCKS ERTS_PROC_LOCK_STATUS @@ -846,8 +830,8 @@ typedef struct { #define ERTS_PSD_DELAYED_GC_TASK_QS_GET_LOCKS ERTS_PROC_LOCK_MAIN #define ERTS_PSD_DELAYED_GC_TASK_QS_SET_LOCKS ERTS_PROC_LOCK_MAIN -#define ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS ERTS_PROC_LOCK_MAIN -#define ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS ((ErtsProcLocks) 0) +#define ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS ((ErtsProcLocks) 0) typedef struct { ErtsProcLocks get_locks; @@ -924,7 +908,6 @@ struct ErtsPendingSuspend_ { # define MIN_VHEAP_SIZE(p) (p)->min_vheap_size # define BIN_VHEAP_SZ(p) (p)->bin_vheap_sz -# define BIN_VHEAP_MATURE(p) (p)->bin_vheap_mature # define BIN_OLD_VHEAP_SZ(p) (p)->bin_old_vheap_sz # define BIN_OLD_VHEAP(p) (p)->bin_old_vheap @@ -957,6 +940,16 @@ struct process { #endif /* + * Moved to after "struct hipe_process_state hipe", as a temporary fix for + * LLVM hard-coding offsetof(struct process, hipe.nstack) (sic!) + * (see void X86FrameLowering::adjustForHiPEPrologue(...) in + * lib/Target/X86/X86FrameLowering.cpp). + * + * Used to be below "Eterm* hend". + */ + Eterm* abandoned_heap; + + /* * Saved x registers. */ Uint arity; /* Number of live argument registers (only valid @@ -1038,21 +1031,26 @@ struct process { Uint16 gen_gcs; /* Number of (minor) generational GCs. */ Uint16 max_gen_gcs; /* Max minor gen GCs before fullsweep. */ ErlOffHeap off_heap; /* Off-heap data updated by copy_struct(). */ - ErlHeapFragment* mbuf; /* Pointer to message buffer list */ - Uint mbuf_sz; /* Size of all message buffers */ - ErtsPSD *psd; /* Rarely used process specific data */ + ErlHeapFragment* mbuf; /* Pointer to heap fragment list */ + ErlHeapFragment* live_hf_end; + ErtsMessage *msg_frag; /* Pointer to message fragment list */ + Uint mbuf_sz; /* Total size of heap fragments and message fragments */ + erts_smp_atomic_t psd; /* Rarely used process specific data */ Uint64 bin_vheap_sz; /* Virtual heap block size for binaries */ - Uint64 bin_vheap_mature; /* Virtual heap block size for binaries */ Uint64 bin_old_vheap_sz; /* Virtual old heap block size for binaries */ Uint64 bin_old_vheap; /* Virtual old heap size for binaries */ ErtsProcSysTaskQs *sys_task_qs; erts_smp_atomic32_t state; /* Process state flags (see ERTS_PSFLG_*) */ +#ifdef ERTS_DIRTY_SCHEDULERS + erts_smp_atomic32_t dirty_state; /* Process dirty state flags (see ERTS_PDSFLG_*) */ +#endif #ifdef ERTS_SMP ErlMessageInQueue msg_inq; + ErlTraceMessageQueue *trace_msg_q; ErtsPendExit pending_exit; erts_proc_lock_t lock; ErtsSchedulerData *scheduler_data; @@ -1067,6 +1065,7 @@ struct process { #ifdef CHECK_FOR_HOLES Eterm* last_htop; /* No need to scan the heap below this point. */ ErlHeapFragment* last_mbuf; /* No need to scan beyond this mbuf. */ + ErlHeapFragment* heap_hfrag; /* Heap abandoned, htop now lives in this frag */ #endif #ifdef DEBUG @@ -1090,6 +1089,7 @@ extern const Process erts_invalid_process; do { \ (p)->last_htop = 0; \ (p)->last_mbuf = 0; \ + (p)->heap_hfrag = NULL; \ } while (0) # define ERTS_HOLE_CHECK(p) erts_check_for_holes((p)) @@ -1167,15 +1167,16 @@ void erts_check_for_holes(Process* p); #define ERTS_PSFLG_RUNNING_SYS ERTS_PSFLG_BIT(15) #define ERTS_PSFLG_PROXY ERTS_PSFLG_BIT(16) #define ERTS_PSFLG_DELAYED_SYS ERTS_PSFLG_BIT(17) -#ifdef ERTS_DIRTY_SCHEDULERS -#define ERTS_PSFLG_DIRTY_CPU_PROC ERTS_PSFLG_BIT(18) -#define ERTS_PSFLG_DIRTY_IO_PROC ERTS_PSFLG_BIT(19) -#define ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q ERTS_PSFLG_BIT(20) -#define ERTS_PSFLG_DIRTY_IO_PROC_IN_Q ERTS_PSFLG_BIT(21) +#define ERTS_PSFLG_OFF_HEAP_MSGQ ERTS_PSFLG_BIT(18) +#define ERTS_PSFLG_ON_HEAP_MSGQ ERTS_PSFLG_BIT(19) +#define ERTS_PSFLG_DIRTY_CPU_PROC ERTS_PSFLG_BIT(20) +#define ERTS_PSFLG_DIRTY_IO_PROC ERTS_PSFLG_BIT(21) +#define ERTS_PSFLG_DIRTY_ACTIVE_SYS ERTS_PSFLG_BIT(22) #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_DIRTY_WORK (ERTS_PSFLG_DIRTY_CPU_PROC \ + | ERTS_PSFLG_DIRTY_IO_PROC \ + | ERTS_PSFLG_DIRTY_ACTIVE_SYS) #define ERTS_PSFLGS_IN_PRQ_MASK (ERTS_PSFLG_IN_PRQ_MAX \ | ERTS_PSFLG_IN_PRQ_HIGH \ @@ -1189,6 +1190,36 @@ void erts_check_for_holes(Process* p); #define ERTS_PSFLGS_GET_PRQ_PRIO(PSFLGS) \ (((PSFLGS) >> ERTS_PSFLGS_PRQ_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK) +#ifdef ERTS_DIRTY_SCHEDULERS + +/* + * Flags in the dirty_state field. + */ + +#define ERTS_PDSFLG_IN_CPU_PRQ_MAX (((erts_aint32_t) 1) << 0) +#define ERTS_PDSFLG_IN_CPU_PRQ_HIGH (((erts_aint32_t) 1) << 1) +#define ERTS_PDSFLG_IN_CPU_PRQ_NORMAL (((erts_aint32_t) 1) << 2) +#define ERTS_PDSFLG_IN_CPU_PRQ_LOW (((erts_aint32_t) 1) << 3) +#define ERTS_PDSFLG_IN_IO_PRQ_MAX (((erts_aint32_t) 1) << 4) +#define ERTS_PDSFLG_IN_IO_PRQ_HIGH (((erts_aint32_t) 1) << 5) +#define ERTS_PDSFLG_IN_IO_PRQ_NORMAL (((erts_aint32_t) 1) << 6) +#define ERTS_PDSFLG_IN_IO_PRQ_LOW (((erts_aint32_t) 1) << 7) + +#define ERTS_PDSFLGS_QMASK ERTS_PSFLGS_QMASK +#define ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET 0 +#define ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET ERTS_PSFLGS_QMASK_BITS + +#define ERTS_PDSFLG_IN_CPU_PRQ_MASK (ERTS_PDSFLG_IN_CPU_PRQ_MAX \ + | ERTS_PDSFLG_IN_CPU_PRQ_HIGH \ + | ERTS_PDSFLG_IN_CPU_PRQ_NORMAL\ + | ERTS_PDSFLG_IN_CPU_PRQ_LOW) +#define ERTS_PDSFLG_IN_IO_PRQ_MASK (ERTS_PDSFLG_IN_CPU_PRQ_MAX \ + | ERTS_PDSFLG_IN_CPU_PRQ_HIGH \ + | ERTS_PDSFLG_IN_CPU_PRQ_NORMAL\ + | ERTS_PDSFLG_IN_CPU_PRQ_LOW) +#endif + + /* * Static flags that do not change after process creation. */ @@ -1222,12 +1253,16 @@ void erts_check_for_holes(Process* p); #define SPO_USE_ARGS 2 #define SPO_MONITOR 4 #define SPO_SYSTEM_PROC 8 +#define SPO_OFF_HEAP_MSGQ 16 +#define SPO_ON_HEAP_MSGQ 32 + +extern int erts_default_spo_flags; /* * The following struct contains options for a process to be spawned. */ typedef struct { - Uint flags; + int flags; int error_code; /* Error code returned from create_process(). */ Eterm mref; /* Monitor ref returned (if SPO_MONITOR was given). */ @@ -1267,7 +1302,6 @@ Eterm* erts_heap_alloc(Process* p, Uint need, Uint xtra); Eterm* erts_set_hole_marker(Eterm* ptr, Uint sz); #endif -extern Uint erts_default_process_flags; extern erts_smp_rwmtx_t erts_cpu_bind_rwmtx; /* If any of the erts_system_monitor_* variables are set (enabled), ** erts_system_monitor must be != NIL, to allow testing on just @@ -1309,14 +1343,31 @@ extern int erts_system_profile_ts_type; #define F_HAVE_BLCKD_MSCHED (1 << 8) /* Process has blocked multi-scheduling */ #define F_P2PNR_RESCHED (1 << 9) /* Process has been rescheduled via erts_pid2proc_not_running() */ #define F_FORCE_GC (1 << 10) /* Force gc at process in-scheduling */ -#define F_DISABLE_GC (1 << 11) /* Disable GC */ +#define F_DISABLE_GC (1 << 11) /* Disable GC (see below) */ +#define F_OFF_HEAP_MSGQ (1 << 12) /* Off heap msg queue */ +#define F_ON_HEAP_MSGQ (1 << 13) /* Off heap msg queue */ +#define F_OFF_HEAP_MSGQ_CHNG (1 << 14) /* Off heap msg queue changing */ +#define F_ABANDONED_HEAP_USE (1 << 15) /* Have usage of abandoned heap */ +#define F_DELAY_GC (1 << 16) /* Similar to disable GC (see below) */ +#define F_SCHDLR_ONLN_WAITQ (1 << 17) /* Process enqueued waiting to change schedulers online */ +#define F_HAVE_BLCKD_NMSCHED (1 << 18) /* Process has blocked normal multi-scheduling */ + +/* + * F_DISABLE_GC and F_DELAY_GC are similar. Both will prevent + * GC of the process, but it is important to use the right + * one: + * - F_DISABLE_GC should *only* be used by BIFs. This when + * the BIF needs to yield while preventig a GC. + * - F_DELAY_GC should only be used when GC is temporarily + * disabled while the process is scheduled. A process must + * not be scheduled out while F_DELAY_GC is set. + */ #define ERTS_TRACE_FLAGS_TS_TYPE_SHIFT 0 #define F_TRACE_FLAG(N) (1 << (ERTS_TRACE_TS_TYPE_BITS + (N))) /* process trace_flags */ - #define F_NOW_TS (ERTS_TRACE_FLG_NOW_TIMESTAMP \ << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT) #define F_STRICT_MON_TS (ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP \ @@ -1338,8 +1389,7 @@ extern int erts_system_profile_ts_type; #define F_TRACE_ARITY_ONLY F_TRACE_FLAG(12) #define F_TRACE_RETURN_TO F_TRACE_FLAG(13) /* Return_to trace when breakpoint tracing */ #define F_TRACE_SILENT F_TRACE_FLAG(14) /* No call trace msg suppress */ -#define F_TRACER F_TRACE_FLAG(15) /* May be (has been) tracer */ -#define F_EXCEPTION_TRACE F_TRACE_FLAG(16) /* May have exception trace on stack */ +#define F_EXCEPTION_TRACE F_TRACE_FLAG(15) /* May have exception trace on stack */ /* port trace flags, currently the same as process trace flags */ #define F_TRACE_SCHED_PORTS F_TRACE_FLAG(17) /* Trace of port scheduling */ @@ -1368,12 +1418,14 @@ extern int erts_system_profile_ts_type; | F_TRACE_SCHED_PORTS | F_TRACE_SCHED_NO \ | F_TRACE_SCHED_EXIT) + #define ERTS_TRACEE_MODIFIER_FLAGS \ - (F_TRACE_SILENT | F_TIMESTAMP_MASK | F_TRACE_SCHED_NO) -#define ERTS_PORT_TRACEE_FLAGS \ - (ERTS_TRACEE_MODIFIER_FLAGS | F_TRACE_PORTS | F_TRACE_SCHED_PORTS) + (F_TRACE_SILENT | F_TIMESTAMP_MASK | F_TRACE_SCHED_NO \ + | F_TRACE_RECEIVE | F_TRACE_SEND) +#define ERTS_PORT_TRACEE_FLAGS \ + (ERTS_TRACEE_MODIFIER_FLAGS | F_TRACE_PORTS | F_TRACE_SCHED_PORTS) #define ERTS_PROC_TRACEE_FLAGS \ - ((TRACEE_FLAGS & ~ERTS_PORT_TRACEE_FLAGS) | ERTS_TRACEE_MODIFIER_FLAGS) + ((TRACEE_FLAGS & ~ERTS_PORT_TRACEE_FLAGS) | ERTS_TRACEE_MODIFIER_FLAGS) #define SEQ_TRACE_FLAG(N) (1 << (ERTS_TRACE_TS_TYPE_BITS + (N))) @@ -1493,6 +1545,7 @@ int erts_setup_nif_gc(Process* proc, Eterm** objv, int* nobj); /* see erl_nif.c void erts_destroy_nif_export(void *); /* see erl_nif.c */ ErtsProcList *erts_proclist_create(Process *); +ErtsProcList *erts_proclist_copy(ErtsProcList *); void erts_proclist_destroy(ErtsProcList *); ERTS_GLB_INLINE int erts_proclist_same(ErtsProcList *, Process *); @@ -1673,40 +1726,33 @@ void erts_schedule_thr_prgr_later_cleanup_op(void (*)(void *), void *, ErtsThrPrgrLaterOp *, UWord); +void erts_schedule_complete_off_heap_message_queue_change(Eterm pid); +void erts_schedule_flush_trace_messages(Eterm pid); +int erts_flush_trace_messages(Process *c_p, ErtsProcLocks locks); #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) int erts_dbg_check_halloc_lock(Process *p); #endif -#ifdef DEBUG -void erts_dbg_multi_scheduling_return_trap(Process *, Eterm); -#endif -int erts_get_max_no_executing_schedulers(void); #if defined(ERTS_SMP) || defined(ERTS_DIRTY_SCHEDULERS) -ErtsSchedSuspendResult -erts_schedulers_state(Uint *, Uint *, Uint *, Uint *, Uint *, Uint *, int); +void +erts_schedulers_state(Uint *, Uint *, Uint *, Uint *, Uint *, Uint *, Uint *, Uint *); #endif #ifdef ERTS_SMP ErtsSchedSuspendResult erts_set_schedulers_online(Process *p, ErtsProcLocks plocks, Sint new_no, - Sint *old_no -#ifdef ERTS_DIRTY_SCHEDULERS - , int dirty_only -#endif - ); + Sint *old_no, + int dirty_only); ErtsSchedSuspendResult -erts_block_multi_scheduling(Process *, ErtsProcLocks, int, int); +erts_block_multi_scheduling(Process *, ErtsProcLocks, int, int, int); int erts_is_multi_scheduling_blocked(void); -Eterm erts_multi_scheduling_blockers(Process *); +Eterm erts_multi_scheduling_blockers(Process *, int); 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 void erts_notify_check_async_ready_queue(void *); #endif @@ -1800,7 +1846,7 @@ Uint erts_debug_nbalance(void); int erts_debug_wait_completed(Process *c_p, int flags); -Uint erts_process_memory(Process *c_p); +Uint erts_process_memory(Process *c_p, int incl_msg_inq); #ifdef ERTS_SMP # define ERTS_GET_SCHEDULER_DATA_FROM_PROC(PROC) ((PROC)->scheduler_data) @@ -1869,18 +1915,19 @@ do { \ #define ERTS_SMP_LC_CHK_RUNQ_LOCK(RQ, L) #endif -void *erts_psd_set_init(Process *p, ErtsProcLocks plocks, int ix, void *data); +void *erts_psd_set_init(Process *p, int ix, void *data); ERTS_GLB_INLINE void * erts_psd_get(Process *p, int ix); ERTS_GLB_INLINE void * -erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *new); +erts_psd_set(Process *p, int ix, void *new); #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE void * erts_psd_get(Process *p, int ix) { + ErtsPSD *psd; #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) ErtsProcLocks locks = erts_proc_lc_my_proc_locks(p); if (ERTS_LC_PSD_ANY_LOCK == erts_psd_required_locks[ix].get_locks) @@ -1891,17 +1938,19 @@ erts_psd_get(Process *p, int ix) || erts_thr_progress_is_blocking()); } #endif + + psd = (ErtsPSD *) erts_smp_atomic_read_nob(&p->psd); ASSERT(0 <= ix && ix < ERTS_PSD_SIZE); - return p->psd ? p->psd->data[ix] : NULL; + if (!psd) + return NULL; + ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER; + return psd->data[ix]; } - -/* - * NOTE: erts_psd_set() might release and reacquire locks on 'p'. - */ ERTS_GLB_INLINE void * -erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *data) +erts_psd_set(Process *p, int ix, void *data) { + ErtsPSD *psd; #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) ErtsProcLocks locks = erts_proc_lc_my_proc_locks(p); if (ERTS_LC_PSD_ANY_LOCK == erts_psd_required_locks[ix].set_locks) @@ -1912,50 +1961,55 @@ erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *data) || erts_thr_progress_is_blocking()); } #endif + psd = (ErtsPSD *) erts_smp_atomic_read_nob(&p->psd); ASSERT(0 <= ix && ix < ERTS_PSD_SIZE); - if (p->psd) { - void *old = p->psd->data[ix]; - p->psd->data[ix] = data; + if (psd) { + void *old; +#ifdef ERTS_SMP +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_MEMBAR(ETHR_LoadStore|ETHR_StoreStore); +#else + ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore|ETHR_StoreStore); +#endif +#endif + old = psd->data[ix]; + psd->data[ix] = data; return old; } - else { - if (!data) - return NULL; - else - return erts_psd_set_init(p, plocks, ix, data); - } + + if (!data) + return NULL; + + return erts_psd_set_init(p, ix, data); } #endif -#define ERTS_PROC_SCHED_ID(P, L, ID) \ - ((UWord) erts_psd_set((P), (L), ERTS_PSD_SCHED_ID, (void *) (ID))) +#define ERTS_PROC_SCHED_ID(P, ID) \ + ((UWord) erts_psd_set((P), ERTS_PSD_SCHED_ID, (void *) (ID))) #define ERTS_PROC_GET_SAVED_CALLS_BUF(P) \ ((struct saved_calls *) erts_psd_get((P), ERTS_PSD_SAVED_CALLS_BUF)) -#define ERTS_PROC_SET_SAVED_CALLS_BUF(P, L, SCB) \ - ((struct saved_calls *) erts_psd_set((P), (L), ERTS_PSD_SAVED_CALLS_BUF, (void *) (SCB))) +#define ERTS_PROC_SET_SAVED_CALLS_BUF(P, SCB) \ + ((struct saved_calls *) erts_psd_set((P), ERTS_PSD_SAVED_CALLS_BUF, (void *) (SCB))) #define ERTS_PROC_GET_CALL_TIME(P) \ ((process_breakpoint_time_t *) erts_psd_get((P), ERTS_PSD_CALL_TIME_BP)) -#define ERTS_PROC_SET_CALL_TIME(P, L, PBT) \ - ((process_breakpoint_time_t *) erts_psd_set((P), (L), ERTS_PSD_CALL_TIME_BP, (void *) (PBT))) +#define ERTS_PROC_SET_CALL_TIME(P, PBT) \ + ((process_breakpoint_time_t *) erts_psd_set((P), ERTS_PSD_CALL_TIME_BP, (void *) (PBT))) #define ERTS_PROC_GET_DELAYED_GC_TASK_QS(P) \ ((ErtsProcSysTaskQs *) erts_psd_get((P), ERTS_PSD_DELAYED_GC_TASK_QS)) -#define ERTS_PROC_SET_DELAYED_GC_TASK_QS(P, L, PBT) \ - ((ErtsProcSysTaskQs *) erts_psd_set((P), (L), ERTS_PSD_DELAYED_GC_TASK_QS, (void *) (PBT))) +#define ERTS_PROC_SET_DELAYED_GC_TASK_QS(P, PBT) \ + ((ErtsProcSysTaskQs *) erts_psd_set((P), ERTS_PSD_DELAYED_GC_TASK_QS, (void *) (PBT))) #define ERTS_PROC_GET_NIF_TRAP_EXPORT(P) \ erts_psd_get((P), ERTS_PSD_NIF_TRAP_EXPORT) -#define ERTS_PROC_SET_NIF_TRAP_EXPORT(P, L, NTE) \ - erts_psd_set((P), (L), ERTS_PSD_NIF_TRAP_EXPORT, (void *) (NTE)) - +#define ERTS_PROC_SET_NIF_TRAP_EXPORT(P, NTE) \ + erts_psd_set((P), ERTS_PSD_NIF_TRAP_EXPORT, (void *) (NTE)) ERTS_GLB_INLINE Eterm erts_proc_get_error_handler(Process *p); -ERTS_GLB_INLINE Eterm erts_proc_set_error_handler(Process *p, - ErtsProcLocks plocks, - Eterm handler); +ERTS_GLB_INLINE Eterm erts_proc_set_error_handler(Process *p, Eterm handler); #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE Eterm @@ -1971,13 +2025,13 @@ erts_proc_get_error_handler(Process *p) } ERTS_GLB_INLINE Eterm -erts_proc_set_error_handler(Process *p, ErtsProcLocks plocks, Eterm handler) +erts_proc_set_error_handler(Process *p, Eterm handler) { void *old_val; void *new_val; ASSERT(is_atom(handler)); new_val = (handler == am_error_handler) ? NULL : (void *) (UWord) handler; - old_val = erts_psd_set(p, plocks, ERTS_PSD_ERROR_HANDLER, new_val); + old_val = erts_psd_set(p, ERTS_PSD_ERROR_HANDLER, new_val); if (!old_val) return am_error_handler; else { @@ -2110,6 +2164,22 @@ ERTS_GLB_INLINE void erts_smp_xrunq_unlock(ErtsRunQueue *rq, ErtsRunQueue *xrq); ERTS_GLB_INLINE void erts_smp_runqs_lock(ErtsRunQueue *rq1, ErtsRunQueue *rq2); ERTS_GLB_INLINE void erts_smp_runqs_unlock(ErtsRunQueue *rq1, ErtsRunQueue *rq2); +ERTS_GLB_INLINE ErtsMessage *erts_alloc_message_heap_state(Process *pp, + erts_aint32_t *psp, + ErtsProcLocks *plp, + Uint sz, + Eterm **hpp, + ErlOffHeap **ohpp); +ERTS_GLB_INLINE ErtsMessage *erts_alloc_message_heap(Process *pp, + ErtsProcLocks *plp, + Uint sz, + Eterm **hpp, + ErlOffHeap **ohpp); + +ERTS_GLB_INLINE void erts_shrink_message_heap(ErtsMessage **msgpp, Process *pp, + Eterm *start_hp, Eterm *used_hp, Eterm *end_hp, + Eterm *brefs, Uint brefs_size); + #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE @@ -2258,6 +2328,66 @@ erts_smp_runqs_unlock(ErtsRunQueue *rq1, ErtsRunQueue *rq2) #endif } +ERTS_GLB_INLINE ErtsMessage * +erts_alloc_message_heap_state(Process *pp, + erts_aint32_t *psp, + ErtsProcLocks *plp, + Uint sz, + Eterm **hpp, + ErlOffHeap **ohpp) +{ + int on_heap; + ErtsMessage *mp; + + if ((*psp) & ERTS_PSFLG_OFF_HEAP_MSGQ) { + mp = erts_alloc_message(sz, hpp); + *ohpp = sz == 0 ? NULL : &mp->hfrag.off_heap; + return mp; + } + + mp = erts_try_alloc_message_on_heap(pp, psp, plp, sz, hpp, ohpp, &on_heap); + ASSERT(pp || !on_heap); + return mp; +} + +ERTS_GLB_INLINE ErtsMessage * +erts_alloc_message_heap(Process *pp, + ErtsProcLocks *plp, + Uint sz, + Eterm **hpp, + ErlOffHeap **ohpp) +{ + erts_aint32_t state = pp ? erts_smp_atomic32_read_nob(&pp->state) : 0; + return erts_alloc_message_heap_state(pp, &state, plp, sz, hpp, ohpp); +} + +ERTS_GLB_INLINE void +erts_shrink_message_heap(ErtsMessage **msgpp, Process *pp, + Eterm *start_hp, Eterm *used_hp, Eterm *end_hp, + Eterm *brefs, Uint brefs_size) +{ + ASSERT(start_hp <= used_hp && used_hp <= end_hp); + if ((*msgpp)->data.attached == ERTS_MSG_COMBINED_HFRAG) + *msgpp = erts_shrink_message(*msgpp, used_hp - start_hp, + brefs, brefs_size); + else if (!(*msgpp)->data.attached) { + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN + & erts_proc_lc_my_proc_locks(pp)); + HRelease(pp, end_hp, used_hp); + } + else { + ErlHeapFragment *hfrag = (*msgpp)->data.heap_frag; + if (start_hp != used_hp) + hfrag = erts_resize_message_buffer(hfrag, used_hp - start_hp, + brefs, brefs_size); + else { + free_message_buffer(hfrag); + hfrag = NULL; + } + (*msgpp)->data.heap_frag = hfrag; + } +} + #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ ERTS_GLB_INLINE ErtsAtomCacheMap *erts_get_atom_cache_map(Process *c_p); diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c index 3253ee6b70..d8c2eaba94 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2013. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -51,16 +51,19 @@ #define INITIAL_SIZE (erts_pd_initial_size) /* Hash utility macros */ -#define HASH_RANGE(PDict) ((PDict)->homeSize + (PDict)->splitPosition) +#define HASH_RANGE(PDict) ((PDict)->usedSlots) -#define MAKE_HASH(Term) \ -((is_small(Term)) ? unsigned_val(Term) : \ - ((is_atom(Term)) ? \ - (atom_tab(atom_val(term))->slot.bucket.hvalue) : \ - make_hash2(Term))) +#define MAKE_HASH(Term) \ + ((is_small(Term)) ? unsigned_val(Term) : \ + ((is_atom(Term)) ? \ + (atom_tab(atom_val(Term))->slot.bucket.hvalue) : \ + make_internal_hash(Term))) #define PD_SZ2BYTES(Sz) (sizeof(ProcDict) + ((Sz) - 1)*sizeof(Eterm)) +#define pd_hash_value(Pdict, Key) \ + pd_hash_value_to_ix(Pdict, MAKE_HASH((Key))) + /* Memory allocation macros */ #define PD_ALLOC(Sz) \ erts_alloc(ERTS_ALC_T_PROC_DICT, (Sz)) @@ -74,14 +77,19 @@ #define TCDR(Term) CDR(list_val(Term)) /* Array access macro */ -#define ARRAY_GET(PDict, Index) (((PDict)->size > (Index)) ? \ - (PDict)->data[Index] : NIL) +#define ARRAY_GET(PDict, Index) (ASSERT((Index) < (PDict)->arraySize), \ + (PDict)->data[Index]) +#define ARRAY_PUT(PDict, Index, Val) (ASSERT((Index) < (PDict)->arraySize), \ + (PDict)->data[Index] = (Val)) + +#define IS_POW2(X) ((X) && !((X) & ((X)-1))) /* * Forward decalarations */ static void pd_hash_erase(Process *p, Eterm id, Eterm *ret); static void pd_hash_erase_all(Process *p); +static Eterm pd_hash_get_with_hval(Process *p, Eterm bucket, Eterm id); 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); @@ -91,9 +99,9 @@ static void shrink(Process *p, Eterm* ret); static void grow(Process *p); static void array_shrink(ProcDict **ppd, unsigned int need); -static Eterm array_put(ProcDict **ppdict, unsigned int ndx, Eterm term); +static void ensure_array_size(ProcDict**, unsigned int size); -static unsigned int pd_hash_value(ProcDict *pdict, Eterm term); +static unsigned int pd_hash_value_to_ix(ProcDict *pdict, Uint32 hx); static unsigned int next_array_size(unsigned int need); /* @@ -134,6 +142,16 @@ static void pd_check(ProcDict *pd); ** External interface */ +int +erts_pd_set_initial_size(int size) +{ + if (size <= 0) + return 0; + + erts_pd_initial_size = 1 << erts_fit_in_bits_uint(size-1); + return 1; +} + /* * Called from break handler */ @@ -146,9 +164,9 @@ erts_dictionary_dump(int to, void *to_arg, ProcDict *pd) /*PD_CHECK(pd);*/ if (pd == NULL) return; - erts_print(to, to_arg, "(size = %d, used = %d, homeSize = %d, " + erts_print(to, to_arg, "(size = %d, usedSlots = %d, " "splitPosition = %d, numElements = %d)\n", - pd->size, pd->used, pd->homeSize, + pd->arraySize, pd->usedSlots, pd->splitPosition, (unsigned int) pd->numElements); for (i = 0; i < HASH_RANGE(pd); ++i) { erts_print(to, to_arg, "%d: %T\n", i, ARRAY_GET(pd, i)); @@ -203,7 +221,7 @@ erts_dicts_mem_size(Process *p) { Uint size = 0; if (p->dictionary) - size += PD_SZ2BYTES(p->dictionary->size); + size += PD_SZ2BYTES(p->dictionary->arraySize); return size; } @@ -345,7 +363,7 @@ static void pd_hash_erase(Process *p, Eterm id, Eterm *ret) if (is_boxed(old)) { /* Tuple */ ASSERT(is_tuple(old)); if (EQ(tuple_val(old)[1], id)) { - array_put(&(p->dictionary), hval, NIL); + ARRAY_PUT(p->dictionary, hval, NIL); --(p->dictionary->numElements); *ret = tuple_val(old)[2]; } @@ -365,7 +383,7 @@ static void pd_hash_erase(Process *p, Eterm id, Eterm *ret) old = ARRAY_GET(p->dictionary, hval); ASSERT(is_list(old)); if (is_nil(TCDR(old))) { - array_put(&p->dictionary, hval, TCAR(old)); + ARRAY_PUT(p->dictionary, hval, TCAR(old)); } } else if (is_not_nil(old)) { #ifdef DEBUG @@ -390,40 +408,56 @@ static void pd_hash_erase_all(Process *p) } } +Eterm erts_pd_hash_get_with_hx(Process *p, Uint32 hx, Eterm id) +{ + unsigned int hval; + ProcDict *pd = p->dictionary; + + ASSERT(hx == MAKE_HASH(id)); + if (pd == NULL) + return am_undefined; + hval = pd_hash_value_to_ix(pd, hx); + return pd_hash_get_with_hval(p, ARRAY_GET(pd, hval), id); +} + Eterm erts_pd_hash_get(Process *p, Eterm id) { unsigned int hval; - Eterm tmp; ProcDict *pd = p->dictionary; if (pd == NULL) return am_undefined; hval = pd_hash_value(pd, id); - tmp = ARRAY_GET(pd, hval); - if (is_boxed(tmp)) { /* Tuple */ - ASSERT(is_tuple(tmp)); - if (EQ(tuple_val(tmp)[1], id)) { - return tuple_val(tmp)[2]; + return pd_hash_get_with_hval(p, ARRAY_GET(pd, hval), id); +} + +Eterm pd_hash_get_with_hval(Process *p, Eterm bucket, Eterm id) +{ + if (is_boxed(bucket)) { /* Tuple */ + ASSERT(is_tuple(bucket)); + if (EQ(tuple_val(bucket)[1], id)) { + return tuple_val(bucket)[2]; } - } else if (is_list(tmp)) { - for (; tmp != NIL && !EQ(tuple_val(TCAR(tmp))[1], id); tmp = TCDR(tmp)) { + } else if (is_list(bucket)) { + for (; bucket != NIL && !EQ(tuple_val(TCAR(bucket))[1], id); bucket = TCDR(bucket)) { ; } - if (tmp != NIL) { - return tuple_val(TCAR(tmp))[2]; + if (bucket != NIL) { + return tuple_val(TCAR(bucket))[2]; } - } else if (is_not_nil(tmp)) { + } else if (is_not_nil(bucket)) { #ifdef DEBUG erts_fprintf(stderr, "Process dictionary for process %T is broken, trying to " "display term found in line %d:\n" - "%T\n", p->common.id, __LINE__, tmp); + "%T\n", p->common.id, __LINE__, bucket); #endif erts_exit(ERTS_ERROR_EXIT, "Damaged process dictionary found during get/1."); } return am_undefined; } + #define PD_GET_TKEY(Dst,Src) \ do { \ ASSERT(is_tuple((Src))); \ @@ -549,8 +583,11 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) if (p->dictionary == NULL) { /* Create it */ - array_put(&(p->dictionary), INITIAL_SIZE - 1, NIL); - p->dictionary->homeSize = INITIAL_SIZE; + ensure_array_size(&p->dictionary, INITIAL_SIZE); + p->dictionary->usedSlots = INITIAL_SIZE; + p->dictionary->sizeMask = INITIAL_SIZE*2 - 1; + p->dictionary->splitPosition = 0; + p->dictionary->numElements = 0; } hval = pd_hash_value(p->dictionary, id); old = ARRAY_GET(p->dictionary, hval); @@ -583,7 +620,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) root[0] = id; root[1] = value; root[2] = old; - BUMP_REDS(p, erts_garbage_collect(p, needed, root, 3)); + erts_garbage_collect(p, needed, root, 3); id = root[0]; value = root[1]; old = root[2]; @@ -602,19 +639,19 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) * Update the dictionary. */ if (is_nil(old)) { - array_put(&(p->dictionary), hval, tpl); + ARRAY_PUT(p->dictionary, hval, tpl); ++(p->dictionary->numElements); } else if (is_boxed(old)) { ASSERT(is_tuple(old)); if (EQ(tuple_val(old)[1],id)) { - array_put(&(p->dictionary), hval, tpl); + ARRAY_PUT(p->dictionary, hval, tpl); return tuple_val(old)[2]; } else { hp = HeapOnlyAlloc(p, 4); tmp = CONS(hp, old, NIL); hp += 2; ++(p->dictionary->numElements); - array_put(&(p->dictionary), hval, CONS(hp, tpl, tmp)); + ARRAY_PUT(p->dictionary, hval, CONS(hp, tpl, tmp)); hp += 2; ASSERT(hp <= hp_limit); } @@ -624,7 +661,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) * New key. Simply prepend the tuple to the beginning of the list. */ hp = HeapOnlyAlloc(p, 2); - array_put(&(p->dictionary), hval, CONS(hp, tpl, old)); + ARRAY_PUT(p->dictionary, hval, CONS(hp, tpl, old)); hp += 2; ASSERT(hp <= hp_limit); ++(p->dictionary->numElements); @@ -659,7 +696,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) nlist = CONS(hp, tpl, nlist); hp += 2; ASSERT(hp <= hp_limit); - array_put(&(p->dictionary), hval, nlist); + ARRAY_PUT(p->dictionary, hval, nlist); return tuple_val(TCAR(tmp))[2]; } } else { @@ -684,6 +721,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) static void shrink(Process *p, Eterm* ret) { + ProcDict *pd = p->dictionary; unsigned int range = HASH_RANGE(p->dictionary); unsigned int steps = (range*3) / 10; Eterm hi, lo, tmp; @@ -698,25 +736,26 @@ static void shrink(Process *p, Eterm* ret) } for (i = 0; i < steps; ++i) { - ProcDict *pd = p->dictionary; if (pd->splitPosition == 0) { - pd->homeSize /= 2; - pd->splitPosition = pd->homeSize; + ASSERT(IS_POW2(pd->usedSlots)); + pd->sizeMask = pd->usedSlots - 1; + pd->splitPosition = pd->usedSlots / 2; } --(pd->splitPosition); - hi = ARRAY_GET(pd, (pd->splitPosition + pd->homeSize)); + /* Must wait to decrement 'usedSlots' for GC rootset below */ + hi = ARRAY_GET(pd, pd->usedSlots - 1); lo = ARRAY_GET(pd, pd->splitPosition); if (hi != NIL) { if (lo == NIL) { - array_put(&(p->dictionary), pd->splitPosition, hi); + ARRAY_PUT(pd, pd->splitPosition, hi); } else { - int needed = 4; + Sint needed = 4; if (is_list(hi) && is_list(lo)) { needed = 2*erts_list_length(hi); } if (HeapWordsLeft(p) < needed) { - BUMP_REDS(p, erts_garbage_collect(p, needed, ret, 1)); - hi = pd->data[(pd->splitPosition + pd->homeSize)]; + erts_garbage_collect(p, needed, ret, 1); + hi = pd->data[pd->usedSlots - 1]; lo = pd->data[pd->splitPosition]; } #ifdef DEBUG @@ -727,13 +766,13 @@ static void shrink(Process *p, Eterm* ret) hp = HeapOnlyAlloc(p, 4); tmp = CONS(hp, hi, NIL); hp += 2; - array_put(&(p->dictionary), pd->splitPosition, + ARRAY_PUT(pd, pd->splitPosition, CONS(hp,lo,tmp)); hp += 2; ASSERT(hp <= hp_limit); } else { /* hi is a list */ hp = HeapOnlyAlloc(p, 2); - array_put(&(p->dictionary), pd->splitPosition, + ARRAY_PUT(pd, pd->splitPosition, CONS(hp, lo, hi)); hp += 2; ASSERT(hp <= hp_limit); @@ -741,7 +780,7 @@ static void shrink(Process *p, Eterm* ret) } else { /* lo is a list */ if (is_tuple(hi)) { hp = HeapOnlyAlloc(p, 2); - array_put(&(p->dictionary), pd->splitPosition, + ARRAY_PUT(pd, pd->splitPosition, CONS(hp, hi, lo)); hp += 2; ASSERT(hp <= hp_limit); @@ -753,14 +792,15 @@ static void shrink(Process *p, Eterm* ret) hp += 2; } ASSERT(hp <= hp_limit); - array_put(&(p->dictionary), pd->splitPosition, lo); + ARRAY_PUT(pd, pd->splitPosition, lo); } } } } - array_put(&(p->dictionary), (pd->splitPosition + pd->homeSize), NIL); + --pd->usedSlots; + ARRAY_PUT(pd, pd->usedSlots, NIL); } - if (HASH_RANGE(p->dictionary) <= (p->dictionary->size / 4)) { + if (HASH_RANGE(p->dictionary) <= (p->dictionary->arraySize / 4)) { array_shrink(&(p->dictionary), (HASH_RANGE(p->dictionary) * 3) / 2); } } @@ -768,14 +808,14 @@ static void shrink(Process *p, Eterm* ret) static void grow(Process *p) { unsigned int i,j; - unsigned int steps = p->dictionary->homeSize / 5; + unsigned int steps = (p->dictionary->usedSlots / 4) & 0xf; Eterm l1,l2; Eterm l; Eterm *hp; unsigned int pos; unsigned int homeSize; - int needed = 0; - ProcDict *pd; + Sint needed = 0; + ProcDict *pd = p->dictionary; #ifdef DEBUG Eterm *hp_limit; #endif @@ -784,18 +824,20 @@ static void grow(Process *p) if (steps == 0) steps = 1; /* Dont grow over MAX_HASH */ - if ((MAX_HASH - steps) <= HASH_RANGE(p->dictionary)) { + if ((MAX_HASH - steps) <= HASH_RANGE(pd)) { return; } + ensure_array_size(&p->dictionary, HASH_RANGE(pd) + steps); + pd = p->dictionary; + /* * Calculate total number of heap words needed, and garbage collect * if necessary. */ - pd = p->dictionary; pos = pd->splitPosition; - homeSize = pd->homeSize; + homeSize = pd->usedSlots - pd->splitPosition; for (i = 0; i < steps; ++i) { if (pos == homeSize) { homeSize *= 2; @@ -811,7 +853,7 @@ static void grow(Process *p) } } if (HeapWordsLeft(p) < needed) { - BUMP_REDS(p, erts_garbage_collect(p, needed, 0, 0)); + erts_garbage_collect(p, needed, 0, 0); } #ifdef DEBUG hp_limit = p->htop + needed; @@ -820,21 +862,22 @@ static void grow(Process *p) /* * Now grow. */ - + homeSize = pd->usedSlots - pd->splitPosition; for (i = 0; i < steps; ++i) { - ProcDict *pd = p->dictionary; - if (pd->splitPosition == pd->homeSize) { - pd->homeSize *= 2; - pd->splitPosition = 0; + if (pd->splitPosition == homeSize) { + homeSize *= 2; + pd->sizeMask = homeSize*2 - 1; + pd->splitPosition = 0; } pos = pd->splitPosition; ++pd->splitPosition; /* For the hashes */ + ++pd->usedSlots; + ASSERT(pos + homeSize == pd->usedSlots - 1); l = ARRAY_GET(pd, pos); if (is_tuple(l)) { if (pd_hash_value(pd, tuple_val(l)[1]) != pos) { - array_put(&(p->dictionary), pos + - p->dictionary->homeSize, l); - array_put(&(p->dictionary), pos, NIL); + ARRAY_PUT(pd, pos + homeSize, l); + ARRAY_PUT(pd, pos, NIL); } } else { l2 = NIL; @@ -856,10 +899,8 @@ static void grow(Process *p) if (l2 != NIL && TCDR(l2) == NIL) l2 = TCAR(l2); ASSERT(hp <= hp_limit); - /* After array_put pd is no longer valid */ - array_put(&(p->dictionary), pos, l1); - array_put(&(p->dictionary), pos + - p->dictionary->homeSize, l2); + ARRAY_PUT(pd, pos, l1); + ARRAY_PUT(pd, pos + homeSize, l2); } } @@ -876,73 +917,65 @@ static void array_shrink(ProcDict **ppd, unsigned int need) { unsigned int siz = next_array_size(need); - HDEBUGF(("array_shrink: size = %d, used = %d, need = %d", - (*ppd)->size, (*ppd)->used, need)); + HDEBUGF(("array_shrink: size = %d, need = %d", + (*ppd)->arraySize, need)); - if (siz > (*ppd)->size) + if (siz >= (*ppd)->arraySize) return; /* Only shrink */ *ppd = PD_REALLOC(((void *) *ppd), - PD_SZ2BYTES((*ppd)->size), + PD_SZ2BYTES((*ppd)->arraySize), PD_SZ2BYTES(siz)); - (*ppd)->size = siz; - if ((*ppd)->size < (*ppd)->used) - (*ppd)->used = (*ppd)->size; + (*ppd)->arraySize = siz; } -static Eterm array_put(ProcDict **ppdict, unsigned int ndx, Eterm term) +static void ensure_array_size(ProcDict **ppdict, unsigned int size) { + ProcDict *pd = *ppdict; unsigned int i; - Eterm ret; - if (*ppdict == NULL) { - Uint siz = next_array_size(ndx+1); - ProcDict *p; - p = PD_ALLOC(PD_SZ2BYTES(siz)); + if (pd == NULL) { + Uint siz = next_array_size(size); + + pd = PD_ALLOC(PD_SZ2BYTES(siz)); for (i = 0; i < siz; ++i) - p->data[i] = NIL; - p->size = siz; - p->homeSize = p->splitPosition = p->numElements = p->used = 0; - *ppdict = p; - } else if (ndx >= (*ppdict)->size) { - Uint osize = (*ppdict)->size; - Uint nsize = next_array_size(ndx+1); - *ppdict = PD_REALLOC(((void *) *ppdict), + pd->data[i] = NIL; + pd->arraySize = siz; + *ppdict = pd; + } else if (size > pd->arraySize) { + Uint osize = pd->arraySize; + Uint nsize = next_array_size(size); + pd = PD_REALLOC(((void *) pd), PD_SZ2BYTES(osize), PD_SZ2BYTES(nsize)); for (i = osize; i < nsize; ++i) - (*ppdict)->data[i] = NIL; - (*ppdict)->size = nsize; + pd->data[i] = NIL; + pd->arraySize = nsize; + *ppdict = pd; } - ret = (*ppdict)->data[ndx]; - (*ppdict)->data[ndx] = term; - if ((ndx + 1) > (*ppdict)->used) - (*ppdict)->used = ndx + 1; -#ifdef HARDDEBUG - HDEBUGF(("array_put: (*ppdict)->size = %d, (*ppdict)->used = %d, ndx = %d", - (*ppdict)->size, (*ppdict)->used, ndx)); - erts_fprintf(stderr, "%T", term); -#endif /* HARDDEBUG */ - return ret; } /* ** Basic utilities */ -static unsigned int pd_hash_value(ProcDict *pdict, Eterm term) +static unsigned int pd_hash_value_to_ix(ProcDict *pdict, Uint32 hx) { - Uint hash, high; + Uint high; - hash = MAKE_HASH(term); - high = hash % (pdict->homeSize*2); + ASSERT(IS_POW2(pdict->sizeMask+1)); + ASSERT(HASH_RANGE(pdict) >= (pdict->sizeMask >> 1)); + ASSERT(HASH_RANGE(pdict) <= (pdict->sizeMask + 1)); + + high = hx & pdict->sizeMask; if (high >= HASH_RANGE(pdict)) - return hash % pdict->homeSize; + return hx & (pdict->sizeMask >> 1); return high; } + static unsigned int next_array_size(unsigned int need) { static unsigned int tab[] = @@ -1002,24 +1035,28 @@ static unsigned int next_array_size(unsigned int need) static void pd_check(ProcDict *pd) { unsigned int i; + unsigned int used; Uint num; if (pd == NULL) return; - ASSERT(pd->size >= pd->used); + used = HASH_RANGE(pd); + ASSERT(pd->arraySize >= used); ASSERT(HASH_RANGE(pd) <= MAX_HASH); - for (i = 0, num = 0; i < pd->used; ++i) { + for (i = 0, num = 0; i < used; ++i) { Eterm t = pd->data[i]; if (is_nil(t)) { continue; } else if (is_tuple(t)) { ++num; ASSERT(arityval(*tuple_val(t)) == 2); + ASSERT(pd_hash_value(pd, tuple_val(t)[1]) == i); continue; } else if (is_list(t)) { while (t != NIL) { ++num; ASSERT(is_tuple(TCAR(t))); ASSERT(arityval(*(tuple_val(TCAR(t)))) == 2); + ASSERT(pd_hash_value(pd, tuple_val(TCAR(t))[1]) == i); t = TCDR(t); } continue; @@ -1030,7 +1067,7 @@ static void pd_check(ProcDict *pd) } } ASSERT(num == pd->numElements); - ASSERT(pd->splitPosition <= pd->homeSize); + ASSERT(pd->usedSlots >= pd->splitPosition*2); } #endif /* DEBUG */ diff --git a/erts/emulator/beam/erl_process_dict.h b/erts/emulator/beam/erl_process_dict.h index cc53800eb5..387562058c 100644 --- a/erts/emulator/beam/erl_process_dict.h +++ b/erts/emulator/beam/erl_process_dict.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -23,14 +23,18 @@ #include "sys.h" typedef struct proc_dict { - unsigned int size; - unsigned int used; - unsigned int homeSize; + unsigned int sizeMask; + unsigned int usedSlots; + unsigned int arraySize; unsigned int splitPosition; Uint numElements; Eterm data[1]; /* The beginning of an array of erlang terms */ } ProcDict; +#define ERTS_PD_START(PD) ((PD)->data) +#define ERTS_PD_SIZE(PD) ((PD)->usedSlots) + +int erts_pd_set_initial_size(int size); Uint erts_dicts_mem_size(struct process *p); void erts_erase_dicts(struct process *p); void erts_dictionary_dump(int to, void *to_arg, ProcDict *pd); @@ -39,5 +43,6 @@ void erts_deep_dictionary_dump(int to, void *to_arg, Eterm erts_dictionary_copy(struct process *p, ProcDict *pd); Eterm erts_pd_hash_get(struct process *p, Eterm id); +Eterm erts_pd_hash_get_with_hx(Process *p, Uint32 hx, Eterm id); #endif diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 25f0b1ed38..fa76773cac 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2013. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -78,13 +78,14 @@ erts_deep_process_dump(int to, void *to_arg) dump_binaries(to, to_arg, all_binaries); } -Uint erts_process_memory(Process *p) { - ErlMessage *mp; +Uint erts_process_memory(Process *p, int incl_msg_inq) { + ErtsMessage *mp; Uint size = 0; struct saved_calls *scb; size += sizeof(Process); - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p); + if (incl_msg_inq) + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p); erts_doforall_links(ERTS_P_LINKS(p), &erts_one_link_size, &size); erts_doforall_monitors(ERTS_P_MONITORS(p), &erts_one_mon_size, &size); @@ -92,7 +93,7 @@ Uint erts_process_memory(Process *p) { if (p->old_hend && p->old_heap) size += (p->old_hend - p->old_heap) * sizeof(Eterm); - size += p->msg.len * sizeof(ErlMessage); + size += p->msg.len * sizeof(ErtsMessage); for (mp = p->msg.first; mp; mp = mp->next) if (mp->data.attached) @@ -102,7 +103,7 @@ Uint erts_process_memory(Process *p) { size += p->arity * sizeof(p->arg_reg[0]); } - if (p->psd) + if (erts_smp_atomic_read_nob(&p->psd) != (erts_aint_t) NULL) size += sizeof(ErtsPSD); scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p); @@ -119,7 +120,7 @@ static void dump_process_info(int to, void *to_arg, Process *p) { Eterm* sp; - ErlMessage* mp; + ErtsMessage* mp; int yreg = -1; ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p); @@ -365,7 +366,7 @@ heap_dump(int to, void *to_arg, Eterm x) while (x != OUR_NIL) { if (is_CP(x)) { - next = (Eterm *) EXPAND_POINTER(x); + next = (Eterm *) x; } else if (is_list(x)) { ptr = list_val(x); if (ptr[0] != OUR_NIL) { @@ -378,7 +379,7 @@ heap_dump(int to, void *to_arg, Eterm x) ptr[1] = make_small(0); } x = ptr[0]; - ptr[0] = (Eterm) COMPRESS_POINTER(next); + ptr[0] = (Eterm) next; next = ptr + 1; continue; } @@ -408,7 +409,7 @@ heap_dump(int to, void *to_arg, Eterm x) ptr[0] = OUR_NIL; } else { x = ptr[arity]; - ptr[0] = (Eterm) COMPRESS_POINTER(next); + ptr[0] = (Eterm) next; next = ptr + arity - 1; continue; } @@ -617,7 +618,7 @@ erts_dump_extended_process_state(int to, void *to_arg, erts_aint32_t psflg) { if (psflg) erts_print(to, to_arg, " | "); - for (i = 0; i < ERTS_PSFLG_MAX && psflg; i++) { + for (i = 0; i <= ERTS_PSFLG_MAX && psflg; i++) { erts_aint32_t chk = (1 << i); if (psflg & chk) { switch (chk) { @@ -657,16 +658,16 @@ erts_dump_extended_process_state(int to, void *to_arg, erts_aint32_t psflg) { 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_OFF_HEAP_MSGQ: + erts_print(to, to_arg, "OFF_HEAP_MSGQ"); break; + case ERTS_PSFLG_ON_HEAP_MSGQ: + erts_print(to, to_arg, "ON_HEAP_MSGQ"); break; 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 + case ERTS_PSFLG_DIRTY_ACTIVE_SYS: + erts_print(to, to_arg, "DIRTY_ACTIVE_SYS"); break; default: erts_print(to, to_arg, "UNKNOWN(%d)", chk); break; } diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c index 0bee2c848c..a69185bc5c 100644 --- a/erts/emulator/beam/erl_process_lock.c +++ b/erts/emulator/beam/erl_process_lock.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2007-2012. All Rights Reserved. + * Copyright Ericsson AB 2007-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -106,6 +106,7 @@ static struct { Sint16 proc_lock_msgq; Sint16 proc_lock_btm; Sint16 proc_lock_status; + Sint16 proc_lock_trace; } lc_id; #endif @@ -152,6 +153,7 @@ erts_init_proc_lock(int cpus) 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"); + lc_id.proc_lock_trace = erts_lc_get_lock_order_id("proc_trace"); #endif } @@ -1057,6 +1059,11 @@ erts_proc_lock_init(Process *p) #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_trylock(1, &p->lock.status.lc); #endif + erts_mtx_init_x(&p->lock.trace, "proc_trace", p->common.id, do_lock_count); + ethr_mutex_lock(&p->lock.trace.mtx); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_trylock(1, &p->lock.trace.lc); +#endif #endif #ifdef ERTS_PROC_LOCK_DEBUG for (i = 0; i <= ERTS_PROC_LOCK_MAX_BIT; i++) @@ -1078,6 +1085,7 @@ erts_proc_lock_fin(Process *p) erts_mtx_destroy(&p->lock.msgq); erts_mtx_destroy(&p->lock.btm); erts_mtx_destroy(&p->lock.status); + erts_mtx_destroy(&p->lock.trace); #endif #if defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP) erts_lcnt_proc_lock_destroy(p); @@ -1100,26 +1108,29 @@ void erts_lcnt_enable_proc_lock_count(int enable) { void erts_lcnt_proc_lock_init(Process *p) { if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) { erts_lcnt_init_lock_empty(&(p->lock.lcnt_main)); + erts_lcnt_init_lock_empty(&(p->lock.lcnt_link)); erts_lcnt_init_lock_empty(&(p->lock.lcnt_msgq)); erts_lcnt_init_lock_empty(&(p->lock.lcnt_btm)); - erts_lcnt_init_lock_empty(&(p->lock.lcnt_link)); erts_lcnt_init_lock_empty(&(p->lock.lcnt_status)); + erts_lcnt_init_lock_empty(&(p->lock.lcnt_trace)); } else { /* now the common case */ Eterm pid = (p->common.id != ERTS_INVALID_PID) ? p->common.id : NIL; erts_lcnt_init_lock_x(&(p->lock.lcnt_main), "proc_main", ERTS_LCNT_LT_PROCLOCK, pid); + erts_lcnt_init_lock_x(&(p->lock.lcnt_link), "proc_link", ERTS_LCNT_LT_PROCLOCK, pid); erts_lcnt_init_lock_x(&(p->lock.lcnt_msgq), "proc_msgq", ERTS_LCNT_LT_PROCLOCK, pid); erts_lcnt_init_lock_x(&(p->lock.lcnt_btm), "proc_btm", ERTS_LCNT_LT_PROCLOCK, pid); - erts_lcnt_init_lock_x(&(p->lock.lcnt_link), "proc_link", ERTS_LCNT_LT_PROCLOCK, pid); erts_lcnt_init_lock_x(&(p->lock.lcnt_status),"proc_status",ERTS_LCNT_LT_PROCLOCK, pid); + erts_lcnt_init_lock_x(&(p->lock.lcnt_trace), "proc_trace", ERTS_LCNT_LT_PROCLOCK, pid); } /* the lock names should really be aligned to four characters */ } /* logic reversed */ void erts_lcnt_proc_lock_destroy(Process *p) { erts_lcnt_destroy_lock(&(p->lock.lcnt_main)); + erts_lcnt_destroy_lock(&(p->lock.lcnt_link)); 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)); + erts_lcnt_destroy_lock(&(p->lock.lcnt_trace)); } static void lcnt_enable_proc_lock_count(Process *proc, int enable) { @@ -1138,10 +1149,11 @@ static void lcnt_enable_proc_lock_count(Process *proc, int enable) { void erts_lcnt_proc_lock(erts_proc_lock_t *lock, ErtsProcLocks locks) { if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) return; if (locks & ERTS_PROC_LOCK_MAIN) { erts_lcnt_lock(&(lock->lcnt_main)); } + if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_lock(&(lock->lcnt_link)); } 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)); } if (locks & ERTS_PROC_LOCK_STATUS) { erts_lcnt_lock(&(lock->lcnt_status)); } + if (locks & ERTS_PROC_LOCK_TRACE) { erts_lcnt_lock(&(lock->lcnt_trace)); } } void erts_lcnt_proc_lock_post_x(erts_proc_lock_t *lock, ErtsProcLocks locks, @@ -1150,44 +1162,50 @@ void erts_lcnt_proc_lock_post_x(erts_proc_lock_t *lock, ErtsProcLocks locks, if (locks & ERTS_PROC_LOCK_MAIN) { erts_lcnt_lock_post_x(&(lock->lcnt_main), file, line); } + if (locks & ERTS_PROC_LOCK_LINK) { + erts_lcnt_lock_post_x(&(lock->lcnt_link), file, line); + } 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); - } if (locks & ERTS_PROC_LOCK_STATUS) { erts_lcnt_lock_post_x(&(lock->lcnt_status), file, line); } + if (locks & ERTS_PROC_LOCK_TRACE) { + erts_lcnt_lock_post_x(&(lock->lcnt_trace), file, line); + } } void erts_lcnt_proc_lock_unaquire(erts_proc_lock_t *lock, ErtsProcLocks locks) { if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) return; if (locks & ERTS_PROC_LOCK_MAIN) { erts_lcnt_lock_unaquire(&(lock->lcnt_main)); } + if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_lock_unaquire(&(lock->lcnt_link)); } 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)); } if (locks & ERTS_PROC_LOCK_STATUS) { erts_lcnt_lock_unaquire(&(lock->lcnt_status)); } + if (locks & ERTS_PROC_LOCK_TRACE) { erts_lcnt_lock_unaquire(&(lock->lcnt_trace)); } } void erts_lcnt_proc_unlock(erts_proc_lock_t *lock, ErtsProcLocks locks) { if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) return; if (locks & ERTS_PROC_LOCK_MAIN) { erts_lcnt_unlock(&(lock->lcnt_main)); } + if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_unlock(&(lock->lcnt_link)); } 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)); } if (locks & ERTS_PROC_LOCK_STATUS) { erts_lcnt_unlock(&(lock->lcnt_status)); } + if (locks & ERTS_PROC_LOCK_TRACE) { erts_lcnt_unlock(&(lock->lcnt_trace)); } } void erts_lcnt_proc_trylock(erts_proc_lock_t *lock, ErtsProcLocks locks, int res) { if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) return; if (locks & ERTS_PROC_LOCK_MAIN) { erts_lcnt_trylock(&(lock->lcnt_main), res); } + if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_trylock(&(lock->lcnt_link), 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); } if (locks & ERTS_PROC_LOCK_STATUS) { erts_lcnt_trylock(&(lock->lcnt_status), res); } + if (locks & ERTS_PROC_LOCK_TRACE) { erts_lcnt_trylock(&(lock->lcnt_trace), res); } } /* reversed logic */ #endif /* ERTS_ENABLE_LOCK_COUNT */ @@ -1224,6 +1242,10 @@ erts_proc_lc_lock(Process *p, ErtsProcLocks locks, char *file, unsigned int line lck.id = lc_id.proc_lock_status; erts_lc_lock_x(&lck,file,line); } + if (locks & ERTS_PROC_LOCK_TRACE) { + lck.id = lc_id.proc_lock_trace; + erts_lc_lock_x(&lck,file,line); + } } void @@ -1253,6 +1275,10 @@ erts_proc_lc_trylock(Process *p, ErtsProcLocks locks, int locked, lck.id = lc_id.proc_lock_status; erts_lc_trylock_x(locked, &lck, file, line); } + if (locks & ERTS_PROC_LOCK_TRACE) { + lck.id = lc_id.proc_lock_trace; + erts_lc_trylock_x(locked, &lck, file, line); + } } void @@ -1261,6 +1287,10 @@ erts_proc_lc_unlock(Process *p, ErtsProcLocks locks) erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, p->common.id, ERTS_LC_FLG_LT_PROCLOCK); + if (locks & ERTS_PROC_LOCK_TRACE) { + lck.id = lc_id.proc_lock_trace; + erts_lc_unlock(&lck); + } if (locks & ERTS_PROC_LOCK_STATUS) { lck.id = lc_id.proc_lock_status; erts_lc_unlock(&lck); @@ -1292,6 +1322,10 @@ erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks) erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, p->common.id, ERTS_LC_FLG_LT_PROCLOCK); + if (locks & ERTS_PROC_LOCK_TRACE) { + lck.id = lc_id.proc_lock_trace; + erts_lc_might_unlock(&lck); + } if (locks & ERTS_PROC_LOCK_STATUS) { lck.id = lc_id.proc_lock_status; erts_lc_might_unlock(&lck); @@ -1323,6 +1357,8 @@ erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks) erts_lc_might_unlock(&p->lock.btm.lc); if (locks & ERTS_PROC_LOCK_STATUS) erts_lc_might_unlock(&p->lock.status.lc); + if (locks & ERTS_PROC_LOCK_TRACE) + erts_lc_might_unlock(&p->lock.trace.lc); #endif } @@ -1354,6 +1390,10 @@ erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks, char *file, lck.id = lc_id.proc_lock_status; erts_lc_require_lock(&lck, file, line); } + if (locks & ERTS_PROC_LOCK_TRACE) { + lck.id = lc_id.proc_lock_trace; + erts_lc_require_lock(&lck, file, line); + } #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL if (locks & ERTS_PROC_LOCK_MAIN) erts_lc_require_lock(&p->lock.main.lc, file, line); @@ -1365,6 +1405,8 @@ erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks, char *file, 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); + if (locks & ERTS_PROC_LOCK_TRACE) + erts_lc_require_lock(&p->lock.trace.lc, file, line); #endif } @@ -1375,6 +1417,10 @@ erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks) erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, p->common.id, ERTS_LC_FLG_LT_PROCLOCK); + if (locks & ERTS_PROC_LOCK_TRACE) { + lck.id = lc_id.proc_lock_trace; + erts_lc_unrequire_lock(&lck); + } if (locks & ERTS_PROC_LOCK_STATUS) { lck.id = lc_id.proc_lock_status; erts_lc_unrequire_lock(&lck); @@ -1406,6 +1452,8 @@ erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks) erts_lc_unrequire_lock(&p->lock.btm.lc); if (locks & ERTS_PROC_LOCK_STATUS) erts_lc_unrequire_lock(&p->lock.status.lc); + if (locks & ERTS_PROC_LOCK_TRACE) + erts_lc_unrequire_lock(&p->lock.trace.lc); #endif } @@ -1429,6 +1477,8 @@ erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks) lck.id = lc_id.proc_lock_btm; else if (locks & ERTS_PROC_LOCK_STATUS) lck.id = lc_id.proc_lock_status; + else if (locks & ERTS_PROC_LOCK_TRACE) + lck.id = lc_id.proc_lock_trace; else erts_lc_fail("Unknown proc lock found"); @@ -1441,14 +1491,7 @@ erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks) void erts_proc_lc_chk_only_proc_main(Process *p) { -#if ERTS_PROC_LOCK_OWN_IMPL - erts_lc_lock_t proc_main = ERTS_LC_LOCK_INIT(lc_id.proc_lock_main, - p->common.id, - ERTS_LC_FLG_LT_PROCLOCK); - erts_lc_check_exact(&proc_main, 1); -#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL - erts_lc_check_exact(&p->lock.main.lc, 1); -#endif + erts_proc_lc_chk_only_proc(p, ERTS_PROC_LOCK_MAIN); } #if ERTS_PROC_LOCK_OWN_IMPL @@ -1456,14 +1499,67 @@ void erts_proc_lc_chk_only_proc_main(Process *p) ERTS_LC_LOCK_INIT(-1, THE_NON_VALUE, ERTS_LC_FLG_LT_PROCLOCK) #endif /* ERTS_PROC_LOCK_OWN_IMPL */ +void erts_proc_lc_chk_only_proc(Process *p, ErtsProcLocks locks) +{ + int have_locks_len = 0; +#if ERTS_PROC_LOCK_OWN_IMPL + erts_lc_lock_t have_locks[6] = {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, + ERTS_PROC_LC_EMPTY_LOCK_INIT}; + if (locks & ERTS_PROC_LOCK_MAIN) { + have_locks[have_locks_len].id = lc_id.proc_lock_main; + have_locks[have_locks_len++].extra = p->common.id; + } + if (locks & ERTS_PROC_LOCK_LINK) { + have_locks[have_locks_len].id = lc_id.proc_lock_link; + have_locks[have_locks_len++].extra = p->common.id; + } + if (locks & ERTS_PROC_LOCK_MSGQ) { + 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; + } + if (locks & ERTS_PROC_LOCK_TRACE) { + have_locks[have_locks_len].id = lc_id.proc_lock_trace; + have_locks[have_locks_len++].extra = p->common.id; + } +#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL + erts_lc_lock_t have_locks[6]; + 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; + if (locks & ERTS_PROC_LOCK_TRACE) + have_locks[have_locks_len++] = p->lock.trace.lc; +#endif + erts_lc_check_exact(have_locks, have_locks_len); +} + void 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[5] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, + erts_lc_lock_t have_locks[6] = {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, ERTS_PROC_LC_EMPTY_LOCK_INIT}; if (locks & ERTS_PROC_LOCK_MAIN) { @@ -1486,8 +1582,12 @@ erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks) have_locks[have_locks_len].id = lc_id.proc_lock_status; have_locks[have_locks_len++].extra = p->common.id; } + if (locks & ERTS_PROC_LOCK_TRACE) { + have_locks[have_locks_len].id = lc_id.proc_lock_trace; + have_locks[have_locks_len++].extra = p->common.id; + } #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL - erts_lc_lock_t have_locks[5]; + erts_lc_lock_t have_locks[6]; if (locks & ERTS_PROC_LOCK_MAIN) have_locks[have_locks_len++] = p->lock.main.lc; if (locks & ERTS_PROC_LOCK_LINK) @@ -1498,6 +1598,8 @@ erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks) have_locks[have_locks_len++] = p->lock.btm.lc; if (locks & ERTS_PROC_LOCK_STATUS) have_locks[have_locks_len++] = p->lock.status.lc; + if (locks & ERTS_PROC_LOCK_TRACE) + have_locks[have_locks_len++] = p->lock.trace.lc; #endif erts_lc_check(have_locks, have_locks_len, NULL, 0); } @@ -1508,12 +1610,14 @@ 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[5] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, + erts_lc_lock_t have_locks[6] = {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}; - erts_lc_lock_t have_not_locks[5] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, + erts_lc_lock_t have_not_locks[6] = {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}; @@ -1557,9 +1661,17 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks) have_not_locks[have_not_locks_len].id = lc_id.proc_lock_status; have_not_locks[have_not_locks_len++].extra = p->common.id; } + if (locks & ERTS_PROC_LOCK_TRACE) { + have_locks[have_locks_len].id = lc_id.proc_lock_trace; + have_locks[have_locks_len++].extra = p->common.id; + } + else { + have_not_locks[have_not_locks_len].id = lc_id.proc_lock_trace; + have_not_locks[have_not_locks_len++].extra = p->common.id; + } #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL - erts_lc_lock_t have_locks[5]; - erts_lc_lock_t have_not_locks[5]; + erts_lc_lock_t have_locks[6]; + erts_lc_lock_t have_not_locks[6]; if (locks & ERTS_PROC_LOCK_MAIN) have_locks[have_locks_len++] = p->lock.main.lc; @@ -1581,6 +1693,10 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks) have_locks[have_locks_len++] = p->lock.status.lc; else have_not_locks[have_not_locks_len++] = p->lock.status.lc; + if (locks & ERTS_PROC_LOCK_TRACE) + have_locks[have_locks_len++] = p->lock.trace.lc; + else + have_not_locks[have_not_locks_len++] = p->lock.trace.lc; #endif erts_lc_check(have_locks, have_locks_len, @@ -1590,10 +1706,10 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks) ErtsProcLocks erts_proc_lc_my_proc_locks(Process *p) { - int resv[5]; + int resv[6]; ErtsProcLocks res = 0; #if ERTS_PROC_LOCK_OWN_IMPL - erts_lc_lock_t locks[5] = {ERTS_LC_LOCK_INIT(lc_id.proc_lock_main, + erts_lc_lock_t locks[6] = {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, @@ -1607,16 +1723,20 @@ erts_proc_lc_my_proc_locks(Process *p) ERTS_LC_FLG_LT_PROCLOCK), ERTS_LC_LOCK_INIT(lc_id.proc_lock_status, p->common.id, + ERTS_LC_FLG_LT_PROCLOCK), + ERTS_LC_LOCK_INIT(lc_id.proc_lock_trace, + p->common.id, ERTS_LC_FLG_LT_PROCLOCK)}; #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL - erts_lc_lock_t locks[5] = {p->lock.main.lc, + erts_lc_lock_t locks[6] = {p->lock.main.lc, p->lock.link.lc, p->lock.msgq.lc, p->lock.btm.lc, - p->lock.status.lc}; + p->lock.status.lc, + p->lock.trace.lc}; #endif - erts_lc_have_locks(resv, locks, 5); + erts_lc_have_locks(resv, locks, 6); if (resv[0]) res |= ERTS_PROC_LOCK_MAIN; if (resv[1]) @@ -1627,6 +1747,8 @@ erts_proc_lc_my_proc_locks(Process *p) res |= ERTS_PROC_LOCK_BTM; if (resv[4]) res |= ERTS_PROC_LOCK_STATUS; + if (resv[5]) + res |= ERTS_PROC_LOCK_TRACE; return res; } @@ -1634,14 +1756,15 @@ erts_proc_lc_my_proc_locks(Process *p) void erts_proc_lc_chk_no_proc_locks(char *file, int line) { - int resv[5]; - int ids[5] = {lc_id.proc_lock_main, + int resv[6]; + int ids[6] = {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, 5); - if (!ERTS_IS_CRASH_DUMPING && (resv[0] || resv[1] || resv[2] || resv[3] || resv[4])) { + lc_id.proc_lock_status, + lc_id.proc_lock_trace}; + erts_lc_have_lock_ids(resv, ids, 6); + if (!ERTS_IS_CRASH_DUMPING && (resv[0] || resv[1] || resv[2] || resv[3] || resv[4] || resv[5])) { 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 9c59301086..2cccf0697a 100644 --- a/erts/emulator/beam/erl_process_lock.h +++ b/erts/emulator/beam/erl_process_lock.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2007-2012. All Rights Reserved. + * Copyright Ericsson AB 2007-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -66,7 +66,7 @@ #endif -#define ERTS_PROC_LOCK_MAX_BIT 4 +#define ERTS_PROC_LOCK_MAX_BIT 5 typedef erts_aint32_t ErtsProcLocks; @@ -84,6 +84,7 @@ typedef struct erts_proc_lock_t_ { erts_lcnt_lock_t lcnt_msgq; erts_lcnt_lock_t lcnt_btm; erts_lcnt_lock_t lcnt_status; + erts_lcnt_lock_t lcnt_trace; #endif #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL erts_mtx_t main; @@ -91,6 +92,7 @@ typedef struct erts_proc_lock_t_ { erts_mtx_t msgq; erts_mtx_t btm; erts_mtx_t status; + erts_mtx_t trace; #else # error "no implementation" #endif @@ -137,9 +139,18 @@ typedef struct erts_proc_lock_t_ { * Protects the following fields in the process structure: * * pending_suspenders * * suspendee + * * sys_tasks * * ... */ -#define ERTS_PROC_LOCK_STATUS (((ErtsProcLocks) 1) << ERTS_PROC_LOCK_MAX_BIT) +#define ERTS_PROC_LOCK_STATUS (((ErtsProcLocks) 1) << 4) + +/* + * Trace message lock: + * Protects the order in which messages are sent + * from trace nifs. This lock is taken inside enif_send. + * + */ +#define ERTS_PROC_LOCK_TRACE (((ErtsProcLocks) 1) << ERTS_PROC_LOCK_MAX_BIT) /* * Special fields: @@ -154,8 +165,8 @@ typedef struct erts_proc_lock_t_ { * all process locks are held, and are allowed to be read if * at least one process lock (whichever one doesn't matter) * is held: - * * tracer_proc - * * tracer_flags + * * common.tracer + * * common.trace_flags * * The following fields are only allowed to be accessed if * both the schedule queue lock and at least one process lock @@ -198,17 +209,15 @@ typedef struct erts_proc_lock_t_ { /* ERTS_PROC_LOCKS_* are combinations of process locks */ -#define ERTS_PROC_LOCKS_MSG_RECEIVE (ERTS_PROC_LOCK_MSGQ \ - | ERTS_PROC_LOCK_STATUS) -#define ERTS_PROC_LOCKS_MSG_SEND (ERTS_PROC_LOCK_MSGQ \ - | ERTS_PROC_LOCK_STATUS) +#define ERTS_PROC_LOCKS_MSG_RECEIVE ERTS_PROC_LOCK_MSGQ +#define ERTS_PROC_LOCKS_MSG_SEND ERTS_PROC_LOCK_MSGQ #define ERTS_PROC_LOCKS_XSIG_SEND ERTS_PROC_LOCK_STATUS #define ERTS_PROC_LOCKS_ALL \ ((((ErtsProcLocks) 1) << (ERTS_PROC_LOCK_MAX_BIT + 1)) - 1) #define ERTS_PROC_LOCKS_ALL_MINOR (ERTS_PROC_LOCKS_ALL \ - & ~ERTS_PROC_LOCK_MAIN) + & ~ERTS_PROC_LOCK_MAIN) #define ERTS_PIX_LOCKS_BITS 10 @@ -260,6 +269,7 @@ void erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks); void erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks); void erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks); void erts_proc_lc_chk_only_proc_main(Process *p); +void erts_proc_lc_chk_only_proc(Process *p, ErtsProcLocks locks); void erts_proc_lc_chk_no_proc_locks(char *file, int line); ErtsProcLocks erts_proc_lc_my_proc_locks(Process *p); int erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks); @@ -477,9 +487,15 @@ erts_smp_proc_raw_trylock__(Process *p, ErtsProcLocks locks) if (locks & ERTS_PROC_LOCK_STATUS) if (erts_mtx_trylock(&p->lock.status) == EBUSY) goto busy_status; + if (locks & ERTS_PROC_LOCK_TRACE) + if (erts_mtx_trylock(&p->lock.trace) == EBUSY) + goto busy_trace; return 0; +busy_trace: + if (locks & ERTS_PROC_LOCK_TRACE) + erts_mtx_unlock(&p->lock.trace); busy_status: if (locks & ERTS_PROC_LOCK_BTM) erts_mtx_unlock(&p->lock.btm); @@ -568,6 +584,8 @@ erts_smp_proc_lock__(Process *p, erts_mtx_lock(&p->lock.btm); if (locks & ERTS_PROC_LOCK_STATUS) erts_mtx_lock(&p->lock.status); + if (locks & ERTS_PROC_LOCK_TRACE) + erts_mtx_lock(&p->lock.trace); #ifdef ERTS_PROC_LOCK_DEBUG erts_proc_lock_op_debug(p, locks, 1); @@ -653,6 +671,8 @@ erts_smp_proc_unlock__(Process *p, erts_proc_lock_op_debug(p, locks, 0); #endif + if (locks & ERTS_PROC_LOCK_TRACE) + erts_mtx_unlock(&p->lock.trace); if (locks & ERTS_PROC_LOCK_STATUS) erts_mtx_unlock(&p->lock.status); if (locks & ERTS_PROC_LOCK_BTM) diff --git a/erts/emulator/beam/erl_ptab.c b/erts/emulator/beam/erl_ptab.c index 9ed175fe01..22830a19c4 100644 --- a/erts/emulator/beam/erl_ptab.c +++ b/erts/emulator/beam/erl_ptab.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012-2013. All Rights Reserved. + * Copyright Ericsson AB 2012-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_ptab.h b/erts/emulator/beam/erl_ptab.h index 8fd961e3ce..a5931ffc25 100644 --- a/erts/emulator/beam/erl_ptab.h +++ b/erts/emulator/beam/erl_ptab.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012-2013. All Rights Reserved. + * Copyright Ericsson AB 2012-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -37,14 +37,16 @@ #include "erl_alloc.h" #include "erl_monitors.h" -#define ERTS_TRACER_PROC(P) ((P)->common.tracer_proc) +#define ERTS_TRACER(P) ((P)->common.tracer) +#define ERTS_TRACER_MODULE(T) (CAR(list_val(T))) +#define ERTS_TRACER_STATE(T) (CDR(list_val(T))) #define ERTS_TRACE_FLAGS(P) ((P)->common.trace_flags) #define ERTS_P_LINKS(P) ((P)->common.u.alive.links) #define ERTS_P_MONITORS(P) ((P)->common.u.alive.monitors) #define IS_TRACED(p) \ - (ERTS_TRACER_PROC((p)) != NIL) + (ERTS_TRACER(p) != NIL) #define ARE_TRACE_FLAGS_ON(p,tf) \ ((ERTS_TRACE_FLAGS((p)) & (tf|F_SENSITIVE)) == (tf)) #define IS_TRACED_FL(p,tf) \ @@ -56,7 +58,7 @@ typedef struct { erts_atomic_t atmc; Sint sint; } refc; - Eterm tracer_proc; + ErtsTracer tracer; Uint trace_flags; erts_smp_atomic_t timer; union { diff --git a/erts/emulator/beam/erl_sched_spec_pre_alloc.c b/erts/emulator/beam/erl_sched_spec_pre_alloc.c index caec24bc03..cab4bd73db 100644 --- a/erts/emulator/beam/erl_sched_spec_pre_alloc.c +++ b/erts/emulator/beam/erl_sched_spec_pre_alloc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011-2012. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_sched_spec_pre_alloc.h b/erts/emulator/beam/erl_sched_spec_pre_alloc.h index 4d07b0f674..7808d7d438 100644 --- a/erts/emulator/beam/erl_sched_spec_pre_alloc.h +++ b/erts/emulator/beam/erl_sched_spec_pre_alloc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011-2012. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_smp.h b/erts/emulator/beam/erl_smp.h index 5fc5e989a6..713ed50b86 100644 --- a/erts/emulator/beam/erl_smp.h +++ b/erts/emulator/beam/erl_smp.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2013. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_sock.h b/erts/emulator/beam/erl_sock.h index 7be6062115..3429a52d7e 100644 --- a/erts/emulator/beam/erl_sock.h +++ b/erts/emulator/beam/erl_sock.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_sys_driver.h b/erts/emulator/beam/erl_sys_driver.h index 4031eef0aa..d46e88cb05 100644 --- a/erts/emulator/beam/erl_sys_driver.h +++ b/erts/emulator/beam/erl_sys_driver.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c index bae3385d3f..7d857ad326 100644 --- a/erts/emulator/beam/erl_term.c +++ b/erts/emulator/beam/erl_term.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2013. All Rights Reserved. + * Copyright Ericsson AB 2000-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -28,94 +28,35 @@ #include <stdlib.h> #include <stdio.h> -__decl_noreturn static void __noreturn -et_abort(const char *expr, const char *file, unsigned line) +void +erts_set_literal_tag(Eterm *term, Eterm *hp_start, Eterm hsz) { -#ifdef EXIT_ON_ET_ABORT - static int have_been_called = 0; +#ifdef TAG_LITERAL_PTR + Eterm *hp_end, *hp; + + hp_end = hp_start + hsz; + hp = hp_start; - if (have_been_called) { - abort(); - } else { - /* - * Prevent infinite loop. - */ - have_been_called = 1; - erts_exit(ERTS_ERROR_EXIT, "TYPE ASSERTION FAILED, file %s, line %u: %s\n", file, line, expr); - } -#else - erts_fprintf(stderr, "TYPE ASSERTION FAILED, file %s, line %u: %s\n", file, line, expr); - abort(); -#endif -} - -#if ET_DEBUG -#define ET_ASSERT(expr,file,line) \ -do { \ - if (!(expr)) \ - et_abort(#expr, file, line); \ -} while(0) -#else -#define ET_ASSERT(expr,file,line) do { } while(0) -#endif - -#if ET_DEBUG -unsigned tag_val_def_debug(Wterm x, const char *file, unsigned line) -#else -unsigned tag_val_def(Wterm x) -#define file __FILE__ -#define line __LINE__ -#endif -{ - static char msg[32]; - - switch (x & _TAG_PRIMARY_MASK) { - case TAG_PRIMARY_LIST: - ET_ASSERT(_list_precond(x),file,line); - return LIST_DEF; - case TAG_PRIMARY_BOXED: { - Eterm hdr = *boxed_val(x); - ET_ASSERT(is_header(hdr),file,line); - switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { - case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE): return TUPLE_DEF; - case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): return BIG_DEF; - case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): return BIG_DEF; - case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): return REF_DEF; - case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): return FLOAT_DEF; - case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE): return EXPORT_DEF; - case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE): return FUN_DEF; - 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_BIN_MATCHSTATE >> _TAG_PRIMARY_SIZE): return MATCHSTATE_DEF; - } - - break; - } - case TAG_PRIMARY_IMMED1: { - switch ((x & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { - case (_TAG_IMMED1_PID >> _TAG_PRIMARY_SIZE): return PID_DEF; - case (_TAG_IMMED1_PORT >> _TAG_PRIMARY_SIZE): return PORT_DEF; - case (_TAG_IMMED1_IMMED2 >> _TAG_PRIMARY_SIZE): { - switch ((x & _TAG_IMMED2_MASK) >> _TAG_IMMED1_SIZE) { - case (_TAG_IMMED2_ATOM >> _TAG_IMMED1_SIZE): return ATOM_DEF; - case (_TAG_IMMED2_NIL >> _TAG_IMMED1_SIZE): return NIL_DEF; - } - break; + while (hp < hp_end) { + switch (primary_tag(*hp)) { + case TAG_PRIMARY_BOXED: + case TAG_PRIMARY_LIST: + *hp |= TAG_LITERAL_PTR; + break; + case TAG_PRIMARY_HEADER: + if (header_is_thing(*hp)) { + hp += thing_arityval(*hp); } - case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): return SMALL_DEF; - } - break; - } + break; + default: + break; + } + + hp++; } - erts_snprintf(msg, sizeof(msg), "tag_val_def: %#lx", (unsigned long) x); - et_abort(msg, file, line); -#undef file -#undef line + if (is_boxed(*term) || is_list(*term)) + *term |= TAG_LITERAL_PTR; +#endif } /* @@ -174,9 +115,7 @@ ET_DEFINE_CHECKED(Uint,external_thing_data_words,ExternalThing*,is_thing_ptr); ET_DEFINE_CHECKED(Eterm,make_cp,UWord *,_is_taggable_pointer); ET_DEFINE_CHECKED(UWord *,cp_val,Eterm,is_CP); ET_DEFINE_CHECKED(Uint,catch_val,Eterm,is_catch); -ET_DEFINE_CHECKED(Uint,x_reg_offset,Uint,_is_xreg); -ET_DEFINE_CHECKED(Uint,y_reg_offset,Uint,_is_yreg); -ET_DEFINE_CHECKED(Uint,x_reg_index,Uint,_is_xreg); -ET_DEFINE_CHECKED(Uint,y_reg_index,Uint,_is_yreg); +ET_DEFINE_CHECKED(Uint,loader_x_reg_index,Uint,_is_loader_x_reg); +ET_DEFINE_CHECKED(Uint,loader_y_reg_index,Uint,_is_loader_y_reg); #endif /* ET_DEBUG */ diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index d5e91d80d9..c3234ee349 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2014. All Rights Reserved. + * Copyright Ericsson AB 2000-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -21,34 +21,10 @@ #ifndef __ERL_TERM_H #define __ERL_TERM_H -#include "sys.h" /* defines HALFWORD_HEAP */ +#include "erl_mmap.h" typedef UWord Wterm; /* Full word terms */ -#if HALFWORD_HEAP -# define HEAP_ON_C_STACK 0 -# if HALFWORD_ASSERT -# ifdef ET_DEBUG -# undef ET_DEBUG -# endif -# define ET_DEBUG 1 -# endif -# if 1 -# define CHECK_POINTER_MASK 0xFFFFFFFF00000000UL -# define COMPRESS_POINTER(APointer) ((Eterm) (UWord) (APointer)) -# define EXPAND_POINTER(AnEterm) ((UWord) (AnEterm)) -# else -# define CHECK_POINTER_MASK 0x0UL -# define COMPRESS_POINTER(AnUint) (AnUint) -# define EXPAND_POINTER(APointer) (APointer) -# endif -#else -# define HEAP_ON_C_STACK 1 -# define CHECK_POINTER_MASK 0x0UL -# define COMPRESS_POINTER(AnUint) (AnUint) -# define EXPAND_POINTER(APointer) (APointer) -#endif - struct erl_node_; /* Declared in erl_node_tables.h */ /* @@ -74,6 +50,24 @@ struct erl_node_; /* Declared in erl_node_tables.h */ #define _ET_APPLY(F,X) _unchecked_##F(X) #endif +#if defined(ARCH_64) +# define TAG_PTR_MASK__ 0x7 +# if !defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION) +# ifdef HIPE +# error Hipe on 64-bit needs a real mmap as it does not support the literal tag +# endif +# define TAG_LITERAL_PTR 0x4 +# else +# undef TAG_LITERAL_PTR +# endif +#elif defined(ARCH_32) +# define TAG_PTR_MASK__ 0x3 +# undef TAG_LITERAL_PTR +#else +# error Not supported arch +#endif + + #define _TAG_PRIMARY_SIZE 2 #define _TAG_PRIMARY_MASK 0x3 #define TAG_PRIMARY_HEADER 0x0 @@ -190,15 +184,13 @@ struct erl_node_; /* Declared in erl_node_tables.h */ /* boxed object access methods */ -#if HALFWORD_HEAP -#define _is_taggable_pointer(x) (((UWord)(x) & (CHECK_POINTER_MASK | 0x3)) == 0) -#define _boxed_precond(x) (is_boxed(x)) -#else -#define _is_taggable_pointer(x) (((Uint)(x) & 0x3) == 0) + +#define _is_taggable_pointer(x) (((Uint)(x) & TAG_PTR_MASK__) == 0) + #define _boxed_precond(x) (is_boxed(x)) -#endif -#define _is_aligned(x) (((Uint)(x) & 0x3) == 0) -#define _unchecked_make_boxed(x) ((Uint) COMPRESS_POINTER(x) + TAG_PRIMARY_BOXED) + +#define _is_aligned(x) (((Uint)(x) & TAG_PTR_MASK__) == 0) +#define _unchecked_make_boxed(x) ((Uint)(x) + TAG_PRIMARY_BOXED) _ET_DECLARE_CHECKED(Eterm,make_boxed,const Eterm*) #define make_boxed(x) _ET_APPLY(make_boxed,(x)) #if 1 @@ -209,12 +201,16 @@ _ET_DECLARE_CHECKED(int,is_boxed,Eterm) #else #define is_boxed(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_BOXED) #endif -#define _unchecked_boxed_val(x) ((Eterm*) EXPAND_POINTER(((x) - TAG_PRIMARY_BOXED))) +#ifdef TAG_LITERAL_PTR +#define _unchecked_boxed_val(x) _unchecked_ptr_val(x) +#else +#define _unchecked_boxed_val(x) ((Eterm*) ((x) - TAG_PRIMARY_BOXED)) +#endif _ET_DECLARE_CHECKED(Eterm*,boxed_val,Wterm) #define boxed_val(x) _ET_APPLY(boxed_val,(x)) /* cons cell ("list") access methods */ -#define _unchecked_make_list(x) ((Uint) COMPRESS_POINTER(x) + TAG_PRIMARY_LIST) +#define _unchecked_make_list(x) ((Uint)(x) + TAG_PRIMARY_LIST) _ET_DECLARE_CHECKED(Eterm,make_list,const Eterm*) #define make_list(x) _ET_APPLY(make_list,(x)) #if 1 @@ -226,12 +222,12 @@ _ET_DECLARE_CHECKED(int,is_not_list,Eterm) #define is_list(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_LIST) #define is_not_list(x) (!is_list((x))) #endif -#if HALFWORD_HEAP #define _list_precond(x) (is_list(x)) +#ifdef TAG_LITERAL_PTR +#define _unchecked_list_val(x) _unchecked_ptr_val(x) #else -#define _list_precond(x) (is_list(x)) +#define _unchecked_list_val(x) ((Eterm*) ((x) - TAG_PRIMARY_LIST)) #endif -#define _unchecked_list_val(x) ((Eterm*) EXPAND_POINTER((x) - TAG_PRIMARY_LIST)) _ET_DECLARE_CHECKED(Eterm*,list_val,Wterm) #define list_val(x) _ET_APPLY(list_val,(x)) @@ -242,15 +238,22 @@ _ET_DECLARE_CHECKED(Eterm*,list_val,Wterm) #define CDR(x) ((x)[1]) /* generic tagged pointer (boxed or list) access methods */ -#define _unchecked_ptr_val(x) ((Eterm*) EXPAND_POINTER((x) & ~((Uint) 0x3))) +#define _unchecked_ptr_val(x) ((Eterm*) ((x) & ~((Uint) TAG_PTR_MASK__))) #define ptr_val(x) _unchecked_ptr_val((x)) /*XXX*/ #define _unchecked_offset_ptr(x,offs) ((x)+((offs)*sizeof(Eterm))) #define offset_ptr(x,offs) _unchecked_offset_ptr(x,offs) /*XXX*/ #define _unchecked_byte_offset_ptr(x,byte_offs) ((x)+(offs)) #define byte_offset_ptr(x,offs) _unchecked_byte_offset_ptr(x,offs) /*XXX*/ +#ifdef TAG_LITERAL_PTR +#define _unchecked_is_not_literal_ptr(x) (!((x) & TAG_LITERAL_PTR)) +#define is_not_literal_ptr(x) _unchecked_is_not_literal_ptr((x)) /*XXX*/ +#define is_literal_ptr(x) (!is_not_literal_ptr((x))) /*XXX*/ +#endif + + /* fixnum ("small") access methods */ -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) #define SMALL_BITS (64-4) #define SMALL_DIGITS (17) #else @@ -396,11 +399,7 @@ _ET_DECLARE_CHECKED(Eterm*,fun_val,Wterm) _ET_DECLARE_CHECKED(Eterm*,export_val,Wterm) #define export_val(x) _ET_APPLY(export_val,(x)) #define is_export_header(x) ((x) == HEADER_EXPORT) -#if HALFWORD_HEAP -#define HEADER_EXPORT _make_header(2,_TAG_HEADER_EXPORT) -#else #define HEADER_EXPORT _make_header(1,_TAG_HEADER_EXPORT) -#endif /* bignum access methods */ #define make_pos_bignum_header(sz) _make_header((sz),_TAG_HEADER_POS_BIG) @@ -424,7 +423,7 @@ _ET_DECLARE_CHECKED(Eterm*,big_val,Wterm) #define big_val(x) _ET_APPLY(big_val,(x)) /* flonum ("float") access methods */ -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) #define HEADER_FLONUM _make_header(1,_TAG_HEADER_FLOAT) #else #define HEADER_FLONUM _make_header(2,_TAG_HEADER_FLOAT) @@ -445,12 +444,12 @@ typedef union float_def byte fb[sizeof(ieee754_8)]; Uint16 fs[sizeof(ieee754_8) / sizeof(Uint16)]; Uint32 fw[sizeof(ieee754_8) / sizeof(Uint32)]; -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) Uint fdw; #endif } FloatDef; -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) #define FLOAT_VAL_GET_DOUBLE(fval, f) (f).fdw = *((fval)+1) @@ -559,14 +558,6 @@ _ET_DECLARE_CHECKED(Eterm*,tuple_val,Wterm) #define _GETBITS(X,Pos,Size) (((X) >> (Pos)) & ~(~((Uint) 0) << (Size))) -/* - * Creation in node specific data (pids, ports, refs) - */ - -#define _CRE_SIZE 2 - -/* MAX value for the creation field in pid, port and reference */ -#define MAX_CREATION (1 << _CRE_SIZE) /* * PID layout (internal pids): @@ -580,7 +571,7 @@ _ET_DECLARE_CHECKED(Eterm*,tuple_val,Wterm) * * n : number * - * Old pid layout: + * Very old pid layout: * * |3 3 2 2 2 2 2 2|2 2 2 2 1 1 1 1|1 1 1 1 1 1 | | * |1 0 9 8 7 6 5 4|3 2 1 0 9 8 7 6|5 4 3 2 1 0 9 8|7 6 5 4 3 2 1 0| @@ -727,7 +718,7 @@ _ET_DECLARE_CHECKED(struct erl_node_*,internal_port_node,Eterm) #define ERTS_MAX_REF_NUMBERS 3 #define ERTS_REF_NUMBERS ERTS_MAX_REF_NUMBERS -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) # define ERTS_REF_WORDS (ERTS_REF_NUMBERS/2 + 1) # define ERTS_REF_32BIT_WORDS (ERTS_REF_NUMBERS+1) #else @@ -749,7 +740,7 @@ typedef struct { #define make_ref_thing_header(DW) \ _make_header((DW)+REF_THING_HEAD_SIZE-1,_TAG_HEADER_REF) -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) /* * Ref layout on a 64-bit little endian machine: @@ -1009,27 +1000,20 @@ _ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm) #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 */ @@ -1048,14 +1032,14 @@ _ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm) #error "fix yer arch, like" #endif -#define _unchecked_make_cp(x) ((Eterm) COMPRESS_POINTER(x)) +#define _unchecked_make_cp(x) ((Eterm)(x)) _ET_DECLARE_CHECKED(Eterm,make_cp,BeamInstr*) #define make_cp(x) _ET_APPLY(make_cp,(x)) #define is_not_CP(x) ((x) & _CPMASK) #define is_CP(x) (!is_not_CP(x)) -#define _unchecked_cp_val(x) ((BeamInstr*) EXPAND_POINTER(x)) +#define _unchecked_cp_val(x) ((BeamInstr*) (x)) _ET_DECLARE_CHECKED(BeamInstr*,cp_val,Eterm) #define cp_val(x) _ET_APPLY(cp_val,(x)) @@ -1071,44 +1055,40 @@ _ET_DECLARE_CHECKED(Uint,catch_val,Eterm) /* * Overloaded tags. * - * SMALL = 15 - * ATOM/NIL=7 + * In the loader, we want to tag a term in a way so that it can + * be any literal (atom/integer/float/tuple/list/binary) or a + * register. * - * Note that the two least significant bits in SMALL/ATOM/NIL always are 3; - * thus, we can distinguish register from literals by looking at only these - * two bits. + * We can achive that by overloading the PID and PORT tags to + * mean X and Y registers. That works because there are no + * pid or port literals. */ -#define X_REG_DEF 0 -#define Y_REG_DEF 1 -#define R_REG_DEF 2 +#define _LOADER_TAG_XREG _TAG_IMMED1_PID +#define _LOADER_TAG_YREG _TAG_IMMED1_PORT +#define _LOADER_TAG_SIZE _TAG_IMMED1_SIZE +#define _LOADER_MASK _TAG_IMMED1_MASK -#define beam_reg_tag(x) ((x) & 3) +#define LOADER_X_REG _LOADER_TAG_XREG +#define LOADER_Y_REG _LOADER_TAG_YREG -#define make_rreg() R_REG_DEF -#define make_xreg(ix) (((ix) * sizeof(Eterm)) | X_REG_DEF) -#define make_yreg(ix) (((ix) * sizeof(Eterm)) | Y_REG_DEF) +#define make_loader_x_reg(R) (((R) << _LOADER_TAG_SIZE) | _LOADER_TAG_XREG) +#define make_loader_y_reg(R) (((R) << _LOADER_TAG_SIZE) | _LOADER_TAG_YREG) -#define _is_xreg(x) (beam_reg_tag(x) == X_REG_DEF) -#define _is_yreg(x) (beam_reg_tag(x) == Y_REG_DEF) +#define loader_reg_index(R) ((R) >> _LOADER_TAG_SIZE) -#define _unchecked_x_reg_offset(R) ((R) - X_REG_DEF) -_ET_DECLARE_CHECKED(Uint,x_reg_offset,Uint) -#define x_reg_offset(R) _ET_APPLY(x_reg_offset,(R)) +#define loader_tag(T) ((T) & _LOADER_MASK) -#define _unchecked_y_reg_offset(R) ((R) - Y_REG_DEF) -_ET_DECLARE_CHECKED(Uint,y_reg_offset,Uint) -#define y_reg_offset(R) _ET_APPLY(y_reg_offset,(R)) +#define _is_loader_x_reg(x) (loader_tag(x) == _LOADER_TAG_XREG) +#define _is_loader_y_reg(x) (loader_tag(x) == _LOADER_TAG_YREG) -#define reg_index(R) ((R) / sizeof(Eterm)) +#define _unchecked_loader_x_reg_index(R) ((R) >> _LOADER_TAG_SIZE) +_ET_DECLARE_CHECKED(Uint,loader_x_reg_index,Uint) +#define loader_x_reg_index(R) _ET_APPLY(loader_x_reg_index,(R)) -#define _unchecked_x_reg_index(R) ((R) >> 2) -_ET_DECLARE_CHECKED(Uint,x_reg_index,Uint) -#define x_reg_index(R) _ET_APPLY(x_reg_index,(R)) - -#define _unchecked_y_reg_index(R) ((R) >> 2) -_ET_DECLARE_CHECKED(Uint,y_reg_index,Uint) -#define y_reg_index(R) _ET_APPLY(y_reg_index,(R)) +#define _unchecked_loader_y_reg_index(R) ((R) >> _LOADER_TAG_SIZE) +_ET_DECLARE_CHECKED(Uint,loader_y_reg_index,Uint) +#define loader_y_reg_index(R) _ET_APPLY(loader_y_reg_index,(R)) /* * Backwards compatibility definitions: @@ -1141,11 +1121,11 @@ _ET_DECLARE_CHECKED(Uint,y_reg_index,Uint) #define FIRST_VACANT_TAG_DEF 0x12 #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__) +ERTS_GLB_INLINE unsigned tag_val_def(Wterm, const char*, unsigned); #else -extern unsigned tag_val_def(Wterm); +ERTS_GLB_INLINE unsigned tag_val_def(Wterm); #endif + #define not_eq_tags(X,Y) (tag_val_def((X)) ^ tag_val_def((Y))) #define NUMBER_CODE(x,y) ((tag_val_def(x) << 5) | tag_val_def(y)) @@ -1160,81 +1140,83 @@ extern unsigned tag_val_def(Wterm); #define FLOAT_BIG _NUMBER_CODE(FLOAT_DEF,BIG_DEF) #define FLOAT_FLOAT _NUMBER_CODE(FLOAT_DEF,FLOAT_DEF) -#if HALFWORD_HEAP -#define ptr2rel(PTR,BASE) ((Eterm*)((char*)(PTR) - (char*)(BASE))) -#define rterm2wterm(REL,BASE) ((Wterm)(REL) + (Wterm)(BASE)) - -#else /* HALFWORD_HEAP */ - -#define ptr2rel(PTR,BASE) (PTR) -#define rterm2wterm(REL,BASE) (REL) - -#endif /* !HALFWORD_HEAP */ - -#define make_list_rel(PTR, BASE) make_list(ptr2rel(PTR,BASE)) -#define make_boxed_rel(PTR, BASE) make_boxed(ptr2rel(PTR,BASE)) -#define make_fun_rel make_boxed_rel -#define make_binary_rel make_boxed_rel -#define make_tuple_rel make_boxed_rel -#define make_external_rel make_boxed_rel -#define make_internal_ref_rel make_boxed_rel -#define make_big_rel make_boxed_rel - -#define binary_val_rel(RTERM, BASE) binary_val(rterm2wterm(RTERM, BASE)) -#define list_val_rel(RTERM, BASE) list_val(rterm2wterm(RTERM, BASE)) -#define boxed_val_rel(RTERM, BASE) boxed_val(rterm2wterm(RTERM, BASE)) -#define tuple_val_rel(RTERM, BASE) tuple_val(rterm2wterm(RTERM, BASE)) -#define export_val_rel(RTERM, BASE) export_val(rterm2wterm(RTERM, BASE)) -#define fun_val_rel(RTERM, BASE) fun_val(rterm2wterm(RTERM, BASE)) -#define big_val_rel(RTERM,BASE) big_val(rterm2wterm(RTERM,BASE)) -#define float_val_rel(RTERM,BASE) float_val(rterm2wterm(RTERM,BASE)) -#define internal_ref_val_rel(RTERM,BASE) internal_ref_val(rterm2wterm(RTERM,BASE)) - -#define external_thing_ptr_rel(RTERM, BASE) external_thing_ptr(rterm2wterm(RTERM, BASE)) -#define external_data_words_rel(RTERM,BASE) external_data_words(rterm2wterm(RTERM,BASE)) - -#define external_port_node_rel(RTERM,BASE) external_port_node(rterm2wterm(RTERM,BASE)) -#define external_port_data_rel(RTERM,BASE) external_port_data(rterm2wterm(RTERM,BASE)) - -#define is_external_pid_rel(RTERM,BASE) is_external_pid(rterm2wterm(RTERM,BASE)) -#define external_pid_node_rel(RTERM,BASE) external_pid_node(rterm2wterm(RTERM,BASE)) -#define external_pid_data_rel(RTERM,BASE) external_pid_data(rterm2wterm(RTERM,BASE)) +#define is_same(A,B) ((A)==(B)) -#define is_binary_rel(RTERM,BASE) is_binary(rterm2wterm(RTERM,BASE)) -#define is_float_rel(RTERM,BASE) is_float(rterm2wterm(RTERM,BASE)) -#define is_fun_rel(RTERM,BASE) is_fun(rterm2wterm(RTERM,BASE)) -#define is_big_rel(RTERM,BASE) is_big(rterm2wterm(RTERM,BASE)) -#define is_export_rel(RTERM,BASE) is_export(rterm2wterm(RTERM,BASE)) -#define is_tuple_rel(RTERM,BASE) is_tuple(rterm2wterm(RTERM,BASE)) +void erts_set_literal_tag(Eterm *term, Eterm *hp_start, Eterm hsz); -#define GET_DOUBLE_REL(RTERM, f, BASE) GET_DOUBLE(rterm2wterm(RTERM,BASE), f) - -#define ref_thing_ptr_rel(RTERM,BASE) ref_thing_ptr(rterm2wterm(RTERM,BASE)) -#define is_internal_ref_rel(RTERM,BASE) is_internal_ref(rterm2wterm(RTERM,BASE)) -#define is_external_rel(RTERM,BASE) is_external(rterm2wterm(RTERM,BASE)) -#define is_external_port_rel(RTERM,BASE) is_external_port(rterm2wterm(RTERM,BASE)) -#define is_external_ref_rel(RTERM,BASE) is_external_ref(rterm2wterm(RTERM,BASE)) - -#define external_node_rel(RTERM,BASE) external_node(rterm2wterm(RTERM,BASE)) - - -#if HALFWORD_HEAP -ERTS_GLB_INLINE int is_same(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base); +#if ET_DEBUG +#define ET_ASSERT(expr,file,line) \ +do { \ + if (!(expr)) \ + erl_assert_error("TYPE ASSERTION: " #expr, __FUNCTION__, file, line); \ +} while(0) +#else +#define ET_ASSERT(expr,file,line) do { } while(0) +#endif #if ERTS_GLB_INLINE_INCL_FUNC_DEF -ERTS_GLB_INLINE int is_same(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base) -{ - /* If bases differ, assume a and b are on different "heaps", - ie can only be same if immed */ - ASSERT(a_base == b_base || is_immed(a) || is_immed(b) - || rterm2wterm(a,a_base) != rterm2wterm(b,b_base)); - return a == b && (a_base == b_base || is_immed(a)); +#if ET_DEBUG +ERTS_GLB_INLINE unsigned tag_val_def(Wterm x, const char *file, unsigned line) +#else +ERTS_GLB_INLINE unsigned tag_val_def(Wterm x) +#define file __FILE__ +#define line __LINE__ +#endif +{ + static char *msg = "tag_val_def error"; + + switch (x & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_LIST: + ET_ASSERT(_list_precond(x),file,line); + return LIST_DEF; + case TAG_PRIMARY_BOXED: { + Eterm hdr = *boxed_val(x); + ET_ASSERT(is_header(hdr),file,line); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE): return TUPLE_DEF; + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): return BIG_DEF; + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): return BIG_DEF; + case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): return REF_DEF; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): return FLOAT_DEF; + case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE): return EXPORT_DEF; + case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE): return FUN_DEF; + 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_BIN_MATCHSTATE >> _TAG_PRIMARY_SIZE): return MATCHSTATE_DEF; + } + + break; + } + case TAG_PRIMARY_IMMED1: { + switch ((x & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_PID >> _TAG_PRIMARY_SIZE): return PID_DEF; + case (_TAG_IMMED1_PORT >> _TAG_PRIMARY_SIZE): return PORT_DEF; + case (_TAG_IMMED1_IMMED2 >> _TAG_PRIMARY_SIZE): { + switch ((x & _TAG_IMMED2_MASK) >> _TAG_IMMED1_SIZE) { + case (_TAG_IMMED2_ATOM >> _TAG_IMMED1_SIZE): return ATOM_DEF; + case (_TAG_IMMED2_NIL >> _TAG_IMMED1_SIZE): return NIL_DEF; + } + break; + } + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): return SMALL_DEF; + } + break; + } + } + erl_assert_error(msg, __FUNCTION__, file, line); +#undef file +#undef line } #endif -#else /* !HALFWORD_HEAP */ -#define is_same(A,A_BASE,B,B_BASE) ((A)==(B)) +#if ET_DEBUG +#define tag_val_def(X) tag_val_def(X, __FILE__, __LINE__) #endif #endif /* __ERL_TERM_H */ diff --git a/erts/emulator/beam/erl_thr_progress.c b/erts/emulator/beam/erl_thr_progress.c index 7b06fd840f..542541165b 100644 --- a/erts/emulator/beam/erl_thr_progress.c +++ b/erts/emulator/beam/erl_thr_progress.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011-2013. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_thr_progress.h b/erts/emulator/beam/erl_thr_progress.h index b89cc4c267..b2894ba1fe 100644 --- a/erts/emulator/beam/erl_thr_progress.h +++ b/erts/emulator/beam/erl_thr_progress.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011-2013. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_thr_queue.c b/erts/emulator/beam/erl_thr_queue.c index 7ff456b915..f56d0828dd 100644 --- a/erts/emulator/beam/erl_thr_queue.c +++ b/erts/emulator/beam/erl_thr_queue.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011-2013. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -780,3 +780,35 @@ erts_thr_q_dequeue(ErtsThrQ_t *q) return res; #endif } + +#ifdef USE_LTTNG_VM_TRACEPOINTS +int +erts_thr_q_length_dirty(ErtsThrQ_t *q) +{ + int n = 0; +#ifndef USE_THREADS + void *res; + ErtsThrQElement_t *tmp; + + for (tmp = q->first; tmp != NULL; tmp = tmp->next) { + n++; + } +#else + ErtsThrQElement_t *e; + erts_aint_t inext; + + e = ErtsThrQDirtyReadEl(&q->head.head); + inext = erts_atomic_read_acqb(&e->next); + + while (inext != ERTS_AINT_NULL) { + e = (ErtsThrQElement_t *) inext; + if (e != &q->tail.data.marker) { + /* don't count marker */ + n++; + } + inext = erts_atomic_read_acqb(&e->next); + } +#endif + return n; +} +#endif diff --git a/erts/emulator/beam/erl_thr_queue.h b/erts/emulator/beam/erl_thr_queue.h index 27a6d03224..705a67af4c 100644 --- a/erts/emulator/beam/erl_thr_queue.h +++ b/erts/emulator/beam/erl_thr_queue.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011-2013. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -190,6 +190,10 @@ void erts_thr_q_append_finalize_dequeue_data(ErtsThrQFinDeQ_t *, int erts_thr_q_finalize_dequeue(ErtsThrQFinDeQ_t *); void erts_thr_q_finalize_dequeue_state_init(ErtsThrQFinDeQ_t *); +#ifdef USE_LTTNG_VM_TRACEPOINTS +int erts_thr_q_length_dirty(ErtsThrQ_t *); +#endif + #ifdef ERTS_SMP ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_q_need_thr_progress(ErtsThrQ_t *q); #endif diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h index 34f91e2ec8..eccd49f2a9 100644 --- a/erts/emulator/beam/erl_threads.h +++ b/erts/emulator/beam/erl_threads.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -2056,6 +2056,8 @@ erts_atomic64_read_dirty(erts_atomic64_t *var) #endif /* !USE_THREADS */ +#include "erl_msacc.h" + #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE void @@ -2414,6 +2416,7 @@ erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx) { #ifdef USE_THREADS int res; + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_unlock(&mtx->lc); #endif @@ -2432,6 +2435,7 @@ erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx) #endif if (res != 0 && res != EINTR) erts_thr_fatal_error(res, "wait on condition variable"); + ERTS_MSACC_POP_STATE(); #endif } @@ -3488,7 +3492,11 @@ ERTS_GLB_INLINE void erts_tse_reset(erts_tse_t *ep) ERTS_GLB_INLINE int erts_tse_wait(erts_tse_t *ep) { #ifdef USE_THREADS - return ethr_event_wait(&((ethr_ts_event *) ep)->event); + int res; + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + res = ethr_event_wait(&((ethr_ts_event *) ep)->event); + ERTS_MSACC_POP_STATE(); + return res; #else return ENOTSUP; #endif @@ -3497,7 +3505,11 @@ ERTS_GLB_INLINE int erts_tse_wait(erts_tse_t *ep) ERTS_GLB_INLINE int erts_tse_swait(erts_tse_t *ep, int spincount) { #ifdef USE_THREADS - return ethr_event_swait(&((ethr_ts_event *) ep)->event, spincount); + int res; + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + res = ethr_event_swait(&((ethr_ts_event *) ep)->event, spincount); + ERTS_MSACC_POP_STATE(); + return res; #else return ENOTSUP; #endif @@ -3506,8 +3518,12 @@ ERTS_GLB_INLINE int erts_tse_swait(erts_tse_t *ep, int spincount) ERTS_GLB_INLINE int erts_tse_twait(erts_tse_t *ep, Sint64 tmo) { #ifdef USE_THREADS - return ethr_event_twait(&((ethr_ts_event *) ep)->event, - (ethr_sint64_t) tmo); + int res; + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + res = ethr_event_twait(&((ethr_ts_event *) ep)->event, + (ethr_sint64_t) tmo); + ERTS_MSACC_POP_STATE(); + return res; #else return ENOTSUP; #endif @@ -3516,9 +3532,13 @@ ERTS_GLB_INLINE int erts_tse_twait(erts_tse_t *ep, Sint64 tmo) ERTS_GLB_INLINE int erts_tse_stwait(erts_tse_t *ep, int spincount, Sint64 tmo) { #ifdef USE_THREADS - return ethr_event_stwait(&((ethr_ts_event *) ep)->event, - spincount, - (ethr_sint64_t) tmo); + int res; + ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP); + res = ethr_event_stwait(&((ethr_ts_event *) ep)->event, + spincount, + (ethr_sint64_t) tmo); + ERTS_MSACC_POP_STATE(); + return res; #else return ENOTSUP; #endif diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h index 93a0d556bf..a1c4220633 100644 --- a/erts/emulator/beam/erl_time.h +++ b/erts/emulator/beam/erl_time.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2011. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -142,6 +142,8 @@ erts_time_unit_conversion(Uint64 value, Uint32 from_time_unit, Uint32 to_time_unit); +ErtsSysPerfCounter erts_perf_counter_unit(void); + #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE Uint64 diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c index 99005356ed..346404fe2a 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-2015. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -1749,7 +1749,7 @@ erts_get_monotonic_time(ErtsSchedulerData *esdp) { ErtsMonotonicTime mtime = time_sup.r.o.get_time(); update_last_mtime(esdp, mtime); - return mtime; + return mtime; } ErtsMonotonicTime @@ -1957,15 +1957,16 @@ send_time_offset_changed_notifications(void *new_offsetp) 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; + ErtsMessage *mp; ErlOffHeap *ohp; Eterm message; - hp = erts_alloc_message_heap(hsz, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, + hsz, &hp, &ohp); *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_queue_message(rp, &rp_locks, mp, message); } erts_smp_proc_unlock(rp, rp_locks); } @@ -2434,9 +2435,19 @@ BIF_RETTYPE os_system_time_0(BIF_ALIST_0) BIF_RET(make_time_val(BIF_P, stime)); } -BIF_RETTYPE os_system_time_1(BIF_ALIST_0) +BIF_RETTYPE os_system_time_1(BIF_ALIST_1) { ErtsSystemTime stime = erts_os_system_time(); BIF_RET(time_unit_conversion(BIF_P, BIF_ARG_1, stime, 0)); } +BIF_RETTYPE +os_perf_counter_0(BIF_ALIST_0) +{ + BIF_RET(make_time_val(BIF_P, erts_sys_perf_counter())); +} + +BIF_RETTYPE erts_internal_perf_counter_unit_0(BIF_ALIST_0) +{ + BIF_RET(make_time_val(BIF_P, erts_sys_perf_counter_unit())); +} diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 114853cac4..128696270b 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2014. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -20,6 +20,19 @@ /* * Support functions for tracing. + * + * Ideas for future speed improvements in tracing framework: + * * Move ErtsTracerNif into ErtsTracer + * + Removes need for locking + * + Removes hash lookup overhead + * + Use a refc on the ErtsTracerNif to know when it can + * be freed. We don't want to allocate a separate + * ErtsTracerNif for each module used. + * * Optimize GenericBp for cache locality by reusing equivalent + * GenericBp and GenericBpData in multiple tracer points. + * + Possibly we want to use specialized instructions for different + * types of trace so that the knowledge of which struct is used + * can be in the instruction. */ #ifdef HAVE_CONFIG_H @@ -39,6 +52,7 @@ #include "erl_bits.h" #include "erl_thr_progress.h" #include "erl_bif_unique.h" +#include "erl_map.h" #if 0 #define DEBUG_PRINTOUTS @@ -46,17 +60,15 @@ #undef DEBUG_PRINTOUTS #endif -extern BeamInstr beam_return_to_trace[1]; /* OpCode(i_return_to_trace) */ -extern BeamInstr beam_return_trace[1]; /* OpCode(i_return_trace) */ -extern BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */ - /* Pseudo export entries. Never filled in with data, only used to yield unique pointers of the correct type. */ Export exp_send, exp_receive, exp_timeout; -static Eterm system_seq_tracer; -static Uint default_trace_flags; -static Eterm default_tracer; +static ErtsTracer system_seq_tracer; +static Uint default_proc_trace_flags; +static ErtsTracer default_proc_tracer; +static Uint default_port_trace_flags; +static ErtsTracer default_port_tracer; static Eterm system_monitor; static Eterm system_profile; @@ -70,8 +82,6 @@ static erts_smp_rwmtx_t sys_trace_rwmtx; enum ErtsSysMsgType { SYS_MSG_TYPE_UNDEFINED, - SYS_MSG_TYPE_TRACE, - SYS_MSG_TYPE_SEQTRACE, SYS_MSG_TYPE_SYSMON, SYS_MSG_TYPE_ERRLGR, SYS_MSG_TYPE_PROC_MSG, @@ -176,7 +186,7 @@ take_timestamp(ErtsTraceTimeStamp *tsp, int ts_type) hsz += 3; /* 2-tuple */ raw_unique = erts_raw_get_unique_monotonic_integer(); tsp->u.monotonic.raw_unique = raw_unique; - hsz += erts_raw_unique_monotonic_integer_heap_size(raw_unique); + hsz += erts_raw_unique_monotonic_integer_heap_size(raw_unique, 0); } return hsz; } @@ -216,8 +226,7 @@ write_timestamp(ErtsTraceTimeStamp *tsp, Eterm **hpp) return emtime; raw = tsp->u.monotonic.raw_unique; - unique = erts_raw_make_unique_monotonic_integer_value(hpp, - raw); + unique = erts_raw_make_unique_monotonic_integer_value(hpp, raw, 0); res = TUPLE2(*hpp, emtime, unique); *hpp += 3; return res; @@ -228,6 +237,7 @@ write_timestamp(ErtsTraceTimeStamp *tsp, Eterm **hpp) } } +#ifdef ERTS_SMP #define PATCH_TS_SIZE(p) patch_ts_size(TFLGS_TS_TYPE(p)) static ERTS_INLINE Uint @@ -248,6 +258,7 @@ patch_ts_size(int ts_type) return 0; } } +#endif /* * Write a timestamp. The timestamp MUST be the last @@ -299,43 +310,6 @@ write_ts(int ts_type, Eterm *hp, ErlHeapFragment *bp, Process *tracer) return res; } -/* - * Patch a timestamp into a tuple. The tuple MUST be the last thing - * built on the heap before the call, and the timestamp MUST be - * the last thing after the call. This since patch_ts() might adjust - * the size of the used area. - */ - -#define PATCH_TS__(Type, Tuple, Hp, Bp, Tracer) \ - do { \ - int ts_type__ = (Type); \ - if (ts_type__) \ - patch_ts(ts_type__, (Tuple), (Hp), (Bp), (Tracer)); \ - } while (0) - -#ifdef ERTS_SMP -#define PATCH_TS(Type, Tuple, Hp, Bp, Tracer) \ - PATCH_TS__((Type), (Tuple), (Hp), (Bp), NULL) -#else -#define PATCH_TS(Type, Tuple, Hp, Bp, Tracer) \ - PATCH_TS__((Type), (Tuple), (Hp), (Bp), (Tracer)) -#endif - -static ERTS_INLINE void -patch_ts(int ts_type, Eterm tuple, Eterm* hp, ErlHeapFragment *bp, Process *tracer) -{ - Eterm *tptr = tuple_val(tuple); - int arity = arityval(*tptr); - - ASSERT(ts_type); - ASSERT((tptr+arity+1) == hp); - - tptr[0] = make_arityval(arity+1); - tptr[1] = am_trace_ts; - - *hp = write_ts(ts_type, hp+1, bp, tracer); -} - #ifdef ERTS_SMP static void enqueue_sys_msg_unlocked(enum ErtsSysMsgType type, Eterm from, @@ -350,6 +324,14 @@ static void enqueue_sys_msg(enum ErtsSysMsgType type, static void init_sys_msg_dispatcher(void); #endif +static void init_tracer_nif(void); +static int tracer_cmp_fun(void*, void*); +static HashValue tracer_hash_fun(void*); +static void *tracer_alloc_fun(void*); +static void tracer_free_fun(void*); + +typedef struct ErtsTracerNif_ ErtsTracerNif; + void erts_init_trace(void) { erts_smp_rwmtx_opt_t rwmtx_opts = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER; rwmtx_opts.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ; @@ -363,81 +345,66 @@ void erts_init_trace(void) { erts_bif_trace_init(); erts_system_monitor_clear(NULL); erts_system_profile_clear(NULL); - default_trace_flags = F_INITIAL_TRACE_FLAGS; - default_tracer = NIL; - system_seq_tracer = am_false; + default_proc_trace_flags = F_INITIAL_TRACE_FLAGS; + default_proc_tracer = erts_tracer_nil; + default_port_trace_flags = F_INITIAL_TRACE_FLAGS; + default_port_tracer = erts_tracer_nil; + system_seq_tracer = erts_tracer_nil; #ifdef ERTS_SMP init_sys_msg_dispatcher(); #endif + init_tracer_nif(); } -static Eterm system_seq_tracer; - -#ifdef ERTS_SMP #define ERTS_ALLOC_SYSMSG_HEAP(SZ, BPP, OHPP, UNUSED) \ (*(BPP) = new_message_buffer((SZ)), \ *(OHPP) = &(*(BPP))->off_heap, \ (*(BPP))->mem) -#else -#define ERTS_ALLOC_SYSMSG_HEAP(SZ, BPP, OHPP, RPP) \ - erts_alloc_message_heap((SZ), (BPP), (OHPP), (RPP), 0) -#endif -#ifdef ERTS_SMP -#define ERTS_ENQ_TRACE_MSG(FPID, TPID, MSG, BP) \ -do { \ - ERTS_LC_ASSERT(erts_smp_lc_mtx_is_locked(&smq_mtx)); \ - enqueue_sys_msg_unlocked(SYS_MSG_TYPE_TRACE, (FPID), (TPID), (MSG), (BP)); \ -} while(0) -#else -#define ERTS_ENQ_TRACE_MSG(FPID, TPROC, MSG, BP) \ - erts_queue_message((TPROC), NULL, (BP), (MSG), NIL) -#endif +enum ErtsTracerOpt { + TRACE_FUN_DEFAULT = 0, + TRACE_FUN_ENABLED = 1, + TRACE_FUN_T_SEND = 2, + TRACE_FUN_T_RECEIVE = 3, + TRACE_FUN_T_CALL = 4, + TRACE_FUN_T_SCHED_PROC = 5, + TRACE_FUN_T_SCHED_PORT = 6, + TRACE_FUN_T_GC = 7, + TRACE_FUN_T_PROCS = 8, + TRACE_FUN_T_PORTS = 9, + TRACE_FUN_E_SEND = 10, + TRACE_FUN_E_RECEIVE = 11, + TRACE_FUN_E_CALL = 12, + TRACE_FUN_E_SCHED_PROC = 13, + TRACE_FUN_E_SCHED_PORT = 14, + TRACE_FUN_E_GC = 15, + TRACE_FUN_E_PROCS = 16, + TRACE_FUN_E_PORTS = 17 +}; -/* - * NOTE that the ERTS_GET_TRACER_REF() returns from the function (!!!) - * using it, and resets the parameters used if the tracer is invalid, i.e., - * use it with extreme care! - */ -#ifdef ERTS_SMP -#define ERTS_NULL_TRACER_REF NIL -#define ERTS_TRACER_REF_TYPE Eterm - /* In the smp case, we never find the tracer invalid here (the sys - message dispatcher thread takes care of that). */ -#define ERTS_GET_TRACER_REF(RES, TPID, TRACEE_FLGS) \ -do { (RES) = (TPID); } while(0) -int -erts_is_tracer_proc_valid(Process* p) -{ - return 1; -} -#else -#define ERTS_NULL_TRACER_REF NULL -#define ERTS_TRACER_REF_TYPE Process * -#define ERTS_GET_TRACER_REF(RES, TPID, TRACEE_FLGS) \ -do { \ - (RES) = erts_proc_lookup((TPID)); \ - if (!(RES) || !(ERTS_TRACE_FLAGS((RES)) & F_TRACER)) { \ - (TPID) = NIL; \ - (TRACEE_FLGS) &= ~TRACEE_FLAGS; \ - return; \ - } \ -} while (0) -int -erts_is_tracer_proc_valid(Process* p) -{ - Process* tracer; +#define NIF_TRACER_TYPES (18) - tracer = erts_proc_lookup(ERTS_TRACER_PROC(p)); - if (tracer && ERTS_TRACE_FLAGS(tracer) & F_TRACER) { - return 1; - } else { - ERTS_TRACER_PROC(p) = NIL; - ERTS_TRACE_FLAGS(p) = ~TRACEE_FLAGS; - return 0; - } -} -#endif + +static ERTS_INLINE int +send_to_tracer_nif_raw(Process *c_p, Process *tracee, const ErtsTracer tracer, + Uint trace_flags, Eterm t_p_id, ErtsTracerNif *tnif, + enum ErtsTracerOpt topt, + Eterm tag, Eterm msg, Eterm extra, Eterm pam_result); +static ERTS_INLINE int +send_to_tracer_nif(Process *c_p, ErtsPTabElementCommon *t_p, + Eterm t_p_id, ErtsTracerNif *tnif, + enum ErtsTracerOpt topt, + Eterm tag, Eterm msg, Eterm extra); +static ERTS_INLINE Eterm +call_enabled_tracer(Process *c_p, const ErtsTracer tracer, + ErtsTracerNif **tnif_ref, + enum ErtsTracerOpt topt, + Eterm tag, Eterm t_p_id); +static int +is_tracer_enabled(Process* c_p, ErtsProcLocks c_p_locks, + ErtsPTabElementCommon *t_p, + ErtsTracerNif **tnif_ret, + enum ErtsTracerOpt topt, Eterm tag); static Uint active_sched; @@ -452,19 +419,6 @@ static void exiting_reset(Eterm exiting) { erts_smp_rwmtx_rwlock(&sys_trace_rwmtx); - if (exiting == default_tracer) { - default_tracer = NIL; - default_trace_flags &= TRACEE_FLAGS; -#ifdef DEBUG - default_trace_flags |= F_INITIAL_TRACE_FLAGS; -#endif - } - if (exiting == system_seq_tracer) { -#ifdef DEBUG_PRINTOUTS - erts_fprintf(stderr, "seq tracer %T exited\n", exiting); -#endif - system_seq_tracer = am_false; - } if (exiting == system_monitor) { #ifdef ERTS_SMP system_monitor = NIL; @@ -489,11 +443,7 @@ erts_trace_check_exiting(Eterm exiting) { int reset = 0; erts_smp_rwmtx_rlock(&sys_trace_rwmtx); - if (exiting == default_tracer) - reset = 1; - else if (exiting == system_seq_tracer) - reset = 1; - else if (exiting == system_monitor) + if (exiting == system_monitor) reset = 1; else if (exiting == system_profile) reset = 1; @@ -502,23 +452,26 @@ erts_trace_check_exiting(Eterm exiting) exiting_reset(exiting); } -static ERTS_INLINE int -is_valid_tracer(Eterm tracer) -{ - return erts_proc_lookup(tracer) || erts_is_valid_tracer_port(tracer); -} - -Eterm -erts_set_system_seq_tracer(Process *c_p, ErtsProcLocks c_p_locks, Eterm new) +ErtsTracer +erts_set_system_seq_tracer(Process *c_p, ErtsProcLocks c_p_locks, ErtsTracer new) { - Eterm old; + ErtsTracer old; - if (new != am_false && !is_valid_tracer(new)) - return THE_NON_VALUE; + if (!ERTS_TRACER_IS_NIL(new)) { + Eterm nif_result = call_enabled_tracer( + NULL, new, NULL, + TRACE_FUN_ENABLED, am_trace_status, am_undefined); + switch (nif_result) { + case am_trace: break; + default: + return THE_NON_VALUE; + } + } erts_smp_rwmtx_rwlock(&sys_trace_rwmtx); old = system_seq_tracer; - system_seq_tracer = new; + system_seq_tracer = erts_tracer_nil; + erts_tracer_update(&system_seq_tracer, new); #ifdef DEBUG_PRINTOUTS erts_fprintf(stderr, "set seq tracer new=%T old=%T\n", new, old); @@ -527,66 +480,134 @@ erts_set_system_seq_tracer(Process *c_p, ErtsProcLocks c_p_locks, Eterm new) return old; } -Eterm +ErtsTracer erts_get_system_seq_tracer(void) { - Eterm st; + ErtsTracer st; erts_smp_rwmtx_rlock(&sys_trace_rwmtx); st = system_seq_tracer; #ifdef DEBUG_PRINTOUTS erts_fprintf(stderr, "get seq tracer %T\n", st); #endif erts_smp_rwmtx_runlock(&sys_trace_rwmtx); + + if (st != erts_tracer_nil && + call_enabled_tracer(NULL, st, NULL, TRACE_FUN_ENABLED, + am_trace_status, am_undefined) == am_remove) { + erts_set_system_seq_tracer(NULL, 0, erts_tracer_nil); + st = erts_tracer_nil; + } + return st; } static ERTS_INLINE void -get_default_tracing(Uint *flagsp, Eterm *tracerp) -{ - if (!(default_trace_flags & TRACEE_FLAGS)) - default_tracer = NIL; - - if (is_nil(default_tracer)) { - default_trace_flags &= ~TRACEE_FLAGS; - } else if (is_internal_pid(default_tracer)) { - if (!erts_proc_lookup(default_tracer)) { - reset_tracer: - default_trace_flags &= ~TRACEE_FLAGS; - default_tracer = NIL; - } +get_default_tracing(Uint *flagsp, ErtsTracer *tracerp, + Uint *default_trace_flags, + ErtsTracer *default_tracer) +{ + if (!(*default_trace_flags & TRACEE_FLAGS)) + ERTS_TRACER_CLEAR(default_tracer); + + if (ERTS_TRACER_IS_NIL(*default_tracer)) { + *default_trace_flags &= ~TRACEE_FLAGS; } else { - ASSERT(is_internal_port(default_tracer)); - if (!erts_is_valid_tracer_port(default_tracer)) - goto reset_tracer; + Eterm nif_res; + nif_res = call_enabled_tracer(NULL, *default_tracer, + NULL, TRACE_FUN_ENABLED, + am_trace_status, am_undefined); + switch (nif_res) { + case am_trace: break; + default: { + ErtsTracer curr_default_tracer = *default_tracer; + if (tracerp) { + /* we only have a rlock, so we have to unlock and then rwlock */ + erts_smp_rwmtx_runlock(&sys_trace_rwmtx); + erts_smp_rwmtx_rwlock(&sys_trace_rwmtx); + } + /* check if someone else changed default tracer + while we got the write lock, if so we don't do + anything. */ + if (curr_default_tracer == *default_tracer) { + *default_trace_flags &= ~TRACEE_FLAGS; + ERTS_TRACER_CLEAR(default_tracer); + } + if (tracerp) { + erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx); + erts_smp_rwmtx_rlock(&sys_trace_rwmtx); + } + } + } } if (flagsp) - *flagsp = default_trace_flags; - if (tracerp) - *tracerp = default_tracer; + *flagsp = *default_trace_flags; + if (tracerp) { + erts_tracer_update(tracerp,*default_tracer); + } +} + +static ERTS_INLINE void +erts_change_default_tracing(int setflags, Uint flags, + const ErtsTracer tracer, + Uint *default_trace_flags, + ErtsTracer *default_tracer) +{ + if (setflags) + *default_trace_flags |= flags; + else + *default_trace_flags &= ~flags; + + erts_tracer_update(default_tracer, tracer); + + get_default_tracing(NULL, NULL, default_trace_flags, default_tracer); } void -erts_change_default_tracing(int setflags, Uint *flagsp, Eterm *tracerp) +erts_change_default_proc_tracing(int setflags, Uint flagsp, + const ErtsTracer tracer) { erts_smp_rwmtx_rwlock(&sys_trace_rwmtx); - if (flagsp) { - if (setflags) - default_trace_flags |= *flagsp; - else - default_trace_flags &= ~(*flagsp); - } - if (tracerp) - default_tracer = *tracerp; - get_default_tracing(flagsp, tracerp); + erts_change_default_tracing( + setflags, flagsp, tracer, + &default_proc_trace_flags, + &default_proc_tracer); erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx); } void -erts_get_default_tracing(Uint *flagsp, Eterm *tracerp) +erts_change_default_port_tracing(int setflags, Uint flagsp, + const ErtsTracer tracer) +{ + erts_smp_rwmtx_rwlock(&sys_trace_rwmtx); + erts_change_default_tracing( + setflags, flagsp, tracer, + &default_port_trace_flags, + &default_port_tracer); + erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx); +} + +void +erts_get_default_proc_tracing(Uint *flagsp, ErtsTracer *tracerp) +{ + erts_smp_rwmtx_rlock(&sys_trace_rwmtx); + *tracerp = erts_tracer_nil; /* initialize */ + get_default_tracing( + flagsp, tracerp, + &default_proc_trace_flags, + &default_proc_tracer); + erts_smp_rwmtx_runlock(&sys_trace_rwmtx); +} + +void +erts_get_default_port_tracing(Uint *flagsp, ErtsTracer *tracerp) { erts_smp_rwmtx_rlock(&sys_trace_rwmtx); - get_default_tracing(flagsp, tracerp); + *tracerp = erts_tracer_nil; /* initialize */ + get_default_tracing( + flagsp, tracerp, + &default_port_trace_flags, + &default_port_tracer); erts_smp_rwmtx_runlock(&sys_trace_rwmtx); } @@ -624,29 +645,22 @@ erts_get_system_profile(void) { return profile; } -#ifdef ERTS_SMP -static void -do_send_to_port(Eterm to, - Port* unused_port, - Eterm from, - enum ErtsSysMsgType type, - Eterm message) -{ - Uint sz = size_object(message); - ErlHeapFragment *bp = new_message_buffer(sz); - Uint *hp = bp->mem; - Eterm msg = copy_struct(message, sz, &hp, &bp->off_heap); - - enqueue_sys_msg_unlocked(type, from, to, msg, bp); -} -#define WRITE_SYS_MSG_TO_PORT write_sys_msg_to_port +#ifdef HAVE_ERTS_NOW_CPU +# define GET_NOW(m, s, u) \ +do { \ + if (erts_cpu_timestamp) \ + erts_get_now_cpu(m, s, u); \ + else \ + get_now(m, s, u); \ +} while (0) #else -#define WRITE_SYS_MSG_TO_PORT do_send_to_port +# define GET_NOW(m, s, u) do {get_now(m, s, u);} while (0) #endif + static void -WRITE_SYS_MSG_TO_PORT(Eterm unused_to, +write_sys_msg_to_port(Eterm unused_to, Port* trace_port, Eterm unused_from, enum ErtsSysMsgType unused_type, @@ -673,150 +687,6 @@ WRITE_SYS_MSG_TO_PORT(Eterm unused_to, erts_free(ERTS_ALC_T_TMP, (void *) buffer); } - -#ifndef ERTS_SMP -/* Send {trace_ts, Pid, out, 0, Timestamp} - * followed by {trace_ts, Pid, in, 0, NewTimestamp} - * - * 'NewTimestamp' through patch_ts(). - */ -static void -do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp, int ts_type) { -#define LOCAL_HEAP_SIZE (5+5+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - Eterm message; - Eterm *hp; - Eterm mfarity; - - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - ASSERT(is_pid(pid)); - ASSERT(is_tuple(timestamp)); - ASSERT(*tuple_val(timestamp) == make_arityval(3)); - - hp = local_heap; - mfarity = make_small(0); - message = TUPLE5(hp, am_trace_ts, pid, am_out, mfarity, timestamp); - /* Note, hp is deliberately NOT incremented since it will be reused */ - - do_send_to_port(trace_port->common.id, - trace_port, - pid, - SYS_MSG_TYPE_UNDEFINED, - message); - - - message = TUPLE5(hp, am_trace_ts, pid, am_in, mfarity, - NIL /* Will be overwritten by timestamp */); - hp += 6; - hp[-1] = write_ts(ts_type, hp, NULL, NULL); - - do_send_to_port(trace_port->common.id, - trace_port, - pid, - SYS_MSG_TYPE_UNDEFINED, - message); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE -} -#endif - -/* If (c_p != NULL), a fake schedule out/in message pair will be sent, - * if the driver so requests. - * It is assumed that 'message' is not an 'out' message. - * - * 'c_p' is the currently executing process, "tracee" is the traced process - * which 'message' concerns => if (*tracee_flags & F_TIMESTAMP_MASK), - * 'message' must contain a timestamp. - */ -static void -send_to_port(Process *c_p, Eterm message, - Eterm *tracer_pid, Uint *tracee_flags) { - Port* trace_port; -#ifndef ERTS_SMP - int ts_type; -#define LOCAL_HEAP_SIZE ERTS_TRACE_PATCH_TS_MAX_SIZE - Eterm ts; - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); -#endif - - ASSERT(is_internal_port(*tracer_pid)); -#ifdef ERTS_SMP - if (is_not_internal_port(*tracer_pid)) - return; - - trace_port = NULL; -#else - - trace_port = erts_id2port_sflgs(*tracer_pid, - NULL, - 0, - ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP); - - if (!trace_port) { - *tracee_flags &= ~TRACEE_FLAGS; - *tracer_pid = NIL; - return; - } - - /* - * Make a fake schedule only if the current process is traced - * with 'running' and 'timestamp'. - */ - - if ( c_p == NULL || - (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP_MASK))) { -#endif - do_send_to_port(*tracer_pid, - trace_port, - c_p ? c_p->common.id : NIL, - SYS_MSG_TYPE_TRACE, - message); -#ifndef ERTS_SMP - erts_port_release(trace_port); - return; - } - - /* - * Note that the process being traced for some type of trace messages - * (e.g. getting_linked) need not be the current process. That other - * process might not have timestamps enabled. - */ - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - /* A fake schedule might be needed. - * Create a dummy trace message with timestamp to be - * passed to do_send_schedfix_to_port(). - */ - ts_type = TFLGS_TS_TYPE(c_p); - ts = write_ts(ts_type, local_heap, NULL, NULL); - - trace_port->control_flags &= ~PORT_CONTROL_FLAG_HEAVY; - do_send_to_port(*tracer_pid, - trace_port, - c_p ? c_p->common.id : NIL, - SYS_MSG_TYPE_TRACE, - message); - - if (trace_port->control_flags & PORT_CONTROL_FLAG_HEAVY) { - /* The driver has just informed us that the last write took a - * non-neglectible amount of time. - * - * We need to fake some trace messages to compensate for the time the - * current process had to sacrifice for the writing of the previous - * trace message. We pretend that the process got scheduled out - * just after writning the real trace message, and now gets scheduled - * in again. - */ - do_send_schedfix_to_port(trace_port, c_p->common.id, ts, ts_type); - } - - erts_port_release(trace_port); - - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE -#endif -} - #ifndef ERTS_SMP /* Profile send * Checks if profiler is port or process @@ -826,11 +696,9 @@ send_to_port(Process *c_p, Eterm message, static void profile_send(Eterm from, Eterm message) { Uint sz = 0; - ErlHeapFragment *bp = NULL; Uint *hp = NULL; Eterm msg = NIL; Process *profile_p = NULL; - ErlOffHeap *off_heap = NULL; Eterm profiler = erts_get_system_profile(); @@ -847,15 +715,16 @@ profile_send(Eterm from, Eterm message) { 0, ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP); if (profiler_port) { - do_send_to_port(profiler, - profiler_port, - NIL, /* or current process->common.id */ - SYS_MSG_TYPE_SYSPROF, - message); + write_sys_msg_to_port(profiler, + profiler_port, + NIL, /* or current process->common.id */ + SYS_MSG_TYPE_SYSPROF, + message); erts_port_release(profiler_port); } } else { + ErtsMessage *mp; ASSERT(is_internal_pid(profiler)); profile_p = erts_proc_lookup(profiler); @@ -864,157 +733,32 @@ profile_send(Eterm from, Eterm message) { return; sz = size_object(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); - } -} - -#endif - - -/* A fake schedule out/in message pair will be sent, - * if the driver so requests. - * - * 'c_p' is the currently executing process, may be NULL. - */ -static void -seq_trace_send_to_port(Process *c_p, - Eterm seq_tracer, - Eterm message) -{ - Port* trace_port; -#ifndef ERTS_SMP - int ts_type; - Eterm ts; -#define LOCAL_HEAP_SIZE ERTS_TRACE_PATCH_TS_MAX_SIZE - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#endif - - ASSERT(is_internal_port(seq_tracer)); -#ifdef ERTS_SMP - if (is_not_internal_port(seq_tracer)) - return; - - trace_port = NULL; -#else - trace_port = erts_id2port_sflgs(seq_tracer, - NULL, - 0, - ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP); - if (!trace_port) { - system_seq_tracer = am_false; -#ifndef ERTS_SMP - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#endif - return; - } - - if (c_p == NULL - || (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP_MASK))) { -#endif - do_send_to_port(seq_tracer, - trace_port, - c_p ? c_p->common.id : NIL, - SYS_MSG_TYPE_SEQTRACE, - message); - -#ifndef ERTS_SMP - erts_port_release(trace_port); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); - return; - } - /* Make a fake schedule only if the current process is traced - * with 'running' and 'timestamp'. - */ + mp = erts_alloc_message(sz, &hp); + if (sz == 0) + msg = message; + else + msg = copy_struct(message, sz, &hp, &mp->hfrag.off_heap); - /* A fake schedule might be needed. - * Create a dummy trace message with timestamp to be - * passed to do_send_schedfix_to_port(). - */ - ts_type = TFLGS_TS_TYPE(c_p); - ts = write_ts(ts_type, local_heap, NULL, NULL); - - trace_port->control_flags &= ~PORT_CONTROL_FLAG_HEAVY; - do_send_to_port(seq_tracer, - trace_port, - c_p ? c_p->common.id : NIL, - SYS_MSG_TYPE_SEQTRACE, - message); - - if (trace_port->control_flags & PORT_CONTROL_FLAG_HEAVY) { - /* The driver has just informed us that the last write took a - * non-neglectible amount of time. - * - * We need to fake some trace messages to compensate for the time the - * current process had to sacrifice for the writing of the previous - * trace message. We pretend that the process got scheduled out - * just after writing the real trace message, and now gets scheduled - * in again. - */ - do_send_schedfix_to_port(trace_port, c_p->common.id, ts, ts_type); + erts_queue_message(profile_p, NULL, mp, msg); } - - erts_port_release(trace_port); - - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE -#endif } -static ERTS_INLINE void -send_to_tracer(Process *tracee, - ERTS_TRACER_REF_TYPE tracer_ref, - Eterm msg, - Eterm **hpp, - ErlHeapFragment *bp, - int no_fake_sched) -{ - ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(tracee)); - - erts_smp_mtx_lock(&smq_mtx); - - if (is_internal_pid(ERTS_TRACER_PROC(tracee))) { - PATCH_TS(TFLGS_TS_TYPE(tracee), msg, *hpp, bp, tracer_ref); - ERTS_ENQ_TRACE_MSG(tracee->common.id, tracer_ref, msg, bp); - } - else { - ASSERT(is_internal_port(ERTS_TRACER_PROC(tracee))); - PATCH_TS(TFLGS_TS_TYPE(tracee), msg, *hpp, NULL, NULL); - send_to_port(no_fake_sched ? NULL : tracee, - msg, - &ERTS_TRACER_PROC(tracee), - &ERTS_TRACE_FLAGS(tracee)); - } - - erts_smp_mtx_unlock(&smq_mtx); - -} +#endif static void -trace_sched_aux(Process *p, Eterm what, int never_fake_sched) +trace_sched_aux(Process *p, ErtsProcLocks locks, Eterm what) { -#define LOCAL_HEAP_SIZE (5+4+1+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p); - Eterm tmp, mess, *hp; - ErlHeapFragment *bp = NULL; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref = ERTS_NULL_TRACER_REF; - int sched_no, curr_func, to_port, no_fake_sched; + Eterm tmp, *hp; + int curr_func; + ErtsTracerNif *tnif = NULL; - if (is_nil(ERTS_TRACER_PROC(p))) + if (ERTS_TRACER_IS_NIL(ERTS_TRACER(p))) return; - no_fake_sched = never_fake_sched; - switch (what) { case am_out: case am_out_exiting: case am_out_exited: - no_fake_sched = 1; - break; case am_in: case am_in_exiting: break; @@ -1023,16 +767,8 @@ trace_sched_aux(Process *p, Eterm what, int never_fake_sched) break; } - sched_no = IS_TRACED_FL(p, F_TRACE_SCHED_NO); - to_port = is_internal_port(ERTS_TRACER_PROC(p)); - - if (!to_port) { - ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(p), - ERTS_TRACE_FLAGS(p)); - } + if (!is_tracer_enabled(p, locks, &p->common, &tnif, TRACE_FUN_E_SCHED_PROC, what)) + return; if (ERTS_PROC_IS_EXITING(p)) curr_func = 0; @@ -1042,44 +778,16 @@ trace_sched_aux(Process *p, Eterm what, int never_fake_sched) curr_func = p->current != NULL; } - UseTmpHeap(LOCAL_HEAP_SIZE,p); - - if (to_port) - hp = local_heap; - else { - Uint size = 5; - if (curr_func) - size += 4; - if (sched_no) - size += 1; - size += PATCH_TS_SIZE(p); - hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); - } - if (!curr_func) { tmp = make_small(0); } else { + hp = HAlloc(p, 4); tmp = TUPLE3(hp,p->current[0],p->current[1],make_small(p->current[2])); hp += 4; } - if (!sched_no) { - mess = TUPLE4(hp, am_trace, p->common.id, what, tmp); - hp += 5; - } - else { -#ifdef ERTS_SMP - Eterm sched_id = make_small(p->scheduler_data->no); -#else - Eterm sched_id = make_small(1); -#endif - mess = TUPLE5(hp, am_trace, p->common.id, what, sched_id, tmp); - hp += 6; - } - - send_to_tracer(p, tracer_ref, mess, &hp, bp, no_fake_sched); - UnUseTmpHeap(LOCAL_HEAP_SIZE,p); -#undef LOCAL_HEAP_SIZE + send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_SCHED_PROC, + what, tmp, THE_NON_VALUE); } /* Send {trace_ts, Pid, What, {Mod, Func, Arity}, Timestamp} @@ -1089,9 +797,9 @@ trace_sched_aux(Process *p, Eterm what, int never_fake_sched) * 'out_exiting', or 'out_exited'. */ void -trace_sched(Process *p, Eterm what) +trace_sched(Process *p, ErtsProcLocks locks, Eterm what) { - trace_sched_aux(p, what, 0); + trace_sched_aux(p, locks, what); } /* Send {trace_ts, Pid, Send, Msg, DestPid, Timestamp} @@ -1102,140 +810,51 @@ trace_sched(Process *p, Eterm what) void trace_send(Process *p, Eterm to, Eterm msg) { - Eterm operation; - unsigned sz_msg; - unsigned sz_to; - Eterm* hp; - Eterm mess; - - if (!ARE_TRACE_FLAGS_ON(p, F_TRACE_SEND)) { - return; - } + Eterm operation = am_send; + ErtsTracerNif *tnif = NULL; + + ASSERT(ARE_TRACE_FLAGS_ON(p, F_TRACE_SEND)); - operation = am_send; if (is_internal_pid(to)) { if (!erts_proc_lookup(to)) goto send_to_non_existing_process; } else if(is_external_pid(to) && external_pid_dist_entry(to) == erts_this_dist_entry) { - char *s; send_to_non_existing_process: - s = "send_to_non_existing_process"; - operation = am_atom_put(s, sys_strlen(s)); + operation = am_send_to_non_existing_process; } - if (is_internal_port(ERTS_TRACER_PROC(p))) { -#define LOCAL_HEAP_SIZE (6 + ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; - mess = TUPLE5(hp, am_trace, p->common.id, operation, msg, to); - hp += 6; - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL); - send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - Uint need; - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - - ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(p), - ERTS_TRACE_FLAGS(p)); - - sz_msg = size_object(msg); - sz_to = size_object(to); - need = sz_msg + sz_to + 6 + PATCH_TS_SIZE(p); - - hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref); - - to = copy_struct(to, - sz_to, - &hp, - off_heap); - msg = copy_struct(msg, - sz_msg, - &hp, - off_heap); - mess = TUPLE5(hp, am_trace, p->common.id, operation, msg, to); - hp += 6; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref); - ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - } + if (is_tracer_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif, + TRACE_FUN_E_SEND, operation)) + send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_SEND, + operation, msg, to); } /* Send {trace_ts, Pid, receive, Msg, Timestamp} * or {trace, Pid, receive, Msg} */ void -trace_receive(Process *rp, Eterm msg) +trace_receive(Process *c_p, Eterm msg) { - Eterm mess; - size_t sz_msg; - Eterm* hp; - - if (is_internal_port(ERTS_TRACER_PROC(rp))) { -#define LOCAL_HEAP_SIZE (5+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; - mess = TUPLE4(hp, am_trace, rp->common.id, am_receive, msg); - hp += 5; - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(TFLGS_TS_TYPE(rp), mess, hp, NULL, NULL); - send_to_port(rp, mess, &ERTS_TRACER_PROC(rp), &ERTS_TRACE_FLAGS(rp)); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - Uint hsz; - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - - ASSERT(is_internal_pid(ERTS_TRACER_PROC(rp))); - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(rp), - ERTS_TRACE_FLAGS(rp)); - - sz_msg = size_object(msg); - - hsz = sz_msg + 5 + PATCH_TS_SIZE(rp); - - hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, tracer_ref); - - msg = copy_struct(msg, sz_msg, &hp, off_heap); - mess = TUPLE4(hp, am_trace, rp->common.id, am_receive, msg); - hp += 5; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(rp), mess, hp, bp, tracer_ref); - ERTS_ENQ_TRACE_MSG(rp->common.id, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - } + ErtsTracerNif *tnif = NULL; + if (is_tracer_enabled(NULL, 0, &c_p->common, &tnif, + TRACE_FUN_E_RECEIVE, am_receive)) + send_to_tracer_nif(NULL, &c_p->common, c_p->common.id, + tnif, TRACE_FUN_T_RECEIVE, + am_receive, msg, THE_NON_VALUE); } int seq_trace_update_send(Process *p) { - Eterm seq_tracer = erts_get_system_seq_tracer(); + ErtsTracer seq_tracer = erts_get_system_seq_tracer(); ASSERT((is_tuple(SEQ_TRACE_TOKEN(p)) || is_nil(SEQ_TRACE_TOKEN(p)))); - if ( (p->common.id == seq_tracer) || (SEQ_TRACE_TOKEN(p) == NIL) + if (have_no_seqtrace(SEQ_TRACE_TOKEN(p)) || + (seq_tracer != NIL && + call_enabled_tracer(NULL, seq_tracer, NULL, + TRACE_FUN_ENABLED, am_trace_status, + p ? p->common.id : am_undefined) != am_trace) #ifdef USE_VM_PROBES || (SEQ_TRACE_TOKEN(p) == am_have_dt_utag) #endif @@ -1267,20 +886,29 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, Eterm receiver, Process *process, Eterm exitfrom) { Eterm mess; - ErlHeapFragment* bp; Eterm* hp; Eterm label; Eterm lastcnt_serial; Eterm type_atom; - int sz_exit; - Eterm seq_tracer; - int ts_type; + ErtsTracer seq_tracer; + int seq_tracer_flags = 0; +#define LOCAL_HEAP_SIZE (64) + DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); seq_tracer = erts_get_system_seq_tracer(); ASSERT(is_tuple(token) || is_nil(token)); - if (SEQ_TRACE_T_SENDER(token) == seq_tracer || token == NIL || - (process && ERTS_TRACE_FLAGS(process) & F_SENSITIVE)) { + if (token == NIL || (process && ERTS_TRACE_FLAGS(process) & F_SENSITIVE) || + ERTS_TRACER_IS_NIL(seq_tracer) || + call_enabled_tracer(NULL, seq_tracer, + NULL, TRACE_FUN_ENABLED, + am_trace_status, + process ? process->common.id : am_undefined) != am_trace) { + return; + } + + if ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & type) == 0) { + /* No flags set, nothing to do */ return; } @@ -1293,147 +921,28 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, return; /* To avoid warning */ } - if ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & type) == 0) { - /* No flags set, nothing to do */ - return; - } + UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - if (seq_tracer == am_false) { - return; /* no need to send anything */ + hp = local_heap; + label = SEQ_TRACE_T_LABEL(token); + lastcnt_serial = TUPLE2(hp, SEQ_TRACE_T_LASTCNT(token), + SEQ_TRACE_T_SERIAL(token)); + hp += 3; + if (exitfrom != NIL) { + msg = TUPLE3(hp, am_EXIT, exitfrom, msg); + hp += 4; } + mess = TUPLE5(hp, type_atom, lastcnt_serial, SEQ_TRACE_T_SENDER(token), receiver, msg); + hp += 6; - ts_type = ERTS_SEQTFLGS2TSTYPE(unsigned_val(SEQ_TRACE_T_FLAGS(token))); - - if (is_internal_port(seq_tracer)) { -#define LOCAL_HEAP_SIZE (60 + ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); + seq_tracer_flags |= ERTS_SEQTFLGS2TFLGS(unsigned_val(SEQ_TRACE_T_FLAGS(token))); - hp = local_heap; - label = SEQ_TRACE_T_LABEL(token); - lastcnt_serial = TUPLE2(hp, SEQ_TRACE_T_LASTCNT(token), - SEQ_TRACE_T_SERIAL(token)); - hp += 3; - if (exitfrom != NIL) { - msg = TUPLE3(hp, am_EXIT, exitfrom, msg); - hp += 4; - } - mess = TUPLE5(hp, type_atom, lastcnt_serial, SEQ_TRACE_T_SENDER(token), - receiver, msg); - hp += 6; + send_to_tracer_nif_raw(NULL, process, seq_tracer, seq_tracer_flags, + label, NULL, TRACE_FUN_DEFAULT, am_seq_trace, mess, + THE_NON_VALUE, am_true); - erts_smp_mtx_lock(&smq_mtx); - if (!ts_type) { - mess = TUPLE3(hp, am_seq_trace, label, mess); - seq_trace_send_to_port(NULL, seq_tracer, mess); - } else { - mess = TUPLE4(hp, am_seq_trace, label, mess, - NIL /* Will be overwritten by timestamp */); - hp += 5; - hp[-1] = write_ts(ts_type, hp, NULL, NULL); - seq_trace_send_to_port(process, seq_tracer, mess); - } - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); + UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); #undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { -#ifndef ERTS_SMP - Process* tracer; -#endif - Eterm sender_copy; - Eterm receiver_copy; - Eterm m2; - Uint sz_label, sz_lastcnt_serial, sz_msg, sz_ts, sz_sender, - sz_exitfrom, sz_receiver; - - ASSERT(is_internal_pid(seq_tracer)); - -#ifndef ERTS_SMP - - tracer = erts_proc_lookup(seq_tracer); - if (!tracer) { - system_seq_tracer = am_false; - return; /* no need to send anything */ - } -#endif - if (receiver == seq_tracer) { - return; /* no need to send anything */ - } - - sz_label = size_object(SEQ_TRACE_T_LABEL(token)); - sz_sender = size_object(SEQ_TRACE_T_SENDER(token)); - sz_receiver = size_object(receiver); - sz_lastcnt_serial = 3; /* TUPLE2 */ - sz_msg = size_object(msg); - - sz_ts = patch_ts_size(ts_type); - if (exitfrom != NIL) { - sz_exit = 4; /* create {'EXIT',exitfrom,msg} */ - sz_exitfrom = size_object(exitfrom); - } - else { - sz_exit = 0; - sz_exitfrom = 0; - } - bp = new_message_buffer(4 /* TUPLE3 */ + sz_ts + 6 /* TUPLE5 */ - + sz_lastcnt_serial + sz_label + sz_msg - + sz_exit + sz_exitfrom - + sz_sender + sz_receiver); - hp = bp->mem; - label = copy_struct(SEQ_TRACE_T_LABEL(token), sz_label, &hp, &bp->off_heap); - lastcnt_serial = TUPLE2(hp,SEQ_TRACE_T_LASTCNT(token),SEQ_TRACE_T_SERIAL(token)); - hp += 3; - m2 = copy_struct(msg, sz_msg, &hp, &bp->off_heap); - if (sz_exit) { - Eterm exitfrom_copy = copy_struct(exitfrom, - sz_exitfrom, - &hp, - &bp->off_heap); - m2 = TUPLE3(hp, am_EXIT, exitfrom_copy, m2); - hp += 4; - } - sender_copy = copy_struct(SEQ_TRACE_T_SENDER(token), - sz_sender, - &hp, - &bp->off_heap); - receiver_copy = copy_struct(receiver, - sz_receiver, - &hp, - &bp->off_heap); - mess = TUPLE5(hp, - type_atom, - lastcnt_serial, - sender_copy, - receiver_copy, - m2); - hp += 6; - - erts_smp_mtx_lock(&smq_mtx); - - if (!ts_type) - mess = TUPLE3(hp, am_seq_trace, label, mess); - else { - mess = TUPLE4(hp, am_seq_trace, label, mess, - NIL /* Will be overwritten by timestamp */); - hp += 5; - /* Write timestamp in element 6 of the 'msg' tuple */ - hp[-1] = write_ts(ts_type, hp, bp, -#ifndef ERTS_SMP - tracer -#else - NULL -#endif - ); - } - -#ifdef ERTS_SMP - enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SEQTRACE, NIL, NIL, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); -#else - /* trace_token must be NIL here */ - erts_queue_message(tracer, NULL, bp, mess, NIL); -#endif - } } /* Send {trace_ts, Pid, return_to, {Mod, Func, Arity}, Timestamp} @@ -1442,63 +951,20 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, void erts_trace_return_to(Process *p, BeamInstr *pc) { -#define LOCAL_HEAP_SIZE (4+5+ERTS_TRACE_PATCH_TS_MAX_SIZE) - Eterm* hp; Eterm mfa; - Eterm mess; - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); BeamInstr *code_ptr = find_function_from_pc(pc); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; - if (!code_ptr) { mfa = am_undefined; } else { + Eterm *hp = HAlloc(p, 4); mfa = TUPLE3(hp, code_ptr[0], code_ptr[1], make_small(code_ptr[2])); - hp += 4; } - - mess = TUPLE4(hp, am_trace, p->common.id, am_return_to, mfa); - hp += 5; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL); - - if (is_internal_port(ERTS_TRACER_PROC(p))) { - send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); - } else { - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - unsigned size; - /* - * Find the tracer. - */ - ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(p), - ERTS_TRACE_FLAGS(p)); - - size = size_object(mess); - - hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); - - /* - * Copy the trace message into the buffer and enqueue it. - */ - mess = copy_struct(mess, size, &hp, off_heap); - ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp); - } - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); + send_to_tracer_nif(p, &p->common, p->common.id, NULL, TRACE_FUN_T_CALL, + am_return_to, mfa, THE_NON_VALUE); } @@ -1506,114 +972,53 @@ erts_trace_return_to(Process *p, BeamInstr *pc) * or {trace, Pid, return_from, {Mod, Name, Arity}, Retval} */ void -erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid) +erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, ErtsTracer *tracer) { Eterm* hp; - Eterm mfa; - Eterm mess; - Eterm mod, name; + Eterm mfa, mod, name; int arity; Uint meta_flags, *tracee_flags; - int ts_type; -#ifdef ERTS_SMP - Eterm tracee; -#endif - - ASSERT(tracer_pid); - if (*tracer_pid == am_true) { + + ASSERT(tracer); + if (ERTS_TRACER_COMPARE(*tracer, erts_tracer_true)) { /* Breakpoint trace enabled without specifying tracer => * use process tracer and flags */ - tracer_pid = &ERTS_TRACER_PROC(p); + tracer = &ERTS_TRACER(p); } - if (is_nil(*tracer_pid)) { + if (ERTS_TRACER_IS_NIL(*tracer)) { /* Trace disabled */ return; } - ASSERT(is_internal_pid(*tracer_pid) || is_internal_port(*tracer_pid)); - if (*tracer_pid == p->common.id) { - /* Do not generate trace messages to oneself */ - return; - } - if (tracer_pid == &ERTS_TRACER_PROC(p)) { + ASSERT(IS_TRACER_VALID(*tracer)); + if (tracer == &ERTS_TRACER(p)) { /* Tracer specified in process structure => * non-breakpoint trace => * use process flags */ tracee_flags = &ERTS_TRACE_FLAGS(p); -#ifdef ERTS_SMP - tracee = p->common.id; -#endif + if (! (*tracee_flags & F_TRACE_CALLS)) { + return; + } } else { /* Tracer not specified in process structure => * tracer specified in breakpoint => * meta trace => * use fixed flag set instead of process flags - */ + */ meta_flags = F_TRACE_CALLS | F_NOW_TS; tracee_flags = &meta_flags; -#ifdef ERTS_SMP - tracee = NIL; -#endif - } - if (! (*tracee_flags & F_TRACE_CALLS)) { - return; } - + mod = fi[0]; name = fi[1]; arity = fi[2]; - - ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags); - - if (is_internal_port(*tracer_pid)) { -#define LOCAL_HEAP_SIZE (4+6+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - hp = local_heap; - mfa = TUPLE3(hp, mod, name, make_small(arity)); - hp += 4; - mess = TUPLE5(hp, am_trace, p->common.id, am_return_from, mfa, retval); - hp += 6; - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(ts_type, mess, hp, NULL, NULL); - send_to_port(p, mess, tracer_pid, tracee_flags); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - unsigned size; - unsigned retval_size; - - ASSERT(is_internal_pid(*tracer_pid)); - - ERTS_GET_TRACER_REF(tracer_ref, *tracer_pid, *tracee_flags); - - retval_size = size_object(retval); - size = 6 + 4 + retval_size + patch_ts_size(ts_type); - - hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); - - /* - * Build the trace tuple and put it into receive queue of the tracer process. - */ - - mfa = TUPLE3(hp, mod, name, make_small(arity)); - hp += 4; - retval = copy_struct(retval, retval_size, &hp, off_heap); - mess = TUPLE5(hp, am_trace, p->common.id, am_return_from, mfa, retval); - hp += 6; - - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(ts_type, mess, hp, bp, tracer_ref); - - ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - } + hp = HAlloc(p, 4); + mfa = TUPLE3(hp, mod, name, make_small(arity)); + hp += 4; + send_to_tracer_nif_raw(p, NULL, *tracer, *tracee_flags, p->common.id, + NULL, TRACE_FUN_T_CALL, am_return_from, mfa, retval, am_true); } /* Send {trace_ts, Pid, exception_from, {Mod, Name, Arity}, {Class,Value}, @@ -1625,116 +1030,50 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid) */ void erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value, - Eterm *tracer_pid) + ErtsTracer *tracer) { Eterm* hp; - Eterm mfa_tuple; - Eterm cv; - Eterm mess; + Eterm mfa_tuple, cv; Uint meta_flags, *tracee_flags; - int ts_type; -#ifdef ERTS_SMP - Eterm tracee; -#endif - - ASSERT(tracer_pid); - if (*tracer_pid == am_true) { + + ASSERT(tracer); + if (ERTS_TRACER_COMPARE(*tracer, erts_tracer_true)) { /* Breakpoint trace enabled without specifying tracer => * use process tracer and flags */ - tracer_pid = &ERTS_TRACER_PROC(p); + tracer = &ERTS_TRACER(p); } - if (is_nil(*tracer_pid)) { + if (ERTS_TRACER_IS_NIL(*tracer)) { /* Trace disabled */ return; } - ASSERT(is_internal_pid(*tracer_pid) || is_internal_port(*tracer_pid)); - if (*tracer_pid == p->common.id) { - /* Do not generate trace messages to oneself */ - return; - } - if (tracer_pid == &ERTS_TRACER_PROC(p)) { + ASSERT(IS_TRACER_VALID(*tracer)); + if (tracer == &ERTS_TRACER(p)) { /* Tracer specified in process structure => * non-breakpoint trace => * use process flags */ tracee_flags = &ERTS_TRACE_FLAGS(p); -#ifdef ERTS_SMP - tracee = p->common.id; -#endif - if (! (*tracee_flags & F_TRACE_CALLS)) { - return; - } + if (! (*tracee_flags & F_TRACE_CALLS)) { + return; + } } else { /* Tracer not specified in process structure => * tracer specified in breakpoint => * meta trace => * use fixed flag set instead of process flags - */ + */ meta_flags = F_TRACE_CALLS | F_NOW_TS; tracee_flags = &meta_flags; -#ifdef ERTS_SMP - tracee = NIL; -#endif } - - ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags); - - if (is_internal_port(*tracer_pid)) { -#define LOCAL_HEAP_SIZE (4+3+6+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; - mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], make_small((Eterm)mfa[2])); - hp += 4; - cv = TUPLE2(hp, class, value); - hp += 3; - mess = TUPLE5(hp, am_trace, p->common.id, am_exception_from, mfa_tuple, cv); - hp += 6; - ASSERT((hp - local_heap) <= LOCAL_HEAP_SIZE); - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(ts_type, mess, hp, NULL, NULL); - send_to_port(p, mess, tracer_pid, tracee_flags); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - unsigned size; - unsigned value_size; - - ASSERT(is_internal_pid(*tracer_pid)); - - ERTS_GET_TRACER_REF(tracer_ref, *tracer_pid, *tracee_flags); - - value_size = size_object(value); - size = 6 + 4 + 3 + value_size + patch_ts_size(ts_type); - - hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); - - /* - * Build the trace tuple and put it into receive queue of the tracer process. - */ - - mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], make_small((Eterm) mfa[2])); - hp += 4; - value = copy_struct(value, value_size, &hp, off_heap); - cv = TUPLE2(hp, class, value); - hp += 3; - mess = TUPLE5(hp, am_trace, p->common.id, - am_exception_from, mfa_tuple, cv); - hp += 6; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(ts_type, mess, hp, bp, tracer_ref); - ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - } + hp = HAlloc(p, 7);; + mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], make_small((Eterm)mfa[2])); + hp += 4; + cv = TUPLE2(hp, class, value); + hp += 3; + send_to_tracer_nif_raw(p, NULL, *tracer, *tracee_flags, p->common.id, + NULL, TRACE_FUN_T_CALL, am_exception_from, mfa_tuple, cv, am_true); } /* @@ -1753,7 +1092,7 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value, */ Uint32 erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, - Eterm* args, int local, Eterm *tracer_pid) + Eterm* args, int local, ErtsTracer *tracer) { Eterm* hp; Eterm mfa_tuple; @@ -1761,55 +1100,53 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, int i; Uint32 return_flags; Eterm pam_result = am_true; - Eterm mess; Uint meta_flags, *tracee_flags; - int ts_type; -#ifdef ERTS_SMP - Eterm tracee; -#endif + ErtsTracerNif *tnif = NULL; Eterm transformed_args[MAX_ARG]; - DeclareTypedTmpHeap(ErlSubBin,sub_bin_heap,p); + ErtsTracer pre_ms_tracer = erts_tracer_nil; - ASSERT(tracer_pid); - if (*tracer_pid == am_true) { - /* Breakpoint trace enabled without specifying tracer => + ASSERT(tracer); + if (ERTS_TRACER_COMPARE(*tracer, erts_tracer_true)) { + /* Breakpoint trace enabled without specifying tracer => * use process tracer and flags */ - tracer_pid = &ERTS_TRACER_PROC(p); - } - if (is_nil(*tracer_pid)) { - /* Trace disabled */ - return 0; + tracer = &ERTS_TRACER(p); } - ASSERT(is_internal_pid(*tracer_pid) || is_internal_port(*tracer_pid)); - if (*tracer_pid == p->common.id) { - /* Do not generate trace messages to oneself */ + if (ERTS_TRACER_IS_NIL(*tracer)) { + /* Trace disabled */ return 0; } - if (tracer_pid == &ERTS_TRACER_PROC(p)) { + ASSERT(IS_TRACER_VALID(*tracer)); + if (tracer == &ERTS_TRACER(p)) { /* Tracer specified in process structure => * non-breakpoint trace => * use process flags */ tracee_flags = &ERTS_TRACE_FLAGS(p); -#ifdef ERTS_SMP - tracee = p->common.id; -#endif + if (!is_tracer_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif, + TRACE_FUN_E_CALL, am_call)) { + return 0; + } } else { /* Tracer not specified in process structure => * tracer specified in breakpoint => * meta trace => * use fixed flag set instead of process flags - */ - if (ERTS_TRACE_FLAGS(p) & F_SENSITIVE) { - /* No trace messages for sensitive processes. */ - return 0; - } + */ + if (ERTS_TRACE_FLAGS(p) & F_SENSITIVE) { + /* No trace messages for sensitive processes. */ + return 0; + } meta_flags = F_TRACE_CALLS | F_NOW_TS; tracee_flags = &meta_flags; -#ifdef ERTS_SMP - tracee = NIL; -#endif + switch (call_enabled_tracer(p, *tracer, + &tnif, TRACE_FUN_T_CALL, + am_call, p->common.id)) { + default: + case am_remove: *tracer = erts_tracer_nil; + case am_discard: return 0; + case am_trace: break; + } } /* @@ -1820,18 +1157,13 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, * temporarily convert any match contexts to sub binaries. */ arity = (Eterm) mfa[2]; - UseTmpHeap(ERL_SUB_BIN_SIZE,p); -#ifdef DEBUG - sub_bin_heap->thing_word = 0; -#endif for (i = 0; i < arity; i++) { Eterm arg = args[i]; if (is_boxed(arg) && header_is_bin_matchstate(*boxed_val(arg))) { ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(arg); ErlBinMatchBuffer* mb = &ms->mb; Uint bit_size; - - ASSERT(sub_bin_heap->thing_word == 0); /* At most one of match context */ + ErlSubBin *sub_bin_heap = (ErlSubBin *)HAlloc(p, ERL_SUB_BIN_SIZE); bit_size = mb->size - mb->offset; sub_bin_heap->thing_word = HEADER_SUB_BIN; @@ -1848,298 +1180,98 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, } args = transformed_args; - ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags); - - if (is_internal_port(*tracer_pid)) { -#if HEAP_ON_C_STACK - Eterm local_heap[60+ERTS_TRACE_PATCH_TS_MAX_SIZE+MAX_ARG]; -#else - Eterm *local_heap = erts_alloc(ERTS_ALC_T_TEMP_TERM, - sizeof(Eterm)*(60+ERTS_TRACE_PATCH_TS_MAX_SIZE+MAX_ARG)); -#endif - hp = local_heap; - - if (!erts_is_valid_tracer_port(*tracer_pid)) { -#ifdef ERTS_SMP - ASSERT(is_nil(tracee) || tracer_pid == &ERTS_TRACER_PROC(p)); - if (is_not_nil(tracee)) - erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); -#endif - *tracee_flags &= ~TRACEE_FLAGS; - *tracer_pid = NIL; -#ifdef ERTS_SMP - if (is_not_nil(tracee)) - erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); -#endif -#if !HEAP_ON_C_STACK - erts_free(ERTS_ALC_T_TEMP_TERM,local_heap); -#endif - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return 0; - } - - /* - * If there is a PAM program, run it. Return if it fails. - * - * Some precedence rules: - * - * - No proc flags, e.g 'silent' or 'return_to' - * has any effect on meta trace. - * - The 'silent' process trace flag silences all call - * related messages, e.g 'call', 'return_to' and 'return_from'. - * - The {message,_} PAM function does not affect {return_trace}. - * - The {message,false} PAM function shall give the same - * 'call' trace message as no PAM match. - * - The {message,true} PAM function shall give the same - * 'call' trace message as a nonexistent PAM program. - */ - - /* BEGIN this code should be the same for port and pid trace */ - return_flags = 0; - if (match_spec) { - pam_result = erts_match_set_run(p, match_spec, args, arity, - ERTS_PAM_TMP_RESULT, &return_flags); - if (is_non_value(pam_result)) { - erts_match_set_release_result(p); -#if !HEAP_ON_C_STACK - erts_free(ERTS_ALC_T_TEMP_TERM,local_heap); -#endif - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return 0; - } - } - if (tracee_flags == &meta_flags) { - /* Meta trace */ - if (pam_result == am_false) { - erts_match_set_release_result(p); -#if !HEAP_ON_C_STACK - erts_free(ERTS_ALC_T_TEMP_TERM,local_heap); -#endif - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return return_flags; - } - } else { - /* Non-meta trace */ - if (*tracee_flags & F_TRACE_SILENT) { - erts_match_set_release_result(p); -#if !HEAP_ON_C_STACK - erts_free(ERTS_ALC_T_TEMP_TERM,local_heap); -#endif - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return 0; - } - if (pam_result == am_false) { - erts_match_set_release_result(p); -#if !HEAP_ON_C_STACK - erts_free(ERTS_ALC_T_TEMP_TERM,local_heap); -#endif - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return return_flags; - } - if (local && (*tracee_flags & F_TRACE_RETURN_TO)) { - return_flags |= MATCH_SET_RETURN_TO_TRACE; - } - } - /* END this code should be the same for port and pid trace */ - - /* - * Build the the {M,F,A} tuple in the local heap. - * (A is arguments or arity.) - */ - - if (*tracee_flags & F_TRACE_ARITY_ONLY) { - mfa_tuple = make_small(arity); - } else { - mfa_tuple = NIL; - for (i = arity-1; i >= 0; i--) { - mfa_tuple = CONS(hp, args[i], mfa_tuple); - hp += 2; - } - } - mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], mfa_tuple); - hp += 4; - - /* - * Build the trace tuple and send it to the port. - */ - - mess = TUPLE4(hp, am_trace, p->common.id, am_call, mfa_tuple); - hp += 5; - if (pam_result != am_true) { - hp[-5] = make_arityval(5); - *hp++ = pam_result; - } - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(ts_type, mess, hp, NULL, NULL); - send_to_port(p, mess, tracer_pid, tracee_flags); - erts_smp_mtx_unlock(&smq_mtx); - erts_match_set_release_result(p); -#if !HEAP_ON_C_STACK - erts_free(ERTS_ALC_T_TEMP_TERM,local_heap); -#endif - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return *tracer_pid == NIL ? 0 : return_flags; + /* + * If there is a PAM program, run it. Return if it fails. + * + * Some precedence rules: + * + * - No proc flags, e.g 'silent' or 'return_to' + * has any effect on meta trace. + * - The 'silent' process trace flag silences all call + * related messages, e.g 'call', 'return_to' and 'return_from'. + * - The {message,_} PAM function does not affect {return_trace}. + * - The {message,false} PAM function shall give the same + * 'call' trace message as no PAM match. + * - The {message,true} PAM function shall give the same + * 'call' trace message as a nonexistent PAM program. + */ + return_flags = 0; + if (match_spec) { + /* we have to make a copy of the tracer here as the match spec + may remove it, and we still want to generate a trace message */ + erts_tracer_update(&pre_ms_tracer, *tracer); + tracer = &pre_ms_tracer; + pam_result = erts_match_set_run(p, match_spec, args, arity, + ERTS_PAM_TMP_RESULT, &return_flags); + if (is_non_value(pam_result)) { + erts_match_set_release_result(p); + UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); + ERTS_TRACER_CLEAR(&pre_ms_tracer); + return 0; + } + } + + if (tracee_flags == &meta_flags) { + /* Meta trace */ + if (pam_result == am_false) { + erts_match_set_release_result(p); + UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); + ERTS_TRACER_CLEAR(&pre_ms_tracer); + return return_flags; + } } else { - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - Process *tracer; - ERTS_TRACER_REF_TYPE tracer_ref; -#ifdef ERTS_SMP - Eterm tpid; -#endif - unsigned size; - unsigned sizes[MAX_ARG]; - unsigned pam_result_size = 0; - int invalid_tracer; + /* Non-meta trace */ + if (*tracee_flags & F_TRACE_SILENT) { + erts_match_set_release_result(p); + UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); + ERTS_TRACER_CLEAR(&pre_ms_tracer); + return 0; + } + if (pam_result == am_false) { + erts_match_set_release_result(p); + UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); + ERTS_TRACER_CLEAR(&pre_ms_tracer); + return return_flags; + } + if (local && (*tracee_flags & F_TRACE_RETURN_TO)) { + return_flags |= MATCH_SET_RETURN_TO_TRACE; + } + } + + ASSERT(!ERTS_TRACER_IS_NIL(*tracer)); - ASSERT(is_internal_pid(*tracer_pid)); - - tracer = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, - *tracer_pid, ERTS_PROC_LOCK_STATUS); - if (!tracer) - invalid_tracer = 1; - else { - invalid_tracer = !(ERTS_TRACE_FLAGS(tracer) & F_TRACER); - erts_smp_proc_unlock(tracer, ERTS_PROC_LOCK_STATUS); - } - - if (invalid_tracer) { -#ifdef ERTS_SMP - ASSERT(is_nil(tracee) - || tracer_pid == &ERTS_TRACER_PROC(p)); - if (is_not_nil(tracee)) - erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); -#endif - *tracee_flags &= ~TRACEE_FLAGS; - *tracer_pid = NIL; -#ifdef ERTS_SMP - if (is_not_nil(tracee)) - erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); -#endif - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return 0; - } - -#ifdef ERTS_SMP - tpid = *tracer_pid; /* Need to save tracer pid, - since *tracer_pid might - be reset by erts_match_set_run() */ - tracer_ref = tpid; -#else - tracer_ref = tracer; -#endif - - /* - * If there is a PAM program, run it. Return if it fails. - * - * See the rules above in the port trace code. - */ - - /* BEGIN this code should be the same for port and pid trace */ - return_flags = 0; - if (match_spec) { - pam_result = erts_match_set_run(p, match_spec, args, arity, - ERTS_PAM_TMP_RESULT, &return_flags); - if (is_non_value(pam_result)) { - erts_match_set_release_result(p); - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return 0; - } - } - if (tracee_flags == &meta_flags) { - /* Meta trace */ - if (pam_result == am_false) { - erts_match_set_release_result(p); - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return return_flags; - } - } else { - /* Non-meta trace */ - if (*tracee_flags & F_TRACE_SILENT) { - erts_match_set_release_result(p); - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return 0; - } - if (pam_result == am_false) { - erts_match_set_release_result(p); - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return return_flags; - } - if (local && (*tracee_flags & F_TRACE_RETURN_TO)) { - return_flags |= MATCH_SET_RETURN_TO_TRACE; - } - } - /* END this code should be the same for port and pid trace */ - - /* - * Calculate number of words needed on heap. - */ - - size = 4 + 5; /* Trace tuple + MFA tuple. */ - if (! (*tracee_flags & F_TRACE_ARITY_ONLY)) { - size += 2*arity; - for (i = arity-1; i >= 0; i--) { - sizes[i] = size_object(args[i]); - size += sizes[i]; - } - } - size += patch_ts_size(ts_type); - if (pam_result != am_true) { - pam_result_size = size_object(pam_result); - size += 1 + pam_result_size; - /* One element in trace tuple + term size. */ - } - - hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); + /* + * Build the the {M,F,A} tuple in the local heap. + * (A is arguments or arity.) + */ - /* - * Build the the {M,F,A} tuple in the message buffer. - * (A is arguments or arity.) - */ - - if (*tracee_flags & F_TRACE_ARITY_ONLY) { - mfa_tuple = make_small(arity); - } else { - mfa_tuple = NIL; - for (i = arity-1; i >= 0; i--) { - Eterm term = copy_struct(args[i], sizes[i], &hp, off_heap); - mfa_tuple = CONS(hp, term, mfa_tuple); - hp += 2; - } - } - mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], mfa_tuple); - hp += 4; - - /* - * Copy the PAM result (if any) onto the heap. - */ - - if (pam_result != am_true) { - pam_result = copy_struct(pam_result, pam_result_size, &hp, off_heap); - } - erts_match_set_release_result(p); + if (*tracee_flags & F_TRACE_ARITY_ONLY) { + hp = HAlloc(p, 4); + mfa_tuple = make_small(arity); + } else { + hp = HAlloc(p, 4 + arity * 2); + mfa_tuple = NIL; + for (i = arity-1; i >= 0; i--) { + mfa_tuple = CONS(hp, args[i], mfa_tuple); + hp += 2; + } + } + mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], mfa_tuple); + hp += 4; - /* - * Build the trace tuple and enqueue it. - */ - - mess = TUPLE4(hp, am_trace, p->common.id, am_call, mfa_tuple); - hp += 5; - if (pam_result != am_true) { - hp[-5] = make_arityval(5); - *hp++ = pam_result; - } + /* + * Build the trace tuple and send it to the port. + */ + send_to_tracer_nif_raw(p, NULL, *tracer, *tracee_flags, p->common.id, + tnif, TRACE_FUN_T_CALL, am_call, mfa_tuple, THE_NON_VALUE, pam_result); + erts_match_set_release_result(p); - erts_smp_mtx_lock(&smq_mtx); + if (match_spec && tracer == &pre_ms_tracer) + ERTS_TRACER_CLEAR(&pre_ms_tracer); - PATCH_TS(ts_type, mess, hp, bp, tracer_ref); - ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return return_flags; - } + return return_flags; } /* Sends trace message: @@ -2151,69 +1283,14 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, * 't_p' is the traced process. */ void -trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data) +trace_proc(Process *c_p, ErtsProcLocks c_p_locks, + Process *t_p, Eterm what, Eterm data) { - Eterm mess; - Eterm* hp; - int need; - - ERTS_SMP_LC_ASSERT((erts_proc_lc_my_proc_locks(t_p) != 0) - || erts_thr_progress_is_blocking()); - if (is_internal_port(ERTS_TRACER_PROC(t_p))) { -#define LOCAL_HEAP_SIZE (5+5) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - - hp = local_heap; - mess = TUPLE4(hp, am_trace, t_p->common.id, what, data); - hp += 5; - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, NULL, NULL); - send_to_port( -#ifndef ERTS_SMP - /* No fake schedule out and in again after an exit */ - what == am_exit ? NULL : c_p, -#else - /* Fake schedule out and in are never sent when smp enabled */ - c_p, -#endif - mess, - &ERTS_TRACER_PROC(t_p), - &ERTS_TRACE_FLAGS(t_p)); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - Eterm tmp; - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - size_t sz_data; - - ASSERT(is_internal_pid(ERTS_TRACER_PROC(t_p))); - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(t_p), - ERTS_TRACE_FLAGS(t_p)); - - sz_data = size_object(data); - - need = sz_data + 5 + PATCH_TS_SIZE(t_p); - - hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref); - - tmp = copy_struct(data, sz_data, &hp, off_heap); - mess = TUPLE4(hp, am_trace, t_p->common.id, what, tmp); - hp += 5; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, bp, tracer_ref); - - ERTS_ENQ_TRACE_MSG(t_p->common.id, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - } + ErtsTracerNif *tnif = NULL; + if (is_tracer_enabled(c_p, c_p_locks, &t_p->common, &tnif, + TRACE_FUN_E_PROCS, what)) + send_to_tracer_nif(c_p, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_PROCS, + what, data, THE_NON_VALUE); } @@ -2225,62 +1302,21 @@ trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data) * and 'args' may be a deep term. */ void -trace_proc_spawn(Process *p, Eterm pid, +trace_proc_spawn(Process *p, Eterm what, Eterm pid, Eterm mod, Eterm func, Eterm args) { - Eterm mfa; - Eterm mess; - Eterm* hp; - - if (is_internal_port(ERTS_TRACER_PROC(p))) { -#define LOCAL_HEAP_SIZE (4+6+5) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; - mfa = TUPLE3(hp, mod, func, args); - hp += 4; - mess = TUPLE5(hp, am_trace, p->common.id, am_spawn, pid, mfa); - hp += 6; - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL); - send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - Eterm tmp; - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - size_t sz_args, sz_pid; - Uint need; + ErtsTracerNif *tnif = NULL; + if (is_tracer_enabled(p, ERTS_PROC_LOCKS_ALL & + ~(ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE), + &p->common, &tnif, TRACE_FUN_E_PROCS, what)) { + Eterm mfa; + Eterm* hp; - ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(p), - ERTS_TRACE_FLAGS(p)); - - sz_args = size_object(args); - sz_pid = size_object(pid); - need = sz_args + 4 + 6 + PATCH_TS_SIZE(p); - - hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref); - - tmp = copy_struct(args, sz_args, &hp, off_heap); - mfa = TUPLE3(hp, mod, func, tmp); - hp += 4; - tmp = copy_struct(pid, sz_pid, &hp, off_heap); - mess = TUPLE5(hp, am_trace, p->common.id, am_spawn, tmp, mfa); - hp += 6; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref); - - ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); + hp = HAlloc(p, 4); + mfa = TUPLE3(hp, mod, func, args); + hp += 4; + send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_PROCS, + what, pid, mfa); } } @@ -2312,113 +1348,26 @@ void save_calls(Process *p, Export *e) * are all small (atomic) integers. */ void -trace_gc(Process *p, Eterm what) +trace_gc(Process *p, Eterm what, Uint size) { - ERTS_DECL_AM(bin_vheap_size); - ERTS_DECL_AM(bin_vheap_block_size); - ERTS_DECL_AM(bin_old_vheap_size); - ERTS_DECL_AM(bin_old_vheap_block_size); - - ErlHeapFragment *bp = NULL; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref = ERTS_NULL_TRACER_REF; /* Initialized - to eliminate - compiler - warning */ + ErtsTracerNif *tnif = NULL; Eterm* hp; Eterm msg = NIL; - Uint size; - - Eterm tags[] = { - am_old_heap_block_size, - am_heap_block_size, - am_mbuf_size, - am_recent_size, - am_stack_size, - am_old_heap_size, - am_heap_size, - AM_bin_vheap_size, - AM_bin_vheap_block_size, - AM_bin_old_vheap_size, - AM_bin_old_vheap_block_size - }; - - UWord values[] = { - OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0, - HEAP_SIZE(p), - MBUF_SIZE(p), - HIGH_WATER(p) - HEAP_START(p), - STACK_START(p) - p->stop, - OLD_HEAP(p) ? OLD_HTOP(p) - OLD_HEAP(p) : 0, - HEAP_TOP(p) - HEAP_START(p), - MSO(p).overhead, - BIN_VHEAP_SZ(p), - BIN_OLD_VHEAP(p), - BIN_OLD_VHEAP_SZ(p) - }; -#define LOCAL_HEAP_SIZE \ - (sizeof(values)/sizeof(*values)) * \ - (2/*cons*/ + 3/*2-tuple*/ + BIG_UINT_HEAP_SIZE) + \ - 5/*4-tuple */ + ERTS_TRACE_PATCH_TS_MAX_SIZE - DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p); - - ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(Eterm)); - - UseTmpHeap(LOCAL_HEAP_SIZE,p); - - if (is_internal_port(ERTS_TRACER_PROC(p))) { - hp = local_heap; -#ifdef DEBUG - size = 0; - (void) erts_bld_atom_uword_2tup_list(NULL, - &size, - sizeof(values)/sizeof(*values), - tags, - values); - size += 5/*4-tuple*/ + PATCH_TS_SIZE(p); -#endif - } else { - ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(p), - ERTS_TRACE_FLAGS(p)); - - size = 0; - (void) erts_bld_atom_uword_2tup_list(NULL, - &size, - sizeof(values)/sizeof(*values), - tags, - values); - size += 5/*4-tuple*/ + PATCH_TS_SIZE(p); - - hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); - } - - ASSERT(size <= LOCAL_HEAP_SIZE); + Uint sz = 0; + Eterm tup; - msg = erts_bld_atom_uword_2tup_list(&hp, - NULL, - sizeof(values)/sizeof(*values), - tags, - values); + if (is_tracer_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif, TRACE_FUN_E_GC, what)) { - msg = TUPLE4(hp, am_trace, p->common.id, what, msg); - hp += 5; + (void) erts_process_gc_info(p, &sz, NULL); + hp = HAlloc(p, sz + 3 + 2); - erts_smp_mtx_lock(&smq_mtx); + msg = erts_process_gc_info(p, NULL, &hp); + tup = TUPLE2(hp, am_wordsize, make_small(size)); hp += 3; + msg = CONS(hp, tup, msg); hp += 2; - if (is_internal_port(ERTS_TRACER_PROC(p))) { - PATCH_TS(TFLGS_TS_TYPE(p), msg, hp, NULL, NULL); - send_to_port(p, msg, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); + send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_GC, + what, msg, am_undefined); } - else { - PATCH_TS(TFLGS_TS_TYPE(p), msg, hp, bp, tracer_ref); - ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, msg, bp); - } - erts_smp_mtx_unlock(&smq_mtx); - UnUseTmpHeap(LOCAL_HEAP_SIZE,p); -#undef LOCAL_HEAP_SIZE } void @@ -2477,7 +1426,11 @@ 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); + { + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = bp; + erts_queue_message(monitor_p, NULL, mp, msg); + } #endif } void @@ -2538,7 +1491,11 @@ 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); + { + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = bp; + erts_queue_message(monitor_p, NULL, mp, msg); + } #endif } @@ -2609,7 +1566,11 @@ 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); + { + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = bp; + erts_queue_message(monitor_p, NULL, mp, msg); + } #endif } @@ -2680,7 +1641,11 @@ 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); + { + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = bp; + erts_queue_message(monitor_p, NULL, mp, msg); + } #endif } @@ -2708,7 +1673,11 @@ 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); + { + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = bp; + erts_queue_message(monitor_p, NULL, mp, msg); + } #endif } @@ -2769,106 +1738,15 @@ profile_scheduler(Eterm scheduler_id, Eterm state) { } -void -profile_scheduler_q(Eterm scheduler_id, Eterm state, Eterm no_schedulers, Uint Ms, Uint s, Uint us) { - Eterm *hp, msg, timestamp; - -#ifndef ERTS_SMP -#define LOCAL_HEAP_SIZE (4 + 7) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; -#else - ErlHeapFragment *bp; - Uint hsz; - - hsz = 4 + 7; - - bp = new_message_buffer(hsz); - hp = bp->mem; -#endif - - erts_smp_mtx_lock(&smq_mtx); - - timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4; - msg = TUPLE6(hp, am_profile, am_scheduler, scheduler_id, state, no_schedulers, timestamp); hp += 7; -#ifndef ERTS_SMP - profile_send(NIL, msg); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE -#else - enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, NIL, NIL, msg, bp); -#endif - erts_smp_mtx_unlock(&smq_mtx); - -} - - -/* Send {trace_ts, Pid, What, {Mod, Func, Arity}, Timestamp} - * or {trace, Pid, What, {Mod, Func, Arity}} - * - * where 'What' is supposed to be 'in' or 'out'. - * - * Virtual scheduling do not fake scheduling for ports. - */ - - -void trace_virtual_sched(Process *p, Eterm what) -{ - trace_sched_aux(p, what, 1); -} - /* Port profiling */ void trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) { - Eterm mess; - Eterm* hp; - - if (is_internal_port(ERTS_TRACER_PROC(p))) { -#define LOCAL_HEAP_SIZE (6+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; - - mess = TUPLE5(hp, am_trace, calling_pid, am_open, p->common.id, drv_name); - hp += 6; - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL); - /* No fake schedule */ - send_to_port(NULL, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - size_t sz_data; - ERTS_TRACER_REF_TYPE tracer_ref; - - ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); - - sz_data = 6 + PATCH_TS_SIZE(p); - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(p), - ERTS_TRACE_FLAGS(p)); - - hp = ERTS_ALLOC_SYSMSG_HEAP(sz_data, &bp, &off_heap, tracer_ref); - - mess = TUPLE5(hp, am_trace, calling_pid, am_open, p->common.id, drv_name); - hp += 6; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref); - - ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - } - + ErtsTracerNif *tnif = NULL; + ERTS_SMP_CHK_NO_PROC_LOCKS; + if (is_tracer_enabled(NULL, 0, &p->common, &tnif, TRACE_FUN_E_PORTS, am_open)) + send_to_tracer_nif(NULL, &p->common, p->common.id, tnif, TRACE_FUN_T_PORTS, + am_open, calling_pid, drv_name); } /* Sends trace message: @@ -2880,52 +1758,211 @@ trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) { */ void trace_port(Port *t_p, Eterm what, Eterm data) { - Eterm mess; - Eterm* hp; + ErtsTracerNif *tnif = NULL; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) || erts_thr_progress_is_blocking()); + ERTS_SMP_CHK_NO_PROC_LOCKS; + if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_PORTS, what)) + send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_PORTS, + what, data, THE_NON_VALUE); +} - if (is_internal_port(ERTS_TRACER_PROC(t_p))) { -#define LOCAL_HEAP_SIZE (5+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - hp = local_heap; - mess = TUPLE4(hp, am_trace, t_p->common.id, what, data); - hp += 5; - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, NULL, NULL); - /* No fake schedule */ - send_to_port(NULL,mess,&ERTS_TRACER_PROC(t_p),&ERTS_TRACE_FLAGS(t_p)); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); +static Eterm +trace_port_tmp_binary(char *bin, Sint sz, Binary **bptrp, Eterm **hp) +{ + if (sz <= ERL_ONHEAP_BIN_LIMIT) { + ErlHeapBin *hb = (ErlHeapBin *)*hp; + hb->thing_word = header_heap_bin(sz); + hb->size = sz; + sys_memcpy(hb->data, bin, sz); + *hp += heap_bin_size(sz); + return make_binary(hb); } else { - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - size_t sz_data; - ERTS_TRACER_REF_TYPE tracer_ref; + ProcBin* pb = (ProcBin *)*hp; + Binary *bptr = erts_bin_nrml_alloc(sz); + erts_refc_init(&bptr->refc, 1); + sys_memcpy(bptr->orig_bytes, bin, sz); + pb->thing_word = HEADER_PROC_BIN; + pb->size = sz; + pb->next = NULL; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = 0; + *bptrp = bptr; + *hp += PROC_BIN_SIZE; + return make_binary(pb); + } +} - ASSERT(is_internal_pid(ERTS_TRACER_PROC(t_p))); +/* Sends trace message: + * {trace, PortPid, 'receive', {pid(), {command, iolist()}}} + * {trace, PortPid, 'receive', {pid(), {control, pid()}}} + * {trace, PortPid, 'receive', {pid(), exit}} + * + */ +void +trace_port_receive(Port *t_p, Eterm caller, Eterm what, ...) +{ + ErtsTracerNif *tnif = NULL; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) + || erts_thr_progress_is_blocking()); + ERTS_SMP_CHK_NO_PROC_LOCKS; + if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_RECEIVE, am_receive)) { + /* We can use a stack heap here, as the nif is called in the + context of a port */ +#define LOCAL_HEAP_SIZE (3 + 3 + heap_bin_size(ERL_ONHEAP_BIN_LIMIT) + 3) + DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); + + Eterm *hp, data, *orig_hp = NULL; + Binary *bptr = NULL; + va_list args; + UseTmpHeapNoproc(LOCAL_HEAP_SIZE); + hp = local_heap; + + if (what == am_close) { + data = what; + } else { + Eterm arg; + va_start(args, what); + if (what == am_command) { + char *bin = va_arg(args, char *); + Sint sz = va_arg(args, Sint); + va_end(args); + arg = trace_port_tmp_binary(bin, sz, &bptr, &hp); + } else if (what == am_call || what == am_control) { + unsigned int command = va_arg(args, unsigned int); + char *bin = va_arg(args, char *); + Sint sz = va_arg(args, Sint); + Eterm cmd; + va_end(args); + arg = trace_port_tmp_binary(bin, sz, &bptr, &hp); +#if defined(ARCH_32) + if (!IS_USMALL(0, command)) { + *hp = make_pos_bignum_header(1); + BIG_DIGIT(hp, 0) = (Uint)command; + cmd = make_big(hp); + hp += 2; + } else +#endif + { + cmd = make_small((Sint)command); + } + arg = TUPLE2(hp, cmd, arg); + hp += 3; + } else if (what == am_commandv) { + ErlIOVec *evp = va_arg(args, ErlIOVec*); + int i; + va_end(args); + if ((6 + evp->vsize * (2+PROC_BIN_SIZE+ERL_SUB_BIN_SIZE)) > LOCAL_HEAP_SIZE) { + hp = erts_alloc(ERTS_ALC_T_TMP, + (6 + evp->vsize * (2+PROC_BIN_SIZE+ERL_SUB_BIN_SIZE)) * sizeof(Eterm)); + orig_hp = hp; + } + arg = NIL; + /* Convert each element in the ErlIOVec to a sub bin that points + to a procbin. We don't have to increment the proc bin refc as + the port task keeps the reference alive. */ + for (i = evp->vsize-1; i >= 0; i--) { + if (evp->iov[i].iov_len) { + ProcBin* pb = (ProcBin*)hp; + ErlSubBin *sb; + ASSERT(evp->binv[i]); + pb->thing_word = HEADER_PROC_BIN; + pb->val = ErlDrvBinary2Binary(evp->binv[i]); + pb->size = pb->val->orig_size; + pb->next = NULL; + pb->bytes = (byte*) pb->val->orig_bytes; + pb->flags = 0; + hp += PROC_BIN_SIZE; + + sb = (ErlSubBin*) hp; + sb->thing_word = HEADER_SUB_BIN; + sb->size = evp->iov[i].iov_len; + sb->offs = (byte*)(evp->iov[i].iov_base) - pb->bytes; + sb->orig = make_binary(pb); + sb->bitoffs = 0; + sb->bitsize = 0; + sb->is_writable = 0; + hp += ERL_SUB_BIN_SIZE; + + arg = CONS(hp, make_binary(sb), arg); + hp += 2; + } + } + what = am_command; + } else { + arg = va_arg(args, Eterm); + va_end(args); + } + data = TUPLE2(hp, what, arg); + hp += 3; + } + + data = TUPLE2(hp, caller, data); + hp += 3; + ASSERT(hp <= (local_heap + LOCAL_HEAP_SIZE) || orig_hp); + send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, + TRACE_FUN_T_RECEIVE, + am_receive, data, THE_NON_VALUE); + + if (bptr && erts_refc_dectest(&bptr->refc, 1) == 0) + erts_bin_free(bptr); + + if (orig_hp) + erts_free(ERTS_ALC_T_TMP, orig_hp); + + UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); + } +#undef LOCAL_HEAP_SIZE +} + +void +trace_port_send(Port *t_p, Eterm receiver, Eterm msg, int exists) +{ + ErtsTracerNif *tnif = NULL; + Eterm op = exists ? am_send : am_send_to_non_existing_process; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) + || erts_thr_progress_is_blocking()); + ERTS_SMP_CHK_NO_PROC_LOCKS; + if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_SEND, op)) + send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_SEND, + op, msg, receiver); +} - sz_data = 5 + PATCH_TS_SIZE(t_p); +void trace_port_send_binary(Port *t_p, Eterm to, Eterm what, char *bin, Sint sz) +{ + ErtsTracerNif *tnif = NULL; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) + || erts_thr_progress_is_blocking()); + ERTS_SMP_CHK_NO_PROC_LOCKS; + if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_SEND, am_send)) { + Eterm msg; + Binary* bptr = NULL; +#define LOCAL_HEAP_SIZE (3 + 3 + heap_bin_size(ERL_ONHEAP_BIN_LIMIT)) + DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(t_p), - ERTS_TRACE_FLAGS(t_p)); + Eterm *hp; - hp = ERTS_ALLOC_SYSMSG_HEAP(sz_data, &bp, &off_heap, tracer_ref); + ERTS_CT_ASSERT(heap_bin_size(ERL_ONHEAP_BIN_LIMIT) >= PROC_BIN_SIZE); + UseTmpHeapNoproc(LOCAL_HEAP_SIZE); + hp = local_heap; - mess = TUPLE4(hp, am_trace, t_p->common.id, what, data); - hp += 5; + msg = trace_port_tmp_binary(bin, sz, &bptr, &hp); - erts_smp_mtx_lock(&smq_mtx); + msg = TUPLE2(hp, what, msg); + hp += 3; + msg = TUPLE2(hp, t_p->common.id, msg); + hp += 3; - PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, bp, tracer_ref); + send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_SEND, + am_send, msg, to); + if (bptr && erts_refc_dectest(&bptr->refc, 1) == 0) + erts_bin_free(bptr); - ERTS_ENQ_TRACE_MSG(t_p->common.id, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); + UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); +#undef LOCAL_HEAP_SIZE } } @@ -2939,83 +1976,19 @@ trace_port(Port *t_p, Eterm what, Eterm data) { void trace_sched_ports(Port *p, Eterm what) { - trace_sched_ports_where(p,what, make_small(0)); + trace_sched_ports_where(p, what, make_small(0)); } -void -trace_sched_ports_where(Port *p, Eterm what, Eterm where) { - Eterm mess; - Eterm* hp; - int ws = 5; - Eterm sched_id = am_undefined; - - if (is_internal_port(ERTS_TRACER_PROC(p))) { -#define LOCAL_HEAP_SIZE (6+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; - - if (IS_TRACED_FL(p, F_TRACE_SCHED_NO)) { -#ifdef ERTS_SMP - ErtsSchedulerData *esd = erts_get_scheduler_data(); - if (esd) sched_id = make_small(esd->no); - else sched_id = am_undefined; -#else - sched_id = make_small(1); -#endif - mess = TUPLE5(hp, am_trace, p->common.id, what, sched_id, where); - ws = 6; - } else { - mess = TUPLE4(hp, am_trace, p->common.id, what, where); - ws = 5; - } - hp += ws; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL); - - /* No fake scheduling */ - send_to_port(NULL, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - - ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); - - if (IS_TRACED_FL(p, F_TRACE_SCHED_NO)) ws = 6; /* Make place for scheduler id */ - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(p), - ERTS_TRACE_FLAGS(p)); - - hp = ERTS_ALLOC_SYSMSG_HEAP(ws+PATCH_TS_SIZE(p), &bp, &off_heap, tracer_ref); - - if (IS_TRACED_FL(p, F_TRACE_SCHED_NO)) { -#ifdef ERTS_SMP - ErtsSchedulerData *esd = erts_get_scheduler_data(); - if (esd) sched_id = make_small(esd->no); - else sched_id = am_undefined; -#else - sched_id = make_small(1); -#endif - mess = TUPLE5(hp, am_trace, p->common.id, what, sched_id, where); - } else { - mess = TUPLE4(hp, am_trace, p->common.id, what, where); - } - hp += ws; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref); - ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - } +void +trace_sched_ports_where(Port *t_p, Eterm what, Eterm where) { + ErtsTracerNif *tnif = NULL; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) + || erts_thr_progress_is_blocking()); + ERTS_SMP_CHK_NO_PROC_LOCKS; + if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_SCHED_PORT, what)) + send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, + tnif, TRACE_FUN_T_SCHED_PORT, + what, where, THE_NON_VALUE); } /* Port profiling */ @@ -3068,6 +2041,7 @@ profile_runnable_proc(Process *p, Eterm status){ Eterm *hp, msg; Eterm where = am_undefined; ErlHeapFragment *bp = NULL; + int use_current = 1; #ifndef ERTS_SMP #define LOCAL_HEAP_SIZE (4 + 6 + ERTS_TRACE_PATCH_TS_MAX_SIZE) @@ -3080,12 +2054,19 @@ profile_runnable_proc(Process *p, Eterm status){ Uint hsz = 4 + 6 + patch_ts_size(erts_system_profile_ts_type)-1; #endif - if (!p->current) { - p->current = find_function_from_pc(p->i); + if (ERTS_PROC_IS_EXITING(p)) { + use_current = 0; + /* could probably set 'where' to 'exiting' here, + * though it's not documented as such */ + } else { + if (!p->current) { + p->current = find_function_from_pc(p->i); + } + use_current = p->current != NULL; } #ifdef ERTS_SMP - if (!p->current) { + if (!use_current) { hsz -= 4; } @@ -3093,7 +2074,7 @@ profile_runnable_proc(Process *p, Eterm status){ hp = bp->mem; #endif - if (p->current) { + if (use_current) { where = TUPLE3(hp, p->current[0], p->current[1], make_small(p->current[2])); hp += 4; } else { where = make_small(0); @@ -3123,28 +2104,6 @@ profile_runnable_proc(Process *p, Eterm status){ #ifdef ERTS_SMP -void -erts_check_my_tracer_proc(Process *p) -{ - if (is_internal_pid(ERTS_TRACER_PROC(p))) { - Process *tracer = erts_pid2proc(p, - ERTS_PROC_LOCK_MAIN, - ERTS_TRACER_PROC(p), - ERTS_PROC_LOCK_STATUS); - int invalid_tracer = (!tracer - || !(ERTS_TRACE_FLAGS(tracer) & F_TRACER)); - if (tracer) - erts_smp_proc_unlock(tracer, ERTS_PROC_LOCK_STATUS); - if (invalid_tracer) { - erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); - ERTS_TRACE_FLAGS(p) &= ~TRACEE_FLAGS; - ERTS_TRACER_PROC(p) = NIL; - erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); - } - } -} - - typedef struct ErtsSysMsgQ_ ErtsSysMsgQ; struct ErtsSysMsgQ_ { ErtsSysMsgQ *next; @@ -3222,12 +2181,6 @@ static void print_msg_type(ErtsSysMsgQ *smqp) { switch (smqp->type) { - case SYS_MSG_TYPE_TRACE: - erts_fprintf(stderr, "TRACE "); - break; - case SYS_MSG_TYPE_SEQTRACE: - erts_fprintf(stderr, "SEQTRACE "); - break; case SYS_MSG_TYPE_SYSMON: erts_fprintf(stderr, "SYSMON "); break; @@ -3238,8 +2191,8 @@ print_msg_type(ErtsSysMsgQ *smqp) erts_fprintf(stderr, "ERRLGR "); break; case SYS_MSG_TYPE_PROC_MSG: - erts_fprintf(stderr, "PROC_MSG "); - break; + erts_fprintf(stderr, "PROC_MSG "); + break; default: erts_fprintf(stderr, "??? "); break; @@ -3251,17 +2204,6 @@ static void sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver) { switch (smqp->type) { - case SYS_MSG_TYPE_TRACE: - /* Invalid tracer_proc's are removed when processes - are scheduled in. */ - break; - case SYS_MSG_TYPE_SEQTRACE: - /* Reset seq_tracer if it hasn't changed */ - erts_smp_rwmtx_rwlock(&sys_trace_rwmtx); - if (system_seq_tracer == receiver) - system_seq_tracer = am_false; - erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx); - break; case SYS_MSG_TYPE_SYSMON: if (receiver == NIL && !erts_system_monitor_long_gc @@ -3322,7 +2264,7 @@ sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver) break; } case SYS_MSG_TYPE_PROC_MSG: - break; + break; default: ASSERT(0); } @@ -3436,19 +2378,13 @@ sys_msg_dispatcher_func(void *unused) if (erts_thr_progress_update(NULL)) erts_thr_progress_leader_update(NULL); - ERTS_SCHED_FAIR_YIELD(); - #ifdef DEBUG_PRINTOUTS print_msg_type(smqp); #endif switch (smqp->type) { - case SYS_MSG_TYPE_TRACE: - case SYS_MSG_TYPE_PROC_MSG: - receiver = smqp->to; - break; - case SYS_MSG_TYPE_SEQTRACE: - receiver = erts_get_system_seq_tracer(); - break; + case SYS_MSG_TYPE_PROC_MSG: + receiver = smqp->to; + break; case SYS_MSG_TYPE_SYSMON: receiver = erts_get_system_monitor(); if (smqp->from == receiver) { @@ -3483,21 +2419,16 @@ sys_msg_dispatcher_func(void *unused) if (is_internal_pid(receiver)) { proc = erts_pid2proc(NULL, 0, receiver, proc_locks); - if (!proc - || (smqp->type == SYS_MSG_TYPE_TRACE - && !(ERTS_TRACE_FLAGS(proc) & F_TRACER))) { + if (!proc) { /* Bad tracer */ -#ifdef DEBUG_PRINTOUTS - if (smqp->type == SYS_MSG_TYPE_TRACE && proc) - erts_fprintf(stderr, - "<tracer alive but missing " - "F_TRACER flag> "); -#endif goto failure; } else { + ErtsMessage *mp; queue_proc_msg: - erts_queue_message(proc,&proc_locks,smqp->bp,smqp->msg,NIL); + mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = smqp->bp; + erts_queue_message(proc,&proc_locks,mp,smqp->msg); #ifdef DEBUG_PRINTOUTS erts_fprintf(stderr, "delivered\n"); #endif @@ -3563,12 +2494,6 @@ erts_foreach_sys_msg_in_q(void (*func)(Eterm, for (sm = sys_message_queue; sm; sm = sm->next) { Eterm to; switch (sm->type) { - case SYS_MSG_TYPE_TRACE: - to = sm->to; - break; - case SYS_MSG_TYPE_SEQTRACE: - to = erts_get_system_seq_tracer(); - break; case SYS_MSG_TYPE_SYSMON: to = erts_get_system_monitor(); break; @@ -3592,9 +2517,6 @@ static void init_sys_msg_dispatcher(void) { erts_smp_thr_opts_t thr_opts = ERTS_SMP_THR_OPTS_DEFAULT_INITER; -#ifdef __OSE__ - thr_opts.coreNo = 0; -#endif thr_opts.detached = 1; thr_opts.name = "sys_msg_dispatcher"; init_smq_element_alloc(); @@ -3602,7 +2524,6 @@ init_sys_msg_dispatcher(void) sys_message_queue_end = NULL; erts_smp_cnd_init(&smq_cnd); erts_smp_mtx_init(&smq_mtx, "sys_msg_q"); - erts_smp_thr_create(&sys_msg_dispatcher_tid, sys_msg_dispatcher_func, NULL, @@ -3610,3 +2531,589 @@ init_sys_msg_dispatcher(void) } #endif + +#include "erl_nif.h" + +typedef struct { + char *name; + Uint arity; + ErlNifFunc *cb; +} ErtsTracerType; + +struct ErtsTracerNif_ { + HashBucket hb; + Eterm module; + struct erl_module_nif* nif_mod; + ErtsTracerType tracers[NIF_TRACER_TYPES]; +}; + +static void init_tracer_template(ErtsTracerNif *tnif) { + + /* default tracer functions */ + tnif->tracers[TRACE_FUN_DEFAULT].name = "trace"; + tnif->tracers[TRACE_FUN_DEFAULT].arity = 6; + tnif->tracers[TRACE_FUN_DEFAULT].cb = NULL; + + tnif->tracers[TRACE_FUN_ENABLED].name = "enabled"; + tnif->tracers[TRACE_FUN_ENABLED].arity = 3; + tnif->tracers[TRACE_FUN_ENABLED].cb = NULL; + + /* specific tracer functions */ + tnif->tracers[TRACE_FUN_T_SEND].name = "trace_send"; + tnif->tracers[TRACE_FUN_T_SEND].arity = 6; + tnif->tracers[TRACE_FUN_T_SEND].cb = NULL; + + tnif->tracers[TRACE_FUN_T_RECEIVE].name = "trace_receive"; + tnif->tracers[TRACE_FUN_T_RECEIVE].arity = 6; + tnif->tracers[TRACE_FUN_T_RECEIVE].cb = NULL; + + tnif->tracers[TRACE_FUN_T_CALL].name = "trace_call"; + tnif->tracers[TRACE_FUN_T_CALL].arity = 6; + tnif->tracers[TRACE_FUN_T_CALL].cb = NULL; + + tnif->tracers[TRACE_FUN_T_SCHED_PROC].name = "trace_running_procs"; + tnif->tracers[TRACE_FUN_T_SCHED_PROC].arity = 6; + tnif->tracers[TRACE_FUN_T_SCHED_PROC].cb = NULL; + + tnif->tracers[TRACE_FUN_T_SCHED_PORT].name = "trace_running_ports"; + tnif->tracers[TRACE_FUN_T_SCHED_PORT].arity = 6; + tnif->tracers[TRACE_FUN_T_SCHED_PORT].cb = NULL; + + tnif->tracers[TRACE_FUN_T_GC].name = "trace_garbage_collection"; + tnif->tracers[TRACE_FUN_T_GC].arity = 6; + tnif->tracers[TRACE_FUN_T_GC].cb = NULL; + + tnif->tracers[TRACE_FUN_T_PROCS].name = "trace_procs"; + tnif->tracers[TRACE_FUN_T_PROCS].arity = 6; + tnif->tracers[TRACE_FUN_T_PROCS].cb = NULL; + + tnif->tracers[TRACE_FUN_T_PORTS].name = "trace_ports"; + tnif->tracers[TRACE_FUN_T_PORTS].arity = 6; + tnif->tracers[TRACE_FUN_T_PORTS].cb = NULL; + + /* specific enabled functions */ + tnif->tracers[TRACE_FUN_E_SEND].name = "enabled_send"; + tnif->tracers[TRACE_FUN_E_SEND].arity = 3; + tnif->tracers[TRACE_FUN_E_SEND].cb = NULL; + + tnif->tracers[TRACE_FUN_E_RECEIVE].name = "enabled_receive"; + tnif->tracers[TRACE_FUN_E_RECEIVE].arity = 3; + tnif->tracers[TRACE_FUN_E_RECEIVE].cb = NULL; + + tnif->tracers[TRACE_FUN_E_CALL].name = "enabled_call"; + tnif->tracers[TRACE_FUN_E_CALL].arity = 3; + tnif->tracers[TRACE_FUN_E_CALL].cb = NULL; + + tnif->tracers[TRACE_FUN_E_SCHED_PROC].name = "enabled_running_procs"; + tnif->tracers[TRACE_FUN_E_SCHED_PROC].arity = 3; + tnif->tracers[TRACE_FUN_E_SCHED_PROC].cb = NULL; + + tnif->tracers[TRACE_FUN_E_SCHED_PORT].name = "enabled_running_ports"; + tnif->tracers[TRACE_FUN_E_SCHED_PORT].arity = 3; + tnif->tracers[TRACE_FUN_E_SCHED_PORT].cb = NULL; + + tnif->tracers[TRACE_FUN_E_GC].name = "enabled_garbage_collection"; + tnif->tracers[TRACE_FUN_E_GC].arity = 3; + tnif->tracers[TRACE_FUN_E_GC].cb = NULL; + + tnif->tracers[TRACE_FUN_E_PROCS].name = "enabled_procs"; + tnif->tracers[TRACE_FUN_E_PROCS].arity = 3; + tnif->tracers[TRACE_FUN_E_PROCS].cb = NULL; + + tnif->tracers[TRACE_FUN_E_PORTS].name = "enabled_ports"; + tnif->tracers[TRACE_FUN_E_PORTS].arity = 3; + tnif->tracers[TRACE_FUN_E_PORTS].cb = NULL; +} + +static Hash *tracer_hash = NULL; +static erts_smp_rwmtx_t tracer_mtx; + +static ErtsTracerNif * +load_tracer_nif(const ErtsTracer tracer) +{ + Module* mod = erts_get_module(ERTS_TRACER_MODULE(tracer), + erts_active_code_ix()); + struct erl_module_instance *instance; + ErlNifFunc *funcs; + int num_of_funcs; + ErtsTracerNif tnif_tmpl, *tnif; + ErtsTracerType *tracers; + int i,j; + + if (!mod || !mod->curr.nif) { + return NULL; + } + + instance = &mod->curr; + + init_tracer_template(&tnif_tmpl); + tnif_tmpl.nif_mod = instance->nif; + tnif_tmpl.module = ERTS_TRACER_MODULE(tracer); + tracers = tnif_tmpl.tracers; + + num_of_funcs = erts_nif_get_funcs(instance->nif, &funcs); + + for(i = 0; i < num_of_funcs; i++) { + for (j = 0; j < NIF_TRACER_TYPES; j++) { + if (strcmp(tracers[j].name, funcs[i].name) == 0 && tracers[j].arity == funcs[i].arity) { + tracers[j].cb = &(funcs[i]); + break; + } + } + } + + if (tracers[TRACE_FUN_DEFAULT].cb == NULL || tracers[TRACE_FUN_ENABLED].cb == NULL ) { + return NULL; + } + + erts_smp_rwmtx_rwlock(&tracer_mtx); + tnif = hash_put(tracer_hash, &tnif_tmpl); + erts_smp_rwmtx_rwunlock(&tracer_mtx); + + return tnif; +} + +static ERTS_INLINE ErtsTracerNif * +lookup_tracer_nif(const ErtsTracer tracer) +{ + ErtsTracerNif tnif_tmpl; + ErtsTracerNif *tnif; + tnif_tmpl.module = ERTS_TRACER_MODULE(tracer); + erts_smp_rwmtx_rlock(&tracer_mtx); + if ((tnif = hash_get(tracer_hash, &tnif_tmpl)) == NULL) { + erts_smp_rwmtx_runlock(&tracer_mtx); + tnif = load_tracer_nif(tracer); + ASSERT(!tnif || tnif->nif_mod); + return tnif; + } + erts_smp_rwmtx_runlock(&tracer_mtx); + ASSERT(tnif->nif_mod); + return tnif; +} + +/* This function converts an Erlang tracer term to ErtsTracer. + It returns THE_NON_VALUE if an invalid tracer term was given. + Accepted input is: + pid() || port() || {prefix, pid()} || {prefix, port()} || + {prefix, atom(), term()} || {atom(), term()} + */ +ErtsTracer +erts_term_to_tracer(Eterm prefix, Eterm t) +{ + ErtsTracer tracer = erts_tracer_nil; + ASSERT(is_atom(prefix) || prefix == THE_NON_VALUE); + if (!is_nil(t)) { + Eterm module = am_erl_tracer, state = THE_NON_VALUE; + Eterm hp[2]; + if (is_tuple(t)) { + Eterm *tp = tuple_val(t); + if (prefix != THE_NON_VALUE) { + if (arityval(tp[0]) == 2 && tp[1] == prefix) + t = tp[2]; + else if (arityval(tp[0]) == 3 && tp[1] == prefix && is_atom(tp[2])) { + module = tp[2]; + state = tp[3]; + } + } else { + if (arityval(tp[0]) == 2 && is_atom(tp[2])) { + module = tp[1]; + state = tp[2]; + } + } + } + if (state == THE_NON_VALUE && (is_internal_pid(t) || is_internal_port(t))) + state = t; + if (state == THE_NON_VALUE) + return THE_NON_VALUE; + erts_tracer_update(&tracer, CONS(hp, module, state)); + } + if (!lookup_tracer_nif(tracer)) { + ASSERT(ERTS_TRACER_MODULE(tracer) != am_erl_tracer); + ERTS_TRACER_CLEAR(&tracer); + return THE_NON_VALUE; + } + return tracer; +} + +Eterm +erts_tracer_to_term(Process *p, ErtsTracer tracer) +{ + if (ERTS_TRACER_IS_NIL(tracer)) + return am_false; + if (ERTS_TRACER_MODULE(tracer) == am_erl_tracer) + /* Have to manage these specifically in order to be + backwards compatible */ + return ERTS_TRACER_STATE(tracer); + else { + Eterm *hp = HAlloc(p, 3); + return TUPLE2(hp, ERTS_TRACER_MODULE(tracer), + copy_object(ERTS_TRACER_STATE(tracer), p)); + } +} + + +static ERTS_INLINE int +send_to_tracer_nif_raw(Process *c_p, Process *tracee, + const ErtsTracer tracer, Uint tracee_flags, + Eterm t_p_id, ErtsTracerNif *tnif, + enum ErtsTracerOpt topt, + Eterm tag, Eterm msg, Eterm extra, Eterm pam_result) +{ + if (tnif || (tnif = lookup_tracer_nif(tracer)) != NULL) { +#define MAP_SIZE 3 + Eterm argv[6], local_heap[3+MAP_SIZE /* values */ + (MAP_SIZE+1 /* keys */)]; + flatmap_t *map = (flatmap_t*)(local_heap+(MAP_SIZE+1)); + Eterm *map_values = flatmap_get_values(map); + + topt = (tnif->tracers[topt].cb) ? topt : TRACE_FUN_DEFAULT; + ASSERT(topt < NIF_TRACER_TYPES); + + argv[0] = tag; + argv[1] = ERTS_TRACER_STATE(tracer); + argv[2] = t_p_id; + argv[3] = msg; + argv[4] = extra == THE_NON_VALUE ? am_undefined : extra; + argv[5] = make_flatmap(map); + + map->thing_word = MAP_HEADER_FLATMAP; + map->size = MAP_SIZE; + map->keys = TUPLE3(local_heap, am_match_spec_result, am_scheduler_id, am_timestamp); + + *map_values++ = pam_result; + if (tracee_flags & F_TRACE_SCHED_NO) + *map_values++ = make_small(erts_get_scheduler_id()); + else + *map_values++ = am_undefined; + if (tracee_flags & F_NOW_TS) +#ifdef HAVE_ERTS_NOW_CPU + if (erts_cpu_timestamp) + *map_values++ = am_cpu_timestamp; + else +#endif + *map_values++ = am_timestamp; + else if (tracee_flags & F_STRICT_MON_TS) + *map_values++ = am_strict_monotonic; + else if (tracee_flags & F_MON_TS) + *map_values++ = am_monotonic; + else + *map_values++ = am_undefined; + +#undef MAP_SIZE + erts_nif_call_function(c_p, tracee ? tracee : c_p, + tnif->nif_mod, + tnif->tracers[topt].cb, + tnif->tracers[topt].arity, + argv); + } + return 1; +} + +static ERTS_INLINE int +send_to_tracer_nif(Process *c_p, ErtsPTabElementCommon *t_p, + Eterm t_p_id, ErtsTracerNif *tnif, enum ErtsTracerOpt topt, + Eterm tag, Eterm msg, Eterm extra) +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) + if (c_p) { + /* We have to hold the main lock of the currently executing process */ + erts_proc_lc_chk_have_proc_locks(c_p, ERTS_PROC_LOCK_MAIN); + } + if (is_internal_pid(t_p->id)) { + /* We have to have at least one lock */ + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks((Process*)t_p) & ERTS_PROC_LOCKS_ALL); + } else { + ASSERT(is_internal_port(t_p->id)); + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked((Port*)t_p)); + } +#endif + + return send_to_tracer_nif_raw(c_p, + is_internal_pid(t_p->id) ? (Process*)t_p : NULL, + t_p->tracer, t_p->trace_flags, + t_p_id, tnif, topt, tag, msg, extra, + am_true); +} + +static ERTS_INLINE Eterm +call_enabled_tracer(Process *c_p, const ErtsTracer tracer, + ErtsTracerNif **tnif_ret, + enum ErtsTracerOpt topt, + Eterm tag, Eterm t_p_id) { + ErtsTracerNif *tnif = lookup_tracer_nif(tracer); + if (tnif) { + Eterm argv[] = {tag, ERTS_TRACER_STATE(tracer), t_p_id}; + topt = (tnif->tracers[topt].cb) ? topt : TRACE_FUN_ENABLED; + ASSERT(topt < NIF_TRACER_TYPES); + ASSERT(tnif->tracers[topt].cb != NULL); + if (tnif_ret) *tnif_ret = tnif; + return erts_nif_call_function(c_p, NULL, tnif->nif_mod, + tnif->tracers[topt].cb, + tnif->tracers[topt].arity, + argv); + } + return am_remove; +} + +static int +is_tracer_enabled(Process* c_p, ErtsProcLocks c_p_locks, + ErtsPTabElementCommon *t_p, + ErtsTracerNif **tnif_ret, + enum ErtsTracerOpt topt, Eterm tag) { + Eterm nif_result; + +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) + if (c_p) + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == c_p_locks + || erts_thr_progress_is_blocking()); + if (is_internal_pid(t_p->id)) { + /* We have to have at least one lock */ + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks((Process*)t_p) & ERTS_PROC_LOCKS_ALL + || erts_thr_progress_is_blocking()); + } else { + ASSERT(is_internal_port(t_p->id)); + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked((Port*)t_p) + || erts_thr_progress_is_blocking()); + } +#endif + + nif_result = call_enabled_tracer(c_p, t_p->tracer, tnif_ret, topt, tag, t_p->id); + switch (nif_result) { + case am_discard: return 0; + case am_trace: return 1; + case THE_NON_VALUE: + case am_remove: break; + default: + /* only am_remove should be returned, but if + something else is returned we fall-through + and remove the tracer. */ + ASSERT(0); + } + + /* Only remove tracer on self() and ports */ + if (is_internal_port(t_p->id) || (c_p && c_p->common.id == t_p->id)) { + ErtsProcLocks c_p_xlocks = 0; + if (is_internal_pid(t_p->id)) { + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) & ERTS_PROC_LOCK_MAIN); + if (c_p_locks != ERTS_PROC_LOCKS_ALL) { + c_p_xlocks = ~c_p_locks & ERTS_PROC_LOCKS_ALL; + if (erts_smp_proc_trylock(c_p, c_p_xlocks) == EBUSY) { + erts_smp_proc_unlock(c_p, c_p_locks & ~ERTS_PROC_LOCK_MAIN); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + } + } + } + erts_tracer_replace(t_p, erts_tracer_nil); + t_p->trace_flags &= ~TRACEE_FLAGS; + + if (c_p_xlocks) + erts_smp_proc_unlock(c_p, c_p_xlocks); + } + + return 0; +} + +int erts_is_tracer_proc_enabled(Process* c_p, ErtsProcLocks c_p_locks, + ErtsPTabElementCommon *t_p, Eterm type) +{ + return is_tracer_enabled(c_p, c_p_locks, t_p, NULL, TRACE_FUN_ENABLED, am_trace_status); +} + +int erts_is_tracer_enabled(Process *c_p, const ErtsTracer tracer) +{ + ErtsTracerNif *tnif = lookup_tracer_nif(tracer); + if (tnif) { + Eterm nif_result = call_enabled_tracer(c_p, tracer, &tnif, + TRACE_FUN_ENABLED, am_trace_status, + c_p->common.id); + switch (nif_result) { + case am_discard: + case am_trace: return 1; + default: + break; + } + } + return 0; +} + +void erts_tracer_replace(ErtsPTabElementCommon *t_p, const ErtsTracer tracer) +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) + if (is_internal_pid(t_p->id) && !erts_thr_progress_is_blocking()) { + erts_proc_lc_chk_have_proc_locks((Process*)t_p, ERTS_PROC_LOCKS_ALL); + } else if (is_internal_port(t_p->id)) { + ERTS_LC_ASSERT(erts_lc_is_port_locked((Port*)t_p) + || erts_thr_progress_is_blocking()); + } +#endif + if (ERTS_TRACER_COMPARE(t_p->tracer, tracer)) + return; + + erts_tracer_update(&t_p->tracer, tracer); +} + +static void free_tracer(void *p) +{ + ErtsTracer tracer = (ErtsTracer)p; + + if (is_immed(ERTS_TRACER_STATE(tracer))) { + erts_free(ERTS_ALC_T_HEAP_FRAG, ptr_val(tracer)); + } else { + ErlHeapFragment *hf = (void*)((char*)(ptr_val(tracer)) - offsetof(ErlHeapFragment, mem)); + free_message_buffer(hf); + } +} + +/* un-define erts_tracer_update before implementation */ +#ifdef erts_tracer_update +#undef erts_tracer_update +#endif + +/* + * ErtsTracer is either NIL, 'true' or [Mod | State] + * + * - If State is immediate then the memory for + * the cons cell is just two words + sizeof(ErtsThrPrgrLaterOp) large. + * - If State is a complex term then the cons cell + * is allocated in an ErlHeapFragment where the cons + * ptr points to the mem field. So in order to get the + * ptr to the fragment you do this: + * (char*)(ptr_val(tracer)) - offsetof(ErlHeapFragment, mem) + * Normally you shouldn't have to care about this though + * as erts_tracer_update takes care of it for you. + * + * When ErtsTracer is stored in the stack as part of a + * return trace, the cons cell is stored on the heap of + * the process. + * + * The cons cell is not always stored on the heap as: + * 1) for port/meta tracing there is no heap + * 2) we would need the main lock in order to + * read the tracer which is undesirable. + * + * One way to optimize this (memory wise) is to keep an refc and only bump + * the refc when *tracer is NIL. + */ +void +erts_tracer_update(ErtsTracer *tracer, const ErtsTracer new_tracer) +{ + ErlHeapFragment *hf; + + if (is_not_nil(*tracer)) { + Uint offs = 2; + UWord size = 2 * sizeof(Eterm) + sizeof(ErtsThrPrgrLaterOp); + ASSERT(is_list(*tracer)); + if (is_not_immed(ERTS_TRACER_STATE(*tracer))) { + hf = (void*)(((char*)(ptr_val(*tracer)) - offsetof(ErlHeapFragment, mem))); + offs = hf->used_size; + size = hf->alloc_size * sizeof(Eterm) + sizeof(ErlHeapFragment); + ASSERT(offs == size_object(*tracer)); + } + /* We schedule the free:ing of the tracer until after a thread progress + has been made so that we know that no schedulers have any references + to it. Because we do this, it is possible to release all locks of a + process/port and still use the ErtsTracer of that port/process + without having to worry if it is free'd. + */ + erts_schedule_thr_prgr_later_cleanup_op( + free_tracer, (void*)(*tracer), + (ErtsThrPrgrLaterOp*)(ptr_val(*tracer) + offs), + size); + } + + if (is_nil(new_tracer)) { + *tracer = new_tracer; + } else if (is_immed(ERTS_TRACER_STATE(new_tracer))) { + /* If tracer state is an immediate we only allocate a 2 Eterm heap. + Not sure if it is worth it, we save 4 words (sizeof(ErlHeapFragment)) + per tracer. */ + Eterm *hp = erts_alloc(ERTS_ALC_T_HEAP_FRAG, + 2*sizeof(Eterm) + sizeof(ErtsThrPrgrLaterOp)); + *tracer = CONS(hp, ERTS_TRACER_MODULE(new_tracer), + ERTS_TRACER_STATE(new_tracer)); + } else { + Eterm *hp, tracer_state = ERTS_TRACER_STATE(new_tracer), + tracer_module = ERTS_TRACER_MODULE(new_tracer); + Uint sz = size_object(tracer_state); + hf = new_message_buffer(sz + 2 /* cons cell */ + (sizeof(ErtsThrPrgrLaterOp)+sizeof(Eterm)-1)/sizeof(Eterm)); + hp = hf->mem + 2; + hf->used_size -= (sizeof(ErtsThrPrgrLaterOp)+sizeof(Eterm)-1)/sizeof(Eterm); + *tracer = copy_struct(tracer_state, sz, &hp, &hf->off_heap); + *tracer = CONS(hf->mem, tracer_module, *tracer); + ASSERT((void*)(((char*)(ptr_val(*tracer)) - offsetof(ErlHeapFragment, mem))) == hf); + } +} + +static void init_tracer_nif() +{ + erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER; + rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ; + rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED; + erts_smp_rwmtx_init_opt(&tracer_mtx, &rwmtx_opt, "tracer_mtx"); + + erts_tracer_nif_clear(); + +} + +int erts_tracer_nif_clear() +{ + + erts_smp_rwmtx_rlock(&tracer_mtx); + if (!tracer_hash || tracer_hash->nobjs) { + + HashFunctions hf; + hf.hash = tracer_hash_fun; + hf.cmp = tracer_cmp_fun; + hf.alloc = tracer_alloc_fun; + hf.free = tracer_free_fun; + hf.meta_alloc = (HMALLOC_FUN) erts_alloc; + hf.meta_free = (HMFREE_FUN) erts_free; + hf.meta_print = (HMPRINT_FUN) erts_print; + + erts_smp_rwmtx_runlock(&tracer_mtx); + erts_smp_rwmtx_rwlock(&tracer_mtx); + + if (tracer_hash) + hash_delete(tracer_hash); + + tracer_hash = hash_new(ERTS_ALC_T_TRACER_NIF, "tracer_hash", 10, hf); + + erts_smp_rwmtx_rwunlock(&tracer_mtx); + return 1; + } + + erts_smp_rwmtx_runlock(&tracer_mtx); + return 0; +} + +static int tracer_cmp_fun(void* a, void* b) +{ + return ((ErtsTracerNif*)a)->module != ((ErtsTracerNif*)b)->module; +} + +static HashValue tracer_hash_fun(void* obj) +{ + return make_internal_hash(((ErtsTracerNif*)obj)->module); +} + +static void *tracer_alloc_fun(void* tmpl) +{ + ErtsTracerNif *obj = erts_alloc(ERTS_ALC_T_TRACER_NIF, + sizeof(ErtsTracerNif) + + sizeof(ErtsThrPrgrLaterOp)); + memcpy(obj, tmpl, sizeof(*obj)); + return obj; +} + +static void tracer_free_fun_cb(void* obj) +{ + erts_free(ERTS_ALC_T_TRACER_NIF, obj); +} + +static void tracer_free_fun(void* obj) +{ + ErtsTracerNif *tnif = obj; + erts_schedule_thr_prgr_later_op( + tracer_free_fun_cb, obj, + (ErtsThrPrgrLaterOp*)(tnif + 1)); + +} diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h index a0058264d7..9a007e62ec 100644 --- a/erts/emulator/beam/erl_trace.h +++ b/erts/emulator/beam/erl_trace.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012-2013. All Rights Reserved. + * Copyright Ericsson AB 2012-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -46,6 +46,8 @@ #define ERTS_SEQTFLGS2TSTYPE(SEQTFLGS) \ ((int) (((SEQTFLGS) >> ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT) \ & ERTS_TRACE_TS_TYPE_MASK)) +#define ERTS_SEQTFLGS2TFLGS(SEQTFLGS) \ + (ERTS_SEQTFLGS2TSTYPE(SEQTFLGS) << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT) #endif /* ERL_TRACE_H__FLAGS__ */ @@ -62,15 +64,19 @@ void erts_system_profile_clear(Process *c_p); /* erl_trace.c */ void erts_init_trace(void); void erts_trace_check_exiting(Eterm exiting); -Eterm erts_set_system_seq_tracer(Process *c_p, - ErtsProcLocks c_p_locks, - Eterm new); -Eterm erts_get_system_seq_tracer(void); -void erts_change_default_tracing(int setflags, Uint *flagsp, Eterm *tracerp); -void erts_get_default_tracing(Uint *flagsp, Eterm *tracerp); +ErtsTracer erts_set_system_seq_tracer(Process *c_p, + ErtsProcLocks c_p_locks, + ErtsTracer new); +ErtsTracer erts_get_system_seq_tracer(void); +void erts_change_default_proc_tracing(int setflags, Uint flagsp, + const ErtsTracer tracerp); +void erts_get_default_proc_tracing(Uint *flagsp, ErtsTracer *tracerp); +void erts_change_default_port_tracing(int setflags, Uint flagsp, + const ErtsTracer tracerp); +void erts_get_default_port_tracing(Uint *flagsp, ErtsTracer *tracerp); void erts_set_system_monitor(Eterm monitor); Eterm erts_get_system_monitor(void); -int erts_is_tracer_proc_valid(Process* p); +int erts_is_tracer_valid(Process* p); #ifdef ERTS_SMP void erts_check_my_tracer_proc(Process *); @@ -81,28 +87,32 @@ void erts_foreach_sys_msg_in_q(void (*func)(Eterm, Eterm, ErlHeapFragment *)); void erts_queue_error_logger_message(Eterm, Eterm, ErlHeapFragment *); +void erts_send_sys_msg_proc(Eterm, Eterm, Eterm, ErlHeapFragment *); #endif -void erts_send_sys_msg_proc(Eterm, Eterm, Eterm, ErlHeapFragment *); void trace_send(Process*, Eterm, Eterm); -void trace_receive(Process*, Eterm); -Uint32 erts_call_trace(Process *p, BeamInstr mfa[], struct binary *match_spec, Eterm* args, - int local, Eterm *tracer_pid); -void erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid); +void trace_receive(Process *, Eterm); +Uint32 erts_call_trace(Process *p, BeamInstr mfa[], struct binary *match_spec, + Eterm* args, int local, ErtsTracer *tracer); +void erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, + ErtsTracer *tracer); void erts_trace_exception(Process* p, BeamInstr mfa[], Eterm class, Eterm value, - Eterm *tracer); + ErtsTracer *tracer); void erts_trace_return_to(Process *p, BeamInstr *pc); -void trace_sched(Process*, Eterm); -void trace_proc(Process*, Process*, Eterm, Eterm); -void trace_proc_spawn(Process*, Eterm pid, Eterm mod, Eterm func, Eterm args); +void trace_sched(Process*, ErtsProcLocks, Eterm); +void trace_proc(Process*, ErtsProcLocks, Process*, Eterm, Eterm); +void trace_proc_spawn(Process*, Eterm what, Eterm pid, Eterm mod, Eterm func, Eterm args); void save_calls(Process *p, Export *); -void trace_gc(Process *p, Eterm what); +void trace_gc(Process *p, Eterm what, Uint size); /* port tracing */ -void trace_virtual_sched(Process*, Eterm); +void trace_virtual_sched(Process*, ErtsProcLocks, Eterm); void trace_sched_ports(Port *pp, Eterm); void trace_sched_ports_where(Port *pp, Eterm, Eterm); void trace_port(Port *, Eterm what, Eterm data); void trace_port_open(Port *, Eterm calling_pid, Eterm drv_name); +void trace_port_receive(Port *, Eterm calling_pid, Eterm tag, ...); +void trace_port_send(Port *, Eterm to, Eterm msg, int exists); +void trace_port_send_binary(Port *, Eterm to, Eterm what, char *bin, Sint sz); /* system_profile */ void erts_set_system_profile(Eterm profile); @@ -121,7 +131,7 @@ void monitor_large_heap(Process *p); void monitor_generic(Process *p, Eterm type, Eterm spec); Uint erts_trace_flag2bit(Eterm flag); int erts_trace_flags(Eterm List, - Uint *pMask, Eterm *pTracer, int *pCpuTimestamp); + Uint *pMask, ErtsTracer *pTracer, int *pCpuTimestamp); Eterm erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr *I); #ifdef ERTS_SMP @@ -161,15 +171,53 @@ int erts_set_trace_pattern(Process*p, Eterm* mfa, int specified, struct binary* match_prog_set, struct binary *meta_match_prog_set, int on, struct trace_pattern_flags, - Eterm meta_tracer_pid, int is_blocking); + ErtsTracer meta_tracer, int is_blocking); void erts_get_default_trace_pattern(int *trace_pattern_is_on, struct binary **match_spec, struct binary **meta_match_spec, struct trace_pattern_flags *trace_pattern_flags, - Eterm *meta_tracer_pid); + ErtsTracer *meta_tracer); int erts_is_default_trace_enabled(void); void erts_bif_trace_init(void); int erts_finish_breakpointing(void); +/* Nif tracer functions */ +int erts_is_tracer_proc_enabled(Process *c_p, ErtsProcLocks c_p_locks, + ErtsPTabElementCommon *t_p, Eterm type); +int erts_is_tracer_enabled(Process *c_p, const ErtsTracer tracer); +Eterm erts_tracer_to_term(Process *p, ErtsTracer tracer); +ErtsTracer erts_term_to_tracer(Eterm prefix, Eterm term); +void erts_tracer_replace(ErtsPTabElementCommon *t_p, + const ErtsTracer new_tracer); +void erts_tracer_update(ErtsTracer *tracer, const ErtsTracer new_tracer); +int erts_tracer_nif_clear(void); + +#define erts_tracer_update(t,n) do { if (*(t) != (n)) erts_tracer_update(t,n); } while(0) +#define ERTS_TRACER_CLEAR(t) erts_tracer_update(t, erts_tracer_nil) + +static const ErtsTracer +ERTS_DECLARE_DUMMY(erts_tracer_true) = am_true; + +static const ErtsTracer +ERTS_DECLARE_DUMMY(erts_tracer_nil) = NIL; + +#define ERTS_TRACER_COMPARE(t1, t2) \ + (EQ((t1), (t2))) + +#define ERTS_TRACER_IS_NIL(t1) ERTS_TRACER_COMPARE(t1, erts_tracer_nil) + +#define IS_TRACER_VALID(tracer) \ + (ERTS_TRACER_COMPARE(tracer,erts_tracer_true) \ + || ERTS_TRACER_IS_NIL(tracer) \ + || (is_list(tracer) && is_atom(CAR(list_val(tracer))))) + +#define ERTS_TRACER_FROM_ETERM(termp) \ + ((ErtsTracer*)(termp)) + +#define ERTS_TRACER_PROC_IS_ENABLED(PROC) \ + (!ERTS_TRACER_IS_NIL(ERTS_TRACER(PROC)) \ + && erts_is_tracer_proc_enabled(PROC, ERTS_PROC_LOCK_MAIN, \ + &(PROC)->common, am_trace_status)) + #endif /* ERL_TRACE_H__ */ diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index 36d85b0a22..3c3536c021 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2013. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_unicode.h b/erts/emulator/beam/erl_unicode.h index 4c25d89b7c..e01eaa787e 100644 --- a/erts/emulator/beam/erl_unicode.h +++ b/erts/emulator/beam/erl_unicode.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_unicode_normalize.h b/erts/emulator/beam/erl_unicode_normalize.h index 16c62db50e..21e2a52544 100644 --- a/erts/emulator/beam/erl_unicode_normalize.h +++ b/erts/emulator/beam/erl_unicode_normalize.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2010. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h index 6dab3bf297..81800752f0 100644 --- a/erts/emulator/beam/erl_utils.h +++ b/erts/emulator/beam/erl_utils.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012-2014. All Rights Reserved. + * Copyright Ericsson AB 2012-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -115,7 +115,7 @@ 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); +Sint erts_list_length(Eterm); int erts_is_builtin(Eterm, Eterm, int); Uint32 make_broken_hash(Eterm); Uint32 block_hash(byte *, unsigned, Uint32); @@ -157,51 +157,46 @@ void erts_init_utils_mem(void); erts_dsprintf_buf_t *erts_create_tmp_dsbuf(Uint); void erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *); -#if HALFWORD_HEAP -int eq_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base); -# define eq(A,B) eq_rel(A,NULL,B,NULL) -#else int eq(Eterm, Eterm); -# define eq_rel(A,A_BASE,B,B_BASE) eq(A,B) -#endif #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, 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 +int erts_cmp_atoms(Eterm a, Eterm b); Sint erts_cmp(Eterm, Eterm, int, int); +Sint erts_cmp_compound(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_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) - -#define cmp_lt_term(a,b) (CMP_TERM((a),(b)) < 0) -#define cmp_le_term(a,b) (CMP_TERM((a),(b)) <= 0) -#define cmp_ge_term(a,b) (CMP_TERM((a),(b)) >= 0) -#define cmp_gt_term(a,b) (CMP_TERM((a),(b)) > 0) - -#define CMP_LT(a,b) ((a) != (b) && cmp_lt((a),(b))) -#define CMP_GE(a,b) ((a) == (b) || cmp_ge((a),(b))) -#define CMP_EQ(a,b) ((a) == (b) || cmp_eq((a),(b))) -#define CMP_NE(a,b) ((a) != (b) && cmp_ne((a),(b))) - -#define CMP_LT_TERM(a,b) ((a) != (b) && cmp_lt_term((a),(b))) -#define CMP_GE_TERM(a,b) ((a) == (b) || cmp_ge_term((a),(b))) +#define CMP_LT(a,b) ((a) != (b) && CMP((a),(b)) < 0) +#define CMP_LE(a,b) ((a) == (b) || CMP((a),(b)) <= 0) +#define CMP_EQ(a,b) ((a) == (b) || CMP_EQ_ONLY((a),(b)) == 0) +#define CMP_NE(a,b) ((a) != (b) && CMP_EQ_ONLY((a),(b)) != 0) +#define CMP_GE(a,b) ((a) == (b) || CMP((a),(b)) >= 0) +#define CMP_GT(a,b) ((a) != (b) && CMP((a),(b)) > 0) + +#define CMP_EQ_ACTION(X,Y,Action) \ + if ((X) != (Y)) { CMP_SPEC((X),(Y),!=,Action,1); } +#define CMP_NE_ACTION(X,Y,Action) \ + if ((X) == (Y)) { Action; } else { CMP_SPEC((X),(Y),==,Action,1); } +#define CMP_GE_ACTION(X,Y,Action) \ + if ((X) != (Y)) { CMP_SPEC((X),(Y),<,Action,0); } +#define CMP_LT_ACTION(X,Y,Action) \ + if ((X) == (Y)) { Action; } else { CMP_SPEC((X),(Y),>=,Action,0); } + +#define CMP_SPEC(X,Y,Op,Action,EqOnly) \ + if (is_atom(X) && is_atom(Y)) { \ + if (erts_cmp_atoms(X, Y) Op 0) { Action; }; \ + } else if (is_both_small(X, Y)) { \ + if (signed_val(X) Op signed_val(Y)) { Action; }; \ + } else if (is_float(X) && is_float(Y)) { \ + FloatDef af, bf; \ + GET_DOUBLE(X, af); \ + GET_DOUBLE(Y, bf); \ + if (af.fd Op bf.fd) { Action; }; \ + } else { \ + if (erts_cmp_compound(X,Y,0,EqOnly) Op 0) { Action; }; \ + } #endif diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index 8948ca2ea9..f3c54de214 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -40,14 +40,6 @@ #define MAX_ARG 255 /* Max number of arguments allowed */ #define MAX_REG 1024 /* Max number of x(N) registers used */ -/* Scheduler stores data for temporary heaps if - !HEAP_ON_C_STACK. Macros (*TmpHeap*) in global.h selects if we put temporary - heap data on the C stack or if we use the buffers in the scheduler data. */ -#define TMP_HEAP_SIZE 128 /* Number of Eterm in the schedulers - small heap for transient heap data */ -#define ERL_ARITH_TMP_HEAP_SIZE 4 /* as does erl_arith... */ -#define BEAM_EMU_TMP_HEAP_SIZE 2 /* and beam_emu... */ - /* * The new arithmetic operations need some extra X registers in the register array. * so does the gc_bif's (i_gc_bif3 need 3 extra). @@ -117,12 +109,8 @@ #define HeapWordsLeft(p) (HEAP_LIMIT(p) - HEAP_TOP(p)) #if defined(DEBUG) || defined(CHECK_FOR_HOLES) -#if HALFWORD_HEAP -# define ERTS_HOLE_MARKER (0xdeadbeef) -#else # define ERTS_HOLE_MARKER (((0xdeadbeef << 24) << 8) | 0xdeadbeef) -#endif -#endif +#endif /* egil: 32-bit ? */ /* * Allocate heap memory on the ordinary heap, NEVER in a heap @@ -153,6 +141,7 @@ typedef struct op_entry { char* name; /* Name of instruction. */ Uint32 mask[3]; /* Signature mask. */ + unsigned involves_r; /* Needs special attention when matching. */ int sz; /* Number of loaded words. */ char* pack; /* Instructions for packing engine. */ char* sign; /* Signature string. */ @@ -176,7 +165,6 @@ extern int erts_atom_table_size;/* Atom table size */ extern int erts_pd_initial_size;/* Initial Process dictionary table size */ #define ORIG_CREATION 0 -#define INTERNAL_CREATION 255 /* macros for extracting bytes from uint16's */ diff --git a/erts/emulator/beam/erl_zlib.c b/erts/emulator/beam/erl_zlib.c index e44e86c39c..944ff2e35f 100644 --- a/erts/emulator/beam/erl_zlib.c +++ b/erts/emulator/beam/erl_zlib.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2013. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erl_zlib.h b/erts/emulator/beam/erl_zlib.h index 2ca1e3735e..c83c6f291f 100644 --- a/erts/emulator/beam/erl_zlib.h +++ b/erts/emulator/beam/erl_zlib.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2013. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/erlang_dtrace.d b/erts/emulator/beam/erlang_dtrace.d index c682f76e3a..237889e0f5 100644 --- a/erts/emulator/beam/erlang_dtrace.d +++ b/erts/emulator/beam/erlang_dtrace.d @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Dustin Sallings, Michal Ptaszek, Scott Lystig Fritchie 2011-2012. + * Copyright Dustin Sallings, Michal Ptaszek, Scott Lystig Fritchie 2011-2016. * All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); @@ -700,6 +700,35 @@ provider erlang { */ probe efile_drv__return(int, int, char *, int, int, int); + +/* + * The set of probes called by the erlang tracer nif backend. In order + * to receive events on these you both have to enable tracing in erlang + * using the trace bifs and also from dtrace/systemtap. + */ + + + /** + * A trace message of type `event` was triggered by process `p`. + * + * + * @param p the PID (string form) of the process + * @param event the event that was triggered (i.e. call or spawn) + * @param state the state of the tracer nif as a string + * @param arg1 first argument to the trace event + * @param arg2 second argument to the trace event + */ + probe trace(char *p, char *event, char *state, char *arg1, char *arg2); + + /** + * A sequence trace message of type `label` was triggered. + * + * @param state the state of the tracer nif as a string + * @param label the seq trace label + * @param seq_info the seq trace info tuple as a string + */ + probe trace_seq(char *state, char *label, char *seq_info); + /* * NOTE: * For formatting int64_t arguments within a D script, see: diff --git a/erts/etc/ose/run_erl.h b/erts/emulator/beam/erlang_lttng.c index bdc8b6c355..fce40eedc1 100644 --- a/erts/etc/ose/run_erl.h +++ b/erts/emulator/beam/erlang_lttng.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -17,14 +17,16 @@ * * %CopyrightEnd% */ -#ifndef ERL_RUN_ERL_H -#define ERL_RUN_ERL_H - -#include "ose.h" - -#include "erts.sig" - -int run_erl(int argc, char **argv); -OS_PROCESS(run_erl_process); +#ifdef HAVE_CONFIG_H +# include "config.h" #endif + +#ifdef USE_LTTNG +#define TRACEPOINT_CREATE_PROBES +/* + * The header containing our TRACEPOINT_EVENTs. + */ +#define TRACEPOINT_DEFINE +#include "erlang_lttng.h" +#endif /* USE_LTTNG */ diff --git a/erts/emulator/beam/erlang_lttng.h b/erts/emulator/beam/erlang_lttng.h new file mode 100644 index 0000000000..12f68e477b --- /dev/null +++ b/erts/emulator/beam/erlang_lttng.h @@ -0,0 +1,424 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2016. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifdef USE_LTTNG +#undef TRACEPOINT_PROVIDER +#define TRACEPOINT_PROVIDER com_ericsson_otp + +#undef TRACEPOINT_INCLUDE +#define TRACEPOINT_INCLUDE "erlang_lttng.h" + +#if !defined(__ERLANG_LTTNG_H__) || defined(TRACEPOINT_HEADER_MULTI_READ) +#define __ERLANG_LTTNG_H__ + +#include <lttng/tracepoint.h> + +/* Schedulers */ + +TRACEPOINT_EVENT( + com_ericsson_otp, + scheduler_poll, + TP_ARGS( + int, id, + int, runnable + ), + TP_FIELDS( + ctf_integer(int, scheduler, id) + ctf_integer(int, runnable, runnable) + ) +) + +#ifndef LTTNG_CARRIER_STATS +#define LTTNG_CARRIER_STATS +typedef struct { + unsigned long no; + unsigned long size; +} lttng_stat_values_t; + +typedef struct { + lttng_stat_values_t carriers; + lttng_stat_values_t blocks; +} lttng_carrier_stats_t; +#endif + + +/* Port and Driver Scheduling */ + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_start, + TP_ARGS( + char*, pid, + char*, driver, + char*, port + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(driver, driver) + ctf_string(port, port) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_init, + TP_ARGS( + char*, driver, + int, major, + int, minor, + int, flags + ), + TP_FIELDS( + ctf_string(driver, driver) + ctf_integer(int, major, major) + ctf_integer(int, minor, minor) + ctf_integer(int, flags, flags) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_outputv, + TP_ARGS( + char*, pid, + char*, port, + char*, driver, + size_t, bytes + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ctf_integer(size_t, bytes, bytes) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_output, + TP_ARGS( + char*, pid, + char*, port, + char*, driver, + size_t, bytes + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ctf_integer(size_t, bytes, bytes) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_ready_input, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_ready_output, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_event, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_timeout, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_stop_select, + TP_ARGS( + char*, driver + ), + TP_FIELDS( + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_flush, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_stop, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_process_exit, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_ready_async, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_finish, + TP_ARGS( + char*, driver + ), + TP_FIELDS( + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_call, + TP_ARGS( + char*, pid, + char*, port, + char*, driver, + unsigned int, command, + size_t, bytes + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ctf_integer(unsigned int, command, command) + ctf_integer(size_t, bytes, bytes) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_control, + TP_ARGS( + char*, pid, + char*, port, + char*, driver, + unsigned int, command, + size_t, bytes + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ctf_integer(unsigned int, command, command) + ctf_integer(size_t, bytes, bytes) + ) +) + +/* Async pool */ + +TRACEPOINT_EVENT( + com_ericsson_otp, + aio_pool_get, + TP_ARGS( + char*, port, + int, length + ), + TP_FIELDS( + ctf_string(port, port) + ctf_integer(int, length, length) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + aio_pool_put, + TP_ARGS( + char*, port, + int, length + ), + TP_FIELDS( + ctf_string(port, port) + ctf_integer(int, length, length) + ) +) + + +/* Memory Allocator */ + +TRACEPOINT_EVENT( + com_ericsson_otp, + carrier_create, + TP_ARGS( + const char*, type, + int, instance, + unsigned long, size, + lttng_carrier_stats_t *, mbcs, + lttng_carrier_stats_t *, sbcs + ), + TP_FIELDS( + ctf_string(type, type) + ctf_integer(int, instance, instance) + ctf_integer(unsigned long, size, size) + ctf_integer(unsigned long, mbc_carriers, mbcs->carriers.no) + ctf_integer(unsigned long, mbc_carriers_size, mbcs->carriers.size) + ctf_integer(unsigned long, mbc_blocks, mbcs->blocks.no) + ctf_integer(unsigned long, mbc_blocks_size, mbcs->blocks.size) + ctf_integer(unsigned long, sbc_carriers, sbcs->carriers.no) + ctf_integer(unsigned long, sbc_carriers_size, sbcs->carriers.size) + ctf_integer(unsigned long, sbc_blocks, sbcs->blocks.no) + ctf_integer(unsigned long, sbc_blocks_size, sbcs->blocks.size) + ) +) + + +TRACEPOINT_EVENT( + com_ericsson_otp, + carrier_destroy, + TP_ARGS( + const char*, type, + int, instance, + unsigned long, size, + lttng_carrier_stats_t *, mbcs, + lttng_carrier_stats_t *, sbcs + ), + TP_FIELDS( + ctf_string(type, type) + ctf_integer(int, instance, instance) + ctf_integer(unsigned long, size, size) + ctf_integer(unsigned long, mbc_carriers, mbcs->carriers.no) + ctf_integer(unsigned long, mbc_carriers_size, mbcs->carriers.size) + ctf_integer(unsigned long, mbc_blocks, mbcs->blocks.no) + ctf_integer(unsigned long, mbc_blocks_size, mbcs->blocks.size) + ctf_integer(unsigned long, sbc_carriers, sbcs->carriers.no) + ctf_integer(unsigned long, sbc_carriers_size, sbcs->carriers.size) + ctf_integer(unsigned long, sbc_blocks, sbcs->blocks.no) + ctf_integer(unsigned long, sbc_blocks_size, sbcs->blocks.size) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + carrier_pool_put, + TP_ARGS( + const char*, name, + int, instance, + unsigned long, size + ), + TP_FIELDS( + ctf_string(type, name) + ctf_integer(int, instance, instance) + ctf_integer(unsigned long, size, size) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + carrier_pool_get, + TP_ARGS( + const char*, name, + int, instance, + unsigned long, size + ), + TP_FIELDS( + ctf_string(type, name) + ctf_integer(int, instance, instance) + ctf_integer(unsigned long, size, size) + ) +) + +#endif /* __ERLANG_LTTNG_H__ */ +#include <lttng/tracepoint-event.h> +#endif /* USE_LTTNG */ diff --git a/erts/emulator/beam/error.h b/erts/emulator/beam/error.h index cba8672c68..6c33b12dd0 100644 --- a/erts/emulator/beam/error.h +++ b/erts/emulator/beam/error.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c index 2420df36b5..02c24557c1 100644 --- a/erts/emulator/beam/export.c +++ b/erts/emulator/beam/export.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -184,6 +184,9 @@ init_export_table(void) f.cmp = (HCMP_FUN) export_cmp; f.alloc = (HALLOC_FUN) export_alloc; f.free = (HFREE_FUN) export_free; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; for (i=0; i<ERTS_NUM_CODE_IX; i++) { erts_index_init(ERTS_ALC_T_EXPORT_TABLE, &export_tables[i], "export_list", diff --git a/erts/emulator/beam/export.h b/erts/emulator/beam/export.h index a8bc9d2f66..8c81cbd410 100644 --- a/erts/emulator/beam/export.h +++ b/erts/emulator/beam/export.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index ffe3303796..3c002d43a7 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -51,7 +51,18 @@ #define MAX_STRING_LEN 0xffff -#define is_valid_creation(Cre) ((unsigned)(Cre) < MAX_CREATION || (Cre) == INTERNAL_CREATION) +/* MAX value for the creation field in pid, port and reference + for the local node and for the current external format. + + Larger creation values than this are allowed in external pid, port and refs + encoded with NEW_PID_EXT, NEW_PORT_EXT and NEWER_REFERENCE_EXT. + The point here is to prepare for future upgrade to 32-bit creation. + OTP-19 (erts-8.0) can handle big creation values from other (newer) nodes, + but do not use big creation values for the local node yet, + as we still may have to communicate with older nodes. +*/ +#define ERTS_MAX_LOCAL_CREATION (3) +#define is_valid_creation(Cre) ((unsigned)(Cre) <= ERTS_MAX_LOCAL_CREATION) #undef ERTS_DEBUG_USE_DIST_SEP #ifdef DEBUG @@ -97,7 +108,7 @@ static byte* enc_pid(ErtsAtomCacheMap *, Eterm, byte*, Uint32); struct B2TContext_t; static byte* dec_term(ErtsDistExternal*, ErtsHeapFactory*, byte*, Eterm*, struct B2TContext_t*); static byte* dec_atom(ErtsDistExternal *, byte*, Eterm*); -static byte* dec_pid(ErtsDistExternal *, ErtsHeapFactory*, byte*, Eterm*); +static byte* dec_pid(ErtsDistExternal *, ErtsHeapFactory*, byte*, Eterm*, byte tag); static Sint decoded_size(byte *ep, byte* endp, int internal_tags, struct B2TContext_t*); static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1); @@ -967,19 +978,24 @@ erts_decode_dist_ext(ErtsHeapFactory* factory, return THE_NON_VALUE; } -Eterm erts_decode_ext(ErtsHeapFactory* factory, byte **ext) +Eterm erts_decode_ext(ErtsHeapFactory* factory, byte **ext, Uint32 flags) { + ErtsDistExternal ede, *edep; Eterm obj; byte *ep = *ext; if (*ep++ != VERSION_MAGIC) { erts_factory_undo(factory); return THE_NON_VALUE; } - ep = dec_term(NULL, factory, ep, &obj, NULL); + if (flags) { + ASSERT(flags == ERTS_DIST_EXT_BTT_SAFE); + ede.flags = flags; /* a dummy struct just for the flags */ + edep = &ede; + } else { + edep = NULL; + } + ep = dec_term(edep, factory, ep, &obj, NULL); if (!ep) { -#ifdef DEBUG - bin_write(ERTS_PRINT_STDERR,NULL,*ext,500); -#endif return THE_NON_VALUE; } *ext = ep; @@ -2147,12 +2163,13 @@ static byte* enc_pid(ErtsAtomCacheMap *acmp, Eterm pid, byte* ep, Uint32 dflags) { Uint on, os; + Eterm sysname = ((is_internal_pid(pid) && (dflags & DFLAG_INTERNAL_TAGS)) + ? am_Empty : pid_node_name(pid)); + Uint32 creation = pid_creation(pid); + byte* tagp = ep++; - *ep++ = PID_EXT; /* insert atom here containing host and sysname */ - ep = enc_atom(acmp, pid_node_name(pid), ep, dflags); - - /* two bytes for each number and serial */ + ep = enc_atom(acmp, sysname, ep, dflags); on = pid_number(pid); os = pid_serial(pid); @@ -2161,8 +2178,15 @@ enc_pid(ErtsAtomCacheMap *acmp, Eterm pid, byte* ep, Uint32 dflags) ep += 4; put_int32(os, ep); ep += 4; - *ep++ = (is_internal_pid(pid) && (dflags & DFLAG_INTERNAL_TAGS)) ? - INTERNAL_CREATION : pid_creation(pid); + if (creation <= ERTS_MAX_LOCAL_CREATION) { + *tagp = PID_EXT; + *ep++ = creation; + } else { + ASSERT(is_external_pid(pid)); + *tagp = NEW_PID_EXT; + put_int32(creation, ep); + ep += 4; + } return ep; } @@ -2242,27 +2266,27 @@ dec_atom(ErtsDistExternal *edep, byte* ep, Eterm* objp) return ep; } -static ERTS_INLINE ErlNode* dec_get_node(Eterm sysname, Uint creation) +static ERTS_INLINE ErlNode* dec_get_node(Eterm sysname, Uint32 creation) { - switch (creation) { - case INTERNAL_CREATION: + if (sysname == am_Empty) /* && DFLAG_INTERNAL_TAGS */ return erts_this_node; - case ORIG_CREATION: - if (sysname == erts_this_node->sysname) { - creation = erts_this_node->creation; - } - } + + if (sysname == erts_this_node->sysname + && (creation == erts_this_node->creation || creation == ORIG_CREATION)) + return erts_this_node; + return erts_find_or_insert_node(sysname,creation); } static byte* -dec_pid(ErtsDistExternal *edep, ErtsHeapFactory* factory, byte* ep, Eterm* objp) +dec_pid(ErtsDistExternal *edep, ErtsHeapFactory* factory, byte* ep, + Eterm* objp, byte tag) { Eterm sysname; Uint data; Uint num; Uint ser; - Uint cre; + Uint32 cre; ErlNode *node; *objp = NIL; /* In case we fail, don't leave a hole in the heap */ @@ -2278,12 +2302,19 @@ dec_pid(ErtsDistExternal *edep, ErtsHeapFactory* factory, byte* ep, Eterm* objp) ep += 4; if (ser > ERTS_MAX_PID_SERIAL) return NULL; - cre = get_int8(ep); - ep += 1; - if (!is_valid_creation(cre)) { - return NULL; + if (tag == PID_EXT) { + cre = get_int8(ep); + ep += 1; + if (!is_valid_creation(cre)) { + return NULL; + } + } else { + ASSERT(tag == NEW_PID_EXT); + cre = get_int32(ep); + ep += 4; } + data = make_pid_data(ser, num); /* @@ -2339,10 +2370,6 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Eterm val; FloatDef f; Sint r = 0; -#if HALFWORD_HEAP - UWord wobj; -#endif - if (ctx) { WSTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK); @@ -2362,11 +2389,8 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, outer_loop: while (!WSTACK_ISEMPTY(s)) { -#if HALFWORD_HEAP - obj = (Eterm) (wobj = WSTACK_POP(s)); -#else obj = WSTACK_POP(s); -#endif + switch (val = WSTACK_POP(s)) { case ENC_TERM: break; @@ -2384,11 +2408,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, break; case ENC_PATCH_FUN_SIZE: { -#if HALFWORD_HEAP - byte* size_p = (byte *) wobj; -#else byte* size_p = (byte *) obj; -#endif put_int32(ep - size_p, size_p); } goto outer_loop; @@ -2435,21 +2455,13 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, case ENC_LAST_ARRAY_ELEMENT: /* obj is the tuple */ { -#if HALFWORD_HEAP - Eterm* ptr = (Eterm *) wobj; -#else Eterm* ptr = (Eterm *) obj; -#endif obj = *ptr; } break; default: /* ENC_LAST_ARRAY_ELEMENT+1 and upwards */ { -#if HALFWORD_HEAP - Eterm* ptr = (Eterm *) wobj; -#else Eterm* ptr = (Eterm *) obj; -#endif obj = *ptr++; WSTACK_PUSH2(s, val-1, (UWord)ptr); } @@ -2542,16 +2554,26 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, case REF_DEF: case EXTERNAL_REF_DEF: { Uint32 *ref_num; + Eterm sysname = (((dflags & DFLAG_INTERNAL_TAGS) && is_internal_ref(obj)) + ? am_Empty : ref_node_name(obj)); + Uint32 creation = ref_creation(obj); + byte* tagp = ep++; ASSERT(dflags & DFLAG_EXTENDED_REFERENCES); - *ep++ = NEW_REFERENCE_EXT; i = ref_no_of_numbers(obj); put_int16(i, ep); ep += 2; - ep = enc_atom(acmp,ref_node_name(obj),ep,dflags); - *ep++ = ((dflags & DFLAG_INTERNAL_TAGS) && is_internal_ref(obj)) ? - INTERNAL_CREATION : ref_creation(obj); + ep = enc_atom(acmp, sysname, ep, dflags); + if (creation <= ERTS_MAX_LOCAL_CREATION) { + *tagp = NEW_REFERENCE_EXT; + *ep++ = creation; + } else { + ASSERT(is_external_ref(obj)); + *tagp = NEWER_REFERENCE_EXT; + put_int32(creation, ep); + ep += 4; + } ref_num = ref_numbers(obj); for (j = 0; j < i; j++) { put_int32(ref_num[j], ep); @@ -2560,17 +2582,27 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, break; } case PORT_DEF: - case EXTERNAL_PORT_DEF: + case EXTERNAL_PORT_DEF: { + Eterm sysname = (((dflags & DFLAG_INTERNAL_TAGS) && is_internal_port(obj)) + ? am_Empty : port_node_name(obj)); + Uint32 creation = port_creation(obj); + byte* tagp = ep++; - *ep++ = PORT_EXT; - ep = enc_atom(acmp,port_node_name(obj),ep,dflags); + ep = enc_atom(acmp, sysname, ep, dflags); j = port_number(obj); put_int32(j, ep); ep += 4; - *ep++ = ((dflags & DFLAG_INTERNAL_TAGS) && is_internal_port(obj)) ? - INTERNAL_CREATION : port_creation(obj); + if (creation <= ERTS_MAX_LOCAL_CREATION) { + *tagp = PORT_EXT; + *ep++ = creation; + } else { + ASSERT(is_external_port(obj)); + *tagp = NEW_PORT_EXT; + put_int32(creation, ep); + ep += 4; + } break; - + } case LIST_DEF: { int is_str; @@ -2976,7 +3008,7 @@ dec_term(ErtsDistExternal *edep, case B2TDecodeList: objp = next - 2; while (n > 0) { - objp[0] = (Eterm) COMPRESS_POINTER(next); + objp[0] = (Eterm) next; objp[1] = make_list(next); next = objp; objp -= 2; @@ -2987,7 +3019,7 @@ dec_term(ErtsDistExternal *edep, case B2TDecodeTuple: objp = next - 1; while (n-- > 0) { - objp[0] = (Eterm) COMPRESS_POINTER(next); + objp[0] = (Eterm) next; next = objp; objp--; } @@ -3043,7 +3075,7 @@ dec_term(ErtsDistExternal *edep, while (next != NULL) { objp = next; - next = (Eterm *) EXPAND_POINTER(*objp); + next = (Eterm *) *objp; switch (*ep++) { case INTEGER_EXT: @@ -3051,7 +3083,7 @@ dec_term(ErtsDistExternal *edep, Sint sn = get_int32(ep); ep += 4; -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) *objp = make_small(sn); #else if (MY_IS_SSMALL(sn)) { @@ -3174,7 +3206,7 @@ dec_term_atom_common: reds -= n; } while (n-- > 0) { - objp[0] = (Eterm) COMPRESS_POINTER(next); + objp[0] = (Eterm) next; next = objp; objp--; } @@ -3192,8 +3224,8 @@ dec_term_atom_common: *objp = make_list(hp); hp += 2 * n; objp = hp - 2; - objp[0] = (Eterm) COMPRESS_POINTER((objp+1)); - objp[1] = (Eterm) COMPRESS_POINTER(next); + objp[0] = (Eterm) (objp+1); + objp[1] = (Eterm) next; next = objp; objp -= 2; n--; @@ -3206,7 +3238,7 @@ dec_term_atom_common: reds -= n; } while (n > 0) { - objp[0] = (Eterm) COMPRESS_POINTER(next); + objp[0] = (Eterm) next; objp[1] = make_list(next); next = objp; objp -= 2; @@ -3274,20 +3306,23 @@ dec_term_atom_common: hp += FLOAT_SIZE_OBJECT; break; } - case PID_EXT: + case PID_EXT: + case NEW_PID_EXT: factory->hp = hp; - ep = dec_pid(edep, factory, ep, objp); + ep = dec_pid(edep, factory, ep, objp, ep[-1]); hp = factory->hp; if (ep == NULL) { goto error; } break; - case PORT_EXT: + case PORT_EXT: + case NEW_PORT_EXT: { Eterm sysname; ErlNode *node; Uint num; - Uint cre; + Uint32 cre; + byte tag = ep[-1]; if ((ep = dec_atom(edep, ep, &sysname)) == NULL) { goto error; @@ -3296,12 +3331,17 @@ dec_term_atom_common: goto error; } ep += 4; - cre = get_int8(ep); - ep++; - if (!is_valid_creation(cre)) { - goto error; - } - + if (tag == PORT_EXT) { + cre = get_int8(ep); + ep++; + if (!is_valid_creation(cre)) { + goto error; + } + } + else { + cre = get_int32(ep); + ep += 4; + } node = dec_get_node(sysname, cre); if(node == erts_this_node) { *objp = make_internal_port(num); @@ -3326,7 +3366,7 @@ dec_term_atom_common: Eterm sysname; ErlNode *node; int i; - Uint cre; + Uint32 cre; Uint32 *ref_num; Uint32 r0; Uint ref_words; @@ -3350,9 +3390,6 @@ dec_term_atom_common: ref_words = get_int16(ep); ep += 2; - if (ref_words > ERTS_MAX_REF_NUMBERS) - goto error; - if ((ep = dec_atom(edep, ep, &sysname)) == NULL) goto error; @@ -3365,15 +3402,30 @@ dec_term_atom_common: ep += 4; if (r0 >= MAX_REFERENCE) goto error; + goto ref_ext_common; + + case NEWER_REFERENCE_EXT: + ref_words = get_int16(ep); + ep += 2; + + if ((ep = dec_atom(edep, ep, &sysname)) == NULL) + goto error; + + cre = get_int32(ep); + ep += 4; + r0 = get_int32(ep); /* allow full word */ + ep += 4; ref_ext_common: + if (ref_words > ERTS_MAX_REF_NUMBERS) + goto error; node = dec_get_node(sysname, cre); if(node == erts_this_node) { RefThing *rtp = (RefThing *) hp; ref_num = (Uint32 *) (hp + REF_THING_HEAD_SIZE); -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) hp += REF_THING_HEAD_SIZE + ref_words/2 + 1; rtp->header = make_ref_thing_header(ref_words/2 + 1); #else @@ -3384,13 +3436,13 @@ dec_term_atom_common: } else { ExternalThing *etp = (ExternalThing *) hp; -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) hp += EXTERNAL_THING_HEAD_SIZE + ref_words/2 + 1; #else hp += EXTERNAL_THING_HEAD_SIZE + ref_words; #endif -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) etp->header = make_external_ref_header(ref_words/2 + 1); #else etp->header = make_external_ref_header(ref_words); @@ -3403,7 +3455,7 @@ dec_term_atom_common: ref_num = &(etp->data.ui32[0]); } -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) *(ref_num++) = ref_words /* 32-bit arity */; #endif ref_num[0] = r0; @@ -3411,7 +3463,7 @@ dec_term_atom_common: ref_num[i] = get_int32(ep); ep += 4; } -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) if ((1 + ref_words) % 2) ref_num[ref_words] = 0; #endif @@ -3563,12 +3615,7 @@ dec_term_atom_common: } *objp = make_export(hp); *hp++ = HEADER_EXPORT; -#if HALFWORD_HEAP - *((UWord *) (UWord) hp) = (UWord) erts_export_get_or_make_stub(mod, name, arity); - hp += 2; -#else *hp++ = (Eterm) erts_export_get_or_make_stub(mod, name, arity); -#endif break; } break; @@ -3604,8 +3651,8 @@ dec_term_atom_common: *objp = make_flatmap(mp); for (n = size; n; n--) { - *vptr = (Eterm) COMPRESS_POINTER(next); - *kptr = (Eterm) COMPRESS_POINTER(vptr); + *vptr = (Eterm) next; + *kptr = (Eterm) vptr; next = kptr; vptr--; kptr--; @@ -3619,8 +3666,8 @@ dec_term_atom_common: hamt->leaf_array = hp; for (n = size; n; n--) { - CDR(hp) = (Eterm) COMPRESS_POINTER(next); - CAR(hp) = (Eterm) COMPRESS_POINTER(&CDR(hp)); + CDR(hp) = (Eterm) next; + CAR(hp) = (Eterm) &CDR(hp); next = &CAR(hp); hp += 2; } @@ -3697,11 +3744,11 @@ dec_term_atom_common: /* Environment */ for (i = num_free-1; i >= 0; i--) { - funp->env[i] = (Eterm) COMPRESS_POINTER(next); + funp->env[i] = (Eterm) next; next = funp->env + i; } /* Creator */ - funp->creator = (Eterm) COMPRESS_POINTER(next); + funp->creator = (Eterm) next; next = &(funp->creator); break; } @@ -3725,9 +3772,9 @@ dec_term_atom_common: *objp = make_fun(funp); /* Creator pid */ - if (*ep != PID_EXT - || (ep = dec_pid(edep, factory, ++ep, - &funp->creator))==NULL) { + if ((*ep != PID_EXT && *ep != NEW_PID_EXT) + || (ep = dec_pid(edep, factory, ep+1, + &funp->creator, *ep))==NULL) { goto error; } @@ -3770,7 +3817,7 @@ dec_term_atom_common: /* Environment */ for (i = num_free-1; i >= 0; i--) { - funp->env[i] = (Eterm) COMPRESS_POINTER(next); + funp->env[i] = (Eterm) next; next = funp->env + i; } break; @@ -3897,7 +3944,7 @@ dec_term_atom_common: } WSTACK_DESTROY(flat_maps); - ASSERT((Eterm*)EXPAND_POINTER(*dbg_resultp) != NULL); + ASSERT((Eterm*)*dbg_resultp != NULL); if (ctx) { ctx->state = B2TDone; @@ -3911,9 +3958,13 @@ error: * Must unlink all off-heap objects that may have been * linked into the process. */ - if (factory->hp < hp) { /* Sometimes we used hp and sometimes factory->hp */ - factory->hp = hp; /* the largest must be the freshest */ + if (factory->mode != FACTORY_CLOSED) { + if (factory->hp < hp) { /* Sometimes we used hp and sometimes factory->hp */ + factory->hp = hp; /* the largest must be the freshest */ + } } + else ASSERT(factory->hp == hp); + error_hamt: erts_factory_undo(factory); PSTACK_DESTROY(hamt_array); @@ -4029,20 +4080,29 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, else result += 1 + 4 + 1 + i; /* tag,size,sign,digits */ break; + case EXTERNAL_PID_DEF: + if (external_pid_creation(obj) > ERTS_MAX_LOCAL_CREATION) + result += 3; + /*fall through*/ case PID_DEF: - case EXTERNAL_PID_DEF: result += (1 + encode_size_struct2(acmp, pid_node_name(obj), dflags) + 4 + 4 + 1); break; + case EXTERNAL_REF_DEF: + if (external_ref_creation(obj) > ERTS_MAX_LOCAL_CREATION) + result += 3; + /*fall through*/ case REF_DEF: - case EXTERNAL_REF_DEF: ASSERT(dflags & DFLAG_EXTENDED_REFERENCES); i = ref_no_of_numbers(obj); result += (1 + 2 + encode_size_struct2(acmp, ref_node_name(obj), dflags) + 1 + 4*i); break; - case PORT_DEF: - case EXTERNAL_PORT_DEF: + case EXTERNAL_PORT_DEF: + if (external_port_creation(obj) > ERTS_MAX_LOCAL_CREATION) + result += 3; + /*fall through*/ + case PORT_DEF: result += (1 + encode_size_struct2(acmp, port_node_name(obj), dflags) + 4 + 1); break; @@ -4190,11 +4250,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, case EXPORT_DEF: { Export* ep = *((Export **) (export_val(obj) + 1)); -#if HALFWORD_HEAP - result += 2; -#else result += 1; -#endif result += encode_size_struct2(acmp, ep->code[0], dflags); result += encode_size_struct2(acmp, ep->code[1], dflags); result += encode_size_struct2(acmp, make_small(ep->code[2]), dflags); @@ -4309,7 +4365,7 @@ init_done: switch (tag) { case INTEGER_EXT: SKIP(4); -#if !defined(ARCH_64) || HALFWORD_HEAP +#if !defined(ARCH_64) heap_size += BIG_UINT_HEAP_SIZE; #endif break; @@ -4373,19 +4429,32 @@ init_done: SKIP(1+atom_extra_skip); atom_extra_skip = 0; break; - case PID_EXT: + case NEW_PID_EXT: + atom_extra_skip = 12; + goto case_PID; + case PID_EXT: atom_extra_skip = 9; + case_PID: /* In case it is an external pid */ heap_size += EXTERNAL_THING_HEAD_SIZE + 1; terms++; break; - case PORT_EXT: + case NEW_PORT_EXT: + atom_extra_skip = 8; + goto case_PORT; + case PORT_EXT: atom_extra_skip = 5; + case_PORT: /* In case it is an external port */ heap_size += EXTERNAL_THING_HEAD_SIZE + 1; terms++; break; - case NEW_REFERENCE_EXT: + case NEWER_REFERENCE_EXT: + atom_extra_skip = 4; + goto case_NEW_REFERENCE; + case NEW_REFERENCE_EXT: + atom_extra_skip = 1; + case_NEW_REFERENCE: { int id_words; @@ -4396,9 +4465,9 @@ init_done: goto error; ep += 2; - atom_extra_skip = 1 + 4*id_words; + atom_extra_skip += 4*id_words; /* In case it is an external ref */ -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) heap_size += EXTERNAL_THING_HEAD_SIZE + id_words/2 + 1; #else heap_size += EXTERNAL_THING_HEAD_SIZE + id_words; @@ -4484,11 +4553,7 @@ init_done: break; case EXPORT_EXT: terms += 3; -#if HALFWORD_HEAP - heap_size += 3; -#else heap_size += 2; -#endif break; case NEW_FUN_EXT: { diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index d12051c6b4..f00426cc16 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -18,8 +18,6 @@ * %CopyrightEnd% */ -/* Same order as the ordering of terms in erlang */ - /* Since there are 255 different External tag values to choose from There is no reason to not be extravagant. Hence, the different tags for large/small tuple e.t.c @@ -37,9 +35,12 @@ #define SMALL_ATOM_EXT 's' #define REFERENCE_EXT 'e' #define NEW_REFERENCE_EXT 'r' +#define NEWER_REFERENCE_EXT 'Z' #define PORT_EXT 'f' +#define NEW_PORT_EXT 'Y' #define NEW_FLOAT_EXT 'F' #define PID_EXT 'g' +#define NEW_PID_EXT 'X' #define SMALL_TUPLE_EXT 'h' #define LARGE_TUPLE_EXT 'i' #define NIL_EXT 'j' @@ -191,7 +192,7 @@ Eterm erts_decode_dist_ext(ErtsHeapFactory* factory, ErtsDistExternal *); Sint erts_decode_ext_size(byte*, Uint); Sint erts_decode_ext_size_ets(byte*, Uint); -Eterm erts_decode_ext(ErtsHeapFactory*, byte**); +Eterm erts_decode_ext(ErtsHeapFactory*, byte**, Uint32 flags); Eterm erts_decode_ext_ets(ErtsHeapFactory*, byte*); Eterm erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 1b8595fe57..a7bc990deb 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -44,6 +44,8 @@ #include "erl_port.h" #include "erl_gc.h" +struct enif_func_t; + struct enif_environment_t /* ErlNifEnv */ { struct erl_module_nif* mod_nif; @@ -54,14 +56,21 @@ struct enif_environment_t /* ErlNifEnv */ int fpe_was_unmasked; struct enif_tmp_obj_t* tmp_obj_list; int exception_thrown; /* boolean */ + Process *tracee; }; extern void erts_pre_nif(struct enif_environment_t*, Process*, - struct erl_module_nif*); + struct erl_module_nif*, Process* tracee); extern void erts_post_nif(struct enif_environment_t* env); extern Eterm erts_nif_taints(Process* p); extern void erts_print_nif_taints(int to, void* to_arg); void erts_unload_nif(struct erl_module_nif* nif); extern void erl_nif_init(void); +extern int erts_nif_get_funcs(struct erl_module_nif*, + struct enif_func_t **funcs); +extern Eterm erts_nif_call_function(Process *p, Process *tracee, + struct erl_module_nif*, + struct enif_func_t *, + int argc, Eterm *argv); /* Driver handle (wrapper for old plain handle) */ #define ERL_DE_OK 0 @@ -310,9 +319,6 @@ typedef union { typedef struct proc_bin { Eterm thing_word; /* Subtag REFC_BINARY_SUBTAG. */ Uint size; /* Binary size in bytes. */ -#if HALFWORD_HEAP - void* dummy_ptr_padding__; -#endif struct erl_off_heap_header *next; Binary *val; /* Pointer to Binary structure. */ byte *bytes; /* Pointer to the actual data bytes. */ @@ -383,7 +389,7 @@ extern int bif_reductions; /* reductions + fcalls (when doing call_bif) */ extern int stackdump_on_exit; /* - * Here is an implementation of a lightweiht stack. + * Here is an implementation of a lightweight stack. * * Use it like this: * @@ -848,6 +854,94 @@ do {\ } while(0) +/* + * An implementation of lightweight unbounded queues, + * using a circular dynamic array. + * It does not include support for change_allocator. + * + * Use it like this: + * + * DECLARE_EQUEUE(Queue) (At the start of a block) + * ... + * EQUEUE_PUT(Queue, Term) + * ... + * if (EQUEUE_ISEMPTY(Queue)) { + * Queue is empty + * } else { + * Term = EQUEUE_GET(Stack); + * Process popped Term here + * } + * ... + * DESTROY_EQUEUE(Queue) + */ + +typedef struct { + Eterm* start; + Eterm* front; + Eterm* back; + int possibly_empty; + Eterm* end; + ErtsAlcType_t alloc_type; +} ErtsEQueue; + +#define DEF_EQUEUE_SIZE (16) + +void erl_grow_equeue(ErtsEQueue*, Eterm* def_queue); +#define EQUE_CONCAT(a,b) a##b +#define EQUE_DEF_QUEUE(q) EQUE_CONCAT(q,_default_equeue) + +#define DECLARE_EQUEUE(q) \ + UWord EQUE_DEF_QUEUE(q)[DEF_EQUEUE_SIZE]; \ + ErtsEQueue q = { \ + EQUE_DEF_QUEUE(q), /* start */ \ + EQUE_DEF_QUEUE(q), /* front */ \ + EQUE_DEF_QUEUE(q), /* back */ \ + 1, /* possibly_empty */ \ + EQUE_DEF_QUEUE(q) + DEF_EQUEUE_SIZE, /* end */ \ + ERTS_ALC_T_ESTACK /* alloc_type */ \ + } + +#define DESTROY_EQUEUE(q) \ +do { \ + if (q.start != EQUE_DEF_QUEUE(q)) { \ + erts_free(q.alloc_type, q.start); \ + } \ +} while(0) + +#define EQUEUE_PUT_UNCHECKED(q, x) \ +do { \ + q.possibly_empty = 0; \ + *(q.back) = (x); \ + if (++(q.back) == q.end) { \ + q.back = q.start; \ + } \ +} while(0) + +#define EQUEUE_PUT(q, x) \ +do { \ + if (q.back == q.front && !q.possibly_empty) { \ + erl_grow_equeue(&q, EQUE_DEF_QUEUE(q)); \ + } \ + EQUEUE_PUT_UNCHECKED(q, x); \ +} while(0) + +#define EQUEUE_ISEMPTY(q) (q.back == q.front && q.possibly_empty) + +ERTS_GLB_INLINE Eterm erts_equeue_get(ErtsEQueue *q); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF +ERTS_GLB_INLINE Eterm erts_equeue_get(ErtsEQueue *q) { + Eterm x; + q->possibly_empty = 1; + x = *(q->front); + if (++(q->front) == q->end) { + q->front = q->start; + } + return x; +} +#endif +#define EQUEUE_GET(q) erts_equeue_get(&(q)); + /* binary.c */ void erts_emasculate_writable_binary(ProcBin* pb); @@ -900,8 +994,18 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg); Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2); /* beam_bif_load.c */ -Eterm erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp); +#define ERTS_CPC_ALLOW_GC (1 << 0) +#define ERTS_CPC_COPY_LITERALS (1 << 1) +#define ERTS_CPC_ALL (ERTS_CPC_ALLOW_GC | ERTS_CPC_COPY_LITERALS) +Eterm erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp); +typedef struct { + Eterm *ptr; + Uint sz; + Eterm pid; +} copy_literals_t; + +extern copy_literals_t erts_clrange; /* beam_load.c */ typedef struct { @@ -913,6 +1017,7 @@ typedef struct { Binary* erts_alloc_loader_state(void); Eterm erts_module_for_prepared_code(Binary* magic); +Eterm erts_has_code_on_load(Binary* magic); Eterm erts_prepare_loading(Binary* loader_state, Process *c_p, Eterm group_leader, Eterm* modp, byte* code, Uint size); @@ -931,7 +1036,7 @@ Eterm erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info); /* beam_ranges.c */ void erts_init_ranges(void); -void erts_start_staging_ranges(void); +void erts_start_staging_ranges(int num_new); void erts_end_staging_ranges(int commit); void erts_update_ranges(BeamInstr* code, Uint size); void erts_remove_from_ranges(BeamInstr* code); @@ -956,35 +1061,71 @@ __decl_noreturn void __noreturn erts_exit(int n, char*, ...); __decl_noreturn void __noreturn erts_flush_async_exit(int n, char*, ...); void erl_error(char*, va_list); -/* copy.c */ -Eterm copy_object(Eterm, Process*); +/* This controls whether sharing-preserving copy is used by Erlang */ -#if HALFWORD_HEAP -Uint size_object_rel(Eterm, Eterm*); -# define size_object(A) size_object_rel(A,NULL) +#ifdef SHCOPY +#define SHCOPY_SEND +#define SHCOPY_SPAWN +#endif + +/* The persistent state while the sharing-preserving copier works */ -Eterm copy_struct_rel(Eterm, Uint, Eterm**, ErlOffHeap*, Eterm* src_base, Eterm* dst_base); -# define copy_struct(OBJ,SZ,HPP,OH) copy_struct_rel(OBJ,SZ,HPP,OH, NULL,NULL) +typedef struct { + Eterm queue_default[DEF_EQUEUE_SIZE]; + Eterm* queue_start; + Eterm* queue_end; + ErtsAlcType_t queue_alloc_type; + UWord bitstore_default[DEF_WSTACK_SIZE]; + UWord* bitstore_start; + ErtsAlcType_t bitstore_alloc_type; + Eterm shtable_default[DEF_ESTACK_SIZE]; + Eterm* shtable_start; + ErtsAlcType_t shtable_alloc_type; + Uint literal_size; + Eterm *range_ptr; + Uint range_sz; +} erts_shcopy_t; + +#define INITIALIZE_SHCOPY(info) \ +do { \ + info.queue_start = info.queue_default; \ + info.bitstore_start = info.bitstore_default; \ + info.shtable_start = info.shtable_default; \ + info.literal_size = 0; \ + info.range_ptr = erts_clrange.ptr; \ + info.range_sz = erts_clrange.sz; \ +} while(0) -Eterm copy_shallow_rel(Eterm*, Uint, Eterm**, ErlOffHeap*, Eterm* src_base); -# define copy_shallow(A,B,C,D) copy_shallow_rel(A,B,C,D,NULL) +#define DESTROY_SHCOPY(info) \ +do { \ + if (info.queue_start != info.queue_default) { \ + erts_free(info.queue_alloc_type, info.queue_start); \ + } \ + if (info.bitstore_start != info.bitstore_default) { \ + erts_free(info.bitstore_alloc_type, info.bitstore_start); \ + } \ + if (info.shtable_start != info.shtable_default) { \ + erts_free(info.shtable_alloc_type, info.shtable_start); \ + } \ +} while(0) -#else /* !HALFWORD_HEAP */ +/* copy.c */ +Eterm copy_object_x(Eterm, Process*, Uint); +#define copy_object(Term, Proc) copy_object_x(Term,Proc,0) Uint size_object(Eterm); -# define size_object_rel(A,B) size_object(A) +Uint copy_shared_calculate(Eterm, erts_shcopy_t*); +Eterm copy_shared_perform(Eterm, Uint, erts_shcopy_t*, Eterm**, ErlOffHeap*); -Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*); -# define copy_struct_rel(OBJ,SZ,HPP,OH, SB,DB) copy_struct(OBJ,SZ,HPP,OH) +Uint size_shared(Eterm); +Eterm copy_struct_x(Eterm, Uint, Eterm**, ErlOffHeap*, Uint* bsz); +#define copy_struct(Obj,Sz,HPP,OH) \ + copy_struct_x(Obj,Sz,HPP,OH,NULL) Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*); -# define copy_shallow_rel(A,B,C,D, BASE) copy_shallow(A,B,C,D) -#endif - - -void move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first, - Eterm* refs, unsigned nrefs); +void erts_move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first, + Eterm* refs, unsigned nrefs, int literals); /* Utilities */ extern void erts_delete_nodes_monitors(Process *, ErtsProcLocks); @@ -1037,6 +1178,9 @@ extern ErtsModifiedTimings erts_modified_timings[]; extern int erts_no_line_info; extern Eterm erts_error_logger_warnings; extern int erts_initialized; +#if defined(USE_THREADS) && !defined(ERTS_SMP) +extern erts_tid_t erts_main_thread; +#endif extern int erts_compat_rel; extern int erts_use_sender_punish; void erts_short_init(void); @@ -1177,10 +1321,10 @@ int erts_utf8_to_latin1(byte* dest, const byte* source, int slen); #define ERTS_UTF8_OK_MAX_CHARS 4 void bin_write(int, void*, byte*, size_t); -int intlist_to_buf(Eterm, char*, int); /* most callers pass plain char*'s */ +Sint intlist_to_buf(Eterm, char*, Sint); /* most callers pass plain char*'s */ struct Sint_buf { -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) char s[22]; #else char s[12]; @@ -1250,7 +1394,7 @@ ErlDrvSizeT erts_iolist_to_buf(Eterm, char*, ErlDrvSizeT); ErlDrvSizeT erts_iolist_to_buf_yielding(ErtsIOList2BufState *); int erts_iolist_size_yielding(ErtsIOListState *state); int erts_iolist_size(Eterm, ErlDrvSizeT *); -int is_string(Eterm); +Sint is_string(Eterm); void erl_at_exit(void (*) (void*), void*); Eterm collect_memory(Process *); void dump_memory_to_fd(int); @@ -1296,6 +1440,29 @@ int erts_print_system_version(int to, void *arg, Process *c_p); int erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg); +ERTS_GLB_FORCE_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_FORCE_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr) +{ + ASSERT(is_boxed(tptr) || is_list(tptr)); + ASSERT(ptr == ptr_val(tptr)); + +#if defined(ERTS_HAVE_IS_IN_LITERAL_RANGE) + return erts_is_in_literal_range(ptr); +#elif defined(TAG_LITERAL_PTR) + return is_literal_ptr(tptr); +#else +# error Not able to detect literals... +#endif + +} + +#endif + +Eterm erts_msacc_request(Process *c_p, int action, Eterm *threads); + /* ** Call_trace uses this API for the parameter matching functions */ @@ -1344,191 +1511,21 @@ extern void erts_match_prog_foreach_offheap(Binary *b, extern erts_driver_t vanilla_driver; extern erts_driver_t spawn_driver; +extern erts_driver_t forker_driver; extern erts_driver_t fd_driver; int erts_beam_jump_table(void); -/* Should maybe be placed in erl_message.h, but then we get an include mess. */ -ERTS_GLB_INLINE Eterm * -erts_alloc_message_heap_state(Uint size, - ErlHeapFragment **bpp, - ErlOffHeap **ohpp, - Process *receiver, - ErtsProcLocks *receiver_locks, - erts_aint32_t *statep); - -ERTS_GLB_INLINE Eterm * -erts_alloc_message_heap(Uint size, - ErlHeapFragment **bpp, - ErlOffHeap **ohpp, - Process *receiver, - ErtsProcLocks *receiver_locks); - -#if ERTS_GLB_INLINE_INCL_FUNC_DEF - -/* - * NOTE: erts_alloc_message_heap() releases msg q and status - * lock on receiver without ensuring that other locks are - * held. User is responsible to ensure that the receiver - * pointer cannot become invalid until after message has - * been passed. This is normal done either by increasing - * reference count on process (preferred) or by holding - * main or link lock over the whole message passing - * operation. - */ - -ERTS_GLB_INLINE Eterm * -erts_alloc_message_heap_state(Uint size, - ErlHeapFragment **bpp, - ErlOffHeap **ohpp, - Process *receiver, - ErtsProcLocks *receiver_locks, - erts_aint32_t *statep) -{ - Eterm *hp; - erts_aint32_t state; -#ifdef ERTS_SMP - int locked_main = 0; - state = erts_smp_atomic32_read_acqb(&receiver->state); - if (statep) - *statep = state; - if (state & (ERTS_PSFLG_EXITING - | ERTS_PSFLG_PENDING_EXIT)) - goto allocate_in_mbuf; -#endif - - if (size > (Uint) INT_MAX) - erts_exit(ERTS_ABORT_EXIT, "HUGE size (%beu)\n", size); - - if ( -#if defined(ERTS_SMP) - *receiver_locks & ERTS_PROC_LOCK_MAIN -#else - 1 -#endif - ) { -#ifdef ERTS_SMP - try_allocate_on_heap: -#endif - state = erts_smp_atomic32_read_nob(&receiver->state); - if (statep) - *statep = state; - if ((state & (ERTS_PSFLG_EXITING - | ERTS_PSFLG_PENDING_EXIT)) - || (receiver->flags & F_DISABLE_GC) - || HEAP_LIMIT(receiver) - HEAP_TOP(receiver) <= size) { - /* - * The heap is either potentially in an inconsistent - * state, or not large enough. - */ -#ifdef ERTS_SMP - if (locked_main) { - *receiver_locks &= ~ERTS_PROC_LOCK_MAIN; - erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MAIN); - } -#endif - goto allocate_in_mbuf; - } - hp = HEAP_TOP(receiver); - HEAP_TOP(receiver) = hp + size; - *bpp = NULL; - *ohpp = &MSO(receiver); - } -#ifdef ERTS_SMP - else if (erts_smp_proc_trylock(receiver, ERTS_PROC_LOCK_MAIN) == 0) { - locked_main = 1; - *receiver_locks |= ERTS_PROC_LOCK_MAIN; - goto try_allocate_on_heap; - } -#endif - else { - ErlHeapFragment *bp; - allocate_in_mbuf: - bp = new_message_buffer(size); - hp = bp->mem; - *bpp = bp; - *ohpp = &bp->off_heap; - } - - return hp; -} - -ERTS_GLB_INLINE Eterm * -erts_alloc_message_heap(Uint size, - ErlHeapFragment **bpp, - ErlOffHeap **ohpp, - Process *receiver, - ErtsProcLocks *receiver_locks) -{ - return erts_alloc_message_heap_state(size, bpp, ohpp, receiver, - receiver_locks, NULL); -} - -#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ - -#if !HEAP_ON_C_STACK -# if defined(DEBUG) -# define DeclareTmpHeap(VariableName,Size,Process) \ - Eterm *VariableName = erts_debug_allocate_tmp_heap(Size,Process) -# define DeclareTypedTmpHeap(Type,VariableName,Process) \ - Type *VariableName = (Type *) erts_debug_allocate_tmp_heap(sizeof(Type)/sizeof(Eterm),Process) -# define DeclareTmpHeapNoproc(VariableName,Size) \ - Eterm *VariableName = erts_debug_allocate_tmp_heap(Size,NULL) -# define UseTmpHeap(Size,Proc) \ - do { \ - erts_debug_use_tmp_heap((Size),(Proc)); \ - } while (0) -# define UnUseTmpHeap(Size,Proc) \ - do { \ - erts_debug_unuse_tmp_heap((Size),(Proc)); \ - } while (0) -# define UseTmpHeapNoproc(Size) \ - do { \ - erts_debug_use_tmp_heap(Size,NULL); \ - } while (0) -# define UnUseTmpHeapNoproc(Size) \ - do { \ - erts_debug_unuse_tmp_heap(Size,NULL); \ - } while (0) -# else -# define DeclareTmpHeap(VariableName,Size,Process) \ - Eterm *VariableName = (ERTS_PROC_GET_SCHDATA(Process)->tmp_heap)+(ERTS_PROC_GET_SCHDATA(Process)->num_tmp_heap_used) -# define DeclareTypedTmpHeap(Type,VariableName,Process) \ - Type *VariableName = (Type *) (ERTS_PROC_GET_SCHDATA(Process)->tmp_heap)+(ERTS_PROC_GET_SCHDATA(Process)->num_tmp_heap_used) -# define DeclareTmpHeapNoproc(VariableName,Size) \ - Eterm *VariableName = (erts_get_scheduler_data()->tmp_heap)+(erts_get_scheduler_data()->num_tmp_heap_used) -# define UseTmpHeap(Size,Proc) \ - do { \ - ERTS_PROC_GET_SCHDATA(Proc)->num_tmp_heap_used += (Size); \ - } while (0) -# define UnUseTmpHeap(Size,Proc) \ - do { \ - ERTS_PROC_GET_SCHDATA(Proc)->num_tmp_heap_used -= (Size); \ - } while (0) -# define UseTmpHeapNoproc(Size) \ - do { \ - erts_get_scheduler_data()->num_tmp_heap_used += (Size); \ - } while (0) -# define UnUseTmpHeapNoproc(Size) \ - do { \ - erts_get_scheduler_data()->num_tmp_heap_used -= (Size); \ - } while (0) - - -# endif - -#else -# define DeclareTmpHeap(VariableName,Size,Process) \ +#define DeclareTmpHeap(VariableName,Size,Process) \ Eterm VariableName[Size] -# define DeclareTypedTmpHeap(Type,VariableName,Process) \ +#define DeclareTypedTmpHeap(Type,VariableName,Process) \ Type VariableName[1] -# define DeclareTmpHeapNoproc(VariableName,Size) \ +#define DeclareTmpHeapNoproc(VariableName,Size) \ Eterm VariableName[Size] -# define UseTmpHeap(Size,Proc) /* Nothing */ -# define UnUseTmpHeap(Size,Proc) /* Nothing */ -# define UseTmpHeapNoproc(Size) /* Nothing */ -# define UnUseTmpHeapNoproc(Size) /* Nothing */ -#endif /* HEAP_ON_C_STACK */ +#define UseTmpHeap(Size,Proc) /* Nothing */ +#define UnUseTmpHeap(Size,Proc) /* Nothing */ +#define UseTmpHeapNoproc(Size) /* Nothing */ +#define UnUseTmpHeapNoproc(Size) /* Nothing */ ERTS_GLB_INLINE void dtrace_pid_str(Eterm pid, char *process_buf); ERTS_GLB_INLINE void dtrace_proc_str(Process *process, char *process_buf); @@ -1544,10 +1541,15 @@ ERTS_GLB_INLINE void dtrace_fun_decode(Process *process, ERTS_GLB_INLINE void dtrace_pid_str(Eterm pid, char *process_buf) { - erts_snprintf(process_buf, DTRACE_TERM_BUF_SIZE, "<%lu.%lu.%lu>", - pid_channel_no(pid), - pid_number(pid), - pid_serial(pid)); + if (is_pid(pid)) + erts_snprintf(process_buf, DTRACE_TERM_BUF_SIZE, "<%lu.%lu.%lu>", + pid_channel_no(pid), + pid_number(pid), + pid_serial(pid)); + else if (is_port(pid)) + erts_snprintf(process_buf, DTRACE_TERM_BUF_SIZE, "#Port<%lu.%lu>", + port_channel_no(pid), + port_number(pid)); } ERTS_GLB_INLINE void @@ -1559,9 +1561,7 @@ dtrace_proc_str(Process *process, char *process_buf) ERTS_GLB_INLINE void dtrace_port_str(Port *port, char *port_buf) { - erts_snprintf(port_buf, DTRACE_TERM_BUF_SIZE, "#Port<%lu.%lu>", - port_channel_no(port->common.id), - port_number(port->common.id)); + dtrace_pid_str(port->common.id, port_buf); } ERTS_GLB_INLINE void @@ -1576,6 +1576,7 @@ dtrace_fun_decode(Process *process, erts_snprintf(mfa_buf, DTRACE_TERM_BUF_SIZE, "%T:%T/%d", module, function, arity); } + #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ #endif /* !__GLOBAL_H__ */ diff --git a/erts/emulator/beam/hash.c b/erts/emulator/beam/hash.c index 895fe657d1..e255b961f1 100644 --- a/erts/emulator/beam/hash.c +++ b/erts/emulator/beam/hash.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -27,8 +27,6 @@ #endif #include "sys.h" -#include "erl_vm.h" -#include "global.h" #include "hash.h" /* @@ -66,6 +64,7 @@ void hash_get_info(HashInfo *hi, Hash *h) int i; int max_depth = 0; int objects = 0; + int used = 0; for (i = 0; i < size; i++) { int depth = 0; @@ -76,14 +75,18 @@ void hash_get_info(HashInfo *hi, Hash *h) depth++; b = b->next; } - if (depth > max_depth) - max_depth = depth; + if (depth) { + used++; + if (depth > max_depth) + max_depth = depth; + } } + ASSERT(objects == h->nobjs); hi->name = h->name; hi->size = h->size; - hi->used = h->used; - hi->objs = objects; + hi->used = used; + hi->objs = h->nobjs; hi->depth = max_depth; } @@ -98,11 +101,11 @@ void hash_info(int to, void *arg, Hash* h) hash_get_info(&hi, h); - erts_print(to, arg, "=hash_table:%s\n", hi.name); - erts_print(to, arg, "size: %d\n", hi.size); - erts_print(to, arg, "used: %d\n", hi.used); - erts_print(to, arg, "objs: %d\n", hi.objs); - erts_print(to, arg, "depth: %d\n", hi.depth); + h->fun.meta_print(to, arg, "=hash_table:%s\n", hi.name); + h->fun.meta_print(to, arg, "size: %d\n", hi.size); + h->fun.meta_print(to, arg, "used: %d\n", hi.used); + h->fun.meta_print(to, arg, "objs: %d\n", hi.objs); + h->fun.meta_print(to, arg, "depth: %d\n", hi.depth); } @@ -119,47 +122,56 @@ hash_table_sz(Hash *h) } +static ERTS_INLINE void set_thresholds(Hash* h) +{ + h->grow_threshold = (8*h->size)/5; /* grow at 160% load */ + if (h->size_ix > h->min_size_ix) + h->shrink_threshold = h->size / 5; /* shrink at 20% load */ + else + h->shrink_threshold = -1; /* never shrink below inital size */ +} + /* ** init a pre allocated or static hash structure ** and allocate buckets. */ -Hash* hash_init(ErtsAlcType_t type, Hash* h, char* name, int size, HashFunctions fun) +Hash* hash_init(int type, Hash* h, char* name, int size, HashFunctions fun) { int sz; int ix = 0; - h->type = type; + h->meta_alloc_type = type; while (h_size_table[ix] != -1 && h_size_table[ix] < size) ix++; if (h_size_table[ix] == -1) - erts_exit(ERTS_ERROR_EXIT, "panic: too large hash table size (%d)\n", size); + return NULL; size = h_size_table[ix]; sz = size*sizeof(HashBucket*); - h->bucket = (HashBucket**) erts_alloc(h->type, sz); + h->bucket = (HashBucket**) fun.meta_alloc(h->meta_alloc_type, sz); sys_memzero(h->bucket, sz); h->is_allocated = 0; h->name = name; h->fun = fun; h->size = size; - h->size20percent = h->size/5; - h->size80percent = (4*h->size)/5; - h->ix = ix; - h->used = 0; + h->size_ix = ix; + h->min_size_ix = ix; + h->nobjs = 0; + set_thresholds(h); return h; } /* ** Create a new hash table */ -Hash* hash_new(ErtsAlcType_t type, char* name, int size, HashFunctions fun) +Hash* hash_new(int type, char* name, int size, HashFunctions fun) { Hash* h; - h = erts_alloc(type, sizeof(Hash)); + h = fun.meta_alloc(type, sizeof(Hash)); h = hash_init(type, h, name, size, fun); h->is_allocated = 1; @@ -183,9 +195,9 @@ void hash_delete(Hash* h) b = b_next; } } - erts_free(h->type, h->bucket); + h->fun.meta_free(h->meta_alloc_type, h->bucket); if (h->is_allocated) - erts_free(h->type, (void*) h); + h->fun.meta_free(h->meta_alloc_type, (void*) h); } /* @@ -199,39 +211,34 @@ static void rehash(Hash* h, int grow) int i; if (grow) { - if ((h_size_table[h->ix+1]) == -1) + if ((h_size_table[h->size_ix+1]) == -1) return; - h->ix++; + h->size_ix++; } else { - if (h->ix == 0) + if (h->size_ix == 0) return; - h->ix--; + h->size_ix--; } - h->size = h_size_table[h->ix]; - h->size20percent = h->size/5; - h->size80percent = (4*h->size)/5; + h->size = h_size_table[h->size_ix]; sz = h->size*sizeof(HashBucket*); - new_bucket = (HashBucket **) erts_alloc(h->type, sz); + new_bucket = (HashBucket **) h->fun.meta_alloc(h->meta_alloc_type, sz); sys_memzero(new_bucket, sz); - h->used = 0; - for (i = 0; i < old_size; i++) { HashBucket* b = h->bucket[i]; while (b != (HashBucket*) 0) { HashBucket* b_next = b->next; int ix = b->hvalue % h->size; - if (new_bucket[ix] == NULL) - h->used++; b->next = new_bucket[ix]; new_bucket[ix] = b; b = b_next; } } - erts_free(h->type, (void *) h->bucket); + h->fun.meta_free(h->meta_alloc_type, (void *) h->bucket); h->bucket = new_bucket; + set_thresholds(h); } /* @@ -268,68 +275,15 @@ void* hash_put(Hash* h, void* tmpl) } b = (HashBucket*) h->fun.alloc(tmpl); - if (h->bucket[ix] == NULL) - h->used++; - b->hvalue = hval; b->next = h->bucket[ix]; h->bucket[ix] = b; - if (h->used > h->size80percent) /* rehash at 80% */ + if (++h->nobjs > h->grow_threshold) rehash(h, 1); return (void*) b; } -static void -hash_insert_entry(Hash* h, HashBucket* entry) -{ - HashValue hval = entry->hvalue; - int ix = hval % h->size; - HashBucket* b = h->bucket[ix]; - - while (b != (HashBucket*) 0) { - if ((b->hvalue == hval) && (h->fun.cmp((void*)entry, (void*)b) == 0)) { - abort(); /* Should not happen */ - } - b = b->next; - } - - if (h->bucket[ix] == NULL) - h->used++; - - entry->next = h->bucket[ix]; - h->bucket[ix] = entry; - - if (h->used > h->size80percent) /* rehash at 80% */ - rehash(h, 1); -} - - -/* - * Move all entries in src into dst; empty src. - * Entries in src must not exist in dst. - */ -void -erts_hash_merge(Hash* src, Hash* dst) -{ - int limit = src->size; - HashBucket** bucket = src->bucket; - int i; - - src->used = 0; - for (i = 0; i < limit; i++) { - HashBucket* b = bucket[i]; - HashBucket* next; - - bucket[i] = NULL; - while (b) { - next = b->next; - hash_insert_entry(dst, b); - b = next; - } - } -} - /* ** Erase hash entry return template if erased ** return 0 if not erased @@ -348,9 +302,7 @@ void* hash_erase(Hash* h, void* tmpl) else h->bucket[ix] = b->next; h->fun.free((void*)b); - if (h->bucket[ix] == NULL) - h->used--; - if (h->used < h->size20percent) /* rehash at 20% */ + if (--h->nobjs < h->shrink_threshold) rehash(h, 0); return tmpl; } @@ -381,9 +333,7 @@ hash_remove(Hash *h, void *tmpl) prev->next = b->next; else h->bucket[ix] = b->next; - if (h->bucket[ix] == NULL) - h->used--; - if (h->used < h->size20percent) /* rehash at 20% */ + if (--h->nobjs < h->shrink_threshold) rehash(h, 0); return (void *) b; } diff --git a/erts/emulator/beam/hash.h b/erts/emulator/beam/hash.h index 87fdb360e3..9f773d8faa 100644 --- a/erts/emulator/beam/hash.h +++ b/erts/emulator/beam/hash.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -29,14 +29,17 @@ #include "sys.h" #endif -#include "erl_alloc.h" - typedef unsigned long HashValue; +typedef struct hash Hash; typedef int (*HCMP_FUN)(void*, void*); typedef HashValue (*H_FUN)(void*); typedef void* (*HALLOC_FUN)(void*); typedef void (*HFREE_FUN)(void*); +/* Meta functions */ +typedef void* (*HMALLOC_FUN)(int,size_t); +typedef void (*HMFREE_FUN)(int,void*); +typedef int (*HMPRINT_FUN)(int,void*,char*, ...); /* ** This bucket must be placed in top of @@ -55,6 +58,9 @@ typedef struct hash_functions HCMP_FUN cmp; HALLOC_FUN alloc; HFREE_FUN free; + HMALLOC_FUN meta_alloc; + HMFREE_FUN meta_free; + HMPRINT_FUN meta_print; } HashFunctions; typedef struct { @@ -65,22 +71,23 @@ typedef struct { int depth; } HashInfo; -typedef struct hash +struct hash { HashFunctions fun; /* Function block */ int is_allocated; /* 0 iff hash structure is on stack or is static */ - ErtsAlcType_t type; + int meta_alloc_type; /* argument to pass to meta_alloc and meta_free */ char* name; /* Table name (static string, for debugging) */ int size; /* Number of slots */ - int size20percent; /* 20 percent of number of slots */ - int size80percent; /* 80 percent of number of slots */ - int ix; /* Size index in size table */ - int used; /* Number of slots used */ + int shrink_threshold; + int grow_threshold; + int size_ix; /* Size index in size table */ + int min_size_ix; /* Never shrink table smaller than this */ + int nobjs; /* Number of objects in table */ HashBucket** bucket; /* Vector of bucket pointers (objects) */ -} Hash; +}; -Hash* hash_new(ErtsAlcType_t, char*, int, HashFunctions); -Hash* hash_init(ErtsAlcType_t, Hash*, char*, int, HashFunctions); +Hash* hash_new(int, char*, int, HashFunctions); +Hash* hash_init(int, Hash*, char*, int, HashFunctions); void hash_delete(Hash*); void hash_get_info(HashInfo*, Hash*); @@ -93,6 +100,4 @@ void* hash_erase(Hash*, void*); void* hash_remove(Hash*, void*); void hash_foreach(Hash*, void (*func)(void *, void *), void *); -void erts_hash_merge(Hash* src, Hash* dst); - #endif diff --git a/erts/emulator/beam/index.c b/erts/emulator/beam/index.c index 5f6ea14732..26d6c04ea0 100644 --- a/erts/emulator/beam/index.c +++ b/erts/emulator/beam/index.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2012. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/index.h b/erts/emulator/beam/index.h index 14fab41026..218779c33b 100644 --- a/erts/emulator/beam/index.h +++ b/erts/emulator/beam/index.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -30,6 +30,10 @@ #include "hash.h" #endif +#ifndef ERL_ALLOC_H__ +#include "erl_alloc.h" +#endif + typedef struct index_slot { HashBucket bucket; diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index fbcb0c31fc..5c2595c69d 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -47,16 +47,18 @@ #define ERTS_WANT_EXTERNAL_TAGS #include "external.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #include "erl_map.h" #include "erl_bif_unique.h" #include "erl_hl_timer.h" #include "erl_time.h" extern ErlDrvEntry fd_driver_entry; -#ifndef __OSE__ extern ErlDrvEntry vanilla_driver_entry; -#endif extern ErlDrvEntry spawn_driver_entry; +#ifndef __WIN32__ +extern ErlDrvEntry forker_driver_entry; +#endif extern ErlDrvEntry *driver_tab[]; /* table of static drivers, only used during initialization */ erts_driver_t *driver_list; /* List of all drivers, static and dynamic. */ @@ -74,6 +76,9 @@ const Port erts_invalid_port = {{ERTS_INVALID_PORT}}; erts_driver_t vanilla_driver; erts_driver_t spawn_driver; +#ifndef __WIN32__ +erts_driver_t forker_driver; +#endif erts_driver_t fd_driver; int erts_port_synchronous_ops = 0; @@ -83,10 +88,11 @@ int erts_port_parallelism = 0; static erts_atomic64_t bytes_in; static erts_atomic64_t bytes_out; -static void deliver_result(Eterm sender, Eterm pid, Eterm res); +static void deliver_result(Port *p, Eterm sender, Eterm pid, Eterm res); static int init_driver(erts_driver_t *, ErlDrvEntry *, DE_Handle *); static void terminate_port(Port *p); static void pdl_init(void); +static int driver_failure_term(ErlDrvPort ix, Eterm term, int eof); #ifdef ERTS_SMP static void driver_monitor_lock_pdl(Port *p); static void driver_monitor_unlock_pdl(Port *p); @@ -206,6 +212,7 @@ static ERTS_INLINE void kill_port(Port *pp) { ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp)); + ERTS_TRACER_CLEAR(&ERTS_TRACER(pp)); erts_ptab_delete_element(&erts_port, &pp->common); /* Time of death */ erts_port_task_free_port(pp); /* In non-smp case the port structure may have been deallocated now */ @@ -308,12 +315,9 @@ static Port *create_port(char *name, size_t port_size, busy_port_queue_size, size; erts_aint32_t state = ERTS_PORT_SFLG_CONNECTED; erts_aint32_t x_pts_flgs = 0; -#ifdef DEBUG - /* Make sure the debug flags survives until port is freed */ - state |= ERTS_PORT_SFLG_PORT_DEBUG; -#endif #ifdef ERTS_SMP + ErtsRunQueue *runq; if (!driver_lock) { /* Align size for mutex following port struct */ port_size = size = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(Port)); @@ -323,6 +327,12 @@ static Port *create_port(char *name, #endif port_size = size = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(Port)); +#ifdef DEBUG + /* Make sure the debug flags survives until port is freed */ + state |= ERTS_PORT_SFLG_PORT_DEBUG; +#endif + + busy_port_queue_size = ((driver->flags & ERL_DRV_FLAG_NO_BUSY_MSGQ) ? 0 @@ -358,8 +368,12 @@ static Port *create_port(char *name, p += sizeof(erts_mtx_t); state |= ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK; } - erts_smp_atomic_set_nob(&prt->run_queue, - (erts_aint_t) erts_get_runq_current(NULL)); + if (erts_get_scheduler_data()) + runq = erts_get_runq_current(NULL); + else + runq = ERTS_RUNQ_IX(0); + erts_smp_atomic_set_nob(&prt->run_queue, (erts_aint_t) runq); + prt->xports = NULL; #else erts_atomic32_init_nob(&prt->refc, 1); @@ -385,12 +399,13 @@ static Port *create_port(char *name, prt->common.u.alive.reg = NULL; ERTS_PTMR_INIT(prt); erts_port_task_handle_init(&prt->timeout_task); - prt->psd = NULL; + erts_smp_atomic_init_nob(&prt->psd, (erts_aint_t) NULL); + prt->async_open_port = NULL; prt->drv_data = (SWord) 0; prt->os_pid = -1; /* Set default tracing */ - erts_get_default_tracing(&ERTS_TRACE_FLAGS(prt), &ERTS_TRACER_PROC(prt)); + erts_get_default_port_tracing(&ERTS_TRACE_FLAGS(prt), &ERTS_TRACER(prt)); ERTS_CT_ASSERT(offsetof(Port,common) == 0); @@ -467,6 +482,11 @@ erts_port_free(Port *prt) erts_port_task_fini_sched(&prt->sched); + if (prt->async_open_port) { + erts_free(ERTS_ALC_T_PRTSD, prt->async_open_port); + prt->async_open_port = NULL; + } + #ifdef ERTS_SMP ASSERT(prt->lock); if (state & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK) @@ -688,8 +708,9 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ error_number = error_type = 0; if (driver->start) { + ERTS_MSACC_PUSH_STATE_M(); if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) { - trace_sched_ports_where(port, am_in, am_start); + trace_sched_ports_where(port, am_in, am_open); } port->caller = pid; #ifdef USE_VM_PROBES @@ -698,6 +719,19 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ DTRACE3(driver_start, process_str, driver->name, port_str); } #endif + + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); + +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_start)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(pid, proc_str); + lttng_port_to_str(port, port_str); + LTTNG3(driver_start, proc_str, driver->name, port_str); + } +#endif + fpe_was_unmasked = erts_block_fpe(); drv_data = (*driver->start)(ERTS_Port2ErlDrvPort(port), name, opts); if (((SWord) drv_data) == -1) @@ -717,9 +751,10 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ } erts_unblock_fpe(fpe_was_unmasked); + ERTS_MSACC_POP_STATE_M(); port->caller = NIL; if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) { - trace_sched_ports_where(port, am_out, am_start); + trace_sched_ports_where(port, am_out, am_open); } #ifdef ERTS_SMP if (port->xports) @@ -1106,7 +1141,7 @@ io_list_vec_len(Eterm obj, int* vsize, Uint* csize, Uint p_v_size = 0; Uint p_c_size = 0; Uint p_in_clist = 0; - Uint total; /* Uint due to halfword emulator */ + Uint total; goto L_jump_start; /* avoid a push */ @@ -1266,7 +1301,7 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp) reds_left_in = CONTEXT_REDS/10; else { if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) - trace_virtual_sched(c_p, am_out); + trace_sched(c_p, ERTS_PROC_LOCK_MAIN, am_out); /* * No status lock held while sending runnable * proc trace messages. It is however not needed @@ -1350,7 +1385,7 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp) } if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) - trace_virtual_sched(c_p, am_in); + trace_sched(c_p, ERTS_PROC_LOCK_MAIN, am_in); /* * No status lock held while sending runnable * proc trace messages. It is however not needed @@ -1413,7 +1448,7 @@ queue_port_sched_op_reply(Process *rp, erts_factory_trim_and_close(factory, &msg, 1); - erts_queue_message(rp, rp_locksp, factory->heap_frags, msg, NIL); + erts_queue_message(rp, rp_locksp, factory->message, msg); } static void @@ -1421,12 +1456,9 @@ port_sched_op_reply(Eterm to, Uint32 *ref_num, Eterm msg) { Process *rp = erts_proc_lookup_raw(to); if (rp) { - ErlOffHeap *ohp; - ErlHeapFragment* bp; ErtsHeapFactory factory; Eterm msg_copy; Uint hsz, msg_sz; - Eterm *hp; ErtsProcLocks rp_locks = 0; hsz = ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE; @@ -1437,18 +1469,13 @@ port_sched_op_reply(Eterm to, Uint32 *ref_num, Eterm msg) hsz += msg_sz; } - hp = erts_alloc_message_heap(hsz, - &bp, - &ohp, - rp, - &rp_locks); - erts_factory_message_init(&factory, rp, hp, bp); - if (is_immed(msg)) - msg_copy = msg; - else { - msg_copy = copy_struct(msg, msg_sz, &hp, ohp); - factory.hp = hp; - } + (void) erts_factory_message_create(&factory, rp, + &rp_locks, hsz); + msg_copy = (is_immed(msg) + ? msg + : copy_struct(msg, msg_sz, + &factory.hp, + factory.off_heap)); queue_port_sched_op_reply(rp, &rp_locks, @@ -1509,9 +1536,8 @@ erts_schedule_proc2port_signal(Process *c_p, ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); c_p->msg.save = c_p->msg.last; - erts_smp_proc_unlock(c_p, - (ERTS_PROC_LOCK_MAIN - | ERTS_PROC_LOCKS_MSG_RECEIVE)); + erts_smp_proc_unlock(c_p, (ERTS_PROC_LOCKS_MSG_RECEIVE + | ERTS_PROC_LOCK_MAIN)); } @@ -1547,6 +1573,26 @@ erts_schedule_proc2port_signal(Process *c_p, return ERTS_PORT_OP_SCHEDULED; } +static int +erts_schedule_port2port_signal(Eterm port_num, ErtsProc2PortSigData *sigdp, + int task_flags, + ErtsProc2PortSigCallback callback) +{ + Port *prt = erts_port_lookup_raw(port_num); + + if (!prt) + return -1; + + sigdp->caller = ERTS_INVALID_PID; + + return erts_port_task_schedule(prt->common.id, + NULL, + ERTS_PORT_TASK_PROC_SIG, + sigdp, + callback, + task_flags); +} + static ERTS_INLINE void send_badsig(Port *prt) { ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND; @@ -1691,16 +1737,30 @@ call_driver_outputv(int bang_op, else { ErtsSchedulerData *esdp = erts_get_scheduler_data(); ErlDrvSizeT size = evp->size; + ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt) || ERTS_IS_CRASH_DUMPING); + + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, caller, am_commandv, evp); + #ifdef USE_VM_PROBES if (DTRACE_ENABLED(driver_outputv)) { DTRACE_FORMAT_COMMON_PID_AND_PORT(caller, prt); DTRACE4(driver_outputv, process_str, port_str, prt->name, size); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_outputv)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(caller, proc_str); + lttng_port_to_str(prt, port_str); + LTTNG4(driver_outputv, proc_str, port_str, prt->name, size); + } +#endif prt->caller = caller; (*drv->outputv)((ErlDrvData) prt->drv_data, evp); @@ -1711,6 +1771,8 @@ call_driver_outputv(int bang_op, esdp->io.out += (Uint64) size; else erts_atomic64_add_nob(&bytes_out, (erts_aint64_t) size); + + ERTS_MSACC_POP_STATE_M(); } } @@ -1724,7 +1786,6 @@ cleanup_scheduled_outputv(ErlIOVec *ev, ErlDrvBinary *cbinp) driver_free_binary(ev->binv[i]); if (cbinp) driver_free_binary(cbinp); - erts_free(ERTS_ALC_T_DRV_CMD_DATA, ev); } static int @@ -1791,6 +1852,7 @@ call_driver_output(int bang_op, send_badsig(prt); else { ErtsSchedulerData *esdp = erts_get_scheduler_data(); + ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt) || ERTS_IS_CRASH_DUMPING); @@ -1800,6 +1862,18 @@ call_driver_output(int bang_op, DTRACE4(driver_output, process_str, port_str, prt->name, size); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_output)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(caller, proc_str); + lttng_port_to_str(prt, port_str); + LTTNG4(driver_output, proc_str, port_str, prt->name, size); + } +#endif + + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, caller, am_command, bufp, size); prt->caller = caller; (*drv->output)((ErlDrvData) prt->drv_data, bufp, size); @@ -1810,6 +1884,8 @@ call_driver_output(int bang_op, esdp->io.out += (Uint64) size; else erts_atomic64_add_nob(&bytes_out, (erts_aint64_t) size); + + ERTS_MSACC_POP_STATE_M(); } } @@ -1859,6 +1935,188 @@ port_sig_output(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *si return ERTS_PORT_REDS_CMD_OUTPUT; } + +/* + * This erts_port_output will always create a port task. + * The call is treated as a port_command call, i.e. no + * badsig i generated if the input in invalid. However + * an error_logger message is generated. + */ +int +erts_port_output_async(Port *prt, Eterm from, Eterm list) +{ + + ErtsPortOpResult res; + ErtsProc2PortSigData *sigdp; + erts_driver_t *drv = prt->drv_ptr; + size_t size; + int task_flags; + ErtsProc2PortSigCallback port_sig_callback; + ErlDrvBinary *cbin = NULL; + ErlIOVec *evp = NULL; + char *buf = NULL; + ErtsPortTaskHandle *ns_pthp; + + if (drv->outputv) { + ErlIOVec ev; + SysIOVec* ivp; + ErlDrvBinary** bvp; + int vsize; + Uint csize; + Uint pvsize; + Uint pcsize; + size_t iov_offset, binv_offset, alloc_size; + Uint blimit = 0; + char *ptr; + int i; + + Eterm* bptr = NULL; + Uint offset; + + if (is_binary(list)) { + /* We optimize for when we get a procbin without offset */ + Eterm real_bin; + int bitoffs; + int bitsize; + ERTS_GET_REAL_BIN(list, real_bin, offset, bitoffs, bitsize); + bptr = binary_val(real_bin); + if (*bptr == HEADER_PROC_BIN && bitoffs == 0) { + size = binary_size(list); + vsize = 1; + } else + bptr = NULL; + } + + if (!bptr) { + if (io_list_vec_len(list, &vsize, &csize, &pvsize, &pcsize, &size)) + goto bad_value; + + /* To pack or not to pack (small binaries) ...? */ + if (vsize >= SMALL_WRITE_VEC) { + /* Do pack */ + vsize = pvsize + 1; + csize = pcsize; + blimit = ERL_SMALL_IO_BIN_LIMIT; + } + cbin = driver_alloc_binary(csize); + if (!cbin) + erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, ERTS_SIZEOF_Binary(csize)); + } + + + iov_offset = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(ErlIOVec)); + binv_offset = iov_offset; + binv_offset += ERTS_ALC_DATA_ALIGN_SIZE((vsize+1)*sizeof(SysIOVec)); + alloc_size = binv_offset; + alloc_size += (vsize+1)*sizeof(ErlDrvBinary *); + + sigdp = erts_port_task_alloc_p2p_sig_data_extra(alloc_size, (void**)&ptr); + + evp = (ErlIOVec *) ptr; + ivp = evp->iov = (SysIOVec *) (ptr + iov_offset); + bvp = evp->binv = (ErlDrvBinary **) (ptr + binv_offset); + + ivp[0].iov_base = NULL; + ivp[0].iov_len = 0; + bvp[0] = NULL; + + if (bptr) { + ProcBin* pb = (ProcBin *) bptr; + + ivp[1].iov_base = pb->bytes+offset; + ivp[1].iov_len = size; + bvp[1] = Binary2ErlDrvBinary(pb->val); + + evp->vsize = 1; + } else { + + evp->vsize = io_list_to_vec(list, ivp+1, bvp+1, cbin, blimit); + if (evp->vsize < 0) { + if (evp != &ev) + erts_free(ERTS_ALC_T_DRV_CMD_DATA, evp); + driver_free_binary(cbin); + goto bad_value; + } + } +#if 0 + /* This assertion may say something useful, but it can + be falsified during the emulator test suites. */ + ASSERT(evp->vsize == vsize); +#endif + evp->vsize++; + evp->size = size; /* total size */ + + /* Need to increase refc on all binaries */ + for (i = 1; i < evp->vsize; i++) + if (bvp[i]) + driver_binary_inc_refc(bvp[i]); + + sigdp->flags = ERTS_P2P_SIG_TYPE_OUTPUTV; + sigdp->u.outputv.from = from; + sigdp->u.outputv.evp = evp; + sigdp->u.outputv.cbinp = cbin; + port_sig_callback = port_sig_outputv; + } else { + ErlDrvSizeT ERTS_DECLARE_DUMMY(r); + + /* + * Apperently there exist code that write 1 byte to + * much in buffer. Where it resides I don't know, but + * we can live with one byte extra allocated... + */ + + if (erts_iolist_size(list, &size)) + goto bad_value; + + buf = erts_alloc(ERTS_ALC_T_DRV_CMD_DATA, size + 1); + + r = erts_iolist_to_buf(list, buf, size); + ASSERT(ERTS_IOLIST_TO_BUF_SUCCEEDED(r)); + + sigdp = erts_port_task_alloc_p2p_sig_data(); + sigdp->flags = ERTS_P2P_SIG_TYPE_OUTPUT; + sigdp->u.output.from = from; + sigdp->u.output.bufp = buf; + sigdp->u.output.size = size; + port_sig_callback = port_sig_output; + } + sigdp->flags = 0; + ns_pthp = NULL; + task_flags = 0; + + res = erts_schedule_proc2port_signal(NULL, + prt, + ERTS_INVALID_PID, + NULL, + sigdp, + task_flags, + ns_pthp, + port_sig_callback); + + if (res != ERTS_PORT_OP_SCHEDULED) { + if (drv->outputv) + cleanup_scheduled_outputv(evp, cbin); + else + cleanup_scheduled_output(buf); + return 1; + } + return 1; + +bad_value: + + /* + * We call badsig directly here as this function is called with + * the main lock of the calling process still held. + * At the moment this operation is always not a bang_op, so + * only an error_logger message should be generated, no badsig. + */ + + badsig_received(0, prt, erts_atomic32_read_nob(&prt->state), 1); + + return 0; + +} + ErtsPortOpResult erts_port_output(Process *c_p, int flags, @@ -1868,7 +2126,7 @@ erts_port_output(Process *c_p, Eterm *refp) { ErtsPortOpResult res; - ErtsProc2PortSigData *sigdp; + ErtsProc2PortSigData *sigdp = NULL; erts_driver_t *drv = prt->drv_ptr; size_t size; int try_call; @@ -1921,7 +2179,6 @@ erts_port_output(Process *c_p, DTRACE4(port_command, process_str, port_str, prt->name, "command"); } #endif - if (drv->outputv) { ErlIOVec ev; SysIOVec iv[SMALL_WRITE_VEC]; @@ -1950,10 +2207,13 @@ erts_port_output(Process *c_p, evp = &ev; } else { - char *ptr = erts_alloc((try_call - ? ERTS_ALC_T_TMP - : ERTS_ALC_T_DRV_CMD_DATA), alloc_size); - + char *ptr; + if (try_call) { + ptr = erts_alloc(ERTS_ALC_T_TMP, alloc_size); + } else { + sigdp = erts_port_task_alloc_p2p_sig_data_extra( + alloc_size, (void**)&ptr); + } evp = (ErlIOVec *) ptr; ivp = evp->iov = (SysIOVec *) (ptr + iov_offset); bvp = evp->binv = (ErlDrvBinary **) (ptr + binv_offset); @@ -1982,9 +2242,12 @@ erts_port_output(Process *c_p, bvp[0] = NULL; evp->vsize = io_list_to_vec(list, ivp+1, bvp+1, cbin, blimit); if (evp->vsize < 0) { - if (evp != &ev) - erts_free(try_call ? ERTS_ALC_T_TMP : ERTS_ALC_T_DRV_CMD_DATA, - evp); + if (evp != &ev) { + if (try_call) + erts_free(ERTS_ALC_T_TMP, evp); + else + erts_port_task_free_p2p_sig_data(sigdp); + } driver_free_binary(cbin); goto bad_value; } @@ -2036,8 +2299,10 @@ erts_port_output(Process *c_p, /* Fall through... */ case ERTS_TRY_IMM_DRV_CALL_INVALID_PORT: driver_free_binary(cbin); - if (evp != &ev) + if (evp != &ev) { + ASSERT(!sigdp); erts_free(ERTS_ALC_T_TMP, evp); + } if (try_call_res != ERTS_TRY_IMM_DRV_CALL_OK) return ERTS_PORT_OP_DROPPED; if (c_p) @@ -2048,8 +2313,10 @@ erts_port_output(Process *c_p, if (async_nosuspend && (sched_flags & (busy_flgs|ERTS_PTS_FLG_EXIT))) { driver_free_binary(cbin); - if (evp != &ev) + if (evp != &ev) { + ASSERT(!sigdp); erts_free(ERTS_ALC_T_TMP, evp); + } return ((sched_flags & ERTS_PTS_FLG_EXIT) ? ERTS_PORT_OP_DROPPED : ERTS_PORT_OP_BUSY); @@ -2064,9 +2331,16 @@ erts_port_output(Process *c_p, if (bvp[i]) driver_binary_inc_refc(bvp[i]); - new_evp = erts_alloc(ERTS_ALC_T_DRV_CMD_DATA, alloc_size); + /* The port task and iovec is allocated in the + same structure as an optimization. This + is especially important in erts_port_output_async + of when !try_call */ + ASSERT(sigdp == NULL); + sigdp = erts_port_task_alloc_p2p_sig_data_extra( + alloc_size, (void**)&new_evp); if (evp != &ev) { + /* Copy from TMP alloc to port task */ sys_memcpy((void *) new_evp, (void *) evp, alloc_size); new_evp->iov = (SysIOVec *) (((char *) new_evp) + iov_offset); @@ -2114,7 +2388,6 @@ erts_port_output(Process *c_p, evp = new_evp; } - sigdp = erts_port_task_alloc_p2p_sig_data(); sigdp->flags = ERTS_P2P_SIG_TYPE_OUTPUTV; sigdp->u.outputv.from = from; sigdp->u.outputv.evp = evp; @@ -2323,7 +2596,10 @@ call_deliver_port_exit(int bang_op, return ERTS_PORT_OP_DROPPED; } - if (!erts_deliver_port_exit(prt, from, reason, bang_op)) + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, from, am_close); + + if (!erts_deliver_port_exit(prt, from, reason, bang_op, broken_link)) return ERTS_PORT_OP_DROPPED; #ifdef USE_VM_PROBES @@ -2382,6 +2658,11 @@ erts_port_exit(Process *c_p, | ERTS_PORT_SIG_FLG_BROKEN_LINK | ERTS_PORT_SIG_FLG_FORCE_SCHED)) == 0); +#ifndef __WIN32__ + if (prt->drv_ptr == &forker_driver) + return ERTS_PORT_OP_DROPPED; +#endif + if (!(flags & ERTS_PORT_SIG_FLG_FORCE_SCHED)) { ErtsTryImmDrvCallState try_call_state = ERTS_INIT_TRY_IMM_DRV_CALL_STATE(c_p, @@ -2389,13 +2670,13 @@ erts_port_exit(Process *c_p, ERTS_PORT_SFLGS_INVALID_LOOKUP, 0, !refp, - am_exit); + am_close); switch (try_imm_drv_call(&try_call_state)) { case ERTS_TRY_IMM_DRV_CALL_OK: { res = call_deliver_port_exit(flags & ERTS_PORT_SIG_FLG_BANG_OP, - from, + c_p ? c_p->common.id : from, prt, try_call_state.state, reason, @@ -2474,8 +2755,11 @@ set_port_connected(int bang_op, return ERTS_PORT_OP_DROPPED; } + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, from, am_connect, connect); + ERTS_PORT_SET_CONNECTED(prt, connect); - deliver_result(prt->common.id, from, am_connected); + deliver_result(prt, prt->common.id, from, am_connected); #ifdef USE_VM_PROBES if(DTRACE_ENABLED(port_command)) { @@ -2497,10 +2781,22 @@ set_port_connected(int bang_op, erts_add_link(&ERTS_P_LINKS(rp), LINK_PID, prt->common.id); erts_add_link(&ERTS_P_LINKS(prt), LINK_PID, connect); + if (IS_TRACED_FL(rp, F_TRACE_PROCS)) + trace_proc(NULL, 0, rp, am_getting_linked, prt->common.id); + ERTS_PORT_SET_CONNECTED(prt, connect); erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + if (IS_TRACED_FL(prt, F_TRACE_PORTS)) + trace_port(prt, am_getting_linked, connect); + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, from, am_connect, connect); + if (IS_TRACED_FL(prt, F_TRACE_SEND)) { + Eterm hp[3]; + trace_port_send(prt, from, TUPLE2(hp, prt->common.id, am_connected), 1); + } + #ifdef USE_VM_PROBES if (DTRACE_ENABLED(port_connect)) { DTRACE_CHARBUF(process_str, DTRACE_TERM_BUF_SIZE); @@ -2603,8 +2899,11 @@ static void port_unlink(Port *prt, Eterm from) { ErtsLink *lnk = erts_remove_link(&ERTS_P_LINKS(prt), from); - if (lnk) + if (lnk) { + if (IS_TRACED_FL(prt, F_TRACE_PORTS)) + trace_port(prt, am_getting_unlinked, from); erts_destroy_link(lnk); + } } static int @@ -2674,10 +2973,10 @@ port_link_failure(Eterm port_id, Eterm linker) NIL, NULL, 0); - if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) { + if (xres >= 0) { /* We didn't exit the process and it is traced */ if (IS_TRACED_FL(rp, F_TRACE_PROCS)) - trace_proc(NULL, rp, am_getting_unlinked, port_id); + trace_proc(NULL, 0, rp, am_getting_unlinked, port_id); } if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); @@ -2688,10 +2987,15 @@ port_link_failure(Eterm port_id, Eterm linker) static void port_link(Port *prt, erts_aint32_t state, Eterm to) { - if (!(state & ERTS_PORT_SFLGS_INVALID_LOOKUP)) + if (IS_TRACED_FL(prt, F_TRACE_PORTS)) + trace_port(prt, am_getting_linked, to); + if (!(state & ERTS_PORT_SFLGS_INVALID_LOOKUP)) { erts_add_link(&ERTS_P_LINKS(prt), LINK_PID, to); - else + } else { port_link_failure(prt->common.id, to); + if (IS_TRACED_FL(prt, F_TRACE_PORTS)) + trace_port(prt, am_unlink, to); + } } static int @@ -2699,8 +3003,9 @@ port_sig_link(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *sigd { if (op == ERTS_PROC2PORT_SIG_EXEC) port_link(prt, state, sigdp->u.link.to); - else + else { port_link_failure(sigdp->u.link.port, sigdp->u.link.to); + } if (sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY) port_sched_op_reply(sigdp->caller, sigdp->ref, am_true); return ERTS_PORT_REDS_LINK; @@ -2746,6 +3051,72 @@ erts_port_link(Process *c_p, Port *prt, Eterm to, Eterm *refp) port_sig_link); } +static void +init_ack_send_reply(Port *port, Eterm resp) +{ + + if (!is_internal_port(resp)) { + Process *rp = erts_proc_lookup_raw(port->async_open_port->to); + erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK); + erts_remove_link(&ERTS_P_LINKS(port), port->async_open_port->to); + erts_remove_link(&ERTS_P_LINKS(rp), port->common.id); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + } + port_sched_op_reply(port->async_open_port->to, + port->async_open_port->ref, + resp); + + erts_free(ERTS_ALC_T_PRTSD, port->async_open_port); + port->async_open_port = NULL; +} + +void +erl_drv_init_ack(ErlDrvPort ix, ErlDrvData res) { + Port *port = erts_drvport2port(ix); + SWord err_type = (SWord)res; + Eterm resp; + + if (port == ERTS_INVALID_ERL_DRV_PORT && port->async_open_port) + return; + + if (port->async_open_port) { + switch(err_type) { + case -3: + resp = am_badarg; + break; + case -2: { + char *str = erl_errno_id(errno); + resp = erts_atom_put((byte *) str, strlen(str), + ERTS_ATOM_ENC_LATIN1, 1); + break; + } + case -1: + resp = am_einval; + break; + default: + resp = port->common.id; + break; + } + + init_ack_send_reply(port, resp); + + if (err_type == -1 || err_type == -2 || err_type == -3) + driver_failure_term(ix, am_normal, 0); + port->drv_data = err_type; + } +} + +void +erl_drv_set_os_pid(ErlDrvPort ix, ErlDrvSInt pid) { + Port *port = erts_drvport2port(ix); + + if (port == ERTS_INVALID_ERL_DRV_PORT) + return; + + port->os_pid = (SWord)pid; + +} + void erts_init_io(int port_tab_size, int port_tab_size_ignore_files, int legacy_port_tab) @@ -2806,10 +3177,11 @@ void erts_init_io(int port_tab_size, erts_smp_rwmtx_rwlock(&erts_driver_list_lock); init_driver(&fd_driver, &fd_driver_entry, NULL); -#ifndef __OSE__ init_driver(&vanilla_driver, &vanilla_driver_entry, NULL); -#endif init_driver(&spawn_driver, &spawn_driver_entry, NULL); +#ifndef __WIN32__ + init_driver(&forker_driver, &forker_driver_entry, NULL); +#endif erts_init_static_drivers(); for (dp = driver_tab; *dp != NULL; dp++) erts_add_driver_entry(*dp, NULL, 1); @@ -2871,6 +3243,9 @@ void erts_lcnt_enable_io_lock_count(int enable) { lcnt_enable_drv_lock_count(&vanilla_driver, enable); lcnt_enable_drv_lock_count(&spawn_driver, enable); +#ifndef __WIN32__ + lcnt_enable_drv_lock_count(&forker_driver, enable); +#endif lcnt_enable_drv_lock_count(&fd_driver, enable); /* enable lock counting in all drivers */ for (dp = driver_list; dp; dp = dp->next) { @@ -3050,7 +3425,7 @@ static int read_linebuf(LineBufContext *bp) } static void -deliver_result(Eterm sender, Eterm pid, Eterm res) +deliver_result(Port *prt, Eterm sender, Eterm pid, Eterm res) { Process *rp; ErtsProcLocks rp_locks = 0; @@ -3058,24 +3433,35 @@ deliver_result(Eterm sender, Eterm pid, Eterm res) ERTS_SMP_CHK_NO_PROC_LOCKS; + ASSERT(!prt || prt->common.id == sender); +#ifdef ERTS_SMP + ASSERT(!prt || erts_lc_is_port_locked(prt)); +#endif + ASSERT(is_internal_port(sender) && is_internal_pid(pid)); rp = (scheduler ? erts_proc_lookup(pid) : erts_pid2proc_opt(NULL, 0, pid, 0, ERTS_P2P_FLG_INC_REFC)); + if (prt && IS_TRACED_FL(prt, F_TRACE_SEND)) { + Eterm hp[3]; + trace_port_send(prt, pid, TUPLE2(hp, sender, res), !!rp); + } + if (rp) { Eterm tuple; - ErlHeapFragment *bp; + ErtsMessage *mp; ErlOffHeap *ohp; Eterm* hp; Uint sz_res; sz_res = size_object(res); - hp = erts_alloc_message_heap(sz_res + 3, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, + sz_res + 3, &hp, &ohp); res = copy_struct(res, sz_res, &hp, ohp); tuple = TUPLE2(hp, sender, res); - erts_queue_message(rp, &rp_locks, bp, tuple, NIL); + erts_queue_message(rp, &rp_locks, mp, tuple); if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); @@ -3103,10 +3489,11 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, Eterm tuple; Process* rp; Eterm* hp; - ErlHeapFragment *bp; + ErtsMessage *mp; ErlOffHeap *ohp; ErtsProcLocks rp_locks = 0; int scheduler = erts_get_scheduler_id() != 0; + int trace_send = IS_TRACED_FL(prt, F_TRACE_SEND); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); ERTS_SMP_CHK_NO_PROC_LOCKS; @@ -3129,7 +3516,7 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, if (!rp) return; - hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(trace_send ? NULL : rp, &rp_locks, need, &hp, &ohp); listp = NIL; if ((state & ERTS_PORT_SFLG_BINARY_IO) == 0) { @@ -3171,7 +3558,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); + if (trace_send) + trace_port_send(prt, to, tuple, 1); + + ERL_MESSAGE_TOKEN(mp) = am_undefined; + erts_queue_message(rp, &rp_locks, mp, tuple); if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) @@ -3245,11 +3636,12 @@ deliver_vec_message(Port* prt, /* Port */ Eterm tuple; Process* rp; Eterm* hp; - ErlHeapFragment *bp; + ErtsMessage *mp; ErlOffHeap *ohp; ErtsProcLocks rp_locks = 0; int scheduler = erts_get_scheduler_id() != 0; erts_aint32_t state; + int trace_send = IS_TRACED_FL(prt, F_TRACE_SEND); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); ERTS_SMP_CHK_NO_PROC_LOCKS; @@ -3277,7 +3669,7 @@ deliver_vec_message(Port* prt, /* Port */ need += (hlen+csize)*2; } - hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(trace_send ? NULL : rp, &rp_locks, need, &hp, &ohp); listp = NIL; iov += vsize; @@ -3338,7 +3730,11 @@ 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); + if (IS_TRACED_FL(prt, F_TRACE_SEND)) + trace_port_send(prt, to, tuple, 1); + + ERL_MESSAGE_TOKEN(mp) = am_undefined; + erts_queue_message(rp, &rp_locks, mp, tuple); erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) erts_proc_dec_refc(rp); @@ -3378,18 +3774,32 @@ static void flush_port(Port *p) ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); if (p->drv_ptr->flush != NULL) { + ERTS_MSACC_PUSH_STATE_M(); #ifdef USE_VM_PROBES if (DTRACE_ENABLED(driver_flush)) { DTRACE_FORMAT_COMMON_PID_AND_PORT(ERTS_PORT_GET_CONNECTED(p), p) DTRACE3(driver_flush, process_str, port_str, p->name); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_flush)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(p), proc_str); + lttng_port_to_str(p, port_str); + LTTNG3(driver_flush, proc_str, port_str, p->name); + } +#endif + + if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { trace_sched_ports_where(p, am_in, am_flush); } + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); fpe_was_unmasked = erts_block_fpe(); (*p->drv_ptr->flush)((ErlDrvData)p->drv_data); erts_unblock_fpe(fpe_was_unmasked); + ERTS_MSACC_POP_STATE_M(); if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { trace_sched_ports_where(p, am_out, am_flush); } @@ -3413,6 +3823,7 @@ terminate_port(Port *prt) Eterm connected_id = NIL /* Initialize to silence compiler */; erts_driver_t *drv; erts_aint32_t state; + ErtsPrtSD *psd; ERTS_SMP_CHK_NO_PROC_LOCKS; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); @@ -3437,20 +3848,37 @@ terminate_port(Port *prt) drv = prt->drv_ptr; if ((drv != NULL) && (drv->stop != NULL)) { int fpe_was_unmasked = erts_block_fpe(); + ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT); #ifdef USE_VM_PROBES if (DTRACE_ENABLED(driver_stop)) { DTRACE_FORMAT_COMMON_PID_AND_PORT(connected_id, prt) DTRACE3(driver_stop, process_str, drv->name, port_str); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_stop)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(connected_id, proc_str); + lttng_port_to_str(prt, port_str); + LTTNG3(driver_stop, proc_str, port_str, drv->name); + } +#endif + (*drv->stop)((ErlDrvData)prt->drv_data); erts_unblock_fpe(fpe_was_unmasked); + ERTS_MSACC_POP_STATE_M(); #ifdef ERTS_SMP if (prt->xports) erts_port_handle_xports(prt); ASSERT(!prt->xports); #endif } + + if (is_internal_port(send_closed_port_id) + && IS_TRACED_FL(prt, F_TRACE_SEND)) + trace_port_send(prt, connected_id, am_closed, 1); + if(drv->handle != NULL) { erts_smp_rwmtx_rlock(&erts_driver_list_lock); erts_ddll_decrement_port_count(drv->handle); @@ -3464,8 +3892,9 @@ terminate_port(Port *prt) erts_cleanup_port_data(prt); - if (prt->psd) - erts_free(ERTS_ALC_T_PRTSD, prt->psd); + psd = (ErtsPrtSD *) erts_smp_atomic_read_nob(&prt->psd); + if (psd) + erts_free(ERTS_ALC_T_PRTSD, psd); ASSERT(prt->dist_entry == NULL); @@ -3481,7 +3910,7 @@ terminate_port(Port *prt) erts_flush_async_exit(erts_halt_code, ""); } if (is_internal_port(send_closed_port_id)) - deliver_result(send_closed_port_id, connected_id, am_closed); + deliver_result(NULL, send_closed_port_id, connected_id, am_closed); } void @@ -3514,7 +3943,7 @@ static void sweep_one_monitor(ErtsMonitor *mon, void *vpsc) typedef struct { - Eterm port; + Port *port; Eterm reason; } SweepContext; @@ -3523,10 +3952,13 @@ static void sweep_one_link(ErtsLink *lnk, void *vpsc) SweepContext *psc = vpsc; DistEntry *dep; Process *rp; - + Eterm port_id = psc->port->common.id; ASSERT(lnk->type == LINK_PID); - + + if (IS_TRACED_FL(psc->port, F_TRACE_PORTS)) + trace_port(psc->port, am_unlink, lnk->pid); + if (is_external_pid(lnk->pid)) { dep = external_pid_dist_entry(lnk->pid); if(dep != erts_this_dist_entry) { @@ -3539,9 +3971,9 @@ static void sweep_one_link(ErtsLink *lnk, void *vpsc) case ERTS_DSIG_PREP_NOT_CONNECTED: break; case ERTS_DSIG_PREP_CONNECTED: - erts_remove_dist_link(&dld, psc->port, lnk->pid, dep); + erts_remove_dist_link(&dld, port_id, lnk->pid, dep); erts_destroy_dist_link(&dld); - code = erts_dsig_send_exit(&dsd, psc->port, lnk->pid, + code = erts_dsig_send_exit(&dsd, port_id, lnk->pid, psc->reason); ASSERT(code == ERTS_DSIG_SEND_OK); break; @@ -3555,23 +3987,25 @@ static void sweep_one_link(ErtsLink *lnk, void *vpsc) ASSERT(is_internal_pid(lnk->pid)); rp = erts_pid2proc(NULL, 0, lnk->pid, rp_locks); if (rp) { - ErtsLink *rlnk = erts_remove_link(&ERTS_P_LINKS(rp), psc->port); + ErtsLink *rlnk = erts_remove_link(&ERTS_P_LINKS(rp), port_id); if (rlnk) { int xres = erts_send_exit_signal(NULL, - psc->port, + port_id, rp, &rp_locks, psc->reason, NIL, NULL, 0); - if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) { + if (xres >= 0) { + if (rp_locks & ERTS_PROC_LOCKS_XSIG_SEND) { + erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_XSIG_SEND); + rp_locks &= ~ERTS_PROC_LOCKS_XSIG_SEND; + } /* We didn't exit the process and it is traced */ - if (IS_TRACED_FL(rp, F_TRACE_PROCS)) { - trace_proc(NULL, rp, am_getting_unlinked, - psc->port); - } + if (IS_TRACED_FL(rp, F_TRACE_PROCS)) + trace_proc(NULL, 0, rp, am_getting_unlinked, port_id); } erts_destroy_link(rlnk); } @@ -3593,7 +4027,8 @@ static void sweep_one_link(ErtsLink *lnk, void *vpsc) */ int -erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) +erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed, + int drop_normal) { ErtsLink *lnk; Eterm rreason; @@ -3623,8 +4058,10 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) | ERTS_PORT_SFLG_CLOSING)) return 0; - if (reason == am_normal && from != ERTS_PORT_GET_CONNECTED(p) && from != p->common.id) + if (reason == am_normal && from != ERTS_PORT_GET_CONNECTED(p) + && from != p->common.id && drop_normal) { return 0; + } set_state_flags = ERTS_PORT_SFLG_EXITING; if (send_closed) @@ -3635,9 +4072,8 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) state = erts_atomic32_read_bor_mb(&p->state, set_state_flags); state |= set_state_flags; - if (IS_TRACED_FL(p, F_TRACE_PORTS)) { + if (IS_TRACED_FL(p, F_TRACE_PORTS)) trace_port(p, am_closed, reason); - } erts_trace_check_exiting(p->common.id); @@ -3647,7 +4083,7 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) (void) erts_unregister_name(NULL, 0, p, p->common.u.alive.reg->name); { - SweepContext sc = {p->common.id, rreason}; + SweepContext sc = {p, rreason}; lnk = ERTS_P_LINKS(p); ERTS_P_LINKS(p) = NULL; erts_sweep_links(lnk, &sweep_one_link, &sc); @@ -3755,6 +4191,7 @@ call_driver_control(Eterm caller, ErlDrvSizeT *from_size) { ErlDrvSSizeT cres; + ERTS_MSACC_PUSH_STATE_M(); if (!prt->drv_ptr->control) return ERTS_PORT_OP_BADARG; @@ -3769,6 +4206,21 @@ call_driver_control(Eterm caller, } #endif + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, caller, am_control, command, bufp, size); + + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); + +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_control)) { + lttng_decl_procbuf(proc_str); + lttng_decl_portbuf(port_str); + lttng_pid_to_str(caller, proc_str); + lttng_port_to_str(prt, port_str); + LTTNG5(driver_control, proc_str, port_str, prt->name, command, size); + } +#endif + prt->caller = caller; cres = prt->drv_ptr->control((ErlDrvData) prt->drv_data, command, @@ -3778,9 +4230,14 @@ call_driver_control(Eterm caller, *from_size); prt->caller = NIL; + ERTS_MSACC_POP_STATE_M(); + if (cres < 0) return ERTS_PORT_OP_BADARG; + if (IS_TRACED_FL(prt, F_TRACE_SEND)) + trace_port_send_binary(prt, caller, am_control, *resp_bufp, cres); + *from_size = (ErlDrvSizeT) cres; return ERTS_PORT_OP_DONE; @@ -3829,7 +4286,6 @@ write_port_control_result(int control_flags, ErlDrvSizeT resp_size, char *pre_alloc_buf, Eterm **hpp, - ErlHeapFragment *bp, ErlOffHeap *ohp) { Eterm res; @@ -3903,16 +4359,13 @@ port_sig_control(Port *prt, if (res == ERTS_PORT_OP_DONE) { Eterm msg; - Eterm *hp; - ErlHeapFragment *bp; - ErlOffHeap *ohp; ErtsHeapFactory factory; Process *rp; ErtsProcLocks rp_locks = 0; Uint hsz, rsz; int control_flags; - rp = erts_proc_lookup_raw(sigdp->caller); + rp = sigdp->caller == ERTS_INVALID_PID ? NULL : erts_proc_lookup_raw(sigdp->caller); if (!rp) goto done; @@ -3925,22 +4378,15 @@ port_sig_control(Port *prt, hsz = rsz + ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE; - hp = erts_alloc_message_heap(hsz, - &bp, - &ohp, - rp, - &rp_locks); - erts_factory_message_init(&factory, rp, hp, bp); + (void) erts_factory_message_create(&factory, rp, + &rp_locks, hsz); msg = write_port_control_result(control_flags, resp_bufp, resp_size, &resp_buf[0], - &hp, - bp, - ohp); - factory.hp = hp; - + &factory.hp, + factory.off_heap); queue_port_sched_op_reply(rp, &rp_locks, &factory, @@ -3955,7 +4401,8 @@ port_sig_control(Port *prt, /* failure */ - port_sched_op_reply(sigdp->caller, sigdp->ref, am_badarg); + if (sigdp->caller != ERTS_INVALID_PID) + port_sched_op_reply(sigdp->caller, sigdp->ref, am_badarg); done: @@ -3965,6 +4412,23 @@ done: return ERTS_PORT_REDS_CONTROL; } +/* + * This is an asynchronous control call. I.e. it will not return anything + * to the caller. + */ +int +erl_drv_port_control(Eterm port_num, char cmd, char* buff, ErlDrvSizeT size) +{ + ErtsProc2PortSigData *sigdp = erts_port_task_alloc_p2p_sig_data(); + + sigdp->flags = ERTS_P2P_SIG_TYPE_CONTROL | ERTS_P2P_SIG_DATA_FLG_REPLY; + sigdp->u.control.binp = NULL; + sigdp->u.control.command = cmd; + sigdp->u.control.bufp = buff; + sigdp->u.control.size = size; + + return erts_schedule_port2port_signal(port_num, sigdp, 0, port_sig_control); +} ErtsPortOpResult erts_port_control(Process* c_p, @@ -4081,7 +4545,6 @@ erts_port_control(Process* c_p, resp_size, &resp_buf[0], &hp, - NULL, &c_p->off_heap); BUMP_REDS(c_p, ERTS_PORT_REDS_CONTROL); return ERTS_PORT_OP_DONE; @@ -4103,10 +4566,10 @@ erts_port_control(Process* c_p, binp = NULL; if (is_binary(data) && binary_bitoffset(data) == 0) { - Eterm *ebinp = binary_val_rel(data, NULL); + Eterm *ebinp = binary_val(data); ASSERT(!tmp_alloced); if (*ebinp == HEADER_SUB_BIN) - ebinp = binary_val_rel(((ErlSubBin *) ebinp)->orig, NULL); + ebinp = binary_val(((ErlSubBin *) ebinp)->orig); if (*ebinp != HEADER_PROC_BIN) copy = 1; else { @@ -4159,6 +4622,7 @@ call_driver_call(Eterm caller, unsigned *ret_flagsp) { ErlDrvSSizeT cres; + ERTS_MSACC_PUSH_STATE_M(); if (!prt->drv_ptr->call) return ERTS_PORT_OP_BADARG; @@ -4173,6 +4637,20 @@ call_driver_call(Eterm caller, DTRACE5(driver_call, process_str, port_str, prt->name, command, size); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_call)) { + lttng_decl_procbuf(proc_str); + lttng_decl_portbuf(port_str); + lttng_pid_to_str(caller,proc_str); + lttng_port_to_str(prt, port_str); + LTTNG5(driver_call, proc_str, port_str, prt->name, command, size); + } +#endif + + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, caller, am_call, command, bufp, size); + + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); prt->caller = caller; cres = prt->drv_ptr->call((ErlDrvData) prt->drv_data, @@ -4184,10 +4662,15 @@ call_driver_call(Eterm caller, ret_flagsp); prt->caller = NIL; + ERTS_MSACC_POP_STATE_M(); + if (cres <= 0 || ((byte) (*resp_bufp)[0]) != VERSION_MAGIC) return ERTS_PORT_OP_BADARG; + if (IS_TRACED_FL(prt, F_TRACE_SEND)) + trace_port_send_binary(prt, caller, am_call, *resp_bufp, cres); + *from_size = (ErlDrvSizeT) cres; return ERTS_PORT_OP_DONE; @@ -4240,22 +4723,15 @@ port_sig_call(Port *prt, hsz = erts_decode_ext_size((byte *) resp_bufp, resp_size); if (hsz >= 0) { - ErlHeapFragment* bp; - ErlOffHeap* ohp; ErtsHeapFactory factory; byte *endp; hsz += 3; /* ok tuple */ hsz += ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE; - hp = erts_alloc_message_heap(hsz, - &bp, - &ohp, - rp, - &rp_locks); + (void) erts_factory_message_create(&factory, rp, &rp_locks, hsz); endp = (byte *) resp_bufp; - erts_factory_message_init(&factory, rp, hp, bp); - msg = erts_decode_ext(&factory, &endp); + msg = erts_decode_ext(&factory, &endp, 0); if (is_value(msg)) { hp = erts_produce_heap(&factory, 3, @@ -4374,7 +4850,7 @@ erts_port_call(Process* c_p, hsz += 3; erts_factory_proc_prealloc_init(&factory, c_p, hsz); endp = (byte *) resp_bufp; - term = erts_decode_ext(&factory, &endp); + term = erts_decode_ext(&factory, &endp, 0); if (term == THE_NON_VALUE) return ERTS_PORT_OP_BADARG; hp = erts_produce_heap(&factory,3,0); @@ -4515,7 +4991,9 @@ port_sig_info(Port *prt, sigdp->u.info.item); if (is_value(value)) { ErtsHeapFactory factory; - erts_factory_message_init(&factory, NULL, hp, bp); + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = bp; + erts_factory_selfcontained_message_init(&factory, mp, hp); queue_port_sched_op_reply(rp, &rp_locks, &factory, @@ -4603,8 +5081,8 @@ reply_io_bytes(void *vreq) rp = erts_proc_lookup(req->pid); if (rp) { - ErlOffHeap *ohp = NULL; - ErlHeapFragment *bp = NULL; + ErlOffHeap *ohp; + ErtsMessage *mp; ErtsProcLocks rp_locks; Eterm ref, msg, ein, eout, *hp; Uint64 in, out; @@ -4626,7 +5104,7 @@ reply_io_bytes(void *vreq) erts_bld_uint64(NULL, &hsz, in); erts_bld_uint64(NULL, &hsz, out); - hp = erts_alloc_message_heap(hsz, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(rp, &rp_locks, hsz, &hp, &ohp); ref = make_internal_ref(hp); write_ref_thing(hp, req->refn[0], req->refn[1], req->refn[2]); @@ -4636,7 +5114,8 @@ reply_io_bytes(void *vreq) eout = erts_bld_uint64(&hp, NULL, out); msg = TUPLE4(hp, ref, make_small(sched_id), ein, eout); - erts_queue_message(rp, &rp_locks, bp, msg, NIL); + + erts_queue_message(rp, &rp_locks, mp, msg); if (req->sched_id == sched_id) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -4742,6 +5221,10 @@ print_port_info(Port *p, int to, void *arg) erts_print(to, arg, "Port is a file: %s\n",p->name); } else if (p->drv_ptr == &spawn_driver) { erts_print(to, arg, "Port controls external process: %s\n",p->name); +#ifndef __WIN32__ + } else if (p->drv_ptr == &forker_driver) { + erts_print(to, arg, "Port controls forker process: %s\n",p->name); +#endif } else { erts_print(to, arg, "Port controls linked-in driver: %s\n",p->name); } @@ -4888,6 +5371,7 @@ int get_port_flags(ErlDrvPort ix) void erts_raw_port_command(Port* p, byte* buf, Uint len) { int fpe_was_unmasked; + ERTS_MSACC_PUSH_STATE_M(); ERTS_SMP_CHK_NO_PROC_LOCKS; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); @@ -4908,9 +5392,11 @@ void erts_raw_port_command(Port* p, byte* buf, Uint len) DTRACE4(driver_output, "-raw-", port_str, p->name, len); } #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); fpe_was_unmasked = erts_block_fpe(); (*p->drv_ptr->output)((ErlDrvData)p->drv_data, (char*) buf, (int) len); erts_unblock_fpe(fpe_was_unmasked); + ERTS_MSACC_POP_STATE_M(); } int async_ready(Port *p, void* data) @@ -4922,14 +5408,25 @@ int async_ready(Port *p, void* data) if (p) { ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); if (p->drv_ptr->ready_async != NULL) { + ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT); #ifdef USE_VM_PROBES if (DTRACE_ENABLED(driver_ready_async)) { DTRACE_FORMAT_COMMON_PID_AND_PORT(ERTS_PORT_GET_CONNECTED(p), p) DTRACE3(driver_ready_async, process_str, port_str, p->name); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_ready_async)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(p), proc_str); + lttng_port_to_str(p, port_str); + LTTNG3(driver_ready_async, proc_str, port_str, p->name); + } +#endif (*p->drv_ptr->ready_async)((ErlDrvData)p->drv_data, data); need_free = 0; + ERTS_MSACC_POP_STATE_M(); } erts_port_driver_callback_epilogue(p, NULL); @@ -5081,14 +5578,15 @@ ErlDrvTermData driver_mk_term_nil(void) void driver_report_exit(ErlDrvPort ix, int status) { Eterm* hp; + ErlOffHeap *ohp; Eterm tuple; Process *rp; Eterm pid; - ErlHeapFragment *bp = NULL; - ErlOffHeap *ohp; + ErtsMessage *mp; ErtsProcLocks rp_locks = 0; int scheduler = erts_get_scheduler_id() != 0; Port* prt = erts_drvport2port(ix); + int trace_send = IS_TRACED_FL(prt, F_TRACE_SEND); if (prt == ERTS_INVALID_ERL_DRV_PORT) return; @@ -5105,13 +5603,17 @@ void driver_report_exit(ErlDrvPort ix, int status) if (!rp) return; - hp = erts_alloc_message_heap(3+3, &bp, &ohp, rp, &rp_locks); + mp = erts_alloc_message_heap(trace_send ? NULL : rp, &rp_locks, 3+3, &hp, &ohp); tuple = TUPLE2(hp, am_exit_status, make_small(status)); hp += 3; tuple = TUPLE2(hp, prt->common.id, tuple); - erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined); + if (IS_TRACED_FL(prt, F_TRACE_SEND)) + trace_port_send(prt, pid, tuple, 1); + + ERL_MESSAGE_TOKEN(mp) = am_undefined; + erts_queue_message(rp, &rp_locks, mp, tuple); erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) @@ -5205,13 +5707,13 @@ cleanup_b2t_states(struct b2t_states__ *b2tsp) */ static int -driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) +driver_deliver_term(Port *prt, Eterm to, ErlDrvTermData* data, int len) { #define HEAP_EXTRA 200 #define ERTS_DDT_FAIL do { res = -1; goto done; } while (0) Uint need = 0; int depth = 0; - int res; + int res = 0; ErlDrvTermData* ptr; ErlDrvTermData* ptr_end; DECLARE_ESTACK(stack); @@ -5221,7 +5723,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) ErtsProcLocks rp_locks = 0; struct b2t_states__ b2t; int scheduler; - int is_heap_need_limited = 1; ErtsSchedulerData *esdp = erts_get_scheduler_data(); ERTS_UNDEF(mess,NIL); @@ -5260,25 +5761,17 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) break; case ERL_DRV_INT: /* signed int argument */ ERTS_DDT_CHK_ENOUGH_ARGS(1); -#if HALFWORD_HEAP - erts_bld_sint64(NULL, &need, (Sint64)ptr[0]); -#else /* check for bignum */ if (!IS_SSMALL((Sint)ptr[0])) need += BIG_UINT_HEAP_SIZE; /* use small_to_big */ -#endif ptr++; depth++; break; case ERL_DRV_UINT: /* unsigned int argument */ ERTS_DDT_CHK_ENOUGH_ARGS(1); -#if HALFWORD_HEAP - erts_bld_uint64(NULL, &need, (Uint64)ptr[0]); -#else /* check for bignum */ if (!IS_USMALL(0, (Uint)ptr[0])) need += BIG_UINT_HEAP_SIZE; /* use small_to_big */ -#endif ptr++; depth++; break; @@ -5398,9 +5891,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) need += hsz; ptr += 2; depth++; - if (size > MAP_SMALL_MAP_LIMIT*3) { /* may contain big map */ - is_heap_need_limited = 0; - } break; } case ERL_DRV_MAP: { /* int */ @@ -5408,7 +5898,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) if ((int) ptr[0] < 0) ERTS_DDT_FAIL; if (ptr[0] > MAP_SMALL_MAP_LIMIT) { need += HASHMAP_ESTIMATED_HEAP_SIZE(ptr[0]); - is_heap_need_limited = 0; } else { need += MAP_HEADER_FLATMAP_SZ + 1 + 2*ptr[0]; } @@ -5443,20 +5932,25 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) ? erts_proc_lookup(to) : erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_INC_REFC)); if (!rp) { - res = 0; - goto done; - } + if (!prt || !IS_TRACED_FL(prt, F_TRACE_SEND)) + goto done; + if (!erts_is_tracer_proc_enabled(NULL, 0, &prt->common, am_send)) + goto done; - /* Try copy directly to destination heap if we know there are no big maps */ - if (is_heap_need_limited) { - ErlOffHeap *ohp; - ErlHeapFragment* bp; - Eterm* hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks); - erts_factory_message_init(&factory, rp, hp, bp); - } - else { - erts_factory_message_init(&factory, NULL, NULL, - new_message_buffer(need)); + res = -2; + + /* We allocate a temporary heap to be used to create + the message that may be sent using tracing */ + erts_factory_tmp_init(&factory, erts_alloc(ERTS_ALC_T_DRIVER, need*sizeof(Eterm)), + need, ERTS_ALC_T_DRIVER); + + } else { + /* We force the creation of a heap fragment (rp == NULL) when send + tracing so that we don't have the main lock of the process while + tracing */ + Process *trace_rp = prt && IS_TRACED_FL(prt, F_TRACE_SEND) ? NULL : rp; + (void) erts_factory_message_create(&factory, trace_rp, &rp_locks, need); + res = 1; } /* @@ -5477,10 +5971,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) break; case ERL_DRV_INT: /* signed int argument */ -#if HALFWORD_HEAP - erts_reserve_heap(&factory, BIG_NEED_SIZE(2)); - mess = erts_bld_sint64(&factory.hp, NULL, (Sint64)ptr[0]); -#else erts_reserve_heap(&factory, BIG_UINT_HEAP_SIZE); if (IS_SSMALL((Sint)ptr[0])) mess = make_small((Sint)ptr[0]); @@ -5488,15 +5978,10 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) mess = small_to_big((Sint)ptr[0], factory.hp); factory.hp += BIG_UINT_HEAP_SIZE; } -#endif ptr++; break; case ERL_DRV_UINT: /* unsigned int argument */ -#if HALFWORD_HEAP - erts_reserve_heap(&factory, BIG_NEED_FOR_BITS(64)); - mess = erts_bld_uint64(&factory.hp, NULL, (Uint64)ptr[0]); -#else erts_reserve_heap(&factory, BIG_UINT_HEAP_SIZE); if (IS_USMALL(0, (Uint)ptr[0])) mess = make_small((Uint)ptr[0]); @@ -5504,7 +5989,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) mess = uint_to_big((Uint)ptr[0], factory.hp); factory.hp += BIG_UINT_HEAP_SIZE; } -#endif ptr++; break; @@ -5730,22 +6214,40 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) ESTACK_PUSH(stack, mess); } - res = 1; - done: if (res > 0) { mess = ESTACK_POP(stack); /* get resulting value */ - erts_factory_close(&factory); + erts_factory_trim_and_close(&factory, &mess, 1); + + if (prt && IS_TRACED_FL(prt, F_TRACE_SEND)) + trace_port_send(prt, to, mess, 1); + /* send message */ - erts_queue_message(rp, &rp_locks, factory.heap_frags, mess, am_undefined); + ERL_MESSAGE_TOKEN(factory.message) = am_undefined; + erts_queue_message(rp, &rp_locks, factory.message, mess); + } + else if (res == -2) { + /* this clause only happens when we were requested to + generate a send trace, but the process to send to + did not exist any more */ + mess = ESTACK_POP(stack); /* get resulting value */ + + trace_port_send(prt, to, mess, 0); + + erts_factory_trim_and_close(&factory, &mess, 1); + erts_free(ERTS_ALC_T_DRIVER, factory.hp_start); + res = 0; } else { if (b2t.ix > b2t.used) b2t.used = b2t.ix; for (b2t.ix = 0; b2t.ix < b2t.used; b2t.ix++) erts_binary2term_abort(&b2t.state[b2t.ix]); - erts_factory_undo(&factory); + if (factory.mode != FACTORY_CLOSED) { + ERL_MESSAGE_TERM(factory.message) = am_undefined; + erts_factory_undo(&factory); + } } if (rp) { if (rp_locks) @@ -5761,7 +6263,8 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) } static ERTS_INLINE int -deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p) +deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p, + Port **trace_prt) { #ifdef ERTS_SMP ErtsThrPrgrDelayHandle dhndl = erts_thr_progress_unmanaged_delay(); @@ -5789,8 +6292,11 @@ deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p) if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED) { erts_thr_progress_unmanaged_continue(dhndl); ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore); - } + } else #endif + { + *trace_prt = prt; + } ERTS_SMP_LC_ASSERT(dhndl == ERTS_THR_PRGR_DHANDLE_MANAGED ? erts_lc_is_port_locked(prt) : !erts_lc_is_port_locked(prt)); @@ -5801,10 +6307,11 @@ int erl_drv_output_term(ErlDrvTermData port_id, ErlDrvTermData* data, int len) { /* May be called from arbitrary thread */ Eterm connected; - int res = deliver_term_check_port(port_id, &connected); + Port *prt = NULL; + int res = deliver_term_check_port(port_id, &connected, &prt); if (res <= 0) return res; - return driver_deliver_term(connected, data, len); + return driver_deliver_term(prt, connected, data, len); } /* @@ -5828,7 +6335,7 @@ driver_output_term(ErlDrvPort drvport, ErlDrvTermData* data, int len) if (state & ERTS_PORT_SFLG_CLOSING) return 0; - return driver_deliver_term(ERTS_PORT_GET_CONNECTED(prt), data, len); + return driver_deliver_term(prt, ERTS_PORT_GET_CONNECTED(prt), data, len); } int erl_drv_send_term(ErlDrvTermData port_id, @@ -5837,10 +6344,11 @@ int erl_drv_send_term(ErlDrvTermData port_id, int len) { /* May be called from arbitrary thread */ - int res = deliver_term_check_port(port_id, NULL); + Port *prt = NULL; + int res = deliver_term_check_port(port_id, NULL, &prt); if (res <= 0) return res; - return driver_deliver_term(to, data, len); + return driver_deliver_term(prt, to, data, len); } /* @@ -5859,20 +6367,21 @@ driver_send_term(ErlDrvPort drvport, * to make this access safe without using a less efficient * internal data representation for ErlDrvPort. */ + Port* prt = NULL; ERTS_SMP_CHK_NO_PROC_LOCKS; #ifdef ERTS_SMP if (erts_thr_progress_is_managed_thread()) #endif { erts_aint32_t state; - Port* prt = erts_drvport2port_state(drvport, &state); + prt = erts_drvport2port_state(drvport, &state); if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; /* invalid (dead) */ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if (state & ERTS_PORT_SFLG_CLOSING) return 0; } - return driver_deliver_term(to, data, len); + return driver_deliver_term(prt, to, data, len); } @@ -6843,7 +7352,7 @@ int driver_monitor_process(ErlDrvPort drvport, { Port *prt; int ret; -#if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)) +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) ErtsSchedulerData *sched = erts_get_scheduler_data(); #endif @@ -6854,16 +7363,6 @@ int driver_monitor_process(ErlDrvPort drvport, /* Now (in SMP) we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock)); - -#if !HEAP_ON_C_STACK - if (!sched) { - /* Need a separate allocation for the ref :( */ - Eterm *buf = erts_alloc(ERTS_ALC_T_TEMP_TERM, - sizeof(Eterm)*REF_THING_SIZE); - ret = do_driver_monitor_process(prt,buf,process,monitor); - erts_free(ERTS_ALC_T_TEMP_TERM,buf); - } else -#endif { DeclareTmpHeapNoproc(buf,REF_THING_SIZE); UseTmpHeapNoproc(REF_THING_SIZE); @@ -6916,7 +7415,7 @@ int driver_demonitor_process(ErlDrvPort drvport, { Port *prt; int ret; -#if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)) +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) ErtsSchedulerData *sched = erts_get_scheduler_data(); #endif @@ -6927,15 +7426,6 @@ int driver_demonitor_process(ErlDrvPort drvport, /* Now we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock)); -#if !HEAP_ON_C_STACK - if (!sched) { - /* Need a separate allocation for the ref :( */ - Eterm *buf = erts_alloc(ERTS_ALC_T_TEMP_TERM, - sizeof(Eterm)*REF_THING_SIZE); - ret = do_driver_demonitor_process(prt,buf,monitor); - erts_free(ERTS_ALC_T_TEMP_TERM,buf); - } else -#endif { DeclareTmpHeapNoproc(buf,REF_THING_SIZE); UseTmpHeapNoproc(REF_THING_SIZE); @@ -6971,7 +7461,7 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport, { Port *prt; ErlDrvTermData ret; -#if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)) +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) ErtsSchedulerData *sched = erts_get_scheduler_data(); #endif @@ -6982,16 +7472,6 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport, /* Now we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock)); - -#if !HEAP_ON_C_STACK - if (!sched) { - /* Need a separate allocation for the ref :( */ - Eterm *buf = erts_alloc(ERTS_ALC_T_TEMP_TERM, - sizeof(Eterm)*REF_THING_SIZE); - ret = do_driver_get_monitored_process(prt,buf,monitor); - erts_free(ERTS_ALC_T_TEMP_TERM,buf); - } else -#endif { DeclareTmpHeapNoproc(buf,REF_THING_SIZE); UseTmpHeapNoproc(REF_THING_SIZE); @@ -7015,6 +7495,7 @@ void erts_fire_port_monitor(Port *prt, Eterm ref) void (*callback)(ErlDrvData drv_data, ErlDrvMonitor *monitor); ErlDrvMonitor drv_monitor; int fpe_was_unmasked; + ERTS_MSACC_PUSH_STATE_M(); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); ASSERT(prt->drv_ptr != NULL); @@ -7026,6 +7507,7 @@ void erts_fire_port_monitor(Port *prt, Eterm ref) callback = prt->drv_ptr->process_exit; ASSERT(callback != NULL); ref_to_driver_monitor(ref,&drv_monitor); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); DRV_MONITOR_UNLOCK_PDL(prt); #ifdef USE_VM_PROBES if (DTRACE_ENABLED(driver_process_exit)) { @@ -7033,10 +7515,20 @@ void erts_fire_port_monitor(Port *prt, Eterm ref) DTRACE3(driver_process_exit, process_str, port_str, prt->name); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_process_exit)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(prt), proc_str); + lttng_port_to_str(prt, port_str); + LTTNG3(driver_process_exit, proc_str, port_str, prt->name); + } +#endif fpe_was_unmasked = erts_block_fpe(); (*callback)((ErlDrvData) (prt->drv_data), &drv_monitor); erts_unblock_fpe(fpe_was_unmasked); DRV_MONITOR_LOCK_PDL(prt); + ERTS_MSACC_POP_STATE_M(); /* remove monitor *after* callback */ rmon = erts_remove_monitor(&ERTS_P_MONITORS(prt), ref); DRV_MONITOR_UNLOCK_PDL(prt); @@ -7057,12 +7549,15 @@ driver_failure_term(ErlDrvPort ix, Eterm term, int eof) if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + if (prt->async_open_port) + init_ack_send_reply(prt, prt->common.id); if (eof) flush_linebuf_messages(prt, state); if (state & ERTS_PORT_SFLG_CLOSING) { terminate_port(prt); } else if (eof && (state & ERTS_PORT_SFLG_SOFT_EOF)) { - deliver_result(prt->common.id, ERTS_PORT_GET_CONNECTED(prt), am_eof); + deliver_result(prt, prt->common.id, ERTS_PORT_GET_CONNECTED(prt), am_eof); } else { /* XXX UGLY WORK AROUND, Let erts_deliver_port_exit() terminate the port */ if (prt->port_data_lock) @@ -7070,7 +7565,7 @@ driver_failure_term(ErlDrvPort ix, Eterm term, int eof) prt->ioq.size = 0; if (prt->port_data_lock) driver_pdl_unlock(prt->port_data_lock); - erts_deliver_port_exit(prt, prt->common.id, eof ? am_normal : term, 0); + erts_deliver_port_exit(prt, prt->common.id, eof ? am_normal : term, 0, 0); } return 0; } @@ -7506,6 +8001,8 @@ init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle) int fpe_was_unmasked = erts_block_fpe(); DTRACE4(driver_init, drv->name, drv->version.major, drv->version.minor, drv->flags); + LTTNG4(driver_init, drv->name, drv->version.major, drv->version.minor, + drv->flags); res = (*de->init)(); erts_unblock_fpe(fpe_was_unmasked); return res; diff --git a/erts/emulator/beam/lttng-wrapper.h b/erts/emulator/beam/lttng-wrapper.h new file mode 100644 index 0000000000..294872c365 --- /dev/null +++ b/erts/emulator/beam/lttng-wrapper.h @@ -0,0 +1,107 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2016. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifndef __LTTNG_WRAPPER_H__ +#define __LTTNG_WRAPPER_H__ + +#ifdef USE_LTTNG + +#include "erlang_lttng.h" +#define USE_LTTNG_VM_TRACEPOINTS + +#define LTTNG_BUFFER_SZ (256) +#define LTTNG_PROC_BUFFER_SZ (16) +#define LTTNG_PORT_BUFFER_SZ (20) +#define LTTNG_MFA_BUFFER_SZ (256) + +#define lttng_decl_procbuf(Name) \ + char Name[LTTNG_PROC_BUFFER_SZ] + +#define lttng_decl_portbuf(Name) \ + char Name[LTTNG_PORT_BUFFER_SZ] + +#define lttng_decl_mfabuf(Name) \ + char Name[LTTNG_MFA_BUFFER_SZ] + +#define lttng_decl_carrier_stats(Name) \ + lttng_carrier_stats_t Name##_STATSTRUCT, *Name = &Name##_STATSTRUCT + +#define lttng_pid_to_str(pid, name) \ + erts_snprintf(name, LTTNG_PROC_BUFFER_SZ, "%T", (pid)) + +#define lttng_portid_to_str(pid, name) \ + erts_snprintf(name, LTTNG_PORT_BUFFER_SZ, "%T", (pid)) + +#define lttng_proc_to_str(p, name) \ + lttng_pid_to_str(((p) ? (p)->common.id : ERTS_INVALID_PID), name) + +#define lttng_port_to_str(p, name) \ + lttng_portid_to_str(((p) ? (p)->common.id : ERTS_INVALID_PORT), name) + +#define lttng_mfa_to_str(m,f,a, Name) \ + erts_snprintf(Name, LTTNG_MFA_BUFFER_SZ, "%T:%T/%lu", (Eterm)(m), (Eterm)(f), (Uint)(a)) + +#define lttng_proc_to_mfa_str(p, Name) \ + do { \ + if (ERTS_PROC_IS_EXITING((p))) { \ + strcpy(Name, "<exiting>"); \ + } else { \ + BeamInstr *_fptr = find_function_from_pc((p)->i); \ + if (_fptr) { \ + lttng_mfa_to_str(_fptr[0],_fptr[1],_fptr[2], Name); \ + } else { \ + strcpy(Name, "<unknown>"); \ + } \ + } \ + } while(0) + +/* ErtsRunQueue->ErtsSchedulerData->Uint */ +#define lttng_rq_to_id(RQ) \ + (RQ)->scheduler->no + +#define LTTNG_ENABLED(Name) \ + tracepoint_enabled(com_ericsson_otp, Name) + +/* include a special LTTNG_DO for do_tracepoint ? */ +#define LTTNG1(Name, Arg1) \ + tracepoint(com_ericsson_otp, Name, (Arg1)) + +#define LTTNG2(Name, Arg1, Arg2) \ + tracepoint(com_ericsson_otp, Name, (Arg1), (Arg2)) + +#define LTTNG3(Name, Arg1, Arg2, Arg3) \ + tracepoint(com_ericsson_otp, Name, (Arg1), (Arg2), (Arg3)) + +#define LTTNG4(Name, Arg1, Arg2, Arg3, Arg4) \ + tracepoint(com_ericsson_otp, Name, (Arg1), (Arg2), (Arg3), (Arg4)) + +#define LTTNG5(Name, Arg1, Arg2, Arg3, Arg4, Arg5) \ + tracepoint(com_ericsson_otp, Name, (Arg1), (Arg2), (Arg3), (Arg4), (Arg5)) + +#else /* USE_LTTNG */ + +#define LTTNG1(Name, Arg1) do {} while(0) +#define LTTNG2(Name, Arg1, Arg2) do {} while(0) +#define LTTNG3(Name, Arg1, Arg2, Arg3) do {} while(0) +#define LTTNG4(Name, Arg1, Arg2, Arg3, Arg4) do {} while(0) +#define LTTNG5(Name, Arg1, Arg2, Arg3, Arg4, Arg5) do {} while(0) + +#endif /* USE_LTTNG */ +#endif /* __LTTNG_WRAPPER_H__ */ diff --git a/erts/emulator/beam/module.c b/erts/emulator/beam/module.c index 86dd3b5aac..3eb11f1693 100644 --- a/erts/emulator/beam/module.c +++ b/erts/emulator/beam/module.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -74,8 +74,8 @@ static Module* module_alloc(Module* tmpl) erts_smp_atomic_add_nob(&tot_module_bytes, sizeof(Module)); obj->module = tmpl->module; - obj->curr.code = 0; - obj->old.code = 0; + obj->curr.code_hdr = 0; + obj->old.code_hdr = 0; obj->curr.code_length = 0; obj->old.code_length = 0; obj->slot.index = -1; @@ -103,6 +103,9 @@ void init_module_table(void) f.cmp = (HCMP_FUN) module_cmp; f.alloc = (HALLOC_FUN) module_alloc; f.free = (HFREE_FUN) module_free; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; for (i = 0; i < ERTS_NUM_CODE_IX; i++) { erts_index_init(ERTS_ALC_T_MODULE_TABLE, &module_tables[i], "module_code", diff --git a/erts/emulator/beam/module.h b/erts/emulator/beam/module.h index c8a6351b04..4e12731d85 100644 --- a/erts/emulator/beam/module.h +++ b/erts/emulator/beam/module.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -26,7 +26,7 @@ #endif struct erl_module_instance { - BeamInstr* code; + BeamCodeHeader* code_hdr; int code_length; /* Length of loaded code in bytes. */ unsigned catches; struct erl_module_nif* nif; @@ -37,6 +37,7 @@ struct erl_module_instance { typedef struct erl_module { IndexSlot slot; /* Must be located at top of struct! */ int module; /* Atom index for module (not tagged). */ + int seen; /* Used by finish_loading() */ struct erl_module_instance curr; struct erl_module_instance old; /* protected by "old_code" rwlock */ diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 1d32e72247..879daaca0a 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2013. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -39,8 +39,8 @@ too_old_compiler | never() => # necessary.) Since the instructions don't work correctly in R12B, simply # refuse to load the module. -func_info M=a a==am_module_info A=u==0 | label L | move n r => too_old_compiler -func_info M=a a==am_module_info A=u==1 | label L | move n r => too_old_compiler +func_info M=a a==am_module_info A=u==0 | label L | move n x==0 => too_old_compiler +func_info M=a a==am_module_info A=u==1 | label L | move n x==0 => too_old_compiler # The undocumented and unsupported guard BIF is_constant/1 was removed # in R13. The is_constant/2 operation is marked as obsolete in genop.tab, @@ -76,17 +76,6 @@ return # with the following call instruction, we need to make sure that # there is no line/1 instruction between the move and the call. # - -move S r | line Loc | call_ext Ar Func => \ - line Loc | move S r | call_ext Ar Func -move S r | line Loc | call_ext_last Ar Func=u$is_bif D => \ - line Loc | move S r | call_ext_last Ar Func D -move S r | line Loc | call_ext_only Ar Func=u$is_bif => \ - line Loc | move S r | call_ext_only Ar Func -move S r | line Loc | call Ar Func => \ - line Loc | move S r | call Ar Func - -# # A tail-recursive call to an external function (non-BIF) will # never be saved on the stack, so there is no reason to keep # the line instruction. (The compiler did not remove the line @@ -94,10 +83,14 @@ move S r | line Loc | call Ar Func => \ # BIFs and ordinary Erlang functions.) # -line Loc | call_ext_last Ar Func=u$is_not_bif D => \ - call_ext_last Ar Func D -line Loc | call_ext_only Ar Func=u$is_not_bif => \ - call_ext_only Ar Func +move S X0=x==0 | line Loc | call_ext Ar Func => \ + line Loc | move S X0 | call_ext Ar Func +move S X0=x==0 | line Loc | call_ext_last Ar Func=u$is_not_bif D => \ + move S X0 | call_ext_last Ar Func D +move S X0=x==0 | line Loc | call_ext_only Ar Func=u$is_not_bif => \ + move S X0 | call_ext_only Ar Func +move S X0=x==0 | line Loc | call Ar Func => \ + line Loc | move S X0 | call Ar Func line Loc | func_info M F A => func_info M F A | line Loc @@ -167,66 +160,45 @@ 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_bins r f I i_select_val_bins x f I i_select_val_bins y f I -i_select_val_lins r f I i_select_val_lins x f I i_select_val_lins y f I -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 -i_jump_on_val r f I I i_jump_on_val x f I I i_jump_on_val y f I I -jump Target | label Lbl | same_label(Target, Lbl) => label Lbl - -is_ne_exact L1 S1 S2 | jump Fail | label L2 | same_label(L1, L2) => \ - is_eq_exact Fail S1 S2 | label L2 - %macro: get_list GetList -pack get_list x x x get_list x x y -get_list x x r get_list x y x get_list x y y -get_list x y r -get_list x r x -get_list x r y get_list y x x get_list y x y -get_list y x r get_list y y x get_list y y y -get_list y y r -get_list y r x -get_list y r y +# The following get_list instructions using x(0) are frequently used. get_list r x x +get_list r r y +get_list x r x get_list r x y -get_list r x r -get_list r y x -get_list r y y get_list r y r -get_list r r x -get_list r r y +get_list r x r # Old-style catch. catch y f @@ -237,33 +209,34 @@ try Y F => catch Y F try_case Y => try_end Y try_end y -try_case_end Literal=q => move Literal x | try_case_end x try_case_end s # Destructive set tuple element -set_tuple_element Lit=q Tuple Pos => move Lit x | set_tuple_element x Tuple Pos set_tuple_element s d P # Get tuple element %macro: i_get_tuple_element GetTupleElement -pack i_get_tuple_element x P x -i_get_tuple_element r P x i_get_tuple_element y P x -i_get_tuple_element x P r -i_get_tuple_element y P r %cold -i_get_tuple_element r P r i_get_tuple_element x P y -i_get_tuple_element r P y i_get_tuple_element y P y %hot +%macro: i_get_tuple_element2 GetTupleElement2 -pack +i_get_tuple_element2 x P x + +%macro: i_get_tuple_element2y GetTupleElement2Y -pack +i_get_tuple_element2y x P y y + +%macro: i_get_tuple_element3 GetTupleElement3 -pack +i_get_tuple_element3 x P x + %macro: is_number IsNumber -fail_action %cold -is_number f r is_number f x is_number f y %hot @@ -273,25 +246,28 @@ is_number Fail Literal=q => move Literal x | is_number Fail x jump f -case_end Literal=cq => move Literal x | case_end x -badmatch Literal=cq => move Literal x | badmatch x +case_end NotInX=cy => move NotInX x | case_end x +badmatch NotInX=cy => move NotInX x | badmatch x -case_end r case_end x -case_end y -badmatch r badmatch x -badmatch y if_end -raise s s + +# Operands for raise/2 are almost always in x(2) and x(1). +# Optimize for that case. +raise x==2 x==1 => i_raise +raise Trace=y Value=y => move Trace x=2 | move Value x=1 | i_raise +raise Trace Value => move Trace x=3 | move Value x=1 | move x=3 x=2 | i_raise + +i_raise # Internal now, but could be useful to make known to the compiler. badarg j system_limit j -move C=cxy r | jump Lbl => move_jump Lbl C +move C=cxy x==0 | jump Lbl => move_jump Lbl C %macro: move_jump MoveJump -nonext move_jump f n @@ -309,8 +285,6 @@ 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 @@ -323,24 +297,76 @@ move_window X1=x X2=x X3=x X4=x Y1=y Y4=y | move X5=x Y5=y | succ(Y4,Y5) => \ 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 +%macro: move_window3 MoveWindow3 -pack +%macro: move_window4 MoveWindow4 -pack +%macro: move_window5 MoveWindow5 -pack + 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 +# Swap registers. +move R1=x Tmp=x | move R2=xy R1 | move Tmp R2 => swap_temp R1 R2 Tmp + +swap_temp R1 R2 Tmp | line Loc | apply Live | is_killed_apply(Tmp, Live) => \ + swap R1 R2 | line Loc | apply Live + +swap_temp R1 R2 Tmp | line Loc | call Live Addr | is_killed(Tmp, Live) => \ + swap R1 R2 | line Loc | call Live Addr +swap_temp R1 R2 Tmp | call_only Live Addr | \ + is_killed(Tmp, Live) => swap R1 R2 | call_only Live Addr +swap_temp R1 R2 Tmp | call_last Live Addr D | \ + is_killed(Tmp, Live) => swap R1 R2 | call_last Live Addr D + +swap_temp R1 R2 Tmp | line Loc | call_ext Live Addr | is_killed(Tmp, Live) => \ + swap R1 R2 | line Loc | call_ext Live Addr +swap_temp R1 R2 Tmp | line Loc | call_ext_only Live Addr | \ + is_killed(Tmp, Live) => swap R1 R2 | line Loc | call_ext_only Live Addr +swap_temp R1 R2 Tmp | line Loc | call_ext_last Live Addr D | \ + is_killed(Tmp, Live) => swap R1 R2 | line Loc | call_ext_last Live Addr D + +%macro: swap_temp SwapTemp -pack +swap_temp x x x +swap_temp x y x + +%macro: swap Swap -pack +swap x x +swap x y + +move Src=x D1=x | move Src=x D2=x => move_dup Src D1 D2 +move Src=x SD=x | move SD=x D=x => move_dup Src SD D +move Src=x D1=x | move Src=x D2=y => move_dup Src D1 D2 +move Src=y SD=x | move SD=x D=y => move_dup Src SD D +move Src=x SD=x | move SD=x D=y => move_dup Src SD D +move Src=y SD=x | move SD=x D=x => move_dup Src SD D + +move SD=x D=x | move Src=xy SD=x => move_shift Src SD D +move SD=y D=x | move Src=x SD=y => move_shift Src SD D +move SD=x D=y | move Src=x SD=x => move_shift Src SD D + +# The transformations above guarantee that the source for +# the second move is not the same as the destination for +# the first move. That means that we can do the moves in +# parallel (fetch both values, then store them) which could +# be faster. + +move X1=x Y1=y | move X2=x Y2=y => move2_par X1 Y1 X2 Y2 +move Y1=y X1=x | move Y2=y X2=x => move2_par Y1 X1 Y2 X2 + +move X1=x X2=x | move X3=x X4=x => move2_par X1 X2 X3 X4 + +move X1=x X2=x | move X3=x Y1=y => move2_par X1 X2 X3 Y1 + +move S1=x S2=x | move X1=x Y1=y => move2_par S1 S2 X1 Y1 -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 S1=y S2=x | move X1=x Y1=y => move2_par 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 +move Y1=y X1=x | move S1=x D1=x => move2_par Y1 X1 S1 D1 +move S1=x D1=x | move Y1=y X1=x => move2_par 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 +move2_par X1=x Y1=y X2=x Y2=y | move X3=x Y3=y => move3 X1 Y1 X2 Y2 X3 Y3 +move2_par Y1=y X1=x Y2=y X2=x | move Y3=y X3=x => move3 Y1 X1 Y2 X2 Y3 X3 +move2_par 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 @@ -348,21 +374,32 @@ move C=aiq X=x==2 => move_x2 C move_x1 c move_x2 c -%macro: move2 Move2 -pack -move2 x y x y -move2 y x y x -move2 x x x x +%macro: move_shift MoveShift -pack +move_shift x x x +move_shift y x x +move_shift x y x +move_shift x x y -move2 x r x x +%macro: move_dup MoveDup -pack +move_dup x x x +move_dup x x y +move_dup y x x +move_dup y x y -move2 x r x y -move2 r y x y -move2 y r x y +%macro: move2_par Move2Par -pack -move2 r x y x -move2 y x r x +move2_par x y x y +move2_par y x y x +move2_par x x x x -%macro: move3 Move3 +move2_par x x x y + +move2_par y x x y + +move2_par x x y x +move2_par y x x x + +%macro: move3 Move3 -pack move3 x y x y x y move3 y x y x y x move3 x x x x x x @@ -375,20 +412,22 @@ move S=c D=y => move S x | move x D %macro:move Move -pack -gen_dest move x x move x y -move x r move y x -move y r -move r x -move r y -move c r move c x move n x -move n r move y y +# The following move instructions using x(0) are frequently used. + +move x r +move r x +move y r +move c r +move r y + # Receive operations. -loop_rec Fail Src | smp_mark_target_label(Fail) => i_loop_rec Fail Src +loop_rec Fail x==0 | smp_mark_target_label(Fail) => i_loop_rec Fail label L | wait_timeout Fail Src | smp_already_locked(L) => label L | i_wait_timeout_locked Fail Src wait_timeout Fail Src => i_wait_timeout Fail Src @@ -403,7 +442,7 @@ label L | timeout | smp_already_locked(L) => label L | timeout_locked remove_message timeout timeout_locked -i_loop_rec f r +i_loop_rec f loop_rec_end f wait f wait_locked f @@ -421,93 +460,57 @@ send # Optimized comparisons with one immediate/literal operand. # -is_eq_exact Lbl R=rxy C=ian => i_is_eq_exact_immed Lbl R C -is_eq_exact Lbl R=rxy C=q => i_is_eq_exact_literal R Lbl C +is_eq_exact Lbl R=xy C=ian => i_is_eq_exact_immed Lbl R C +is_eq_exact Lbl R=xy C=q => i_is_eq_exact_literal Lbl R C -is_ne_exact Lbl R=rxy C=ian => i_is_ne_exact_immed Lbl R C -is_ne_exact Lbl R=rxy C=q => i_is_ne_exact_literal R Lbl C +is_ne_exact Lbl R=xy C=ian => i_is_ne_exact_immed Lbl R C +is_ne_exact Lbl R=xy C=q => i_is_ne_exact_literal Lbl R C %macro: i_is_eq_exact_immed EqualImmed -fail_action i_is_eq_exact_immed f r c i_is_eq_exact_immed f x c i_is_eq_exact_immed f y c -i_is_eq_exact_literal r f c -i_is_eq_exact_literal x f c -i_is_eq_exact_literal y f c +i_is_eq_exact_literal f x c +i_is_eq_exact_literal f y c %macro: i_is_ne_exact_immed NotEqualImmed -fail_action -i_is_ne_exact_immed f r c i_is_ne_exact_immed f x c i_is_ne_exact_immed f y c -i_is_ne_exact_literal r f c -i_is_ne_exact_literal x f c -i_is_ne_exact_literal y f c +i_is_ne_exact_literal f x c +i_is_ne_exact_literal f y 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 Y=y X=x => is_eq_exact Lbl X Y +%macro: is_eq_exact EqualExact -fail_action -pack +is_eq_exact f x x +is_eq_exact f x y +is_eq_exact f s s -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 +%macro: is_lt IsLessThan -fail_action +is_lt f x x +is_lt f x c +is_lt f c x %cold -i_is_eq_exact_spec f r r +is_lt f s s %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 +%macro: is_ge IsGreaterEqual -fail_action +is_ge f x x +is_ge f x c +is_ge f c x %cold -i_is_lt_spec f r r -i_is_lt_spec f c c +is_ge f s s %hot -is_ge Lbl S1=xc S2=xc => i_is_ge_spec Lbl S1 S2 +%macro: is_ne_exact NotEqualExact -fail_action +is_ne_exact f s s -%macro: i_is_ge_spec IsGreaterEqual -fail_action +%macro: is_eq Equal -fail_action +is_eq f s s -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_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 - -i_is_eq_exact f -i_is_ne_exact f -i_is_lt f -i_is_ge f -i_is_eq f -i_is_ne f +%macro: is_ne NotEqual -fail_action +is_ne f s s # # Putting things. @@ -525,14 +528,13 @@ i_put_tuple Dst Arity Puts=* | put S => \ i_put_tuple/2 %macro:i_put_tuple PutTuple -pack -goto:do_put_tuple -i_put_tuple r I i_put_tuple x I i_put_tuple y I # -# The instruction "put_list Const [] Dst" will not be generated by -# the current BEAM compiler. But until R15A, play it safe by handling -# that instruction with the following transformation. +# The instruction "put_list Const [] Dst" were generated in rare +# circumstances up to and including OTP 18. Starting with OTP 19, +# AFAIK, it should never be generated. # put_list Const=c n Dst => move Const x | put_list x n Dst @@ -542,74 +544,36 @@ put_list x n x put_list y n x put_list x x x put_list y x x -put_list x x r -put_list y r r put_list y y x put_list x y x -put_list r x x -put_list r y x -put_list r x r -put_list y y r -put_list y r x -put_list r n x -put_list x r x -put_list x y r -put_list y x r put_list y x x -put_list x r r - # put_list SrcReg Constant Dst -put_list r c r -put_list r c x -put_list r c y -put_list x c r put_list x c x put_list x c y -put_list y c r put_list y c x -put_list y c y # put_list Constant SrcReg Dst -put_list c r r -put_list c r x -put_list c r y -put_list c x r put_list c x x -put_list c x y - -put_list c y r put_list c y x -put_list c y y -%cold -put_list s s d -%hot +# The following put_list instructions using x(0) are frequently used. -%macro: i_fetch FetchArgs -pack -i_fetch c r -i_fetch c x -i_fetch c y -i_fetch r c -i_fetch r x -i_fetch r y -i_fetch x c -i_fetch x r -i_fetch x x -i_fetch x y -i_fetch y c -i_fetch y r -i_fetch y x -i_fetch y y +put_list y r r +put_list x r r +put_list r n r +put_list r n x +put_list r x x +put_list r x r +put_list x x r %cold -i_fetch c c -i_fetch s s +put_list s s d %hot # @@ -631,27 +595,27 @@ return_trace # Note: There is no 'move_return y r', since there never are any y registers # when we do move_return (if we have y registers, we must do move_deallocate_return). -move S r | return => move_return S r +move S x==0 | return => move_return S %macro: move_return MoveReturn -nonext -move_return x r -move_return c r -move_return n r +move_return x +move_return c +move_return n -move S r | deallocate D | return => move_deallocate_return S r D +move S x==0 | deallocate D | return => move_deallocate_return S D %macro: move_deallocate_return MoveDeallocateReturn -pack -nonext -move_deallocate_return x r Q -move_deallocate_return y r Q -move_deallocate_return c r Q -move_deallocate_return n r Q +move_deallocate_return x Q +move_deallocate_return y Q +move_deallocate_return c Q +move_deallocate_return n Q deallocate D | return => deallocate_return D %macro: deallocate_return DeallocateReturn -nonext deallocate_return Q -test_heap Need u==1 | put_list Y=y r r => test_heap_1_put_list Need Y +test_heap Need u==1 | put_list Y=y x==0 x==0 => test_heap_1_put_list Need Y %macro: test_heap_1_put_list TestHeapPutList -pack test_heap_1_put_list I y @@ -660,18 +624,18 @@ test_heap_1_put_list I y is_tuple Fail Literal=q => move Literal x | is_tuple Fail x is_tuple Fail=f c => jump Fail -is_tuple Fail=f S=rxy | test_arity Fail=f S=rxy Arity => is_tuple_of_arity Fail S Arity +is_tuple Fail=f S=xy | test_arity Fail=f S=xy Arity => is_tuple_of_arity Fail S Arity %macro:is_tuple_of_arity IsTupleOfArity -fail_action +is_tuple_of_arity f r A is_tuple_of_arity f x A is_tuple_of_arity f y A -is_tuple_of_arity f r A %macro: is_tuple IsTuple -fail_action +is_tuple f r is_tuple f x is_tuple f y -is_tuple f r test_arity Fail Literal=q Arity => move Literal x | test_arity Fail x Arity test_arity Fail=f c Arity => jump Fail @@ -679,95 +643,66 @@ test_arity Fail=f c Arity => jump Fail %macro: test_arity IsArity -fail_action test_arity f x A test_arity f y A -test_arity f r A - -is_tuple_of_arity Fail=f Reg Arity | get_tuple_element Reg P=u==0 Dst=xy => \ - is_tuple_of_arity Fail Reg Arity | extract_next_element Dst | original_reg Reg P - -test_arity Fail Reg Arity | get_tuple_element Reg P=u==0 Dst=xy => \ - test_arity Fail Reg Arity | extract_next_element Dst | original_reg Reg P - -original_reg Reg P1 | get_tuple_element Reg P2 Dst=xy | succ(P1, P2) => \ - extract_next_element Dst | original_reg Reg P2 -get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst | original_reg Reg P +get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \ + get_tuple_element Reg=x P3 D3=x | \ + succ(P1, P2) | succ(P2, P3) | \ + succ(D1, D2) | succ(D2, D3) => i_get_tuple_element3 Reg P1 D1 -original_reg Reg Pos => +get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \ + succ(P1, P2) | succ(D1, D2) => i_get_tuple_element2 Reg P1 D1 -original_reg/2 +get_tuple_element Reg=x P1 D1=y | get_tuple_element Reg=x P2 D2=y | \ + succ(P1, P2) => i_get_tuple_element2y Reg P1 D1 D2 -extract_next_element D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \ -succ(P1, P2) | succ(D1, D2) => \ - extract_next_element2 D1 | original_reg Reg P2 - -extract_next_element2 D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \ -succ(P1, P2) | succ2(D1, D2) => \ - extract_next_element3 D1 | original_reg Reg P2 - -#extract_next_element3 D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \ -#succ(P1, P2) | succ3(D1, D2) => \ -# extract_next_element4 D1 | original_reg Reg P2 - -%macro: extract_next_element ExtractNextElement -pack -extract_next_element x -extract_next_element y - -%macro: extract_next_element2 ExtractNextElement2 -pack -extract_next_element2 x -extract_next_element2 y - -%macro: extract_next_element3 ExtractNextElement3 -pack -extract_next_element3 x -extract_next_element3 y - -#%macro: extract_next_element4 ExtractNextElement4 -pack -#extract_next_element4 x -#extract_next_element4 y +get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst is_integer Fail=f i => is_integer Fail=f an => jump Fail is_integer Fail Literal=q => move Literal x | is_integer Fail x -is_integer Fail=f S=rx | allocate Need Regs => is_integer_allocate Fail S Need Regs +is_integer Fail=f S=x | allocate Need Regs => is_integer_allocate Fail S Need Regs %macro: is_integer_allocate IsIntegerAllocate -fail_action is_integer_allocate f x I I -is_integer_allocate f r I I %macro: is_integer IsInteger -fail_action is_integer f x is_integer f y -is_integer f r is_list Fail=f n => is_list Fail Literal=q => move Literal x | is_list Fail x is_list Fail=f c => jump Fail %macro: is_list IsList -fail_action -is_list f r is_list f x %cold is_list f y %hot -is_nonempty_list Fail=f S=rx | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs +is_nonempty_list Fail=f S=x | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs %macro:is_nonempty_list_allocate IsNonemptyListAllocate -fail_action -pack -is_nonempty_list_allocate f x I t is_nonempty_list_allocate f r I t +is_nonempty_list_allocate f x I t -is_nonempty_list F=f r | test_heap I1 I2 => is_non_empty_list_test_heap F r I1 I2 +is_nonempty_list F=f x==0 | test_heap I1 I2 => is_non_empty_list_test_heap F I1 I2 %macro: is_non_empty_list_test_heap IsNonemptyListTestHeap -fail_action -pack -is_non_empty_list_test_heap f r I t +is_non_empty_list_test_heap f I t + +is_nonempty_list Fail=f S=x | get_list S D1=x D2=x => \ + is_nonempty_list_get_list Fail S D1 D2 + +%macro: is_nonempty_list_get_list IsNonemptyListGetList -fail_action -pack +is_nonempty_list_get_list f r x x +is_nonempty_list_get_list f x x x %macro: is_nonempty_list IsNonemptyList -fail_action is_nonempty_list f x is_nonempty_list f y -is_nonempty_list f r %macro: is_atom IsAtom -fail_action is_atom f x -is_atom f r %cold is_atom f y %hot @@ -775,7 +710,6 @@ is_atom Fail=f a => is_atom Fail=f niq => jump Fail %macro: is_float IsFloat -fail_action -is_float f r is_float f x %cold is_float f y @@ -789,12 +723,10 @@ is_nil Fail=f qia => jump Fail %macro: is_nil IsNil -fail_action is_nil f x is_nil f y -is_nil f r is_binary Fail Literal=q => move Literal x | is_binary Fail x is_binary Fail=f c => jump Fail %macro: is_binary IsBinary -fail_action -is_binary f r is_binary f x %cold is_binary f y @@ -806,7 +738,6 @@ is_bitstr Fail Term => is_bitstring Fail Term is_bitstring Fail Literal=q => move Literal x | is_bitstring Fail x is_bitstring Fail=f c => jump Fail %macro: is_bitstring IsBitstring -fail_action -is_bitstring f r is_bitstring f x %cold is_bitstring f y @@ -814,7 +745,6 @@ is_bitstring f y is_reference Fail=f cq => jump Fail %macro: is_reference IsRef -fail_action -is_reference f r is_reference f x %cold is_reference f y @@ -822,7 +752,6 @@ is_reference f y is_pid Fail=f cq => jump Fail %macro: is_pid IsPid -fail_action -is_pid f r is_pid f x %cold is_pid f y @@ -830,7 +759,6 @@ is_pid f y is_port Fail=f cq => jump Fail %macro: is_port IsPort -fail_action -is_port f r is_port f x %cold is_port f y @@ -842,14 +770,12 @@ is_boolean Fail=f ac => jump Fail %cold %macro: is_boolean IsBoolean -fail_action -is_boolean f r is_boolean f x is_boolean f y %hot is_function2 Fail=f acq Arity => jump Fail is_function2 Fail=f Fun a => jump Fail -is_function2 Fail Fun Literal=q => move Literal x | is_function2 Fail Fun x is_function2 f s s %macro: is_function2 IsFunction2 -fail_action @@ -989,76 +915,76 @@ call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate %unless USE_VM_PROBES call_ext Arity u$func:erlang:dt_get_tag/0 => \ - move a=am_undefined r + move a=am_undefined x=0 call_ext_last Arity u$func:erlang:dt_get_tag/0 D => \ - move a=am_undefined r | deallocate D | return + move a=am_undefined x=0 | deallocate D | return call_ext_only Arity u$func:erlang:dt_get_tag/0 => \ - move a=am_undefined r | return - -move Any r | call_ext Arity u$func:erlang:dt_put_tag/1 => \ - move a=am_undefined r -move Any r | call_ext_last Arity u$func:erlang:dt_put_tag/1 D => \ - move a=am_undefined r | deallocate D | return -move Any r | call_ext_only Arity u$func:erlang:dt_put_tag/1 => \ - move a=am_undefined r | return + move a=am_undefined x=0 | return + +move Any x==0 | call_ext Arity u$func:erlang:dt_put_tag/1 => \ + move a=am_undefined x=0 +move Any x==0 | call_ext_last Arity u$func:erlang:dt_put_tag/1 D => \ + move a=am_undefined x=0 | deallocate D | return +move Any x==0 | call_ext_only Arity u$func:erlang:dt_put_tag/1 => \ + move a=am_undefined x=0 | return call_ext Arity u$func:erlang:dt_put_tag/1 => \ - move a=am_undefined r + move a=am_undefined x=0 call_ext_last Arity u$func:erlang:dt_put_tag/1 D => \ - move a=am_undefined r | deallocate D | return + move a=am_undefined x=0 | deallocate D | return call_ext_only Arity u$func:erlang:dt_put_tag/1 => \ - move a=am_undefined r | return + move a=am_undefined x=0 | return call_ext Arity u$func:erlang:dt_get_tag_data/0 => \ - move a=am_undefined r + move a=am_undefined x=0 call_ext_last Arity u$func:erlang:dt_get_tag_data/0 D => \ - move a=am_undefined r | deallocate D | return + move a=am_undefined x=0 | deallocate D | return call_ext_only Arity u$func:erlang:dt_get_tag_data/0 => \ - move a=am_undefined r | return - -move Any r | call_ext Arity u$func:erlang:dt_spread_tag/1 => \ - move a=am_true r -move Any r | call_ext_last Arity u$func:erlang:dt_spread_tag/1 D => \ - move a=am_true r | deallocate D | return -move Any r | call_ext_only Arity u$func:erlang:dt_spread_tag/1 => \ - move a=am_true r | return + move a=am_undefined x=0 | return + +move Any x==0 | call_ext Arity u$func:erlang:dt_spread_tag/1 => \ + move a=am_true x=0 +move Any x==0 | call_ext_last Arity u$func:erlang:dt_spread_tag/1 D => \ + move a=am_true x=0 | deallocate D | return +move Any x==0 | call_ext_only Arity u$func:erlang:dt_spread_tag/1 => \ + move a=am_true x=0 | return call_ext Arity u$func:erlang:dt_spread_tag/1 => \ - move a=am_true r + move a=am_true x=0 call_ext_last Arity u$func:erlang:dt_spread_tag/1 D => \ - move a=am_true r | deallocate D | return + move a=am_true x=0 | deallocate D | return call_ext_only Arity u$func:erlang:dt_spread_tag/1 => \ - move a=am_true r | return - -move Any r | call_ext Arity u$func:erlang:dt_restore_tag/1 => \ - move a=am_true r -move Any r | call_ext_last Arity u$func:erlang:dt_restore_tag/1 D => \ - move a=am_true r | deallocate D | return -move Any r | call_ext_only Arity u$func:erlang:dt_restore_tag/1 => \ - move a=am_true r | return + move a=am_true x=0 | return + +move Any x==0 | call_ext Arity u$func:erlang:dt_restore_tag/1 => \ + move a=am_true x=0 +move Any x==0 | call_ext_last Arity u$func:erlang:dt_restore_tag/1 D => \ + move a=am_true x=0 | deallocate D | return +move Any x==0 | call_ext_only Arity u$func:erlang:dt_restore_tag/1 => \ + move a=am_true x=0 | return call_ext Arity u$func:erlang:dt_restore_tag/1 => \ - move a=am_true r + move a=am_true x=0 call_ext_last Arity u$func:erlang:dt_restore_tag/1 D => \ - move a=am_true r | deallocate D | return + move a=am_true x=0 | deallocate D | return call_ext_only Arity u$func:erlang:dt_restore_tag/1 => \ - move a=am_true r | return - -move Any r | call_ext Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \ - move Any r -move Any r | call_ext_last Arity u$func:erlang:dt_prepend_vm_tag_data/1 D => \ - move Any r | deallocate D | return -move Any r | call_ext_only Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \ - move Any r | return + move a=am_true x=0 | return + +move Any x==0 | call_ext Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \ + move Any x=0 +move Any x==0 | call_ext_last Arity u$func:erlang:dt_prepend_vm_tag_data/1 D => \ + move Any x=0 | deallocate D | return +move Any x==0 | call_ext_only Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \ + move Any x=0 | return call_ext Arity u$func:erlang:dt_prepend_vm_tag_data/1 => call_ext_last Arity u$func:erlang:dt_prepend_vm_tag_data/1 D => \ deallocate D | return call_ext_only Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \ return -move Any r | call_ext Arity u$func:erlang:dt_append_vm_tag_data/1 => \ - move Any r -move Any r | call_ext_last Arity u$func:erlang:dt_append_vm_tag_data/1 D => \ - move Any r | deallocate D | return -move Any r | call_ext_only Arity u$func:erlang:dt_append_vm_tag_data/1 => \ - move Any r | return +move Any x==0 | call_ext Arity u$func:erlang:dt_append_vm_tag_data/1 => \ + move Any x=0 +move Any x==0 | call_ext_last Arity u$func:erlang:dt_append_vm_tag_data/1 D => \ + move Any x=0 | deallocate D | return +move Any x==0 | call_ext_only Arity u$func:erlang:dt_append_vm_tag_data/1 => \ + move Any x=0 | return call_ext Arity u$func:erlang:dt_append_vm_tag_data/1 => call_ext_last Arity u$func:erlang:dt_append_vm_tag_data/1 D => \ deallocate D | return @@ -1066,10 +992,17 @@ call_ext_only Arity u$func:erlang:dt_append_vm_tag_data/1 => \ return # Can happen after one of the transformations above. -move Discarded r | move Something r => move Something r +move Discarded x==0 | move Something x==0 => move Something x=0 %endif +call_ext u==0 u$func:os:perf_counter/0 => \ + i_perf_counter +call_ext_last u==0 u$func:os:perf_counter/0 D => \ + i_perf_counter | deallocate_return D +call_ext_only u==0 u$func:os:perf_counter/0 => \ + i_perf_counter | return + # # The general case for BIFs that have no special instructions. # A BIF used in the tail must be followed by a return instruction. @@ -1091,9 +1024,9 @@ call_ext_only Ar=u Bif=u$is_bif => \ # with call instructions. # -move S=c r | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S r Func -move S=c r | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S r -move S=c r | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S r +move S=c x==0 | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S Func +move S=c x==0 | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S +move S=c x==0 | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S call_ext Ar Func => i_call_ext Func call_ext_last Ar Func D => i_call_ext_last Func D @@ -1109,6 +1042,8 @@ i_apply_fun_only i_hibernate +i_perf_counter + call_bif e # @@ -1118,80 +1053,74 @@ call_bif e bif0 u$bif:erlang:self/0 Dst=d => self Dst bif0 u$bif:erlang:node/0 Dst=d => node Dst -bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => i_get Src Dst +bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => gen_get(Src, Dst) -bif2 Jump=j u$bif:erlang:element/2 S1=s S2=rxy Dst=d => gen_element(Jump, S1, S2, Dst) +bif2 Jump=j u$bif:erlang:element/2 S1=s S2=xy Dst=d => gen_element(Jump, S1, S2, Dst) -bif1 Fail Bif Literal=q Dst => move Literal x | bif1 Fail Bif x Dst bif1 p Bif S1 Dst => bif1_body Bif S1 Dst -bif1_body Bif Literal=q Dst => move Literal x | bif1_body Bif x Dst - -bif2 p Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2_body Bif Dst -bif2 Fail Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst +bif2 p Bif S1 S2 Dst => i_bif2_body Bif S1 S2 Dst +bif2 Fail Bif S1 S2 Dst => i_bif2 Fail Bif S1 S2 Dst +i_get_hash c I d i_get s d %macro: self Self -self r self x self y %macro: node Node -node r node x %cold node y %hot -i_fast_element r j I d -i_fast_element x j I d -i_fast_element y j I d +i_fast_element j x I d +i_fast_element j y I d -i_element r j s d -i_element x j s d -i_element y j s d +i_element j x s d +i_element j y s d bif1 f b s d bif1_body b s d -i_bif2 f b d -i_bif2_body b d +i_bif2 f b s s d +i_bif2_body b s s d # # Internal calls. # -move S=c r | call Ar P=f => i_move_call S r P -move S=s r | call Ar P=f => move_call S r P +move S=c x==0 | call Ar P=f => i_move_call S P +move S=s x==0 | call Ar P=f => move_call S P -i_move_call c r f +i_move_call c f %macro:move_call MoveCall -arg_f -size -nonext -move_call/3 +move_call/2 -move_call x r f -move_call y r f +move_call x f +move_call y f -move S=c r | call_last Ar P=f D => i_move_call_last P D S r -move S r | call_last Ar P=f D => move_call_last S r P D +move S=c x==0 | call_last Ar P=f D => i_move_call_last P D S +move S x==0 | call_last Ar P=f D => move_call_last S P D -i_move_call_last f P c r +i_move_call_last f P c %macro:move_call_last MoveCallLast -arg_f -nonext -pack -move_call_last/4 -move_call_last x r f Q -move_call_last y r f Q +move_call_last/3 +move_call_last x f Q +move_call_last y f Q -move S=c r | call_only Ar P=f => i_move_call_only P S r -move S=x r | call_only Ar P=f => move_call_only S r P +move S=c x==0 | call_only Ar P=f => i_move_call_only P S +move S=x x==0 | call_only Ar P=f => move_call_only S P -i_move_call_only f c r +i_move_call_only f c %macro:move_call_only MoveCallOnly -arg_f -nonext -move_call_only/3 +move_call_only/2 -move_call_only x r f +move_call_only x f call Ar Func => i_call Func call_last Ar Func D => i_call_last Func D @@ -1205,9 +1134,9 @@ i_call_ext e i_call_ext_last e P i_call_ext_only e -i_move_call_ext c r e -i_move_call_ext_last e P c r -i_move_call_ext_only e c r +i_move_call_ext c e +i_move_call_ext_last e P c +i_move_call_ext_only e c # Fun calls. @@ -1227,7 +1156,6 @@ i_make_fun I t %macro: is_function IsFunction -fail_action is_function f x is_function f y -is_function f r is_function Fail=f c => jump Fail func_info M F A => i_func_info u M F A @@ -1239,131 +1167,105 @@ func_info M F A => i_func_info u M F A %cold bs_start_match2 Fail=f ica X Y D => jump Fail bs_start_match2 Fail Bin X Y D => i_bs_start_match2 Bin Fail X Y D -i_bs_start_match2 r f I I d i_bs_start_match2 x f I I d i_bs_start_match2 y f I I d bs_save2 Reg Index => gen_bs_save(Reg, Index) -i_bs_save2 r I i_bs_save2 x I bs_restore2 Reg Index => gen_bs_restore(Reg, Index) -i_bs_restore2 r I i_bs_restore2 x I # Matching integers bs_match_string Fail Ms Bits Val => i_bs_match_string Ms Fail Bits Val -i_bs_match_string r f I I i_bs_match_string x f I I # Fetching integers from binaries. -bs_get_integer2 Fail=f Ms=rx Live=u Sz=sq Unit=u Flags=u Dst=d => \ +bs_get_integer2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \ gen_get_integer2(Fail, Ms, Live, Sz, Unit, Flags, Dst) -i_bs_get_integer_small_imm r I f I d i_bs_get_integer_small_imm x I f I d -i_bs_get_integer_imm r I I f I d i_bs_get_integer_imm x I I f I d -i_bs_get_integer f I I d -i_bs_get_integer_8 r f d +i_bs_get_integer f I I s s d i_bs_get_integer_8 x f d -i_bs_get_integer_16 r f d i_bs_get_integer_16 x f d -i_bs_get_integer_32 r f I d i_bs_get_integer_32 x f I d # Fetching binaries from binaries. -bs_get_binary2 Fail=f Ms=rx Live=u Sz=sq Unit=u Flags=u Dst=d => \ +bs_get_binary2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \ gen_get_binary2(Fail, Ms, Live, Sz, Unit, Flags, Dst) %macro: i_bs_get_binary_imm2 BsGetBinaryImm_2 -fail_action -gen_dest %macro: i_bs_get_binary2 BsGetBinary_2 -fail_action -gen_dest %macro: i_bs_get_binary_all2 BsGetBinaryAll_2 -fail_action -gen_dest -i_bs_get_binary_imm2 f r I I I d i_bs_get_binary_imm2 f x I I I d -i_bs_get_binary2 f r I s I d i_bs_get_binary2 f x I s I d -i_bs_get_binary_all2 f r I I d i_bs_get_binary_all2 f x I I d -i_bs_get_binary_all_reuse r f I i_bs_get_binary_all_reuse x f I # Fetching float from binaries. -bs_get_float2 Fail=f Ms=rx Live=u Sz=s Unit=u Flags=u Dst=d => \ +bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \ gen_get_float2(Fail, Ms, Live, Sz, Unit, Flags, Dst) -bs_get_float2 Fail=f Ms=rx Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail +bs_get_float2 Fail=f Ms=x Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail %macro: i_bs_get_float2 BsGetFloat2 -fail_action -gen_dest -i_bs_get_float2 f r I s I d i_bs_get_float2 f x I s I d # Miscellanous -bs_skip_bits2 Fail=f Ms=rx Sz=s Unit=u Flags=u => \ - gen_skip_bits2(Fail, Ms, Sz, Unit, Flags) -bs_skip_bits2 Fail=f Ms=rx Sz=q Unit=u Flags=u => \ +bs_skip_bits2 Fail=f Ms=x Sz=sq Unit=u Flags=u => \ gen_skip_bits2(Fail, Ms, Sz, Unit, Flags) %macro: i_bs_skip_bits_imm2 BsSkipBitsImm2 -fail_action -i_bs_skip_bits_imm2 f r I i_bs_skip_bits_imm2 f x I %macro: i_bs_skip_bits2 BsSkipBits2 -fail_action -i_bs_skip_bits2 f r x I -i_bs_skip_bits2 f r y I i_bs_skip_bits2 f x x I -i_bs_skip_bits2 f x r I i_bs_skip_bits2 f x y I %macro: i_bs_skip_bits_all2 BsSkipBitsAll2 -fail_action -i_bs_skip_bits_all2 f r I i_bs_skip_bits_all2 f x I -bs_test_tail2 Fail=f Ms=rx Bits=u==0 => bs_test_zero_tail2 Fail Ms -bs_test_tail2 Fail=f Ms=rx Bits=u => bs_test_tail_imm2 Fail Ms Bits -bs_test_zero_tail2 f r +bs_test_tail2 Fail=f Ms=x Bits=u==0 => bs_test_zero_tail2 Fail Ms +bs_test_tail2 Fail=f Ms=x Bits=u => bs_test_tail_imm2 Fail Ms Bits bs_test_zero_tail2 f x -bs_test_tail_imm2 f r I bs_test_tail_imm2 f x I bs_test_unit F Ms Unit=u==8 => bs_test_unit8 F Ms -bs_test_unit f r I bs_test_unit f x I -bs_test_unit8 f r bs_test_unit8 f x -bs_context_to_binary r +# An y register operand for bs_context_to_binary is rare, +# but can happen because of inlining. + +bs_context_to_binary Y=y => move Y x | bs_context_to_binary x + bs_context_to_binary x -bs_context_to_binary y # # Utf8/utf16/utf32 support. (R12B-5) # -bs_get_utf8 Fail=f Ms=rx u u Dst=d => i_bs_get_utf8 Ms Fail Dst -i_bs_get_utf8 r f d +bs_get_utf8 Fail=f Ms=x u u Dst=d => i_bs_get_utf8 Ms Fail Dst i_bs_get_utf8 x f d -bs_skip_utf8 Fail=f Ms=rx u u => i_bs_get_utf8 Ms Fail x +bs_skip_utf8 Fail=f Ms=x u u => i_bs_get_utf8 Ms Fail x -bs_get_utf16 Fail=f Ms=rx u Flags=u Dst=d => i_bs_get_utf16 Ms Fail Flags Dst -bs_skip_utf16 Fail=f Ms=rx u Flags=u => i_bs_get_utf16 Ms Fail Flags x +bs_get_utf16 Fail=f Ms=x u Flags=u Dst=d => i_bs_get_utf16 Ms Fail Flags Dst +bs_skip_utf16 Fail=f Ms=x u Flags=u => i_bs_get_utf16 Ms Fail Flags x -i_bs_get_utf16 r f I d i_bs_get_utf16 x f I d -bs_get_utf32 Fail=f Ms=rx Live=u Flags=u Dst=d => \ +bs_get_utf32 Fail=f Ms=x Live=u Flags=u Dst=d => \ bs_get_integer2 Fail Ms Live i=32 u=1 Flags Dst | \ - i_fetch Dst Ms | \ - i_bs_validate_unicode_retract Fail -bs_skip_utf32 Fail=f Ms=rx Live=u Flags=u => \ + i_bs_validate_unicode_retract Fail Dst Ms +bs_skip_utf32 Fail=f Ms=x Live=u Flags=u => \ bs_get_integer2 Fail Ms Live i=32 u=1 Flags x | \ - i_fetch x Ms | \ - i_bs_validate_unicode_retract Fail + i_bs_validate_unicode_retract Fail x Ms -i_bs_validate_unicode_retract j +i_bs_validate_unicode_retract j s s %hot # @@ -1385,13 +1287,12 @@ bs_init2 Fail Sz=u Words Regs Flags Dst => \ bs_init2 Fail Sz Words=u==0 Regs Flags Dst => \ i_bs_init_fail Sz Fail Regs Dst bs_init2 Fail Sz Words Regs Flags Dst => \ - i_fetch Sz r | i_bs_init_fail_heap Words Fail Regs Dst + i_bs_init_fail_heap Sz Words Fail Regs Dst -i_bs_init_fail r j I d i_bs_init_fail x j I d i_bs_init_fail y j I d -i_bs_init_fail_heap I j I d +i_bs_init_fail_heap s I j I d i_bs_init I I d i_bs_init_heap_bin I I d @@ -1408,39 +1309,35 @@ bs_init_bits Fail Sz=u Words Regs Flags Dst => i_bs_init_bits_heap Sz Words Reg bs_init_bits Fail Sz Words=u==0 Regs Flags Dst => \ i_bs_init_bits_fail Sz Fail Regs Dst bs_init_bits Fail Sz Words Regs Flags Dst => \ - i_fetch Sz r | i_bs_init_bits_fail_heap Words Fail Regs Dst + i_bs_init_bits_fail_heap Sz Words Fail Regs Dst -i_bs_init_bits_fail r j I d i_bs_init_bits_fail x j I d i_bs_init_bits_fail y j I d -i_bs_init_bits_fail_heap I j I d +i_bs_init_bits_fail_heap s I j I d i_bs_init_bits I I d i_bs_init_bits_heap I I I d bs_add Fail S1=i==0 S2 Unit=u==1 D => move S2 D -bs_add Fail S1 S2 Unit D => i_fetch S1 S2 | i_bs_add Fail Unit D -i_bs_add j I d +bs_add j s s I d bs_append Fail Size Extra Live Unit Bin Flags Dst => \ - i_fetch Size Bin | i_bs_append Fail Extra Live Unit Dst + move Bin x | i_bs_append Fail Extra Live Unit Size Dst bs_private_append Fail Size Unit Bin Flags Dst => \ - i_fetch Size Bin | i_bs_private_append Fail Unit Dst + i_bs_private_append Fail Unit Size Bin Dst bs_init_writable -i_bs_append j I I I d -i_bs_private_append j I d +i_bs_append j I I I s d +i_bs_private_append j I s s d # # Storing integers into binaries. # -bs_put_integer Fail=j Sz=s Unit=u Flags=u Literal=q => \ - move Literal x | bs_put_integer Fail Sz Unit Flags x bs_put_integer Fail=j Sz=sq Unit=u Flags=u Src=s => \ gen_put_integer(Fail, Sz, Unit, Flags, Src) @@ -1454,32 +1351,20 @@ i_new_bs_put_integer_imm j I I s # Utf8/utf16/utf32 support. (R12B-5) # -bs_utf8_size Fail Literal=q Dst=d => \ - move Literal x | bs_utf8_size Fail x Dst bs_utf8_size j Src=s Dst=d => i_bs_utf8_size Src Dst i_bs_utf8_size s d -bs_utf16_size Fail Literal=q Dst=d => \ - move Literal x | bs_utf16_size Fail x Dst bs_utf16_size j Src=s Dst=d => i_bs_utf16_size Src Dst i_bs_utf16_size s d -bs_put_utf8 Fail=j Flags=u Literal=q => \ - move Literal x | bs_put_utf8 Fail Flags x bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src i_bs_put_utf8 j s -bs_put_utf16 Fail=j Flags=u Literal=q => \ - move Literal x | bs_put_utf16 Fail Flags x -bs_put_utf16 Fail Flags=u Src=s => i_bs_put_utf16 Fail Flags Src - -i_bs_put_utf16 j I s +bs_put_utf16 j I s -bs_put_utf32 Fail=j Flags=u Literal=q => \ - move Literal x | bs_put_utf32 Fail Flags x bs_put_utf32 Fail=j Flags=u Src=s => \ i_bs_validate_unicode Fail Src | bs_put_integer Fail i=32 u=1 Flags Src @@ -1490,9 +1375,6 @@ i_bs_validate_unicode j s # bs_put_float Fail Sz=q Unit Flags Val => badarg Fail -bs_put_float Fail=j Sz Unit=u Flags=u Literal=q => \ - move Literal x | bs_put_float Fail Sz Unit Flags x - bs_put_float Fail=j Sz=s Unit=u Flags=u Src=s => \ gen_put_float(Fail, Sz, Unit, Flags, Src) @@ -1506,8 +1388,6 @@ i_new_bs_put_float_imm j I I s # Storing binaries into binaries. # -bs_put_binary Fail Sz Unit Flags Literal=q => \ - move Literal x | bs_put_binary Fail Sz Unit Flags x bs_put_binary Fail=j Sz=s Unit=u Flags=u Src=s => \ gen_put_binary(Fail, Sz, Unit, Flags, Src) @@ -1600,7 +1480,6 @@ 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 @@ -1611,101 +1490,119 @@ has_map_fields Fail Src Size Rest=* => \ ## Transform get_map_elements(s) #{ K1 := V1, K2 := V2 } -get_map_elements Fail Src=rxy Size=u==2 Rest=* => \ +get_map_elements Fail Src=xy 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 -i_get_map_element Fail Src=rxy Key=ry Dst => \ +i_get_map_element Fail Src=xy Key=y Dst => \ move Key x | i_get_map_element Fail Src x Dst %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 x r -i_get_map_element f x x r -i_get_map_element f y x r -i_get_map_element f r x x i_get_map_element f x x x i_get_map_element f y x x -i_get_map_element f r x y i_get_map_element f x x y i_get_map_element f y x y # +# Convert the plus operations to a generic plus instruction. +# +gen_plus/5 +gen_minus/5 + +gc_bif1 Fail Live u$bif:erlang:splus/1 Src Dst => \ + gen_plus Fail Live Src i Dst +gc_bif2 Fail Live u$bif:erlang:splus/2 S1 S2 Dst => \ + gen_plus Fail Live S1 S2 Dst + +gc_bif1 Fail Live u$bif:erlang:sminus/1 Src Dst => \ + gen_minus Fail Live i Src Dst +gc_bif2 Fail Live u$bif:erlang:sminus/2 S1 S2 Dst => \ + gen_minus Fail Live S1 S2 Dst + +# # Optimize addition and subtraction of small literals using # the i_increment/4 instruction (in bodies, not in guards). # -gc_bif2 p Live u$bif:erlang:splus/2 Int=i Reg=d Dst => \ +gen_plus p Live Int=i Reg=d Dst => \ gen_increment(Reg, Int, Live, Dst) -gc_bif2 p Live u$bif:erlang:splus/2 Reg=d Int=i Dst => \ +gen_plus p Live Reg=d Int=i Dst => \ gen_increment(Reg, Int, Live, Dst) -gc_bif2 p Live u$bif:erlang:sminus/2 Reg=d Int=i Dst | \ - negation_is_small(Int) => \ +gen_minus p Live Reg=d Int=i Dst | negation_is_small(Int) => \ gen_increment_from_minus(Reg, Int, Live, 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 +gen_plus Fail Live S1 S2 Dst => i_plus Fail Live S1 S2 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 +gen_minus Fail Live S1 S2 Dst => i_minus Fail Live S1 S2 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 Live u$bif:erlang:stimes/2 S1 S2 Dst => \ + i_times Fail Live S1 S2 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 +gc_bif2 Fail Live u$bif:erlang:div/2 S1 S2 Dst => \ + i_m_div Fail Live S1 S2 Dst +gc_bif2 Fail Live u$bif:erlang:intdiv/2 S1 S2 Dst => \ + i_int_div Fail Live S1 S2 Dst -gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst +gc_bif2 Fail Live u$bif:erlang:rem/2 S1 S2 Dst => \ + i_rem Fail Live S1 S2 Dst + +gc_bif2 Fail Live u$bif:erlang:bsl/2 S1 S2 Dst => \ + i_bsl Fail Live S1 S2 Dst +gc_bif2 Fail Live u$bif:erlang:bsr/2 S1 S2 Dst => \ + i_bsr Fail Live S1 S2 Dst + +gc_bif2 Fail Live u$bif:erlang:band/2 S1 S2 Dst => \ + i_band Fail Live S1 S2 Dst -gc_bif1 Fail I u$bif:erlang:sminus/1 Src Dst=d => i_fetch i Src | i_minus Fail I Dst -gc_bif1 Fail I u$bif:erlang:splus/1 Src Dst=d => i_fetch i Src | i_plus Fail I Dst +gc_bif2 Fail Live u$bif:erlang:bor/2 S1 S2 Dst => \ + i_bor Fail Live S1 S2 Dst + +gc_bif2 Fail Live u$bif:erlang:bxor/2 S1 S2 Dst => \ + i_bxor Fail Live S1 S2 Dst + +gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst 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_plus j I x y d +i_plus j I s s 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_minus j I s s d + +i_times j I s s d + +i_m_div j I s s d +i_int_div j I s s d + i_rem j I x x d -i_rem j I d +i_rem j I s s d -i_bsl j I d -i_bsr j I d +i_bsl j I s s d +i_bsr j I s s d i_band j I x c d -i_band j I d -i_bor j I d -i_bxor j I d +i_band j I s s d + +i_bor j I s s d +i_bxor j I s s d i_int_bnot j s I d @@ -1731,21 +1628,18 @@ gc_bif2 Fail I Bif S1 S2 Dst => \ gc_bif3 Fail I Bif S1 S2 S3 Dst => \ gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst) -i_gc_bif1 Fail Bif V=q Live D => move V x | i_gc_bif1 Fail Bif x Live D - i_gc_bif1 j I s I d -ii_gc_bif2/6 - -ii_gc_bif2 Fail Bif S1 S2 Live D => i_fetch S1 S2 | i_gc_bif2 Fail Bif Live D - -i_gc_bif2 j I I d +i_gc_bif2 j I I s s d ii_gc_bif3/7 -ii_gc_bif3 Fail Bif S1 S2 S3 Live D => move S1 x | i_fetch S2 S3 | i_gc_bif3 Fail Bif x Live D +# A specific instruction can only have 6 operands, so we must +# pass one of the arguments in an x register. +ii_gc_bif3 Fail Bif Live S1 S2 S3 Dst => \ + move S1 x | i_gc_bif3 Fail Bif Live S2 S3 Dst -i_gc_bif3 j I s I d +i_gc_bif3 j I I s s d # # The following instruction is specially handled in beam_load.c diff --git a/erts/emulator/beam/packet_parser.c b/erts/emulator/beam/packet_parser.c index a737a86f14..f14910bc72 100644 --- a/erts/emulator/beam/packet_parser.c +++ b/erts/emulator/beam/packet_parser.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2013. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/packet_parser.h b/erts/emulator/beam/packet_parser.h index 717d905fad..358d650804 100644 --- a/erts/emulator/beam/packet_parser.h +++ b/erts/emulator/beam/packet_parser.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/register.c b/erts/emulator/beam/register.c index 020e61d136..77f79fcea4 100644 --- a/erts/emulator/beam/register.c +++ b/erts/emulator/beam/register.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -151,6 +151,9 @@ void init_register_table(void) f.cmp = (HCMP_FUN) reg_cmp; f.alloc = (HALLOC_FUN) reg_alloc; f.free = (HFREE_FUN) reg_free; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; hash_init(ERTS_ALC_T_REG_TABLE, &process_reg, "process_reg", PREG_HASH_SIZE, f); @@ -223,7 +226,8 @@ int erts_register_name(Process *c_p, Eterm name, Eterm id) rp = (RegProc*) hash_put(&process_reg, (void*) &r); if (proc && rp->p == proc) { if (IS_TRACED_FL(proc, F_TRACE_PROCS)) { - trace_proc(c_p, proc, am_register, name); + trace_proc(proc, ERTS_PROC_LOCK_MAIN, + proc, am_register, name); } proc->common.u.alive.reg = rp; } @@ -467,8 +471,8 @@ int erts_unregister_name(Process *c_p, int res = 0; RegProc r, *rp; Port *port = c_prt; + ErtsProcLocks current_c_p_locks = 0; #ifdef ERTS_SMP - ErtsProcLocks current_c_p_locks; /* * SMP note: If 'c_prt != NULL' and 'c_prt->reg->name == name', @@ -534,8 +538,12 @@ int erts_unregister_name(Process *c_p, ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(port)); rp->pt->common.u.alive.reg = NULL; - + if (IS_TRACED_FL(port, F_TRACE_PORTS)) { + if (current_c_p_locks) { + erts_smp_proc_unlock(c_p, current_c_p_locks); + current_c_p_locks = 0; + } trace_port(port, am_unregister, r.name); } @@ -552,7 +560,8 @@ int erts_unregister_name(Process *c_p, #endif rp->p->common.u.alive.reg = NULL; if (IS_TRACED_FL(rp->p, F_TRACE_PROCS)) { - trace_proc(c_p, rp->p, am_unregister, r.name); + trace_proc(rp->p, (c_p == rp->p) ? c_p_locks : ERTS_PROC_LOCK_MAIN, + rp->p, am_unregister, r.name); } #ifdef ERTS_SMP if (rp->p != c_p) { diff --git a/erts/emulator/beam/register.h b/erts/emulator/beam/register.h index 144536f34b..88ab7b7bf1 100644 --- a/erts/emulator/beam/register.h +++ b/erts/emulator/beam/register.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2012. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/safe_hash.c b/erts/emulator/beam/safe_hash.c index 3f039c8dfd..30b26a7296 100644 --- a/erts/emulator/beam/safe_hash.c +++ b/erts/emulator/beam/safe_hash.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2011. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/safe_hash.h b/erts/emulator/beam/safe_hash.h index a11370813c..6910b33004 100644 --- a/erts/emulator/beam/safe_hash.h +++ b/erts/emulator/beam/safe_hash.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 6497a1e648..748fba15c7 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -21,6 +21,19 @@ #ifndef __SYS_H__ #define __SYS_H__ +#if !defined(__GNUC__) +# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) 0 +#elif !defined(__GNUC_MINOR__) +# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \ + ((__GNUC__ << 24) >= (((MAJ) << 24) | ((MIN) << 12) | (PL))) +#elif !defined(__GNUC_PATCHLEVEL__) +# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \ + (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12)) >= (((MAJ) << 24) | ((MIN) << 12) | (PL))) +#else +# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \ + (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12) | __GNUC_PATCHLEVEL__) >= (((MAJ) << 24) | ((MIN) << 12) | (PL))) +#endif + #ifdef ERTS_INLINE # ifndef ERTS_CAN_INLINE # define ERTS_CAN_INLINE 1 @@ -38,6 +51,17 @@ # endif #endif +#ifndef ERTS_FORCE_INLINE +# if ERTS_AT_LEAST_GCC_VSN__(3,1,1) +# define ERTS_FORCE_INLINE __inline__ __attribute__((__always_inline__)) +# elif defined(__WIN32__) +# define ERTS_FORCE_INLINE __forceinline +# endif +# ifndef ERTS_FORCE_INLINE +# define ERTS_FORCE_INLINE ERTS_INLINE +# endif +#endif + #if defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK) # undef ERTS_CAN_INLINE # define ERTS_CAN_INLINE 0 @@ -46,8 +70,10 @@ #endif #if ERTS_CAN_INLINE +#define ERTS_GLB_FORCE_INLINE static ERTS_FORCE_INLINE #define ERTS_GLB_INLINE static ERTS_INLINE #else +#define ERTS_GLB_FORCE_INLINE #define ERTS_GLB_INLINE #endif @@ -61,22 +87,14 @@ # define NO_FPE_SIGNALS #endif -#ifdef DISABLE_CHILD_WAITER_THREAD -#undef ENABLE_CHILD_WAITER_THREAD -#endif - -#if defined(ERTS_SMP) && !defined(DISABLE_CHILD_WAITER_THREAD) -#undef ENABLE_CHILD_WAITER_THREAD -#define ENABLE_CHILD_WAITER_THREAD 1 -#endif - #define ERTS_I64_LITERAL(X) X##LL +#define ErtsInArea(ptr,start,nbytes) \ + ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes)) + #if defined (__WIN32__) # include "erl_win_sys.h" -#elif defined (__OSE__) -# include "erl_ose_sys.h" -#else +#else # include "erl_unix_sys.h" #ifndef UNIX # define UNIX 1 @@ -111,19 +129,6 @@ typedef int ErtsSysFdType; typedef ERTS_SYS_FD_TYPE ErtsSysFdType; #endif -#if !defined(__GNUC__) -# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) 0 -#elif !defined(__GNUC_MINOR__) -# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \ - ((__GNUC__ << 24) >= (((MAJ) << 24) | ((MIN) << 12) | (PL))) -#elif !defined(__GNUC_PATCHLEVEL__) -# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \ - (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12)) >= (((MAJ) << 24) | ((MIN) << 12) | (PL))) -#else -# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \ - (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12) | __GNUC_PATCHLEVEL__) >= (((MAJ) << 24) | ((MIN) << 12) | (PL))) -#endif - #if ERTS_AT_LEAST_GCC_VSN__(2, 96, 0) # define ERTS_LIKELY(BOOL) __builtin_expect((BOOL), !0) # define ERTS_UNLIKELY(BOOL) __builtin_expect((BOOL), 0) @@ -131,6 +136,17 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType; # define ERTS_LIKELY(BOOL) (BOOL) # define ERTS_UNLIKELY(BOOL) (BOOL) #endif + +#if ERTS_AT_LEAST_GCC_VSN__(2, 96, 0) +#if (defined(__APPLE__) && defined(__MACH__)) || defined(__DARWIN__) +# define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("__DATA,ERTS_LOW_WRITE") )) +#else +# define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("ERTS_LOW_WRITE") )) +#endif +#else +# define ERTS_WRITE_UNLIKELY(X) X +#endif + #ifdef __GNUC__ # if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ > 5) # define ERTS_DECLARE_DUMMY(X) X __attribute__ ((unused)) @@ -191,6 +207,12 @@ __decl_noreturn void __noreturn erl_assert_error(const char* expr, const char *f # define ASSERT(e) ((void) 1) #endif +#ifdef ERTS_SMP +# define ERTS_SMP_ASSERT(e) ASSERT(e) +#else +# define ERTS_SMP_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. @@ -285,62 +307,11 @@ __decl_noreturn void __noreturn erl_assert_error(const char* expr, const char *f #else #error Neither 32 nor 64 bit architecture #endif -#if defined(ARCH_64) && defined(HALFWORD_HEAP_EMULATOR) -# define HALFWORD_HEAP 1 -# define HALFWORD_ASSERT 0 -# define ASSERT_HALFWORD(COND) ASSERT(COND) -# undef ERTS_SIZEOF_TERM -# define ERTS_SIZEOF_TERM 4 -#else -# define HALFWORD_HEAP 0 -# define HALFWORD_ASSERT 0 -# define ASSERT_HALFWORD(COND) -#endif #if SIZEOF_VOID_P != SIZEOF_SIZE_T #error sizeof(void*) != sizeof(size_t) #endif -#if HALFWORD_HEAP - -#if SIZEOF_INT == 4 -typedef unsigned int Eterm; -typedef unsigned int Uint; -typedef int Sint; -#define ERTS_UINT_MAX UINT_MAX -#define ERTS_SIZEOF_ETERM SIZEOF_INT -#define ErtsStrToSint strtol -#else -#error Found no appropriate type to use for 'Eterm', 'Uint' and 'Sint' -#endif - -#if SIZEOF_VOID_P == SIZEOF_LONG -typedef unsigned long UWord; -typedef long SWord; -#define SWORD_CONSTANT(Const) Const##L -#define UWORD_CONSTANT(Const) Const##UL -#define ERTS_UWORD_MAX ULONG_MAX -#define ERTS_SWORD_MAX LONG_MAX -#elif SIZEOF_VOID_P == SIZEOF_INT -typedef unsigned int UWord; -typedef int SWord; -#define SWORD_CONSTANT(Const) Const -#define UWORD_CONSTANT(Const) Const##U -#define ERTS_UWORD_MAX UINT_MAX -#define ERTS_SWORD_MAX INT_MAX -#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG -typedef unsigned long long UWord; -typedef long long SWord; -#define SWORD_CONSTANT(Const) Const##LL -#define UWORD_CONSTANT(Const) Const##ULL -#define ERTS_UWORD_MAX ULLONG_MAX -#define ERTS_SWORD_MAX LLONG_MAX -#else -#error Found no appropriate type to use for 'Eterm', 'Uint' and 'Sint' -#endif - -#else /* !HALFWORD_HEAP */ - #if SIZEOF_VOID_P == SIZEOF_LONG typedef unsigned long Eterm; typedef unsigned long Uint; @@ -383,8 +354,6 @@ typedef Uint UWord; typedef Sint SWord; #define ERTS_UINT_MAX ERTS_UWORD_MAX -#endif /* HALFWORD_HEAP */ - typedef UWord BeamInstr; #ifndef HAVE_INT64 @@ -675,6 +644,15 @@ typedef struct preload { unsigned char* code; /* Code pointer */ } Preload; +/* + * ErtsTracer is either NIL, 'true' or [Mod | State] + * + * If set to NIL, it means no tracer. + * If set to 'true' it means the current process' tracer. + * If set to [Mod | State], there is a tracer. + * See erts_tracer_update for more details + */ +typedef Eterm ErtsTracer; /* * This structure contains options to all built in drivers. @@ -786,6 +764,7 @@ void erts_sys_main_thread(void); extern int erts_sys_prepare_crash_dump(int secs); extern void erts_sys_pre_init(void); extern void erl_sys_init(void); +extern void erl_sys_late_init(void); extern void erl_sys_args(int *argc, char **argv); extern void erl_sys_schedule(int); void sys_tty_reset(int); @@ -1103,7 +1082,6 @@ extern int erts_use_kernel_poll; #define put_int8(i, s) do {((unsigned char*)(s))[0] = (i) & 0xff;} while (0) - /* * Use DEBUGF as you would use printf, but use double parentheses: * diff --git a/erts/emulator/beam/time.c b/erts/emulator/beam/time.c index 988338ed81..6f15082130 100644 --- a/erts/emulator/beam/time.c +++ b/erts/emulator/beam/time.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -278,9 +278,14 @@ ErtsMonotonicTime erts_check_next_timeout_time(ErtsSchedulerData *esdp) { ErtsTimerWheel *tiw = esdp->timer_wheel; + ErtsMonotonicTime time; + ERTS_MSACC_DECLARE_CACHE_X(); if (tiw->true_next_timeout_time) return tiw->next_timeout_time; - return find_next_timeout(esdp, tiw, 1, 0, 0); + ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(ERTS_MSACC_STATE_TIMERS); + time = find_next_timeout(esdp, tiw, 1, 0, 0); + ERTS_MSACC_POP_STATE_M_X(); + return time; } #ifndef ERTS_TW_DEBUG @@ -336,6 +341,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) { int tiw_pos_ix, slots, yielded_slot_restarted, yield_count; ErtsMonotonicTime bump_to, tmp_slots, old_pos; + ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS); yield_count = ERTS_TWHEEL_BUMP_YIELD_LIMIT; @@ -371,6 +377,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) tiw->next_timeout_time = curr_time + ERTS_MONOTONIC_DAY; tiw->pos = bump_to; tiw->yield_slot = ERTS_TWHEEL_SLOT_INACTIVE; + ERTS_MSACC_POP_STATE_M_X(); return; } @@ -382,6 +389,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) tiw->yield_slot = ERTS_TWHEEL_SLOT_AT_ONCE; tiw->true_next_timeout_time = 1; tiw->next_timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(old_pos); + ERTS_MSACC_POP_STATE_M_X(); return; } @@ -400,8 +408,10 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) p = tiw->at_once.head; } - if (tiw->pos >= bump_to) + if (tiw->pos >= bump_to) { + ERTS_MSACC_POP_STATE_M_X(); break; + } if (tiw->nto == 0) goto empty_wheel; @@ -478,6 +488,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) tiw->yield_slot = tiw_pos_ix; tiw->yield_slots_left = slots; tiw->yield_start_pos = old_pos; + ERTS_MSACC_POP_STATE_M_X(); return; /* Yield! */ } @@ -500,6 +511,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) /* Search at most two seconds ahead... */ (void) find_next_timeout(NULL, tiw, 0, curr_time, ERTS_SEC_TO_MONOTONIC(2)); + ERTS_MSACC_POP_STATE_M_X(); } Uint @@ -569,6 +581,7 @@ erts_twheel_set_timer(ErtsTimerWheel *tiw, ErtsMonotonicTime timeout_pos) { ErtsMonotonicTime timeout_time; + ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS); p->u.func.timeout = timeout; p->u.func.cancel = cancel; @@ -612,6 +625,7 @@ erts_twheel_set_timer(ErtsTimerWheel *tiw, tiw->true_next_timeout_time = 1; tiw->next_timeout_time = timeout_time; } + ERTS_MSACC_POP_STATE_M_X(); } void @@ -620,11 +634,13 @@ erts_twheel_cancel_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p) if (p->slot != ERTS_TWHEEL_SLOT_INACTIVE) { ErlCancelProc cancel; void *arg; + ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS); remove_timer(tiw, p); cancel = p->u.func.cancel; arg = p->u.func.arg; if (cancel) (*cancel)(arg); + ERTS_MSACC_POP_STATE_M_X(); } } diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index b9ce70e364..68006e7ef3 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -71,46 +71,10 @@ #define HAVE_MALLOPT 0 #endif -/* profile_scheduler mini message queue */ - -typedef struct { - Uint scheduler_id; - Uint no_schedulers; - Uint Ms; - Uint s; - Uint us; - Eterm state; -} profile_sched_msg; - -typedef struct { - profile_sched_msg msg[2]; - Uint n; -} profile_sched_msg_q; - -#ifdef ERTS_SMP - -#if 0 /* Unused */ -static void -dispatch_profile_msg_q(profile_sched_msg_q *psmq) -{ - int i = 0; - profile_sched_msg *msg = NULL; - ASSERT(psmq != NULL); - for (i = 0; i < psmq->n; i++) { - msg = &(psmq->msg[i]); - profile_scheduler_q(make_small(msg->scheduler_id), msg->state, am_undefined, msg->Ms, msg->s, msg->us); - } -} -#endif - -#endif - - Eterm* erts_heap_alloc(Process* p, Uint need, Uint xtra) { ErlHeapFragment* bp; - Eterm* htop; Uint n; #if defined(DEBUG) || defined(CHECK_FOR_HOLES) Uint i; @@ -156,16 +120,6 @@ erts_heap_alloc(Process* p, Uint need, Uint xtra) n--; #endif - /* - * When we have created a heap fragment, we are no longer allowed - * to store anything more on the heap. - */ - htop = HEAP_TOP(p); - if (htop < HEAP_LIMIT(p)) { - *htop = make_pos_bignum_header(HEAP_LIMIT(p)-htop-1); - HEAP_TOP(p) = HEAP_LIMIT(p); - } - bp->next = MBUF(p); MBUF(p) = bp; bp->alloc_size = n; @@ -269,6 +223,31 @@ erl_grow_pstack(ErtsPStack* s, void* default_pstack, unsigned need_bytes) s->psp = s->pstart + sp_offs; } +/* + * Helper function for the EQUEUE macros defined in global.h. + */ + +void +erl_grow_equeue(ErtsEQueue* q, Eterm* default_equeue) +{ + Uint old_size = (q->end - q->start); + Uint new_size = old_size * 2; + Uint first_part = (q->end - q->front); + Uint second_part = (q->back - q->start); + Eterm* new_ptr = erts_alloc(q->alloc_type, new_size*sizeof(Eterm)); + ASSERT(q->back == q->front); // of course the queue is full now! + if (first_part > 0) + sys_memcpy(new_ptr, q->front, first_part*sizeof(Eterm)); + if (second_part > 0) + sys_memcpy(new_ptr+first_part, q->start, second_part*sizeof(Eterm)); + if (q->start != default_equeue) + erts_free(q->alloc_type, q->start); + q->start = new_ptr; + q->end = q->start + new_size; + q->front = q->start; + q->back = q->start + old_size; +} + /* CTYPE macros */ #define LATIN1 @@ -303,10 +282,10 @@ erl_grow_pstack(ErtsPStack* s, void* default_pstack, unsigned need_bytes) * Calculate length of a list. * Returns -1 if not a proper list (i.e. not terminated with NIL) */ -int +Sint erts_list_length(Eterm list) { - int i = 0; + Sint i = 0; while(is_list(list)) { i++; @@ -894,7 +873,7 @@ tail_recur: Uint y2 = y1 < 0 ? -(Uint)y1 : y1; UINT32_HASH_STEP(y2, FUNNY_NUMBER2); -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) if (y2 >> 32) UINT32_HASH_STEP(y2 >> 32, FUNNY_NUMBER2); #endif @@ -1015,7 +994,7 @@ tail_recur: } d = BIG_DIGIT(ptr, k); k = sizeof(ErtsDigit); -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) if (!(d >> 32)) k /= 2; #endif @@ -1985,7 +1964,7 @@ tail_recur: (atom_tab(atom_val(term))->slot.bucket.hvalue); break; case SMALL_DEF: -#if defined(ARCH_64) && !HALFWORD_HEAP +#if defined(ARCH_64) { Sint y1 = signed_val(term); Uint y2 = y1 < 0 ? -(Uint)y1 : y1; @@ -2281,7 +2260,11 @@ static void do_send_logger_message(Eterm *hp, ErlOffHeap *ohp, ErlHeapFragment * erts_queue_error_logger_message(from, message, bp); } #else - erts_queue_message(p, NULL /* only used for smp build */, bp, message, NIL); + { + ErtsMessage *mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = bp; + erts_queue_message(p, NULL /* only used for smp build */, mp, message); + } #endif } @@ -2594,11 +2577,7 @@ erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *dsbufp) * Test for equality of two terms. * Returns 0 if not equal, or a non-zero value otherwise. */ -#if HALFWORD_HEAP -int eq_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base) -#else int eq(Eterm a, Eterm b) -#endif { DECLARE_WSTACK(stack); Sint sz; @@ -2606,18 +2585,18 @@ int eq(Eterm a, Eterm b) Eterm* bb; tailrecur: - if (is_same(a, a_base, b, b_base)) goto pop_next; + if (is_same(a, b)) goto pop_next; tailrecur_ne: switch (primary_tag(a)) { case TAG_PRIMARY_LIST: if (is_list(b)) { - Eterm* aval = list_val_rel(a, a_base); - Eterm* bval = list_val_rel(b, b_base); + Eterm* aval = list_val(a); + Eterm* bval = list_val(b); while (1) { Eterm atmp = CAR(aval); Eterm btmp = CAR(bval); - if (!is_same(atmp,a_base,btmp,b_base)) { + if (!is_same(atmp,btmp)) { WSTACK_PUSH2(stack,(UWord) CDR(bval),(UWord) CDR(aval)); a = atmp; b = btmp; @@ -2625,7 +2604,7 @@ tailrecur_ne: } atmp = CDR(aval); btmp = CDR(bval); - if (is_same(atmp,a_base,btmp,b_base)) { + if (is_same(atmp,btmp)) { goto pop_next; } if (is_not_list(atmp) || is_not_list(btmp)) { @@ -2633,22 +2612,22 @@ tailrecur_ne: b = btmp; goto tailrecur_ne; } - aval = list_val_rel(atmp, a_base); - bval = list_val_rel(btmp, b_base); + aval = list_val(atmp); + bval = list_val(btmp); } } break; /* not equal */ case TAG_PRIMARY_BOXED: { - Eterm hdr = *boxed_val_rel(a,a_base); + Eterm hdr = *boxed_val(a); switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: { - aa = tuple_val_rel(a, a_base); - if (!is_boxed(b) || *boxed_val_rel(b,b_base) != *aa) + aa = tuple_val(a); + if (!is_boxed(b) || *boxed_val(b) != *aa) goto not_equal; - bb = tuple_val_rel(b,b_base); + bb = tuple_val(b); if ((sz = arityval(*aa)) == 0) goto pop_next; ++aa; ++bb; @@ -2667,16 +2646,16 @@ tailrecur_ne: Uint a_bitoffs; Uint b_bitoffs; - if (!is_binary_rel(b,b_base)) { + if (!is_binary(b)) { goto not_equal; } - a_size = binary_size_rel(a,a_base); - b_size = binary_size_rel(b,b_base); + a_size = binary_size(a); + b_size = binary_size(b); if (a_size != b_size) { goto not_equal; } - ERTS_GET_BINARY_BYTES_REL(a, a_ptr, a_bitoffs, a_bitsize, a_base); - ERTS_GET_BINARY_BYTES_REL(b, b_ptr, b_bitoffs, b_bitsize, b_base); + ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize); + ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize); if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) { if (sys_memcmp(a_ptr, b_ptr, a_size) == 0) goto pop_next; } else if (a_bitsize == b_bitsize) { @@ -2687,9 +2666,9 @@ tailrecur_ne: } case EXPORT_SUBTAG: { - if (is_export_rel(b,b_base)) { - Export* a_exp = *((Export **) (export_val_rel(a,a_base) + 1)); - Export* b_exp = *((Export **) (export_val_rel(b,b_base) + 1)); + if (is_export(b)) { + Export* a_exp = *((Export **) (export_val(a) + 1)); + Export* b_exp = *((Export **) (export_val(b) + 1)); if (a_exp == b_exp) goto pop_next; } break; /* not equal */ @@ -2699,10 +2678,10 @@ tailrecur_ne: ErlFunThing* f1; ErlFunThing* f2; - if (!is_fun_rel(b,b_base)) + if (!is_fun(b)) goto not_equal; - f1 = (ErlFunThing *) fun_val_rel(a,a_base); - f2 = (ErlFunThing *) fun_val_rel(b,b_base); + f1 = (ErlFunThing *) fun_val(a); + f2 = (ErlFunThing *) fun_val(b); if (f1->fe->module != f2->fe->module || f1->fe->old_index != f2->fe->old_index || f1->fe->old_uniq != f2->fe->old_uniq || @@ -2720,15 +2699,15 @@ tailrecur_ne: ExternalThing *ap; ExternalThing *bp; - if(!is_external_rel(b,b_base)) + if(!is_external(b)) goto not_equal; - ap = external_thing_ptr_rel(a,a_base); - bp = external_thing_ptr_rel(b,b_base); + ap = external_thing_ptr(a); + bp = external_thing_ptr(b); if(ap->header == bp->header && ap->node == bp->node) { - ASSERT(1 == external_data_words_rel(a,a_base)); - ASSERT(1 == external_data_words_rel(b,b_base)); + ASSERT(1 == external_data_words(a)); + ASSERT(1 == external_data_words(b)); if (ap->data.ui[0] == bp->data.ui[0]) goto pop_next; } @@ -2749,11 +2728,11 @@ tailrecur_ne: ExternalThing* athing; ExternalThing* bthing; - if(!is_external_ref_rel(b,b_base)) + if(!is_external_ref(b)) goto not_equal; - athing = external_thing_ptr_rel(a,a_base); - bthing = external_thing_ptr_rel(b,b_base); + athing = external_thing_ptr(a); + bthing = external_thing_ptr(b); if(athing->node != bthing->node) goto not_equal; @@ -2765,12 +2744,12 @@ tailrecur_ne: goto ref_common; case REF_SUBTAG: - if (!is_internal_ref_rel(b,b_base)) + if (!is_internal_ref(b)) goto not_equal; { - RefThing* athing = ref_thing_ptr_rel(a,a_base); - RefThing* bthing = ref_thing_ptr_rel(b,b_base); + RefThing* athing = ref_thing_ptr(a); + RefThing* bthing = ref_thing_ptr(b); alen = internal_thing_ref_no_of_numbers(athing); blen = internal_thing_ref_no_of_numbers(bthing); anum = internal_thing_ref_numbers(athing); @@ -2820,10 +2799,10 @@ tailrecur_ne: { int i; - if (!is_big_rel(b,b_base)) + if (!is_big(b)) goto not_equal; - aa = big_val_rel(a,a_base); - bb = big_val_rel(b,b_base); + aa = big_val(a); + bb = big_val(b); if (*aa != *bb) goto not_equal; i = BIG_ARITY(aa); @@ -2838,19 +2817,19 @@ tailrecur_ne: FloatDef af; FloatDef bf; - if (is_float_rel(b,b_base)) { - GET_DOUBLE_REL(a, af, a_base); - GET_DOUBLE_REL(b, bf, b_base); + if (is_float(b)) { + GET_DOUBLE(a, af); + GET_DOUBLE(b, bf); if (af.fd == bf.fd) goto pop_next; } 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) + if (is_flatmap(a)) { + aa = flatmap_val(a); + if (!is_boxed(b) || *boxed_val(b) != *aa) goto not_equal; - bb = flatmap_val_rel(b,b_base); + bb = flatmap_val(b); sz = flatmap_get_size((flatmap_t*)aa); if (sz != flatmap_get_size((flatmap_t*)bb)) goto not_equal; @@ -2862,11 +2841,11 @@ tailrecur_ne: goto term_array; } else { - if (!is_boxed(b) || *boxed_val_rel(b,b_base) != hdr) + if (!is_boxed(b) || *boxed_val(b) != hdr) goto not_equal; - aa = hashmap_val_rel(a, a_base) + 1; - bb = hashmap_val_rel(b, b_base) + 1; + aa = hashmap_val(a) + 1; + bb = hashmap_val(b) + 1; switch (hdr & _HEADER_MAP_SUBTAG_MASK) { case HAMT_SUBTAG_HEAD_ARRAY: aa++; bb++; @@ -2899,7 +2878,7 @@ term_array: /* arrays in 'aa' and 'bb', length in 'sz' */ Eterm* bp = bb; Sint i = sz; for (;;) { - if (!is_same(*ap,a_base,*bp,b_base)) break; + if (!is_same(*ap,*bp)) break; if (--i == 0) goto pop_next; ++ap; ++bp; @@ -2977,7 +2956,7 @@ static int cmpbytes(byte *s1, int l1, byte *s2, int l2) #define float_comp(x,y) (((x)<(y)) ? -1 : (((x)==(y)) ? 0 : 1)) -static int cmp_atoms(Eterm a, Eterm b) +int erts_cmp_atoms(Eterm a, Eterm b) { Atom *aa = atom_tab(atom_val(a)); Atom *bb = atom_tab(atom_val(b)); @@ -2988,7 +2967,6 @@ static int cmp_atoms(Eterm a, Eterm b) bb->name+3, bb->len-3); } -#if !HALFWORD_HEAP /* cmp(Eterm a, Eterm b) * For compatibility with HiPE - arith-based compare. */ @@ -2996,39 +2974,22 @@ Sint cmp(Eterm a, Eterm b) { 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 +Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only); -#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); + return erts_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)) { + } else if (is_float(a) && is_float(b)) { FloatDef af, bf; - GET_DOUBLE_REL(a, af, a_base); - GET_DOUBLE_REL(b, bf, b_base); + GET_DOUBLE(a, af); + GET_DOUBLE(b, bf); 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 } @@ -3036,13 +2997,7 @@ Sint erts_cmp(Eterm a, Eterm b, int exact, int eq_only) * exact = 1 -> term-based compare * exact = 0 -> arith-based compare */ -#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 +Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only) { #define PSTACK_TYPE struct erts_cmp_hashmap_state struct erts_cmp_hashmap_state { @@ -3099,7 +3054,7 @@ static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only) do { \ if((AN) != (BN)) { \ if((AN)->sysname != (BN)->sysname) \ - RETURN_NEQ(cmp_atoms((AN)->sysname, (BN)->sysname)); \ + RETURN_NEQ(erts_cmp_atoms((AN)->sysname, (BN)->sysname)); \ ASSERT((AN)->creation != (BN)->creation); \ RETURN_NEQ(((AN)->creation < (BN)->creation) ? -1 : 1); \ } \ @@ -3109,7 +3064,7 @@ static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only) bodyrecur: j = 0; tailrecur: - if (is_same(a,a_base,b,b_base)) { /* Equal values or pointers. */ + if (is_same(a,b)) { /* Equal values or pointers. */ goto pop_next; } tailrecur_ne: @@ -3117,7 +3072,7 @@ tailrecur_ne: /* deal with majority (?) cases by brute-force */ if (is_atom(a)) { if (is_atom(b)) { - ON_CMP_GOTO(cmp_atoms(a, b)); + ON_CMP_GOTO(erts_cmp_atoms(a, b)); } } else if (is_both_small(a, b)) { ON_CMP_GOTO(signed_val(a) - signed_val(b)); @@ -3135,9 +3090,9 @@ tailrecur_ne: if (is_internal_port(b)) { bnode = erts_this_node; bdata = internal_port_data(b); - } else if (is_external_port_rel(b,b_base)) { - bnode = external_port_node_rel(b,b_base); - bdata = external_port_data_rel(b,b_base); + } else if (is_external_port(b)) { + bnode = external_port_node(b); + bdata = external_port_data(b); } else { a_tag = PORT_DEF; goto mixed_types; @@ -3153,9 +3108,9 @@ tailrecur_ne: if (is_internal_pid(b)) { bnode = erts_this_node; bdata = internal_pid_data(b); - } else if (is_external_pid_rel(b,b_base)) { - bnode = external_pid_node_rel(b,b_base); - bdata = external_pid_data_rel(b,b_base); + } else if (is_external_pid(b)) { + bnode = external_pid_node(b); + bdata = external_pid_data(b); } else { a_tag = PID_DEF; goto mixed_types; @@ -3188,12 +3143,12 @@ tailrecur_ne: a_tag = LIST_DEF; goto mixed_types; } - aa = list_val_rel(a,a_base); - bb = list_val_rel(b,b_base); + aa = list_val(a); + bb = list_val(b); while (1) { Eterm atmp = CAR(aa); Eterm btmp = CAR(bb); - if (!is_same(atmp,a_base,btmp,b_base)) { + if (!is_same(atmp,btmp)) { WSTACK_PUSH2(stack,(UWord) CDR(bb),(UWord) CDR(aa)); a = atmp; b = btmp; @@ -3201,7 +3156,7 @@ tailrecur_ne: } atmp = CDR(aa); btmp = CDR(bb); - if (is_same(atmp,a_base,btmp,b_base)) { + if (is_same(atmp,btmp)) { goto pop_next; } if (is_not_list(atmp) || is_not_list(btmp)) { @@ -3209,20 +3164,20 @@ tailrecur_ne: b = btmp; goto tailrecur_ne; } - aa = list_val_rel(atmp,a_base); - bb = list_val_rel(btmp,b_base); + aa = list_val(atmp); + bb = list_val(btmp); } case TAG_PRIMARY_BOXED: { - Eterm ahdr = *boxed_val_rel(a,a_base); + Eterm ahdr = *boxed_val(a); switch ((ahdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE): - if (!is_tuple_rel(b,b_base)) { + if (!is_tuple(b)) { a_tag = TUPLE_DEF; goto mixed_types; } - aa = tuple_val_rel(a,a_base); - bb = tuple_val_rel(b,b_base); + aa = tuple_val(a); + bb = tuple_val(b); /* compare the arities */ i = arityval(ahdr); /* get the arity*/ if (i != arityval(*bb)) { @@ -3238,18 +3193,18 @@ tailrecur_ne: { 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); + if (!is_flatmap(b)) { + if (is_hashmap(b)) { + aa = (Eterm *)flatmap_val(a); + i = flatmap_get_size((flatmap_t*)aa) - hashmap_size(b); 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); + aa = (Eterm *)flatmap_val(a); + bb = (Eterm *)flatmap_val(b); i = flatmap_get_size((flatmap_t*)aa); if (i != flatmap_get_size((flatmap_t*)bb)) { @@ -3276,21 +3231,21 @@ tailrecur_ne: 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); + if (!is_hashmap(b)) { + if (is_flatmap(b)) { + bb = (Eterm *)flatmap_val(b); + i = hashmap_size(a) - 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); + i = hashmap_size(a) - hashmap_size(b); if (i) { RETURN_NEQ(i); } - if (hashmap_size_rel(a,a_base) == 0) { + if (hashmap_size(a) == 0) { goto pop_next; } @@ -3325,48 +3280,48 @@ tailrecur_ne: goto bodyrecur; } case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): - if (!is_float_rel(b,b_base)) { + if (!is_float(b)) { a_tag = FLOAT_DEF; goto mixed_types; } else { FloatDef af; FloatDef bf; - GET_DOUBLE_REL(a, af, a_base); - GET_DOUBLE_REL(b, bf, b_base); + GET_DOUBLE(a, af); + GET_DOUBLE(b, bf); ON_CMP_GOTO(float_comp(af.fd, bf.fd)); } case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): - if (!is_big_rel(b,b_base)) { + if (!is_big(b)) { a_tag = BIG_DEF; goto mixed_types; } - ON_CMP_GOTO(big_comp(rterm2wterm(a,a_base), rterm2wterm(b,b_base))); + ON_CMP_GOTO(big_comp(a, b)); case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE): - if (!is_export_rel(b,b_base)) { + if (!is_export(b)) { a_tag = EXPORT_DEF; goto mixed_types; } else { - Export* a_exp = *((Export **) (export_val_rel(a,a_base) + 1)); - Export* b_exp = *((Export **) (export_val_rel(b,b_base) + 1)); + Export* a_exp = *((Export **) (export_val(a) + 1)); + Export* b_exp = *((Export **) (export_val(b) + 1)); - if ((j = cmp_atoms(a_exp->code[0], b_exp->code[0])) != 0) { + if ((j = erts_cmp_atoms(a_exp->code[0], b_exp->code[0])) != 0) { RETURN_NEQ(j); } - if ((j = cmp_atoms(a_exp->code[1], b_exp->code[1])) != 0) { + if ((j = erts_cmp_atoms(a_exp->code[1], b_exp->code[1])) != 0) { RETURN_NEQ(j); } ON_CMP_GOTO((Sint) a_exp->code[2] - (Sint) b_exp->code[2]); } break; case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE): - if (!is_fun_rel(b,b_base)) { + if (!is_fun(b)) { a_tag = FUN_DEF; goto mixed_types; } else { - ErlFunThing* f1 = (ErlFunThing *) fun_val_rel(a,a_base); - ErlFunThing* f2 = (ErlFunThing *) fun_val_rel(b,b_base); + ErlFunThing* f1 = (ErlFunThing *) fun_val(a); + ErlFunThing* f2 = (ErlFunThing *) fun_val(b); Sint diff; diff = cmpbytes(atom_tab(atom_val(f1->fe->module))->name, @@ -3398,29 +3353,29 @@ tailrecur_ne: if (is_internal_pid(b)) { bnode = erts_this_node; bdata = internal_pid_data(b); - } else if (is_external_pid_rel(b,b_base)) { - bnode = external_pid_node_rel(b,b_base); - bdata = external_pid_data_rel(b,b_base); + } else if (is_external_pid(b)) { + bnode = external_pid_node(b); + bdata = external_pid_data(b); } else { a_tag = EXTERNAL_PID_DEF; goto mixed_types; } - anode = external_pid_node_rel(a,a_base); - adata = external_pid_data_rel(a,a_base); + anode = external_pid_node(a); + adata = external_pid_data(a); goto pid_common; case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE): if (is_internal_port(b)) { bnode = erts_this_node; bdata = internal_port_data(b); - } else if (is_external_port_rel(b,b_base)) { - bnode = external_port_node_rel(b,b_base); - bdata = external_port_data_rel(b,b_base); + } else if (is_external_port(b)) { + bnode = external_port_node(b); + bdata = external_port_data(b); } else { a_tag = EXTERNAL_PORT_DEF; goto mixed_types; } - anode = external_port_node_rel(a,a_base); - adata = external_port_data_rel(a,a_base); + anode = external_port_node(a); + adata = external_port_data(a); goto port_common; case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): /* @@ -3428,14 +3383,13 @@ tailrecur_ne: * (32-bit words), *not* ref data words. */ - - if (is_internal_ref_rel(b,b_base)) { - RefThing* bthing = ref_thing_ptr_rel(b,b_base); + if (is_internal_ref(b)) { + RefThing* bthing = ref_thing_ptr(b); bnode = erts_this_node; bnum = internal_thing_ref_numbers(bthing); blen = internal_thing_ref_no_of_numbers(bthing); - } else if(is_external_ref_rel(b,b_base)) { - ExternalThing* bthing = external_thing_ptr_rel(b,b_base); + } else if(is_external_ref(b)) { + ExternalThing* bthing = external_thing_ptr(b); bnode = bthing->node; bnum = external_thing_ref_numbers(bthing); blen = external_thing_ref_no_of_numbers(bthing); @@ -3444,7 +3398,7 @@ tailrecur_ne: goto mixed_types; } { - RefThing* athing = ref_thing_ptr_rel(a,a_base); + RefThing* athing = ref_thing_ptr(a); anode = erts_this_node; anum = internal_thing_ref_numbers(athing); alen = internal_thing_ref_no_of_numbers(athing); @@ -3477,13 +3431,13 @@ tailrecur_ne: RETURN_NEQ((Sint32) (anum[i] - bnum[i])); goto pop_next; case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): - if (is_internal_ref_rel(b,b_base)) { - RefThing* bthing = ref_thing_ptr_rel(b,b_base); + if (is_internal_ref(b)) { + RefThing* bthing = ref_thing_ptr(b); bnode = erts_this_node; bnum = internal_thing_ref_numbers(bthing); blen = internal_thing_ref_no_of_numbers(bthing); - } else if (is_external_ref_rel(b,b_base)) { - ExternalThing* bthing = external_thing_ptr_rel(b,b_base); + } else if (is_external_ref(b)) { + ExternalThing* bthing = external_thing_ptr(b); bnode = bthing->node; bnum = external_thing_ref_numbers(bthing); blen = external_thing_ref_no_of_numbers(bthing); @@ -3492,7 +3446,7 @@ tailrecur_ne: goto mixed_types; } { - ExternalThing* athing = external_thing_ptr_rel(a,a_base); + ExternalThing* athing = external_thing_ptr(a); anode = athing->node; anum = external_thing_ref_numbers(athing); alen = external_thing_ref_no_of_numbers(athing); @@ -3500,13 +3454,13 @@ tailrecur_ne: goto ref_common; default: /* Must be a binary */ - ASSERT(is_binary_rel(a,a_base)); - if (!is_binary_rel(b,b_base)) { + ASSERT(is_binary(a)); + if (!is_binary(b)) { a_tag = BINARY_DEF; goto mixed_types; } else { - Uint a_size = binary_size_rel(a,a_base); - Uint b_size = binary_size_rel(b,b_base); + Uint a_size = binary_size(a); + Uint b_size = binary_size(b); Uint a_bitsize; Uint b_bitsize; Uint a_bitoffs; @@ -3515,8 +3469,8 @@ tailrecur_ne: int cmp; byte* a_ptr; byte* b_ptr; - ERTS_GET_BINARY_BYTES_REL(a, a_ptr, a_bitoffs, a_bitsize, a_base); - ERTS_GET_BINARY_BYTES_REL(b, b_ptr, b_bitoffs, b_bitsize, b_base); + ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize); + ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize); if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) { min_size = (a_size < b_size) ? a_size : b_size; if ((cmp = sys_memcmp(a_ptr, b_ptr, min_size)) != 0) { @@ -3547,13 +3501,8 @@ tailrecur_ne: { FloatDef f1, f2; Eterm big; -#if HALFWORD_HEAP - Wterm aw = is_immed(a) ? a : rterm2wterm(a,a_base); - Wterm bw = is_immed(b) ? b : rterm2wterm(b,b_base); -#else Eterm aw = a; Eterm bw = b; -#endif #define MAX_LOSSLESS_FLOAT ((double)((1LL << 53) - 2)) #define MIN_LOSSLESS_FLOAT ((double)(((1LL << 53) - 2)*-1)) #define BIG_ARITY_FLOAT_MAX (1024 / D_EXP) /* arity of max float as a bignum */ @@ -3625,7 +3574,7 @@ tailrecur_ne: } } else { big = double_to_big(f2.fd, big_buf, sizeof(big_buf)/sizeof(Eterm)); - j = big_comp(aw, rterm2wterm(big,big_buf)); + j = big_comp(aw, big); } if (_NUMBER_CODE(a_tag, b_tag) == FLOAT_BIG) { j = -j; @@ -3673,9 +3622,9 @@ term_array: /* arrays in 'aa' and 'bb', length in 'i' */ while (--i) { a = *aa++; b = *bb++; - if (!is_same(a,a_base, b,b_base)) { + if (!is_same(a, b)) { if (is_atom(a) && is_atom(b)) { - if ((j = cmp_atoms(a, b)) != 0) { + if ((j = erts_cmp_atoms(a, b)) != 0) { goto not_equal; } } else if (is_both_small(a, b)) { @@ -3946,11 +3895,11 @@ void bin_write(int to, void *to_arg, byte* buf, size_t sz) /* Fill buf with the contents of bytelist list return number of chars in list or -1 for error */ -int -intlist_to_buf(Eterm list, char *buf, int len) +Sint +intlist_to_buf(Eterm list, char *buf, Sint len) { Eterm* listptr; - int sz = 0; + Sint sz = 0; if (is_nil(list)) return 0; @@ -4365,7 +4314,7 @@ iolist_size(const int yield_support, ErtsIOListState *state, Eterm obj, ErlDrvSi { int res, init_yield_count, yield_count; Eterm* objp; - Uint size = (Uint) *sizep; /* Intentionally Uint due to halfword heap */ + Uint size = (Uint) *sizep; DECLARE_ESTACK(s); if (!yield_support) @@ -4497,11 +4446,12 @@ int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep) return iolist_size(0, NULL, obj, sizep); } -/* return 0 if item is not a non-empty flat list of bytes */ -int +/* return 0 if item is not a non-empty flat list of bytes + otherwise return the nonzero length of the list */ +Sint is_string(Eterm list) { - int len = 0; + Sint len = 0; while(is_list(list)) { Eterm* consp = list_val(list); diff --git a/erts/emulator/beam/version.h b/erts/emulator/beam/version.h index 004725eaf5..0fa775fe8c 100644 --- a/erts/emulator/beam/version.h +++ b/erts/emulator/beam/version.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 5e25747ddf..3adb8db661 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -101,15 +101,9 @@ # include "config.h" #endif -#ifndef __OSE__ #include <ctype.h> #include <sys/types.h> #include <stdlib.h> -#else -#include "ctype.h" -#include "sys/types.h" -#include "stdlib.h" -#endif /* Need (NON)BLOCKING macros for sendfile */ #ifndef WANT_NONBLOCKING @@ -882,7 +876,7 @@ static void reply_Uint_posix_error(file_descriptor *desc, Uint num, TRACE_C('N'); response[0] = FILE_RESP_NUMERR; -#if SIZEOF_VOID_P == 4 || HALFWORD_HEAP +#if SIZEOF_VOID_P == 4 put_int32(0, response+1); #else put_int32(num>>32, response+1); @@ -951,7 +945,7 @@ static int reply_Uint(file_descriptor *desc, Uint result) { TRACE_C('R'); tmp[0] = FILE_RESP_NUMBER; -#if SIZEOF_VOID_P == 4 || HALFWORD_HEAP +#if SIZEOF_VOID_P == 4 put_int32(0, tmp+1); #else put_int32(result>>32, tmp+1); @@ -2906,12 +2900,12 @@ file_output(ErlDrvData e, char* buf, ErlDrvSizeT count) d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + FILENAME_BYTELEN(buf + 9*4) + FILENAME_CHARSIZE); - d->info.mode = get_int32(buf + 0 * 4); - d->info.uid = get_int32(buf + 1 * 4); - d->info.gid = get_int32(buf + 2 * 4); - d->info.accessTime = (time_t)((Sint64)get_int64(buf + 3 * 4)); - d->info.modifyTime = (time_t)((Sint64)get_int64(buf + 5 * 4)); - d->info.cTime = (time_t)((Sint64)get_int64(buf + 7 * 4)); + d->info.mode = get_int32(buf + 0 * 4); + d->info.uid = get_int32(buf + 1 * 4); + d->info.gid = get_int32(buf + 2 * 4); + d->info.accessTime = get_int64(buf + 3 * 4); + d->info.modifyTime = get_int64(buf + 5 * 4); + d->info.cTime = get_int64(buf + 7 * 4); FILENAME_COPY(d->b, buf + 9*4); #ifdef USE_VM_PROBES diff --git a/erts/emulator/drivers/common/erl_efile.h b/erts/emulator/drivers/common/erl_efile.h index be5a891486..b7f063b4f2 100644 --- a/erts/emulator/drivers/common/erl_efile.h +++ b/erts/emulator/drivers/common/erl_efile.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2013. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -105,9 +105,9 @@ typedef struct _Efile_info { Uint32 inode; /* Inode number. */ Uint32 uid; /* User id of owner. */ Uint32 gid; /* Group id of owner. */ - time_t accessTime; /* Last time the file was accessed. */ - time_t modifyTime; /* Last time the file was modified. */ - time_t cTime; /* Creation time (Windows) or last + Sint64 accessTime; /* Last time the file was accessed. */ + Sint64 modifyTime; /* Last time the file was modified. */ + Sint64 cTime; /* Creation time (Windows) or last * inode change (Unix). */ } Efile_info; diff --git a/erts/emulator/drivers/common/gzio.h b/erts/emulator/drivers/common/gzio.h index a6fe2fb6f5..ee0ebe7bd8 100644 --- a/erts/emulator/drivers/common/gzio.h +++ b/erts/emulator/drivers/common/gzio.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/drivers/common/gzio_zutil.h b/erts/emulator/drivers/common/gzio_zutil.h index 9eefb86637..b229ae4efd 100644 --- a/erts/emulator/drivers/common/gzio_zutil.h +++ b/erts/emulator/drivers/common/gzio_zutil.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 2d2bd80783..e87d141ddb 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2015. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -94,10 +94,6 @@ typedef unsigned long long llu_t; #define INT16_MAX (32767) #endif -#ifdef __OSE__ -#include "inet.h" -#endif - #ifdef __WIN32__ #define STRNCASECMP strncasecmp @@ -298,139 +294,7 @@ static unsigned long one_value = 1; #define TCP_SHUT_RD SD_RECEIVE #define TCP_SHUT_RDWR SD_BOTH -#elif defined (__OSE__) - -/* - * Some notes about how inet (currently only tcp) works on OSE. - * The driver uses OSE signals to communicate with the one_inet - * process. Because of the difference in how signals and file descriptors - * work the whole select/deselect mechanic is very different. - * In ose when a sock_select is done a function is called. That function - * notes the changes that the driver want to do, but does not act on it. - * later when the function returns the new desired state is compared - * to the previous state and the apprioriate actions are taken. The action - * is usually to either request more data from the stack or stop requesting - * data. - * - * One thing to note is that the driver never does select/deselect. It always - * listens for the signals. Flow of data is regulated by sending or not sending - * signals to the ose inet process. - * - * The interesting functions to look at are: - * * inet_driver_select : called when sock_select is called - * * tcp_inet_ose_dispatch_signal : checks state changes and sends new signals - * * tcp_inet_drv_output_ose : ready output callback, reads signals and calls - * dispatch_signal - * * tcp_inet_drv_input_ose : ready input callback. - */ - -#include "efs.h" -#include "sys/socket.h" -#include "sys/uio.h" -#include "sfk/sys/sfk_uio.h" -#include "netinet/in.h" -#include "netinet/tcp.h" -#include "netdb.h" -#include "ose_spi/socket.sig" - - -static ssize_t writev_fallback(int fd, const struct iovec *iov, int iovcnt, int max_sz); - -#define INVALID_SOCKET -1 -#define INVALID_EVENT -1 -#define SOCKET_ERROR -1 - -#define SOCKET int -#define HANDLE int -#define FD_READ ERL_DRV_READ -#define FD_WRITE ERL_DRV_WRITE -#define FD_CLOSE 0 -#define FD_CONNECT (1<<4) -#define FD_ACCEPT (1<<5) -#define SOCK_FD_ERROR (1<<6) - -#define sock_connect(s, addr, len) connect((s), (addr), (len)) -#define sock_listen(s, b) listen((s), (b)) -#define sock_bind(s, addr, len) bind((s), (addr), (len)) -#define sock_getopt(s,t,n,v,l) getsockopt((s),(t),(n),(v),(l)) -#define sock_setopt(s,t,n,v,l) setsockopt((s),(t),(n),(v),(l)) -#define sock_name(s, addr, len) getsockname((s), (addr), (len)) -#define sock_peer(s, addr, len) getpeername((s), (addr), (len)) -#define sock_ntohs(x) ntohs((x)) -#define sock_ntohl(x) ntohl((x)) -#define sock_htons(x) htons((x)) -#define sock_htonl(x) htonl((x)) - -#define sock_accept(s, addr, len) accept((s), (addr), (len)) -#define sock_send(s,buf,len,flag) inet_send((s),(buf),(len),(flag)) -#define sock_sendto(s,buf,blen,flag,addr,alen) \ - sendto((s),(buf),(blen),(flag),(addr),(alen)) -#define sock_sendv(s, vec, size, np, flag) \ - (*(np) = writev_fallback((s), (struct iovec*)(vec), (size), (*(np)))) -#define sock_sendmsg(s,msghdr,flag) sendmsg((s),(msghdr),(flag)) - -#define sock_open(af, type, proto) socket((af), (type), (proto)) -#define sock_close(s) close((s)) -#define sock_dup(s) dup((s)) -#define sock_shutdown(s, how) shutdown((s), (how)) - -#define sock_hostname(buf, len) gethostname((buf), (len)) -#define sock_getservbyname(name,proto) getservbyname((name), (proto)) -#define sock_getservbyport(port,proto) getservbyport((port), (proto)) - -#define sock_recv(s,buf,len,flag) recv((s),(buf),(len),(flag)) -#define sock_recvfrom(s,buf,blen,flag,addr,alen) \ - recvfrom((s),(buf),(blen),(flag),(addr),(alen)) -#define sock_recvmsg(s,msghdr,flag) recvmsg((s),(msghdr),(flag)) - -#define sock_errno() errno -#define sock_create_event(d) ((d)->s) /* return file descriptor */ -#define sock_close_event(e) /* do nothing */ - -#ifndef WANT_NONBLOCKING -#define WANT_NONBLOCKING -#endif -#include "sys.h" - -typedef unsigned long u_long; -#define IN_CLASSA(a) ((((in_addr_t)(a)) & 0x80000000) == 0) -#define IN_CLASSA_NET 0xff000000 -#define IN_CLASSA_NSHIFT 24 -#define IN_CLASSA_HOST (0xffffffff & ~IN_CLASSA_NET) -#define IN_CLASSA_MAX 128 - -#define IN_CLASSB(a) ((((in_addr_t)(a)) & 0xc0000000) == 0x80000000) -#define IN_CLASSB_NET 0xffff0000 -#define IN_CLASSB_NSHIFT 16 -#define IN_CLASSB_HOST (0xffffffff & ~IN_CLASSB_NET) -#define IN_CLASSB_MAX 65536 - -#define IN_CLASSC(a) ((((in_addr_t)(a)) & 0xe0000000) == 0xc0000000) -#define IN_CLASSC_NET 0xffffff00 -#define IN_CLASSC_NSHIFT 8 -#define IN_CLASSC_HOST (0xffffffff & ~IN_CLASSC_NET) - -#define IN_CLASSD(a) ((((in_addr_t)(a)) & 0xf0000000) == 0xe0000000) -#define IN_MULTICAST(a) IN_CLASSD(a) - -#define IN_EXPERIMENTAL(a) ((((in_addr_t)(a)) & 0xe0000000) == 0xe0000000) -#define IN_BADCLASS(a) ((((in_addr_t)(a)) & 0xf0000000) == 0xf0000000) - -#define sock_select(d, flags, onoff) do { \ - ASSERT(!(d)->is_ignored); \ - (d)->event_mask = (onoff) ? \ - ((d)->event_mask | (flags)) : \ - ((d)->event_mask & ~(flags)); \ - DEBUGF(("(%s / %d) sock_select(%ld): flags=%02X, onoff=%d, event_mask=%02lX, s=%d\r\n", \ - __FILE__, __LINE__, (long) (d)->port, (flags), (onoff), (unsigned long) (d)->event_mask, (d)->s)); \ - 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__ */ +#else /* !__WIN32__ */ #include <sys/time.h> #ifdef NETDB_H_NEEDS_IN_H @@ -704,7 +568,7 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n) #define TCP_SHUT_RD SHUT_RD #define TCP_SHUT_RDWR SHUT_RDWR -#endif /* !__WIN32__ && !__OSE__ */ +#endif /* !__WIN32__ */ #ifdef HAVE_SOCKLEN_T # define SOCKLEN_T socklen_t @@ -1168,13 +1032,6 @@ typedef struct { char *netns; /* Socket network namespace name as full file path */ #endif -#ifdef __OSE__ - int select_state; /* state to keep track of whether we - should trigger another read/write - request at end of ready_input/output */ - ErlDrvEvent events[6]; -#endif - } inet_descriptor; @@ -1190,10 +1047,8 @@ static void tcp_inet_stop(ErlDrvData); static void tcp_inet_command(ErlDrvData, char*, ErlDrvSizeT); static void tcp_inet_commandv(ErlDrvData, ErlIOVec*); static void tcp_inet_flush(ErlDrvData drv_data); -#ifndef __OSE__ static void tcp_inet_drv_input(ErlDrvData, ErlDrvEvent); static void tcp_inet_drv_output(ErlDrvData data, ErlDrvEvent event); -#endif static ErlDrvData tcp_inet_start(ErlDrvPort, char* command); static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData, unsigned int, char*, ErlDrvSizeT, char**, ErlDrvSizeT); @@ -1206,71 +1061,6 @@ static void tcp_inet_event(ErlDrvData, ErlDrvEvent); static void find_dynamic_functions(void); #endif -#ifdef __OSE__ -/* The structure of the signal used for requesting asynchronous - * notification from the stack. Under normal circumstances the network stack - * shouldn't overwrite the value set in the fd field by the sender - * of the request */ -struct OseAsyncSig { - struct FmEvent event; - int fd; -}; - -union SIGNAL { - SIGSELECT signo; - struct OseAsyncSig async; -}; - -static ErlDrvSSizeT tcp_inet_ctl_ose(ErlDrvData e, unsigned int cmd, - char* buf, ErlDrvSizeT len, - char** rbuf, ErlDrvSizeT rsize); -static void tcp_inet_commandv_ose(ErlDrvData e, ErlIOVec* ev); -static void tcp_inet_drv_output_ose(ErlDrvData data, ErlDrvEvent event); -static void tcp_inet_drv_input_ose(ErlDrvData data, ErlDrvEvent event); -static ErlDrvOseEventId inet_resolve_signal(union SIGNAL *sig); - -#ifdef INET_DRV_DEBUG - -static char *read_req = "SO_EVENT_READ_REQUEST"; -static char *read_rep = "SO_EVENT_READ_REPLY"; -static char *write_req = "SO_EVENT_WRITE_REQUEST"; -static char *write_rep = "SO_EVENT_WRITE_REPLY"; -static char *eof_req = "SO_EVENT_EOF_REQUEST"; -static char *eof_rep = "SO_EVENT_EOF_REPLY"; -static char *accept_req = "SO_EVENT_ACCEPT_REQUEST"; -static char *accept_rep = "SO_EVENT_ACCEPT_REPLY"; -static char *connect_req = "SO_EVENT_CONNECT_REQUEST"; -static char *connect_rep = "SO_EVENT_CONNECT_REPLY"; -static char *error_req = "SO_EVENT_ERROR_REQUEST"; -static char *error_rep = "SO_EVENT_ERROR_REPLY"; -static char signo_tmp[32]; - -static char *signo_to_string(SIGSELECT signo) { - switch (signo) { - case SO_EVENT_READ_REQUEST: { return read_req; } - case SO_EVENT_READ_REPLY: { return read_rep; } - case SO_EVENT_WRITE_REQUEST: { return write_req; } - case SO_EVENT_WRITE_REPLY: { return write_rep; } - case SO_EVENT_EOF_REQUEST: { return eof_req; } - case SO_EVENT_EOF_REPLY: { return eof_rep; } - case SO_EVENT_ACCEPT_REQUEST: { return accept_req; } - case SO_EVENT_ACCEPT_REPLY: { return accept_rep; } - case SO_EVENT_CONNECT_REQUEST: { return connect_req; } - case SO_EVENT_CONNECT_REPLY: { return connect_rep; } - case SO_EVENT_ERROR_REQUEST: { return error_req; } - case SO_EVENT_ERROR_REPLY: { return error_rep; } - } - - snprintf(signo_tmp,32,"0x%x",signo); - - return signo_tmp; -} - -#endif - -#endif /* __OSE__ */ - - static struct erl_drv_entry tcp_inet_driver_entry = { tcp_inet_init, /* inet_init will add this driver !! */ @@ -1280,9 +1070,6 @@ static struct erl_drv_entry tcp_inet_driver_entry = #ifdef __WIN32__ tcp_inet_event, NULL, -#elif defined(__OSE__) - tcp_inet_drv_input_ose, /*ready_input*/ - tcp_inet_drv_output_ose, /*ready_output*/ #else tcp_inet_drv_input, tcp_inet_drv_output, @@ -1290,17 +1077,9 @@ static struct erl_drv_entry tcp_inet_driver_entry = "tcp_inet", NULL, NULL, -#ifdef __OSE__ - tcp_inet_ctl_ose, -#else tcp_inet_ctl, -#endif tcp_inet_timeout, -#ifdef __OSE__ - tcp_inet_commandv_ose, -#else tcp_inet_commandv, -#endif NULL, tcp_inet_flush, NULL, @@ -1452,14 +1231,6 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event); /* convert descriptor pointer to inet_descriptor pointer */ #define INETP(d) (&(d)->inet) -#ifdef __OSE__ -static void inet_driver_select(inet_descriptor* desc, - int flags, int onoff); -static void tcp_inet_ose_dispatch_signals(tcp_descriptor *desc, - int prev_select_state, - union SIGNAL *sig); -#endif - static int async_ref = 0; /* async reference id generator */ #define NEW_ASYNC_ID() ((async_ref++) & 0xffff) @@ -4355,16 +4126,6 @@ static void desc_close(inet_descriptor* desc) desc->forced_events = 0; desc->send_would_block = 0; #endif -#ifdef __OSE__ - if (desc->events[0]) { - driver_select(desc->port,desc->events[0],FD_READ|FD_WRITE|ERL_DRV_USE,0); - driver_select(desc->port,desc->events[1],FD_READ|FD_WRITE|ERL_DRV_USE,0); - driver_select(desc->port,desc->events[2],FD_READ|FD_WRITE|ERL_DRV_USE,0); - driver_select(desc->port,desc->events[3],FD_READ|FD_WRITE|ERL_DRV_USE,0); - driver_select(desc->port,desc->events[4],FD_READ|FD_WRITE|ERL_DRV_USE,0); - driver_select(desc->port,desc->events[5],FD_READ|FD_WRITE|ERL_DRV_USE,0); - } -#else /* * We should close the fd here, but the other driver might still * be selecting on it. @@ -4374,7 +4135,6 @@ static void desc_close(inet_descriptor* desc) ERL_DRV_USE, 0); else inet_stop_select((ErlDrvEvent)(long)desc->event,NULL); -#endif desc->event = INVALID_EVENT; /* closed by stop_select callback */ desc->s = INVALID_SOCKET; desc->event_mask = 0; @@ -4416,65 +4176,6 @@ static int erl_inet_close(inet_descriptor* desc) return 0; } -#ifdef __OSE__ -static void inet_select_init(inet_descriptor* desc) -{ - desc->events[0] = - erl_drv_ose_event_alloc(SO_EVENT_READ_REPLY, - desc->s, - inet_resolve_signal, - NULL); - driver_select(desc->port, desc->events[0], - ERL_DRV_READ|ERL_DRV_USE, 1); - - desc->events[1] = - erl_drv_ose_event_alloc(SO_EVENT_EOF_REPLY, - desc->s, - inet_resolve_signal, - NULL); - driver_select(desc->port, desc->events[1], - ERL_DRV_READ|ERL_DRV_USE, 1); - - desc->events[2] = - erl_drv_ose_event_alloc(SO_EVENT_ACCEPT_REPLY, - desc->s, - inet_resolve_signal, - NULL); - driver_select(desc->port, desc->events[2], - ERL_DRV_READ|ERL_DRV_USE, 1); - - /* trigger tcp_inet_input */ - desc->events[3] = - erl_drv_ose_event_alloc(SO_EVENT_WRITE_REPLY, - desc->s, - inet_resolve_signal, - NULL); - driver_select(desc->port, desc->events[3], - ERL_DRV_WRITE|ERL_DRV_USE, 1); - - desc->events[4] = - erl_drv_ose_event_alloc(SO_EVENT_CONNECT_REPLY, - desc->s, - inet_resolve_signal, - NULL); - driver_select(desc->port, desc->events[4], - ERL_DRV_WRITE|ERL_DRV_USE, 1); - - desc->events[5] = - erl_drv_ose_event_alloc(SO_EVENT_ERROR_REPLY, - desc->s, - inet_resolve_signal, - NULL); - driver_select(desc->port, desc->events[5], - ERL_DRV_WRITE|ERL_DRV_USE, 1); - - /* Issue a select on error event before any other select to be sure we are - prepared to receive error notifications from the stack, even in the - situations when select isn't issued */ - sock_select(desc, SOCK_FD_ERROR, 1); -} -#endif - static ErlDrvSSizeT inet_ctl_open(inet_descriptor* desc, int domain, int type, char** rbuf, ErlDrvSizeT rsize) { @@ -4557,9 +4258,6 @@ static ErlDrvSSizeT inet_ctl_open(inet_descriptor* desc, int domain, int type, #ifdef __WIN32__ driver_select(desc->port, desc->event, ERL_DRV_READ, 1); #endif -#ifdef __OSE__ - inet_select_init(desc); -#endif desc->state = INET_STATE_OPEN; desc->stype = type; @@ -4583,13 +4281,7 @@ static ErlDrvSSizeT inet_ctl_fdopen(inet_descriptor* desc, int domain, int type, if (name.sa.sa_family != domain) return ctl_error(EINVAL, rbuf, rsize); } -#ifdef __OSE__ - /* for fdopen duplicating the sd will allow to uniquely identify - the signal from OSE with erlang port */ - desc->s = sock_dup(s); -#else desc->s = s; -#endif if ((desc->event = sock_create_event(desc)) == INVALID_EVENT) return ctl_error(sock_errno(), rbuf, rsize); @@ -4607,12 +4299,6 @@ static ErlDrvSSizeT inet_ctl_fdopen(inet_descriptor* desc, int domain, int type, sz = sizeof(name); if (!IS_SOCKET_ERROR(sock_peer(s, (struct sockaddr*) &name, &sz))) { desc->state = INET_STATE_CONNECTED; -#ifdef __OSE__ - /* since we are dealing with different descriptors (i.e. inet and - socket) the select part should be initialized with the right - values */ - inet_select_init(desc); -#endif } } @@ -8414,15 +8100,6 @@ static ErlDrvData inet_start(ErlDrvPort port, int size, int protocol) #ifdef HAVE_SETNS desc->netns = NULL; #endif -#ifdef __OSE__ - desc->select_state = 0; - desc->events[0] = NULL; - desc->events[1] = NULL; - desc->events[2] = NULL; - desc->events[3] = NULL; - desc->events[4] = NULL; - desc->events[5] = NULL; -#endif return (ErlDrvData)desc; } @@ -9149,10 +8826,6 @@ static tcp_descriptor* tcp_inet_copy(tcp_descriptor* desc,SOCKET s, copy_desc->inet.port = port; copy_desc->inet.dport = driver_mk_port(port); -#ifdef __OSE__ - inet_select_init(©_desc->inet); -#endif - *err = 0; return copy_desc; } @@ -9214,23 +8887,6 @@ static void tcp_inet_stop(ErlDrvData e) inet_stop(INETP(desc)); } -#ifdef __OSE__ - -static ErlDrvSSizeT tcp_inet_ctl_ose(ErlDrvData e, unsigned int cmd, - char* buf, ErlDrvSizeT len, - char** rbuf, ErlDrvSizeT rsize) { - - tcp_descriptor* desc = (tcp_descriptor*)e; - int prev_select_state = INETP(desc)->select_state; - - ErlDrvSSizeT res = tcp_inet_ctl(e,cmd,buf,len,rbuf,rsize); - - tcp_inet_ose_dispatch_signals((tcp_descriptor*)e,prev_select_state,NULL); - - return res; -} -#endif - /* TCP requests from Erlang */ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, ErlDrvSizeT len, @@ -9672,17 +9328,6 @@ static void tcp_inet_command(ErlDrvData e, char *buf, ErlDrvSizeT len) DEBUGF(("tcp_inet_command(%ld) }\r\n", (long)desc->inet.port)); } -#ifdef __OSE__ - -static void tcp_inet_commandv_ose(ErlDrvData e, ErlIOVec* ev) { - int prev_select_state = INETP((tcp_descriptor*)e)->select_state; - tcp_inet_commandv(e, ev); - tcp_inet_ose_dispatch_signals((tcp_descriptor*)e,prev_select_state,NULL); -} - -#endif - - static void tcp_inet_commandv(ErlDrvData e, ErlIOVec* ev) { tcp_descriptor* desc = (tcp_descriptor*)e; @@ -9755,22 +9400,6 @@ static void inet_stop_select(ErlDrvEvent event, void* _) { #ifdef __WIN32__ WSACloseEvent((HANDLE)event); -#elif defined(__OSE__) - ErlDrvOseEventId id; - union SIGNAL *sig; - erl_drv_ose_event_fetch(event, NULL, &id,NULL); - DEBUGF(("inet_stop_select(?#?) {s=%d\n",id)); - sock_close((int)id); - /* On socket close all the signals waiting to be processed as part of the - select should be deallocated */ - while((sig = erl_drv_ose_get_signal(event))) { - DEBUGF(("inet_stop_select(?#?): Freeing signal %s\n", - signo_to_string(sig->signo))); - free_buf(&sig); - } - erl_drv_ose_event_free(event); - DEBUGF(("inet_stop_select(?#?) }\n")); - #else sock_close((SOCKET)(long)event); #endif @@ -10319,146 +9948,7 @@ static void tcp_inet_event(ErlDrvData e, ErlDrvEvent event) return; } -#elif defined(__OSE__) /* !__WIN32__ */ -/* The specific resolve signal function. It will return the socket descriptor - for which the select was issued */ -static ErlDrvOseEventId inet_resolve_signal(union SIGNAL *sig) { - DEBUGF(("%s(?#?): s=%d got signal %s, status = %d, extra = %d, sender = 0x%x\n", - __FUNCTION__,sig->async.fd,signo_to_string(sig->signo), - sig->async.event.status, - sig->async.event.extra,sender(&sig))); - if (sig->signo == SO_EVENT_READ_REPLY || - sig->signo == SO_EVENT_ACCEPT_REPLY || - sig->signo == SO_EVENT_EOF_REPLY || - sig->signo == SO_EVENT_WRITE_REPLY || - sig->signo == SO_EVENT_ERROR_REPLY || - sig->signo == SO_EVENT_CONNECT_REPLY ) { - return sig->async.fd; - } - - return -1; -} - -static void inet_driver_select(inet_descriptor* desc, - int flags, int onoff) { - ASSERT(!desc->is_ignored); - - if(onoff) { - desc->select_state |= flags; - } else { - desc->select_state &= ~flags; - } -} - -static ssize_t writev_fallback(int fd, const struct iovec *iov, int iovcnt, int max_sz) -{ - size_t data_len = 0; - size_t sent = 0; - ssize_t n; - int i; - - for(i = 0; i < iovcnt; i++) - { - data_len = iov[i].iov_len; -tryagain: - n = sock_send(fd, iov[i].iov_base, data_len, 0); - if (IS_SOCKET_ERROR(n)) { - /* If buffer length is greater than the amount stack is able to - * send out then try to send at least max_sz (this comes with - * SO_EVENT_WRITE_REPLY signal*/ - if ((errno == EMSGSIZE) && (max_sz > 0) && (data_len > max_sz)) { - data_len = max_sz; - goto tryagain; - } - break; - } - sent += n; - } - return sent; -} - -#define OSE_EVENT_REQ(TCP_DESC,EVENT) do { \ - union SIGNAL *sig = alloc(sizeof(struct OseAsyncSig), EVENT); \ - sig->async.fd = INETP(TCP_DESC)->s; \ - ose_request_event(INETP(TCP_DESC)->s, &sig, 1); \ - DEBUGF(("%s(%ld): s=%d sent %s\r\n",__FUNCTION__, \ - INETP(TCP_DESC)->port,INETP(TCP_DESC)->s,signo_to_string(EVENT))); \ - } while(0) - -static void tcp_inet_ose_dispatch_signals(tcp_descriptor *desc, - int prev_select_state, - union SIGNAL *sig) { - if (sig) { - DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) {s=%d resend\r\n", - (long)INETP(desc)->port,INETP(desc)->s)); - /* We are reacting to a signal, which means that if - the select_state for that signal is still activated - we should send a new signal */ - switch (sig->signo) { - case SO_EVENT_READ_REPLY: { - if (INETP(desc)->select_state & FD_READ) - OSE_EVENT_REQ(desc,SO_EVENT_READ_REQUEST); - break; - } - case SO_EVENT_WRITE_REPLY: { - if (INETP(desc)->select_state & FD_WRITE) - OSE_EVENT_REQ(desc,SO_EVENT_WRITE_REQUEST); - break; - } - case SO_EVENT_CONNECT_REPLY: { - if (INETP(desc)->select_state & FD_CONNECT) - OSE_EVENT_REQ(desc,SO_EVENT_CONNECT_REQUEST); - break; - } - case SO_EVENT_ACCEPT_REPLY: { - if (INETP(desc)->select_state & FD_ACCEPT) - OSE_EVENT_REQ(desc,SO_EVENT_ACCEPT_REQUEST); - break; - } - case SO_EVENT_ERROR_REPLY: { - if (INETP(desc)->select_state & SOCK_FD_ERROR) - OSE_EVENT_REQ(desc,SO_EVENT_ERROR_REQUEST); - break; - } - - } - DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) }\r\n", - (long)INETP(desc)->port)); - } - - if (INETP(desc)->select_state != prev_select_state) { - /* If the select state has changed we have to issue signals for - the state parts that have changed. */ - int xor_select_state = INETP(desc)->select_state ^ prev_select_state; - DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) {s=%d select change\r\n", - (long)INETP(desc)->port,INETP(desc)->s)); - if ((xor_select_state & FD_READ) && - (INETP(desc)->select_state & FD_READ)) { - OSE_EVENT_REQ(desc,SO_EVENT_READ_REQUEST); - } - if ((xor_select_state & FD_WRITE) && - (INETP(desc)->select_state & FD_WRITE)) { - OSE_EVENT_REQ(desc,SO_EVENT_WRITE_REQUEST); - } - if ((xor_select_state & FD_CONNECT) && - (INETP(desc)->select_state & FD_CONNECT)) { - OSE_EVENT_REQ(desc,SO_EVENT_CONNECT_REQUEST); - } - if ((xor_select_state & FD_ACCEPT) && - (INETP(desc)->select_state & FD_ACCEPT)) { - OSE_EVENT_REQ(desc,SO_EVENT_ACCEPT_REQUEST); - } - if ((xor_select_state & SOCK_FD_ERROR) && - (INETP(desc)->select_state & SOCK_FD_ERROR)) { - OSE_EVENT_REQ(desc,SO_EVENT_ERROR_REQUEST); - } - - DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) }\r\n", - (long)INETP(desc)->port)); - } -} - -#endif /* __OSE__ */ +#endif /* __WIN32__ */ /* socket has input: @@ -10945,49 +10435,6 @@ static void tcp_shutdown_async(tcp_descriptor* desc) desc->tcp_add_flags |= TCP_ADDF_SHUTDOWN_WR_DONE; } -#ifdef __OSE__ - -static void tcp_inet_drv_output_ose(ErlDrvData data, ErlDrvEvent event) -{ - union SIGNAL *event_sig = erl_drv_ose_get_signal(event); - - while (event_sig) { - int prev_select_state = INETP((tcp_descriptor*)data)->select_state; - int res = tcp_inet_output((tcp_descriptor*)data, (HANDLE)event_sig); - if (res != -1) { - tcp_inet_ose_dispatch_signals((tcp_descriptor*)data, - prev_select_state,event_sig); - free_buf(&event_sig); - event_sig = erl_drv_ose_get_signal(event); - } else { - /* NOTE: here the event object could have been deallocated!!!! - inet_stop_select is called when doing driver_select(ERL_DRV_USE,0) - */ - free_buf(&event_sig); - return; - } - } -} - -static void tcp_inet_drv_input_ose(ErlDrvData data, ErlDrvEvent event) -{ - union SIGNAL *event_sig = erl_drv_ose_get_signal(event); - - while (event_sig) { - int prev_select_state = INETP((tcp_descriptor*)data)->select_state; - int res = tcp_inet_input((tcp_descriptor*)data, (HANDLE)event); - if (res != -1) { - tcp_inet_ose_dispatch_signals((tcp_descriptor*)data, prev_select_state, - event_sig); - free_buf(&event_sig); - event_sig = erl_drv_ose_get_signal(event); - } else { - free_buf(&event_sig); - return; - } - } -} -#else static void tcp_inet_drv_output(ErlDrvData data, ErlDrvEvent event) { (void)tcp_inet_output((tcp_descriptor*)data, (HANDLE)event); @@ -10997,7 +10444,6 @@ static void tcp_inet_drv_input(ErlDrvData data, ErlDrvEvent event) { (void)tcp_inet_input((tcp_descriptor*)data, (HANDLE)event); } -#endif /* socket ready for ouput: ** 1. INET_STATE_CONNECTING => non block connect ? @@ -11063,13 +10509,6 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event) ssize_t n; SysIOVec* iov; -#ifdef __OSE__ - /* For large size buffers case the amount of data that the stack is - able to send out (received in the .extra field) should be passed - down to writev_fallback */ - n = event ? ((union SIGNAL*)event)->async.event.extra : 0; -#endif - if ((iov = driver_peekq(ix, &vsize)) == NULL) { sock_select(INETP(desc), FD_WRITE, 0); send_empty_out_q_msgs(INETP(desc)); @@ -11097,12 +10536,6 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event) sizes > (max 32 bit signed int) */ size_t howmuch = 0x7FFFFFFF; /* max signed 32 bit */ int x; -#ifdef __OSE__ - /* For EWOULDBLOCK sock_sendv returns 0 so we have to be sure it - wasn't the case */ - if(sock_errno() == ERRNO_BLOCK) - goto done; -#endif for(x = 0; x < vsize && iov[x].iov_len == 0; ++x) ; if (x < vsize) { diff --git a/erts/emulator/drivers/common/ram_file_drv.c b/erts/emulator/drivers/common/ram_file_drv.c index 9cb44d0b7e..bcdfe6a186 100644 --- a/erts/emulator/drivers/common/ram_file_drv.c +++ b/erts/emulator/drivers/common/ram_file_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2011. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/drivers/common/zlib_drv.c b/erts/emulator/drivers/common/zlib_drv.c index 364048174c..440ba956d8 100644 --- a/erts/emulator/drivers/common/zlib_drv.c +++ b/erts/emulator/drivers/common/zlib_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2013. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/drivers/ose/ose_efile.c b/erts/emulator/drivers/ose/ose_efile.c deleted file mode 100644 index c8337a95d5..0000000000 --- a/erts/emulator/drivers/ose/ose_efile.c +++ /dev/null @@ -1,1125 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2012. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Purpose: Provides file and directory operations for OSE. - */ -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif -#if defined(HAVE_POSIX_FALLOCATE) && !defined(__sun) && !defined(__sun__) -#define _XOPEN_SOURCE 600 -#endif -#if !defined(_GNU_SOURCE) && defined(HAVE_LINUX_FALLOC_H) -#define _GNU_SOURCE -#endif -#include "sys.h" -#include "erl_driver.h" -#include "erl_efile.h" -#if defined(DARWIN) || defined(HAVE_LINUX_FALLOC_H) || defined(HAVE_POSIX_FALLOCATE) -#include "fcntl.h" -#endif -#include "ose.h" -#include "unistd.h" -#include "sys/stat.h" -#include "dirent.h" -#include "sys/time.h" -#include "time.h" -#include "assert.h" - -/* Find a definition of MAXIOV, that is used in the code later. */ -#if defined IOV_MAX -#define MAXIOV IOV_MAX -#elif defined UIO_MAXIOV -#define MAXIOV UIO_MAXIOV -#else -#define MAXIOV 16 -#endif - -/* - * Macros for testing file types. - */ - -#define ISDIR(st) (((st).st_mode & S_IFMT) == S_IFDIR) -#define ISREG(st) (((st).st_mode & S_IFMT) == S_IFREG) -#define ISDEV(st) \ - (((st).st_mode&S_IFMT) == S_IFCHR || ((st).st_mode&S_IFMT) == S_IFBLK) -#define ISLNK(st) (((st).st_mode & S_IFLNK) == S_IFLNK) -#ifdef NO_UMASK -#define FILE_MODE 0644 -#define DIR_MODE 0755 -#else -#define FILE_MODE 0666 -#define DIR_MODE 0777 -#endif - -#define IS_DOT_OR_DOTDOT(s) \ - (s[0] == '.' && (s[1] == '\0' || (s[1] == '.' && s[2] == '\0'))) - -/* - * Macros for handling local file descriptors - * and mutexes. - * - * Handling of files like this is necessary because OSE - * does not allow seeking after the end of a file. So - * what we do it emulate this by keeping track of the size - * of the file and where the file's positions is. If a - * write happens after eof then we pad it. - * - * Given time this should be rewritten to get rid of the - * mutex and use the port lock to protect the data. This - * could be done be done by adapting the efile api for some - * calls to allow some meta-data to be associated with the - * open file. - */ - -#define L_FD_IS_VALID(fd_data) ((fd_data)->beyond_eof > 0) -#define L_FD_INVALIDATE(fd_data) (fd_data)->beyond_eof = 0 -#define L_FD_CUR(fd_data) (fd_data)->pos -#define L_FD_OFFS_BEYOND_EOF(fd_data, offs) \ - (((fd_data)->size > offs) ? 0 : 1) - -#define L_FD_FAIL -1 -#define L_FD_SUCCESS 1 -#define L_FD_PAD_SIZE 255 - -struct fd_meta { - ErlDrvMutex *meta_mtx; - struct fd_data *fd_data_list; -}; - -struct fd_data { - int fd; - struct fd_data *next; - struct fd_data *prev; - int pos; - int beyond_eof; - size_t size; -#ifdef DEBUG - PROCESS owner; -#endif -}; - -static int l_invalidate_local_fd(int fd); -static int l_pad_file(struct fd_data *fd_data, off_t offset); -static int check_error(int result, Efile_error* errInfo); -static struct fd_data* l_new_fd(void); -static int l_remove_local_fd(int fd); -static struct fd_data* l_find_local_fd(int fd); -static int l_update_local_fd(int fd, int pos, int size); - -static struct fd_meta* fdm = NULL; - - -/***************************************************************************/ - -static int -l_remove_local_fd(int fd) -{ - struct fd_data *fd_data; - fd_data = l_find_local_fd(fd); - - if (fd_data == NULL) { - return L_FD_FAIL; - } -#ifdef DEBUG - assert(fd_data->owner == current_process()); -#endif - erl_drv_mutex_lock(fdm->meta_mtx); - /* head ? */ - if (fd_data == fdm->fd_data_list) { - if (fd_data->next != NULL) { - /* remove link to head */ - fd_data->next->prev = NULL; - /* set new head */ - fdm->fd_data_list = fd_data->next; - } - else { - /* head is lonely */ - fdm->fd_data_list = NULL; - } - } - else { /* not head */ - if (fd_data->prev == NULL) { - erl_drv_mutex_unlock(fdm->meta_mtx); - return L_FD_FAIL; - } - else { - if (fd_data->next != NULL) { - fd_data->next->prev = fd_data->prev; - fd_data->prev->next = fd_data->next; - } - else { - fd_data->prev->next = NULL; - } - } - } - - /* scramble values */ - fd_data->beyond_eof = -1; - fd_data->next = NULL; - fd_data->prev = NULL; - fd_data->fd = -1; - - /* unlock and clean */ - driver_free(fd_data); - erl_drv_mutex_unlock(fdm->meta_mtx); - - return L_FD_SUCCESS; -} - -/***************************************************************************/ - -static int -l_invalidate_local_fd(int fd) { - struct fd_data *fd_data; - - if ((fd_data = l_find_local_fd(fd)) == NULL) { - return L_FD_FAIL; - } - - fd_data->beyond_eof = 0; - return L_FD_SUCCESS; -} - -/****************************************************************************/ - -static struct fd_data* -l_find_local_fd(int fd) { - struct fd_data *fd_data; - - fd_data = NULL; - erl_drv_mutex_lock(fdm->meta_mtx); - for (fd_data = fdm->fd_data_list; fd_data != NULL; ) { - if (fd_data->fd == fd) { -#ifdef DEBUG - assert(fd_data->owner == current_process()); -#endif - break; - } - fd_data = fd_data->next; - } - erl_drv_mutex_unlock(fdm->meta_mtx); - return fd_data; -} - -/***************************************************************************/ - -static struct fd_data* -l_new_fd(void) { - struct fd_data *fd_data; - - fd_data = driver_alloc(sizeof(struct fd_data)); - if (fd_data == NULL) { - return NULL; - } - erl_drv_mutex_lock(fdm->meta_mtx); - if (fdm->fd_data_list == NULL) { - fdm->fd_data_list = fd_data; - fdm->fd_data_list->prev = NULL; - fdm->fd_data_list->next = NULL; - } - else { - fd_data->next = fdm->fd_data_list; - fdm->fd_data_list = fd_data; - fdm->fd_data_list->prev = NULL; - } -#ifdef DEBUG - fd_data->owner = current_process(); -#endif - erl_drv_mutex_unlock(fdm->meta_mtx); - return fd_data; -} - -/***************************************************************************/ - -static int -l_update_local_fd(int fd, int pos, int size) { - struct fd_data *fd_data = NULL; - - fd_data = l_find_local_fd(fd); - /* new fd to handle? */ - if (fd_data == NULL) { - fd_data = l_new_fd(); - if (fd_data == NULL) { - /* out of memory */ - return L_FD_FAIL; - } - } - fd_data->size = size; - fd_data->pos = pos; - fd_data->fd = fd; - fd_data->beyond_eof = 1; - - return L_FD_SUCCESS; -} - -/***************************************************************************/ - -static int -l_pad_file(struct fd_data *fd_data, off_t offset) { - int size_dif; - int written = 0; - int ret_val = L_FD_SUCCESS; - char padding[L_FD_PAD_SIZE]; - - size_dif = (offset - fd_data->size); - memset(&padding, '\0', L_FD_PAD_SIZE); - - while (size_dif > 0) { - written = write(fd_data->fd, padding, - (size_dif < L_FD_PAD_SIZE) ? - size_dif : L_FD_PAD_SIZE); - if (written < 0 && errno != EINTR && errno != EAGAIN) { - ret_val = -1; - break; - } - size_dif -= written; - } - L_FD_INVALIDATE(fd_data); - return ret_val; -} - -/***************************************************************************/ - -static int -check_error(int result, Efile_error *errInfo) { - if (result < 0) { - errInfo->posix_errno = errInfo->os_errno = errno; - return 0; - } - return 1; -} - -/***************************************************************************/ - -int -efile_init() { - fdm = driver_alloc(sizeof(struct fd_meta)); - if (fdm == NULL) { - return L_FD_FAIL; - } - fdm->meta_mtx = erl_drv_mutex_create("ose_efile local fd mutex\n"); - erl_drv_mutex_lock(fdm->meta_mtx); - fdm->fd_data_list = NULL; - erl_drv_mutex_unlock(fdm->meta_mtx); - return L_FD_SUCCESS; -} - -/***************************************************************************/ - -int -efile_mkdir(Efile_error* errInfo, /* Where to return error codes. */ - char* name) /* Name of directory to create. */ -{ -#ifdef NO_MKDIR_MODE - return check_error(mkdir(name), errInfo); -#else - int res = mkdir(name, DIR_MODE); - if (res < 0 && errno == EINVAL) { - errno = ENOENT; - } - return check_error(res, errInfo); -#endif -} - -/***************************************************************************/ - -int -efile_rmdir(Efile_error* errInfo, /* Where to return error codes. */ - char* name) /* Name of directory to delete. */ -{ - if (rmdir(name) == 0) { - return 1; - } - if (errno == ENOTEMPTY) { - errno = EEXIST; - } - if (errno == EEXIST || errno == EINVAL) { - int saved_errno = errno; - struct stat file_stat; - struct stat cwd_stat; - - if(stat(name, &file_stat) != 0) { - errno = ENOENT; - return check_error(-1, errInfo); - } - /* - * The error code might be wrong if this is the current directory. - */ - if (stat(name, &file_stat) == 0 && stat(".", &cwd_stat) == 0 && - file_stat.st_ino == cwd_stat.st_ino && - file_stat.st_dev == cwd_stat.st_dev) { - saved_errno = EACCES; - } - errno = saved_errno; - } - return check_error(-1, errInfo); -} - -/***************************************************************************/ - -int -efile_delete_file(Efile_error* errInfo, /* Where to return error codes. */ - char* name) /* Name of file to delete. */ -{ - struct stat statbuf; - - if (stat(name, &statbuf) >= 0) { - /* Do not let unlink() remove directories */ - if (ISDIR(statbuf)) { - errno = EPERM; - return check_error(-1, errInfo); - } - - if (unlink(name) == 0) { - return 1; - } - - if (errno == EISDIR) { - errno = EPERM; - return check_error(-1, errInfo); - } - } - else { - if (errno == EINVAL) { - errno = ENOENT; - return check_error(-1, errInfo); - } - } - return check_error(-1, errInfo); -} - -/* - *--------------------------------------------------------------------------- - * - * Changes the name of an existing file or directory, from src to dst. - * If src and dst refer to the same file or directory, does nothing - * and returns success. Otherwise if dst already exists, it will be - * deleted and replaced by src subject to the following conditions: - * If src is a directory, dst may be an empty directory. - * If src is a file, dst may be a file. - * In any other situation where dst already exists, the rename will - * fail. - * - * Results: - * If the directory was successfully created, returns 1. - * Otherwise the return value is 0 and errno is set to - * indicate the error. Some possible values for errno are: - * - * EACCES: src or dst parent directory can't be read and/or written. - * EEXIST: dst is a non-empty directory. - * EINVAL: src is a root directory or dst is a subdirectory of src. - * EISDIR: dst is a directory, but src is not. - * ENOENT: src doesn't exist, or src or dst is "". - * ENOTDIR: src is a directory, but dst is not. - * EXDEV: src and dst are on different filesystems. - * - * Side effects: - * The implementation of rename may allow cross-filesystem renames, - * but the caller should be prepared to emulate it with copy and - * delete if errno is EXDEV. - * - *--------------------------------------------------------------------------- - */ - -int -efile_rename(Efile_error* errInfo, /* Where to return error codes. */ - char* src, /* Original name. */ - char* dst) /* New name. */ -{ - - /* temporary fix AFM does not recognize ./<file name> - * in destination remove pending on adaption of AFM fix - */ - - char *dot_str; - if (dst != NULL) { - dot_str = strchr(dst, '.'); - if (dot_str && dot_str == dst && dot_str[1] == '/') { - dst = dst+2; - } - } - - if (rename(src, dst) == 0) { - return 1; - } - if (errno == ENOTEMPTY) { - errno = EEXIST; - } - if (errno == EINVAL) { - struct stat file_stat; - - if (stat(dst, &file_stat)== 0) { - if (ISDIR(file_stat)) { - errno = EISDIR; - } - else if (ISREG(file_stat)) { - errno = ENOTDIR; - } - else { - errno = EINVAL; - } - } - else { - errno = EINVAL; - } - } - - if (strcmp(src, "/") == 0) { - errno = EINVAL; - } - return check_error(-1, errInfo); -} - -/***************************************************************************/ - -int -efile_chdir(Efile_error* errInfo, /* Where to return error codes. */ - char* name) /* Name of directory to make current. */ -{ - return check_error(chdir(name), errInfo); -} - -/***************************************************************************/ - -int -efile_getdcwd(Efile_error* errInfo, /* Where to return error codes. */ - int drive, /* 0 - current, 1 - A, 2 - B etc. */ - char* buffer, /* Where to return the current - directory. */ - size_t size) /* Size of buffer. */ -{ - if (drive == 0) { - if (getcwd(buffer, size) == NULL) - return check_error(-1, errInfo); - - return 1; - } - - /* - * Drives other than 0 is not supported on Unix. - */ - - errno = ENOTSUP; - return check_error(-1, errInfo); -} - -/***************************************************************************/ - -int -efile_readdir(Efile_error* errInfo, /* Where to return error codes. */ - char* name, /* Name of directory to open. */ - EFILE_DIR_HANDLE* p_dir_handle, /* Pointer to directory - handle of - open directory.*/ - char* buffer, /* Pointer to buffer for - one filename. */ - size_t *size) /* in-out Size of buffer, length - of name. */ -{ - DIR *dp; /* Pointer to directory structure. */ - struct dirent* dirp; /* Pointer to directory entry. */ - - /* - * If this is the first call, we must open the directory. - */ - - if (*p_dir_handle == NULL) { - dp = opendir(name); - if (dp == NULL) - return check_error(-1, errInfo); - *p_dir_handle = (EFILE_DIR_HANDLE) dp; - } - - /* - * Retrieve the name of the next file using the directory handle. - */ - - dp = *((DIR **)((void *)p_dir_handle)); - for (;;) { - dirp = readdir(dp); - if (dirp == NULL) { - closedir(dp); - return 0; - } - if (IS_DOT_OR_DOTDOT(dirp->d_name)) - continue; - buffer[0] = '\0'; - strncat(buffer, dirp->d_name, (*size)-1); - *size = strlen(dirp->d_name); - return 1; - } -} - -/***************************************************************************/ - -int -efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ - char* name, /* Name of directory to open. */ - int flags, /* Flags to user for opening. */ - int* pfd, /* Where to store the file - descriptor. */ - Sint64 *pSize) /* Where to store the size of the - file. */ -{ - struct stat statbuf; - int fd; - int mode; /* Open mode. */ - - if (stat(name, &statbuf) >= 0 && !ISREG(statbuf)) { - errno = EISDIR; - return check_error(-1, errInfo); - } - - switch (flags & (EFILE_MODE_READ|EFILE_MODE_WRITE)) { - case EFILE_MODE_READ: - mode = O_RDONLY; - break; - case EFILE_MODE_WRITE: - if (flags & EFILE_NO_TRUNCATE) - mode = O_WRONLY | O_CREAT; - else - mode = O_WRONLY | O_CREAT | O_TRUNC; - break; - case EFILE_MODE_READ_WRITE: - mode = O_RDWR | O_CREAT; - break; - default: - errno = EINVAL; - return check_error(-1, errInfo); - } - - - if (flags & EFILE_MODE_APPEND) { - mode &= ~O_TRUNC; - mode |= O_APPEND; - } - - if (flags & EFILE_MODE_EXCL) { - mode |= O_EXCL; - } - - fd = open(name, mode, FILE_MODE); - - if (!check_error(fd, errInfo)) - return 0; - - *pfd = fd; - if (pSize) { - *pSize = statbuf.st_size; - } - return 1; -} - -/***************************************************************************/ - -int -efile_may_openfile(Efile_error* errInfo, char *name) { - struct stat statbuf; /* Information about the file */ - int result; - - result = stat(name, &statbuf); - if (!check_error(result, errInfo)) - return 0; - if (!ISREG(statbuf)) { - errno = EISDIR; - return check_error(-1, errInfo); - } - return 1; -} - -/***************************************************************************/ - -void -efile_closefile(int fd) -{ - if (l_find_local_fd(fd) != NULL) { - l_remove_local_fd(fd); - } - close(fd); -} - -/***************************************************************************/ - -int -efile_fdatasync(Efile_error *errInfo, /* Where to return error codes. */ - int fd) /* File descriptor for file to sync data. */ -{ - return efile_fsync(errInfo, fd); -} - -/***************************************************************************/ - -int -efile_fsync(Efile_error *errInfo, /* Where to return error codes. */ - int fd) /* File descriptor for file to sync. */ -{ - return check_error(fsync(fd), errInfo); -} - -/***************************************************************************/ - -int -efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, - char* name, int info_for_link) -{ - struct stat statbuf; /* Information about the file */ - int result; - - result = stat(name, &statbuf); - if (!check_error(result, errInfo)) { - return 0; - } - -#if SIZEOF_OFF_T == 4 - pInfo->size_high = 0; -#else - pInfo->size_high = (Uint32)(statbuf.st_size >> 32); -#endif - pInfo->size_low = (Uint32)statbuf.st_size; - -#ifdef NO_ACCESS - /* Just look at read/write access for owner. */ - - pInfo->access = ((statbuf.st_mode >> 6) & 07) >> 1; - -#else - pInfo->access = FA_NONE; - if (access(name, R_OK) == 0) - pInfo->access |= FA_READ; - if (access(name, W_OK) == 0) - pInfo->access |= FA_WRITE; - -#endif - - if (ISDEV(statbuf)) - pInfo->type = FT_DEVICE; - else if (ISDIR(statbuf)) - pInfo->type = FT_DIRECTORY; - else if (ISREG(statbuf)) - pInfo->type = FT_REGULAR; - else if (ISLNK(statbuf)) - pInfo->type = FT_SYMLINK; - else - pInfo->type = FT_OTHER; - - pInfo->accessTime = statbuf.st_atime; - pInfo->modifyTime = statbuf.st_mtime; - pInfo->cTime = statbuf.st_ctime; - - pInfo->mode = statbuf.st_mode; - pInfo->links = statbuf.st_nlink; - pInfo->major_device = statbuf.st_dev; - pInfo->inode = statbuf.st_ino; - pInfo->uid = statbuf.st_uid; - pInfo->gid = statbuf.st_gid; - - return 1; -} - -/***************************************************************************/ - -int -efile_write_info(Efile_error *errInfo, Efile_info *pInfo, char *name) -{ - /* - * On some systems chown will always fail for a non-root user unless - * POSIX_CHOWN_RESTRICTED is not set. Others will succeed as long as - * you don't try to chown a file to someone besides youself. - */ - if (pInfo->mode != -1) { - mode_t newMode = pInfo->mode & (S_ISUID | S_ISGID | - S_IRWXU | S_IRWXG | S_IRWXO); - if (chmod(name, newMode)) { - newMode &= ~(S_ISUID | S_ISGID); - if (chmod(name, newMode)) { - return check_error(-1, errInfo); - } - } - } - - return 1; -} - -/***************************************************************************/ - -int -efile_write(Efile_error* errInfo, /* Where to return error codes. */ - int flags, /* Flags given when file was - opened. */ - int fd, /* File descriptor to write to. */ - char* buf, /* Buffer to write. */ - size_t count) /* Number of bytes to write. */ -{ - ssize_t written; /* Bytes written in last operation. */ - struct fd_data *fd_data; - - if ((fd_data = l_find_local_fd(fd)) != NULL) { - if (L_FD_IS_VALID(fd_data)) { - /* we are beyond eof and need to pad*/ - if (l_pad_file(fd_data, L_FD_CUR(fd_data)) < 0) { - return check_error(-1, errInfo); - } - } - } - - while (count > 0) { - if ((written = write(fd, buf, count)) < 0) { - if (errno != EINTR) { - return check_error(-1, errInfo); - } - else { - written = 0; - } - } - ASSERT(written <= count); - buf += written; - count -= written; - } - return 1; -} - -/***************************************************************************/ - -int -efile_writev(Efile_error* errInfo, /* Where to return error codes */ - int flags, /* Flags given when file was - * opened */ - int fd, /* File descriptor to write to */ - SysIOVec* iov, /* Vector of buffer structs. - * The structs may be changed i.e. - * due to incomplete writes */ - int iovcnt) /* Number of structs in vector */ -{ - struct fd_data *fd_data; - int cnt = 0; /* Buffers so far written */ - - ASSERT(iovcnt >= 0); - if ((fd_data = l_find_local_fd(fd)) != NULL) { - if (L_FD_IS_VALID(fd_data)) { - /* we are beyond eof and need to pad*/ - if (l_pad_file(fd_data, L_FD_CUR(fd_data)) < 0) { - return check_error(-1, errInfo); - } - } - } - while (cnt < iovcnt) { - if ((! iov[cnt].iov_base) || (iov[cnt].iov_len <= 0)) { - /* Empty buffer - skip */ - cnt++; - } - else { /* Non-empty buffer */ - ssize_t w; /* Bytes written in this call */ - do { - w = write(fd, iov[cnt].iov_base, iov[cnt].iov_len); - } while (w < 0 && errno == EINTR); - - ASSERT(w <= iov[cnt].iov_len || w == -1); - - if (w < 0) { - return check_error(-1, errInfo); - } - /* Move forward to next buffer to write */ - for (; cnt < iovcnt && w > 0; cnt++) { - if (iov[cnt].iov_base && iov[cnt].iov_len > 0) { - if (w < iov[cnt].iov_len) { - /* Adjust the buffer for next write */ - iov[cnt].iov_len -= w; - iov[cnt].iov_base += w; - w = 0; - break; - } - else { - w -= iov[cnt].iov_len; - } - } - } - ASSERT(w == 0); - } /* else Non-empty buffer */ - } /* while (cnt< iovcnt) */ - return 1; -} - -/***************************************************************************/ - -int -efile_read(Efile_error* errInfo, /* Where to return error codes. */ - int flags, /* Flags given when file was opened. */ - int fd, /* File descriptor to read from. */ - char* buf, /* Buffer to read into. */ - size_t count, /* Number of bytes to read. */ - size_t *pBytesRead) /* Where to return number of - bytes read. */ -{ - ssize_t n; - struct fd_data *fd_data; - - if ((fd_data = l_find_local_fd(fd)) != NULL) { - if (L_FD_IS_VALID(fd_data)) { - *pBytesRead = 0; - return 1; - } - } - for (;;) { - if ((n = read(fd, buf, count)) >= 0) { - break; - } - else if (errno != EINTR) { - return check_error(-1, errInfo); - } - } - if (fd_data != NULL && L_FD_IS_VALID(fd_data)) { - L_FD_INVALIDATE(fd_data); - } - *pBytesRead = (size_t) n; - return 1; -} - -/* pread() and pwrite() */ -/* Some unix systems, notably Solaris has these syscalls */ -/* It is especially nice for i.e. the dets module to have support */ -/* for this, even if the underlying OS dosn't support it, it is */ -/* reasonably easy to work around by first calling seek, and then */ -/* calling read(). */ -/* This later strategy however changes the file pointer, which pread() */ -/* does not do. We choose to ignore this and say that the location */ -/* of the file pointer is undefined after a call to any of the p functions*/ - - -int -efile_pread(Efile_error* errInfo, /* Where to return error codes. */ - int fd, /* File descriptor to read from. */ - Sint64 offset, /* Offset in bytes from BOF. */ - char* buf, /* Buffer to read into. */ - size_t count, /* Number of bytes to read. */ - size_t *pBytesRead) /* Where to return - number of bytes read. */ -{ - int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); - if (res) { - return efile_read(errInfo, 0, fd, buf, count, pBytesRead); - } else { - return res; - } -} - - -/***************************************************************************/ - -int -efile_pwrite(Efile_error* errInfo, /* Where to return error codes. */ - int fd, /* File descriptor to write to. */ - char* buf, /* Buffer to write. */ - size_t count, /* Number of bytes to write. */ - Sint64 offset) /* where to write it */ -{ - int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); - - if (res) { - return efile_write(errInfo, 0, fd, buf, count); - } else { - return res; - } -} - -/***************************************************************************/ - -int -efile_seek(Efile_error* errInfo, /* Where to return error codes. */ - int fd, /* File descriptor to do the seek on. */ - Sint64 offset, /* Offset in bytes from the given - origin. */ - int origin, /* Origin of seek (SEEK_SET, SEEK_CUR, - SEEK_END). */ - Sint64 *new_location) /* Resulting new location in file. */ -{ - off_t off, result; - off = (off_t) offset; - - switch (origin) { - case EFILE_SEEK_SET: - origin = SEEK_SET; - break; - case EFILE_SEEK_CUR: - origin = SEEK_CUR; - break; - case EFILE_SEEK_END: - origin = SEEK_END; - break; - default: - errno = EINVAL; - return check_error(-1, errInfo); - } - - if (off != offset) { - errno = EINVAL; - return check_error(-1, errInfo); - } - - errno = 0; - result = lseek(fd, off, origin); - - if (result >= 0) { - l_invalidate_local_fd(fd); - } - - if (result < 0) - { - if (errno == ENOSYS) { - int size, cur_pos; - - if (off < 0) { - errno = EINVAL; - return check_error(-1, errInfo); - } - - cur_pos = lseek(fd, 0, SEEK_CUR); - size = lseek(fd, 0, SEEK_END); - - if (origin == SEEK_SET) { - result = offset; - } - else if (origin == SEEK_CUR) { - result = offset + cur_pos; - } - else if (origin == SEEK_END) { - result = size + offset; - } - - /* sanity check our result */ - if (size > result) { - return check_error(-1, errInfo); - } - - /* store the data localy */ - l_update_local_fd(fd, result, size); - - /* reset the original file position */ - if (origin != SEEK_END) { - lseek(fd, cur_pos, SEEK_SET); - } - } - else if (errno == 0) { - errno = EINVAL; - } - } - - if (new_location) { - *new_location = result; - } - - return 1; -} - -/***************************************************************************/ - -int -efile_truncate_file(Efile_error* errInfo, int *fd, int flags) -{ - off_t offset; - struct fd_data *fd_data; - - if ((fd_data = l_find_local_fd(*fd)) != NULL && L_FD_IS_VALID(fd_data)) { - offset = L_FD_CUR(fd_data); - } - else { - offset = lseek(*fd, 0, SEEK_CUR); - } - - return check_error(((offset >= 0) && - (ftruncate(*fd, offset) == 0)) ? 1 : -1, errInfo); -} - -/***************************************************************************/ - -int -efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size) -{ - errno = ENOTSUP; - return check_error(-1, errInfo); -} - -/***************************************************************************/ - -int -efile_altname(Efile_error* errInfo, char* name, char* buffer, size_t size) -{ - errno = ENOTSUP; - return check_error(-1, errInfo); -} - -/***************************************************************************/ - -int -efile_link(Efile_error* errInfo, char* old, char* new) -{ - errno = ENOTSUP; - return check_error(-1, errInfo); -} - -/***************************************************************************/ - -int -efile_symlink(Efile_error* errInfo, char* old, char* new) -{ - errno = ENOTSUP; - return check_error(-1, errInfo); -} - -/***************************************************************************/ - -int -efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, - Sint64 length, int advise) -{ - return check_error(posix_fadvise(fd, offset, length, advise), errInfo); -} - -/***************************************************************************/ - -static int -call_posix_fallocate(int fd, Sint64 offset, Sint64 length) -{ - int ret; - - /* - * On Linux and Solaris for example, posix_fallocate() returns - * a positive error number on error and it does not set errno. - * On FreeBSD however (9.0 at least), it returns -1 on error - * and it sets errno. - */ - do { - ret = posix_fallocate(fd, (off_t) offset, (off_t) length); - if (ret > 0) { - errno = ret; - ret = -1; - } - } while (ret != 0 && errno == EINTR); - - return ret; -} - -/***************************************************************************/ - -int -efile_fallocate(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length) -{ - return check_error(call_posix_fallocate(fd, offset, length), errInfo); -} diff --git a/erts/emulator/drivers/ose/ose_signal_drv.c b/erts/emulator/drivers/ose/ose_signal_drv.c deleted file mode 100644 index 2be9462a47..0000000000 --- a/erts/emulator/drivers/ose/ose_signal_drv.c +++ /dev/null @@ -1,897 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2013-2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#include "errno.h" -#include "stdio.h" -#include "string.h" -#include "stddef.h" - -#include "sys.h" -#include "erl_driver.h" -#include "ose.h" - - -#ifdef HAVE_OSE_SPI_H -#include "ose_spi/ose_spi.h" -#endif - -#define DEBUG_ATTACH 0 -#define DEBUG_HUNT 0 -#define DEBUG_SEND 0 -#define DEBUG_LISTEN 0 - -#if 0 -#define DEBUGP(FMT,...) printf(FMT, __VA_ARGS__) -#else -#define DEBUGP(FMT,...) -#endif - -#if DEBUG_ATTACH -#define DEBUGP_ATTACH(...) DEBUGP( __VA_ARGS__) -#else -#define DEBUGP_ATTACH(...) -#endif - -#if DEBUG_HUNT -#define DEBUGP_HUNT(...) DEBUGP( __VA_ARGS__) -#else -#define DEBUGP_HUNT(...) -#endif - -#if DEBUG_LISTEN -#define DEBUGP_LISTEN(...) DEBUGP( __VA_ARGS__) -#else -#define DEBUGP_LISTEN(...) -#endif - -#if DEBUG_SEND -#define DEBUGP_SEND(...) DEBUGP( __VA_ARGS__) -#else -#define DEBUGP_SEND(...) -#endif - - -#define DRIVER_NAME "ose_signal_drv" -#define GET_SPID 1 -#define GET_NAME 2 -#define HUNT 100 -#define DEHUNT 101 -#define ATTACH 102 -#define DETACH 103 -#define SEND 104 -#define SEND_W_S 105 -#define LISTEN 106 -#define OPEN 200 - -#define REF_SEGMENT_SIZE 8 - -struct async { - SIGSELECT signo; - ErlDrvTermData port; - ErlDrvTermData proc; - PROCESS spid; - PROCESS target; - Uint32 ref; -}; - -/** - * OSE signals - **/ -union SIGNAL { - SIGSELECT signo; - struct async async; -}; - -/** - * The driver's context - **/ -typedef struct _driver_context { - ErlDrvPort port; - PROCESS spid; - ErlDrvEvent perm_events[2]; - ErlDrvEvent *events; - Uint32 event_cnt; - Uint32 ref; - Uint32 *outstanding_refs; - Uint32 outstanding_refs_max; - Uint32 outstanding_refs_cnt; -} driver_context_t; - -/** - * Global variables - **/ -static ErlDrvTermData a_ok; -static ErlDrvTermData a_error; -static ErlDrvTermData a_enomem; -static ErlDrvTermData a_enoent; -static ErlDrvTermData a_badarg; -static ErlDrvTermData a_mailbox_up; -static ErlDrvTermData a_mailbox_down; -static ErlDrvTermData a_ose_drv_reply; -static ErlDrvTermData a_message; -static PROCESS proxy_proc; - - -/** - * Serialize/unserialize unsigned 32-bit values - **/ -static char *put_u32(unsigned int value, char *ptr) { - *ptr++ = (value & 0xff000000) >> 24; - *ptr++ = (value & 0x00ff0000) >> 16; - *ptr++ = (value & 0x0000ff00) >> 8; - *ptr++ = (value & 0xff); - - return ptr; -} - -static unsigned int get_u32(char *ptr) { - unsigned int result = 0; - result += (ptr[0] & 0xff) << 24; - result += (ptr[1] & 0xff) << 16; - result += (ptr[2] & 0xff) << 8; - result += (ptr[3] & 0xff); - - return result; -} - - -/* Stolen from efile_drv.c */ - -/* char EV_CHAR_P(ErlIOVec *ev, int p, int q) */ -#define EV_CHAR_P(ev, p, q) \ - (((char *)(ev)->iov[(q)].iov_base) + (p)) - -/* int EV_GET_CHAR(ErlIOVec *ev, char *p, int *pp, int *qp) */ -#define EV_GET_CHAR(ev, p, pp, qp) ev_get_char(ev, p ,pp, qp) -static int -ev_get_char(ErlIOVec *ev, char *p, int *pp, int *qp) { - if (*(pp)+1 <= (ev)->iov[*(qp)].iov_len) { - *(p) = *EV_CHAR_P(ev, *(pp), *(qp)); - if (*(pp)+1 < (ev)->iov[*(qp)].iov_len) - *(pp) = *(pp)+1; - else { - (*(qp))++; - *pp = 0; - } - return !0; - } - return 0; -} - -/* Uint32 EV_UINT32(ErlIOVec *ev, int p, int q)*/ -#define EV_UINT32(ev, p, q) \ - ((Uint32) *(((unsigned char *)(ev)->iov[(q)].iov_base) + (p))) - -/* int EV_GET_UINT32(ErlIOVec *ev, Uint32 *p, int *pp, int *qp) */ -#define EV_GET_UINT32(ev, p, pp, qp) ev_get_uint32(ev,(Uint32*)(p),pp,qp) -static int -ev_get_uint32(ErlIOVec *ev, Uint32 *p, int *pp, int *qp) { - if (*(pp)+4 <= (ev)->iov[*(qp)].iov_len) { - *(p) = (EV_UINT32(ev, *(pp), *(qp)) << 24) - | (EV_UINT32(ev, *(pp)+1, *(qp)) << 16) - | (EV_UINT32(ev, *(pp)+2, *(qp)) << 8) - | (EV_UINT32(ev, *(pp)+3, *(qp))); - if (*(pp)+4 < (ev)->iov[*(qp)].iov_len) - *(pp) = *(pp)+4; - else { - (*(qp))++; - *pp = 0; - } - return !0; - } - return 0; -} - -/** - * Convinience macros - **/ -#define send_response(port,output) erl_drv_send_term(driver_mk_port(port),\ - driver_caller(port), output, sizeof(output) / sizeof(output[0])); - -void iov_memcpy(void *dest,ErlIOVec *ev,int ind,int off); -void iov_memcpy(void *dest,ErlIOVec *ev,int ind,int off) { - int i; - memcpy(dest,ev->iov[ind].iov_base+off,ev->iov[ind].iov_len-off); - for (i = ind+1; i < ev->vsize; i++) - memcpy(dest,ev->iov[i].iov_base,ev->iov[i].iov_len); -} - -/** - * Reference handling - **/ - -static int add_reference(driver_context_t *ctxt, Uint32 ref) { - - /* - * Premature optimizations may be evil, but they sure are fun. - */ - - if (ctxt->outstanding_refs == NULL) { - /* First ref to be ignored */ - ctxt->outstanding_refs = driver_alloc(REF_SEGMENT_SIZE*sizeof(Uint32)); - if (!ctxt->outstanding_refs) - return 1; - - memset(ctxt->outstanding_refs,0,REF_SEGMENT_SIZE*sizeof(Uint32)); - ctxt->outstanding_refs_max += REF_SEGMENT_SIZE; - ctxt->outstanding_refs[ctxt->outstanding_refs_cnt++] = ref; - } else if (ctxt->outstanding_refs_cnt == ctxt->outstanding_refs_max) { - /* Expand ref array */ - Uint32 *new_array; - ctxt->outstanding_refs_max += REF_SEGMENT_SIZE; - new_array = driver_realloc(ctxt->outstanding_refs, - ctxt->outstanding_refs_max*sizeof(Uint32)); - - if (!new_array) { - ctxt->outstanding_refs_max -= REF_SEGMENT_SIZE; - return 1; - } - - ctxt->outstanding_refs = new_array; - - memset(ctxt->outstanding_refs+ctxt->outstanding_refs_cnt,0, - REF_SEGMENT_SIZE*sizeof(Uint32)); - ctxt->outstanding_refs[ctxt->outstanding_refs_cnt++] = ref; - - } else { - /* Find an empty slot: - * First we try current index, - * then we scan for a slot. - */ - if (!ctxt->outstanding_refs[ctxt->outstanding_refs_cnt]) { - ctxt->outstanding_refs[ctxt->outstanding_refs_cnt++] = ref; - } else { - int i; - ASSERT(ctxt->outstanding_refs_cnt < ctxt->outstanding_refs_max); - for (i = 0; i < ctxt->outstanding_refs_max; i++) - if (!ctxt->outstanding_refs[i]) - break; - ASSERT(ctxt->outstanding_refs[i] == 0); - ctxt->outstanding_refs[i] = ref; - ctxt->outstanding_refs_cnt++; - } - } - return 0; -} - -/* Return 0 if removed, 1 if does not exist, */ -static int remove_reference(driver_context_t *ctxt, Uint32 ref) { - int i,j; - - if (ctxt->outstanding_refs_max == 0 && ctxt->outstanding_refs_cnt == 0) { - ASSERT(ctxt->outstanding_refs == NULL); - return 1; - } - - for (i = 0; i < ctxt->outstanding_refs_max; i++) { - if (ctxt->outstanding_refs[i] == ref) { - ctxt->outstanding_refs[i] = 0; - ctxt->outstanding_refs_cnt--; - i = -1; - break; - } - } - - if (i != -1) - return 1; - - if (ctxt->outstanding_refs_cnt == 0) { - driver_free(ctxt->outstanding_refs); - ctxt->outstanding_refs = NULL; - ctxt->outstanding_refs_max = 0; - } else if (ctxt->outstanding_refs_cnt == (ctxt->outstanding_refs_max - REF_SEGMENT_SIZE)) { - Uint32 *new_array; - for (i = 0, j = 0; i < ctxt->outstanding_refs_cnt; i++) { - if (ctxt->outstanding_refs[i] == 0) { - for (j = i+1; j < ctxt->outstanding_refs_max; j++) - if (ctxt->outstanding_refs[j]) { - ctxt->outstanding_refs[i] = ctxt->outstanding_refs[j]; - ctxt->outstanding_refs[j] = 0; - break; - } - } - } - ctxt->outstanding_refs_max -= REF_SEGMENT_SIZE; - new_array = driver_realloc(ctxt->outstanding_refs, - ctxt->outstanding_refs_max*sizeof(Uint32)); - if (!new_array) { - ctxt->outstanding_refs_max += REF_SEGMENT_SIZE; - return 2; - } - - ctxt->outstanding_refs = new_array; - - } - - return 0; -} - -/** - * The OSE proxy process. This only handles ERTS_SIGNAL_OSE_DRV_ATTACH. - * The process is needed because signals triggered by attach ignore - * redir tables. - * - * We have one global proxy process to save memory. An attempt to make each - * port phantom into a proxy was made, but that used way to much memory. - */ -static OS_PROCESS(driver_proxy_process) { - SIGSELECT sigs[] = {1,ERTS_SIGNAL_OSE_DRV_ATTACH}; - PROCESS master = 0; - - while (1) { - union SIGNAL *sig = receive(sigs); - - if (sig->signo == ERTS_SIGNAL_OSE_DRV_ATTACH) { - - /* The first message is used to determine who to send messages to. */ - if (master == 0) - master = sender(&sig); - - if (sig->async.target == 0) { - PROCESS from = sender(&sig); - restore(sig); - DEBUGP_ATTACH("0x%x: got attach 0x%x, sending to 0x%x\n", - current_process(),from,master); - sig->async.target = from; - send(&sig,master); - } else { - PROCESS target = sig->async.target; - restore(sig); - sig->async.target = 0; - DEBUGP_ATTACH("0x%x: doing attach on 0x%x\n",current_process(),target); - attach(&sig,target); - } - } - } -} - - -/** - * Init routine for the driver - **/ -static int drv_init(void) { - - a_ok = driver_mk_atom("ok"); - a_error = driver_mk_atom("error"); - a_enomem = driver_mk_atom("enomem"); - a_enoent = driver_mk_atom("enoent"); - a_badarg = driver_mk_atom("badarg"); - a_mailbox_up = driver_mk_atom("mailbox_up"); - a_mailbox_down = driver_mk_atom("mailbox_down"); - a_ose_drv_reply = driver_mk_atom("ose_drv_reply"); - a_message = driver_mk_atom("message"); - - proxy_proc = create_process(get_ptype(current_process()), - "ose_signal_driver_proxy", - driver_proxy_process, 10000, - get_pri(current_process()), - 0, 0, NULL, 0, 0); - -#ifdef DEBUG - efs_clone(proxy_proc); -#endif - start(proxy_proc); - - return 0; -} - -/* Signal resolution callback */ -static ErlDrvOseEventId resolve_signal(union SIGNAL* osig) { - union SIGNAL *sig = osig; - if (sig->signo == ERTS_SIGNAL_OSE_DRV_HUNT || - sig->signo == ERTS_SIGNAL_OSE_DRV_ATTACH) { - return sig->async.spid; - } - DEBUGP("%p: Got signal %d sent to %p from 0x%p\n", - current_process(),sig->signo,addressee(&sig),sender(&sig)); - return addressee(&sig); -} - - -/** - * Start routine for the driver - **/ -static ErlDrvData drv_start(ErlDrvPort port, char *command) -{ - driver_context_t *ctxt = driver_alloc(sizeof(driver_context_t)); - - ctxt->perm_events[0] = NULL; - ctxt->perm_events[1] = NULL; - - ctxt->spid = 0; - ctxt->port = port; - ctxt->event_cnt = 0; - ctxt->events = NULL; - ctxt->ref = 0; - ctxt->outstanding_refs = NULL; - ctxt->outstanding_refs_max = 0; - ctxt->outstanding_refs_cnt = 0; - - - /* Set the communication protocol to Erlang to be binary */ - set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY); - - /* Everything ok */ - return (ErlDrvData)ctxt; -} - -/** - * Stop routine for the driver - **/ -static void drv_stop(ErlDrvData driver_data) -{ - driver_context_t *ctxt = (driver_context_t *)driver_data; - int i; - - /* HUNT + ATTACH */ - if (ctxt->perm_events[0]) - driver_select(ctxt->port, ctxt->perm_events[0], - ERL_DRV_USE|ERL_DRV_READ, 0); - if (ctxt->perm_events[1]) - driver_select(ctxt->port, ctxt->perm_events[1], - ERL_DRV_USE|ERL_DRV_READ, 0); - - for (i = 0; i < ctxt->event_cnt; i++) { - driver_select(ctxt->port, ctxt->events[i], ERL_DRV_USE|ERL_DRV_READ, 0); - } - - if (ctxt->spid != 0) - kill_proc(ctxt->spid); - DEBUGP("0x%x: stopped\n",ctxt->spid); - if (ctxt->events) - driver_free(ctxt->events); - if (ctxt->outstanding_refs) - driver_free(ctxt->outstanding_refs); - - driver_free(ctxt); -} - -/** - * Output from Erlang - **/ -static void outputv(ErlDrvData driver_data, ErlIOVec *ev) -{ - driver_context_t *ctxt = (driver_context_t *)driver_data; - int p = 0, q = 1; - char cmd; - - if (! EV_GET_CHAR(ev,&cmd,&p,&q)) { - ErlDrvTermData output[] = { - ERL_DRV_ATOM, a_ose_drv_reply, - ERL_DRV_PORT, driver_mk_port(ctxt->port), - ERL_DRV_ATOM, a_badarg, - ERL_DRV_TUPLE, 3}; - send_response(ctxt->port, output); - return; - } - - /* Command is in the buffer's first byte */ - switch(cmd) { - - case OPEN: { - char *name = driver_alloc(ev->size - 1+1); - struct OS_redir_entry redir[2]; - - redir[0].sig = 1; - redir[0].pid = current_process(); - - iov_memcpy(name,ev,q,p); - name[ev->size-1] = '\0'; - - ctxt->spid = create_process(OS_PHANTOM, name, NULL, 0, - 0, 0, 0, redir, 0, 0); - - DEBUGP("0x%x: open\n",ctxt->spid); - - ctxt->perm_events[1] = - erl_drv_ose_event_alloc(ERTS_SIGNAL_OSE_DRV_ATTACH,(int)ctxt->spid, - resolve_signal, NULL); - driver_select(ctxt->port,ctxt->perm_events[1],ERL_DRV_READ|ERL_DRV_USE,1); - - ctxt->perm_events[0] = - erl_drv_ose_event_alloc(ERTS_SIGNAL_OSE_DRV_HUNT,(int)ctxt->spid, - resolve_signal, NULL); - driver_select(ctxt->port,ctxt->perm_events[0],ERL_DRV_READ|ERL_DRV_USE,1); - - start(ctxt->spid); - - { - ErlDrvTermData output[] = { - ERL_DRV_ATOM, a_ose_drv_reply, - ERL_DRV_PORT, driver_mk_port(ctxt->port), - ERL_DRV_ATOM, a_ok, - ERL_DRV_TUPLE, 3}; - - send_response(ctxt->port, output); - } - - break; - - } - - case ATTACH: - case HUNT: - { - union SIGNAL *sig = alloc(sizeof(union SIGNAL), - cmd == HUNT ? ERTS_SIGNAL_OSE_DRV_HUNT:ERTS_SIGNAL_OSE_DRV_ATTACH); - - sig->async.port = driver_mk_port(ctxt->port); - sig->async.proc = driver_caller(ctxt->port); - sig->async.spid = ctxt->spid; - sig->async.ref = ++ctxt->ref; - - if (add_reference(ctxt,ctxt->ref)) { - ErlDrvTermData output[] = { - ERL_DRV_ATOM, a_ose_drv_reply, - ERL_DRV_PORT, driver_mk_port(ctxt->port), - ERL_DRV_ATOM, a_enomem, - ERL_DRV_TUPLE, 3}; - send_response(ctxt->port, output); - free_buf(&sig); - } else { - ErlDrvTermData output[] = { - ERL_DRV_ATOM, a_ose_drv_reply, - ERL_DRV_PORT, driver_mk_port(ctxt->port), - ERL_DRV_PORT, driver_mk_port(ctxt->port), - ERL_DRV_INT, (ErlDrvUInt)ctxt->ref, - ERL_DRV_TUPLE, 2, - ERL_DRV_TUPLE, 3}; - send_response(ctxt->port, output); - - if (cmd == HUNT) { - char *huntname = driver_alloc(sizeof(char)*((ev->size-1)+1)); - - iov_memcpy(huntname,ev,q,p); - huntname[ev->size-1] = '\0'; - - DEBUGP_HUNT("0x%x: hunt %s -> %u (%u,%u)\n", - ctxt->spid,huntname,ctxt->ref, - ctxt->outstanding_refs_cnt, - ctxt->outstanding_refs_max); - - hunt(huntname, 0, NULL, &sig); - - driver_free(huntname); - } else { - EV_GET_UINT32(ev,&sig->async.target,&p,&q); - DEBUGP_ATTACH("0x%x: attach %u -> %u (%u,%u)\n", - ctxt->spid,sig->async.target, - ctxt->ref, - ctxt->outstanding_refs_cnt, - ctxt->outstanding_refs_max); - - send(&sig,proxy_proc); - } - - } - - break; - } - - case DETACH: - case DEHUNT: - { - - Uint32 ref; - - EV_GET_UINT32(ev,&ref,&p,&q); - if (cmd == DETACH) { - DEBUGP_ATTACH("0x%x: detach %u (%u,%u)\n",ctxt->spid,ref, - ctxt->outstanding_refs_cnt, - ctxt->outstanding_refs_max); - } else { - DEBUGP_HUNT("0x%x: dehunt %u (%u,%u)\n",ctxt->spid,ref, - ctxt->outstanding_refs_cnt, - ctxt->outstanding_refs_max); - } - - if (remove_reference(ctxt,ref)) { - ErlDrvTermData output[] = { - ERL_DRV_ATOM, a_ose_drv_reply, - ERL_DRV_PORT, driver_mk_port(ctxt->port), - ERL_DRV_ATOM, a_error, - ERL_DRV_ATOM, a_enoent, - ERL_DRV_TUPLE, 2, - ERL_DRV_TUPLE, 3}; - - send_response(ctxt->port, output); - } else { - ErlDrvTermData output[] = { - ERL_DRV_ATOM, a_ose_drv_reply, - ERL_DRV_PORT, driver_mk_port(ctxt->port), - ERL_DRV_ATOM, a_ok, - ERL_DRV_TUPLE, 3}; - - send_response(ctxt->port, output); - } - - break; - } - - case SEND: - case SEND_W_S: - { - PROCESS spid; - PROCESS sender; - SIGSELECT signo; - OSBUFSIZE size = ev->size-9; - union SIGNAL *sig; - - EV_GET_UINT32(ev,&spid,&p,&q); - - if (cmd == SEND_W_S) { - EV_GET_UINT32(ev,&sender,&p,&q); - size -= 4; - } else { - sender = ctxt->spid; - } - - EV_GET_UINT32(ev,&signo,&p,&q); - - sig = alloc(size + sizeof(SIGSELECT),signo); - - if (cmd == SEND_W_S) { - DEBUGP_SEND("0x%x: send_w_s(%u,%u,%u)\n",ctxt->spid,spid,signo,sender); - } else { - DEBUGP_SEND("0x%x: send(%u,%u)\n",ctxt->spid,spid,signo); - } - - iov_memcpy(((char *)&sig->signo) + sizeof(SIGSELECT),ev,q,p); - - send_w_s(&sig, sender, spid); - - break; - } - - case LISTEN: - { - int i,j,event_cnt = (ev->size - 1)/4; - ErlDrvEvent *events = NULL; - SIGSELECT signo,tmp_signo; - - if (event_cnt == 0) { - for (i = 0; i < ctxt->event_cnt; i++) - driver_select(ctxt->port,ctxt->events[i],ERL_DRV_READ|ERL_DRV_USE,0); - if (ctxt->events) - driver_free(ctxt->events); - } else { - events = driver_alloc(sizeof(ErlDrvEvent)*event_cnt); - EV_GET_UINT32(ev,&signo,&p,&q); - for (i = 0, j = 0; i < event_cnt || j < ctxt->event_cnt; ) { - - if (ctxt->events) - erl_drv_ose_event_fetch(ctxt->events[j],&tmp_signo,NULL,NULL); - - if (signo == tmp_signo) { - events[i++] = ctxt->events[j++]; - EV_GET_UINT32(ev,&signo,&p,&q); - } else if (signo < tmp_signo || !ctxt->events) { - /* New signal to select on */ - events[i] = erl_drv_ose_event_alloc(signo,(int)ctxt->spid, - resolve_signal, NULL); - driver_select(ctxt->port,events[i++],ERL_DRV_READ|ERL_DRV_USE,1); - EV_GET_UINT32(ev,&signo,&p,&q); - } else { - /* Remove old signal to select on */ - driver_select(ctxt->port,ctxt->events[j++],ERL_DRV_READ|ERL_DRV_USE,0); - } - } - if (ctxt->events) - driver_free(ctxt->events); - } - ctxt->events = events; - ctxt->event_cnt = event_cnt; - - { - ErlDrvTermData output[] = { - ERL_DRV_ATOM, a_ose_drv_reply, - ERL_DRV_PORT, driver_mk_port(ctxt->port), - ERL_DRV_ATOM, a_ok, - ERL_DRV_TUPLE, 3}; - send_response(ctxt->port, output); - } - break; - } - - default: - { - DEBUGP("Warning: 'ose_signal_drv' unknown command '%d'\n", cmd); - break; - } - } -} - -/** - * Handler for when OSE signal arrives - **/ -static void ready_input(ErlDrvData driver_data, ErlDrvEvent event) -{ - driver_context_t *ctxt = (driver_context_t *)driver_data; - union SIGNAL *sig = erl_drv_ose_get_signal(event); - - while (sig != NULL) { - - switch(sig->signo) - { - /* Remote process is available */ - case ERTS_SIGNAL_OSE_DRV_HUNT: - { - const PROCESS spid = sender(&sig); - - if (remove_reference(ctxt,sig->async.ref)) { - DEBUGP_HUNT("0x%x: Got hunt from 0x%x -> %u (CANCELLED) (%u,%u)\n", - ctxt->spid,spid,sig->async.ref, - ctxt->outstanding_refs_cnt, - ctxt->outstanding_refs_max); - /* Already removed by dehunt */ - } else { - ErlDrvTermData reply[] = { - ERL_DRV_ATOM, a_mailbox_up, - ERL_DRV_PORT, sig->async.port, - ERL_DRV_PORT, sig->async.port, - ERL_DRV_UINT, (ErlDrvUInt)sig->async.ref, - ERL_DRV_TUPLE, 2, - ERL_DRV_UINT, (ErlDrvUInt)spid, - ERL_DRV_TUPLE, 4}; - DEBUGP_HUNT("0x%x: Got hunt from 0x%x -> %u (%u,%u)\n", - ctxt->spid,spid,sig->async.ref, - ctxt->outstanding_refs_cnt, - ctxt->outstanding_refs_max); - erl_drv_send_term(sig->async.port, sig->async.proc, reply, - sizeof(reply) / sizeof(reply[0])); - } - break; - } - - /* Remote process is down */ - case ERTS_SIGNAL_OSE_DRV_ATTACH: - { - PROCESS spid = sig->async.target; - - if (remove_reference(ctxt,sig->async.ref)) { - DEBUGP_ATTACH("0x%x: Got attach from 0x%x -> %u (CANCELLED) (%u,%u)\n", - ctxt->spid,spid,sig->async.ref, - ctxt->outstanding_refs_cnt, - ctxt->outstanding_refs_max); - /* Already removed by detach */ - } else { - ErlDrvTermData reply[] = { - ERL_DRV_ATOM, a_mailbox_down, - ERL_DRV_PORT, sig->async.port, - ERL_DRV_PORT, sig->async.port, - ERL_DRV_UINT, sig->async.ref, - ERL_DRV_TUPLE, 2, - ERL_DRV_UINT, (ErlDrvUInt)spid, - ERL_DRV_TUPLE, 4}; - DEBUGP_ATTACH("0x%x: Got attach from 0x%x -> %u (%u,%u)\n", - ctxt->spid,spid,sig->async.ref, - ctxt->outstanding_refs_cnt, - ctxt->outstanding_refs_max); - erl_drv_send_term(sig->async.port, sig->async.proc, reply, - sizeof(reply) / sizeof(reply[0])); - } - break; - } - - /* Received user defined signal */ - default: - { - const PROCESS spid = sender(&sig); - const OSBUFSIZE size = sigsize(&sig) - sizeof(SIGSELECT); - const char *sig_data = ((char *)&sig->signo) + sizeof(SIGSELECT); - - ErlDrvTermData reply[] = { - ERL_DRV_ATOM, a_message, - ERL_DRV_PORT, driver_mk_port(ctxt->port), - ERL_DRV_UINT, (ErlDrvUInt)spid, - ERL_DRV_UINT, (ErlDrvUInt)ctxt->spid, - ERL_DRV_UINT, (ErlDrvUInt)sig->signo, - ERL_DRV_BUF2BINARY, (ErlDrvTermData)sig_data, (ErlDrvUInt)size, - ERL_DRV_TUPLE, 4, - ERL_DRV_TUPLE, 3}; - - DEBUGP_SEND("0x%x: Got 0x%u\r\n", spid, sig->signo); - - erl_drv_output_term(driver_mk_port(ctxt->port), reply, - sizeof(reply) / sizeof(reply[0])); - break; - } - } - - free_buf(&sig); - sig = erl_drv_ose_get_signal(event); - } -} - -/** - * Handler for 'port_control' - **/ -static ErlDrvSSizeT control(ErlDrvData driver_data, unsigned int cmd, - char *buf, ErlDrvSizeT len, - char **rbuf, ErlDrvSizeT rlen) -{ - driver_context_t *ctxt = (driver_context_t *)driver_data; - - switch(cmd) - { - case GET_SPID: - { - const PROCESS spid = ctxt->spid; - put_u32(spid, *rbuf); - return sizeof(PROCESS); - } - -#ifdef HAVE_OSE_SPI_H - case GET_NAME: - { - const PROCESS spid = get_u32(buf); - char *name = (char*)get_pid_info(spid,OSE_PI_NAME); - int n; - if (!name) { - *rbuf = NULL; - return 0; - } - - if (rlen < (n = strlen(name))) { - ErlDrvBinary *bin = driver_alloc_binary(n); - strncpy(bin->orig_bytes,name,n); - *rbuf = (char*)bin; - } else - strncpy(*rbuf,name,n); - free_buf((union SIGNAL**)&name); - - return n; - } -#endif - default: - { - /* Unknown command */ - return (ErlDrvSSizeT)ERL_DRV_ERROR_GENERAL; - break; - } - } -} - -static void stop_select(ErlDrvEvent event, void *reserved) -{ - erl_drv_ose_event_free(event); -} - -/** - * Setup the driver entry for the Erlang runtime - **/ -ErlDrvEntry ose_signal_driver_entry = { - .init = drv_init, - .start = drv_start, - .stop = drv_stop, - .outputv = outputv, - .ready_input = ready_input, - .driver_name = DRIVER_NAME, - .control = control, - .extended_marker = ERL_DRV_EXTENDED_MARKER, - .major_version = ERL_DRV_EXTENDED_MAJOR_VERSION, - .minor_version = ERL_DRV_EXTENDED_MINOR_VERSION, - .driver_flags = ERL_DRV_FLAG_USE_PORT_LOCKING, - .stop_select = stop_select -}; - diff --git a/erts/emulator/drivers/ose/ttsl_drv.c b/erts/emulator/drivers/ose/ttsl_drv.c deleted file mode 100644 index f759b47984..0000000000 --- a/erts/emulator/drivers/ose/ttsl_drv.c +++ /dev/null @@ -1,69 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Stub tty driver because group/user depend on this. - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#include "erl_driver.h" - -static int ttysl_init(void); -static ErlDrvData ttysl_start(ErlDrvPort, char*); - -/* Define the driver table entry. */ -struct erl_drv_entry ttsl_driver_entry = { - ttysl_init, - ttysl_start, - NULL, - NULL, - NULL, - NULL, - "tty_sl", - NULL, - NULL, - NULL, - NULL, /* timeout */ - NULL, /* outputv */ - NULL, /* ready_async */ - NULL, /* flush */ - NULL, /* call */ - NULL, /* event */ - ERL_DRV_EXTENDED_MARKER, - ERL_DRV_EXTENDED_MAJOR_VERSION, - ERL_DRV_EXTENDED_MINOR_VERSION, - 0, /* ERL_DRV_FLAGs */ - NULL, - NULL, /* process_exit */ - NULL -}; - - -static int ttysl_init(void) -{ - return 0; -} - -static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) -{ - return ERL_DRV_ERROR_GENERAL; -} diff --git a/erts/emulator/drivers/unix/bin_drv.c b/erts/emulator/drivers/unix/bin_drv.c index 21fb398907..4b633bb0cf 100644 --- a/erts/emulator/drivers/unix/bin_drv.c +++ b/erts/emulator/drivers/unix/bin_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/drivers/unix/multi_drv.c b/erts/emulator/drivers/unix/multi_drv.c index 7f8c2d9a0d..eddc57d4d4 100644 --- a/erts/emulator/drivers/unix/multi_drv.c +++ b/erts/emulator/drivers/unix/multi_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/drivers/unix/sig_drv.c b/erts/emulator/drivers/unix/sig_drv.c index e6f2ecc494..68ad6b9156 100644 --- a/erts/emulator/drivers/unix/sig_drv.c +++ b/erts/emulator/drivers/unix/sig_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index 25cad37e25..e425b99f16 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -199,7 +199,7 @@ static void my_debug_printf(char *fmt, ...) erts_vsnprintf(buffer,1024,fmt,args); va_end(args); erts_fprintf(debuglog,"%s\n",buffer); - //erts_printf("Debuglog = %s\n",buffer); + /*erts_printf("Debuglog = %s\n",buffer);*/ } #else @@ -261,7 +261,7 @@ static int ttysl_init(void) if (debuglog != NULL) setbuf(debuglog,NULL); } - DEBUGLOG(("Debuglog = %s(0x%ld)\n",dl,(long) debuglog)); + DEBUGLOG(("ttysl_init: Debuglog = %s(0x%ld)\n",dl,(long) debuglog)); } #endif return 0; @@ -277,36 +277,46 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) int flag; extern int using_oldshell; /* set this to let the rest of erts know */ + DEBUGLOG(("ttysl_start: driver input \"%s\", ttysl_port = %d (-1 expected)", buf, ttysl_port)); utf8buf_size = 0; - if (ttysl_port != (ErlDrvPort)-1) - return ERL_DRV_ERROR_GENERAL; + if (ttysl_port != (ErlDrvPort)-1) { + DEBUGLOG(("ttysl_start: failure with ttysl_port = %d, not initialized properly?\n", ttysl_port)); + return ERL_DRV_ERROR_GENERAL; + } - if (!isatty(0) || !isatty(1)) + DEBUGLOG(("ttysl_start: isatty(0) = %d (1 expected), isatty(1) = %d (1 expected)", isatty(0), isatty(1))); + if (!isatty(0) || !isatty(1)) { + DEBUGLOG(("ttysl_start: failure in isatty, isatty(0) = %d, isatty(1) = %d", isatty(0), isatty(1))); return ERL_DRV_ERROR_GENERAL; + } /* Set the terminal modes to default leave as is. */ canon = echo = sig = 0; /* Parse the input parameters. */ for (s = strchr(buf, ' '); s; s = t) { - s++; - /* Find end of this argument (start of next) and insert NUL. */ - if ((t = strchr(s, ' '))) { - *t = '\0'; - } - if ((flag = ((*s == '+') ? 1 : ((*s == '-') ? -1 : 0)))) { - if (s[1] == 'c') canon = flag; - if (s[1] == 'e') echo = flag; - if (s[1] == 's') sig = flag; - } - else if ((ttysl_fd = open(s, O_RDWR, 0)) < 0) - return ERL_DRV_ERROR_GENERAL; + s++; + /* Find end of this argument (start of next) and insert NUL. */ + if ((t = strchr(s, ' '))) { + *t = '\0'; + } + if ((flag = ((*s == '+') ? 1 : ((*s == '-') ? -1 : 0)))) { + if (s[1] == 'c') canon = flag; + if (s[1] == 'e') echo = flag; + if (s[1] == 's') sig = flag; + } + else if ((ttysl_fd = open(s, O_RDWR, 0)) < 0) { + DEBUGLOG(("ttysl_start: failed to open ttysl_fd, open(%s, O_RDWR, 0)) = %d\n", s, ttysl_fd)); + return ERL_DRV_ERROR_GENERAL; + } } + if (ttysl_fd < 0) ttysl_fd = 0; if (tty_init(ttysl_fd, canon, echo, sig) < 0 || - tty_set(ttysl_fd) < 0) { + tty_set(ttysl_fd) < 0) { + DEBUGLOG(("ttysl_start: failed init tty or set tty\n")); ttysl_port = (ErlDrvPort)-1; tty_reset(ttysl_fd); return ERL_DRV_ERROR_GENERAL; @@ -314,6 +324,7 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) /* Set up smart line and termcap stuff. */ if (!start_lbuf() || !start_termcap()) { + DEBUGLOG(("ttysl_start: failed to start_lbuf or start_termcap\n")); stop_lbuf(); /* Must free this */ tty_reset(ttysl_fd); return ERL_DRV_ERROR_GENERAL; @@ -335,10 +346,10 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) l = setlocale(LC_CTYPE, ""); /* Set international environment */ if (l != NULL) { utf8_mode = (strcmp(nl_langinfo(CODESET), "UTF-8") == 0); - DEBUGLOG(("setlocale: %s\n",l)); + DEBUGLOG(("ttysl_start: setlocale: %s",l)); } #endif - DEBUGLOG(("utf8_mode is %s\n",(utf8_mode) ? "on" : "off")); + DEBUGLOG(("ttysl_start: utf8_mode is %s",(utf8_mode) ? "on" : "off")); sys_signal(SIGCONT, cont); sys_signal(SIGWINCH, winch); @@ -348,6 +359,7 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) /* we need to know this when we enter the break handler */ using_oldshell = 0; + DEBUGLOG(("ttysl_start: successful start\n")); return (ErlDrvData)ttysl_port; /* Nothing important to return */ #endif /* HAVE_TERMCAP */ } @@ -418,6 +430,7 @@ static ErlDrvSSizeT ttysl_control(ErlDrvData drv_data, static void ttysl_stop(ErlDrvData ttysl_data) { + DEBUGLOG(("ttysl_stop: ttysl_port = %d\n",ttysl_port)); if (ttysl_port != (ErlDrvPort)-1) { stop_lbuf(); stop_termcap(); @@ -617,12 +630,13 @@ static int check_buf_size(byte *s, int n) int ch; int size = 10; + DEBUGLOG(("check_buf_size: n = %d",n)); while(pos < n) { /* Indata is always UTF-8 */ if ((ch = pick_utf8(s,n,&pos)) < 0) { /* XXX temporary allow invalid chars */ ch = (int) s[pos]; - DEBUGLOG(("Invalid UTF8:%d",ch)); + DEBUGLOG(("check_buf_size: Invalid UTF8:%d",ch)); ++pos; } if (utf8_mode) { /* That is, terminal is UTF8 compliant */ @@ -630,7 +644,7 @@ static int check_buf_size(byte *s, int n) #ifdef HAVE_WCWIDTH int width; #endif - DEBUGLOG(("Printable(UTF-8:%d):%d",pos,ch)); + DEBUGLOG(("check_buf_size: Printable(UTF-8:%d):%d",pos,ch)); size++; #ifdef HAVE_WCWIDTH if ((width = wcwidth(ch)) > 1) { @@ -640,21 +654,21 @@ static int check_buf_size(byte *s, int n) } else if (ch == '\t') { size += 8; } else { - DEBUGLOG(("Magic(UTF-8:%d):%d",pos,ch)); + DEBUGLOG(("check_buf_size: Magic(UTF-8:%d):%d",pos,ch)); size += 2; } } else { if (ch <= 255 && isprint(ch)) { - DEBUGLOG(("Printable:%d",ch)); + DEBUGLOG(("check_buf_size: Printable:%d",ch)); size++; } else if (ch == '\t') size += 8; else if (ch >= 128) { - DEBUGLOG(("Non printable:%d",ch)); + DEBUGLOG(("check_buf_size: Non printable:%d",ch)); size += (octal_or_hex_positions(ch) + 1); } else { - DEBUGLOG(("Magic:%d",ch)); + DEBUGLOG(("check_buf_size: Magic:%d",ch)); size += 2; } } @@ -664,10 +678,12 @@ static int check_buf_size(byte *s, int n) lbuf_size = size + lpos + BUFSIZ; if ((lbuf = driver_realloc(lbuf, lbuf_size * sizeof(Uint32))) == NULL) { + DEBUGLOG(("check_buf_size: alloc failure of %d bytes", lbuf_size * sizeof(Uint32))); driver_failure(ttysl_port, -1); return(0); } } + DEBUGLOG(("check_buf_size: success\n")); return(1); } @@ -685,6 +701,8 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun if (lpos > MAXSIZE) put_chars((byte*)"\n", 1); + DEBUGLOG(("ttysl_from_erlang: OP = %d", buf[0])); + switch (buf[0]) { case OP_PUTC_SYNC: /* Using sync means that we have to send an ok to the @@ -695,7 +713,7 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun the port_command. */ /* fall through */ case OP_PUTC: - DEBUGLOG(("OP: Putc(%lu)",(unsigned long) count-1)); + DEBUGLOG(("ttysl_from_erlang: OP: Putc(%lu)",(unsigned long) count-1)); if (check_buf_size((byte*)buf+1, count-1) == 0) return; put_chars((byte*)buf+1, count-1); @@ -738,6 +756,7 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun ERL_DRV_USE|ERL_DRV_WRITE,1); break; } else { + DEBUGLOG(("ttysl_from_erlang: driver failure in writev(%d,..) = %d (errno = %d)\n", ttysl_fd, written, errno)); driver_failure_posix(ttysl_port, errno); return; } @@ -774,6 +793,9 @@ static void ttysl_to_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) { ErlDrvSizeT sz; iov = driver_peekq(ttysl_port,&qlen); + + DEBUGLOG(("ttysl_to_tty: qlen = %d", qlen)); + if (iov) written = writev(ttysl_fd, iov, qlen > MAXIOV ? MAXIOV : qlen); else @@ -782,6 +804,7 @@ static void ttysl_to_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) { if (errno == EINTR) { continue; } else if (errno != ERRNO_BLOCK){ + DEBUGLOG(("ttysl_to_tty: driver failure in writev(%d,..) = %d (errno = %d)\n", ttysl_fd, written, errno)); driver_failure_posix(ttysl_port, errno); } break; @@ -800,11 +823,13 @@ static void ttysl_to_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) { if (sz == 0) { driver_select(ttysl_port,(ErlDrvEvent)(long)ttysl_fd, ERL_DRV_WRITE,0); - if (ttysl_terminate) + if (ttysl_terminate) { /* flush has been called, which means we should terminate when queue is empty. This will not send any exit message */ + DEBUGLOG(("ttysl_to_tty: ttysl_terminate normal\n")); driver_failure_atom(ttysl_port, "normal"); + } break; } } @@ -814,6 +839,7 @@ static void ttysl_to_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) { } static void ttysl_flush_tty(ErlDrvData ttysl_data) { + DEBUGLOG(("ttysl_flush_tty: ..")); ttysl_terminate = 1; return; } @@ -834,6 +860,8 @@ static void ttysl_from_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) p += utf8buf_size; utf8buf_size = 0; } + + DEBUGLOG(("ttysl_from_tty: remainder = %d", left)); if ((i = read((int)(SWord)fd, (char *) p, left)) >= 0) { if (p != b) { @@ -847,7 +875,7 @@ static void ttysl_from_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) utf8buf_size = i -pos; memcpy(utf8buf,b+pos,utf8buf_size); } else if (ch == -1) { - DEBUGLOG(("Giving up on UTF8 mode, invalid character")); + DEBUGLOG(("ttysl_from_tty: Giving up on UTF8 mode, invalid character")); utf8_mode = 0; goto latin_terminal; } @@ -864,6 +892,7 @@ static void ttysl_from_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) } } } else { + DEBUGLOG(("ttysl_from_tty: driver failure in read(%d,..) = %d\n", (int)(SWord)fd, i)); driver_failure(ttysl_port, -1); } } @@ -1155,7 +1184,7 @@ static int write_buf(Uint32 *s, int n) byte *octbuff; byte octtmp[256]; int octbytes; - DEBUGLOG(("Escaped: %d", ch)); + DEBUGLOG(("write_buf: Escaped: %d", ch)); octbytes = octal_or_hex_positions(ch); if (octbytes > 256) { octbuff = driver_alloc(octbytes); @@ -1164,11 +1193,11 @@ static int write_buf(Uint32 *s, int n) } octbytes = 0; octal_or_hex_format(ch, octbuff, &octbytes); - DEBUGLOG(("octbytes: %d", octbytes)); + DEBUGLOG(("write_buf: octbytes: %d", octbytes)); outc('\\'); for (i = 0; i < octbytes; ++i) { outc(lastput = octbuff[i]); - DEBUGLOG(("outc: %d", (int) lastput)); + DEBUGLOG(("write_buf: outc: %d", (int) lastput)); } n -= octbytes+1; s += octbytes+1; @@ -1180,7 +1209,7 @@ static int write_buf(Uint32 *s, int n) --n; s++; #endif } else { - DEBUGLOG(("Very unexpected character %d",(int) *s)); + DEBUGLOG(("write_buf: Very unexpected character %d",(int) *s)); ++n; --s; } @@ -1242,6 +1271,9 @@ static int start_termcap(void) size_t envsz = 1024; char *env = NULL; char *c; + int tres; + + DEBUGLOG(("start_termcap: ..")); capbuf = driver_alloc(1024); if (!capbuf) @@ -1249,9 +1281,10 @@ static int start_termcap(void) eres = erl_drv_getenv("TERM", capbuf, &envsz); if (eres == 0) env = capbuf; - else if (eres < 0) + else if (eres < 0) { + DEBUGLOG(("start_termcap: failure in erl_drv_getenv(\"TERM\", ..) = %d\n", eres)); goto false; - else /* if (eres > 1) */ { + } else /* if (eres > 1) */ { char *envbuf = driver_alloc(envsz); if (!envbuf) goto false; @@ -1261,7 +1294,8 @@ static int start_termcap(void) if (eres == 0) break; newenvbuf = driver_realloc(envbuf, envsz); - if (eres < 0 || !newenvbuf) { + if (eres < 0 || !newenvbuf) { + DEBUGLOG(("start_termcap: failure in erl_drv_getenv(\"TERM\", ..) = %d or realloc buf == %p\n", eres, newenvbuf)); env = newenvbuf ? newenvbuf : envbuf; goto false; } @@ -1269,8 +1303,10 @@ static int start_termcap(void) } env = envbuf; } - if (tgetent((char*)lbuf, env) <= 0) - goto false; + if ((tres = tgetent((char*)lbuf, env)) <= 0) { + DEBUGLOG(("start_termcap: failure in tgetent(..) = %d\n", tres)); + goto false; + } if (env != capbuf) { env = NULL; driver_free(env); @@ -1286,8 +1322,11 @@ static int start_termcap(void) if (!(left = tgetflag("bs") ? "\b" : tgetstr("bc", &c))) left = "\b"; /* Can't happen - but does on Solaris 2 */ right = tgetstr("nd", &c); - if (up && down && left && right) - return TRUE; + if (up && down && left && right) { + DEBUGLOG(("start_termcap: successful start\n")); + return TRUE; + } + DEBUGLOG(("start_termcap: failed start\n")); false: if (env && env != capbuf) driver_free(env); @@ -1364,10 +1403,13 @@ static void update_cols(void) static struct termios tty_smode, tty_rmode; -static int tty_init(int fd, int canon, int echo, int sig) -{ - if (tcgetattr(fd, &tty_rmode) < 0) - return -1; +static int tty_init(int fd, int canon, int echo, int sig) { + int tres; + DEBUGLOG(("tty_init: fd = %d, canon = %d, echo = %d, sig = %d", fd, canon, echo, sig)); + if ((tres = tcgetattr(fd, &tty_rmode)) < 0) { + DEBUGLOG(("tty_init: failure in tcgetattr(%d,..) = %d\n", fd, tres)); + return -1; + } tty_smode = tty_rmode; /* Default characteristics for all usage including termcap output. */ @@ -1420,6 +1462,7 @@ static int tty_init(int fd, int canon, int echo, int sig) #endif tty_smode.c_lflag &= ~(ISIG|IEXTEN); } + DEBUGLOG(("tty_init: successful init\n")); return 0; } @@ -1430,20 +1473,25 @@ static int tty_init(int fd, int canon, int echo, int sig) static int tty_set(int fd) { - DEBUGF(("Setting tty...\n")); + int tres; + DEBUGF(("tty_set: Setting tty...\n")); - if (tcsetattr(fd, TCSANOW, &tty_smode) < 0) + if ((tres = tcsetattr(fd, TCSANOW, &tty_smode)) < 0) { + DEBUGLOG(("tty_set: failure in tcgetattr(%d,..) = %d\n", fd, tres)); return(-1); + } return(0); } static int tty_reset(int fd) /* of terminal device */ { - DEBUGF(("Resetting tty...\n")); + int tres; + DEBUGF(("tty_reset: Resetting tty...\n")); - if (tcsetattr(fd, TCSANOW, &tty_rmode) < 0) + if ((tres = tcsetattr(fd, TCSANOW, &tty_rmode)) < 0) { + DEBUGLOG(("tty_reset: failure in tcsetattr(%d,..) = %d\n", fd, tres)); return(-1); - + } return(0); } @@ -1458,6 +1506,7 @@ static int tty_reset(int fd) /* of terminal device */ static RETSIGTYPE suspend(int sig) { if (tty_reset(ttysl_fd) < 0) { + DEBUGLOG(("signal: failure in suspend(%d), can't reset tty %d\n", sig, ttysl_fd)); fprintf(stderr,"Can't reset tty \n"); exit(1); } @@ -1469,6 +1518,7 @@ static RETSIGTYPE suspend(int sig) sys_signal(sig, suspend); /* Reset signal handler */ if (tty_set(ttysl_fd) < 0) { + DEBUGLOG(("signal: failure in suspend(%d), can't set tty %d\n", sig, ttysl_fd)); fprintf(stderr,"Can't set tty raw \n"); exit(1); } @@ -1479,6 +1529,7 @@ static RETSIGTYPE suspend(int sig) static RETSIGTYPE cont(int sig) { if (tty_set(ttysl_fd) < 0) { + DEBUGLOG(("signal: failure in cont(%d), can't set tty raw %d\n", sig, ttysl_fd)); fprintf(stderr,"Can't set tty raw\n"); exit(1); } diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index 00da48b107..bfe0807df8 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2013. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -467,7 +467,7 @@ int efile_fdatasync(Efile_error *errInfo, /* Where to return error codes. */ int fd) /* File descriptor for file to sync data. */ { -#ifdef HAVE_FDATASYNC +#if defined(HAVE_FDATASYNC) && !defined(__DARWIN__) return check_error(fdatasync(fd), errInfo); #else return efile_fsync(errInfo, fd); @@ -537,9 +537,9 @@ efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, else pInfo->type = FT_OTHER; - pInfo->accessTime = statbuf.st_atime; - pInfo->modifyTime = statbuf.st_mtime; - pInfo->cTime = statbuf.st_ctime; + pInfo->accessTime = (Sint64)statbuf.st_atime; + pInfo->modifyTime = (Sint64)statbuf.st_mtime; + pInfo->cTime = (Sint64)statbuf.st_ctime; pInfo->mode = statbuf.st_mode; pInfo->links = statbuf.st_nlink; @@ -578,8 +578,8 @@ efile_write_info(Efile_error *errInfo, Efile_info *pInfo, char *name) } } - tval.actime = pInfo->accessTime; - tval.modtime = pInfo->modifyTime; + tval.actime = (time_t)pInfo->accessTime; + tval.modtime = (time_t)pInfo->modifyTime; return check_error(utime(name, &tval), errInfo); } @@ -638,12 +638,21 @@ efile_writev(Efile_error* errInfo, /* Where to return error codes */ do { w = writev(fd, &iov[cnt], b); } while (w < 0 && errno == EINTR); + if (w < 0 && errno == EINVAL) { + goto single_write; + } } else + single_write: /* Degenerated io vector - use regular write */ #endif { do { - w = write(fd, iov[cnt].iov_base, iov[cnt].iov_len); + size_t iov_len = iov[cnt].iov_len; + size_t limit = 1024*1024*1024; /* 1GB */ + if (iov_len > limit) { + iov_len = limit; + } + w = write(fd, iov[cnt].iov_base, iov_len); } while (w < 0 && errno == EINTR); ASSERT(w <= iov[cnt].iov_len || (w == -1 && errno != EINTR)); diff --git a/erts/emulator/drivers/vxworks/vxworks_resolv.c b/erts/emulator/drivers/vxworks/vxworks_resolv.c index a7de53c692..c2cdf4a90b 100644 --- a/erts/emulator/drivers/vxworks/vxworks_resolv.c +++ b/erts/emulator/drivers/vxworks/vxworks_resolv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/drivers/win32/registry_drv.c b/erts/emulator/drivers/win32/registry_drv.c index 4e396aa8d9..a03a030df8 100644 --- a/erts/emulator/drivers/win32/registry_drv.c +++ b/erts/emulator/drivers/win32/registry_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2013. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/drivers/win32/ttsl_drv.c b/erts/emulator/drivers/win32/ttsl_drv.c index 4bd766a8a8..99e7fb25a4 100644 --- a/erts/emulator/drivers/win32/ttsl_drv.c +++ b/erts/emulator/drivers/win32/ttsl_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/drivers/win32/win_con.c b/erts/emulator/drivers/win32/win_con.c index 7fe708dc7b..0bcccfe405 100644 --- a/erts/emulator/drivers/win32/win_con.c +++ b/erts/emulator/drivers/win32/win_con.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2012. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/drivers/win32/win_con.h b/erts/emulator/drivers/win32/win_con.h index 3f4e89a195..7a642cd7ed 100644 --- a/erts/emulator/drivers/win32/win_con.h +++ b/erts/emulator/drivers/win32/win_con.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2007-2009. All Rights Reserved. + * Copyright Ericsson AB 2007-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c index d95f29f49d..2d366b5833 100644 --- a/erts/emulator/drivers/win32/win_efile.c +++ b/erts/emulator/drivers/win32/win_efile.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2014. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/TODO b/erts/emulator/hipe/TODO index dd9760ea1c..0c28616a30 100644 --- a/erts/emulator/hipe/TODO +++ b/erts/emulator/hipe/TODO @@ -1,7 +1,7 @@ %CopyrightBegin% - Copyright Ericsson AB 2004-2009. All Rights Reserved. + Copyright Ericsson AB 2004-2016. All Rights Reserved. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/elf64ppc.x b/erts/emulator/hipe/elf64ppc.x index 3cd4010cb3..46d2632970 100644 --- a/erts/emulator/hipe/elf64ppc.x +++ b/erts/emulator/hipe/elf64ppc.x @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_amd64.c b/erts/emulator/hipe/hipe_amd64.c index 1bb336637d..62739d2a78 100644 --- a/erts/emulator/hipe/hipe_amd64.c +++ b/erts/emulator/hipe/hipe_amd64.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -83,21 +83,6 @@ int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline) return 0; } -/* - * Memory allocator for executable code. - * - * This is required on AMD64 because some Linux kernels - * (including 2.6.10-rc1 and newer www.kernel.org ones) - * default to non-executable memory mappings, causing - * ordinary malloc() memory to be non-executable. - * - * Implementing this properly also allows us to ensure that - * executable code ends up in the low 2GB of the address space, - * as required by HiPE/AMD64's small code model. - */ -static unsigned int code_bytes; -static char *code_next; - #if 0 /* change to non-zero to get allocation statistics at exit() */ static unsigned int total_mapped, nr_joins, nr_splits, total_alloc, nr_allocs, nr_large, total_lost; static unsigned int atexit_done; @@ -121,101 +106,20 @@ static void atexit_alloc_code_stats(void) #define ALLOC_CODE_STATS(X) do{}while(0) #endif -/* FreeBSD 6.1 breakage */ -#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) -#define MAP_ANONYMOUS MAP_ANON -#endif - -static int morecore(unsigned int alloc_bytes) -{ - unsigned int map_bytes; - char *map_hint, *map_start; - - /* Page-align the amount to allocate. */ - map_bytes = (alloc_bytes + 4095) & ~4095; - - /* Round up small allocations. */ - if (map_bytes < 1024*1024) - map_bytes = 1024*1024; - else - ALLOC_CODE_STATS(++nr_large); - - /* Create a new memory mapping, ensuring it is executable - and in the low 2GB of the address space. Also attempt - to make it adjacent to the previous mapping. */ - map_hint = code_next + code_bytes; -#if !defined(MAP_32BIT) - /* FreeBSD doesn't have MAP_32BIT, and it doesn't respect - a plain map_hint (returns high mappings even though the - hint refers to a free area), so we have to use both map_hint - and MAP_FIXED to get addresses below the 2GB boundary. - This is even worse than the Linux/ppc64 case. - Similarly, Solaris 10 doesn't have MAP_32BIT, - and it doesn't respect a plain map_hint. */ - if (!map_hint) /* first call */ - map_hint = (char*)(512*1024*1024); /* 0.5GB */ -#endif - if ((unsigned long)map_hint & 4095) - abort(); - map_start = mmap(map_hint, map_bytes, - PROT_EXEC|PROT_READ|PROT_WRITE, - MAP_PRIVATE|MAP_ANONYMOUS -#if defined(MAP_32BIT) - |MAP_32BIT -#elif defined(__FreeBSD__) || defined(__sun__) - |MAP_FIXED -#endif - , - -1, 0); - ALLOC_CODE_STATS(fprintf(stderr, "%s: mmap(%p,%u,...) == %p\r\n", __FUNCTION__, map_hint, map_bytes, map_start)); -#if !defined(MAP_32BIT) - if (map_start != MAP_FAILED && - (((unsigned long)map_start + (map_bytes-1)) & ~0x7FFFFFFFUL)) { - fprintf(stderr, "mmap with hint %p returned code memory %p\r\n", map_hint, map_start); - abort(); - } -#endif - if (map_start == MAP_FAILED) - return -1; - - ALLOC_CODE_STATS(total_mapped += map_bytes); - - /* Merge adjacent mappings, so the trailing portion of the previous - mapping isn't lost. In practice this is quite successful. */ - if (map_start == map_hint) { - ALLOC_CODE_STATS(++nr_joins); - code_bytes += map_bytes; -#if !defined(MAP_32BIT) - if (!code_next) /* first call */ - code_next = map_start; -#endif - } else { - ALLOC_CODE_STATS(++nr_splits); - ALLOC_CODE_STATS(total_lost += code_bytes); - code_next = map_start; - code_bytes = map_bytes; - } - - ALLOC_CODE_STATS(atexit_alloc_code_stats()); - - return 0; -} - +/* + * Memory allocator for executable code. + * + * We use a dedicated allocator for executable code (from OTP 19.0) + * to make sure the memory we get is executable (PROT_EXEC) + * and to ensure that executable code ends up in the low 2GB + * of the address space, as required by HiPE/AMD64's small code model. + */ static void *alloc_code(unsigned int alloc_bytes) { - void *res; - - /* Align function entries. */ - alloc_bytes = (alloc_bytes + 3) & ~3; - - 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; - code_next += alloc_bytes; - code_bytes -= alloc_bytes; - return res; + + return erts_alloc(ERTS_ALC_T_HIPE_EXEC, alloc_bytes); } void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p) diff --git a/erts/emulator/hipe/hipe_amd64.h b/erts/emulator/hipe/hipe_amd64.h index 09b55a1243..750a26fcb9 100644 --- a/erts/emulator/hipe/hipe_amd64.h +++ b/erts/emulator/hipe/hipe_amd64.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_amd64.tab b/erts/emulator/hipe/hipe_amd64.tab index 70287034a0..e5ff31b985 100644 --- a/erts/emulator/hipe/hipe_amd64.tab +++ b/erts/emulator/hipe/hipe_amd64.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2011. All Rights Reserved. +# Copyright Ericsson AB 2004-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_amd64_asm.m4 b/erts/emulator/hipe/hipe_amd64_asm.m4 index ecb25ec5c8..2c0fbbee2d 100644 --- a/erts/emulator/hipe/hipe_amd64_asm.m4 +++ b/erts/emulator/hipe/hipe_amd64_asm.m4 @@ -2,7 +2,7 @@ changecom(`/*', `*/')dnl /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4 index 602e71c195..9cf3bf74fd 100644 --- a/erts/emulator/hipe/hipe_amd64_bifs.m4 +++ b/erts/emulator/hipe/hipe_amd64_bifs.m4 @@ -2,7 +2,7 @@ changecom(`/*', `*/')dnl /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2012. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_amd64_gc.h b/erts/emulator/hipe/hipe_amd64_gc.h index e7a156c910..6b95d54904 100644 --- a/erts/emulator/hipe/hipe_amd64_gc.h +++ b/erts/emulator/hipe/hipe_amd64_gc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_amd64_glue.S b/erts/emulator/hipe/hipe_amd64_glue.S index 6fb93bce53..b37ed3c68a 100644 --- a/erts/emulator/hipe/hipe_amd64_glue.S +++ b/erts/emulator/hipe/hipe_amd64_glue.S @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_amd64_glue.h b/erts/emulator/hipe/hipe_amd64_glue.h index e54b8b3a3f..089658f4b5 100644 --- a/erts/emulator/hipe/hipe_amd64_glue.h +++ b/erts/emulator/hipe/hipe_amd64_glue.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_amd64_primops.h b/erts/emulator/hipe/hipe_amd64_primops.h index 23d8202e46..94c39a9433 100644 --- a/erts/emulator/hipe/hipe_amd64_primops.h +++ b/erts/emulator/hipe/hipe_amd64_primops.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_arch.h b/erts/emulator/hipe/hipe_arch.h index 21dabc7cb6..6f959815bb 100644 --- a/erts/emulator/hipe/hipe_arch.h +++ b/erts/emulator/hipe/hipe_arch.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2011. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_arm.c b/erts/emulator/hipe/hipe_arm.c index 01512e9aa1..f8ef468341 100644 --- a/erts/emulator/hipe/hipe_arm.c +++ b/erts/emulator/hipe/hipe_arm.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2012. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_arm.h b/erts/emulator/hipe/hipe_arm.h index a0e07cd6ce..b5fe6317c9 100644 --- a/erts/emulator/hipe/hipe_arm.h +++ b/erts/emulator/hipe/hipe_arm.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_arm.tab b/erts/emulator/hipe/hipe_arm.tab index bcac2cd79d..152319edbd 100644 --- a/erts/emulator/hipe/hipe_arm.tab +++ b/erts/emulator/hipe/hipe_arm.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2011. All Rights Reserved. +# Copyright Ericsson AB 2005-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_arm_asm.m4 b/erts/emulator/hipe/hipe_arm_asm.m4 index 8ce8600f97..ae9ec752bb 100644 --- a/erts/emulator/hipe/hipe_arm_asm.m4 +++ b/erts/emulator/hipe/hipe_arm_asm.m4 @@ -2,7 +2,7 @@ changecom(`/*', `*/')dnl /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4 index 3efe961964..d9c9952dbf 100644 --- a/erts/emulator/hipe/hipe_arm_bifs.m4 +++ b/erts/emulator/hipe/hipe_arm_bifs.m4 @@ -2,7 +2,7 @@ changecom(`/*', `*/')dnl /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2012. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_arm_gc.h b/erts/emulator/hipe/hipe_arm_gc.h index dfffd6c630..e8eb900978 100644 --- a/erts/emulator/hipe/hipe_arm_gc.h +++ b/erts/emulator/hipe/hipe_arm_gc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_arm_glue.S b/erts/emulator/hipe/hipe_arm_glue.S index e4ce9b75ef..49ffa8b1d8 100644 --- a/erts/emulator/hipe/hipe_arm_glue.S +++ b/erts/emulator/hipe/hipe_arm_glue.S @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_arm_glue.h b/erts/emulator/hipe/hipe_arm_glue.h index 39bc27ec5f..dffc5aef03 100644 --- a/erts/emulator/hipe/hipe_arm_glue.h +++ b/erts/emulator/hipe/hipe_arm_glue.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_arm_primops.h b/erts/emulator/hipe/hipe_arm_primops.h index 0e8f84dfb9..c080b67699 100644 --- a/erts/emulator/hipe/hipe_arm_primops.h +++ b/erts/emulator/hipe/hipe_arm_primops.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index c838150db8..48cfafb8c5 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -488,7 +488,7 @@ static void *const_term_alloc(void *tmpl) alloc_size = size + (offsetof(struct const_term, mem)/sizeof(Eterm)); hipe_constants_size += alloc_size; - p = (struct const_term*)erts_alloc(ERTS_ALC_T_HIPE, alloc_size * sizeof(Eterm)); + p = (struct const_term*)erts_alloc(ERTS_ALC_T_LITERAL, alloc_size * sizeof(Eterm)); /* I have absolutely no idea if having a private 'off_heap' works or not. _Some_ off_heap object is required for @@ -497,6 +497,8 @@ static void *const_term_alloc(void *tmpl) hp = &p->mem[0]; p->val = copy_struct(obj, size, &hp, &const_term_table_off_heap); + erts_set_literal_tag(&p->val, &p->mem[0], size); + return &p->bucket; } @@ -507,6 +509,9 @@ static void init_const_term_table(void) f.cmp = (HCMP_FUN) const_term_cmp; f.alloc = (HALLOC_FUN) const_term_alloc; f.free = (HFREE_FUN) NULL; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; hash_init(ERTS_ALC_T_HIPE, &const_term_table, "const_term_table", 97, f); } @@ -574,15 +579,15 @@ static void print_mfa(Eterm mod, Eterm fun, unsigned int ari) static Uint *hipe_find_emu_address(Eterm mod, Eterm name, unsigned int arity) { Module *modp; - Uint *code_base; + BeamCodeHeader* code_hdr; int i, n; modp = erts_get_module(mod, erts_active_code_ix()); - if (modp == NULL || (code_base = modp->curr.code) == NULL) + if (modp == NULL || (code_hdr = modp->curr.code_hdr) == NULL) return NULL; - n = code_base[MI_NUM_FUNCTIONS]; + n = code_hdr->num_functions; for (i = 0; i < n; ++i) { - Uint *code_ptr = (Uint*)code_base[MI_FUNCTIONS+i]; + Uint *code_ptr = (Uint*)code_hdr->functions[i]; ASSERT(code_ptr[0] == BeamOpCode(op_i_func_info_IaaI)); if (code_ptr[3] == name && code_ptr[4] == arity) return code_ptr+5; @@ -715,6 +720,9 @@ static void init_nbif_table(void) f.cmp = (HCMP_FUN) nbif_cmp; f.alloc = (HALLOC_FUN) nbif_alloc; f.free = NULL; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; hash_init(ERTS_ALC_T_NBIF_TABLE, &nbif_table, "nbif_table", 500, f); @@ -808,6 +816,9 @@ static void init_primop_table(void) f.cmp = (HCMP_FUN) primop_cmp; f.alloc = (HALLOC_FUN) primop_alloc; f.free = NULL; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; hash_init(ERTS_ALC_T_HIPE, &primop_table, "primop_table", 50, f); @@ -1826,6 +1837,9 @@ static void init_modinfo_table(void) f.cmp = (HCMP_FUN) modinfo_cmp; f.alloc = (HALLOC_FUN) modinfo_alloc; f.free = (HFREE_FUN) NULL; + f.meta_alloc = (HMALLOC_FUN) erts_alloc; + f.meta_free = (HMFREE_FUN) erts_free; + f.meta_print = (HMPRINT_FUN) erts_print; hash_init(ERTS_ALC_T_HIPE, &modinfo_table, "modinfo_table", 11, f); } diff --git a/erts/emulator/hipe/hipe_bif0.h b/erts/emulator/hipe/hipe_bif0.h index 5527c6c3ed..c9a8216368 100644 --- a/erts/emulator/hipe/hipe_bif0.h +++ b/erts/emulator/hipe/hipe_bif0.h @@ -2,7 +2,7 @@ * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab index 5ce254314a..99237aae05 100644 --- a/erts/emulator/hipe/hipe_bif0.tab +++ b/erts/emulator/hipe/hipe_bif0.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2011. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_bif1.c b/erts/emulator/hipe/hipe_bif1.c index a2682992a4..08adbd474e 100644 --- a/erts/emulator/hipe/hipe_bif1.c +++ b/erts/emulator/hipe/hipe_bif1.c @@ -2,7 +2,7 @@ * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2012. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_bif1.h b/erts/emulator/hipe/hipe_bif1.h index 80cdeb4a82..e12bb1a1f3 100644 --- a/erts/emulator/hipe/hipe_bif1.h +++ b/erts/emulator/hipe/hipe_bif1.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_bif1.tab b/erts/emulator/hipe/hipe_bif1.tab index 6c4e05afdb..c5b452f199 100644 --- a/erts/emulator/hipe/hipe_bif1.tab +++ b/erts/emulator/hipe/hipe_bif1.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2009. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_bif2.c b/erts/emulator/hipe/hipe_bif2.c index 2328e69886..dfd34e31d4 100644 --- a/erts/emulator/hipe/hipe_bif2.c +++ b/erts/emulator/hipe/hipe_bif2.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2012. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_bif2.tab b/erts/emulator/hipe/hipe_bif2.tab index a29e1fbdbb..bbcb577be0 100644 --- a/erts/emulator/hipe/hipe_bif2.tab +++ b/erts/emulator/hipe/hipe_bif2.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2012. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_bif64.c b/erts/emulator/hipe/hipe_bif64.c index b97cf2b7ee..a1a3c81bfe 100644 --- a/erts/emulator/hipe/hipe_bif64.c +++ b/erts/emulator/hipe/hipe_bif64.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_bif64.h b/erts/emulator/hipe/hipe_bif64.h index 856b4003dc..a97ce311d3 100644 --- a/erts/emulator/hipe/hipe_bif64.h +++ b/erts/emulator/hipe/hipe_bif64.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_bif64.tab b/erts/emulator/hipe/hipe_bif64.tab index 3062ab5848..eefca379a0 100644 --- a/erts/emulator/hipe/hipe_bif64.tab +++ b/erts/emulator/hipe/hipe_bif64.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2011. All Rights Reserved. +# Copyright Ericsson AB 2004-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index 7240280345..29095a5389 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2014. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c index a48578c468..ace489452f 100644 --- a/erts/emulator/hipe/hipe_debug.c +++ b/erts/emulator/hipe/hipe_debug.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -195,7 +195,7 @@ void hipe_print_pcb(Process *p) U("rcount ", rcount); U("id ", common.id); U("reds ", reds); - U("tracer_pr..", common.tracer_proc); + U("tracer ", common.tracer); U("trace_fla..", common.trace_flags); U("group_lea..", group_leader); U("flags ", flags); diff --git a/erts/emulator/hipe/hipe_debug.h b/erts/emulator/hipe/hipe_debug.h index bf10d5a2a8..c510eac949 100644 --- a/erts/emulator/hipe/hipe_debug.h +++ b/erts/emulator/hipe/hipe_debug.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_gbif_list.h b/erts/emulator/hipe/hipe_gbif_list.h index dc93741a1d..424b001298 100644 --- a/erts/emulator/hipe/hipe_gbif_list.h +++ b/erts/emulator/hipe/hipe_gbif_list.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_gc.c b/erts/emulator/hipe/hipe_gc.c index 2c747771ac..d0619a0609 100644 --- a/erts/emulator/hipe/hipe_gc.c +++ b/erts/emulator/hipe/hipe_gc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2012. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -46,10 +46,6 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop) /* arch-specific nstack walk state */ struct nstack_walk_state walk_state; - /* fullsweep-specific state */ - char *src, *oh; - Uint src_size, oh_size; - if (!p->hipe.nstack) { ASSERT(!p->hipe.nsp && !p->hipe.nstend); return n_htop; @@ -66,11 +62,6 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop) sdesc = nstack_walk_init_sdesc(p, &walk_state); - src = (char*)HEAP_START(p); - src_size = (char*)HEAP_TOP(p) - src; - oh = (char*)OLD_HEAP(p); - oh_size = (char*)OLD_HTOP(p) - oh; - for (;;) { if (nstack_walk_nsp_reached_end(nsp, nsp_end)) { if (nsp == nsp_end) { @@ -97,8 +88,7 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop) if (IS_MOVED_BOXED(val)) { ASSERT(is_boxed(val)); *nsp_i = val; - } else if (in_area(ptr, src, src_size) || - in_area(ptr, oh, oh_size)) { + } else if (!erts_is_literal(gval, ptr)) { MOVE_BOXED(ptr, val, n_htop, nsp_i); } } else if (is_list(gval)) { @@ -106,8 +96,7 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop) Eterm val = *ptr; if (IS_MOVED_CONS(val)) { *nsp_i = ptr[1]; - } else if (in_area(ptr, src, src_size) || - in_area(ptr, oh, oh_size)) { + } else if (!erts_is_literal(gval, ptr)) { ASSERT(within(ptr, p)); MOVE_CONS(ptr, val, n_htop, nsp_i); } @@ -139,11 +128,13 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop) unsigned int mask; /* arch-specific nstack walk state */ struct nstack_walk_state walk_state; + char *oh; + Uint oh_size; /* gensweep-specific state */ Eterm *old_htop, *n_htop; - char *heap; - Uint heap_size, mature_size; + char *mature; + Uint mature_size; if (!p->hipe.nstack) { ASSERT(!p->hipe.nsp && !p->hipe.nstend); @@ -168,9 +159,10 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop) old_htop = *ptr_old_htop; n_htop = *ptr_n_htop; - heap = (char*)HEAP_START(p); - heap_size = (char*)HEAP_TOP(p) - heap; - mature_size = (char*)HIGH_WATER(p) - heap; + mature = (char *) (p->abandoned_heap ? p->abandoned_heap : p->heap); + mature_size = (char*)HIGH_WATER(p) - mature; + oh = (char*)OLD_HEAP(p); + oh_size = (char*)OLD_HTOP(p) - oh; for (;;) { if (nstack_walk_nsp_reached_end(nsp, nsp_end)) { @@ -209,9 +201,9 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop) if (IS_MOVED_BOXED(val)) { ASSERT(is_boxed(val)); *nsp_i = val; - } else if (in_area(ptr, heap, mature_size)) { + } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_BOXED(ptr, val, old_htop, nsp_i); - } else if (in_area(ptr, heap, heap_size)) { + } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) { ASSERT(within(ptr, p)); MOVE_BOXED(ptr, val, n_htop, nsp_i); } @@ -220,9 +212,9 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop) Eterm val = *ptr; if (IS_MOVED_CONS(val)) { *nsp_i = ptr[1]; - } else if (in_area(ptr, heap, mature_size)) { + } else if (ErtsInArea(ptr, mature, mature_size)) { MOVE_CONS(ptr, val, old_htop, nsp_i); - } else if (in_area(ptr, heap, heap_size)) { + } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) { ASSERT(within(ptr, p)); MOVE_CONS(ptr, val, n_htop, nsp_i); } diff --git a/erts/emulator/hipe/hipe_gc.h b/erts/emulator/hipe/hipe_gc.h index e373324cdd..5b5eb29175 100644 --- a/erts/emulator/hipe/hipe_gc.h +++ b/erts/emulator/hipe/hipe_gc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c index dfa5313739..0d3493ec6c 100644 --- a/erts/emulator/hipe/hipe_mkliterals.c +++ b/erts/emulator/hipe/hipe_mkliterals.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2012. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index 9243e029f6..43144e75ec 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -2,7 +2,7 @@ * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2014. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -196,7 +196,7 @@ hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) ASSERT(!(p->flags & F_DISABLE_GC)); if ((p->stop - 2) < p->htop) { DPRINTF("calling gc to increase BEAM stack size"); - p->fcalls -= erts_garbage_collect(p, 2, reg, arity); + erts_garbage_collect(p, 2, reg, arity); ASSERT(!((p->stop - 2) < p->htop)); } p->stop -= 2; diff --git a/erts/emulator/hipe/hipe_mode_switch.h b/erts/emulator/hipe/hipe_mode_switch.h index bc863a4f36..c40077d558 100644 --- a/erts/emulator/hipe/hipe_mode_switch.h +++ b/erts/emulator/hipe/hipe_mode_switch.h @@ -2,7 +2,7 @@ * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -95,7 +95,7 @@ ERTS_GLB_INLINE void hipe_reserve_beam_trap_frame(Process *p, Eterm reg[], unsig /* 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); + erts_garbage_collect(p, 2, reg, arity); ASSERT(!((p->stop - 2) < p->htop)); } p->stop -= 2; diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 994f963ece..00b572029a 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -80,7 +80,7 @@ Eterm hipe_show_nstack_1(BIF_ALIST_1) void hipe_gc(Process *p, Eterm need) { hipe_set_narity(p, 1); - p->fcalls -= erts_garbage_collect(p, unsigned_val(need), NULL, 0); + erts_garbage_collect(p, unsigned_val(need), NULL, 0); hipe_set_narity(p, 0); } @@ -157,13 +157,22 @@ BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1) */ void hipe_select_msg(Process *p) { - ErlMessage *msgp; + ErtsMessage *msgp; msgp = PEEK_MESSAGE(p); UNLINK_MESSAGE(p, msgp); /* decrements global 'erts_proc_tot_mem' variable */ JOIN_MESSAGE(p); CANCEL_TIMER(p); /* calls erts_cancel_proc_timer() */ - free_message(msgp); + erts_save_message_in_proc(p, msgp); + p->flags &= ~F_DELAY_GC; + if (ERTS_IS_GC_DESIRED(p)) { + /* + * We want to GC soon but we leave a few + * reductions giving the message some time + * to turn into garbage. + */ + ERTS_VBUMP_LEAVE_REDS(p, 5); + } } void hipe_fclearerror_error(Process *p) @@ -520,8 +529,9 @@ BIF_RETTYPE hipe_is_divisible(BIF_ALIST_2) */ Eterm hipe_check_get_msg(Process *c_p) { - Eterm ret; - ErlMessage *msgp; + ErtsMessage *msgp; + + c_p->flags |= F_DELAY_GC; next_message: @@ -543,25 +553,29 @@ Eterm hipe_check_get_msg(Process *c_p) /* XXX: BEAM doesn't need this */ c_p->hipe_smp.have_receive_locks = 1; #endif + c_p->flags &= ~F_DELAY_GC; return THE_NON_VALUE; #ifdef ERTS_SMP } #endif } - ErtsMoveMsgAttachmentIntoProc(msgp, c_p, c_p->stop, HEAP_TOP(c_p), - c_p->fcalls, (void) 0, (void) 0); - ret = ERL_MESSAGE_TERM(msgp); - if (is_non_value(ret)) { + + if (is_non_value(ERL_MESSAGE_TERM(msgp)) + && !erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) { /* * A corrupt distribution message that we weren't able to decode; * remove it... */ ASSERT(!msgp->data.attached); UNLINK_MESSAGE(c_p, msgp); - free_message(msgp); + msgp->next = NULL; + erts_cleanup_messages(msgp); goto next_message; } - return ret; + + ASSERT(is_value(ERL_MESSAGE_TERM(msgp))); + + return ERL_MESSAGE_TERM(msgp); } /* diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h index 55a0d3bb1b..a02d26087b 100644 --- a/erts/emulator/hipe/hipe_native_bif.h +++ b/erts/emulator/hipe/hipe_native_bif.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_ops.tab b/erts/emulator/hipe/hipe_ops.tab index d021c72ac9..96e4c0da91 100644 --- a/erts/emulator/hipe/hipe_ops.tab +++ b/erts/emulator/hipe/hipe_ops.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2011. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_ppc.c b/erts/emulator/hipe/hipe_ppc.c index 3f86de626d..9b2048c457 100644 --- a/erts/emulator/hipe/hipe_ppc.c +++ b/erts/emulator/hipe/hipe_ppc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_ppc.h b/erts/emulator/hipe/hipe_ppc.h index 777c9384d5..e86c122fb1 100644 --- a/erts/emulator/hipe/hipe_ppc.h +++ b/erts/emulator/hipe/hipe_ppc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_ppc.tab b/erts/emulator/hipe/hipe_ppc.tab index 5bf2320cbe..274612d9ce 100644 --- a/erts/emulator/hipe/hipe_ppc.tab +++ b/erts/emulator/hipe/hipe_ppc.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2011. All Rights Reserved. +# Copyright Ericsson AB 2004-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_ppc64.tab b/erts/emulator/hipe/hipe_ppc64.tab index 301a9752f7..a291185b57 100644 --- a/erts/emulator/hipe/hipe_ppc64.tab +++ b/erts/emulator/hipe/hipe_ppc64.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2011. All Rights Reserved. +# Copyright Ericsson AB 2005-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_ppc_asm.m4 b/erts/emulator/hipe/hipe_ppc_asm.m4 index ea74923d1f..be25d65725 100644 --- a/erts/emulator/hipe/hipe_ppc_asm.m4 +++ b/erts/emulator/hipe/hipe_ppc_asm.m4 @@ -2,7 +2,7 @@ changecom(`/*', `*/')dnl /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_ppc_bifs.m4 b/erts/emulator/hipe/hipe_ppc_bifs.m4 index 28518827ec..57b4208bee 100644 --- a/erts/emulator/hipe/hipe_ppc_bifs.m4 +++ b/erts/emulator/hipe/hipe_ppc_bifs.m4 @@ -2,7 +2,7 @@ changecom(`/*', `*/')dnl /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2012. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_ppc_gc.h b/erts/emulator/hipe/hipe_ppc_gc.h index 0854d9e950..a6ec1338ff 100644 --- a/erts/emulator/hipe/hipe_ppc_gc.h +++ b/erts/emulator/hipe/hipe_ppc_gc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_ppc_glue.S b/erts/emulator/hipe/hipe_ppc_glue.S index 6e2022603c..44351dc06c 100644 --- a/erts/emulator/hipe/hipe_ppc_glue.S +++ b/erts/emulator/hipe/hipe_ppc_glue.S @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_ppc_glue.h b/erts/emulator/hipe/hipe_ppc_glue.h index 93ca39fcb3..2bfa10298c 100644 --- a/erts/emulator/hipe/hipe_ppc_glue.h +++ b/erts/emulator/hipe/hipe_ppc_glue.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_ppc_primops.h b/erts/emulator/hipe/hipe_ppc_primops.h index ce3dda9eb3..540605de9f 100644 --- a/erts/emulator/hipe/hipe_ppc_primops.h +++ b/erts/emulator/hipe/hipe_ppc_primops.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_primops.h b/erts/emulator/hipe/hipe_primops.h index 0bec677574..4fcbc9df38 100644 --- a/erts/emulator/hipe/hipe_primops.h +++ b/erts/emulator/hipe/hipe_primops.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_process.h b/erts/emulator/hipe/hipe_process.h index 60d09ea1c9..21c4239753 100644 --- a/erts/emulator/hipe/hipe_process.h +++ b/erts/emulator/hipe/hipe_process.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_risc_gc.h b/erts/emulator/hipe/hipe_risc_gc.h index 770ec93459..315f8e7f9f 100644 --- a/erts/emulator/hipe/hipe_risc_gc.h +++ b/erts/emulator/hipe/hipe_risc_gc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2011. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_risc_glue.h b/erts/emulator/hipe/hipe_risc_glue.h index 51db7eac01..0284265307 100644 --- a/erts/emulator/hipe/hipe_risc_glue.h +++ b/erts/emulator/hipe/hipe_risc_glue.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2011. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_risc_stack.c b/erts/emulator/hipe/hipe_risc_stack.c index fd04421381..dc98c96b8f 100644 --- a/erts/emulator/hipe/hipe_risc_stack.c +++ b/erts/emulator/hipe/hipe_risc_stack.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2011. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_signal.h b/erts/emulator/hipe/hipe_signal.h index b2f461797d..5d8621135b 100644 --- a/erts/emulator/hipe/hipe_signal.h +++ b/erts/emulator/hipe/hipe_signal.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2011. All Rights Reserved. + * Copyright Ericsson AB 2002-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_sparc.c b/erts/emulator/hipe/hipe_sparc.c index bd95bc5d98..23020f34ee 100644 --- a/erts/emulator/hipe/hipe_sparc.c +++ b/erts/emulator/hipe/hipe_sparc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2011. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_sparc.h b/erts/emulator/hipe/hipe_sparc.h index 0b74b2db26..25d513e988 100644 --- a/erts/emulator/hipe/hipe_sparc.h +++ b/erts/emulator/hipe/hipe_sparc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2011. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_sparc.tab b/erts/emulator/hipe/hipe_sparc.tab index 2f528c0607..bc90d38168 100644 --- a/erts/emulator/hipe/hipe_sparc.tab +++ b/erts/emulator/hipe/hipe_sparc.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2011. All Rights Reserved. +# Copyright Ericsson AB 2004-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_sparc_asm.m4 b/erts/emulator/hipe/hipe_sparc_asm.m4 index 227a1658b4..8a9a516eab 100644 --- a/erts/emulator/hipe/hipe_sparc_asm.m4 +++ b/erts/emulator/hipe/hipe_sparc_asm.m4 @@ -2,7 +2,7 @@ changecom(`/*', `*/')dnl /* * %CopyrightBegin% * - * Copyright Ericsson AB 2007-2011. All Rights Reserved. + * Copyright Ericsson AB 2007-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_sparc_bifs.m4 b/erts/emulator/hipe/hipe_sparc_bifs.m4 index a7bbe5b2cc..2e886ec1d1 100644 --- a/erts/emulator/hipe/hipe_sparc_bifs.m4 +++ b/erts/emulator/hipe/hipe_sparc_bifs.m4 @@ -2,7 +2,7 @@ changecom(`/*', `*/')dnl /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_sparc_gc.h b/erts/emulator/hipe/hipe_sparc_gc.h index 99e55df1ce..eea0268ed5 100644 --- a/erts/emulator/hipe/hipe_sparc_gc.h +++ b/erts/emulator/hipe/hipe_sparc_gc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_sparc_glue.S b/erts/emulator/hipe/hipe_sparc_glue.S index 7e47ffb52f..077db9b8ad 100644 --- a/erts/emulator/hipe/hipe_sparc_glue.S +++ b/erts/emulator/hipe/hipe_sparc_glue.S @@ -2,7 +2,7 @@ * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_sparc_glue.h b/erts/emulator/hipe/hipe_sparc_glue.h index 95ce1e5b4a..3a1795f408 100644 --- a/erts/emulator/hipe/hipe_sparc_glue.h +++ b/erts/emulator/hipe/hipe_sparc_glue.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_sparc_primops.h b/erts/emulator/hipe/hipe_sparc_primops.h index e42bcbad62..2ecfa1293e 100644 --- a/erts/emulator/hipe/hipe_sparc_primops.h +++ b/erts/emulator/hipe/hipe_sparc_primops.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_stack.c b/erts/emulator/hipe/hipe_stack.c index e088b45c57..e2e6eb74b1 100644 --- a/erts/emulator/hipe/hipe_stack.c +++ b/erts/emulator/hipe/hipe_stack.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2011. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_stack.h b/erts/emulator/hipe/hipe_stack.h index f575b97ce3..4ea7d5c031 100644 --- a/erts/emulator/hipe/hipe_stack.h +++ b/erts/emulator/hipe/hipe_stack.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2012. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_x86.c b/erts/emulator/hipe/hipe_x86.c index 19b70afced..3d25646231 100644 --- a/erts/emulator/hipe/hipe_x86.c +++ b/erts/emulator/hipe/hipe_x86.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2013. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_x86.h b/erts/emulator/hipe/hipe_x86.h index 30dc5666ae..8967793171 100644 --- a/erts/emulator/hipe/hipe_x86.h +++ b/erts/emulator/hipe/hipe_x86.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2011. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_x86.tab b/erts/emulator/hipe/hipe_x86.tab index 55fb03cde8..b922f05165 100644 --- a/erts/emulator/hipe/hipe_x86.tab +++ b/erts/emulator/hipe/hipe_x86.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2011. All Rights Reserved. +# Copyright Ericsson AB 2004-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_x86_abi.txt b/erts/emulator/hipe/hipe_x86_abi.txt index b74fcef127..31a4a0e121 100644 --- a/erts/emulator/hipe/hipe_x86_abi.txt +++ b/erts/emulator/hipe/hipe_x86_abi.txt @@ -1,7 +1,7 @@ %CopyrightBegin% - Copyright Ericsson AB 2001-2011. All Rights Reserved. + Copyright Ericsson AB 2001-2016. All Rights Reserved. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_x86_asm.m4 b/erts/emulator/hipe/hipe_x86_asm.m4 index 3457574622..91c60382eb 100644 --- a/erts/emulator/hipe/hipe_x86_asm.m4 +++ b/erts/emulator/hipe/hipe_x86_asm.m4 @@ -2,7 +2,7 @@ changecom(`/*', `*/')dnl /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2011. All Rights Reserved. + * Copyright Ericsson AB 2002-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_x86_bifs.m4 b/erts/emulator/hipe/hipe_x86_bifs.m4 index 0c0a8da6eb..b8ac5046d5 100644 --- a/erts/emulator/hipe/hipe_x86_bifs.m4 +++ b/erts/emulator/hipe/hipe_x86_bifs.m4 @@ -2,7 +2,7 @@ changecom(`/*', `*/')dnl /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2012. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_x86_gc.h b/erts/emulator/hipe/hipe_x86_gc.h index a8770ef4f9..c22b28c2d5 100644 --- a/erts/emulator/hipe/hipe_x86_gc.h +++ b/erts/emulator/hipe/hipe_x86_gc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2013. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_x86_glue.S b/erts/emulator/hipe/hipe_x86_glue.S index cf382c480d..8d6e377730 100644 --- a/erts/emulator/hipe/hipe_x86_glue.S +++ b/erts/emulator/hipe/hipe_x86_glue.S @@ -2,7 +2,7 @@ * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_x86_glue.h b/erts/emulator/hipe/hipe_x86_glue.h index 6c123e8938..818d7444e2 100644 --- a/erts/emulator/hipe/hipe_x86_glue.h +++ b/erts/emulator/hipe/hipe_x86_glue.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_x86_primops.h b/erts/emulator/hipe/hipe_x86_primops.h index 3e057059bc..68a284203e 100644 --- a/erts/emulator/hipe/hipe_x86_primops.h +++ b/erts/emulator/hipe/hipe_x86_primops.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c index b7dae88417..50d08b96d3 100644 --- a/erts/emulator/hipe/hipe_x86_signal.c +++ b/erts/emulator/hipe/hipe_x86_signal.c @@ -2,7 +2,7 @@ * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2014. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -38,9 +38,6 @@ * * Our solution is to override the C library's signal handler setup * procedure with our own which enforces the SA_ONSTACK flag. - * - * XXX: This code only supports Linux with glibc-2.1 or above, - * and Solaris 8. */ #ifdef HAVE_CONFIG_H #include "config.h" @@ -55,27 +52,6 @@ #include "hipe_signal.h" #if __GLIBC__ == 2 && (__GLIBC_MINOR__ >= 3) -/* See comment below for glibc 2.2. */ -#ifndef __USE_GNU -#define __USE_GNU /* to un-hide RTLD_NEXT */ -#endif -#include <dlfcn.h> -static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*); -#define init_done() (__next_sigaction != 0) -extern int __sigaction(int, const struct sigaction*, struct sigaction*); -#define __SIGACTION __sigaction -static void do_init(void) -{ - __next_sigaction = dlsym(RTLD_NEXT, "__sigaction"); - if (__next_sigaction != 0) - return; - perror("dlsym"); - abort(); -} -#define INIT() do { if (!init_done()) do_init(); } while (0) -#endif /* glibc 2.3 */ - -#if __GLIBC__ == 2 && (__GLIBC_MINOR__ == 2 /*|| __GLIBC_MINOR__ == 3*/) /* * __libc_sigaction() is the core routine. * Without libpthread, sigaction() and __sigaction() are both aliases @@ -100,65 +76,14 @@ static void do_init(void) * old BSD or SysV interfaces. * glibc's internal calls to __sigaction() appear to be mostly safe. * hipe_signal_init() fixes some unsafe ones, e.g. the SIGPROF handler. - * - * Tested with glibc-2.1.92 on RedHat 7.0, glibc-2.2.2 on RedHat 7.1, - * glibc-2.2.4 on RedHat 7.2, and glibc-2.2.5 on RedHat 7.3. */ -#if 0 -/* works with 2.2.5 and 2.2.4, but not 2.2.2 or 2.1.92 */ +#ifndef __USE_GNU #define __USE_GNU /* to un-hide RTLD_NEXT */ -#include <dlfcn.h> -static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*); -#define init_done() (__next_sigaction != 0) -#define __SIGACTION __sigaction -static void do_init(void) -{ - __next_sigaction = dlsym(RTLD_NEXT, "__sigaction"); - if (__next_sigaction != 0) - return; - perror("dlsym"); - abort(); -} -#define INIT() do { if (!init_done()) do_init(); } while (0) -#else -/* semi-works with all 2.2 versions so far */ -extern int __sigaction(int, const struct sigaction*, struct sigaction*); -#define __next_sigaction __sigaction /* pthreads-aware version */ -#undef __SIGACTION /* we can't override __sigaction() */ -#define INIT() do{}while(0) #endif -#endif /* glibc 2.2 */ - -#if __GLIBC__ == 2 && __GLIBC_MINOR__ == 1 -/* - * __sigaction() is the core routine. - * Without libpthread, sigaction() is an alias for __sigaction(). - * libpthread redefines sigaction() as a non-trivial wrapper around - * __sigaction(). - * glibc has internal calls to both sigaction() and __sigaction(). - * - * Overriding __sigaction() would be ideal, but doing so breaks - * libpthread (threads hang). Instead we override sigaction() and - * use dlsym RTLD_NEXT to find glibc's version of sigaction(). - * glibc's internal calls to __sigaction() appear to be mostly safe. - * hipe_signal_init() fixes some unsafe ones, e.g. the SIGPROF handler. - * - * Tested with glibc-2.1.3 on RedHat 6.2. - */ -#include <dlfcn.h> -static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*); -#define init_done() (__next_sigaction != 0) -#undef __SIGACTION -static void do_init(void) -{ - __next_sigaction = dlsym(RTLD_NEXT, "sigaction"); - if (__next_sigaction != 0) - return; - perror("dlsym"); - abort(); -} -#define INIT() do { if (!init_done()) do_init(); } while (0) -#endif /* glibc 2.1 */ +#define NEXT_SIGACTION "__sigaction" +#define LIBC_SIGACTION __sigaction +#define OVERRIDE_SIGACTION +#endif /* glibc >= 2.3 */ /* Is there no standard identifier for Darwin/MacOSX ? */ #if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) @@ -181,21 +106,10 @@ static void do_init(void) * The other _sigaction, _sigaction_no_bind I don't understand the purpose * of and don't modify. */ -#include <dlfcn.h> -static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*); -#define init_done() (__next_sigaction != 0) -extern int _sigaction(int, const struct sigaction*, struct sigaction*); -#define __SIGACTION _sigaction -static void do_init(void) -{ - __next_sigaction = dlsym(RTLD_NEXT, "sigaction"); - if (__next_sigaction != 0) - return; - perror("dlsym_darwin"); - abort(); -} +#define NEXT_SIGACTION "sigaction" +#define LIBC_SIGACTION _sigaction +#undef OVERRIDE_SIGACTION #define _NSIG NSIG -#define INIT() do { if (!init_done()) do_init(); } while (0) #endif /* __DARWIN__ */ #if defined(__sun__) @@ -218,20 +132,10 @@ static void do_init(void) * our init routine has had a chance to find _sigaction()'s address. * This forces us to initialise at the first call. */ -#include <dlfcn.h> -static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*); -#define init_done() (__next_sigaction != 0) -#define __SIGACTION _sigaction -static void do_init(void) -{ - __next_sigaction = dlsym(RTLD_NEXT, "_sigaction"); - if (__next_sigaction != 0) - return; - perror("dlsym"); - abort(); -} +#define NEXT_SIGACTION "_sigaction" +#define LIBC_SIGACTION _sigaction +#define OVERRIDE_SIGACTION #define _NSIG NSIG -#define INIT() do { if (!init_done()) do_init(); } while (0) #endif /* __sun__ */ #if defined(__FreeBSD__) @@ -239,23 +143,22 @@ static void do_init(void) * This is a copy of Darwin code for FreeBSD. * CAVEAT: detailed semantics are not verified yet. */ -#include <dlfcn.h> -static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*); -#define init_done() (__next_sigaction != 0) -extern int _sigaction(int, const struct sigaction*, struct sigaction*); -#define __SIGACTION _sigaction -static void do_init(void) -{ - __next_sigaction = dlsym(RTLD_NEXT, "sigaction"); - if (__next_sigaction != 0) - return; - perror("dlsym_freebsd"); - abort(); -} +#define NEXT_SIGACTION "sigaction" +#define LIBC_SIGACTION _sigaction +#undef OVERRIDE_SIGACTION #define _NSIG NSIG -#define INIT() do { if (!init_done()) do_init(); } while (0) #endif /* __FreeBSD__ */ +#if defined(__NetBSD__) +/* + * Note: This is only stub code to allow the build to succeed. + * Whether this actually provides the needed overrides for safe + * signal delivery or not is unknown. + */ +#undef NEXT_SIGACTION +#undef OVERRIDE_SIGACTION +#endif /* __NetBSD__ */ + #if !(defined(__GLIBC__) || defined(__DARWIN__) || defined(__NetBSD__) || defined(__FreeBSD__) || defined(__sun__)) /* * Unknown libc -- assume musl. Note: musl deliberately does not provide a musl-specific @@ -265,30 +168,40 @@ static void do_init(void) * There are libc-internal calls to __libc_sigaction which install handlers, so we must * override __libc_sigaction rather than __sigaction. */ +#define NEXT_SIGACTION "__libc_sigaction" +#define LIBC_SIGACTION __libc_sigaction +#define OVERRIDE_SIGACTION +#ifndef _NSIG +#define _NSIG NSIG +#endif +#endif /* !(__GLIBC__ || __DARWIN__ || __NetBSD__ || __FreeBSD__ || __sun__) */ + +#if defined(NEXT_SIGACTION) +/* + * Initialize a function pointer to the libc core sigaction routine, + * to be used by our wrappers. + */ #include <dlfcn.h> -static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*); -#define init_done() (__next_sigaction != 0) -#define __SIGACTION __libc_sigaction +static int (*next_sigaction)(int, const struct sigaction*, struct sigaction*); static void do_init(void) { - __next_sigaction = dlsym(RTLD_NEXT, "__libc_sigaction"); - if (__next_sigaction != 0) + next_sigaction = dlsym(RTLD_NEXT, NEXT_SIGACTION); + if (next_sigaction != 0) return; perror("dlsym"); abort(); } -#ifndef _NSIG -#define _NSIG NSIG -#endif -#define INIT() do { if (!init_done()) do_init(); } while (0) -#endif /* !(__GLIBC__ || __DARWIN__ || __NetBSD__ || __FreeBSD__ || __sun__) */ +#define INIT() do { if (!next_sigaction) do_init(); } while (0) +#else /* !defined(NEXT_SIGACTION) */ +#define INIT() do { } while (0) +#endif /* !defined(NEXT_SIGACTION) */ -#if !defined(__NetBSD__) +#if defined(NEXT_SIGACTION) /* * This is our wrapper for sigaction(). sigaction() can be called before * hipe_signal_init() has been executed, especially when threads support * has been linked with the executable. Therefore, we must initialise - * __next_sigaction() dynamically, the first time it's needed. + * next_sigaction() dynamically, the first time it's needed. */ static int my_sigaction(int signum, const struct sigaction *act, struct sigaction *oldact) { @@ -304,24 +217,26 @@ static int my_sigaction(int signum, const struct sigaction *act, struct sigactio newact.sa_flags |= SA_ONSTACK; act = &newact; } - return __next_sigaction(signum, act, oldact); + return next_sigaction(signum, act, oldact); } #endif + +#if defined(LIBC_SIGACTION) /* * This overrides the C library's core sigaction() procedure, catching * all its internal calls. */ -#ifdef __SIGACTION -int __SIGACTION(int signum, const struct sigaction *act, struct sigaction *oldact) +extern int LIBC_SIGACTION(int, const struct sigaction*, struct sigaction*); +int LIBC_SIGACTION(int signum, const struct sigaction *act, struct sigaction *oldact) { return my_sigaction(signum, act, oldact); } #endif +#if defined(OVERRIDE_SIGACTION) /* * This catches the application's own sigaction() calls. */ -#if !defined(__DARWIN__) && !defined(__NetBSD__) && !defined(__FreeBSD__) int sigaction(int signum, const struct sigaction *act, struct sigaction *oldact) { return my_sigaction(signum, act, oldact); @@ -336,15 +251,11 @@ static void hipe_sigaltstack(void *ss_sp) stack_t ss; ss.ss_sp = ss_sp; - ss.ss_flags = SS_ONSTACK; + ss.ss_flags = 0; ss.ss_size = SIGSTKSZ; if (sigaltstack(&ss, NULL) < 0) { - /* might be a broken pre-2.4 Linux kernel, try harder */ - ss.ss_flags = 0; - if (sigaltstack(&ss, NULL) < 0) { - perror("sigaltstack"); - abort(); - } + perror("sigaltstack"); + abort(); } } @@ -381,9 +292,7 @@ void hipe_signal_init(void) struct sigaction sa; int i; -#ifndef __NetBSD__ INIT(); -#endif hipe_sigaltstack_init(); diff --git a/erts/emulator/hipe/hipe_x86_stack.c b/erts/emulator/hipe/hipe_x86_stack.c index 6629713a05..f1559b1451 100644 --- a/erts/emulator/hipe/hipe_x86_stack.c +++ b/erts/emulator/hipe/hipe_x86_stack.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/internal_doc/dec.erl b/erts/emulator/internal_doc/dec.erl index e64e37a7d9..8ce83fa402 100644 --- a/erts/emulator/internal_doc/dec.erl +++ b/erts/emulator/internal_doc/dec.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/internal_doc/erl_ext_dist.txt b/erts/emulator/internal_doc/erl_ext_dist.txt index 23b7d0d8e5..0b9a783069 100644 --- a/erts/emulator/internal_doc/erl_ext_dist.txt +++ b/erts/emulator/internal_doc/erl_ext_dist.txt @@ -1,7 +1,7 @@ %CopyrightBegin% - Copyright Ericsson AB 1997-2009. All Rights Reserved. + Copyright Ericsson AB 1997-2016. All Rights Reserved. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. diff --git a/erts/emulator/nifs/common/erl_tracer_nif.c b/erts/emulator/nifs/common/erl_tracer_nif.c new file mode 100644 index 0000000000..8a9a1bf16c --- /dev/null +++ b/erts/emulator/nifs/common/erl_tracer_nif.c @@ -0,0 +1,257 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson 2015. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +/* + * Purpose: NIF library for process/port tracer + * + */ + + +#define STATIC_ERLANG_NIF 1 + +#include "erl_nif.h" +#include "config.h" +#include "sys.h" + +#ifdef VALGRIND +# include <valgrind/memcheck.h> +#endif + +/* NIF interface declarations */ +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); +static void unload(ErlNifEnv* env, void* priv_data); + +/* The NIFs: */ +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +static ErlNifFunc nif_funcs[] = { + {"enabled", 3, enabled}, + {"trace", 6, trace} +}; + + +ERL_NIF_INIT(erl_tracer, nif_funcs, load, NULL, upgrade, unload) + +#define ATOMS \ + ATOM_DECL(call); \ + ATOM_DECL(command); \ + ATOM_DECL(cpu_timestamp); \ + ATOM_DECL(discard); \ + ATOM_DECL(exception_from); \ + ATOM_DECL(match_spec_result); \ + ATOM_DECL(monotonic); \ + ATOM_DECL(ok); \ + ATOM_DECL(remove); \ + ATOM_DECL(return_from); \ + ATOM_DECL(scheduler_id); \ + ATOM_DECL(send); \ + ATOM_DECL(send_to_non_existing_process); \ + ATOM_DECL(seq_trace); \ + ATOM_DECL(spawn); \ + ATOM_DECL(strict_monotonic); \ + ATOM_DECL(timestamp); \ + ATOM_DECL(trace); \ + ATOM_DECL(trace_ts); \ + ATOM_DECL(true); \ + ATOM_DECL(gc_minor_start); \ + ATOM_DECL(gc_minor_end); \ + ATOM_DECL(gc_major_start); \ + ATOM_DECL(gc_major_end); \ + ATOM_DECL(undefined); + +#define ATOM_DECL(A) static ERL_NIF_TERM atom_##A +ATOMS +#undef ATOM_DECL + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + +#define ATOM_DECL(A) atom_##A = enif_make_atom(env, #A) +ATOMS +#undef ATOM_DECL + + *priv_data = NULL; + + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) +{ + +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, + ERL_NIF_TERM load_info) +{ + if (*old_priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if (*priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if (load(env, priv_data, load_info)) { + return -1; + } + return 0; +} + +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPid to_pid; + ErlNifPort to_port; + ASSERT(argc == 3); + + if (enif_get_local_pid(env, argv[1], &to_pid)) { + if (!enif_is_process_alive(env, &to_pid)) + /* tracer is dead so we should remove this trace point */ + return atom_remove; + } else if (enif_get_local_port(env, argv[1], &to_port)) { + if (!enif_is_port_alive(env, &to_port)) + /* tracer is dead so we should remove this trace point */ + return atom_remove; + } else { + /* The state was not a pid or a port */ + return atom_remove; + } + + /* Only generate trace for when tracer != tracee */ + if (enif_is_identical(argv[1], argv[2])) { + return atom_discard; + } + + return atom_trace; +} + +/* + -spec trace(seq_trace, TracerState :: pid() | port(), + Label :: non_neg_integer(), + Msg :: term(), + Opts :: map()) -> ignored(); + trace(Tag :: atom(), TracerState :: pid() | port(), + Tracee :: pid() || port() || undefined, + Msg :: term(), + Opts :: map()) -> ignored(). + -spec trace(Tag :: atom(), TracerState :: pid() | port(), + Tracee :: pid() || port() || undefined, + Msg :: term(), + Extra :: term(), + Opts :: map()) -> ignored(). +*/ +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM value, msg, tt[8], opts; + ErlNifPid to_pid; + ErlNifPort to_port; + size_t tt_sz = 0; + int is_port = 0; + ASSERT(argc == 6); + + if (!enif_get_local_pid(env, argv[1], &to_pid)) { + if (!enif_get_local_port(env, argv[1], &to_port)) { + /* This only fails if argv[1] is a not a local port/pid + which should not happen as it is checked in enabled */ + ASSERT(0); + return atom_ok; + } + is_port = 1; + } + + if (!enif_is_identical(argv[4], atom_undefined)) { + tt[tt_sz++] = atom_trace; + tt[tt_sz++] = argv[2]; + tt[tt_sz++] = argv[0]; + tt[tt_sz++] = argv[3]; + tt[tt_sz++] = argv[4]; + } else { + if (enif_is_identical(argv[0], atom_seq_trace)) { + tt[tt_sz++] = atom_seq_trace; + tt[tt_sz++] = argv[2]; + tt[tt_sz++] = argv[3]; + } else { + tt[tt_sz++] = atom_trace; + tt[tt_sz++] = argv[2]; + tt[tt_sz++] = argv[0]; + tt[tt_sz++] = argv[3]; + } + } + + opts = argv[5]; + + if (enif_get_map_value(env, opts, atom_match_spec_result, + &value) + && !enif_is_identical(value, atom_true)) { + tt[tt_sz++] = value; + } + + if (enif_get_map_value(env, opts, atom_scheduler_id, &value) + && !enif_is_identical(value, atom_undefined)) { + tt[tt_sz++] = value; + } + + if (enif_get_map_value(env, opts, atom_timestamp, &value) + && !enif_is_identical(value, atom_undefined)) { + ERL_NIF_TERM ts; + if (enif_is_identical(value, atom_monotonic)) { + ErlNifTime mon = enif_monotonic_time(ERL_NIF_NSEC); + ts = enif_make_int64(env, mon); + } else if (enif_is_identical(value, atom_strict_monotonic)) { + ErlNifTime mon = enif_monotonic_time(ERL_NIF_NSEC); + ERL_NIF_TERM unique = enif_make_unique_integer( + env, ERL_NIF_UNIQUE_MONOTONIC); + ts = enif_make_tuple2(env, enif_make_int64(env, mon), unique); + } else if (enif_is_identical(value, atom_timestamp)) { + ts = enif_now_time(env); + } else if (enif_is_identical(value, atom_cpu_timestamp)) { + ts = enif_cpu_time(env); + } else { + ASSERT(0); + goto error; + } + tt[tt_sz++] = ts; + if (tt[0] == atom_trace) + tt[0] = atom_trace_ts; + } + + msg = enif_make_tuple_from_array(env, tt, tt_sz); + + if (is_port) { + ErlNifBinary bin; + + if (!enif_term_to_binary(env, msg, &bin)) + goto error; + + msg = enif_make_binary(env, &bin); + + if (!enif_port_command(env, &to_port, NULL, msg)) + /* port has probably died, enabled will clean up */; + + enif_release_binary(&bin); + } else { + + if (!enif_send(env, &to_pid, NULL, msg)) + /* process has probably died, enabled will clean up */; + } + +error: + + return atom_ok; +} diff --git a/erts/emulator/pcre/pcre.mk b/erts/emulator/pcre/pcre.mk index b844b77214..38b91237a2 100644 --- a/erts/emulator/pcre/pcre.mk +++ b/erts/emulator/pcre/pcre.mk @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2012. All Rights Reserved. +# Copyright Ericsson AB 2012-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index 105b129065..44a77f3ea5 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2013. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -39,6 +39,7 @@ #include "erl_check_io.h" #include "erl_thr_progress.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #define ERTS_WANT_TIMER_WHEEL_API #include "erl_time.h" @@ -395,6 +396,7 @@ forget_removed(struct pollset_info* psi) if (drv_ptr) { int was_unmasked = erts_block_fpe(); DTRACE1(driver_stop_select, drv_ptr->name); + LTTNG1(driver_stop_select, drv_ptr->name); (*drv_ptr->stop_select) ((ErlDrvEvent) fd, NULL); erts_unblock_fpe(was_unmasked); if (drv_ptr->handle) { @@ -1055,6 +1057,7 @@ done_unknown: if (stop_select_fn) { int was_unmasked = erts_block_fpe(); DTRACE1(driver_stop_select, name); + LTTNG1(driver_stop_select, "unknown"); (*stop_select_fn)(e, NULL); erts_unblock_fpe(was_unmasked); } @@ -1337,11 +1340,7 @@ print_select_op(erts_dsprintf_buf_t *dsbufp, { Port *pp = erts_drvport2port(ix); erts_dsprintf(dsbufp, -#ifdef __OSE__ - "driver_select(%p, %d,%s%s%s%s | %d, %d) " -#else "driver_select(%p, %d,%s%s%s%s, %d) " -#endif "by ", ix, (int) GET_FD(fd), @@ -1861,25 +1860,6 @@ stale_drv_select(Eterm id, ErtsDrvEventState *state, int mode) #ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS -#ifdef __OSE__ -static SafeHashValue drv_ev_state_hash(void *des) -{ - ErtsSysFdType fd = ((ErtsDrvEventState *) des)->fd; - /* We use hash on signo ^ id in order for steal to happen when the - same signo + fd is selected on by two different ports */ - SafeHashValue val = (SafeHashValue)(fd->signo ^ fd->id); - return val ^ (val >> 8); -} - -static int drv_ev_state_cmp(void *des1, void *des2) -{ - ErtsSysFdType fd1 = ((ErtsDrvEventState *) des1)->fd; - ErtsSysFdType fd2 = ((ErtsDrvEventState *) des2)->fd; - if (fd1->signo == fd2->signo && fd1->id == fd2->id) - return 0; - return 1; -} -#else /* !__OSE__ && !ERTS_SYS_CONTINOUS_FD_NUMBERS i.e. probably windows */ static SafeHashValue drv_ev_state_hash(void *des) { SafeHashValue val = (SafeHashValue) ((ErtsDrvEventState *) des)->fd; @@ -1891,7 +1871,6 @@ static int drv_ev_state_cmp(void *des1, void *des2) return ( ((ErtsDrvEventState *) des1)->fd == ((ErtsDrvEventState *) des2)->fd ? 0 : 1); } -#endif static void *drv_ev_state_alloc(void *des_tmpl) { diff --git a/erts/emulator/sys/common/erl_check_io.h b/erts/emulator/sys/common/erl_check_io.h index c8675a7d9d..14f1ea3f43 100644 --- a/erts/emulator/sys/common/erl_check_io.h +++ b/erts/emulator/sys/common/erl_check_io.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2011. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 4180e65fdc..a7e710070b 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2013. All Rights Reserved. + * Copyright Ericsson AB 2002-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -51,23 +51,22 @@ #endif /* - * `mmap_state.sa.bot` and `mmap_state.sua.top` are read only after + * `mm->sa.bot` and `mm->sua.top` are read only after * initialization, but the other pointers are not; i.e., only * ERTS_MMAP_IN_SUPERCARRIER() is allowed without the mutex held. */ #define ERTS_MMAP_IN_SUPERCARRIER(PTR) \ - (((UWord) (PTR)) - ((UWord) mmap_state.sa.bot) \ - < ((UWord) mmap_state.sua.top) - ((UWord) mmap_state.sa.bot)) + (((UWord) (PTR)) - ((UWord) mm->sa.bot) \ + < ((UWord) mm->sua.top) - ((UWord) mm->sa.bot)) #define ERTS_MMAP_IN_SUPERALIGNED_AREA(PTR) \ - (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mmap_state.mtx)), \ - (((UWord) (PTR)) - ((UWord) mmap_state.sa.bot) \ - < ((UWord) mmap_state.sa.top) - ((UWord) mmap_state.sa.bot))) + (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mm->mtx)), \ + (((UWord) (PTR)) - ((UWord) mm->sa.bot) \ + < ((UWord) mm->sa.top) - ((UWord) mm->sa.bot))) #define ERTS_MMAP_IN_SUPERUNALIGNED_AREA(PTR) \ - (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mmap_state.mtx)), \ - (((UWord) (PTR)) - ((UWord) mmap_state.sua.bot) \ - < ((UWord) mmap_state.sua.top) - ((UWord) mmap_state.sua.bot))) + (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mm->mtx)), \ + (((UWord) (PTR)) - ((UWord) mm->sua.bot) \ + < ((UWord) mm->sua.top) - ((UWord) mm->sua.bot))) -int erts_have_erts_mmap; UWord erts_page_inv_mask; #if defined(DEBUG) || defined(ERTS_MMAP_DEBUG) @@ -197,10 +196,10 @@ static ErtsMMapOp mmap_ops[ERTS_MMAP_OP_RINGBUF_SZ]; #define ERTS_MMAP_OP_LCK(RES, IN_SZ, OUT_SZ) \ do { \ - erts_smp_mtx_lock(&mmap_state.mtx); \ + erts_smp_mtx_lock(&mm->mtx); \ ERTS_MMAP_OP_START((IN_SZ)); \ ERTS_MMAP_OP_END((RES), (OUT_SZ)); \ - erts_smp_mtx_unlock(&mmap_state.mtx); \ + erts_smp_mtx_unlock(&mm->mtx); \ } while (0) #define ERTS_MUNMAP_OP(PTR, SZ) \ @@ -219,9 +218,9 @@ static ErtsMMapOp mmap_ops[ERTS_MMAP_OP_RINGBUF_SZ]; #define ERTS_MUNMAP_OP_LCK(PTR, SZ) \ do { \ - erts_smp_mtx_lock(&mmap_state.mtx); \ + erts_smp_mtx_lock(&mm->mtx); \ ERTS_MUNMAP_OP((PTR), (SZ)); \ - erts_smp_mtx_unlock(&mmap_state.mtx); \ + erts_smp_mtx_unlock(&mm->mtx); \ } while (0) #define ERTS_MREMAP_OP_START(OLD_PTR, OLD_SZ, IN_SZ) \ @@ -247,10 +246,10 @@ static ErtsMMapOp mmap_ops[ERTS_MMAP_OP_RINGBUF_SZ]; #define ERTS_MREMAP_OP_LCK(RES, OLD_PTR, OLD_SZ, IN_SZ, OUT_SZ) \ do { \ - erts_smp_mtx_lock(&mmap_state.mtx); \ + erts_smp_mtx_lock(&mm->mtx); \ ERTS_MREMAP_OP_START((OLD_PTR), (OLD_SZ), (IN_SZ)); \ ERTS_MREMAP_OP_END((RES), (OUT_SZ)); \ - erts_smp_mtx_unlock(&mmap_state.mtx); \ + erts_smp_mtx_unlock(&mm->mtx); \ } while (0) #define ERTS_MMAP_OP_ABORT() \ @@ -294,13 +293,14 @@ typedef struct { Uint nseg; }ErtsFreeSegMap; -static struct { - int (*reserve_physical)(char *, UWord); +struct ErtsMemMapper_ { + int (*reserve_physical)(char *, UWord, int exec); void (*unreserve_physical)(char *, UWord); int supercarrier; int no_os_mmap; + int executable; /* is client a native code allocator? */ /* - * Super unaligend area is located above super aligned + * Super unaligned area is located above super aligned * area. That is, `sa.bot` is beginning of the super * carrier, `sua.top` is the end of the super carrier, * and sa.top and sua.bot moves towards eachother. @@ -346,54 +346,68 @@ static struct { UWord used; } os; } size; -} mmap_state; +}; + +ErtsMemMapper erts_dflt_mmapper; + +#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION) +ErtsMemMapper erts_literal_mmapper; +char* erts_literals_start; +UWord erts_literals_size; +#endif + +#ifdef ERTS_ALC_A_EXEC +ErtsMemMapper erts_exec_mmapper; +#endif + + #define ERTS_MMAP_SIZE_SC_SA_INC(SZ) \ do { \ - mmap_state.size.supercarrier.used.total += (SZ); \ - mmap_state.size.supercarrier.used.sa += (SZ); \ - ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total \ - <= mmap_state.size.supercarrier.total); \ - ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sa \ - <= mmap_state.size.supercarrier.used.total); \ + mm->size.supercarrier.used.total += (SZ); \ + mm->size.supercarrier.used.sa += (SZ); \ + ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total \ + <= mm->size.supercarrier.total); \ + ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sa \ + <= mm->size.supercarrier.used.total); \ } while (0) #define ERTS_MMAP_SIZE_SC_SA_DEC(SZ) \ do { \ - ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total >= (SZ)); \ - mmap_state.size.supercarrier.used.total -= (SZ); \ - ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sa >= (SZ)); \ - mmap_state.size.supercarrier.used.sa -= (SZ); \ + ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total >= (SZ)); \ + mm->size.supercarrier.used.total -= (SZ); \ + ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sa >= (SZ)); \ + mm->size.supercarrier.used.sa -= (SZ); \ } while (0) #define ERTS_MMAP_SIZE_SC_SUA_INC(SZ) \ do { \ - mmap_state.size.supercarrier.used.total += (SZ); \ - mmap_state.size.supercarrier.used.sua += (SZ); \ - ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total \ - <= mmap_state.size.supercarrier.total); \ - ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sua \ - <= mmap_state.size.supercarrier.used.total); \ + mm->size.supercarrier.used.total += (SZ); \ + mm->size.supercarrier.used.sua += (SZ); \ + ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total \ + <= mm->size.supercarrier.total); \ + ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sua \ + <= mm->size.supercarrier.used.total); \ } while (0) #define ERTS_MMAP_SIZE_SC_SUA_DEC(SZ) \ do { \ - ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total >= (SZ)); \ - mmap_state.size.supercarrier.used.total -= (SZ); \ - ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sua >= (SZ)); \ - mmap_state.size.supercarrier.used.sua -= (SZ); \ + ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total >= (SZ)); \ + mm->size.supercarrier.used.total -= (SZ); \ + ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sua >= (SZ)); \ + mm->size.supercarrier.used.sua -= (SZ); \ } while (0) #define ERTS_MMAP_SIZE_OS_INC(SZ) \ do { \ - ERTS_MMAP_ASSERT(mmap_state.size.os.used + (SZ) >= (SZ)); \ - mmap_state.size.os.used += (SZ); \ + ERTS_MMAP_ASSERT(mm->size.os.used + (SZ) >= (SZ)); \ + mm->size.os.used += (SZ); \ } while (0) #define ERTS_MMAP_SIZE_OS_DEC(SZ) \ do { \ - ERTS_MMAP_ASSERT(mmap_state.size.os.used >= (SZ)); \ - mmap_state.size.os.used -= (SZ); \ + ERTS_MMAP_ASSERT(mm->size.os.used >= (SZ)); \ + mm->size.os.used -= (SZ); \ } while (0) static void -add_free_desc_area(char *start, char *end) +add_free_desc_area(ErtsMemMapper* mm, char *start, char *end) { ERTS_MMAP_ASSERT(end == (void *) 0 || end > start); if (sizeof(ErtsFreeSegDesc) <= ((UWord) end) - ((UWord) start)) { @@ -403,7 +417,7 @@ add_free_desc_area(char *start, char *end) no = 1; prev_desc = (ErtsFreeSegDesc *) start; - prev_desc->start = mmap_state.desc.free_list; + prev_desc->start = mm->desc.free_list; desc = (ErtsFreeSegDesc *) (start + sizeof(ErtsFreeSegDesc)); desc_end = start + 2*sizeof(ErtsFreeSegDesc); @@ -414,59 +428,59 @@ add_free_desc_area(char *start, char *end) desc_end += sizeof(ErtsFreeSegDesc); no++; } - mmap_state.desc.free_list = (char *) prev_desc; - mmap_state.no.free_seg_descs += no; + mm->desc.free_list = (char *) prev_desc; + mm->no.free_seg_descs += no; } } static ErtsFreeSegDesc * -add_unused_free_desc_area(void) +add_unused_free_desc_area(ErtsMemMapper* mm) { char *ptr; - if (!mmap_state.desc.unused_start) + if (!mm->desc.unused_start) return NULL; - ERTS_MMAP_ASSERT(mmap_state.desc.unused_end); + ERTS_MMAP_ASSERT(mm->desc.unused_end); ERTS_MMAP_ASSERT(ERTS_PAGEALIGNED_SIZE - <= mmap_state.desc.unused_end - mmap_state.desc.unused_start); + <= mm->desc.unused_end - mm->desc.unused_start); - ptr = mmap_state.desc.unused_start + ERTS_PAGEALIGNED_SIZE; - add_free_desc_area(mmap_state.desc.unused_start, ptr); + ptr = mm->desc.unused_start + ERTS_PAGEALIGNED_SIZE; + add_free_desc_area(mm, mm->desc.unused_start, ptr); - if ((mmap_state.desc.unused_end - ptr) >= ERTS_PAGEALIGNED_SIZE) - mmap_state.desc.unused_start = ptr; + if ((mm->desc.unused_end - ptr) >= ERTS_PAGEALIGNED_SIZE) + mm->desc.unused_start = ptr; else - mmap_state.desc.unused_end = mmap_state.desc.unused_start = NULL; + mm->desc.unused_end = mm->desc.unused_start = NULL; - ERTS_MMAP_ASSERT(mmap_state.desc.free_list); - return (ErtsFreeSegDesc *) mmap_state.desc.free_list; + ERTS_MMAP_ASSERT(mm->desc.free_list); + return (ErtsFreeSegDesc *) mm->desc.free_list; } static ERTS_INLINE ErtsFreeSegDesc * -alloc_desc(void) +alloc_desc(ErtsMemMapper* mm) { ErtsFreeSegDesc *res; - res = (ErtsFreeSegDesc *) mmap_state.desc.free_list; + res = (ErtsFreeSegDesc *) mm->desc.free_list; if (!res) { - res = add_unused_free_desc_area(); + res = add_unused_free_desc_area(mm); if (!res) return NULL; } - mmap_state.desc.free_list = res->start; - ASSERT(mmap_state.no.free_segs.curr < mmap_state.no.free_seg_descs); - mmap_state.no.free_segs.curr++; - if (mmap_state.no.free_segs.max < mmap_state.no.free_segs.curr) - mmap_state.no.free_segs.max = mmap_state.no.free_segs.curr; + mm->desc.free_list = res->start; + ASSERT(mm->no.free_segs.curr < mm->no.free_seg_descs); + mm->no.free_segs.curr++; + if (mm->no.free_segs.max < mm->no.free_segs.curr) + mm->no.free_segs.max = mm->no.free_segs.curr; return res; } static ERTS_INLINE void -free_desc(ErtsFreeSegDesc *desc) +free_desc(ErtsMemMapper* mm, ErtsFreeSegDesc *desc) { - desc->start = mmap_state.desc.free_list; - mmap_state.desc.free_list = (char *) desc; - ERTS_MMAP_ASSERT(mmap_state.no.free_segs.curr > 0); - mmap_state.no.free_segs.curr--; + desc->start = mm->desc.free_list; + mm->desc.free_list = (char *) desc; + ERTS_MMAP_ASSERT(mm->no.free_segs.curr > 0); + mm->no.free_segs.curr--; } static ERTS_INLINE ErtsFreeSegDesc* anode_to_desc(RBTNode* anode) @@ -1225,6 +1239,7 @@ Eterm build_free_seg_list(Process* p, ErtsFreeSegMap* map) #if HAVE_MMAP # define ERTS_MMAP_PROT (PROT_READ|PROT_WRITE) +# define ERTS_MMAP_PROT_EXEC (PROT_READ|PROT_WRITE|PROT_EXEC) # if defined(MAP_ANONYMOUS) # define ERTS_MMAP_FLAGS (MAP_ANON|MAP_PRIVATE) # define ERTS_MMAP_FD (-1) @@ -1233,29 +1248,31 @@ Eterm build_free_seg_list(Process* p, ErtsFreeSegMap* map) # define ERTS_MMAP_FD (-1) # else # define ERTS_MMAP_FLAGS (MAP_PRIVATE) -# define ERTS_MMAP_FD mmap_state.mmap_fd +# define ERTS_MMAP_FD mm->mmap_fd # endif #endif static ERTS_INLINE void * -os_mmap(void *hint_ptr, UWord size, int try_superalign) +os_mmap(void *hint_ptr, UWord size, int try_superalign, int executable) { #if HAVE_MMAP + const int prot = executable ? ERTS_MMAP_PROT_EXEC : ERTS_MMAP_PROT; void *res; #ifdef MAP_ALIGN if (try_superalign) - res = mmap((void *) ERTS_SUPERALIGNED_SIZE, size, ERTS_MMAP_PROT, + res = mmap((void *) ERTS_SUPERALIGNED_SIZE, size, prot, ERTS_MMAP_FLAGS|MAP_ALIGN, ERTS_MMAP_FD, 0); else #endif - res = mmap((void *) hint_ptr, size, ERTS_MMAP_PROT, + res = mmap((void *) hint_ptr, size, prot, ERTS_MMAP_FLAGS, ERTS_MMAP_FD, 0); if (res == MAP_FAILED) return NULL; return res; #elif HAVE_VIRTUALALLOC + const DWORD prot = executable ? PAGE_EXECUTE_READWRITE : PAGE_READWRITE; return (void *) VirtualAlloc(NULL, (SIZE_T) size, - MEM_COMMIT|MEM_RESERVE, PAGE_READWRITE); + MEM_COMMIT|MEM_RESERVE, prot); #else # error "missing mmap() or similar" #endif @@ -1312,6 +1329,7 @@ os_mremap(void *ptr, UWord old_size, UWord new_size, int try_superalign) #if HAVE_MMAP #define ERTS_MMAP_RESERVE_PROT (ERTS_MMAP_PROT) +#define ERTS_MMAP_RESERVE_PROT_EXEC (ERTS_MMAP_PROT_EXEC) #define ERTS_MMAP_RESERVE_FLAGS (ERTS_MMAP_FLAGS|MAP_FIXED) #define ERTS_MMAP_UNRESERVE_PROT (PROT_NONE) #define ERTS_MMAP_UNRESERVE_FLAGS (ERTS_MMAP_FLAGS|MAP_NORESERVE|MAP_FIXED) @@ -1319,9 +1337,10 @@ os_mremap(void *ptr, UWord old_size, UWord new_size, int try_superalign) #define ERTS_MMAP_VIRTUAL_FLAGS (ERTS_MMAP_FLAGS|MAP_NORESERVE) static int -os_reserve_physical(char *ptr, UWord size) +os_reserve_physical(char *ptr, UWord size, int exec) { - void *res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_RESERVE_PROT, + const int prot = exec ? ERTS_MMAP_RESERVE_PROT_EXEC : ERTS_MMAP_RESERVE_PROT; + void *res = mmap((void *) ptr, (size_t) size, prot, ERTS_MMAP_RESERVE_FLAGS, ERTS_MMAP_FD, 0); if (res == (void *) MAP_FAILED) return 0; @@ -1338,10 +1357,39 @@ os_unreserve_physical(char *ptr, UWord size) } static void * -os_mmap_virtual(char *ptr, UWord size) +os_mmap_virtual(char *ptr, UWord size, int exec) { - void *res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_VIRTUAL_PROT, - ERTS_MMAP_VIRTUAL_FLAGS, ERTS_MMAP_FD, 0); + int flags = ERTS_MMAP_VIRTUAL_FLAGS; + void* res; + +#ifdef ERTS_ALC_A_EXEC + if (exec) { + ASSERT(!ptr); + /* OTP-19.0: Nice hack below cut-and-pasted from hipe_amd64.c */ + +# ifdef MAP_32BIT + /* If we got MAP_32BIT (Linux), then use that to ask for low memory */ + flags |= MAP_32BIT; +# else + /* FreeBSD doesn't have MAP_32BIT, and it doesn't respect + a plain map_hint (returns high mappings even though the + hint refers to a free area), so we have to use both map_hint + and MAP_FIXED to get addresses below the 2GB boundary. + This is even worse than the Linux/ppc64 case. + Similarly, Solaris 10 doesn't have MAP_32BIT, + and it doesn't respect a plain map_hint. */ + ptr = (char*)(512*1024*1024); /* 0.5GB */ + +# if defined(__FreeBSD__) || defined(__sun__) + flags |= MAP_FIXED; +# endif +# endif /* !MAP_32BIT */ + } +#else /* !ERTS_ALC_A_EXEC */ + ASSERT(!exec); +#endif + res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_VIRTUAL_PROT, + flags, ERTS_MMAP_FD, 0); if (res == (void *) MAP_FAILED) return NULL; return res; @@ -1354,7 +1402,7 @@ os_mmap_virtual(char *ptr, UWord size) #endif /* ERTS_HAVE_OS_MMAP */ -static int reserve_noop(char *ptr, UWord size) +static int reserve_noop(char *ptr, UWord size, int exec) { #ifdef ERTS_MMAP_DEBUG_FILL_AREAS Uint32 *uip, *end = (Uint32 *) (ptr + size); @@ -1378,11 +1426,12 @@ static void unreserve_noop(char *ptr, UWord size) } static UWord -alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end) +alloc_desc_insert_free_seg(ErtsMemMapper* mm, + ErtsFreeSegMap *map, char* start, char* end) { char *ptr; ErtsFreeSegMap *da_map; - ErtsFreeSegDesc *desc = alloc_desc(); + ErtsFreeSegDesc *desc = alloc_desc(mm); if (desc) { insert_free_seg(map, desc, start, end); return 0; @@ -1395,13 +1444,13 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end) */ #if ERTS_HAVE_OS_MMAP - if (!mmap_state.no_os_mmap) { - ptr = os_mmap(mmap_state.desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0); + if (!mm->no_os_mmap) { + ptr = os_mmap(mm->desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0, 0); if (ptr) { - mmap_state.desc.new_area_hint = ptr+ERTS_PAGEALIGNED_SIZE; + mm->desc.new_area_hint = ptr+ERTS_PAGEALIGNED_SIZE; ERTS_MMAP_SIZE_OS_INC(ERTS_PAGEALIGNED_SIZE); - add_free_desc_area(ptr, ptr+ERTS_PAGEALIGNED_SIZE); - desc = alloc_desc(); + add_free_desc_area(mm, ptr, ptr+ERTS_PAGEALIGNED_SIZE); + desc = alloc_desc(mm); ERTS_MMAP_ASSERT(desc); insert_free_seg(map, desc, start, end); return 0; @@ -1412,20 +1461,20 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end) /* * ...then try to find a good place in the supercarrier... */ - da_map = &mmap_state.sua.map; + da_map = &mm->sua.map; desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE); if (desc) { - if (mmap_state.reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE)) + if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE, 0)) ERTS_MMAP_SIZE_SC_SUA_INC(ERTS_PAGEALIGNED_SIZE); else desc = NULL; } else { - da_map = &mmap_state.sa.map; + da_map = &mm->sa.map; desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE); if (desc) { - if (mmap_state.reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE)) + if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE, 0)) ERTS_MMAP_SIZE_SC_SA_INC(ERTS_PAGEALIGNED_SIZE); else desc = NULL; @@ -1433,15 +1482,15 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end) } if (desc) { char *da_end = desc->start + ERTS_PAGEALIGNED_SIZE; - add_free_desc_area(desc->start, da_end); + add_free_desc_area(mm, desc->start, da_end); if (da_end != desc->end) resize_free_seg(da_map, desc, da_end, desc->end); else { delete_free_seg(da_map, desc); - free_desc(desc); + free_desc(mm, desc); } - desc = alloc_desc(); + desc = alloc_desc(mm); ERTS_MMAP_ASSERT(desc); insert_free_seg(map, desc, start, end); return 0; @@ -1454,10 +1503,10 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end) ptr = start + ERTS_PAGEALIGNED_SIZE; ERTS_MMAP_ASSERT(ptr <= end); - add_free_desc_area(start, ptr); + add_free_desc_area(mm, start, ptr); if (ptr != end) { - desc = alloc_desc(); + desc = alloc_desc(mm); ERTS_MMAP_ASSERT(desc); insert_free_seg(map, desc, ptr, end); } @@ -1466,46 +1515,46 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end) } void * -erts_mmap(Uint32 flags, UWord *sizep) +erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep) { char *seg; UWord asize = ERTS_PAGEALIGNED_CEILING(*sizep); /* Map in premapped supercarrier */ - if (mmap_state.supercarrier && !(ERTS_MMAPFLG_OS_ONLY & flags)) { + if (mm->supercarrier && !(ERTS_MMAPFLG_OS_ONLY & flags)) { char *end; ErtsFreeSegDesc *desc; Uint32 superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags); - erts_smp_mtx_lock(&mmap_state.mtx); + erts_smp_mtx_lock(&mm->mtx); ERTS_MMAP_OP_START(*sizep); if (!superaligned) { - desc = lookup_free_seg(&mmap_state.sua.map, asize); + desc = lookup_free_seg(&mm->sua.map, asize); if (desc) { seg = desc->start; end = seg+asize; - if (!mmap_state.reserve_physical(seg, asize)) + if (!mm->reserve_physical(seg, asize, mm->executable)) goto supercarrier_reserve_failure; if (desc->end == end) { - delete_free_seg(&mmap_state.sua.map, desc); - free_desc(desc); + delete_free_seg(&mm->sua.map, desc); + free_desc(mm, desc); } else { ERTS_MMAP_ASSERT(end < desc->end); - resize_free_seg(&mmap_state.sua.map, desc, end, desc->end); + resize_free_seg(&mm->sua.map, desc, end, desc->end); } ERTS_MMAP_SIZE_SC_SUA_INC(asize); goto supercarrier_success; } - if (asize <= mmap_state.sua.bot - mmap_state.sa.top) { - if (!mmap_state.reserve_physical(mmap_state.sua.bot - asize, - asize)) + if (asize <= mm->sua.bot - mm->sa.top) { + if (!mm->reserve_physical(mm->sua.bot - asize, asize, + mm->executable)) goto supercarrier_reserve_failure; - mmap_state.sua.bot -= asize; - seg = mmap_state.sua.bot; + mm->sua.bot -= asize; + seg = mm->sua.bot; ERTS_MMAP_SIZE_SC_SUA_INC(asize); goto supercarrier_success; } @@ -1513,84 +1562,87 @@ erts_mmap(Uint32 flags, UWord *sizep) asize = ERTS_SUPERALIGNED_CEILING(asize); - desc = lookup_free_seg(&mmap_state.sa.map, asize); + desc = lookup_free_seg(&mm->sa.map, asize); if (desc) { char *start = seg = desc->start; seg = (char *) ERTS_SUPERALIGNED_CEILING(seg); end = seg+asize; - if (!mmap_state.reserve_physical(start, (UWord) (end - start))) + if (!mm->reserve_physical(start, (UWord) (end - start), + mm->executable)) goto supercarrier_reserve_failure; ERTS_MMAP_SIZE_SC_SA_INC(asize); if (desc->end == end) { if (start != seg) - resize_free_seg(&mmap_state.sa.map, desc, start, seg); + resize_free_seg(&mm->sa.map, desc, start, seg); else { - delete_free_seg(&mmap_state.sa.map, desc); - free_desc(desc); + delete_free_seg(&mm->sa.map, desc); + free_desc(mm, desc); } } else { ERTS_MMAP_ASSERT(end < desc->end); - resize_free_seg(&mmap_state.sa.map, desc, end, desc->end); + resize_free_seg(&mm->sa.map, desc, end, desc->end); if (start != seg) { UWord ad_sz; - ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map, + ad_sz = alloc_desc_insert_free_seg(mm, &mm->sua.map, start, seg); start += ad_sz; if (start != seg) - mmap_state.unreserve_physical(start, (UWord) (seg - start)); + mm->unreserve_physical(start, (UWord) (seg - start)); } } goto supercarrier_success; } if (superaligned) { - char *start = mmap_state.sa.top; + char *start = mm->sa.top; seg = (char *) ERTS_SUPERALIGNED_CEILING(start); - if (asize + (seg - start) <= mmap_state.sua.bot - start) { + if (asize + (seg - start) <= mm->sua.bot - start) { end = seg + asize; - if (!mmap_state.reserve_physical(start, (UWord) (end - start))) + if (!mm->reserve_physical(start, (UWord) (end - start), + mm->executable)) goto supercarrier_reserve_failure; - mmap_state.sa.top = end; + mm->sa.top = end; ERTS_MMAP_SIZE_SC_SA_INC(asize); if (start != seg) { UWord ad_sz; - ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map, + ad_sz = alloc_desc_insert_free_seg(mm, &mm->sua.map, start, seg); start += ad_sz; if (start != seg) - mmap_state.unreserve_physical(start, (UWord) (seg - start)); + mm->unreserve_physical(start, (UWord) (seg - start)); } goto supercarrier_success; } - desc = lookup_free_seg(&mmap_state.sua.map, asize + ERTS_SUPERALIGNED_SIZE); + desc = lookup_free_seg(&mm->sua.map, asize + ERTS_SUPERALIGNED_SIZE); if (desc) { char *org_start = desc->start; char *org_end = desc->end; seg = (char *) ERTS_SUPERALIGNED_CEILING(org_start); end = seg + asize; - if (!mmap_state.reserve_physical(seg, (UWord) (org_end - seg))) + if (!mm->reserve_physical(seg, (UWord) (org_end - seg), + mm->executable)) goto supercarrier_reserve_failure; ERTS_MMAP_SIZE_SC_SUA_INC(asize); if (org_start != seg) { ERTS_MMAP_ASSERT(org_start < seg); - resize_free_seg(&mmap_state.sua.map, desc, org_start, seg); + resize_free_seg(&mm->sua.map, desc, org_start, seg); desc = NULL; } if (end != org_end) { UWord ad_sz = 0; ERTS_MMAP_ASSERT(end < org_end); if (desc) - resize_free_seg(&mmap_state.sua.map, desc, end, org_end); + resize_free_seg(&mm->sua.map, desc, end, org_end); else - ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map, + ad_sz = alloc_desc_insert_free_seg(mm, &mm->sua.map, end, org_end); end += ad_sz; if (end != org_end) - mmap_state.unreserve_physical(end, + mm->unreserve_physical(end, (UWord) (org_end - end)); } goto supercarrier_success; @@ -1598,20 +1650,20 @@ erts_mmap(Uint32 flags, UWord *sizep) } ERTS_MMAP_OP_ABORT(); - erts_smp_mtx_unlock(&mmap_state.mtx); + erts_smp_mtx_unlock(&mm->mtx); } #if ERTS_HAVE_OS_MMAP /* Map using OS primitives */ - if (!(ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) && !mmap_state.no_os_mmap) { + if (!(ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) && !mm->no_os_mmap) { if (!(ERTS_MMAPFLG_SUPERALIGNED & flags)) { - seg = os_mmap(NULL, asize, 0); + seg = os_mmap(NULL, asize, 0, mm->executable); if (!seg) goto failure; } else { asize = ERTS_SUPERALIGNED_CEILING(*sizep); - seg = os_mmap(NULL, asize, 1); + seg = os_mmap(NULL, asize, 1, mm->executable); if (!seg) goto failure; @@ -1621,7 +1673,8 @@ erts_mmap(Uint32 flags, UWord *sizep) os_munmap(seg, asize); - ptr = os_mmap(NULL, asize + ERTS_SUPERALIGNED_SIZE, 1); + ptr = os_mmap(NULL, asize + ERTS_SUPERALIGNED_SIZE, 1, + mm->executable); if (!ptr) goto failure; @@ -1661,25 +1714,25 @@ supercarrier_success: #endif ERTS_MMAP_OP_END(seg, asize); - erts_smp_mtx_unlock(&mmap_state.mtx); + erts_smp_mtx_unlock(&mm->mtx); *sizep = asize; return (void *) seg; supercarrier_reserve_failure: - erts_smp_mtx_unlock(&mmap_state.mtx); + erts_smp_mtx_unlock(&mm->mtx); *sizep = 0; return NULL; } void -erts_munmap(Uint32 flags, void *ptr, UWord size) +erts_munmap(ErtsMemMapper* mm, Uint32 flags, void *ptr, UWord size) { ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr)); ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(size)); if (!ERTS_MMAP_IN_SUPERCARRIER(ptr)) { - ERTS_MMAP_ASSERT(!mmap_state.no_os_mmap); + ERTS_MMAP_ASSERT(!mm->no_os_mmap); #if ERTS_HAVE_OS_MMAP ERTS_MUNMAP_OP_LCK(ptr, size); ERTS_MMAP_SIZE_OS_DEC(size); @@ -1692,45 +1745,45 @@ erts_munmap(Uint32 flags, void *ptr, UWord size) ErtsFreeSegDesc *prev, *next, *desc; UWord ad_sz = 0; - ERTS_MMAP_ASSERT(mmap_state.supercarrier); + ERTS_MMAP_ASSERT(mm->supercarrier); start = (char *) ptr; end = start + size; - erts_smp_mtx_lock(&mmap_state.mtx); + erts_smp_mtx_lock(&mm->mtx); ERTS_MUNMAP_OP(ptr, size); if (ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) { - map = &mmap_state.sa.map; + map = &mm->sa.map; adjacent_free_seg(map, start, end, &prev, &next); ERTS_MMAP_SIZE_SC_SA_DEC(size); - if (end == mmap_state.sa.top) { + if (end == mm->sa.top) { ERTS_MMAP_ASSERT(!next); if (prev) { start = prev->start; delete_free_seg(map, prev); - free_desc(prev); + free_desc(mm, prev); } - mmap_state.sa.top = start; + mm->sa.top = start; goto supercarrier_success; } } else { - map = &mmap_state.sua.map; + map = &mm->sua.map; adjacent_free_seg(map, start, end, &prev, &next); ERTS_MMAP_SIZE_SC_SUA_DEC(size); - if (start == mmap_state.sua.bot) { + if (start == mm->sua.bot) { ERTS_MMAP_ASSERT(!prev); if (next) { end = next->end; delete_free_seg(map, next); - free_desc(next); + free_desc(mm, next); } - mmap_state.sua.bot = end; + mm->sua.bot = end; goto supercarrier_success; } } @@ -1742,7 +1795,7 @@ erts_munmap(Uint32 flags, void *ptr, UWord size) end = next->end; if (prev) { delete_free_seg(map, next); - free_desc(next); + free_desc(mm, next); goto save_prev; } desc = next; @@ -1756,7 +1809,7 @@ erts_munmap(Uint32 flags, void *ptr, UWord size) if (desc) resize_free_seg(map, desc, start, end); else - ad_sz = alloc_desc_insert_free_seg(map, start, end); + ad_sz = alloc_desc_insert_free_seg(mm, map, start, end); supercarrier_success: { UWord unres_sz; @@ -1764,30 +1817,32 @@ erts_munmap(Uint32 flags, void *ptr, UWord size) ERTS_MMAP_ASSERT(size >= ad_sz); unres_sz = size - ad_sz; if (unres_sz) - mmap_state.unreserve_physical(((char *) ptr) + ad_sz, unres_sz); + mm->unreserve_physical(((char *) ptr) + ad_sz, unres_sz); - erts_smp_mtx_unlock(&mmap_state.mtx); + erts_smp_mtx_unlock(&mm->mtx); } } } static void * -remap_move(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) +remap_move(ErtsMemMapper* mm, + Uint32 flags, void *ptr, UWord old_size, UWord *sizep) { UWord size = *sizep; - void *new_ptr = erts_mmap(flags, &size); + void *new_ptr = erts_mmap(mm, flags, &size); if (!new_ptr) return NULL; *sizep = size; if (old_size < size) size = old_size; sys_memcpy(new_ptr, ptr, (size_t) size); - erts_munmap(flags, ptr, old_size); + erts_munmap(mm, flags, ptr, old_size); return new_ptr; } void * -erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) +erts_mremap(ErtsMemMapper* mm, + Uint32 flags, void *ptr, UWord old_size, UWord *sizep) { void *new_ptr; Uint32 superaligned; @@ -1799,11 +1854,11 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) if (!ERTS_MMAP_IN_SUPERCARRIER(ptr)) { - ERTS_MMAP_ASSERT(!mmap_state.no_os_mmap); + ERTS_MMAP_ASSERT(!mm->no_os_mmap); - if (!(ERTS_MMAPFLG_OS_ONLY & flags) && mmap_state.supercarrier) { - new_ptr = remap_move(ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags, ptr, - old_size, sizep); + if (!(ERTS_MMAPFLG_OS_ONLY & flags) && mm->supercarrier) { + new_ptr = remap_move(mm, ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags, + ptr, old_size, sizep); if (new_ptr) return new_ptr; } @@ -1850,7 +1905,7 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) #endif #if ERTS_HAVE_OS_MREMAP if (superaligned) - return remap_move(flags, new_ptr, old_size, sizep); + return remap_move(mm, flags, new_ptr, old_size, sizep); else { new_ptr = os_mremap(ptr, old_size, asize, 0); if (!new_ptr) @@ -1872,10 +1927,10 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) ErtsFreeSegDesc *prev, *next; UWord ad_sz = 0; - ERTS_MMAP_ASSERT(mmap_state.supercarrier); + ERTS_MMAP_ASSERT(mm->supercarrier); if (ERTS_MMAPFLG_OS_ONLY & flags) - return remap_move(flags, ptr, old_size, sizep); + return remap_move(mm, flags, ptr, old_size, sizep); superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags); @@ -1883,19 +1938,19 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) ? ERTS_SUPERALIGNED_CEILING(*sizep) : ERTS_PAGEALIGNED_CEILING(*sizep)); - erts_smp_mtx_lock(&mmap_state.mtx); + erts_smp_mtx_lock(&mm->mtx); if (ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr) - ? (!superaligned && lookup_free_seg(&mmap_state.sua.map, asize)) - : (superaligned && lookup_free_seg(&mmap_state.sa.map, asize))) { - erts_smp_mtx_unlock(&mmap_state.mtx); + ? (!superaligned && lookup_free_seg(&mm->sua.map, asize)) + : (superaligned && lookup_free_seg(&mm->sa.map, asize))) { + erts_smp_mtx_unlock(&mm->mtx); /* * Segment currently in wrong area (due to a previous memory * shortage), move it to the right area. * (remap_move() will succeed) */ - return remap_move(ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags, ptr, - old_size, sizep); + return remap_move(mm, ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags, + ptr, old_size, sizep); } ERTS_MREMAP_OP_START(ptr, old_size, *sizep); @@ -1917,18 +1972,18 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) UWord unres_sz; new_ptr = ptr; if (!ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) { - map = &mmap_state.sua.map; + map = &mm->sua.map; ERTS_MMAP_SIZE_SC_SUA_DEC(old_size - asize); } else { - if (end == mmap_state.sa.top) { - mmap_state.sa.top = new_end; - mmap_state.unreserve_physical(((char *) ptr) + asize, + if (end == mm->sa.top) { + mm->sa.top = new_end; + mm->unreserve_physical(((char *) ptr) + asize, old_size - asize); goto supercarrier_resize_success; } ERTS_MMAP_SIZE_SC_SA_DEC(old_size - asize); - map = &mmap_state.sa.map; + map = &mm->sa.map; } adjacent_free_seg(map, start, end, &prev, &next); @@ -1936,11 +1991,11 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) if (next) resize_free_seg(map, next, new_end, next->end); else - ad_sz = alloc_desc_insert_free_seg(map, new_end, end); + ad_sz = alloc_desc_insert_free_seg(mm, map, new_end, end); ERTS_MMAP_ASSERT(old_size - asize >= ad_sz); unres_sz = old_size - asize - ad_sz; if (unres_sz) - mmap_state.unreserve_physical(((char *) ptr) + asize + ad_sz, + mm->unreserve_physical(((char *) ptr) + asize + ad_sz, unres_sz); goto supercarrier_resize_success; } @@ -1950,17 +2005,18 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(old_size)); ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(asize)); - adjacent_free_seg(&mmap_state.sua.map, start, end, &prev, &next); + adjacent_free_seg(&mm->sua.map, start, end, &prev, &next); if (next && new_end <= next->end) { - if (!mmap_state.reserve_physical(((char *) ptr) + old_size, - asize - old_size)) + if (!mm->reserve_physical(((char *) ptr) + old_size, + asize - old_size, + mm->executable)) goto supercarrier_reserve_failure; if (new_end < next->end) - resize_free_seg(&mmap_state.sua.map, next, new_end, next->end); + resize_free_seg(&mm->sua.map, next, new_end, next->end); else { - delete_free_seg(&mmap_state.sua.map, next); - free_desc(next); + delete_free_seg(&mm->sua.map, next); + free_desc(mm, next); } new_ptr = ptr; ERTS_MMAP_SIZE_SC_SUA_INC(asize - old_size); @@ -1969,28 +2025,30 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) } else { /* Superaligned area */ - if (end == mmap_state.sa.top) { - if (new_end <= mmap_state.sua.bot) { - if (!mmap_state.reserve_physical(((char *) ptr) + old_size, - asize - old_size)) + if (end == mm->sa.top) { + if (new_end <= mm->sua.bot) { + if (!mm->reserve_physical(((char *) ptr) + old_size, + asize - old_size, + mm->executable)) goto supercarrier_reserve_failure; - mmap_state.sa.top = new_end; + mm->sa.top = new_end; new_ptr = ptr; ERTS_MMAP_SIZE_SC_SA_INC(asize - old_size); goto supercarrier_resize_success; } } else { - adjacent_free_seg(&mmap_state.sa.map, start, end, &prev, &next); + adjacent_free_seg(&mm->sa.map, start, end, &prev, &next); if (next && new_end <= next->end) { - if (!mmap_state.reserve_physical(((char *) ptr) + old_size, - asize - old_size)) + if (!mm->reserve_physical(((char *) ptr) + old_size, + asize - old_size, + mm->executable)) goto supercarrier_reserve_failure; if (new_end < next->end) - resize_free_seg(&mmap_state.sa.map, next, new_end, next->end); + resize_free_seg(&mm->sa.map, next, new_end, next->end); else { - delete_free_seg(&mmap_state.sa.map, next); - free_desc(next); + delete_free_seg(&mm->sa.map, next); + free_desc(mm, next); } new_ptr = ptr; ERTS_MMAP_SIZE_SC_SA_INC(asize - old_size); @@ -2000,12 +2058,12 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) } ERTS_MMAP_OP_ABORT(); - erts_smp_mtx_unlock(&mmap_state.mtx); + erts_smp_mtx_unlock(&mm->mtx); /* Failed to resize... */ } - return remap_move(flags, ptr, old_size, sizep); + return remap_move(mm, flags, ptr, old_size, sizep); supercarrier_resize_success: @@ -2022,25 +2080,24 @@ supercarrier_resize_success: #endif ERTS_MREMAP_OP_END(new_ptr, asize); - erts_smp_mtx_unlock(&mmap_state.mtx); + erts_smp_mtx_unlock(&mm->mtx); *sizep = asize; return new_ptr; supercarrier_reserve_failure: ERTS_MREMAP_OP_END(NULL, old_size); - erts_smp_mtx_unlock(&mmap_state.mtx); + erts_smp_mtx_unlock(&mm->mtx); *sizep = old_size; return NULL; } -int erts_mmap_in_supercarrier(void *ptr) +int erts_mmap_in_supercarrier(ErtsMemMapper* mm, void *ptr) { return ERTS_MMAP_IN_SUPERCARRIER(ptr); } - static struct { Eterm total; Eterm total_sa; @@ -2103,8 +2160,9 @@ static void hard_dbg_mseg_init(void); #endif void -erts_mmap_init(ErtsMMapInit *init) +erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init, int executable) { + static int is_first_call = 1; int virtual_map = 0; char *start = NULL, *end = NULL; UWord pagesize; @@ -2131,20 +2189,21 @@ erts_mmap_init(ErtsMMapInit *init) ERTS_MMAP_OP_RINGBUF_INIT(); - erts_have_erts_mmap = 0; - - mmap_state.supercarrier = 0; - mmap_state.reserve_physical = reserve_noop; - mmap_state.unreserve_physical = unreserve_noop; + mm->supercarrier = 0; + mm->reserve_physical = reserve_noop; + mm->unreserve_physical = unreserve_noop; + mm->executable = executable; #if HAVE_MMAP && !defined(MAP_ANON) - mmap_state.mmap_fd = open("/dev/zero", O_RDWR); - if (mmap_state.mmap_fd < 0) + mm->mmap_fd = open("/dev/zero", O_RDWR); + if (mm->mmap_fd < 0) erts_exit(1, "erts_mmap: Failed to open /dev/zero\n"); #endif - erts_smp_mtx_init(&mmap_state.mtx, "erts_mmap"); - erts_mtx_init(&am.init_mutex, "mmap_init_atoms"); + erts_smp_mtx_init(&mm->mtx, "erts_mmap"); + if (is_first_call) { + erts_mtx_init(&am.init_mutex, "mmap_init_atoms"); + } #ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION if (init->virtual_range.start) { @@ -2153,15 +2212,15 @@ erts_mmap_init(ErtsMMapInit *init) ptr = (char *) ERTS_PAGEALIGNED_CEILING(init->virtual_range.start); end = (char *) ERTS_PAGEALIGNED_FLOOR(init->virtual_range.end); sz = end - ptr; - start = os_mmap_virtual(ptr, sz); + start = os_mmap_virtual(ptr, sz, executable); if (!start || start > ptr || start >= end) erts_exit(1, "erts_mmap: Failed to create virtual range for super carrier\n"); sz = start - ptr; if (sz) os_munmap(end, sz); - mmap_state.reserve_physical = os_reserve_physical; - mmap_state.unreserve_physical = os_unreserve_physical; + mm->reserve_physical = os_reserve_physical; + mm->unreserve_physical = os_unreserve_physical; virtual_map = 1; } else @@ -2178,9 +2237,9 @@ erts_mmap_init(ErtsMMapInit *init) sz = ERTS_PAGEALIGNED_CEILING(init->scs); #ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION if (!init->scrpm) { - start = os_mmap_virtual(NULL, sz); - mmap_state.reserve_physical = os_reserve_physical; - mmap_state.unreserve_physical = os_unreserve_physical; + start = os_mmap_virtual(NULL, sz, executable); + mm->reserve_physical = os_reserve_physical; + mm->unreserve_physical = os_unreserve_physical; virtual_map = 1; } else @@ -2190,7 +2249,7 @@ erts_mmap_init(ErtsMMapInit *init) * The whole supercarrier will by physically * reserved all the time. */ - start = os_mmap(NULL, sz, 1); + start = os_mmap(NULL, sz, 1, executable); } if (!start) erts_exit(1, @@ -2206,34 +2265,32 @@ erts_mmap_init(ErtsMMapInit *init) } #endif } - if (!mmap_state.no_os_mmap) - erts_have_erts_mmap |= ERTS_HAVE_ERTS_OS_MMAP; #endif - mmap_state.no.free_seg_descs = 0; - mmap_state.no.free_segs.curr = 0; - mmap_state.no.free_segs.max = 0; + mm->no.free_seg_descs = 0; + mm->no.free_segs.curr = 0; + mm->no.free_segs.max = 0; - mmap_state.size.supercarrier.total = 0; - mmap_state.size.supercarrier.used.total = 0; - mmap_state.size.supercarrier.used.sa = 0; - mmap_state.size.supercarrier.used.sua = 0; - mmap_state.size.os.used = 0; + mm->size.supercarrier.total = 0; + mm->size.supercarrier.used.total = 0; + mm->size.supercarrier.used.sa = 0; + mm->size.supercarrier.used.sua = 0; + mm->size.os.used = 0; - mmap_state.desc.new_area_hint = NULL; + mm->desc.new_area_hint = NULL; if (!start) { - mmap_state.sa.bot = NULL; - mmap_state.sua.top = NULL; - mmap_state.sa.bot = NULL; - mmap_state.sua.top = NULL; - mmap_state.no_os_mmap = 0; - mmap_state.supercarrier = 0; + mm->sa.bot = NULL; + mm->sua.top = NULL; + mm->sa.bot = NULL; + mm->sua.top = NULL; + mm->no_os_mmap = 0; + mm->supercarrier = 0; } else { size_t desc_size; - mmap_state.no_os_mmap = init->sco; + mm->no_os_mmap = init->sco; desc_size = init->scrfsd; if (desc_size < 100) @@ -2244,66 +2301,73 @@ erts_mmap_init(ErtsMMapInit *init) + ERTS_PAGEALIGNED_SIZE) > end - start) erts_exit(1, "erts_mmap: No space for segments in super carrier\n"); - mmap_state.sa.bot = start; - mmap_state.sa.bot += desc_size; - mmap_state.sa.bot = (char *) ERTS_SUPERALIGNED_CEILING(mmap_state.sa.bot); - mmap_state.sa.top = mmap_state.sa.bot; - mmap_state.sua.top = end; - mmap_state.sua.bot = mmap_state.sua.top; + mm->sa.bot = start; + mm->sa.bot += desc_size; + mm->sa.bot = (char *) ERTS_SUPERALIGNED_CEILING(mm->sa.bot); + mm->sa.top = mm->sa.bot; + mm->sua.top = end; + mm->sua.bot = mm->sua.top; - mmap_state.size.supercarrier.used.total += (UWord) (mmap_state.sa.bot - start); + mm->size.supercarrier.used.total += (UWord) (mm->sa.bot - start); - mmap_state.desc.free_list = NULL; - mmap_state.desc.reserved = 0; + mm->desc.free_list = NULL; + mm->desc.reserved = 0; if (end == (void *) 0) { /* * Very unlikely, but we need a guarantee - * that `mmap_state.sua.top` always will + * that `mm->sua.top` always will * compare as larger than all segment pointers * into the super carrier... */ - mmap_state.sua.top -= ERTS_PAGEALIGNED_SIZE; - mmap_state.size.supercarrier.used.total += ERTS_PAGEALIGNED_SIZE; + mm->sua.top -= ERTS_PAGEALIGNED_SIZE; + mm->size.supercarrier.used.total += ERTS_PAGEALIGNED_SIZE; #ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION - if (!virtual_map || os_reserve_physical(mmap_state.sua.top, ERTS_PAGEALIGNED_SIZE)) + if (!virtual_map || os_reserve_physical(mm->sua.top, ERTS_PAGEALIGNED_SIZE, 0)) #endif - add_free_desc_area(mmap_state.sua.top, end); - mmap_state.desc.reserved += (end - mmap_state.sua.top) / sizeof(ErtsFreeSegDesc); + add_free_desc_area(mm, mm->sua.top, end); + mm->desc.reserved += (end - mm->sua.top) / sizeof(ErtsFreeSegDesc); } - mmap_state.size.supercarrier.total = (UWord) (mmap_state.sua.top - start); + mm->size.supercarrier.total = (UWord) (mm->sua.top - start); /* * Area before (and after) super carrier * will be used for free segment descritors. */ #ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION - if (virtual_map && !os_reserve_physical(start, mmap_state.sa.bot - start)) + if (virtual_map && !os_reserve_physical(start, mm->sa.bot - start, 0)) erts_exit(1, "erts_mmap: Failed to reserve physical memory for descriptors\n"); #endif - mmap_state.desc.unused_start = start; - mmap_state.desc.unused_end = mmap_state.sa.bot; - mmap_state.desc.reserved += ((mmap_state.desc.unused_end - start) + mm->desc.unused_start = start; + mm->desc.unused_end = mm->sa.bot; + mm->desc.reserved += ((mm->desc.unused_end - start) / sizeof(ErtsFreeSegDesc)); - init_free_seg_map(&mmap_state.sa.map, SA_SZ_ADDR_ORDER); - init_free_seg_map(&mmap_state.sua.map, SZ_REVERSE_ADDR_ORDER); + init_free_seg_map(&mm->sa.map, SA_SZ_ADDR_ORDER); + init_free_seg_map(&mm->sua.map, SZ_REVERSE_ADDR_ORDER); - mmap_state.supercarrier = 1; - erts_have_erts_mmap |= ERTS_HAVE_ERTS_SUPERCARRIER_MMAP; + mm->supercarrier = 1; - mmap_state.desc.new_area_hint = end; + mm->desc.new_area_hint = end; } #if !ERTS_HAVE_OS_MMAP - mmap_state.no_os_mmap = 1; + mm->no_os_mmap = 1; #endif #ifdef HARD_DEBUG_MSEG hard_dbg_mseg_init(); #endif + +#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION) + if (mm == &erts_literal_mmapper) { + erts_literals_start = erts_literal_mmapper.sa.bot; + erts_literals_size = erts_literal_mmapper.sua.top - erts_literals_start; + } +#endif + is_first_call = 0; } @@ -2313,7 +2377,8 @@ add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2) *lp = erts_bld_cons(hpp, szp, erts_bld_tuple(hpp, szp, 2, el1, el2), *lp); } -Eterm erts_mmap_info(int *print_to_p, +Eterm erts_mmap_info(ErtsMemMapper* mm, + int *print_to_p, void *print_to_arg, Eterm** hpp, Uint* szp, struct erts_mmap_info_struct* emis) @@ -2328,29 +2393,29 @@ Eterm erts_mmap_info(int *print_to_p, Eterm res = THE_NON_VALUE; if (!hpp) { - erts_smp_mtx_lock(&mmap_state.mtx); - emis->sizes[0] = mmap_state.size.supercarrier.total; - emis->sizes[1] = mmap_state.sa.top - mmap_state.sa.bot; - emis->sizes[2] = mmap_state.sua.top - mmap_state.sua.bot; - emis->sizes[3] = mmap_state.size.supercarrier.used.total; - emis->sizes[4] = mmap_state.size.supercarrier.used.sa; - emis->sizes[5] = mmap_state.size.supercarrier.used.sua; + erts_smp_mtx_lock(&mm->mtx); + emis->sizes[0] = mm->size.supercarrier.total; + emis->sizes[1] = mm->sa.top - mm->sa.bot; + emis->sizes[2] = mm->sua.top - mm->sua.bot; + emis->sizes[3] = mm->size.supercarrier.used.total; + emis->sizes[4] = mm->size.supercarrier.used.sa; + emis->sizes[5] = mm->size.supercarrier.used.sua; - emis->segs[0] = mmap_state.no.free_segs.curr; - emis->segs[1] = mmap_state.no.free_segs.max; - emis->segs[2] = mmap_state.no.free_seg_descs; - emis->segs[3] = mmap_state.desc.reserved; - emis->segs[4] = mmap_state.sa.map.nseg; - emis->segs[5] = mmap_state.sua.map.nseg; + emis->segs[0] = mm->no.free_segs.curr; + emis->segs[1] = mm->no.free_segs.max; + emis->segs[2] = mm->no.free_seg_descs; + emis->segs[3] = mm->desc.reserved; + emis->segs[4] = mm->sa.map.nseg; + emis->segs[5] = mm->sua.map.nseg; - emis->os_used = mmap_state.size.os.used; - erts_smp_mtx_unlock(&mmap_state.mtx); + emis->os_used = mm->size.os.used; + erts_smp_mtx_unlock(&mm->mtx); } if (print_to_p) { int to = *print_to_p; void *arg = print_to_arg; - if (mmap_state.supercarrier) { + if (mm->supercarrier) { const char* prefix = "supercarrier "; erts_print(to, arg, "%stotal size: %bpu\n", prefix, emis->sizes[0]); erts_print(to, arg, "%stotal sa size: %bpu\n", prefix, emis->sizes[1]); @@ -2365,7 +2430,7 @@ Eterm erts_mmap_info(int *print_to_p, erts_print(to, arg, "%ssa free segs: %bpu\n", prefix, emis->segs[4]); erts_print(to, arg, "%ssua free segs: %bpu\n", prefix, emis->segs[5]); } - if (!mmap_state.no_os_mmap) { + if (!mm->no_os_mmap) { erts_print(to, arg, "os mmap size used: %bpu\n", emis->os_used); } } @@ -2377,7 +2442,7 @@ Eterm erts_mmap_info(int *print_to_p, } lix = 0; - if (mmap_state.supercarrier) { + if (mm->supercarrier) { group[0] = erts_bld_atom_uword_2tup_list(hpp, szp, sizeof(size_tags)/sizeof(Eterm), size_tags, emis->sizes); @@ -2389,7 +2454,7 @@ Eterm erts_mmap_info(int *print_to_p, lix++; } - if (!mmap_state.no_os_mmap) { + if (!mm->no_os_mmap) { group[0] = erts_bld_atom_uword_2tup_list(hpp, szp, 1, &am.used, &emis->os_used); list[lix] = erts_bld_2tup_list(hpp, szp, 1, group_tags, group); @@ -2401,25 +2466,26 @@ Eterm erts_mmap_info(int *print_to_p, return res; } -Eterm erts_mmap_info_options(char *prefix, +Eterm erts_mmap_info_options(ErtsMemMapper* mm, + char *prefix, int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) { - const UWord scs = mmap_state.sua.top - mmap_state.sa.bot; - const Eterm sco = mmap_state.no_os_mmap ? am_true : am_false; - const Eterm scrpm = (mmap_state.reserve_physical == reserve_noop) ? am_true : am_false; + const UWord scs = mm->sua.top - mm->sa.bot; + const Eterm sco = mm->no_os_mmap ? am_true : am_false; + const Eterm scrpm = (mm->reserve_physical == reserve_noop) ? am_true : am_false; Eterm res = THE_NON_VALUE; if (print_to_p) { int to = *print_to_p; void *arg = print_to_arg; erts_print(to, arg, "%sscs: %bpu\n", prefix, scs); - if (mmap_state.supercarrier) { + if (mm->supercarrier) { erts_print(to, arg, "%ssco: %T\n", prefix, sco); erts_print(to, arg, "%sscrpm: %T\n", prefix, scrpm); - erts_print(to, arg, "%sscrfsd: %beu\n", prefix, mmap_state.desc.reserved); + erts_print(to, arg, "%sscrfsd: %beu\n", prefix, mm->desc.reserved); } } @@ -2429,9 +2495,9 @@ Eterm erts_mmap_info_options(char *prefix, } res = NIL; - if (mmap_state.supercarrier) { + if (mm->supercarrier) { add_2tup(hpp, szp, &res, am.scrfsd, - erts_bld_uint(hpp,szp, mmap_state.desc.reserved)); + erts_bld_uint(hpp,szp, mm->desc.reserved)); add_2tup(hpp, szp, &res, am.scrpm, scrpm); add_2tup(hpp, szp, &res, am.sco, sco); } @@ -2441,9 +2507,9 @@ Eterm erts_mmap_info_options(char *prefix, } -Eterm erts_mmap_debug_info(Process* p) +Eterm erts_mmap_debug_info(ErtsMemMapper* mm, Process* p) { - if (mmap_state.supercarrier) { + if (mm->supercarrier) { ERTS_DECL_AM(sabot); ERTS_DECL_AM(satop); ERTS_DECL_AM(suabot); @@ -2453,18 +2519,17 @@ Eterm erts_mmap_debug_info(Process* p) UWord values[4]; Eterm *hp, *hp_end; Uint may_need; - const Uint PTR_BIG_SZ = HALFWORD_HEAP ? 3 : 2; - - erts_smp_mtx_lock(&mmap_state.mtx); - values[0] = (UWord)mmap_state.sa.bot; - values[1] = (UWord)mmap_state.sa.top; - values[2] = (UWord)mmap_state.sua.bot; - values[3] = (UWord)mmap_state.sua.top; - sa_list = build_free_seg_list(p, &mmap_state.sa.map); - sua_list = build_free_seg_list(p, &mmap_state.sua.map); - erts_smp_mtx_unlock(&mmap_state.mtx); - - may_need = 4*(2+3+PTR_BIG_SZ) + 2*(2+3); + + erts_smp_mtx_lock(&mm->mtx); + values[0] = (UWord)mm->sa.bot; + values[1] = (UWord)mm->sa.top; + values[2] = (UWord)mm->sua.bot; + values[3] = (UWord)mm->sua.top; + sa_list = build_free_seg_list(p, &mm->sa.map); + sua_list = build_free_seg_list(p, &mm->sua.map); + erts_smp_mtx_unlock(&mm->mtx); + + may_need = 4*(2+3+2) + 2*(2+3); hp = HAlloc(p, may_need); hp_end = hp + may_need; diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h index 66619c5161..b3c45ba116 100644 --- a/erts/emulator/sys/common/erl_mmap.h +++ b/erts/emulator/sys/common/erl_mmap.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2013. All Rights Reserved. + * Copyright Ericsson AB 2013-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -30,9 +30,6 @@ #define ERTS_MMAPFLG_SUPERCARRIER_ONLY (((Uint32) 1) << 1) #define ERTS_MMAPFLG_SUPERALIGNED (((Uint32) 1) << 2) -#define ERTS_HAVE_ERTS_OS_MMAP (1 << 0) -#define ERTS_HAVE_ERTS_SUPERCARRIER_MMAP (1 << 1) -extern int erts_have_erts_mmap; extern UWord erts_page_inv_mask; typedef struct { @@ -53,23 +50,36 @@ typedef struct { #define ERTS_MMAP_INIT_DEFAULT_INITER \ {{NULL, NULL}, {NULL, NULL}, 0, 1, (1 << 16), 1} -void *erts_mmap(Uint32 flags, UWord *sizep); -void erts_munmap(Uint32 flags, void *ptr, UWord size); -void *erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep); -int erts_mmap_in_supercarrier(void *ptr); -void erts_mmap_init(ErtsMMapInit*); +#define ERTS_LITERAL_VIRTUAL_AREA_SIZE (UWORD_CONSTANT(1)*1024*1024*1024) + +#define ERTS_MMAP_INIT_LITERAL_INITER \ + {{NULL, NULL}, {NULL, NULL}, ERTS_LITERAL_VIRTUAL_AREA_SIZE, 1, (1 << 10), 0} + +#define ERTS_HIPE_EXEC_VIRTUAL_AREA_SIZE (UWORD_CONSTANT(512)*1024*1024) + +#define ERTS_MMAP_INIT_HIPE_EXEC_INITER \ + {{NULL, NULL}, {NULL, NULL}, ERTS_HIPE_EXEC_VIRTUAL_AREA_SIZE, 1, (1 << 10), 0} + +typedef struct ErtsMemMapper_ ErtsMemMapper; + +void *erts_mmap(ErtsMemMapper*, Uint32 flags, UWord *sizep); +void erts_munmap(ErtsMemMapper*, Uint32 flags, void *ptr, UWord size); +void *erts_mremap(ErtsMemMapper*, Uint32 flags, void *ptr, UWord old_size, UWord *sizep); +int erts_mmap_in_supercarrier(ErtsMemMapper*, void *ptr); +void erts_mmap_init(ErtsMemMapper*, ErtsMMapInit*, int executable); struct erts_mmap_info_struct { UWord sizes[6]; UWord segs[6]; UWord os_used; }; -Eterm erts_mmap_info(int *print_to_p, void *print_to_arg, +Eterm erts_mmap_info(ErtsMemMapper*, int *print_to_p, void *print_to_arg, Eterm** hpp, Uint* szp, struct erts_mmap_info_struct*); -Eterm erts_mmap_info_options(char *prefix, int *print_to_p, void *print_to_arg, +Eterm erts_mmap_info_options(ErtsMemMapper*, + char *prefix, int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp); struct process; -Eterm erts_mmap_debug_info(struct process*); +Eterm erts_mmap_debug_info(ErtsMemMapper*, struct process*); #define ERTS_SUPERALIGNED_SIZE \ (1 << ERTS_MMAP_SUPERALIGNED_BITS) @@ -121,6 +131,18 @@ Eterm erts_mmap_debug_info(struct process*); # define ERTS_HAVE_OS_MMAP 1 #endif +#ifdef ERTS_WANT_MEM_MAPPERS +# include "erl_alloc_types.h" + +extern ErtsMemMapper erts_dflt_mmapper; +# if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION) +extern ErtsMemMapper erts_literal_mmapper; +# endif +# ifdef ERTS_ALC_A_EXEC +extern ErtsMemMapper erts_exec_mmapper; +# endif +#endif /* ERTS_WANT_MEM_MAPPERS */ + /*#define HARD_DEBUG_MSEG*/ #ifdef HARD_DEBUG_MSEG # define HARD_DBG_INSERT_MSEG hard_dbg_insert_mseg diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index 3398be2b07..43e75e2573 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2013. All Rights Reserved. + * Copyright Ericsson AB 2002-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -31,6 +31,7 @@ # include "config.h" #endif +#define ERTS_WANT_MEM_MAPPERS #include "sys.h" #include "erl_mseg.h" #include "global.h" @@ -99,17 +100,12 @@ static const int debruijn[32] = { static int atoms_initialized; -typedef struct mem_kind_t MemKind; - const ErtsMsegOpt_t erts_mseg_default_opt = { 1, /* Use cache */ 1, /* Preserv data */ 0, /* Absolute shrink threshold */ 0, /* Relative shrink threshold */ 0 /* Scheduler specific */ -#if HALFWORD_HEAP - ,0 /* need low memory */ -#endif }; @@ -142,7 +138,14 @@ struct cache_t_ { typedef struct ErtsMsegAllctr_t_ ErtsMsegAllctr_t; -struct mem_kind_t { +struct ErtsMsegAllctr_t_ { + int ix; + + int is_init_done; + int is_thread_safe; + erts_mtx_t mtx; + + int is_cache_check_scheduled; cache_t cache[MAX_CACHE_SIZE]; cache_t cache_unpowered_node; @@ -168,29 +171,6 @@ struct mem_kind_t { } max_ever; } segments; - ErtsMsegAllctr_t *ma; - const char* name; - MemKind* next; -};/*MemKind*/ - -struct ErtsMsegAllctr_t_ { - int ix; - - int is_init_done; - int is_thread_safe; - erts_mtx_t mtx; - - int is_cache_check_scheduled; - - MemKind* mk_list; - -#if HALFWORD_HEAP - MemKind low_mem; - MemKind hi_mem; -#else - MemKind the_mem; -#endif - Uint max_cache_size; Uint abs_max_cache_bad_fit; Uint rel_max_cache_bad_fit; @@ -302,22 +282,17 @@ schedule_cache_check(ErtsMsegAllctr_t *ma) { /* #define ERTS_PRINT_ERTS_MMAP */ static ERTS_INLINE void * -mseg_create(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, UWord *sizep) +mseg_create(ErtsMsegAllctr_t *ma, Uint flags, UWord *sizep) { #ifdef ERTS_PRINT_ERTS_MMAP UWord req_size = *sizep; #endif void *seg; Uint32 mmap_flags = 0; -#if HALFWORD_HEAP - mmap_flags |= ((mk == &ma->low_mem) - ? ERTS_MMAPFLG_SUPERCARRIER_ONLY - : ERTS_MMAPFLG_OS_ONLY); -#endif if (MSEG_FLG_IS_2POW(flags)) mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED; - seg = erts_mmap(mmap_flags, sizep); + seg = erts_mmap(&erts_dflt_mmapper, mmap_flags, sizep); #ifdef ERTS_PRINT_ERTS_MMAP erts_fprintf(stderr, "%p = erts_mmap(%s, {%bpu, %bpu});\n", seg, @@ -331,18 +306,13 @@ mseg_create(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, UWord *sizep) } static ERTS_INLINE void -mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *seg_p, UWord size) { +mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, void *seg_p, UWord size) { Uint32 mmap_flags = 0; -#if HALFWORD_HEAP - mmap_flags |= ((mk == &ma->low_mem) - ? ERTS_MMAPFLG_SUPERCARRIER_ONLY - : ERTS_MMAPFLG_OS_ONLY); -#endif if (MSEG_FLG_IS_2POW(flags)) mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED; - erts_munmap(mmap_flags, seg_p, size); + erts_munmap(&erts_dflt_mmapper, mmap_flags, seg_p, size); #ifdef ERTS_PRINT_ERTS_MMAP erts_fprintf(stderr, "erts_munmap(%s, %p, %bpu);\n", (mmap_flags & ERTS_MMAPFLG_SUPERALIGNED) ? "sa" : "sua", @@ -353,22 +323,17 @@ mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *seg_p, UWord s } static ERTS_INLINE void * -mseg_recreate(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *old_seg, UWord old_size, UWord *sizep) +mseg_recreate(ErtsMsegAllctr_t *ma, Uint flags, void *old_seg, UWord old_size, UWord *sizep) { #ifdef ERTS_PRINT_ERTS_MMAP UWord req_size = *sizep; #endif void *new_seg; Uint32 mmap_flags = 0; -#if HALFWORD_HEAP - mmap_flags |= ((mk == &ma->low_mem) - ? ERTS_MMAPFLG_SUPERCARRIER_ONLY - : ERTS_MMAPFLG_OS_ONLY); -#endif if (MSEG_FLG_IS_2POW(flags)) mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED; - new_seg = erts_mremap(mmap_flags, old_seg, old_size, sizep); + new_seg = erts_mremap(&erts_dflt_mmapper, mmap_flags, old_seg, old_size, sizep); #ifdef ERTS_PRINT_ERTS_MMAP erts_fprintf(stderr, "%p = erts_mremap(%s, %p, %bpu, {%bpu, %bpu});\n", @@ -392,11 +357,8 @@ do { \ || erts_smp_thr_progress_is_blocking() \ || ERTS_IS_CRASH_DUMPING); \ } while (0) -#define ERTS_DBG_MK_CHK_THR_ACCESS(MK) \ - ERTS_DBG_MA_CHK_THR_ACCESS((MK)->ma) #else #define ERTS_DBG_MA_CHK_THR_ACCESS(MA) -#define ERTS_DBG_MK_CHK_THR_ACCESS(MK) #endif /* Cache interface */ @@ -409,10 +371,10 @@ static ERTS_INLINE void mseg_cache_clear_node(cache_t *c) { c->prev = c; } -static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, Uint flags) { +static ERTS_INLINE int cache_bless_segment(ErtsMsegAllctr_t *ma, void *seg, UWord size, Uint flags) { cache_t *c; - ERTS_DBG_MK_CHK_THR_ACCESS(mk); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); ASSERT(!MSEG_FLG_IS_2POW(flags) || (MSEG_FLG_IS_2POW(flags) && MAP_IS_ALIGNED(seg) && IS_2POW(size))); @@ -421,11 +383,11 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U * Large blocks has no such cache and it is up to mseg to cache them to speed things up. */ - if (!erts_circleq_is_empty(&(mk->cache_free))) { + if (!erts_circleq_is_empty(&(ma->cache_free))) { /* We have free slots, use one to cache the segment */ - c = erts_circleq_head(&(mk->cache_free)); + c = erts_circleq_head(&(ma->cache_free)); erts_circleq_remove(c); c->seg = seg; @@ -437,29 +399,28 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U ASSERT(ix < CACHE_AREAS); ASSERT((1 << (ix + MSEG_ALIGN_BITS)) == size); - erts_circleq_push_head(&(mk->cache_powered_node[ix]), c); + erts_circleq_push_head(&(ma->cache_powered_node[ix]), c); } else - erts_circleq_push_head(&(mk->cache_unpowered_node), c); + erts_circleq_push_head(&(ma->cache_unpowered_node), c); - mk->cache_size++; - ASSERT(mk->cache_size <= mk->ma->max_cache_size); + ma->cache_size++; return 1; - } else if (!MSEG_FLG_IS_2POW(flags) && !erts_circleq_is_empty(&(mk->cache_unpowered_node))) { + } else if (!MSEG_FLG_IS_2POW(flags) && !erts_circleq_is_empty(&(ma->cache_unpowered_node))) { /* No free slots. * Evict oldest slot from unpowered cache so we can cache an unpowered (sbc) segment */ - c = erts_circleq_tail(&(mk->cache_unpowered_node)); + c = erts_circleq_tail(&(ma->cache_unpowered_node)); erts_circleq_remove(c); - mseg_destroy(mk->ma, ERTS_MSEG_FLG_NONE, mk, c->seg, c->size); + mseg_destroy(ma, ERTS_MSEG_FLG_NONE, c->seg, c->size); mseg_cache_clear_node(c); c->seg = seg; c->size = size; - erts_circleq_push_head(&(mk->cache_unpowered_node), c); + erts_circleq_push_head(&(ma->cache_unpowered_node), c); return 1; } else if (!MSEG_FLG_IS_2POW(flags)) { @@ -473,20 +434,20 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U int i; for( i = 0; i < CACHE_AREAS; i++) { - if (erts_circleq_is_empty(&(mk->cache_powered_node[i]))) + if (erts_circleq_is_empty(&(ma->cache_powered_node[i]))) continue; - c = erts_circleq_tail(&(mk->cache_powered_node[i])); + c = erts_circleq_tail(&(ma->cache_powered_node[i])); erts_circleq_remove(c); - mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, c->seg, c->size); + mseg_destroy(ma, ERTS_MSEG_FLG_2POW, c->seg, c->size); mseg_cache_clear_node(c); c->seg = seg; c->size = size; - erts_circleq_push_head(&(mk->cache_unpowered_node), c); + erts_circleq_push_head(&(ma->cache_unpowered_node), c); return 1; } @@ -495,11 +456,11 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U return 0; } -static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flags) { +static ERTS_INLINE void *cache_get_segment(ErtsMsegAllctr_t *ma, UWord *size_p, Uint flags) { UWord size = *size_p; - ERTS_DBG_MK_CHK_THR_ACCESS(mk); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); if (MSEG_FLG_IS_2POW(flags)) { @@ -512,10 +473,10 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag for( i = ix; i < CACHE_AREAS; i++) { - if (erts_circleq_is_empty(&(mk->cache_powered_node[i]))) + if (erts_circleq_is_empty(&(ma->cache_powered_node[i]))) continue; - c = erts_circleq_head(&(mk->cache_powered_node[i])); + c = erts_circleq_head(&(ma->cache_powered_node[i])); erts_circleq_remove(c); ASSERT(IS_2POW(c->size)); @@ -524,31 +485,31 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag csize = c->size; seg = (char*) c->seg; - mk->cache_size--; - mk->cache_hits++; + ma->cache_size--; + ma->cache_hits++; /* link to free cache list */ mseg_cache_clear_node(c); - erts_circleq_push_head(&(mk->cache_free), c); + erts_circleq_push_head(&(ma->cache_free), c); - ASSERT(!(mk->cache_size < 0)); + ASSERT(!(ma->cache_size < 0)); if (csize != size) - mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, seg + size, csize - size); + mseg_destroy(ma, ERTS_MSEG_FLG_2POW, seg + size, csize - size); return seg; } } - else if (!erts_circleq_is_empty(&(mk->cache_unpowered_node))) { + else if (!erts_circleq_is_empty(&(ma->cache_unpowered_node))) { void *seg; cache_t *c; cache_t *best = NULL; UWord bdiff = 0; UWord csize; - UWord bad_max_abs = mk->ma->abs_max_cache_bad_fit; - UWord bad_max_rel = mk->ma->rel_max_cache_bad_fit; + UWord bad_max_abs = ma->abs_max_cache_bad_fit; + UWord bad_max_rel = ma->rel_max_cache_bad_fit; - erts_circleq_foreach(c, &(mk->cache_unpowered_node)) { + erts_circleq_foreach(c, &(ma->cache_unpowered_node)) { csize = c->size; if (csize >= size) { if (((csize - size)*100 < bad_max_rel*size) && (csize - size) < bad_max_abs ) { @@ -557,11 +518,11 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag erts_circleq_remove(c); - mk->cache_size--; - mk->cache_hits++; + ma->cache_size--; + ma->cache_hits++; mseg_cache_clear_node(c); - erts_circleq_push_head(&(mk->cache_free), c); + erts_circleq_push_head(&(ma->cache_free), c); *size_p = csize; @@ -584,7 +545,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag ASSERT(best->seg); ASSERT(best->size > 0); - mk->cache_hits++; + ma->cache_hits++; /* Use current cache placement for remaining segment space */ @@ -608,7 +569,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag * using callbacks from aux-work in the scheduler. */ -static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, Uint flags, cache_t *head) { +static ERTS_INLINE Uint mseg_drop_one_cache_size(ErtsMsegAllctr_t *ma, Uint flags, cache_t *head) { cache_t *c = NULL; c = erts_circleq_tail(head); @@ -617,19 +578,19 @@ static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, Uint flags if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg); - mseg_destroy(mk->ma, flags, mk, c->seg, c->size); + mseg_destroy(ma, flags, c->seg, c->size); mseg_cache_clear_node(c); - erts_circleq_push_head(&(mk->cache_free), c); + erts_circleq_push_head(&(ma->cache_free), c); - mk->segments.current.watermark--; - mk->cache_size--; + ma->segments.current.watermark--; + ma->cache_size--; - ASSERT( mk->cache_size >= 0 ); + ASSERT(ma->cache_size >= 0); - return mk->cache_size; + return ma->cache_size; } -static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, Uint flags, cache_t *head) { +static ERTS_INLINE Uint mseg_drop_cache_size(ErtsMsegAllctr_t *ma, Uint flags, cache_t *head) { cache_t *c = NULL; while (!erts_circleq_is_empty(head)) { @@ -640,58 +601,52 @@ static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, Uint flags, ca if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg); - mseg_destroy(mk->ma, flags, mk, c->seg, c->size); + mseg_destroy(ma, flags, c->seg, c->size); mseg_cache_clear_node(c); - erts_circleq_push_head(&(mk->cache_free), c); - - mk->segments.current.watermark--; - mk->cache_size--; + erts_circleq_push_head(&(ma->cache_free), c); + ma->segments.current.watermark--; + ma->cache_size--; } - ASSERT( mk->cache_size >= 0 ); + ASSERT(ma->cache_size >= 0); - return mk->cache_size; + return ma->cache_size; } -/* mseg_check_memkind_cache - * - Check if we can empty some cached segments in this - * MemKind. +/* mseg_check_cache + * - Check if we can empty some cached segments in this allocator */ -static Uint mseg_check_memkind_cache(MemKind *mk) { +static Uint mseg_check_cache(ErtsMsegAllctr_t *ma) { int i; - ERTS_DBG_MK_CHK_THR_ACCESS(mk); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); for (i = 0; i < CACHE_AREAS; i++) { - if (!erts_circleq_is_empty(&(mk->cache_powered_node[i]))) - return mseg_drop_one_memkind_cache_size(mk, ERTS_MSEG_FLG_2POW, &(mk->cache_powered_node[i])); + if (!erts_circleq_is_empty(&(ma->cache_powered_node[i]))) + return mseg_drop_one_cache_size(ma, ERTS_MSEG_FLG_2POW, &(ma->cache_powered_node[i])); } - if (!erts_circleq_is_empty(&(mk->cache_unpowered_node))) - return mseg_drop_one_memkind_cache_size(mk, ERTS_MSEG_FLG_NONE, &(mk->cache_unpowered_node)); + if (!erts_circleq_is_empty(&(ma->cache_unpowered_node))) + return mseg_drop_one_cache_size(ma, ERTS_MSEG_FLG_NONE, &(ma->cache_unpowered_node)); return 0; } /* mseg_cache_check * - Check if we have some cache we can purge - * in any of the memkinds. */ static void mseg_cache_check(ErtsMsegAllctr_t *ma) { - MemKind* mk; Uint empty_cache = 1; ERTS_MSEG_LOCK(ma); - for (mk = ma->mk_list; mk; mk = mk->next) { - if (mseg_check_memkind_cache(mk)) - empty_cache = 0; - } + if (mseg_check_cache(ma)) + empty_cache = 0; /* If all MemKinds caches are empty, * remove aux-work callback @@ -709,7 +664,7 @@ static void mseg_cache_check(ErtsMsegAllctr_t *ma) { /* erts_mseg_cache_check * - This is a callback that is scheduled as aux-work from * schedulers and is called at some interval if we have a cache - * on this mseg-allocator and memkind. + * on this mseg-allocator. * - Purpose: Empty cache slowly so we don't collect mapped areas * and bloat memory. */ @@ -719,42 +674,32 @@ void erts_mseg_cache_check(void) { } -/* *_mseg_clear_*_cache +/* mseg_clear_cache * Remove cached segments from the allocator completely */ -static void mseg_clear_memkind_cache(MemKind *mk) { + +static void mseg_clear_cache(ErtsMsegAllctr_t *ma) { int i; + ERTS_MSEG_LOCK(ma); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); /* drop pow2 caches */ for (i = 0; i < CACHE_AREAS; i++) { - if (erts_circleq_is_empty(&(mk->cache_powered_node[i]))) + if (erts_circleq_is_empty(&(ma->cache_powered_node[i]))) continue; - mseg_drop_memkind_cache_size(mk, ERTS_MSEG_FLG_2POW, &(mk->cache_powered_node[i])); - ASSERT(erts_circleq_is_empty(&(mk->cache_powered_node[i]))); + mseg_drop_cache_size(ma, ERTS_MSEG_FLG_2POW, &(ma->cache_powered_node[i])); + ASSERT(erts_circleq_is_empty(&(ma->cache_powered_node[i]))); } /* drop varied caches */ - if (!erts_circleq_is_empty(&(mk->cache_unpowered_node))) - mseg_drop_memkind_cache_size(mk, ERTS_MSEG_FLG_NONE, &(mk->cache_unpowered_node)); - - ASSERT(erts_circleq_is_empty(&(mk->cache_unpowered_node))); - ASSERT(mk->cache_size == 0); -} - -static void mseg_clear_cache(ErtsMsegAllctr_t *ma) { - MemKind* mk; - - ERTS_MSEG_LOCK(ma); - ERTS_DBG_MA_CHK_THR_ACCESS(ma); + if (!erts_circleq_is_empty(&(ma->cache_unpowered_node))) + mseg_drop_cache_size(ma, ERTS_MSEG_FLG_NONE, &(ma->cache_unpowered_node)); - - for (mk = ma->mk_list; mk; mk = mk->next) { - mseg_clear_memkind_cache(mk); - } + ASSERT(erts_circleq_is_empty(&(ma->cache_unpowered_node))); + ASSERT(ma->cache_size == 0); INC_CC(ma, clear_cache); - ERTS_MSEG_UNLOCK(ma); } @@ -763,25 +708,12 @@ void erts_mseg_clear_cache(void) { mseg_clear_cache(ERTS_MSEG_ALLCTR_IX(0)); } - - -static ERTS_INLINE MemKind* memkind(ErtsMsegAllctr_t *ma, - const ErtsMsegOpt_t *opt) -{ -#if HALFWORD_HEAP - return opt->low_mem ? &ma->low_mem : &ma->hi_mem; -#else - return &ma->the_mem; -#endif -} - static void * mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, UWord *size_p, Uint flags, const ErtsMsegOpt_t *opt) { UWord size; void *seg; - MemKind* mk = memkind(ma, opt); INC_CC(ma, alloc); @@ -795,10 +727,10 @@ mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, UWord *size_p, } } - if (opt->cache && mk->cache_size > 0 && (seg = cache_get_segment(mk, &size, flags)) != NULL) + if (opt->cache && ma->cache_size > 0 && (seg = cache_get_segment(ma, &size, flags)) != NULL) goto done; - seg = mseg_create(ma, flags, mk, &size); + seg = mseg_create(ma, flags, &size); if (!seg) *size_p = 0; @@ -808,7 +740,7 @@ done: if (erts_mtrace_enabled) erts_mtrace_crr_alloc(seg, atype, ERTS_MTRACE_SEGMENT_ID, size); - ERTS_MSEG_ALLOC_STAT(mk,size); + ERTS_MSEG_ALLOC_STAT(ma,size); } return seg; @@ -819,11 +751,9 @@ static void mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, UWord size, Uint flags, const ErtsMsegOpt_t *opt) { - MemKind* mk = memkind(ma, opt); - - ERTS_MSEG_DEALLOC_STAT(mk,size); + ERTS_MSEG_DEALLOC_STAT(ma,size); - if (opt->cache && cache_bless_segment(mk, seg, size, flags)) { + if (opt->cache && cache_bless_segment(ma, seg, size, flags)) { schedule_cache_check(ma); goto done; } @@ -831,7 +761,7 @@ mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, UWord size, if (erts_mtrace_enabled) erts_mtrace_crr_free(atype, SEGTYPE, seg); - mseg_destroy(ma, flags, mk, seg, size); + mseg_destroy(ma, flags, seg, size); done: @@ -842,7 +772,6 @@ static void * mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, UWord old_size, UWord *new_size_p, Uint flags, const ErtsMsegOpt_t *opt) { - MemKind* mk; void *new_seg; UWord new_size; @@ -861,7 +790,6 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, return NULL; } - mk = memkind(ma, opt); new_seg = seg; if (!MSEG_FLG_IS_2POW(flags)) @@ -876,7 +804,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, if (new_size > old_size) { if (opt->preserv) { - new_seg = mseg_recreate(ma, flags, mk, (void *) seg, old_size, &new_size); + new_seg = mseg_recreate(ma, flags, (void *) seg, old_size, &new_size); if (!new_seg) new_size = old_size; } @@ -896,7 +824,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, new_size = old_size; } else { - new_seg = mseg_recreate(ma, flags, mk, (void *) seg, old_size, &new_size); + new_seg = mseg_recreate(ma, flags, (void *) seg, old_size, &new_size); if (!new_seg) new_size = old_size; } @@ -910,7 +838,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, ASSERT(!MSEG_FLG_IS_2POW(flags) || IS_2POW(new_size)); *new_size_p = new_size; - ERTS_MSEG_REALLOC_STAT(mk, old_size, new_size); + ERTS_MSEG_REALLOC_STAT(ma, old_size, new_size); return new_seg; } @@ -1070,7 +998,8 @@ info_options(ErtsMsegAllctr_t *ma, { Eterm res; - res = erts_mmap_info_options(prefix, print_to_p, print_to_arg, hpp, szp); + res = erts_mmap_info_options(&erts_dflt_mmapper, + prefix, print_to_p, print_to_arg, hpp, szp); if (print_to_p) { int to = *print_to_p; @@ -1180,63 +1109,63 @@ info_calls(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp } static Eterm -info_status(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, void *print_to_arg, +info_status(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, int begin_new_max_period, Uint **hpp, Uint *szp) { Eterm res = THE_NON_VALUE; - if (mk->segments.max_ever.no < mk->segments.max.no) - mk->segments.max_ever.no = mk->segments.max.no; - if (mk->segments.max_ever.sz < mk->segments.max.sz) - mk->segments.max_ever.sz = mk->segments.max.sz; + if (ma->segments.max_ever.no < ma->segments.max.no) + ma->segments.max_ever.no = ma->segments.max.no; + if (ma->segments.max_ever.sz < ma->segments.max.sz) + ma->segments.max_ever.sz = ma->segments.max.sz; if (print_to_p) { int to = *print_to_p; void *arg = print_to_arg; - erts_print(to, arg, "cached_segments: %beu\n", mk->cache_size); - erts_print(to, arg, "cache_hits: %beu\n", mk->cache_hits); + erts_print(to, arg, "cached_segments: %beu\n", ma->cache_size); + erts_print(to, arg, "cache_hits: %beu\n", ma->cache_hits); erts_print(to, arg, "segments: %beu %beu %beu\n", - mk->segments.current.no, mk->segments.max.no, mk->segments.max_ever.no); + ma->segments.current.no, ma->segments.max.no, ma->segments.max_ever.no); erts_print(to, arg, "segments_size: %beu %beu %beu\n", - mk->segments.current.sz, mk->segments.max.sz, mk->segments.max_ever.sz); + ma->segments.current.sz, ma->segments.max.sz, ma->segments.max_ever.sz); erts_print(to, arg, "segments_watermark: %beu\n", - mk->segments.current.watermark); + ma->segments.current.watermark); } if (hpp || szp) { res = NIL; add_2tup(hpp, szp, &res, am.segments_watermark, - bld_unstable_uint(hpp, szp, mk->segments.current.watermark)); + bld_unstable_uint(hpp, szp, ma->segments.current.watermark)); add_4tup(hpp, szp, &res, am.segments_size, - bld_unstable_uint(hpp, szp, mk->segments.current.sz), - bld_unstable_uint(hpp, szp, mk->segments.max.sz), - bld_unstable_uint(hpp, szp, mk->segments.max_ever.sz)); + bld_unstable_uint(hpp, szp, ma->segments.current.sz), + bld_unstable_uint(hpp, szp, ma->segments.max.sz), + bld_unstable_uint(hpp, szp, ma->segments.max_ever.sz)); add_4tup(hpp, szp, &res, am.segments, - bld_unstable_uint(hpp, szp, mk->segments.current.no), - bld_unstable_uint(hpp, szp, mk->segments.max.no), - bld_unstable_uint(hpp, szp, mk->segments.max_ever.no)); + bld_unstable_uint(hpp, szp, ma->segments.current.no), + bld_unstable_uint(hpp, szp, ma->segments.max.no), + bld_unstable_uint(hpp, szp, ma->segments.max_ever.no)); add_2tup(hpp, szp, &res, am.cache_hits, - bld_unstable_uint(hpp, szp, mk->cache_hits)); + bld_unstable_uint(hpp, szp, ma->cache_hits)); add_2tup(hpp, szp, &res, am.cached_segments, - bld_unstable_uint(hpp, szp, mk->cache_size)); + bld_unstable_uint(hpp, szp, ma->cache_size)); } if (begin_new_max_period) { - mk->segments.max.no = mk->segments.current.no; - mk->segments.max.sz = mk->segments.current.sz; + ma->segments.max.no = ma->segments.current.no; + ma->segments.max.sz = ma->segments.current.sz; } return res; } -static Eterm info_memkind(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, void *print_to_arg, +static Eterm info_memkind(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, int begin_max_per, Uint **hpp, Uint *szp) { Eterm res = THE_NON_VALUE; @@ -1244,15 +1173,15 @@ static Eterm info_memkind(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, vo Eterm values[3]; if (print_to_p) { - erts_print(*print_to_p, print_to_arg, "memory kind: %s\n", mk->name); + erts_print(*print_to_p, print_to_arg, "memory kind: %s\n", "all memory"); } if (hpp || szp) { atoms[0] = am.name; atoms[1] = am.status; atoms[2] = am.calls; - values[0] = erts_bld_string(hpp, szp, mk->name); + values[0] = erts_bld_string(hpp, szp, "all memory"); } - values[1] = info_status(ma, mk, print_to_p, print_to_arg, begin_max_per, hpp, szp); + values[1] = info_status(ma, print_to_p, print_to_arg, begin_max_per, hpp, szp); values[2] = info_calls(ma, print_to_p, print_to_arg, hpp, szp); if (hpp || szp) @@ -1261,7 +1190,6 @@ static Eterm info_memkind(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, vo return res; } - static Eterm info_version(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) { @@ -1326,12 +1254,7 @@ erts_mseg_info(int ix, ERTS_MSEG_LOCK(ma); ERTS_DBG_MA_CHK_THR_ACCESS(ma); -#if HALFWORD_HEAP - values[n++] = info_memkind(ma, &ma->low_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); - values[n++] = info_memkind(ma, &ma->hi_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); -#else - values[n++] = info_memkind(ma, &ma->the_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); -#endif + values[n++] = info_memkind(ma, print_to_p, print_to_arg, begin_max_per, hpp, szp); if (hpp || szp) res = bld_2tup_list(hpp, szp, n, atoms, values); @@ -1408,13 +1331,10 @@ Uint erts_mseg_no(const ErtsMsegOpt_t *opt) { ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt); - MemKind* mk; - Uint n = 0; + Uint n; ERTS_MSEG_LOCK(ma); ERTS_DBG_MA_CHK_THR_ACCESS(ma); - for (mk=ma->mk_list; mk; mk=mk->next) { - n += mk->segments.current.no; - } + n = ma->segments.current.no; ERTS_MSEG_UNLOCK(ma); return n; } @@ -1426,16 +1346,16 @@ erts_mseg_unit_size(void) } -static void mem_kind_init(ErtsMsegAllctr_t *ma, MemKind* mk, const char* name) +static void mem_cache_init(ErtsMsegAllctr_t *ma) { int i; /* Clear all cache headers */ - mseg_cache_clear_node(&(mk->cache_free)); - mseg_cache_clear_node(&(mk->cache_unpowered_node)); + mseg_cache_clear_node(&(ma->cache_free)); + mseg_cache_clear_node(&(ma->cache_unpowered_node)); for (i = 0; i < CACHE_AREAS; i++) { - mseg_cache_clear_node(&(mk->cache_powered_node[i])); + mseg_cache_clear_node(&(ma->cache_powered_node[i])); } /* Populate cache free list */ @@ -1443,25 +1363,20 @@ static void mem_kind_init(ErtsMsegAllctr_t *ma, MemKind* mk, const char* name) ASSERT(ma->max_cache_size <= MAX_CACHE_SIZE); for (i = 0; i < ma->max_cache_size; i++) { - mseg_cache_clear_node(&(mk->cache[i])); - erts_circleq_push_head(&(mk->cache_free), &(mk->cache[i])); + mseg_cache_clear_node(&(ma->cache[i])); + erts_circleq_push_head(&(ma->cache_free), &(ma->cache[i])); } - mk->cache_size = 0; - mk->cache_hits = 0; - - mk->segments.current.watermark = 0; - mk->segments.current.no = 0; - mk->segments.current.sz = 0; - mk->segments.max.no = 0; - mk->segments.max.sz = 0; - mk->segments.max_ever.no = 0; - mk->segments.max_ever.sz = 0; - - mk->ma = ma; - mk->name = name; - mk->next = ma->mk_list; - ma->mk_list = mk; + ma->cache_size = 0; + ma->cache_hits = 0; + + ma->segments.current.watermark = 0; + ma->segments.current.no = 0; + ma->segments.current.sz = 0; + ma->segments.max.no = 0; + ma->segments.max.sz = 0; + ma->segments.max_ever.no = 0; + ma->segments.max_ever.sz = 0; } void @@ -1488,16 +1403,16 @@ erts_mseg_init(ErtsMsegInit_t *init) erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms"); -#if HALFWORD_HEAP - if (sizeof(void *) != 8) - erts_exit(1,"Halfword emulator cannot be run in 32bit mode"); - - init->mmap.virtual_range.start = (char *) sbrk(0); - init->mmap.virtual_range.end = (char *) 0x100000000UL; - init->mmap.sco = 0; +#ifdef ERTS_ALC_A_EXEC + /* Initialize erts_exec_mapper *FIRST*, to increase probability + * of getting low memory for HiPE AMD64's small code model. + */ + erts_mmap_init(&erts_exec_mmapper, &init->exec_mmap, 1); +#endif + erts_mmap_init(&erts_dflt_mmapper, &init->dflt_mmap, 0); +#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION) + erts_mmap_init(&erts_literal_mmapper, &init->literal_mmap, 0); #endif - - erts_mmap_init(&init->mmap); if (!IS_2POW(GET_PAGE_SIZE)) erts_exit(ERTS_ABORT_EXIT, "erts_mseg: Unexpected page_size %beu\n", GET_PAGE_SIZE); @@ -1529,14 +1444,7 @@ erts_mseg_init(ErtsMsegInit_t *init) if (ma->max_cache_size > MAX_CACHE_SIZE) ma->max_cache_size = MAX_CACHE_SIZE; - ma->mk_list = NULL; - -#if HALFWORD_HEAP - mem_kind_init(ma, &ma->low_mem, "low memory"); - mem_kind_init(ma, &ma->hi_mem, "high memory"); -#else - mem_kind_init(ma, &ma->the_mem, "all memory"); -#endif + mem_cache_init(ma); sys_memzero((void *) &ma->calls, sizeof(ErtsMsegCalls)); } @@ -1545,13 +1453,8 @@ erts_mseg_init(ErtsMsegInit_t *init) static ERTS_INLINE Uint tot_cache_size(ErtsMsegAllctr_t *ma) { - MemKind* mk; - Uint sz = 0; ERTS_DBG_MA_CHK_THR_ACCESS(ma); - for (mk=ma->mk_list; mk; mk=mk->next) { - sz += mk->cache_size; - } - return sz; + return ma->cache_size; } /* diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h index ba04e919fc..192e5767e4 100644 --- a/erts/emulator/sys/common/erl_mseg.h +++ b/erts/emulator/sys/common/erl_mseg.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2013. All Rights Reserved. + * Copyright Ericsson AB 2002-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -42,16 +42,6 @@ #if ERTS_HAVE_MSEG_SUPER_ALIGNED # define MSEG_ALIGN_BITS ERTS_MMAP_SUPERALIGNED_BITS -#else -/* If we don't use super aligned multiblock carriers - * we will mmap with page size alignment (and thus use corresponding - * align bits). - * - * Current implementation needs this to be a constant and - * only uses this for user dev testing so setting page size - * to 4096 (12 bits) is fine. - */ -# define MSEG_ALIGN_BITS (12) #endif #if HAVE_ERTS_MSEG @@ -69,7 +59,9 @@ typedef struct { Uint rmcbf; Uint mcs; Uint nos; - ErtsMMapInit mmap; + ErtsMMapInit dflt_mmap; + ErtsMMapInit literal_mmap; + ErtsMMapInit exec_mmap; } ErtsMsegInit_t; #define ERTS_MSEG_INIT_DEFAULT_INITIALIZER \ @@ -78,7 +70,9 @@ typedef struct { 20, /* rmcbf: Relative max cache bad fit */ \ 10, /* mcs: Max cache size */ \ 1000, /* cci: Cache check interval */ \ - ERTS_MMAP_INIT_DEFAULT_INITER \ + ERTS_MMAP_INIT_DEFAULT_INITER, \ + ERTS_MMAP_INIT_LITERAL_INITER, \ + ERTS_MMAP_INIT_HIPE_EXEC_INITER \ } typedef struct { @@ -87,9 +81,6 @@ typedef struct { UWord abs_shrink_th; UWord rel_shrink_th; int sched_spec; -#if HALFWORD_HEAP - int low_mem; -#endif } ErtsMsegOpt_t; extern const ErtsMsegOpt_t erts_mseg_default_opt; diff --git a/erts/emulator/sys/common/erl_mtrace_sys_wrap.c b/erts/emulator/sys/common/erl_mtrace_sys_wrap.c index a8c575835a..fc871f94f1 100644 --- a/erts/emulator/sys/common/erl_mtrace_sys_wrap.c +++ b/erts/emulator/sys/common/erl_mtrace_sys_wrap.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/sys/common/erl_os_monotonic_time_extender.c b/erts/emulator/sys/common/erl_os_monotonic_time_extender.c index 367b22d989..d53190fdd5 100644 --- a/erts/emulator/sys/common/erl_os_monotonic_time_extender.c +++ b/erts/emulator/sys/common/erl_os_monotonic_time_extender.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2015. All Rights Reserved. + * Copyright Ericsson AB 2015-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index 21fa214364..e394d84f73 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2013. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -74,6 +74,7 @@ #include "erl_thr_progress.h" #include "erl_driver.h" #include "erl_alloc.h" +#include "erl_msacc.h" #if !defined(ERTS_POLL_USE_EPOLL) \ && !defined(ERTS_POLL_USE_DEVPOLL) \ @@ -2238,6 +2239,7 @@ static ERTS_INLINE int check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) { int res; + ERTS_MSACC_PUSH_STATE_M(); if (erts_smp_atomic_read_nob(&ps->no_of_user_fds) == 0 && timeout_time == ERTS_POLL_NO_TIMEOUT) { /* Nothing to poll and zero timeout; done... */ @@ -2259,6 +2261,7 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) #ifdef ERTS_SMP erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); timerfd_set(ps, &its); res = epoll_wait(ps->kp_fd, ps->res_events, max_res, -1); res = timerfd_clear(ps, res, max_res); @@ -2268,10 +2271,12 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) } #else /* !ERTS_POLL_USE_TIMERFD */ timeout = (int) get_timeout(ps, 1000, timeout_time); + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } res = epoll_wait(ps->kp_fd, ps->res_events, max_res, timeout); #endif /* !ERTS_POLL_USE_TIMERFD */ #elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */ @@ -2279,10 +2284,12 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) if (max_res > ps->res_events_len) grow_res_events(ps, max_res); timeout = get_timeout_timespec(ps, &ts, timeout_time); + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } res = kevent(ps->kp_fd, NULL, 0, ps->res_events, max_res, &ts); #endif /* ----------------------------------------- */ } @@ -2306,26 +2313,33 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) if (poll_res.dp_nfds > ps->res_events_len) grow_res_events(ps, poll_res.dp_nfds); poll_res.dp_fds = ps->res_events; + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } poll_res.dp_timeout = timeout; res = ioctl(ps->kp_fd, DP_POLL, &poll_res); #elif ERTS_POLL_USE_POLL && defined(HAVE_PPOLL) /* --- ppoll ---------------- */ struct timespec ts; timeout = get_timeout_timespec(ps, &ts, timeout_time); + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } res = ppoll(ps->poll_fds, ps->no_poll_fds, &ts, NULL); #elif ERTS_POLL_USE_POLL /* --- poll --------------------------------- */ timeout = (int) get_timeout(ps, 1000, timeout_time); + + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } res = poll(ps->poll_fds, ps->no_poll_fds, timeout); #elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */ SysTimeval to; @@ -2334,18 +2348,22 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) ERTS_FD_COPY(&ps->input_fds, &ps->res_input_fds); ERTS_FD_COPY(&ps->output_fds, &ps->res_output_fds); + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); + } res = ERTS_SELECT(ps->max_fd + 1, &ps->res_input_fds, &ps->res_output_fds, NULL, &to); #ifdef ERTS_SMP - if (timeout) + if (timeout) { erts_thr_progress_finalize_wait(NULL); + ERTS_MSACC_POP_STATE_M(); + } if (res < 0 && errno == EBADF && ERTS_POLLSET_HAVE_UPDATE_REQUESTS(ps)) { @@ -2380,10 +2398,12 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res) return res; #endif /* ----------------------------------------- */ } + if (timeout) { #ifdef ERTS_SMP - if (timeout) erts_thr_progress_finalize_wait(NULL); #endif + ERTS_MSACC_POP_STATE_M(); + } return res; } } diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h index bd3a46ef0f..c16122610d 100644 --- a/erts/emulator/sys/common/erl_poll.h +++ b/erts/emulator/sys/common/erl_poll.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2013. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -93,7 +93,7 @@ # if defined(ERTS_USE_POLL) # undef ERTS_POLL_USE_POLL # define ERTS_POLL_USE_POLL 1 -# elif !defined(__WIN32__) && !defined(__OSE__) +# elif !defined(__WIN32__) # undef ERTS_POLL_USE_SELECT # define ERTS_POLL_USE_SELECT 1 # endif @@ -104,31 +104,13 @@ typedef Uint32 ErtsPollEvents; #undef ERTS_POLL_EV_E2N -#if defined(__WIN32__) || defined(__OSE__) /* --- win32 or ose -------- */ +#if defined(__WIN32__) /* --- win32 --------------------------------------- */ #define ERTS_POLL_EV_IN 1 #define ERTS_POLL_EV_OUT 2 #define ERTS_POLL_EV_ERR 4 #define ERTS_POLL_EV_NVAL 8 -#ifdef __OSE__ - -typedef struct ErtsPollOseMsgList_ { - struct ErtsPollOseMsgList_ *next; - union SIGNAL *data; -} ErtsPollOseMsgList; - -struct erts_sys_fd_type { - SIGSELECT signo; - ErlDrvOseEventId id; - ErtsPollOseMsgList *msgs; - ErlDrvOseEventId (*resolve_signal)(union SIGNAL *sig); - ethr_mutex mtx; - void *extra; -}; - -#endif - #elif ERTS_POLL_USE_EPOLL /* --- epoll ------------------------------- */ #include <sys/epoll.h> diff --git a/erts/emulator/sys/common/erl_sys_common_misc.c b/erts/emulator/sys/common/erl_sys_common_misc.c index e292741bfa..79f87eb3a9 100644 --- a/erts/emulator/sys/common/erl_sys_common_misc.c +++ b/erts/emulator/sys/common/erl_sys_common_misc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2013. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/sys/common/erl_util_queue.h b/erts/emulator/sys/common/erl_util_queue.h index b50e062dd5..73293e0225 100644 --- a/erts/emulator/sys/common/erl_util_queue.h +++ b/erts/emulator/sys/common/erl_util_queue.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2013. All Rights Reserved. + * Copyright Ericsson AB 2013-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/sys/ose/beam.lmconf b/erts/emulator/sys/ose/beam.lmconf deleted file mode 100644 index 4ad46b01d9..0000000000 --- a/erts/emulator/sys/ose/beam.lmconf +++ /dev/null @@ -1,26 +0,0 @@ -OSE_LM_STACK_SIZES=256,512,1024,2048,4096,8192,16384,65536 -OSE_LM_SIGNAL_SIZES=31,63,127,255,1023,4095,16383,65535 -OSE_LM_POOL_SIZE=0x200000 -OSE_LM_MAIN_NAME=main -OSE_LM_MAIN_STACK_SIZE=0xF000 -OSE_LM_MAIN_PRIORITY=20 -## Has to be of a type that allows MAM -OSE_LM_PROGRAM_TYPE=APP_RAM -OSE_LM_DATA_INIT=YES -OSE_LM_BSS_INIT=YES -OSE_LM_EXEC_MODEL=SHARED -HEAP_MAX_SIZE=1000000000 -HEAP_SMALL_BUF_INIT_SIZE=20971520 -HEAP_LARGE_BUF_THRESHOLD=16000000 -HEAP_LOCK_TYPE=2 - -ERTS_DEFAULT_PRIO=24 -ERTS_SCHEDULER_PRIO=24 -ERTS_ASYNC_PRIO=22 -ERTS_AUX_PRIO=24 -ERTS_SYS_MSG_DISPATCHER_PRIO=21 - -# Setting the environment variable EFS_RESOLVE_TMO on the block to 0. -# This will eliminiate delays when trying to open files on not mounted -# volumes. -EFS_RESOLVE_TMO=0 diff --git a/erts/emulator/sys/ose/driver_int.h b/erts/emulator/sys/ose/driver_int.h deleted file mode 100644 index 4a5b7171d1..0000000000 --- a/erts/emulator/sys/ose/driver_int.h +++ /dev/null @@ -1,42 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2009. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * System dependant driver declarations - */ - -#ifndef __DRIVER_INT_H__ -#define __DRIVER_INT_H__ - -#ifdef HAVE_SYS_UIO_H -#include <sys/types.h> -#include <sys/uio.h> - -typedef struct iovec SysIOVec; - -#else - -typedef struct { - char* iov_base; - int iov_len; -} SysIOVec; - -#endif - -#endif diff --git a/erts/emulator/sys/ose/erl_main.c b/erts/emulator/sys/ose/erl_main.c deleted file mode 100644 index 877e85f43a..0000000000 --- a/erts/emulator/sys/ose/erl_main.c +++ /dev/null @@ -1,54 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2000-2009. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif -#include <stdlib.h> - -#include "sys.h" -#include "erl_vm.h" -#include "global.h" -#include "ose.h" - -int -main(int argc, char **argv) { - - (void)stdin;(void)stdout;(void)stderr; - - /* When starting using pm_create -c ARGV="-- -root ..", argv[0] is the first - part of ARGV and not the name of the executable. So we shuffle some - pointers here to make erl_start happy. */ - if (argv[0][0] == '-') { - int i; - char **tmp_argv = malloc(sizeof(char*)*(argc+1)); - for (i = 0; i < argc; i++) - tmp_argv[i+1] = argv[i]; - tmp_argv[0] = "beam"; - erl_start(argc+1,tmp_argv); - free(tmp_argv); - } else { - erl_start(argc,argv); - } - - stop(current_process()); - - return 0; -} diff --git a/erts/emulator/sys/ose/erl_ose_sys.h b/erts/emulator/sys/ose/erl_ose_sys.h deleted file mode 100644 index d0cd3180bf..0000000000 --- a/erts/emulator/sys/ose/erl_ose_sys.h +++ /dev/null @@ -1,356 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2011. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - * - * This file handles differences between different Unix systems. - * This should be the only place with conditional compilation - * depending on the type of OS. - */ - -#ifndef _ERL_OSE_SYS_H -#define _ERL_OSE_SYS_H - -#include "ose.h" -#undef NIL -#include "ramlog.h" -#include "erts.sig" - -#include "fcntl.h" -#include "math.h" -#include "stdio.h" -#include "stdlib.h" -#include "string.h" -#include "sys/param.h" -#include "sys/time.h" -#include "time.h" -#include "dirent.h" -#include "ethread.h" - -/* FIXME: configuration options */ -#define ERTS_SCHED_MIN_SPIN 1 -#define ERTS_SCHED_ONLY_POLL_SCHED_1 1 -#define ERTS_SCHED_FAIR 1 -#define NO_SYSCONF 1 -#define OPEN_MAX FOPEN_MAX - -#define MAP_ANON MAP_ANONYMOUS - -#ifndef HAVE_MMAP -# define HAVE_MMAP 0 -#endif - -#if HAVE_MMAP -# include "sys/mman.h" -#endif - -/* - * Min number of async threads - */ -#define ERTS_MIN_NO_OF_ASYNC_THREADS 1 - -/* - * Our own type of "FD's" - */ -#define ERTS_SYS_FD_TYPE struct erts_sys_fd_type* -#define NO_FSTAT_ON_SYS_FD_TYPE 1 /* They are signals, not files */ - -#include "sys/stat.h" - -/* FIXME mremap is not defined in OSE - POSIX issue */ -extern void *mremap (void *__addr, size_t __old_len, size_t __new_len, - int __flags, ...); - -/* FIXME: mremap constants */ -#define MREMAP_MAYMOVE 1 -#define MREMAP_FIXED 2 - -typedef void *GETENV_STATE; - -/* -** For the erl_timer_sup module. -*/ -#define HAVE_GETHRTIME - -typedef long long SysHrTime; -extern SysHrTime sys_gethrtime(void); - -void sys_init_hrtime(void); - -typedef time_t erts_time_t; - -typedef struct timeval SysTimeval; - -#define sys_gettimeofday(Arg) ((void) gettimeofday((Arg), NULL)) - -typedef struct { - clock_t tms_utime; - clock_t tms_stime; - clock_t tms_cutime; - clock_t tms_cstime; -} SysTimes; - -extern int erts_ticks_per_sec; - -#define SYS_CLK_TCK (erts_ticks_per_sec) - -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 -#ifdef ERTS_SMP -#define erts_thread_init_fp_exception() do{}while(0) -#endif -# define __ERTS_FP_CHECK_INIT(fpexnp) do {} while (0) -# define __ERTS_FP_ERROR(fpexnp, f, Action) if (!finite(f)) { Action; } else {} -# define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) __ERTS_FP_ERROR(fpexnp, f, Action) -# define __ERTS_SAVE_FP_EXCEPTION(fpexnp) -# define __ERTS_RESTORE_FP_EXCEPTION(fpexnp) - -#define erts_sys_block_fpe() 0 -#define erts_sys_unblock_fpe(x) do{}while(0) - -#else /* !NO_FPE_SIGNALS */ - -extern volatile unsigned long *erts_get_current_fp_exception(void); -#ifdef ERTS_SMP -extern void erts_thread_init_fp_exception(void); -#endif -# if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__) -# define erts_fwait(fpexnp,f) \ - __asm__ __volatile__("fwait" : "=m"(*(fpexnp)) : "m"(f)) -# elif (defined(__powerpc__) || defined(__ppc__)) && defined(__GNUC__) -# define erts_fwait(fpexnp,f) \ - __asm__ __volatile__("" : "=m"(*(fpexnp)) : "fm"(f)) -# elif defined(__sparc__) && defined(__linux__) && defined(__GNUC__) -# define erts_fwait(fpexnp,f) \ - __asm__ __volatile__("" : "=m"(*(fpexnp)) : "em"(f)) -# else -# define erts_fwait(fpexnp,f) \ - __asm__ __volatile__("" : "=m"(*(fpexnp)) : "g"(f)) -# endif -# if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__) - extern void erts_restore_fpu(void); -# else -# define erts_restore_fpu() /*empty*/ -# endif -# if (!defined(__GNUC__) || \ - (__GNUC__ < 2) || \ - (__GNUC__ == 2 && __GNUC_MINOR < 96)) && \ - !defined(__builtin_expect) -# define __builtin_expect(x, expected_value) (x) -# endif -static __inline__ int erts_check_fpe(volatile unsigned long *fp_exception, double f) -{ - erts_fwait(fp_exception, f); - if (__builtin_expect(*fp_exception == 0, 1)) - return 0; - *fp_exception = 0; - erts_restore_fpu(); - return 1; -} -# undef erts_fwait -# undef erts_restore_fpu -extern void erts_fp_check_init_error(volatile unsigned long *fp_exception); -static __inline__ void __ERTS_FP_CHECK_INIT(volatile unsigned long *fp_exception) -{ - if (__builtin_expect(*fp_exception == 0, 1)) - return; - erts_fp_check_init_error(fp_exception); -} -# define __ERTS_FP_ERROR(fpexnp, f, Action) do { if (erts_check_fpe((fpexnp),(f))) { Action; } } while (0) -# define __ERTS_SAVE_FP_EXCEPTION(fpexnp) unsigned long old_erl_fp_exception = *(fpexnp) -# define __ERTS_RESTORE_FP_EXCEPTION(fpexnp) \ - do { *(fpexnp) = old_erl_fp_exception; } while (0) - /* This is for library calls where we don't trust the external - code to always throw floating-point exceptions on errors. */ -static __inline__ int erts_check_fpe_thorough(volatile unsigned long *fp_exception, double f) -{ - return erts_check_fpe(fp_exception, f) || !finite(f); -} -# define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) \ - do { if (erts_check_fpe_thorough((fpexnp),(f))) { Action; } } while (0) - -int erts_sys_block_fpe(void); -void erts_sys_unblock_fpe(int); - -#endif /* !NO_FPE_SIGNALS */ - -#define ERTS_FP_CHECK_INIT(p) __ERTS_FP_CHECK_INIT(&(p)->fp_exception) -#define ERTS_FP_ERROR(p, f, A) __ERTS_FP_ERROR(&(p)->fp_exception, f, A) -#define ERTS_FP_ERROR_THOROUGH(p, f, A) __ERTS_FP_ERROR_THOROUGH(&(p)->fp_exception, f, A) - -/* FIXME: force HAVE_GETPAGESIZE and stub getpagesize */ -#ifndef HAVE_GETPAGESIZE -#define HAVE_GETPAGESIZE 1 -#endif - -extern int getpagesize(void); - -#ifndef HZ -#define HZ 60 -#endif - -/* OSE5 doesn't provide limits.h so a number of macros should be - * added manually */ - -#ifndef CHAR_BIT -#define CHAR_BIT 8 -#endif - -/* Minimum and maximum values a `signed int' can hold. */ -#ifndef INT_MAX -#define INT_MAX 2147483647 -#endif - -#ifndef INT_MIN -#define INT_MIN (-INT_MAX - 1) -#endif - -#ifndef UINT_MAX -# define UINT_MAX 4294967295U -#endif - -/* -static void erts_ose_sys_send(union SIGNAL **signal,PROCESS dst, - char* file,int line) { - SIGSELECT **ziggy = (SIGSELECT**)signal; - printf("%s:%d 0x%x Send signal 0x%x(0x%x) to 0x%x\r\n", - file,line,current_process(),ziggy[0][0],*ziggy,dst); - send(signal,dst); -} -#define send(signal,dst) erts_ose_sys_send(signal,dst,__FILE__,__LINE__) - -static void erts_ose_sys_send_w_sender(union SIGNAL **signal, - PROCESS sender,PROCESS dst, - char* file,int line) { - SIGSELECT **ziggy = (SIGSELECT**)signal; - printf("%s:%d 0x%x Send signal 0x%x(0x%x) to 0x%x as 0x%x\r\n", - file,line,current_process(),ziggy[0][0],*ziggy,dst,sender); - send_w_sender(signal,sender,dst); -} -#define send_w_sender(signal,sender,dst) \ - erts_ose_sys_send_w_sender(signal,sender,dst,__FILE__,__LINE__) - - -static union SIGNAL *erts_ose_sys_receive(SIGSELECT *sigsel, - char *file, - int line) { - SIGSELECT *sig; - int i; - - printf("%s:%d 0x%x receive({%d,",file,line,current_process(),sigsel[0]); - for (i = 1; i < sigsel[0]; i++) - printf("0x%x, ",sigsel[i]); - if (sigsel[0] != 0) - printf("0x%x",sigsel[i]); - printf("})\n"); - sig = (SIGSELECT*)receive(sigsel); - printf("%s:%d 0x%x got 0x%x from 0x%x\n",file,line,current_process(), - *sig,sender((union SIGNAL**)(&sig))); - return (union SIGNAL*)sig; -} -#define receive(SIGSEL) erts_ose_sys_receive(SIGSEL,__FILE__,__LINE__) - -static union SIGNAL *erts_ose_sys_receive_w_tmo(OSTIME tmo,SIGSELECT *sigsel, - char *file,int line) { - SIGSELECT *sig; - int i; - if (tmo == 0) { - sig = (SIGSELECT*)receive_w_tmo(tmo,sigsel); - if (sig != NULL) { - printf("%s:%d 0x%x receive_w_tmo(0,{%d,",file,line,current_process(), - sigsel[0]); - for (i = 1; i < sigsel[0]; i++) - printf("0x%x, ",sigsel[i]); - if (sigsel[0] != 0) - printf("0x%x",sigsel[i]); - printf("})\n"); - printf("%s:%d 0x%x got 0x%x from 0x%x\n",file,line,current_process(), - *sig,sender((union SIGNAL**)(&sig))); - } - } else { - printf("%s:%d 0x%x receive_w_tmo(%u,{%d,",file,line,current_process(),tmo, - sigsel[0]); - for (i = 1; i < sigsel[0]; i++) - printf("0x%x, ",sigsel[i]); - if (sigsel[0] != 0) - printf("0x%x",sigsel[i]); - printf("})\n"); - sig = (SIGSELECT*)receive_w_tmo(tmo,sigsel); - printf("%s:%d 0x%x got ",file,line,current_process()); - if (sig == NULL) - printf("TIMEOUT\n"); - else - printf("0x%x from 0x%x\n",*sig,sender((union SIGNAL**)(&sig))); - } - - return (union SIGNAL*)sig; -} - -#define receive_w_tmo(tmo,sigsel) erts_ose_sys_receive_w_tmo(tmo,sigsel, \ - __FILE__,__LINE__) - -static union SIGNAL *erts_ose_sys_receive_fsem(OSTIME tmo,SIGSELECT *sigsel, - OSFSEMVAL fsem, - char *file,int line) { - SIGSELECT *sig; - int i; - if (tmo == 0) { - sig = (SIGSELECT*)receive_fsem(tmo,sigsel,fsem); - if (sig != NULL && sig != OS_RCV_FSEM) { - printf("%s:%d 0x%x receive_fsem(0,{%d,",file,line,current_process(), - sigsel[0]); - for (i = 1; i < sigsel[0]; i++) - printf("0x%x, ",sigsel[i]); - if (sigsel[0] != 0) - printf("0x%x",sigsel[i]); - printf("},%d)\n",fsem); - printf("%s:%d 0x%x got 0x%x from 0x%x\n",file,line,current_process(), - *sig,sender((union SIGNAL**)(&sig))); - } - } else { - printf("%s:%d 0x%x receive_fsem(%u,{%d,",file,line,current_process(),tmo, - sigsel[0]); - for (i = 1; i < sigsel[0]; i++) - printf("0x%x, ",sigsel[i]); - if (sigsel[0] != 0) - printf("0x%x",sigsel[i]); - printf("},%d)\n",fsem); - sig = (SIGSELECT*)receive_fsem(tmo,sigsel,fsem); - printf("%s:%d 0x%x got ",file,line,current_process()); - if (sig == NULL) - printf("TIMEOUT\n"); - else if (sig == OS_RCV_FSEM) - printf("FSEM\n"); - else - printf("0x%x from 0x%x\n",*sig,sender((union SIGNAL**)(&sig))); - } - - return (union SIGNAL*)sig; -} - -#define receive_fsem(tmo,sigsel,fsem) \ - erts_ose_sys_receive_fsem(tmo,sigsel,fsem,__FILE__,__LINE__) -*/ -#endif /* _ERL_OSE_SYS_H */ diff --git a/erts/emulator/sys/ose/erl_ose_sys_ddll.c b/erts/emulator/sys/ose/erl_ose_sys_ddll.c deleted file mode 100644 index 5051f7fcc1..0000000000 --- a/erts/emulator/sys/ose/erl_ose_sys_ddll.c +++ /dev/null @@ -1,127 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2006-2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * Interface functions to the dynamic linker using dl* functions. - * (No support in OSE, we use static linkage instead) - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#include "sys.h" -#include "erl_vm.h" -#include "global.h" - - -void erl_sys_ddll_init(void) { -} - -/* - * Open a shared object - */ -int erts_sys_ddll_open(const char *full_name, void **handle, ErtsSysDdllError* err) -{ - return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY; -} - -int erts_sys_ddll_open_noext(char *dlname, void **handle, ErtsSysDdllError* err) -{ - return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY; -} - -/* - * Find a symbol in the shared object - */ -int erts_sys_ddll_sym2(void *handle, const char *func_name, void **function, - ErtsSysDdllError* err) -{ - return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY; -} - -/* XXX:PaN These two will be changed with new driver interface! */ - -/* - * Load the driver init function, might appear under different names depending on object arch... - */ - -int erts_sys_ddll_load_driver_init(void *handle, void **function) -{ - void *fn; - int res; - if ((res = erts_sys_ddll_sym2(handle, "driver_init", &fn, NULL)) != ERL_DE_NO_ERROR) { - res = erts_sys_ddll_sym2(handle, "_driver_init", &fn, NULL); - } - if (res == ERL_DE_NO_ERROR) { - *function = fn; - } - return res; -} - -int erts_sys_ddll_load_nif_init(void *handle, void **function, ErtsSysDdllError* err) -{ - void *fn; - int res; - if ((res = erts_sys_ddll_sym2(handle, "nif_init", &fn, err)) != ERL_DE_NO_ERROR) { - res = erts_sys_ddll_sym2(handle, "_nif_init", &fn, err); - } - if (res == ERL_DE_NO_ERROR) { - *function = fn; - } - return res; -} - -/* - * Call the driver_init function, whatever it's really called, simple on unix... -*/ -void *erts_sys_ddll_call_init(void *function) { - void *(*initfn)(void) = function; - return (*initfn)(); -} -void *erts_sys_ddll_call_nif_init(void *function) { - return erts_sys_ddll_call_init(function); -} - - - -/* - * Close a chared object - */ -int erts_sys_ddll_close2(void *handle, ErtsSysDdllError* err) -{ - return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY; -} - - -/* - * Return string that describes the (current) error - */ -char *erts_sys_ddll_error(int code) -{ - return "Unspecified error"; -} - -void erts_sys_ddll_free_error(ErtsSysDdllError* err) -{ - if (err->str != NULL) { - erts_free(ERTS_ALC_T_DDLL_TMP_BUF, err->str); - } -} diff --git a/erts/emulator/sys/ose/erl_poll.c b/erts/emulator/sys/ose/erl_poll.c deleted file mode 100644 index c690f08dea..0000000000 --- a/erts/emulator/sys/ose/erl_poll.c +++ /dev/null @@ -1,818 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2006-2012. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * Description: Poll interface suitable for ERTS on OSE with or without - * SMP support. - * - * The interface is currently implemented using: - * - receive + receive_fsem - * - * Author: Lukas Larsson - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#include "erl_thr_progress.h" -#include "erl_driver.h" -#include "erl_alloc.h" -#include "erl_poll.h" - -#define NOFILE 4096 - -/* - * Some debug macros - */ - -/* #define HARDDEBUG -#define HARDTRACE*/ -#ifdef HARDDEBUG -#ifdef HARDTRACE -#define HARDTRACEF(X, ...) { fprintf(stderr, X, __VA_ARGS__); fprintf(stderr,"\r\n"); } -#else -#define HARDTRACEF(...) -#endif - -#else -#define HARDTRACEF(X,...) -#define HARDDEBUGF(...) -#endif - -#if 0 -#define ERTS_POLL_DEBUG_PRINT -#endif - -#if defined(DEBUG) && 0 -#define HARD_DEBUG -#endif - -# define SEL_ALLOC erts_alloc -# define SEL_REALLOC realloc_wrap -# define SEL_FREE erts_free - -#ifdef ERTS_SMP - -#define ERTS_POLLSET_LOCK(PS) \ - erts_smp_mtx_lock(&(PS)->mtx) -#define ERTS_POLLSET_UNLOCK(PS) \ - erts_smp_mtx_unlock(&(PS)->mtx) - -#else - -#define ERTS_POLLSET_LOCK(PS) -#define ERTS_POLLSET_UNLOCK(PS) - -#endif - -/* - * --- Data types ------------------------------------------------------------ - */ - -union SIGNAL { - SIGSELECT sig_no; -}; - -typedef struct erts_sigsel_item_ ErtsSigSelItem; - -struct erts_sigsel_item_ { - ErtsSigSelItem *next; - ErtsSysFdType fd; - ErtsPollEvents events; -}; - -typedef struct erts_sigsel_info_ ErtsSigSelInfo; - -struct erts_sigsel_info_ { - ErtsSigSelInfo *next; - SIGSELECT signo; - ErlDrvOseEventId (*decode)(union SIGNAL* sig); - ErtsSigSelItem *fds; -}; - -struct ErtsPollSet_ { - SIGSELECT *sigs; - ErtsSigSelInfo *info; - Uint sig_count; - Uint item_count; - PROCESS interrupt; - erts_atomic32_t wakeup_state; - erts_atomic64_t timeout_time; -#ifdef ERTS_SMP - erts_smp_mtx_t mtx; -#endif -}; - -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)) -#define ERTS_POLL_WOKEN_IO_READY ((erts_aint32_t) (1 << 3)) -#define ERTS_POLL_SLEEPING ((erts_aint32_t) (1 << 4)) - -/* signal list prototypes */ -static ErtsSigSelInfo *get_sigsel_info(ErtsPollSet ps, SIGSELECT signo); -static ErtsSigSelItem *get_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd); -static ErtsSigSelInfo *add_sigsel_info(ErtsPollSet ps, ErtsSysFdType fd, - ErlDrvOseEventId (*decode)(union SIGNAL* sig)); -static ErtsSigSelItem *add_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd, - ErlDrvOseEventId (*decode)(union SIGNAL* sig)); -static int del_sigsel_info(ErtsPollSet ps, ErtsSigSelInfo *info); -static int del_sigsel_item(ErtsPollSet ps, ErtsSigSelItem *item); -static int update_sigsel(ErtsPollSet ps); - -static ErtsSigSelInfo * -get_sigsel_info(ErtsPollSet ps, SIGSELECT signo) { - ErtsSigSelInfo *curr = ps->info; - while (curr != NULL) { - if (curr->signo == signo) - return curr; - curr = curr->next; - } - return NULL; -} - -static ErtsSigSelItem * -get_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd) { - ErtsSigSelInfo *info = get_sigsel_info(ps,fd->signo); - ErtsSigSelItem *curr; - - if (info == NULL) - return NULL; - - curr = info->fds; - - while (curr != NULL) { - if (curr->fd->id == fd->id) { - ASSERT(curr->fd->signo == fd->signo); - return curr; - } - curr = curr->next; - } - return NULL; -} - -static ErtsSigSelInfo * -add_sigsel_info(ErtsPollSet ps, ErtsSysFdType fd, - ErlDrvOseEventId (*decode)(union SIGNAL* sig)) { - ErtsSigSelInfo *info = SEL_ALLOC(ERTS_ALC_T_POLLSET, - sizeof(ErtsSigSelInfo)); - info->next = ps->info; - info->fds = NULL; - info->signo = fd->signo; - info->decode = decode; - ps->info = info; - ps->sig_count++; - return info; -} - -static ErtsSigSelItem * -add_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd, - ErlDrvOseEventId (*decode)(union SIGNAL* sig)) { - ErtsSigSelInfo *info = get_sigsel_info(ps,fd->signo); - ErtsSigSelItem *item = SEL_ALLOC(ERTS_ALC_T_POLLSET, - sizeof(ErtsSigSelItem)); - if (info == NULL) - info = add_sigsel_info(ps, fd, decode); - if (info->decode != decode) { - erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - erts_dsprintf(dsbufp, "erts_poll_control() inconsistency: multiple resolve_signal functions for same signal (%d)\n", - fd->signo); - erts_send_error_to_logger_nogl(dsbufp); - } - ASSERT(info->decode == decode); - item->next = info->fds; - item->fd = fd; - item->events = 0; - info->fds = item; - ps->item_count++; - return item; -} - -static int del_sigsel_info(ErtsPollSet ps, ErtsSigSelInfo *info) { - ErtsSigSelInfo *curr, *prev; - - if (ps->info == info) { - ps->info = ps->info->next; - } else { - curr = ps->info->next; - prev = ps->info; - - while (curr != info) { - if (curr == NULL) - return 1; - prev = curr; - curr = curr->next; - } - prev->next = curr->next; - } - - ps->sig_count--; - SEL_FREE(ERTS_ALC_T_POLLSET, info); - return 0; -} - -static int del_sigsel_item(ErtsPollSet ps, ErtsSigSelItem *item) { - ErtsSigSelInfo *info = get_sigsel_info(ps,item->fd->signo); - ErtsSigSelItem *curr, *prev; - - ps->item_count--; - ASSERT(ps->item_count >= 0); - - if (info->fds == item) { - info->fds = info->fds->next; - SEL_FREE(ERTS_ALC_T_POLLSET,item); - if (info->fds == NULL) - return del_sigsel_info(ps,info); - return 0; - } - - curr = info->fds->next; - prev = info->fds; - - while (curr != item) { - if (curr == NULL) { - /* We did not find an item to delete so we have to - * increment item count again. - */ - ps->item_count++; - return 1; - } - prev = curr; - curr = curr->next; - } - prev->next = curr->next; - SEL_FREE(ERTS_ALC_T_POLLSET,item); - return 0; -} - -#ifdef ERTS_SMP - -static void update_redir_tables(ErtsPollSet ps) { - struct OS_redir_entry *redir_table; - PROCESS sched_1 = ERTS_SCHEDULER_IX(0)->tid.id; - int i; - redir_table = SEL_ALLOC(ERTS_ALC_T_POLLSET, - sizeof(struct OS_redir_entry)*(ps->sig_count+1)); - - redir_table[0].sig = ps->sig_count+1; - redir_table[0].pid = 0; - - for (i = 1; i < ps->sig_count+1; i++) { - redir_table[i].sig = ps->sigs[i]; - redir_table[i].pid = sched_1; - } - - for (i = 1; i < erts_no_schedulers; i++) { - ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(i); - set_redirection(esdp->tid.id,redir_table); - } - - SEL_FREE(ERTS_ALC_T_POLLSET,redir_table); -} - -#endif - -static int update_sigsel(ErtsPollSet ps) { - ErtsSigSelInfo *info = ps->info; - - int i; - - if (ps->sigs != NULL) - SEL_FREE(ERTS_ALC_T_POLLSET,ps->sigs); - - if (ps->sig_count == 0) { - /* If there are no signals we place a non-valid signal to make sure that - * we do not trigger on a any unrelated signals which are sent to the - * process. - */ - ps->sigs = SEL_ALLOC(ERTS_ALC_T_POLLSET,sizeof(SIGSELECT)*(2)); - ps->sigs[0] = 1; - ps->sigs[1] = ERTS_SIGNAL_INVALID; - return 0; - } - - ps->sigs = SEL_ALLOC(ERTS_ALC_T_POLLSET,sizeof(SIGSELECT)*(ps->sig_count+1)); - ps->sigs[0] = ps->sig_count; - - for (i = 1; info != NULL; i++, info = info->next) - ps->sigs[i] = info->signo; - -#ifdef ERTS_SMP - update_redir_tables(ps); -#endif - - return 0; -} - -static ERTS_INLINE void -wake_poller(ErtsPollSet ps) -{ - erts_aint32_t wakeup_state; - - ERTS_THR_MEMORY_BARRIER; - wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state); - while (wakeup_state != ERTS_POLL_WOKEN_IO_READY - && wakeup_state != ERTS_POLL_WOKEN_INTR) { - erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state, - ERTS_POLL_WOKEN_INTR, - wakeup_state); - if (act == wakeup_state) { - wakeup_state = act; - break; - } - wakeup_state = act; - } - if (wakeup_state == ERTS_POLL_SLEEPING) { - /* - * Since we don't know the internals of signal_fsem() we issue - * a memory barrier as a safety precaution ensuring that - * the store we just made to wakeup_state wont be reordered - * with loads in signal_fsem(). - */ - ERTS_THR_MEMORY_BARRIER; - signal_fsem(ps->interrupt); - } -} - -static ERTS_INLINE void -reset_interrupt(ErtsPollSet ps) -{ - /* We need to keep io-ready if set */ - erts_aint32_t wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state); - while (wakeup_state != ERTS_POLL_NOT_WOKEN && - wakeup_state != ERTS_POLL_SLEEPING) { - erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state, - ERTS_POLL_NOT_WOKEN, - wakeup_state); - if (wakeup_state == act) - break; - wakeup_state = act; - } - ERTS_THR_MEMORY_BARRIER; -} - -static ERTS_INLINE void -set_interrupt(ErtsPollSet ps) -{ - wake_poller(ps); -} - -void erts_poll_interrupt(ErtsPollSet ps,int set) { - HARDTRACEF("erts_poll_interrupt called!\n"); - - if (!set) - reset_interrupt(ps); - else - set_interrupt(ps); - -} - -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 (get_timeout_time(ps) > timeout_time) - set_interrupt(ps); -} - -ErtsPollEvents erts_poll_control(ErtsPollSet ps, ErtsSysFdType fd, - ErtsPollEvents pe, int on, int* do_wake) { - ErtsSigSelItem *curr; - ErtsPollEvents new_events; - int old_sig_count; - - HARDTRACEF( - "%ux: In erts_poll_control, fd = %d, pe = %d, on = %d, *do_wake = %d, curr = 0x%xu", - ps, fd, pe, on, do_wake, curr); - - ERTS_POLLSET_LOCK(ps); - - if (on && (pe & ERTS_POLL_EV_IN) && (pe & ERTS_POLL_EV_OUT)) { - /* Check to make sure both in and out are not used at the same time */ - new_events = ERTS_POLL_EV_NVAL; - goto done; - } - - curr = get_sigsel_item(ps, fd); - old_sig_count = ps->sig_count; - - if (curr == NULL && on) { - curr = add_sigsel_item(ps, fd, fd->resolve_signal); - } else if (curr == NULL && !on) { - new_events = ERTS_POLL_EV_NVAL; - goto done; - } - - new_events = curr->events; - - if (pe == 0) { - *do_wake = 0; - goto done; - } - - if (on) { - new_events |= pe; - curr->events = new_events; - } else { - new_events &= ~pe; - curr->events = new_events; - if (new_events == 0 && del_sigsel_item(ps, curr)) { - new_events = ERTS_POLL_EV_NVAL; - goto done; - } - } - - if (ps->sig_count != old_sig_count) { - if (update_sigsel(ps)) - new_events = ERTS_POLL_EV_NVAL; - } -done: - ERTS_POLLSET_UNLOCK(ps); - HARDTRACEF("%ux: Out erts_poll_control", ps); - return new_events; -} - -int erts_poll_wait(ErtsPollSet ps, - 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(); - - ASSERT(current_process() == ps->interrupt); - ASSERT(get_fsem(current_process()) == 0); - ASSERT(erts_atomic32_read_nob(&ps->wakeup_state) & - (ERTS_POLL_NOT_WOKEN | ERTS_POLL_WOKEN_INTR)); - /* Max no of spots avable in pr */ - no_fds = *len; - - *len = 0; - - /* erts_printf("Entering erts_poll_wait(), timeout_time=%bps\n", - timeout_time); */ - - 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); - } - - set_timeout_time(ps, save_timeout_time); - - while (currid < no_fds) { - if (timeout > 0) { - erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state, - ERTS_POLL_SLEEPING, - ERTS_POLL_NOT_WOKEN); - if (act == ERTS_POLL_NOT_WOKEN) { -#ifdef ERTS_SMP - erts_thr_progress_prepare_wait(NULL); -#endif - sig = receive_fsem(timeout, ps->sigs, 1); -#ifdef ERTS_SMP - erts_thr_progress_finalize_wait(NULL); -#endif - } else { - ASSERT(act == ERTS_POLL_WOKEN_INTR); - sig = OS_RCV_FSEM; - } - } else - sig = receive_w_tmo(0, ps->sigs); - - if (sig == NULL) { - if (timeout > 0) { - erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state, - ERTS_POLL_WOKEN_TIMEDOUT, - ERTS_POLL_SLEEPING); - if (act == ERTS_POLL_WOKEN_INTR) - /* Restore fsem as it was signaled but we got a timeout */ - wait_fsem(1); - } else - erts_atomic32_cmpxchg_nob(&ps->wakeup_state, - ERTS_POLL_WOKEN_TIMEDOUT, - ERTS_POLL_NOT_WOKEN); - break; - } else if (sig == OS_RCV_FSEM) { - ASSERT(erts_atomic32_read_nob(&ps->wakeup_state) == ERTS_POLL_WOKEN_INTR); - break; - } - { - ErtsSigSelInfo *info = get_sigsel_info(ps, sig->sig_no); - struct erts_sys_fd_type fd = { sig->sig_no, info->decode(sig) }; - ErtsSigSelItem *item = get_sigsel_item(ps, &fd); - - ASSERT(sig); - if (currid == 0 && timeout > 0) { - erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state, - ERTS_POLL_WOKEN_IO_READY, - ERTS_POLL_SLEEPING); - if (act == ERTS_POLL_WOKEN_INTR) { - /* Restore fsem as it was signaled but we got a msg */ - wait_fsem(1); - act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state, - ERTS_POLL_WOKEN_IO_READY, - ERTS_POLL_WOKEN_INTR); - } - } else if (currid == 0) { - erts_atomic32_set_nob(&ps->wakeup_state, - ERTS_POLL_WOKEN_IO_READY); - } - - if (item == NULL) { - erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - erts_dsprintf( - dsbufp, - "erts_poll_wait() failed: found unkown signal id %d (signo %u) " - "(curr_proc 0x%x)\n", - fd.id, fd.signo, current_process()); - erts_send_error_to_logger_nogl(dsbufp); - timeout = 0; - /* Under normal circumstances the signal is deallocated by the - * driver that issued the select operation. But in this case - * there's no driver waiting for such signal so we have to - * deallocate it here */ - if (sig) - free_buf(&sig); - } else { - int i; - struct erts_sys_fd_type *fd = NULL; - ErtsPollOseMsgList *tl,*new; - - /* Check if this fd has already been triggered by a previous signal */ - for (i = 0; i < currid;i++) { - if (pr[i].fd == item->fd) { - fd = pr[i].fd; - pr[i].events |= item->events; - break; - } - } - - /* First time this fd is triggered */ - if (fd == NULL) { - pr[currid].fd = item->fd; - pr[currid].events = item->events; - fd = item->fd; - timeout = 0; - currid++; - } - - /* Insert new signal in approriate list */ - new = erts_alloc(ERTS_ALC_T_FD_SIG_LIST,sizeof(ErtsPollOseMsgList)); - new->next = NULL; - new->data = sig; - - ethr_mutex_lock(&fd->mtx); - tl = fd->msgs; - - if (tl == NULL) { - fd->msgs = new; - } else { - while (tl->next != NULL) - tl = tl->next; - tl->next = new; - } - ethr_mutex_unlock(&fd->mtx); - } - - } - } - - { - erts_aint32_t wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state); - - switch (wakeup_state) { - case ERTS_POLL_WOKEN_IO_READY: - res = 0; - break; - case ERTS_POLL_WOKEN_INTR: - res = EINTR; - break; - case ERTS_POLL_WOKEN_TIMEDOUT: - res = ETIMEDOUT; - break; - case ERTS_POLL_NOT_WOKEN: - /* This happens when we get an invalid signal only */ - res = EINVAL; - break; - default: - res = 0; - erts_exit(ERTS_ABORT_EXIT, - "%s:%d: Internal error: Invalid wakeup_state=%d\n", - __FILE__, __LINE__, (int) wakeup_state); - } - } - - erts_atomic32_set_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN); - set_timeout_time(ps, ERTS_MONOTONIC_TIME_MAX); - - *len = currid; - - // HARDTRACEF("%ux: Out erts_poll_wait",ps); - return res; -} - -int erts_poll_max_fds(void) -{ - - HARDTRACEF("In/Out erts_poll_max_fds -> %d",max_fds); - return max_fds; -} - -void erts_poll_info(ErtsPollSet ps, - ErtsPollInfo *pip) -{ - Uint size = 0; - Uint num_events = 0; - - size += sizeof(struct ErtsPollSet_); - size += sizeof(ErtsSigSelInfo)*ps->sig_count; - size += sizeof(ErtsSigSelItem)*ps->item_count; - size += sizeof(SIGSELECT)*(ps->sig_count+1); - - pip->primary = "receive_fsem"; - - pip->fallback = NULL; - - pip->kernel_poll = NULL; - - pip->memory_size = size; - - pip->poll_set_size = num_events; - - pip->fallback_poll_set_size = 0; - - pip->lazy_updates = 0; - - pip->pending_updates = 0; - - pip->batch_updates = 0; - - pip->concurrent_updates = 0; - - - pip->max_fds = erts_poll_max_fds(); - HARDTRACEF("%ux: Out erts_poll_info",ps); - -} - -ErtsPollSet erts_poll_create_pollset(void) -{ - ErtsPollSet ps = SEL_ALLOC(ERTS_ALC_T_POLLSET, - sizeof(struct ErtsPollSet_)); - - ps->sigs = NULL; - ps->sig_count = 0; - ps->item_count = 0; - ps->info = NULL; - ps->interrupt = (PROCESS)0; - erts_atomic32_init_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN); - init_timeout_time(ps); -#ifdef ERTS_SMP - erts_smp_mtx_init(&ps->mtx, "pollset"); -#endif - update_sigsel(ps); - HARDTRACEF("%ux: Out erts_poll_create_pollset",ps); - return ps; -} - -void erts_poll_destroy_pollset(ErtsPollSet ps) -{ - ErtsSigSelInfo *info; - for (info = ps->info; ps->info != NULL; info = ps->info, ps->info = ps->info->next) { - ErtsSigSelItem *item; - for (item = info->fds; info->fds != NULL; item = info->fds, info->fds = info->fds->next) - SEL_FREE(ERTS_ALC_T_POLLSET, item); - SEL_FREE(ERTS_ALC_T_POLLSET, info); - } - - SEL_FREE(ERTS_ALC_T_POLLSET,ps->sigs); - -#ifdef ERTS_SMP - erts_smp_mtx_destroy(&ps->mtx); -#endif - - SEL_FREE(ERTS_ALC_T_POLLSET,ps); -} - -void erts_poll_init(void) -{ - HARDTRACEF("In %s", __FUNCTION__); - max_fds = 256; - - HARDTRACEF("Out %s", __FUNCTION__); -} - - -/* OSE driver functions */ - -union SIGNAL *erl_drv_ose_get_signal(ErlDrvEvent drv_ev) { - struct erts_sys_fd_type *ev = (struct erts_sys_fd_type *)drv_ev; - ethr_mutex_lock(&ev->mtx); - if (ev->msgs == NULL) { - ethr_mutex_unlock(&ev->mtx); - return NULL; - } else { - ErtsPollOseMsgList *msg = ev->msgs; - union SIGNAL *sig = (union SIGNAL*)msg->data; - ASSERT(msg->data); - ev->msgs = msg->next; - ethr_mutex_unlock(&ev->mtx); - erts_free(ERTS_ALC_T_FD_SIG_LIST,msg); - restore(sig); - return sig; - } -} - -ErlDrvEvent -erl_drv_ose_event_alloc(SIGSELECT signo, ErlDrvOseEventId id, - ErlDrvOseEventId (*resolve_signal)(union SIGNAL *sig), void *extra) { - struct erts_sys_fd_type *ev = erts_alloc(ERTS_ALC_T_DRV_EV, - sizeof(struct erts_sys_fd_type)); - ev->signo = signo; - ev->extra = extra; - ev->id = id; - ev->msgs = NULL; - ev->resolve_signal = resolve_signal; - ethr_mutex_init(&ev->mtx); - return (ErlDrvEvent)ev; -} - -void erl_drv_ose_event_free(ErlDrvEvent drv_ev) { - struct erts_sys_fd_type *ev = (struct erts_sys_fd_type *)drv_ev; - ASSERT(ev->msgs == NULL); - ethr_mutex_destroy(&ev->mtx); - erts_free(ERTS_ALC_T_DRV_EV,ev); -} - -void erl_drv_ose_event_fetch(ErlDrvEvent drv_ev, SIGSELECT *signo, - ErlDrvOseEventId *id, void **extra) { - struct erts_sys_fd_type *ev = (struct erts_sys_fd_type *)drv_ev; - if (signo) - *signo = ev->signo; - if (extra) - *extra = ev->extra; - if (id) - *id = ev->id; -} diff --git a/erts/emulator/sys/ose/erts.sig b/erts/emulator/sys/ose/erts.sig deleted file mode 100644 index 78b883ee6c..0000000000 --- a/erts/emulator/sys/ose/erts.sig +++ /dev/null @@ -1,17 +0,0 @@ -#ifndef ERTS_OSE_SIGNALS -#define ERTS_OSE_SIGNALS - -#ifndef ERTS_OSE_SIGNAL_BASE -#define ERTS_OSE_SIGNAL_BASE 0x01900280 -#endif - -#define ERTS_SIGNAL_INVALID ERTS_OSE_SIGNAL_BASE -#define ERTS_SIGNAL_FD_DRV_CONFIG ERTS_OSE_SIGNAL_BASE+1 -#define ERTS_SIGNAL_FD_DRV_ASYNC ERTS_OSE_SIGNAL_BASE+2 -#define ERTS_SIGNAL_OSE_DRV_ATTACH ERTS_OSE_SIGNAL_BASE+3 -#define ERTS_SIGNAL_OSE_DRV_HUNT ERTS_OSE_SIGNAL_BASE+4 - -#define ERTS_SIGNAL_RUN_ERL_SETUP ERTS_OSE_SIGNAL_BASE+100 -#define ERTS_SIGNAL_RUN_ERL_DAEMON ERTS_OSE_SIGNAL_BASE+101 - -#endif diff --git a/erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf b/erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf deleted file mode 100644 index a19d23facf..0000000000 --- a/erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf +++ /dev/null @@ -1,182 +0,0 @@ -/******************************************************************************* - * Copyright (C) 2013-2014 by Enea Software AB, - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * - * 3. Neither the name of the copyright holder nor the names of its contributors - * may be used to endorse or promote products derived from this software - * without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - * POSSIBILITY OF SUCH DAMAGE. - ******************************************************************************/ - -OUTPUT_FORMAT("elf32-powerpc", "elf32-powerpc", "elf32-powerpc") -OUTPUT_ARCH("powerpc") -ENTRY("crt0_lm") -MEMORY -{ - rom : ORIGIN = 0x01000000, LENGTH = 0x01000000 - ram : ORIGIN = 0x02000000, LENGTH = 0x01000000 -} -PHDRS -{ - ph_conf PT_LOAD ; - ph_rom PT_LOAD ; - ph_ram PT_LOAD ; -} -SECTIONS -{ - .text : - { - *(.text_first) - *(.text) - *(.text.*) - *(.stub) - *(oscode) - *(.init*) - *(.fini*) - *(.gnu.warning) - *(.gnu.linkonce.t.*) - *(.glue_7t) - *(.glue_7) - } > rom :ph_rom = 0 - .ose_sfk_biosentry : - { - *(.ose_sfk_biosentry) - } > rom :ph_rom - .ctors : - { - __CTOR_LIST__ = .; - *(.ctors) - *(SORT(.ctors.*)) - __CTOR_END__ = .; - } > rom :ph_rom - .dtors : - { - __DTOR_LIST__ = .; - *(.dtors) - *(SORT(.dtors.*)) - __DTOR_END__ = .; - } > rom :ph_rom - OSESYMS : - { - *(.osesyms) - } > rom :ph_rom - .rodata : - { - *(.rodata) - *(.rodata.*) - *(.gnu.linkonce.r.*) - } > rom :ph_rom - .eh_frame_hdr : - { - *(.eh_frame_hdr) - } > rom :ph_rom - .eh_frame : - { - __EH_FRAME_BEGIN__ = .; - *(.eh_frame) - LONG(0) - __EH_FRAME_END__ = .; - } > rom :ph_rom - .gcc_except_table : - { - *(.gcc_except_table .gcc_except_table.*) - } > rom :ph_rom - .sdata2 : - { - PROVIDE (_SDA2_BASE_ = .); - *(.sdata2) - *(.sdata2.*) - *(.gnu.linkonce.s2.*) - } > rom :ph_rom - .sbss2 : - { - *(.sbss2) - *(.sbss2.*) - *(.gnu.linkonce.sb2.*) - } > rom :ph_rom - LMCONF : - { - obj/?*?/ose_confd.o(.rodata) - *(LMCONF) - } > rom :ph_conf - .data : - { - LONG(0xDEADBABE) - *(.data) - *(.data.*) - *(.gnu.linkonce.d.*) - SORT(CONSTRUCTORS) - . = ALIGN(0x10); - } > ram :ph_ram = 0 - .sdata2 : - { - _SDA2_BASE_ = .; - *(.sdata2 .sdata2.* .gnu.linkonce.s2.*) - }> ram :ph_ram - .sdata : - { - PROVIDE (_SDA_BASE_ = .); - *(.sdata) - *(.sdata.*) - *(.gnu.linkonce.s.*) - } > ram :ph_ram - .sbss : - { - *(.sbss) - *(.sbss.*) - *(.scommon) - *(.gnu.linkonce.sb.*) - } > ram :ph_ram - .bss (NOLOAD) : - { - *(.bss) - *(.bss.*) - *(COMMON) - *(.gnu.linkonce.b.*) - *(.osvars) - } > ram :ph_ram - .ignore (NOLOAD) : - { - *(.rel.dyn) - } > ram :ph_ram - .debug 0 : { *(.debug) } - .line 0 : { *(.line) } - .debug_srcinfo 0 : { *(.debug_srcinfo) } - .debug_sfnames 0 : { *(.debug_sfnames) } - .debug_aranges 0 : { *(.debug_aranges) } - .debug_pubnames 0 : { *(.debug_pubnames) } - .debug_info 0 : { *(.debug_info) *(.gnu.linkonce.wi.*) } - .debug_abbrev 0 : { *(.debug_abbrev) } - .debug_line 0 : { *(.debug_line) } - .debug_frame 0 : { *(.debug_frame) } - .debug_str 0 : { *(.debug_str) } - .debug_loc 0 : { *(.debug_loc) } - .debug_macinfo 0 : { *(.debug_macinfo) } - .debug_weaknames 0 : { *(.debug_weaknames) } - .debug_funcnames 0 : { *(.debug_funcnames) } - .debug_typenames 0 : { *(.debug_typenames) } - .debug_varnames 0 : { *(.debug_varnames) } -} -__OSESYMS_START = ADDR(OSESYMS); -__OSESYMS_END = ADDR(OSESYMS) + SIZEOF(OSESYMS); diff --git a/erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf b/erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf deleted file mode 100644 index 3440c2961b..0000000000 --- a/erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf +++ /dev/null @@ -1,242 +0,0 @@ -/******************************************************************************* - * Copyright (C) 2013-2014 by Enea Software AB, - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * - * 3. Neither the name of the copyright holder nor the names of its contributors - * may be used to endorse or promote products derived from this software - * without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - * POSSIBILITY OF SUCH DAMAGE. - ******************************************************************************/ - -OUTPUT_FORMAT("elf32-powerpc", "elf32-powerpc", "elf32-powerpc") -OUTPUT_ARCH("powerpc") - -ENTRY("crt0_lm") - -/* Note: - * You may have to increase the length of the "rom" memory region and the - * origin and length of the "ram" memory region below depending on the size - * of the code and data in your load module. - */ - -MEMORY -{ - conf : ORIGIN = 0x00100000, LENGTH = 0x00030000 - rom : ORIGIN = 0x01000000, LENGTH = 0x01000000 - ram : ORIGIN = 0x03000000, LENGTH = 0x01000000 -} - -PHDRS -{ - ph_conf PT_LOAD ; - ph_rom PT_LOAD ; - ph_ram PT_LOAD ; -} - -SECTIONS -{ -/*--------------------------------------------------------------------------- - * Load module configuration area - *-------------------------------------------------------------------------*/ - - /* Load module configuration section. */ - LMCONF : - { - obj/?*?/ose_confd.o(.rodata) - *(LMCONF) - } > conf :ph_conf - -/*--------------------------------------------------------------------------- - * Read-only area - *-------------------------------------------------------------------------*/ - - /* Code section. */ - .text : - { - *(.text) - *(.text.*) - *(.stub) - *(oscode) - *(.init*) - *(.fini*) - *(.gnu.warning) - *(.gnu.linkonce.t.*) - } > rom :ph_rom = 0 - - /* OSE symbols section. */ - OSESYMS : - { - *(.osesyms) - } > rom :ph_rom - - /* Read-only data section. */ - .rodata : - { - *(.rodata) - *(.rodata.*) - *(.gnu.linkonce.r.*) - } > rom :ph_rom - - /* C++ exception handling section. */ - .eh_frame : - { - __EH_FRAME_BEGIN__ = .; - *(.eh_frame) - LONG(0) - __EH_FRAME_END__ = .; - } > rom :ph_rom - - /* C++ exception handling section. */ - .gcc_except_table : - { - *(.gcc_except_table .gcc_except_table.*) - } > rom :ph_rom - - /* PowerPC EABI initialized read-only data section. */ - .sdata2 : - { - PROVIDE (_SDA2_BASE_ = .); - *(.sdata2) - *(.sdata2.*) - *(.gnu.linkonce.s2.*) - } > rom :ph_rom - - /* PowerPC EABI uninitialized read-only data section. */ - .sbss2 : - { - *(.sbss2) - *(.sbss2.*) - *(.gnu.linkonce.sb2.*) - } > rom :ph_rom - -/*--------------------------------------------------------------------------- - * Read-write area - *-------------------------------------------------------------------------*/ - - /*------------------------------------------------------------------- - * Initialized data (copied by PM) - *-----------------------------------------------------------------*/ - - /* Data section. */ - .data : - { - *(.data) - *(.data.*) - *(.gnu.linkonce.d.*) - SORT(CONSTRUCTORS) - } > ram :ph_ram - - /* C++ constructor section. */ - .ctors : - { - __CTOR_LIST__ = .; - *(.ctors) - *(SORT(.ctors.*)) - __CTOR_END__ = .; - } > ram :ph_ram - - /* C++ destructor section. */ - .dtors : - { - __DTOR_LIST__ = .; - *(.dtors) - *(SORT(.dtors.*)) - __DTOR_END__ = .; - } > ram :ph_ram - - - /* Small data section. */ - .sdata ALIGN(0x10) : - { - PROVIDE (_SDA_BASE_ = .); - *(.sdata) - *(.sdata.*) - *(.gnu.linkonce.s.*) - } > ram :ph_ram - - /*------------------------------------------------------------------- - * Uninitialized data (cleared by PM) - *-----------------------------------------------------------------*/ - - /* Small bss section. */ - .sbss : - { - *(.sbss) - *(.sbss.*) - *(.scommon) - *(.gnu.linkonce.sb.*) - } > ram :ph_ram - - /* Bss section. */ - .bss : - { - *(.bss) - *(.bss.*) - *(COMMON) - *(.gnu.linkonce.b.*) - } > ram :ph_ram - -/*--------------------------------------------------------------------------- - * Debug information - *-------------------------------------------------------------------------*/ - - /* - * Stabs debug sections. - */ - - .stab 0 : { *(.stab) } - .stabstr 0 : { *(.stabstr) } - .stab.excl 0 : { *(.stab.excl) } - .stab.exclstr 0 : { *(.stab.exclstr) } - .stab.index 0 : { *(.stab.index) } - .stab.indexstr 0 : { *(.stab.indexstr) } - .comment 0 : { *(.comment) } - - /* - * DWARF debug sections. - */ - - /* DWARF 1 */ - .debug 0 : { *(.debug) } - .line 0 : { *(.line) } - /* GNU DWARF 1 extensions */ - .debug_srcinfo 0 : { *(.debug_srcinfo) } - .debug_sfnames 0 : { *(.debug_sfnames) } - /* DWARF 1.1 and DWARF 2 */ - .debug_aranges 0 : { *(.debug_aranges) } - .debug_pubnames 0 : { *(.debug_pubnames) } - /* DWARF 2 */ - .debug_info 0 : { *(.debug_info) *(.gnu.linkonce.wi.*) } - .debug_abbrev 0 : { *(.debug_abbrev) } - .debug_line 0 : { *(.debug_line) } - .debug_frame 0 : { *(.debug_frame) } - .debug_str 0 : { *(.debug_str) } - .debug_loc 0 : { *(.debug_loc) } - .debug_macinfo 0 : { *(.debug_macinfo) } - /* SGI/MIPS DWARF 2 extensions */ - .debug_weaknames 0 : { *(.debug_weaknames) } - .debug_funcnames 0 : { *(.debug_funcnames) } - .debug_typenames 0 : { *(.debug_typenames) } - .debug_varnames 0 : { *(.debug_varnames) } -} diff --git a/erts/emulator/sys/ose/sys.c b/erts/emulator/sys/ose/sys.c deleted file mode 100644 index e354faf02c..0000000000 --- a/erts/emulator/sys/ose/sys.c +++ /dev/null @@ -1,1847 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif -#include "sys/time.h" -#include "time.h" -#include "sys/uio.h" -#include "termios.h" -#include "ctype.h" -#include "termios.h" - -#ifdef HAVE_FCNTL_H -#include "fcntl.h" -#endif - -#ifdef HAVE_SYS_IOCTL_H -#include "sys/ioctl.h" -#endif - -#define ERTS_WANT_BREAK_HANDLING -#define WANT_NONBLOCKING -#include "sys.h" -#include "erl_thr_progress.h" - -#ifdef USE_THREADS -#include "erl_threads.h" -#endif - -#include "erl_mseg.h" - -#include "unistd.h" -#include "efs.h" -#include "erl_printf.h" -#include "aio.h" -#include "pm.h" -#include "fcntl.h" - -/* Set the define to 1 to get some logging */ -#if 0 -#include "ramlog.h" -#define LOG(output) ramlog_printf output -#else -#define LOG(output) -#endif - -extern char **environ; -static erts_smp_rwmtx_t environ_rwmtx; -static PROCESS sig_proxy_pid = 0; - -#define MAX_VSIZE 16 /* Max number of entries allowed in an I/O - * vector sock_sendv(). - */ -/* - * Don't need global.h, but bif_table.h (included by bif.h), - * won't compile otherwise - */ -#include "global.h" -#include "bif.h" - -#include "erl_sys_driver.h" -#include "erl_check_io.h" -#include "erl_cpu_topology.h" - -/* The priority for reader/writer processes */ -#define FD_PROC_PRI get_pri(current_process()) - -typedef struct ErtsSysReportExit_ ErtsSysReportExit; -struct ErtsSysReportExit_ { - ErtsSysReportExit *next; - Eterm port; - int pid; - int ifd; - int ofd; - ErlDrvEvent attach_event; - ErlDrvEvent input_event; - ErlDrvEvent output_event; -}; - -/* This data is shared by these drivers - initialized by spawn_init() */ -static struct driver_data { - ErlDrvPort port_num; - int ofd; - int ifd; - int packet_bytes; - ErtsSysReportExit *report_exit; - int pid; - int alive; - int status; - ErlDrvEvent input_event; - ErlDrvEvent output_event; - struct aiocb aiocb; - FmHandle handle; - char *install_handle; -} *driver_data; /* indexed by fd */ - -struct async { - SIGSELECT signo; - ErlDrvTermData port; - ErlDrvTermData proc; - PROCESS spid; - PROCESS target; - Uint32 ref; -}; - -static ErtsSysReportExit *report_exit_list; -static ERTS_INLINE void report_exit_status(ErtsSysReportExit *rep, int status); - -extern int driver_interrupt(int, int); -extern void do_break(void); - -extern void erl_sys_args(int*, char**); - -/* The following two defs should probably be moved somewhere else */ - -extern void erts_sys_init_float(void); - -extern void erl_crash_dump(char* file, int line, char* fmt, ...); - -#define DIR_SEPARATOR_CHAR '/' - -#if defined(DEBUG) -#define ERL_BUILD_TYPE_MARKER ".debug" -#else /* opt */ -#define ERL_BUILD_TYPE_MARKER -#endif - -#define CHILD_SETUP_PROG_NAME "child_setup" ERL_BUILD_TYPE_MARKER - -#ifdef DEBUG -static int debug_log = 0; -#endif - -#ifdef ERTS_SMP -static erts_smp_atomic32_t have_prepared_crash_dump; -#define ERTS_PREPARED_CRASH_DUMP \ - ((int) erts_smp_atomic32_xchg_nob(&have_prepared_crash_dump, 1)) -#else -static volatile int have_prepared_crash_dump; -#define ERTS_PREPARED_CRASH_DUMP \ - (have_prepared_crash_dump++) -#endif - -static erts_smp_atomic_t sys_misc_mem_sz; - -#if defined(ERTS_SMP) -erts_mtx_t chld_stat_mtx; -#endif - -#if defined(ERTS_SMP) /* ------------------------------------------------- */ -#define CHLD_STAT_LOCK erts_mtx_lock(&chld_stat_mtx) -#define CHLD_STAT_UNLOCK erts_mtx_unlock(&chld_stat_mtx) - -#else /* ------------------------------------------------------------------- */ -#define CHLD_STAT_LOCK -#define CHLD_STAT_UNLOCK -static volatile int children_died; -#endif - -#define SET_AIO(REQ,FD,SIZE,BUFF) \ - memset(&(REQ),0,sizeof(REQ)); \ - (REQ).aio_fildes = FD; \ - (REQ).aio_offset = FM_POSITION_CURRENT; \ - (REQ).aio_nbytes = SIZE; \ - (REQ).aio_buf = BUFF; \ - (REQ).aio_sigevent.sigev_notify = SIGEV_NONE - -/* the first sizeof(struct aiocb *) bytes of the write buffer - * will contain the pointer to the aiocb struct, this needs - * to be freed between asynchronous writes. - * A write of 0 bytes is ignored. */ -#define WRITE_AIO(FD,SIZE,BUFF) do { \ - if (SIZE > 0) { \ - struct aiocb *write_req = driver_alloc(sizeof(struct aiocb)); \ - char *write_buff = driver_alloc((sizeof(char)*SIZE)+1+ \ - (sizeof(struct aiocb *))); \ - *(struct aiocb **)write_buff = (struct aiocb *)write_req; \ - write_buff += sizeof(struct aiocb *); \ - memcpy(write_buff,BUFF,SIZE+1); \ - SET_AIO(*write_req,FD,SIZE,write_buff); \ - if (aio_write(write_req)) \ - ramlog_printf("%s:%d: write failed with %d\n", \ - __FILE__,__LINE__,errno); \ - } \ -} while(0) - -/* free the write_buffer and write_req - * created in the WRITE_AIO() request macro */ -#define FREE_AIO(ptr) do { \ - struct aiocb *aiocb_ptr; \ - char *buffer_ptr; \ - aiocb_ptr = *(struct aiocb **)((ptr)-sizeof(struct aiocb *)); \ - buffer_ptr = (((char*)ptr)-sizeof(struct aiocb *)); \ - driver_free(aiocb_ptr); \ - driver_free(buffer_ptr); \ -} while(0) - -#define DISPATCH_AIO(sig) do { \ - if (aio_dispatch(sig)) \ - ramlog_printf("%s:%d: dispatch failed with %d\n", \ - __FILE__,__LINE__,errno); \ - } while(0) - -#define AIO_PIPE_SIZE 1024 - -/* debug print macros */ -#define DEBUG_RES 0 - -#ifdef DEBUG_RES -#define DEBUG_CHECK_RES(actual, expected) \ - do { \ - if (actual != expected ) { \ - ramlog_printf("Result check failed" \ - " got: 0x%08x expected:0x%08x\nat: %s:%d\n", \ - actual, expected, __FILE__, __LINE__); \ - abort(); /* This might perhaps be too harsh? */ \ - } \ - } while(0) -#else -#define DEBUG_CHECK_RES -#endif - -static struct fd_data { - char pbuf[4]; /* hold partial packet bytes */ - int psz; /* size of pbuf */ - char *buf; - char *cpos; - int sz; - int remain; /* for input on fd */ -} *fd_data; /* indexed by fd */ - -/********************* General functions ****************************/ - -/* This is used by both the drivers and general I/O, must be set early */ -static int max_files = -1; - -/* - * a few variables used by the break handler - */ -#ifdef ERTS_SMP -erts_smp_atomic32_t erts_break_requested; -#define ERTS_SET_BREAK_REQUESTED \ - erts_smp_atomic32_set_nob(&erts_break_requested, (erts_aint32_t) 1) -#define ERTS_UNSET_BREAK_REQUESTED \ - erts_smp_atomic32_set_nob(&erts_break_requested, (erts_aint32_t) 0) -#else -volatile int erts_break_requested = 0; -#define ERTS_SET_BREAK_REQUESTED (erts_break_requested = 1) -#define ERTS_UNSET_BREAK_REQUESTED (erts_break_requested = 0) -#endif -/* set early so the break handler has access to initial mode */ -static struct termios initial_tty_mode; -static int replace_intr = 0; -/* assume yes initially, ttsl_init will clear it */ -int using_oldshell = 1; -static PROCESS get_signal_proxy_pid(void); - -static void -init_check_io(void) -{ - erts_init_check_io(); - max_files = erts_check_io_max_files(); -} - -#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT -#define ERTS_CHK_IO_AS_INTR() erts_check_io_async_sig_interrupt() -#else -#define ERTS_CHK_IO_AS_INTR() erts_check_io_interrupt(1) -#endif -#define ERTS_CHK_IO_INTR erts_check_io_interrupt -#define ERTS_CHK_IO_INTR_TMD erts_check_io_interrupt_timed -#define ERTS_CHK_IO erts_check_io -#define ERTS_CHK_IO_SZ erts_check_io_size - - -void -erts_sys_schedule_interrupt(int set) -{ - ERTS_CHK_IO_INTR(set); -} - -#ifdef ERTS_SMP -void -erts_sys_schedule_interrupt_timed(int set, ErtsMonotonicTime timeout_time) -{ - ERTS_CHK_IO_INTR_TMD(set, timeout_time); -} -#endif - -Uint -erts_sys_misc_mem_sz(void) -{ - Uint res = ERTS_CHK_IO_SZ(); - res += erts_smp_atomic_read_mb(&sys_misc_mem_sz); - return res; -} - -/* - * reset the terminal to the original settings on exit - */ -void sys_tty_reset(int exit_code) -{ - if (using_oldshell && !replace_intr) { - SET_BLOCKING(0); - } - else if (isatty(0)) { - tcsetattr(0,TCSANOW,&initial_tty_mode); - } -} - -#ifdef USE_THREADS - -typedef struct { - int sched_bind_data; -} erts_thr_create_data_t; - -/* - * thr_create_prepare() is called in parent thread before thread creation. - * Returned value is passed as argument to thr_create_cleanup(). - */ -static void * -thr_create_prepare(void) -{ - erts_thr_create_data_t *tcdp; - - tcdp = erts_alloc(ERTS_ALC_T_TMP, sizeof(erts_thr_create_data_t)); - - tcdp->sched_bind_data = erts_sched_bind_atthrcreate_prepare(); - - return (void *) tcdp; -} - - -/* thr_create_cleanup() is called in parent thread after thread creation. */ -static void -thr_create_cleanup(void *vtcdp) -{ - erts_thr_create_data_t *tcdp = (erts_thr_create_data_t *) vtcdp; - - erts_sched_bind_atthrcreate_parent(tcdp->sched_bind_data); - - erts_free(ERTS_ALC_T_TMP, tcdp); -} - -static void -thr_create_prepare_child(void *vtcdp) -{ - erts_thr_create_data_t *tcdp = (erts_thr_create_data_t *) vtcdp; - -#ifdef ERTS_ENABLE_LOCK_COUNT - erts_lcnt_thread_setup(); -#endif - - erts_sched_bind_atthrcreate_child(tcdp->sched_bind_data); -} - -#endif /* #ifdef USE_THREADS */ - -/* The two functions below are stolen from win_con.c - They have to use malloc/free/realloc directly becasue - we want to do able to do erts_printf very early on. - */ -#define VPRINTF_BUF_INC_SIZE 128 -static erts_dsprintf_buf_t * -grow_vprintf_buf(erts_dsprintf_buf_t *dsbufp, size_t need) -{ - char *buf; - size_t size; - - ASSERT(dsbufp); - - if (!dsbufp->str) { - size = (((need + VPRINTF_BUF_INC_SIZE - 1) - / VPRINTF_BUF_INC_SIZE) - * VPRINTF_BUF_INC_SIZE); - buf = (char *) malloc(size * sizeof(char)); - } - else { - size_t free_size = dsbufp->size - dsbufp->str_len; - - if (need <= free_size) - return dsbufp; - - size = need - free_size + VPRINTF_BUF_INC_SIZE; - size = (((size + VPRINTF_BUF_INC_SIZE - 1) - / VPRINTF_BUF_INC_SIZE) - * VPRINTF_BUF_INC_SIZE); - size += dsbufp->size; - buf = (char *) realloc((void *) dsbufp->str, - size * sizeof(char)); - } - if (!buf) - return NULL; - if (buf != dsbufp->str) - dsbufp->str = buf; - dsbufp->size = size; - return dsbufp; -} - -static int erts_sys_ramlog_printf(char *format, va_list arg_list) -{ - int res,i; - erts_dsprintf_buf_t dsbuf = ERTS_DSPRINTF_BUF_INITER(grow_vprintf_buf); - res = erts_vdsprintf(&dsbuf, format, arg_list); - if (res >= 0) { - for (i = 0; i < dsbuf.str_len; i+= 50) - /* We print 50 characters at a time because otherwise - the ramlog looks broken */ - ramlog_printf("%.*s",dsbuf.str_len-50 < 0?dsbuf.str_len:50,dsbuf.str+i); - } - if (dsbuf.str) - free((void *) dsbuf.str); - return res; -} - -void -erts_sys_pre_init(void) -{ - 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 */ - eid.thread_create_prepare_func = thr_create_prepare; - /* After creation in parent */ - eid.thread_create_parent_func = thr_create_cleanup, - - erts_thr_init(&eid); - - report_exit_list = NULL; - -#ifdef ERTS_ENABLE_LOCK_COUNT - erts_lcnt_init(); -#endif - -#if defined(ERTS_SMP) - erts_mtx_init(&chld_stat_mtx, "child_status"); -#endif - } -#ifdef ERTS_SMP - erts_smp_atomic32_init_nob(&erts_break_requested, 0); - erts_smp_atomic32_init_nob(&have_prepared_crash_dump, 0); -#else - erts_break_requested = 0; - have_prepared_crash_dump = 0; -#endif -#if !defined(ERTS_SMP) - children_died = 0; -#endif -#endif /* USE_THREADS */ - - erts_printf_stdout_func = erts_sys_ramlog_printf; - - erts_smp_atomic_init_nob(&sys_misc_mem_sz, 0); -} - -void -erl_sys_init(void) -{ - -#ifdef USE_SETLINEBUF - setlinebuf(stdout); -#else - setvbuf(stdout, (char *)NULL, _IOLBF, BUFSIZ); -#endif - - erts_sys_init_float(); - - /* we save this so the break handler can set and reset it properly */ - /* also so that we can reset on exit (break handler or not) */ - if (isatty(0)) { - tcgetattr(0,&initial_tty_mode); - } - tzset(); /* Required at least for NetBSD with localtime_r() */ -} - -static ERTS_INLINE int -prepare_crash_dump(int secs) -{ -#define NUFBUF (3) - int i, max; - char env[21]; /* enough to hold any 64-bit integer */ - size_t envsz; - /*DeclareTmpHeapNoproc(heap,NUFBUF);*/ - /*Eterm *hp = heap;*/ - /*Eterm list = NIL;*/ - int has_heart = 0; - - UseTmpHeapNoproc(NUFBUF); - - if (ERTS_PREPARED_CRASH_DUMP) - return 0; /* We have already been called */ - - - /* Positive secs means an alarm must be set - * 0 or negative means no alarm - * - * Set alarm before we try to write to a port - * we don't want to hang on a port write with - * no alarm. - * - */ - -#if 0 /*ose TBD!!!*/ - if (secs >= 0) { - alarm((unsigned int)secs); - } -#endif - - /* Make sure we unregister at epmd (unknown fd) and get at least - one free filedescriptor (for erl_crash.dump) */ - - max = max_files; - if (max < 1024) - max = 1024; - for (i = 3; i < max; i++) { - close(i); - } - - envsz = sizeof(env); - i = erts_sys_getenv__("ERL_CRASH_DUMP_NICE", env, &envsz); - if (i >= 0) { - int nice_val; - nice_val = i != 0 ? 0 : atoi(env); - if (nice_val > 39) { - nice_val = 39; - } - set_pri(nice_val); - } - - UnUseTmpHeapNoproc(NUFBUF); -#undef NUFBUF - return has_heart; -} - -int erts_sys_prepare_crash_dump(int secs) -{ - return prepare_crash_dump(secs); -} - -static ERTS_INLINE void -break_requested(void) -{ - /* - * just set a flag - checked for and handled by - * scheduler threads erts_check_io() (not signal handler). - */ -#ifdef DEBUG - fprintf(stderr,"break!\n"); -#endif - if (ERTS_BREAK_REQUESTED) - erts_exit(ERTS_INTR_EXIT, ""); - - ERTS_SET_BREAK_REQUESTED; - ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */ -} - -/* Disable break */ -void erts_set_ignore_break(void) { - -} - -/* Don't use ctrl-c for break handler but let it be - used by the shell instead (see user_drv.erl) */ -void erts_replace_intr(void) { - struct termios mode; - - if (isatty(0)) { - tcgetattr(0, &mode); - - /* here's an example of how to replace ctrl-c with ctrl-u */ - /* mode.c_cc[VKILL] = 0; - mode.c_cc[VINTR] = CKILL; */ - - mode.c_cc[VINTR] = 0; /* disable ctrl-c */ - tcsetattr(0, TCSANOW, &mode); - replace_intr = 1; - } -} - -void init_break_handler(void) -{ - -} - -int sys_max_files(void) -{ - return(max_files); -} - - -/************************** OS info *******************************/ - -/* Used by erlang:info/1. */ -/* (This code was formerly in drv.XXX/XXX_os_drv.c) */ - -char os_type[] = "ose"; - -void -os_flavor(char* namebuf, /* Where to return the name. */ - unsigned size) /* Size of name buffer. */ -{ -#if 0 - struct utsname uts; /* Information about the system. */ - char* s; - - (void) uname(&uts); - for (s = uts.sysname; *s; s++) { - if (isupper((int) *s)) { - *s = tolower((int) *s); - } - } - strcpy(namebuf, uts.sysname); -#else - strncpy(namebuf, "release", size); -#endif -} - -void -os_version(pMajor, pMinor, pBuild) -int* pMajor; /* Pointer to major version. */ -int* pMinor; /* Pointer to minor version. */ -int* pBuild; /* Pointer to build number. */ -{ - *pMajor = 5; - *pMinor = 7; - *pBuild = 0; -} - -void init_getenv_state(GETENV_STATE *state) -{ - erts_smp_rwmtx_rlock(&environ_rwmtx); - *state = NULL; -} - -char **environ; /*ose - needs replacement*/ - -char *getenv_string(GETENV_STATE *state0) -{ - char **state = (char **) *state0; - char *cp; - - ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx)); - - if (state == NULL) - state = environ; - - cp = *state++; - *state0 = (GETENV_STATE) state; - - return cp; -} - -void fini_getenv_state(GETENV_STATE *state) -{ - *state = NULL; - erts_smp_rwmtx_runlock(&environ_rwmtx); -} - - -/************************** Port I/O *******************************/ - -/* I. Common stuff */ - -union SIGNAL { - SIGSELECT sig_no; - struct FmReadPtr fm_read_reply; - struct FmWritePtr fm_write_reply; - struct async async; -}; - -/* II. The spawn/fd drivers */ - -/* - * Decreasing the size of it below 16384 is not allowed. - */ -#define ERTS_SYS_READ_BUF_SZ (64*1024) - -/* Driver interfaces */ -static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); -static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*); -static ErlDrvSSizeT fd_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT, - char **, ErlDrvSizeT); -static int spawn_init(void); -static void fd_stop(ErlDrvData); -static void erl_stop(ErlDrvData); -static void ready_input(ErlDrvData, ErlDrvEvent); -static void ready_output(ErlDrvData, ErlDrvEvent); -static void output(ErlDrvData, char*, ErlDrvSizeT); -static void stop_select(ErlDrvEvent, void*); - -static PROCESS -get_signal_proxy_pid(void) { - union SIGNAL *sig; - SIGSELECT any_sig[] = {1,ERTS_SIGNAL_OSE_DRV_ATTACH}; - - if (!sig_proxy_pid) { - sig = alloc(sizeof(union SIGNAL), ERTS_SIGNAL_OSE_DRV_ATTACH); - hunt("ose_signal_driver_proxy", 0, NULL, &sig); - sig = receive(any_sig); - sig_proxy_pid = sender(&sig); - free_buf(&sig); - } - ASSERT(sig_proxy_pid); - return sig_proxy_pid; -} - -static ErlDrvOseEventId -resolve_signal(union SIGNAL* sig) { - switch(sig->sig_no) { - - case FM_READ_PTR_REPLY: - return (ErlDrvOseEventId)sig->fm_read_reply.handle; - - case FM_WRITE_PTR_REPLY: - return (ErlDrvOseEventId)sig->fm_write_reply.handle; - - case ERTS_SIGNAL_OSE_DRV_ATTACH: - return (ErlDrvOseEventId)sig->async.target; - - default: - break; - } - return (ErlDrvOseEventId)-1; -} - -struct erl_drv_entry spawn_driver_entry = { - spawn_init, - spawn_start, - NULL, /* erl_stop, */ - output, - ready_input, - ready_output, - "spawn", - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - ERL_DRV_EXTENDED_MARKER, - ERL_DRV_EXTENDED_MAJOR_VERSION, - ERL_DRV_EXTENDED_MINOR_VERSION, - ERL_DRV_FLAG_USE_PORT_LOCKING, - NULL, NULL, - stop_select -}; -struct erl_drv_entry fd_driver_entry = { - NULL, - fd_start, - fd_stop, - output, - ready_input, - ready_output, - "fd", - NULL, - NULL, - fd_control, - NULL, - NULL, - NULL, /* ready_async */ - NULL, /* flush */ - NULL, /* call */ - NULL, /* event */ - ERL_DRV_EXTENDED_MARKER, - ERL_DRV_EXTENDED_MAJOR_VERSION, - ERL_DRV_EXTENDED_MINOR_VERSION, - 0, /* ERL_DRV_FLAGs */ - NULL, /* handle2 */ - NULL, /* process_exit */ - stop_select -}; - -static void -set_spawn_fd(int local_fd, int remote_fd, PROCESS remote_pid) { - PROCESS vm_pid; - FmHandle handle; - char env_val[55]; - char env_name[10]; - EfsStatus efs_res; - - /* get pid of pipevm and handle of chosen fd */ - efs_res = efs_examine_fd(local_fd, FLIB_FD_VMPID, &vm_pid, 0); - DEBUG_CHECK_RES(efs_res, EFS_SUCCESS); - - /* setup the file descriptor to buffer per line */ - efs_res = efs_config_fd(local_fd, FLIB_FD_BUFMODE, FM_BUFF_LINE, - FLIB_FD_BUFSIZE, 80, 0); - DEBUG_CHECK_RES(efs_res, EFS_SUCCESS); - - /* duplicate handle and set spawn pid owner */ - efs_res = efs_dup_to(local_fd, remote_pid, &handle); - DEBUG_CHECK_RES(efs_res, EFS_SUCCESS); - - sprintf(env_name, "FD%d", remote_fd); - - /* Syntax of the environment variable: - * "FD#" "<pid of pipevm>,<handle>,<buffer mode>,<buff size>,<omode>" */ - sprintf(env_val, "0x%lx,0x%lx,%lu,%lu,0x%x", - vm_pid, handle, - FM_BUFF_LINE, 80, - O_APPEND); - - set_env(remote_pid, env_name, env_val); -} - -static ErlDrvData -set_driver_data(ErlDrvPort port_num, - int ifd, - int ofd, - int packet_bytes, - int read_write, - int exit_status, - PROCESS pid) -{ - Port *prt; - ErtsSysReportExit *report_exit; - - prt = erts_drvport2port(port_num); - if (prt != ERTS_INVALID_ERL_DRV_PORT) { - prt->os_pid = pid; - } - - /* READ */ - if (read_write & DO_READ) { - EfsStatus res = efs_examine_fd(ifd, FLIB_FD_HANDLE, - &driver_data[ifd].handle, 0); - if (res != EFS_SUCCESS) - ramlog_printf("%s:%d: efs_examine_fd(%d) failed with %d\n", - __FILE__,__LINE__,ifd,errno); - driver_data[ifd].ifd = ifd; - driver_data[ifd].packet_bytes = packet_bytes; - driver_data[ifd].port_num = port_num; - driver_data[ifd].pid = pid; - - /* async read struct */ - memset(&driver_data[ifd].aiocb, 0, sizeof(struct aiocb)); - driver_data[ifd].aiocb.aio_buf = driver_alloc(AIO_PIPE_SIZE); - driver_data[ifd].aiocb.aio_fildes = ifd; - driver_data[ifd].aiocb.aio_nbytes = (packet_bytes?packet_bytes:AIO_PIPE_SIZE); - driver_data[ifd].alive = 1; - driver_data[ifd].status = 0; - driver_data[ifd].input_event = - erl_drv_ose_event_alloc(FM_READ_PTR_REPLY, - driver_data[ifd].handle, resolve_signal, - &driver_data[ifd].ifd); - - /* READ & WRITE */ - if (read_write & DO_WRITE) { - driver_data[ifd].ofd = ofd; - efs_examine_fd(ofd, FLIB_FD_HANDLE, &driver_data[ofd].handle, 0); - - driver_data[ifd].output_event = - erl_drv_ose_event_alloc(FM_WRITE_PTR_REPLY, - driver_data[ofd].handle, resolve_signal, - &driver_data[ofd].ofd); - driver_data[ofd].pid = pid; - if (ifd != ofd) { - driver_data[ofd] = driver_data[ifd]; - driver_data[ofd].aiocb.aio_buf = NULL; - } - } - else { /* READ ONLY */ - driver_data[ifd].ofd = -1; - } - - /* enable input event */ - (void) driver_select(port_num, driver_data[ifd].input_event, - (ERL_DRV_READ | ERL_DRV_USE), 1); - - if (aio_read(&driver_data[ifd].aiocb)) - ramlog_printf("%s:%d: aio_read(%d) failed with %d\n", - __FILE__,__LINE__,ifd,errno); - } - else { /* WRITE ONLY */ - efs_examine_fd(ofd, FLIB_FD_HANDLE, &driver_data[ofd].handle, 0); - driver_data[ofd].packet_bytes = packet_bytes; - driver_data[ofd].port_num = port_num; - driver_data[ofd].ofd = ofd; - driver_data[ofd].pid = pid; - driver_data[ofd].alive = 1; - driver_data[ofd].status = 0; - driver_data[ofd].output_event = - erl_drv_ose_event_alloc(FM_WRITE_PTR_REPLY, driver_data[ofd].handle, - resolve_signal, &driver_data[ofd].ofd); - driver_data[ofd].input_event = driver_data[ofd].output_event; - } - - /* this is used for spawned load modules, and is needed - * to properly uninstall them */ - if (exit_status) { - struct PmProgramInfo *info; - int install_handle_size; - union SIGNAL *sig; - PmStatus pm_status; - report_exit = erts_alloc(ERTS_ALC_T_PRT_REP_EXIT, - sizeof(ErtsSysReportExit)); - report_exit->next = report_exit_list; - report_exit->port = erts_drvport2id(port_num); - report_exit->pid = pid; - report_exit->ifd = (read_write & DO_READ) ? ifd : -1; - report_exit->ofd = (read_write & DO_WRITE) ? ofd : -1; - report_exit_list = report_exit; - report_exit->attach_event = - erl_drv_ose_event_alloc(ERTS_SIGNAL_OSE_DRV_ATTACH, pid, - resolve_signal, &driver_data[ifd].ifd); - - /* setup ifd and ofd report exit */ - driver_data[ifd].report_exit = report_exit; - driver_data[ofd].report_exit = report_exit; - - pm_status = ose_pm_program_info(pid, &info); - DEBUG_CHECK_RES(pm_status, PM_SUCCESS); - - install_handle_size = strlen(info->install_handle)+1; - driver_data[ifd].install_handle = driver_alloc(install_handle_size); - strcpy(driver_data[ifd].install_handle, - info->install_handle); - - free_buf((union SIGNAL **)&info); - - sig = alloc(sizeof(struct async), ERTS_SIGNAL_OSE_DRV_ATTACH); - sig->async.target = pid; - send(&sig, get_signal_proxy_pid()); - - /* this event will trigger when we receive an attach signal - * from the recently dead load module */ - (void)driver_select(port_num,report_exit->attach_event, DO_READ, 1); - } - else { - report_exit = NULL; - } - - /* the return value is the pointer to the driver_data struct we created - * in this function, it will be used in the drivers input - * and output functions */ - return (ErlDrvData)((!(read_write & DO_READ) && read_write & DO_WRITE) - ? &driver_data[ofd] - : &driver_data[ifd]); -} - -static int spawn_init() -{ - int i; - - 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, - max_files * sizeof(struct driver_data)); - - for (i = 0; i < max_files; i++) - driver_data[i].pid = -1; - - return 1; -} - -static void -init_fd_data(int fd, ErlDrvPort port_num) -{ - fd_data[fd].buf = NULL; - fd_data[fd].cpos = NULL; - fd_data[fd].remain = 0; - fd_data[fd].sz = 0; - fd_data[fd].psz = 0; -} - -/* FIXME write a decent text on pipes on ose */ -static ErlDrvData -spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) -{ - int ifd[2]; - int ofd[2]; - static uint32_t ticker = 1; - PmStatus pm_status; - OSDOMAIN domain = PM_NEW_DOMAIN; - PROCESS progpid, mainbid, mainpid; - char *handle = NULL; - struct PmProgramInfo *info; - char *args = NULL; - char *tmp_handle; - ErlDrvData res = (ErlDrvData)-1; - int handle_size; - char *ptr; - - - args = driver_alloc(strlen(name)+1); - strcpy(args, name); - /* We need to handle name in three parts - * - install handle (must be unique) - * - install binary (needed for ose_pm_install_load_module()) - * - full path (as argument to the spawned applications env.var - */ - - /* full path including arguments */ - args = driver_alloc(strlen(name)+1); - strcpy(args, name); - - /* handle path */ - tmp_handle = strrchr(name, '/'); - if (tmp_handle == NULL) { - tmp_handle = name; - } - else { - tmp_handle++; - } - - /* handle args */ - ptr = strchr(tmp_handle, ' '); - if (ptr != NULL) { - *ptr = '\0'; - handle_size = ptr - tmp_handle; - } - else { - handle_size = strlen(name)+1; - } - - /* make room for ticker */ - handle_size += (ticker<10)?3:((ticker<100)?4:5); - handle = driver_alloc(handle_size); - - do { - snprintf(handle, handle_size, "%s_%d", tmp_handle, ticker); - pm_status = ose_pm_install_load_module(0, "ELF", name, handle, - 0, 0, NULL); - ticker++; - } while (pm_status == PM_EINSTALL_HANDLE_ALREADY_INSTALLED); - - if (pm_status != PM_SUCCESS) { - errno = ENOSYS; /* FIXME add comment */ - return ERL_DRV_ERROR_ERRNO; - } - - /* Create Program */ - pm_status = ose_pm_create_program(&domain, handle, 0, 0, - NULL, &progpid, &mainbid); - DEBUG_CHECK_RES(pm_status, PM_SUCCESS); - - /* Get the mainpid from the newly created program */ - pm_status = ose_pm_program_info(progpid, &info); - DEBUG_CHECK_RES(pm_status, PM_SUCCESS); - - mainpid = info->main_process; - free_buf ((union SIGNAL **)&info); - - /* pipevm needs to be started - * pipe will return 0 if success, -1 if not, - * errno will be set */ - if (pipe(ifd) != 0 || pipe(ofd) != 0) { - DEBUG_CHECK_RES(0, -1); - ASSERT(0); - } - - /* setup driver data */ - res = set_driver_data(port_num, ofd[0], ifd[1], opts->packet_bytes, - opts->read_write, 1 /* opts->exit_status */, progpid); - - /* init the fd_data array for read/write */ - init_fd_data(ofd[0], port_num); - init_fd_data(ifd[1], port_num); - - /* setup additional configurations - * for the spawned applications environment */ - if (args != NULL) { - set_env(progpid, "ARGV", args); - } - set_env(mainbid, "EFS_RESOLVE_TMO", 0); - set_spawn_fd(ifd[0], 0, mainpid); - set_spawn_fd(ofd[1], 1, mainpid); - set_spawn_fd(ofd[1], 2, mainpid); - - /* start the spawned program */ - pm_status = ose_pm_start_program(mainbid); - DEBUG_CHECK_RES(pm_status, PM_SUCCESS); - - /* close unused fd's */ - close(ifd[0]); - close(ofd[1]); - - if (handle) { - driver_free(handle); - } - - return (ErlDrvData)res; -} - -#define FD_DEF_HEIGHT 24 -#define FD_DEF_WIDTH 80 -/* Control op */ -#define FD_CTRL_OP_GET_WINSIZE 100 - -static int fd_get_window_size(int fd, Uint32 *width, Uint32 *height) -{ -#ifdef TIOCGWINSZ - struct winsize ws; - if (ioctl(fd,TIOCGWINSZ,&ws) == 0) { - *width = (Uint32) ws.ws_col; - *height = (Uint32) ws.ws_row; - return 0; - } -#endif - return -1; -} - -static ErlDrvSSizeT fd_control(ErlDrvData drv_data, - unsigned int command, - char *buf, ErlDrvSizeT len, - char **rbuf, ErlDrvSizeT rlen) -{ - struct driver_data *data = (struct driver_data *)drv_data; - char resbuff[2*sizeof(Uint32)]; - switch (command) { - case FD_CTRL_OP_GET_WINSIZE: - { - Uint32 w,h; - if (fd_get_window_size(data->ifd,&w,&h)) - return 0; - memcpy(resbuff,&w,sizeof(Uint32)); - memcpy(resbuff+sizeof(Uint32),&h,sizeof(Uint32)); - } - break; - default: - return 0; - } - if (rlen < 2*sizeof(Uint32)) { - *rbuf = driver_alloc(2*sizeof(Uint32)); - } - memcpy(*rbuf,resbuff,2*sizeof(Uint32)); - return 2*sizeof(Uint32); -} - -static ErlDrvData fd_start(ErlDrvPort port_num, char* name, - SysDriverOpts* opts) -{ - ErlDrvData res; - - CHLD_STAT_LOCK; - if (opts->read_write & DO_READ) { - init_fd_data(opts->ifd, port_num); - } - if (opts->read_write & DO_WRITE) { - init_fd_data(opts->ofd, port_num); - } - res = set_driver_data(port_num, opts->ifd, opts->ofd, - opts->packet_bytes, - opts->read_write, 0, -1); - CHLD_STAT_UNLOCK; - return res; -} - -static void clear_fd_data(int fd) -{ - if (fd_data[fd].sz > 0) { - erts_free(ERTS_ALC_T_FD_ENTRY_BUF, (void *) fd_data[fd].buf); - ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= fd_data[fd].sz); - erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*fd_data[fd].sz); - } - fd_data[fd].buf = NULL; - fd_data[fd].sz = 0; - fd_data[fd].remain = 0; - fd_data[fd].cpos = NULL; - fd_data[fd].psz = 0; -} - -static void nbio_stop_fd(ErlDrvPort prt, ErlDrvEvent ev) -{ - int *fd; - driver_select(prt,ev,DO_READ|DO_WRITE,0); - erl_drv_ose_event_fetch(ev, NULL, NULL, (void **)&fd); - clear_fd_data(*fd); - SET_BLOCKING(*fd); -} - -static void fd_stop(ErlDrvData drv_data) /* Does not close the fds */ -{ - struct driver_data *data = (struct driver_data *)drv_data; - - if (data->ofd != -1) { - if (data->ifd != data->ofd) { /* read and write */ - nbio_stop_fd(data->port_num, data->input_event); - nbio_stop_fd(data->port_num, data->output_event); - } - else { /* write only */ - nbio_stop_fd(data->port_num, data->output_event); - } - } - else { /* read only */ - nbio_stop_fd(data->port_num, data->input_event); - } -} - - -static void erl_stop(ErlDrvData drv_data) -{ - struct driver_data *data = (struct driver_data *)drv_data; - - CHLD_STAT_LOCK; - data->pid = -1; - CHLD_STAT_UNLOCK; - - if (data->ofd != -1) { - if (data->ifd != data->ofd) { /* read and write */ - nbio_stop_fd(data->port_num, data->input_event); - nbio_stop_fd(data->port_num, data->output_event); - } - else { /* write only */ - nbio_stop_fd(data->port_num, data->output_event); - } - } - else { /* read only */ - nbio_stop_fd(data->port_num, data->input_event); - } - close(data->ifd); - close(data->ofd); -} - -/* The parameter e is a pointer to the driver_data structure - * related to the fd to be used as output */ -static void output(ErlDrvData drv_data, char* buf, ErlDrvSizeT len) -{ - ErlDrvSizeT sz; - char lb[4]; - char* lbp; - struct driver_data *data = (struct driver_data *)drv_data; - - if (((data->packet_bytes == 2) && - (len > 0xffff)) || (data->packet_bytes == 1 && len > 0xff)) { - driver_failure_posix(data->port_num, EINVAL); - return; /* -1; */ - } - put_int32(len, lb); - lbp = lb + (4-(data->packet_bytes)); - - if ((sz = driver_sizeq(data->port_num)) > 0) { - if (data->packet_bytes != 0) { - driver_enq(data->port_num, lbp, data->packet_bytes); - } - driver_enq(data->port_num, buf, len); - - if (sz + len + data->packet_bytes >= (1 << 13)) - set_busy_port(data->port_num, 1); - } - else { - char *pbbuf; - if (data->packet_bytes != 0) { - pbbuf = malloc(len + data->packet_bytes); - int i; - for (i = 0; i < data->packet_bytes; i++) { - *pbbuf++ = *lbp++; - } - strncpy(pbbuf, buf, len); - pbbuf -= data->packet_bytes; - } - driver_select(data->port_num, data->output_event, - ERL_DRV_WRITE|ERL_DRV_USE, 1); - WRITE_AIO(data->ofd, - (data->packet_bytes ? len+data->packet_bytes : len), - (data->packet_bytes ? pbbuf : buf)); - if (data->packet_bytes != 0) free(pbbuf); - } - return; /* 0; */ -} - -/* This function is being run when we in recieve - * either a read of 0 bytes, or the attach signal from a dying - * spawned load module */ -static int port_inp_failure(ErlDrvPort port_num, ErlDrvEvent ready_fd, int res) - /* Result: 0 (eof) or -1 (error) */ -{ - int *fd; - SIGSELECT sig_no; - ASSERT(res <= 0); - - erl_drv_ose_event_fetch(ready_fd,&sig_no, NULL, (void **)&fd); - /* As we need to handle two signals, we do this in two steps */ - if (driver_data[*fd].alive) { - report_exit_status(driver_data[*fd].report_exit, 0); /* status? */ - } - else { - driver_select(port_num,ready_fd,DO_READ|DO_WRITE,0); - clear_fd_data(*fd); - driver_report_exit(driver_data[*fd].port_num, driver_data[*fd].status); - /* As we do not really know if the spawn has crashed or exited nicely - * we do not check the result status of the following call.. FIXME - * can we handle this in a better way? */ - ose_pm_uninstall_load_module(driver_data[*fd].install_handle); - driver_free(driver_data[*fd].install_handle); - driver_free((void *)driver_data[*fd].aiocb.aio_buf); - - close(*fd); - } - - return 0; -} - -/* The parameter e is a pointer to the driver_data structure - * related to the fd to be used as output. - * ready_fd is the event that triggered this call to ready_input */ -static void ready_input(ErlDrvData drv_data, ErlDrvEvent ready_fd) -{ - int res; - Uint h; - char *buf; - union SIGNAL *sig; - struct driver_data *data = (struct driver_data *)drv_data; - - sig = erl_drv_ose_get_signal(ready_fd); - ASSERT(sig); - - - while (sig) { - /* If we've recieved an attach signal, we need to handle - * it in port_inp_failure */ - if (sig->sig_no == ERTS_SIGNAL_OSE_DRV_ATTACH) { - port_inp_failure(data->port_num, ready_fd, 0); - } - else { - res = sig->fm_read_reply.actual; - if (res == 0) { - port_inp_failure(data->port_num, ready_fd, res); - break; - } - - if (data->packet_bytes == 0) { - if (res < 0) { - if ((errno != EINTR) && (errno != ERRNO_BLOCK)) { - port_inp_failure(data->port_num, ready_fd, res); - } - } - else if (res == 0) { - /* read of 0 bytes, eof, otherside of pipe is assumed dead */ - port_inp_failure(data->port_num, ready_fd, res); - break; - } - else { - buf = driver_alloc(res); - memcpy(buf, (void *)data->aiocb.aio_buf, res); - driver_select(data->port_num, data->output_event, - ERL_DRV_WRITE|ERL_DRV_USE, 1); - driver_output(data->port_num, (char*) buf, res); - driver_free(buf); - } - /* clear the previous read */ - memset(data->aiocb.aio_buf, 0, res); - - /* issue a new read */ - DISPATCH_AIO(sig); - aio_read(&data->aiocb); - } - else if (data->packet_bytes && fd_data[data->ifd].remain > 0) { - /* we've read a partial package, or a header */ - - if (res == fd_data[data->ifd].remain) { /* we are done! */ - char *buf = data->aiocb.aio_buf; - int i; - - /* do we have anything buffered? */ - if (fd_data[data->ifd].buf != NULL) { - memcpy(fd_data[data->ifd].buf + fd_data[data->ifd].sz, - buf, res); - buf = fd_data[data->ifd].buf; - } - - fd_data[data->ifd].sz += res; - driver_output(data->port_num, buf, (fd_data[data->ifd].sz>0?fd_data[data->ifd].sz:res)); - clear_fd_data(data->ifd); - - /* clear the previous read */ - memset(data->aiocb.aio_buf, 0, res); - - /* issue a new read */ - DISPATCH_AIO(sig); - data->aiocb.aio_nbytes = data->packet_bytes; - - if (data->aiocb.aio_buf == NULL) { - port_inp_failure(data->port_num, ready_fd, -1); - } - aio_read(&data->aiocb); - } - else if(res < fd_data[data->ifd].remain) { /* received part of a package */ - if (fd_data[data->ifd].sz == 0) { - - fd_data[data->ifd].sz += res; - memcpy(fd_data[data->ifd].buf, data->aiocb.aio_buf, res); - fd_data[data->ifd].remain -= res; - } - else { - memcpy(fd_data[data->ifd].buf + fd_data[data->ifd].sz, - data->aiocb.aio_buf, res); - fd_data[data->ifd].sz += res; - fd_data[data->ifd].remain -= res; - } - /* clear the previous read */ - memset(data->aiocb.aio_buf, 0, res); - - /* issue a new read */ - DISPATCH_AIO(sig); - data->aiocb.aio_nbytes = fd_data[data->ifd].remain; - - if (data->aiocb.aio_buf == NULL) { - port_inp_failure(data->port_num, ready_fd, -1); - } - aio_read(&data->aiocb); - } - } - else if (data->packet_bytes && fd_data[data->ifd].remain == 0) { /* we've recieved a header */ - - /* analyze the header FIXME */ - switch (data->packet_bytes) { - case 1: h = get_int8(data->aiocb.aio_buf); break; - case 2: h = get_int16(data->aiocb.aio_buf); break; - case 4: h = get_int32(data->aiocb.aio_buf); break; - } - - fd_data[data->ifd].buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h + data->packet_bytes); - fd_data[data->ifd].remain = ((h + data->packet_bytes) - res); - - /* clear the previous read */ - memset(data->aiocb.aio_buf, 0, data->packet_bytes); - - /* issue a new read */ - DISPATCH_AIO(sig); - data->aiocb.aio_nbytes = h; - - if (data->aiocb.aio_buf == NULL) { - port_inp_failure(data->port_num, ready_fd, -1); - } - aio_read(&data->aiocb); - } - } - sig = erl_drv_ose_get_signal(ready_fd); - } -} - - -/* The parameter e is a pointer to the driver_data structure - * related to the fd to be used as output. - * ready_fd is the event that triggered this call to ready_input */ -static void ready_output(ErlDrvData drv_data, ErlDrvEvent ready_fd) -{ - SysIOVec *iov; - int vlen; - int res; - union SIGNAL *sig; - struct driver_data *data = (struct driver_data *)drv_data; - - sig = erl_drv_ose_get_signal(ready_fd); - ASSERT(sig); - - while (sig != NULL) { - if (sig->fm_write_reply.actual <= 0) { - int status; - - status = efs_status_to_errno(sig->fm_write_reply.status); - driver_select(data->port_num, ready_fd, ERL_DRV_WRITE, 0); - DISPATCH_AIO(sig); - FREE_AIO(sig->fm_write_reply.buffer); - - driver_failure_posix(data->port_num, status); - } - else { /* written bytes > 0 */ - iov = driver_peekq(data->port_num, &vlen); - if (vlen > 0) { - DISPATCH_AIO(sig); - FREE_AIO(sig->fm_write_reply.buffer); - res = driver_deq(data->port_num, iov[0].iov_len); - if (res > 0) { - iov = driver_peekq(data->port_num, &vlen); - WRITE_AIO(data->ofd, iov[0].iov_len, iov[0].iov_base); - } - } - else if (vlen == 0) { - DISPATCH_AIO(sig); - FREE_AIO(sig->fm_write_reply.buffer); - } - - } - sig = erl_drv_ose_get_signal(ready_fd); - } -} - -static void stop_select(ErlDrvEvent ready_fd, void* _) -{ - int *fd; - erl_drv_ose_event_fetch(ready_fd, NULL, NULL, (void **)&fd); - erl_drv_ose_event_free(ready_fd); - close(*fd); -} - - -void erts_do_break_handling(void) -{ - struct termios temp_mode; - int saved = 0; - - /* - * Most functions that do_break() calls are intentionally not thread safe; - * therefore, make sure that all threads but this one are blocked before - * proceeding! - */ - erts_smp_thr_progress_block(); - - /* during break we revert to initial settings */ - /* this is done differently for oldshell */ - if (using_oldshell && !replace_intr) { - SET_BLOCKING(1); - } - else if (isatty(0)) { - tcgetattr(0,&temp_mode); - tcsetattr(0,TCSANOW,&initial_tty_mode); - saved = 1; - } - - /* call the break handling function, reset the flag */ - do_break(); - - fflush(stdout); - - /* after break we go back to saved settings */ - if (using_oldshell && !replace_intr) { - SET_NONBLOCKING(1); - } - else if (saved) { - tcsetattr(0,TCSANOW,&temp_mode); - } - - erts_smp_thr_progress_unblock(); -} - -static pid_t -getpid(void) -{ - return get_bid(current_process()); -} - -int getpagesize(void) -{ - return 1024; -} - - -/* Fills in the systems representation of the jam/beam process identifier. -** The Pid is put in STRING representation in the supplied buffer, -** no interpretatione of this should be done by the rest of the -** emulator. The buffer should be at least 21 bytes long. -*/ -void sys_get_pid(char *buffer, size_t buffer_size){ - pid_t p = getpid(); - /* Assume the pid is scalar and can rest in an unsigned long... */ - erts_snprintf(buffer, buffer_size, "%lu",(unsigned long) p); -} - -int -erts_sys_putenv_raw(char *key, char *value) { - return erts_sys_putenv(key, value); -} -int -erts_sys_putenv(char *key, char *value) -{ - int res; - - erts_smp_rwmtx_rwlock(&environ_rwmtx); - res = set_env(get_bid(current_process()), key, - value); - erts_smp_rwmtx_rwunlock(&environ_rwmtx); - return res; -} - - -int -erts_sys_unsetenv(char *key) -{ - int res; - - erts_smp_rwmtx_rwlock(&environ_rwmtx); - res = set_env(get_bid(current_process()),key,NULL); - erts_smp_rwmtx_rwunlock(&environ_rwmtx); - - return res; -} - -int -erts_sys_getenv__(char *key, char *value, size_t *size) -{ - int res; - char *orig_value = get_env(get_bid(current_process()), key); - if (!orig_value) - res = -1; - else { - size_t len = sys_strlen(orig_value); - if (len >= *size) { - *size = len + 1; - res = 1; - } - else { - *size = len; - sys_memcpy((void *) value, (void *) orig_value, len+1); - res = 0; - } - free_buf((union SIGNAL **)&orig_value); - } - return res; -} - -int -erts_sys_getenv_raw(char *key, char *value, size_t *size) { - return erts_sys_getenv(key, value, size); -} - -/* - * erts_sys_getenv - * returns: - * -1, if environment key is not set with a value - * 0, if environment key is set and value fits into buffer res - * 1, if environment key is set but does not fit into buffer res - * res is set with the needed buffer res value - */ - -int -erts_sys_getenv(char *key, char *value, size_t *size) -{ - int res; - erts_smp_rwmtx_rlock(&environ_rwmtx); - res = erts_sys_getenv__(key, value, size); - erts_smp_rwmtx_runlock(&environ_rwmtx); - return res; -} - -void -sys_init_io(void) -{ - fd_data = (struct fd_data *) - erts_alloc(ERTS_ALC_T_FD_TAB, max_files * sizeof(struct fd_data)); - erts_smp_atomic_add_nob(&sys_misc_mem_sz, - max_files * sizeof(struct fd_data)); -} - -extern const char pre_loaded_code[]; -extern Preload pre_loaded[]; - -void erts_sys_alloc_init(void) -{ -} - -void *erts_sys_alloc(ErtsAlcType_t t, void *x, Uint sz) -{ - void *res = malloc((size_t) sz); -#if HAVE_ERTS_MSEG - if (!res) { - erts_mseg_clear_cache(); - return malloc((size_t) sz); - } -#endif - return res; -} - -void *erts_sys_realloc(ErtsAlcType_t t, void *x, void *p, Uint sz) -{ - void *res = realloc(p, (size_t) sz); -#if HAVE_ERTS_MSEG - if (!res) { - erts_mseg_clear_cache(); - return realloc(p, (size_t) sz); - } -#endif - return res; -} - -void erts_sys_free(ErtsAlcType_t t, void *x, void *p) -{ - free(p); -} - -/* Return a pointer to a vector of names of preloaded modules */ - -Preload* -sys_preloaded(void) -{ - return pre_loaded; -} - -/* Return a pointer to preloaded code for module "module" */ -unsigned char* -sys_preload_begin(Preload* p) -{ - return p->code; -} - -/* Clean up if allocated */ -void sys_preload_end(Preload* p) -{ - /* Nothing */ -} - -/* Read a key from console (?) */ - -int sys_get_key(fd) -int fd; -{ - int c; - unsigned char rbuf[64]; - - fflush(stdout); /* Flush query ??? */ - - if ((c = read(fd,rbuf,64)) <= 0) { - return c; - } - - return rbuf[0]; -} - - -#ifdef DEBUG - -extern int erts_initialized; -void -erl_assert_error(const char* expr, const char* func, - const char* file, int line) -{ - fflush(stdout); - fprintf(stderr, "%s:%d:%s() Assertion failed: %s\n", - file, line, func, expr); - fflush(stderr); - ramlog_printf("%s:%d:%s() Assertion failed: %s\n", - file, line, func, expr); - - abort(); -} - -void -erl_debug(char* fmt, ...) -{ - char sbuf[1024]; /* Temporary buffer. */ - va_list va; - - if (debug_log) { - va_start(va, fmt); - vsprintf(sbuf, fmt, va); - va_end(va); - fprintf(stderr, "%s", sbuf); - } -} - -#endif /* DEBUG */ - -static ERTS_INLINE void -report_exit_status(ErtsSysReportExit *rep, int status) -{ - if (rep->ifd >= 0) { - driver_data[rep->ifd].alive = 0; - driver_data[rep->ifd].status = status; - } - if (rep->ofd >= 0) { - driver_data[rep->ofd].alive = 0; - driver_data[rep->ofd].status = status; - } - - erts_free(ERTS_ALC_T_PRT_REP_EXIT, rep); -} - -#define ERTS_REPORT_EXIT_STATUS report_exit_status - -/* - * Called from schedule() when it runs out of runnable processes, - * or when Erlang code has performed INPUT_REDUCTIONS reduction - * steps. runnable == 0 iff there are no runnable Erlang processes. - */ -void -erl_sys_schedule(int runnable) -{ - ASSERT(get_fsem(current_process()) == 0); -#ifdef ERTS_SMP - ASSERT(erts_get_scheduler_data()->no == 1); - ERTS_CHK_IO(!runnable); -#else - ERTS_CHK_IO( 1 ); -#endif - ASSERT(get_fsem(current_process()) == 0); - ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); -} - - -#ifdef ERTS_SMP - -void -erts_sys_main_thread(void) -{ - erts_thread_disable_fpe(); - - /* Become signal receiver thread... */ -#ifdef ERTS_ENABLE_LOCK_CHECK - erts_lc_set_thread_name("signal_receiver"); -#endif - - while (1) { - static const SIGSELECT sigsel[] = {0}; - union SIGNAL *msg = receive(sigsel); - - fprintf(stderr,"Main thread got message %d from 0x%x!!\r\n", - msg->sig_no, sender(&msg)); - free_buf(&msg); - } -} - -#endif /* ERTS_SMP */ - -void -erl_sys_args(int* argc, char** argv) -{ - int i, j; - - erts_smp_rwmtx_init(&environ_rwmtx, "environ"); - - init_check_io(); - - /* Handled arguments have been marked with NULL. Slide arguments - not handled towards the beginning of argv. */ - for (i = 0, j = 0; i < *argc; i++) { - if (argv[i]) - argv[j++] = argv[i]; - } - *argc = j; - -} diff --git a/erts/emulator/sys/ose/sys_float.c b/erts/emulator/sys/ose/sys_float.c deleted file mode 100644 index 51875792ae..0000000000 --- a/erts/emulator/sys/ose/sys_float.c +++ /dev/null @@ -1,845 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#include "sys.h" -#include "global.h" -#include "erl_process.h" - - -#ifdef NO_FPE_SIGNALS - -void -erts_sys_init_float(void) -{ -# ifdef SIGFPE - sys_sigset(SIGFPE, SIG_IGN); /* Ignore so we can test for NaN and Inf */ -# endif -} - -#else /* !NO_FPE_SIGNALS */ - -#ifdef ERTS_SMP -static erts_tsd_key_t fpe_key; - -/* once-only initialisation early in the main thread (via erts_sys_init_float()) */ -static void erts_init_fp_exception(void) -{ - /* XXX: the wrappers prevent using a pthread destructor to - deallocate the key's value; so when/where do we do that? */ - erts_tsd_key_create(&fpe_key); -} - -void erts_thread_init_fp_exception(void) -{ - unsigned long *fpe = erts_alloc(ERTS_ALC_T_FP_EXCEPTION, sizeof(*fpe)); - *fpe = 0L; - erts_tsd_set(fpe_key, fpe); -} - -static ERTS_INLINE volatile unsigned long *erts_thread_get_fp_exception(void) -{ - return (volatile unsigned long*)erts_tsd_get(fpe_key); -} -#else /* !SMP */ -#define erts_init_fp_exception() /*empty*/ -static volatile unsigned long fp_exception; -#define erts_thread_get_fp_exception() (&fp_exception) -#endif /* SMP */ - -volatile unsigned long *erts_get_current_fp_exception(void) -{ - Process *c_p; - - c_p = erts_get_current_process(); - if (c_p) - return &c_p->fp_exception; - return erts_thread_get_fp_exception(); -} - -static void set_current_fp_exception(unsigned long pc) -{ - volatile unsigned long *fpexnp = erts_get_current_fp_exception(); - ASSERT(fpexnp != NULL); - *fpexnp = pc; -} - -void erts_fp_check_init_error(volatile unsigned long *fpexnp) -{ - char buf[64]; - 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) - erts_exit(ERTS_ABORT_EXIT, "%s", buf); - *fpexnp = 0; -#if defined(__i386__) || defined(__x86_64__) - erts_restore_fpu(); -#endif -} - -/* Is there no standard identifier for Darwin/MacOSX ? */ -#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) -#define __DARWIN__ 1 -#endif - -#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__) - -static void unmask_x87(void) -{ - unsigned short cw; - - __asm__ __volatile__("fstcw %0" : "=m"(cw)); - cw &= ~(0x01|0x04|0x08); /* unmask IM, ZM, OM */ - __asm__ __volatile__("fldcw %0" : : "m"(cw)); -} - -/* mask x87 FPE, return true if the previous state was unmasked */ -static int mask_x87(void) -{ - unsigned short cw; - int unmasked; - - __asm__ __volatile__("fstcw %0" : "=m"(cw)); - unmasked = (cw & (0x01|0x04|0x08)) == 0; - /* or just set cw = 0x37f */ - cw |= (0x01|0x04|0x08); /* mask IM, ZM, OM */ - __asm__ __volatile__("fldcw %0" : : "m"(cw)); - return unmasked; -} - -static void unmask_sse2(void) -{ - unsigned int mxcsr; - - __asm__ __volatile__("stmxcsr %0" : "=m"(mxcsr)); - mxcsr &= ~(0x003F|0x0680); /* clear exn flags, unmask OM, ZM, IM (not PM, UM, DM) */ - __asm__ __volatile__("ldmxcsr %0" : : "m"(mxcsr)); -} - -/* mask SSE2 FPE, return true if the previous state was unmasked */ -static int mask_sse2(void) -{ - unsigned int mxcsr; - int unmasked; - - __asm__ __volatile__("stmxcsr %0" : "=m"(mxcsr)); - unmasked = (mxcsr & 0x0680) == 0; - /* or just set mxcsr = 0x1f80 */ - mxcsr &= ~0x003F; /* clear exn flags */ - mxcsr |= 0x0680; /* mask OM, ZM, IM (not PM, UM, DM) */ - __asm__ __volatile__("ldmxcsr %0" : : "m"(mxcsr)); - return unmasked; -} - -#if defined(__x86_64__) - -static inline int cpu_has_sse2(void) { return 1; } - -#else /* !__x86_64__ */ - -/* - * Check if an x86-32 processor has SSE2. - */ -static unsigned int xor_eflags(unsigned int mask) -{ - unsigned int eax, edx; - - eax = mask; /* eax = mask */ - __asm__("pushfl\n\t" - "popl %0\n\t" /* edx = original EFLAGS */ - "xorl %0, %1\n\t" /* eax = mask ^ EFLAGS */ - "pushl %1\n\t" - "popfl\n\t" /* new EFLAGS = mask ^ original EFLAGS */ - "pushfl\n\t" - "popl %1\n\t" /* eax = new EFLAGS */ - "xorl %0, %1\n\t" /* eax = new EFLAGS ^ old EFLAGS */ - "pushl %0\n\t" - "popfl" /* restore original EFLAGS */ - : "=d"(edx), "=a"(eax) - : "1"(eax)); - return eax; -} - -static __inline__ unsigned int cpuid_eax(unsigned int op) -{ - unsigned int eax, save_ebx; - - /* In PIC mode i386 reserves EBX. So we must save - and restore it ourselves to not upset gcc. */ - __asm__( - "movl %%ebx, %1\n\t" - "cpuid\n\t" - "movl %1, %%ebx" - : "=a"(eax), "=m"(save_ebx) - : "0"(op) - : "cx", "dx"); - return eax; -} - -static __inline__ unsigned int cpuid_edx(unsigned int op) -{ - unsigned int eax, edx, save_ebx; - - /* In PIC mode i386 reserves EBX. So we must save - and restore it ourselves to not upset gcc. */ - __asm__( - "movl %%ebx, %2\n\t" - "cpuid\n\t" - "movl %2, %%ebx" - : "=a"(eax), "=d"(edx), "=m"(save_ebx) - : "0"(op) - : "cx"); - return edx; -} - -/* The AC bit, bit #18, is a new bit introduced in the EFLAGS - * register on the Intel486 processor to generate alignment - * faults. This bit cannot be set on the Intel386 processor. - */ -static __inline__ int is_386(void) -{ - return ((xor_eflags(1<<18) >> 18) & 1) == 0; -} - -/* Newer x86 processors have a CPUID instruction, as indicated by - * the ID bit (#21) in EFLAGS being modifiable. - */ -static __inline__ int has_CPUID(void) -{ - return (xor_eflags(1<<21) >> 21) & 1; -} - -static int cpu_has_sse2(void) -{ - unsigned int maxlev, features; - static int has_sse2 = -1; - - if (has_sse2 >= 0) - return has_sse2; - has_sse2 = 0; - - if (is_386()) - return 0; - if (!has_CPUID()) - return 0; - maxlev = cpuid_eax(0); - /* Intel A-step Pentium had a preliminary version of CPUID. - It also didn't have SSE2. */ - if ((maxlev & 0xFFFFFF00) == 0x0500) - return 0; - /* If max level is zero then CPUID cannot report any features. */ - if (maxlev == 0) - return 0; - features = cpuid_edx(1); - has_sse2 = (features & (1 << 26)) != 0; - - return has_sse2; -} -#endif /* !__x86_64__ */ - -static void unmask_fpe(void) -{ - __asm__ __volatile__("fnclex"); - unmask_x87(); - if (cpu_has_sse2()) - unmask_sse2(); -} - -static void unmask_fpe_conditional(int unmasked) -{ - if (unmasked) - unmask_fpe(); -} - -/* mask x86 FPE, return true if the previous state was unmasked */ -static int mask_fpe(void) -{ - int unmasked; - - unmasked = mask_x87(); - if (cpu_has_sse2()) - unmasked |= mask_sse2(); - return unmasked; -} - -void erts_restore_fpu(void) -{ - __asm__ __volatile__("fninit"); - unmask_x87(); - if (cpu_has_sse2()) - unmask_sse2(); -} - -#elif defined(__sparc__) && defined(__linux__) - -#if defined(__arch64__) -#define LDX "ldx" -#define STX "stx" -#else -#define LDX "ld" -#define STX "st" -#endif - -static void unmask_fpe(void) -{ - unsigned long fsr; - - __asm__(STX " %%fsr, %0" : "=m"(fsr)); - fsr &= ~(0x1FUL << 23); /* clear FSR[TEM] field */ - fsr |= (0x1AUL << 23); /* enable NV, OF, DZ exceptions */ - __asm__ __volatile__(LDX " %0, %%fsr" : : "m"(fsr)); -} - -static void unmask_fpe_conditional(int unmasked) -{ - if (unmasked) - unmask_fpe(); -} - -/* mask SPARC FPE, return true if the previous state was unmasked */ -static int mask_fpe(void) -{ - unsigned long fsr; - int unmasked; - - __asm__(STX " %%fsr, %0" : "=m"(fsr)); - unmasked = ((fsr >> 23) & 0x1A) == 0x1A; - fsr &= ~(0x1FUL << 23); /* clear FSR[TEM] field */ - __asm__ __volatile__(LDX " %0, %%fsr" : : "m"(fsr)); - return unmasked; -} - -#elif (defined(__powerpc__) && defined(__linux__)) || (defined(__ppc__) && defined(__DARWIN__)) - -#if defined(__linux__) -#include <sys/prctl.h> - -static void set_fpexc_precise(void) -{ - if (prctl(PR_SET_FPEXC, PR_FP_EXC_PRECISE) < 0) { - perror("PR_SET_FPEXC"); - exit(1); - } -} - -#elif defined(__DARWIN__) - -#include <mach/mach.h> -#include <pthread.h> - -/* - * FE0 FE1 MSR bits - * 0 0 floating-point exceptions disabled - * 0 1 floating-point imprecise nonrecoverable - * 1 0 floating-point imprecise recoverable - * 1 1 floating-point precise mode - * - * Apparently: - * - Darwin 5.5 (MacOS X <= 10.1) starts with FE0 == FE1 == 0, - * and resets FE0 and FE1 to 0 after each SIGFPE. - * - Darwin 6.0 (MacOS X 10.2) starts with FE0 == FE1 == 1, - * and does not reset FE0 or FE1 after a SIGFPE. - */ -#define FE0_MASK (1<<11) -#define FE1_MASK (1<<8) - -/* a thread cannot get or set its own MSR bits */ -static void *fpu_fpe_enable(void *arg) -{ - thread_t t = *(thread_t*)arg; - struct ppc_thread_state state; - unsigned int state_size = PPC_THREAD_STATE_COUNT; - - if (thread_get_state(t, PPC_THREAD_STATE, (natural_t*)&state, &state_size) != KERN_SUCCESS) { - perror("thread_get_state"); - exit(1); - } - if ((state.srr1 & (FE1_MASK|FE0_MASK)) != (FE1_MASK|FE0_MASK)) { -#if 1 - /* This would also have to be performed in the SIGFPE handler - to work around the MSR reset older Darwin releases do. */ - state.srr1 |= (FE1_MASK|FE0_MASK); - thread_set_state(t, PPC_THREAD_STATE, (natural_t*)&state, state_size); -#else - fprintf(stderr, "srr1 == 0x%08x, your Darwin is too old\n", state.srr1); - exit(1); -#endif - } - return NULL; /* Ok, we appear to be on Darwin 6.0 or later */ -} - -static void set_fpexc_precise(void) -{ - thread_t self = mach_thread_self(); - pthread_t enabler; - - if (pthread_create(&enabler, NULL, fpu_fpe_enable, &self)) { - perror("pthread_create"); - } else if (pthread_join(enabler, NULL)) { - perror("pthread_join"); - } -} - -#endif - -static void set_fpscr(unsigned int fpscr) -{ - union { - double d; - unsigned int fpscr[2]; - } u; - - u.fpscr[0] = 0xFFF80000; - u.fpscr[1] = fpscr; - __asm__ __volatile__("mtfsf 255,%0" : : "f"(u.d)); -} - -static unsigned int get_fpscr(void) -{ - union { - double d; - unsigned int fpscr[2]; - } u; - - __asm__("mffs %0" : "=f"(u.d)); - return u.fpscr[1]; -} - -static void unmask_fpe(void) -{ - set_fpexc_precise(); - set_fpscr(0x80|0x40|0x10); /* VE, OE, ZE; not UE or XE */ -} - -static void unmask_fpe_conditional(int unmasked) -{ - if (unmasked) - unmask_fpe(); -} - -/* mask PowerPC FPE, return true if the previous state was unmasked */ -static int mask_fpe(void) -{ - int unmasked; - - unmasked = (get_fpscr() & (0x80|0x40|0x10)) == (0x80|0x40|0x10); - set_fpscr(0x00); - return unmasked; -} - -#else - -static void unmask_fpe(void) -{ - fpsetmask(FP_X_INV | FP_X_OFL | FP_X_DZ); -} - -static void unmask_fpe_conditional(int unmasked) -{ - if (unmasked) - unmask_fpe(); -} - -/* mask IEEE FPE, return true if previous state was unmasked */ -static int mask_fpe(void) -{ - const fp_except unmasked_mask = FP_X_INV | FP_X_OFL | FP_X_DZ; - fp_except old_mask; - - old_mask = fpsetmask(0); - return (old_mask & unmasked_mask) == unmasked_mask; -} - -#endif - -#if (defined(__linux__) && (defined(__i386__) || defined(__x86_64__) || defined(__sparc__) || defined(__powerpc__))) || (defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__) || defined(__ppc__))) || (defined(__FreeBSD__) && (defined(__x86_64__) || defined(__i386__))) || ((defined(__NetBSD__) || defined(__OpenBSD__)) && defined(__x86_64__)) || (defined(__sun__) && defined(__x86_64__)) - -#if defined(__linux__) && defined(__i386__) -#if !defined(X86_FXSR_MAGIC) -#define X86_FXSR_MAGIC 0x0000 -#endif -#elif defined(__FreeBSD__) && defined(__x86_64__) -#include <sys/types.h> -#include <machine/fpu.h> -#elif defined(__FreeBSD__) && defined(__i386__) -#include <sys/types.h> -#include <machine/npx.h> -#elif defined(__DARWIN__) -#include <machine/signal.h> -#elif defined(__OpenBSD__) && defined(__x86_64__) -#include <sys/types.h> -#include <machine/fpu.h> -#endif -#if !(defined(__OpenBSD__) && defined(__x86_64__)) -#include <ucontext.h> -#endif -#include <string.h> - -#if defined(__linux__) && defined(__x86_64__) -#define mc_pc(mc) ((mc)->gregs[REG_RIP]) -#elif defined(__linux__) && defined(__i386__) -#define mc_pc(mc) ((mc)->gregs[REG_EIP]) -#elif defined(__DARWIN__) && defined(__i386__) -#ifdef DARWIN_MODERN_MCONTEXT -#define mc_pc(mc) ((mc)->__ss.__eip) -#else -#define mc_pc(mc) ((mc)->ss.eip) -#endif -#elif defined(__DARWIN__) && defined(__x86_64__) -#ifdef DARWIN_MODERN_MCONTEXT -#define mc_pc(mc) ((mc)->__ss.__rip) -#else -#define mc_pc(mc) ((mc)->ss.rip) -#endif -#elif defined(__FreeBSD__) && defined(__x86_64__) -#define mc_pc(mc) ((mc)->mc_rip) -#elif defined(__FreeBSD__) && defined(__i386__) -#define mc_pc(mc) ((mc)->mc_eip) -#elif defined(__NetBSD__) && defined(__x86_64__) -#define mc_pc(mc) ((mc)->__gregs[_REG_RIP]) -#elif defined(__NetBSD__) && defined(__i386__) -#define mc_pc(mc) ((mc)->__gregs[_REG_EIP]) -#elif defined(__OpenBSD__) && defined(__x86_64__) -#define mc_pc(mc) ((mc)->sc_rip) -#elif defined(__sun__) && defined(__x86_64__) -#define mc_pc(mc) ((mc)->gregs[REG_RIP]) -#endif - -static void fpe_sig_action(int sig, siginfo_t *si, void *puc) -{ - ucontext_t *uc = puc; - unsigned long pc; - -#if defined(__linux__) -#if defined(__x86_64__) - mcontext_t *mc = &uc->uc_mcontext; - fpregset_t fpstate = mc->fpregs; - pc = mc_pc(mc); - /* A failed SSE2 instruction will restart. To avoid - looping we mask SSE2 exceptions now and unmask them - again later in erts_check_fpe()/erts_restore_fpu(). - On RISCs we update PC to skip the failed instruction, - but the ever increasing complexity of the x86 instruction - set encoding makes that a poor solution here. */ - fpstate->mxcsr = 0x1F80; - fpstate->swd &= ~0xFF; -#elif defined(__i386__) - mcontext_t *mc = &uc->uc_mcontext; - fpregset_t fpstate = mc->fpregs; - pc = mc_pc(mc); - if ((fpstate->status >> 16) == X86_FXSR_MAGIC) - ((struct _fpstate*)fpstate)->mxcsr = 0x1F80; - fpstate->sw &= ~0xFF; -#elif defined(__sparc__) && defined(__arch64__) - /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */ - struct sigcontext *sc = (struct sigcontext*)puc; - pc = sc->sigc_regs.tpc; - sc->sigc_regs.tpc = sc->sigc_regs.tnpc; - sc->sigc_regs.tnpc += 4; -#elif defined(__sparc__) - /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */ - struct sigcontext *sc = (struct sigcontext*)puc; - pc = sc->si_regs.pc; - sc->si_regs.pc = sc->si_regs.npc; - sc->si_regs.npc = (unsigned long)sc->si_regs.npc + 4; -#elif defined(__powerpc__) -#if defined(__powerpc64__) - mcontext_t *mc = &uc->uc_mcontext; - unsigned long *regs = &mc->gp_regs[0]; -#else - mcontext_t *mc = uc->uc_mcontext.uc_regs; - unsigned long *regs = &mc->gregs[0]; -#endif - pc = regs[PT_NIP]; - regs[PT_NIP] += 4; - regs[PT_FPSCR] = 0x80|0x40|0x10; /* VE, OE, ZE; not UE or XE */ -#endif -#elif defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__)) -#ifdef DARWIN_MODERN_MCONTEXT - mcontext_t mc = uc->uc_mcontext; - pc = mc_pc(mc); - mc->__fs.__fpu_mxcsr = 0x1F80; - *(unsigned short *)&mc->__fs.__fpu_fsw &= ~0xFF; -#else - mcontext_t mc = uc->uc_mcontext; - pc = mc_pc(mc); - mc->fs.fpu_mxcsr = 0x1F80; - *(unsigned short *)&mc->fs.fpu_fsw &= ~0xFF; -#endif /* DARWIN_MODERN_MCONTEXT */ -#elif defined(__DARWIN__) && defined(__ppc__) - mcontext_t mc = uc->uc_mcontext; - pc = mc->ss.srr0; - mc->ss.srr0 += 4; - mc->fs.fpscr = 0x80|0x40|0x10; -#elif defined(__FreeBSD__) && defined(__x86_64__) - mcontext_t *mc = &uc->uc_mcontext; - struct savefpu *savefpu = (struct savefpu*)&mc->mc_fpstate; - struct envxmm *envxmm = &savefpu->sv_env; - pc = mc_pc(mc); - envxmm->en_mxcsr = 0x1F80; - envxmm->en_sw &= ~0xFF; -#elif defined(__FreeBSD__) && defined(__i386__) - mcontext_t *mc = &uc->uc_mcontext; - union savefpu *savefpu = (union savefpu*)&mc->mc_fpstate; - pc = mc_pc(mc); - if (mc->mc_fpformat == _MC_FPFMT_XMM) { - struct envxmm *envxmm = &savefpu->sv_xmm.sv_env; - envxmm->en_mxcsr = 0x1F80; - envxmm->en_sw &= ~0xFF; - } else { - struct env87 *env87 = &savefpu->sv_87.sv_env; - env87->en_sw &= ~0xFF; - } -#elif defined(__NetBSD__) && defined(__x86_64__) - mcontext_t *mc = &uc->uc_mcontext; - struct fxsave64 *fxsave = (struct fxsave64 *)&mc->__fpregs; - pc = mc_pc(mc); - fxsave->fx_mxcsr = 0x1F80; - fxsave->fx_fsw &= ~0xFF; -#elif defined(__NetBSD__) && defined(__i386__) - mcontext_t *mc = &uc->uc_mcontext; - pc = mc_pc(mc); - if (uc->uc_flags & _UC_FXSAVE) { - struct envxmm *envxmm = (struct envxmm *)&mc->__fpregs; - envxmm->en_mxcsr = 0x1F80; - envxmm->en_sw &= ~0xFF; - } else { - struct env87 *env87 = (struct env87 *)&mc->__fpregs; - env87->en_sw &= ~0xFF; - } -#elif defined(__OpenBSD__) && defined(__x86_64__) - struct fxsave64 *fxsave = uc->sc_fpstate; - pc = mc_pc(uc); - fxsave->fx_mxcsr = 0x1F80; - fxsave->fx_fsw &= ~0xFF; -#elif defined(__sun__) && defined(__x86_64__) - mcontext_t *mc = &uc->uc_mcontext; - struct fpchip_state *fpstate = &mc->fpregs.fp_reg_set.fpchip_state; - pc = mc_pc(mc); - fpstate->mxcsr = 0x1F80; - fpstate->sw &= ~0xFF; -#endif -#if 0 - { - char buf[64]; - snprintf(buf, sizeof buf, "%s: FPE at %p\r\n", __FUNCTION__, (void*)pc); - write(2, buf, strlen(buf)); - } -#endif - set_current_fp_exception(pc); -} - -static void erts_thread_catch_fp_exceptions(void) -{ - struct sigaction act; - memset(&act, 0, sizeof act); - act.sa_sigaction = fpe_sig_action; - act.sa_flags = SA_SIGINFO; - sigaction(SIGFPE, &act, NULL); - unmask_fpe(); -} - -#else /* !((__linux__ && (__i386__ || __x86_64__ || __powerpc__)) || (__DARWIN__ && (__i386__ || __x86_64__ || __ppc__))) */ - -static void fpe_sig_handler(int sig) -{ - set_current_fp_exception(1); /* XXX: convert to sigaction so we can get the trap PC */ -} - -static void erts_thread_catch_fp_exceptions(void) -{ - sys_sigset(SIGFPE, fpe_sig_handler); - unmask_fpe(); -} - -#endif /* (__linux__ && (__i386__ || __x86_64__ || __powerpc__)) || (__DARWIN__ && (__i386__ || __x86_64__ || __ppc__))) */ - -/* once-only initialisation early in the main thread */ -void erts_sys_init_float(void) -{ - erts_init_fp_exception(); - erts_thread_catch_fp_exceptions(); - erts_printf_block_fpe = erts_sys_block_fpe; - erts_printf_unblock_fpe = erts_sys_unblock_fpe; -} - -#endif /* NO_FPE_SIGNALS */ - -void erts_thread_init_float(void) -{ -#ifdef ERTS_SMP - /* This allows Erlang schedulers to leave Erlang-process context - and still have working FP exceptions. XXX: is this needed? */ - erts_thread_init_fp_exception(); -#endif - -#ifndef NO_FPE_SIGNALS - /* NOTE: - * erts_thread_disable_fpe() is called in all threads at - * creation. We at least need to call unmask_fpe() - */ -#if defined(__DARWIN__) || defined(__FreeBSD__) - /* Darwin (7.9.0) does not appear to propagate FP exception settings - to a new thread from its parent. So if we want FP exceptions, we - must manually re-enable them in each new thread. - FreeBSD 6.1 appears to suffer from a similar issue. */ - erts_thread_catch_fp_exceptions(); -#else - unmask_fpe(); -#endif - -#endif -} - -void erts_thread_disable_fpe(void) -{ -#if !defined(NO_FPE_SIGNALS) - (void)mask_fpe(); -#endif -} - -#if !defined(NO_FPE_SIGNALS) -int erts_sys_block_fpe(void) -{ - return mask_fpe(); -} - -void erts_sys_unblock_fpe(int unmasked) -{ - unmask_fpe_conditional(unmasked); -} -#endif - -/* The following check is incorporated from the Vee machine */ - -#define ISDIGIT(d) ((d) >= '0' && (d) <= '9') - -/* - ** Convert a double to ascii format 0.dddde[+|-]ddd - ** return number of characters converted or -1 if error. - ** - ** These two functions should maybe use localeconv() to pick up - ** the current radix character, but since it is uncertain how - ** expensive such a system call is, and since no-one has heard - ** of other radix characters than '.' and ',' an ad-hoc - ** low execution time solution is used instead. - */ - -int -sys_double_to_chars_ext(double fp, char *buffer, size_t buffer_size, size_t decimals) -{ - char *s = buffer; - - if (erts_snprintf(buffer, buffer_size, "%.*e", decimals, fp) >= buffer_size) - return -1; - /* Search upto decimal point */ - if (*s == '+' || *s == '-') s++; - while (ISDIGIT(*s)) s++; - if (*s == ',') *s++ = '.'; /* Replace ',' with '.' */ - /* Scan to end of string */ - while (*s) s++; - return s-buffer; /* i.e strlen(buffer) */ -} - -/* Float conversion */ - -int -sys_chars_to_double(char* buf, double* fp) -{ -#ifndef NO_FPE_SIGNALS - volatile unsigned long *fpexnp = erts_get_current_fp_exception(); -#endif - char *s = buf, *t, *dp; - - /* Robert says that something like this is what he really wanted: - * (The [.,] radix test is NOT what Robert wanted - it was added later) - * - * 7 == sscanf(Tbuf, "%[+-]%[0-9][.,]%[0-9]%[eE]%[+-]%[0-9]%s", ....); - * if (*s2 == 0 || *s3 == 0 || *s4 == 0 || *s6 == 0 || *s7) - * break; - */ - - /* Scan string to check syntax. */ - if (*s == '+' || *s == '-') s++; - if (!ISDIGIT(*s)) /* Leading digits. */ - return -1; - while (ISDIGIT(*s)) s++; - if (*s != '.' && *s != ',') /* Decimal part. */ - return -1; - dp = s++; /* Remember decimal point pos just in case */ - if (!ISDIGIT(*s)) - return -1; - while (ISDIGIT(*s)) s++; - if (*s == 'e' || *s == 'E') { - /* There is an exponent. */ - s++; - if (*s == '+' || *s == '-') s++; - if (!ISDIGIT(*s)) - return -1; - while (ISDIGIT(*s)) s++; - } - if (*s) /* That should be it */ - return -1; - -#ifdef NO_FPE_SIGNALS - errno = 0; -#endif - __ERTS_FP_CHECK_INIT(fpexnp); - *fp = strtod(buf, &t); - __ERTS_FP_ERROR_THOROUGH(fpexnp, *fp, return -1); - if (t != s) { /* Whole string not scanned */ - /* Try again with other radix char */ - *dp = (*dp == '.') ? ',' : '.'; - errno = 0; - __ERTS_FP_CHECK_INIT(fpexnp); - *fp = strtod(buf, &t); - __ERTS_FP_ERROR_THOROUGH(fpexnp, *fp, return -1); - } - -#ifdef NO_FPE_SIGNALS - if (errno == ERANGE) { - if (*fp == HUGE_VAL || *fp == -HUGE_VAL) { - /* overflow, should give error */ - return -1; - } else if (t == s && *fp == 0.0) { - /* This should give 0.0 - OTP-7178 */ - errno = 0; - - } else if (*fp == 0.0) { - return -1; - } - } -#endif - return 0; -} - -int -matherr(struct exception *exc) -{ -#if !defined(NO_FPE_SIGNALS) - volatile unsigned long *fpexnp = erts_get_current_fp_exception(); - if (fpexnp != NULL) - *fpexnp = (unsigned long)__builtin_return_address(0); -#endif - return 1; -} diff --git a/erts/emulator/sys/ose/sys_time.c b/erts/emulator/sys/ose/sys_time.c deleted file mode 100644 index 5dac75956a..0000000000 --- a/erts/emulator/sys/ose/sys_time.c +++ /dev/null @@ -1,57 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#include "sys.h" -#include "global.h" - -/******************* Routines for time measurement *********************/ - -int erts_ticks_per_sec = 0; /* Will be SYS_CLK_TCK in erl_unix_sys.h */ - -int sys_init_time(void) -{ - return SYS_CLOCK_RESOLUTION; -} - -clock_t sys_times(SysTimes *now) { - now->tms_utime = now->tms_stime = now->tms_cutime = now->tms_cstime = 0; - return 0; -} - -static OSTICK last_tick_count = 0; -static SysHrTime wrap = 0; -static OSTICK us_per_tick; - -void sys_init_hrtime() { - us_per_tick = system_tick(); -} - -SysHrTime sys_gethrtime() { - OSTICK ticks = get_ticks(); - if (ticks < (SysHrTime) last_tick_count) { - wrap += 1ULL << 32; - } - last_tick_count = ticks; - return ((((SysHrTime) ticks) + wrap) * 1000*us_per_tick); -} diff --git a/erts/emulator/sys/unix/driver_int.h b/erts/emulator/sys/unix/driver_int.h index a6b9085245..840b832878 100644 --- a/erts/emulator/sys/unix/driver_int.h +++ b/erts/emulator/sys/unix/driver_int.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c index a3c5c20641..6beb316350 100644 --- a/erts/emulator/sys/unix/erl_child_setup.c +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * Copyright Ericsson AB 2002-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -19,109 +19,234 @@ */ /* - * After a vfork() (or fork()) the child exec()s to this program which - * sets up the child and exec()s to the user program (see spawn_start() - * in sys.c and ticket OTP-4389). + * This program is started at erts startup and all fork's that + * have to be done are done in here. This is done for a couple + * of reasons: + * - Allow usage of fork without a memory explosion. + * -- we do not want to use vfork, as it blocks the VM + * until the execv is done, and if the program that + * is to be executed is on an NFS that is unavailable, + * the execv can block for a very long time. + * -- we cannot do fork inside the VM as that would temporarily + * duplicate the memory usage of the VM per parallel exec. + * + * Some implementation notes: + * - A single Unix Domain Socket is setup in between the VM and + * this program. Over that UDS the file descriptors that should + * be used to talk to the child program are sent. + * The actual command to execute, together with options and the + * environment, is sent over the pipe represented by the + * file descriptors mentioned above. We don't send the + * command over the UDS as that would increase the likely hood + * that it's buffer would be full. + * + * - Since it is this program that execv's, it has to take care of + * all the SIGCHLD signals that the child programs generate. The + * signals are received and the pid+exit reason is sent as data + * on the UDS to the VM. The VM is then able to map the pid to the + * port of the child program that just exited and deliver the status + * code if requested. */ #ifdef HAVE_CONFIG_H # include "config.h" #endif -#define NEED_CHILD_SETUP_DEFINES -#include "sys.h" -#include "erl_misc_utils.h" +#include <stdlib.h> +#include <stdio.h> +#include <sys/wait.h> -#ifdef SIG_SIGSET /* Old SysV */ -void sys_sigrelease(int sig) +#define WANT_NONBLOCKING + +#include "erl_driver.h" +#include "sys_uds.h" +#include "hash.h" +#include "erl_term.h" +#include "erl_child_setup.h" + +#define SET_CLOEXEC(fd) fcntl(fd, F_SETFD, fcntl(fd, F_GETFD) | FD_CLOEXEC) + +#if defined(__ANDROID__) +#define SHELL "/system/bin/sh" +#else +#define SHELL "/bin/sh" +#endif /* __ANDROID__ */ + +//#define HARD_DEBUG +#ifdef HARD_DEBUG +#define DEBUG_PRINT(fmt, ...) fprintf(stderr, fmt "\r\n", ##__VA_ARGS__) +#else +#define DEBUG_PRINT(fmt, ...) +#endif + +#define ABORT(fmt, ...) do { \ + fprintf(stderr, "erl_child_setup: " fmt "\r\n", ##__VA_ARGS__); \ + abort(); \ + } while(0) + +#ifdef DEBUG +void +erl_assert_error(const char* expr, const char* func, const char* file, int line) { - sigrelse(sig); + fflush(stdout); + fprintf(stderr, "%s:%d:%s() Assertion failed: %s\n", + file, line, func, expr); + fflush(stderr); + abort(); } -#else /* !SIG_SIGSET */ -#ifdef SIG_SIGNAL /* Old BSD */ -sys_sigrelease(int sig) +#endif + +void sys_sigblock(int sig) { - sigsetmask(sigblock(0) & ~sigmask(sig)); + sigset_t mask; + + sigemptyset(&mask); + sigaddset(&mask, sig); + sigprocmask(SIG_BLOCK, &mask, (sigset_t *)NULL); } -#else /* !SIG_SIGNAL */ /* The True Way - POSIX!:-) */ + void sys_sigrelease(int sig) { sigset_t mask; - sigemptyset(&mask); sigaddset(&mask, sig); sigprocmask(SIG_UNBLOCK, &mask, (sigset_t *)NULL); } -#endif /* !SIG_SIGNAL */ -#endif /* !SIG_SIGSET */ - -#if defined(__ANDROID__) -static int system_properties_fd(void); -#endif /* __ANDROID__ */ -#if defined(__ANDROID__) -#define SHELL "/system/bin/sh" -#else -#define SHELL "/bin/sh" -#endif /* __ANDROID__ */ +static void add_os_pid_to_port_id_mapping(Eterm, pid_t); +static Eterm get_port_id(pid_t); +static int forker_hash_init(void); +static int max_files = -1; +static int sigchld_pipe[2]; -int -main(int argc, char *argv[]) +static int +start_new_child(int pipes[]) { - int i, from, to; - int erts_spawn_executable = 0; + int size, res, i, pos = 0; + char *buff, *o_buff; + + char *cmd, *wd, **new_environ, **args = NULL; + + Sint cnt, flags; - /* OBSERVE! - * Keep child setup after fork() (implemented in sys.c) up to date - * if changes are made here. - */ + /* only child executes here */ - if (argc != CS_ARGV_NO_OF_ARGS) { - if (argc < CS_ARGV_NO_OF_ARGS) { - return 1; - } else { - erts_spawn_executable = 1; - } + do { + res = read(pipes[0], (char*)&size, sizeof(size)); + } while(res < 0 && (errno == EINTR || errno == ERRNO_BLOCK)); + + if (res <= 0) { + goto child_error; } - if (strcmp("false", argv[CS_ARGV_UNBIND_IX]) != 0) - if (erts_unbind_from_cpu_str(argv[CS_ARGV_UNBIND_IX]) != 0) - return 1; + buff = malloc(size); + + DEBUG_PRINT("size = %d", size); + + do { + if ((res = read(pipes[0], buff + pos, size - pos)) < 0) { + if (errno == ERRNO_BLOCK || errno == EINTR) + continue; + goto child_error; + } + if (res == 0) { + errno = EPIPE; + goto child_error; + } + pos += res; + } while(size - pos != 0); + + o_buff = buff; + + flags = get_int32(buff); + buff += sizeof(Sint32); - for (i = 0; i < CS_ARGV_NO_OF_DUP2_OPS; i++) { - if (argv[CS_ARGV_DUP2_OP_IX(i)][0] == '-' - && argv[CS_ARGV_DUP2_OP_IX(i)][1] == '\0') - break; - if (sscanf(argv[CS_ARGV_DUP2_OP_IX(i)], "%d:%d", &from, &to) != 2) - return 1; - if (dup2(from, to) < 0) - return 1; + DEBUG_PRINT("flags = %d", flags); + + cmd = buff; + buff += strlen(buff) + 1; + if (*buff == '\0') { + wd = NULL; + } else { + wd = buff; + buff += strlen(buff) + 1; } + buff++; - if (sscanf(argv[CS_ARGV_FD_CR_IX], "%d:%d", &from, &to) != 2) - return 1; + DEBUG_PRINT("wd = %s", wd); -#if defined(HAVE_CLOSEFROM) - closefrom(from); -#elif defined(__ANDROID__) - if (from <= to) { - int spfd = system_properties_fd(); - for (i = from; i <= to; i++) { - if (i != spfd) { - (void) close(i); - } - } + cnt = get_int32(buff); + buff += sizeof(Sint32); + new_environ = malloc(sizeof(char*)*(cnt + 1)); + + DEBUG_PRINT("env_len = %ld", cnt); + for (i = 0; i < cnt; i++, buff++) { + new_environ[i] = buff; + while(*buff != '\0') buff++; } -#else /* !__ANDROID__ */ - for (i = from; i <= to; i++) { - (void) close(i); + new_environ[cnt] = NULL; + + if (o_buff + size != buff) { + /* This is a spawn executable call */ + cnt = get_int32(buff); + buff += sizeof(Sint32); + args = malloc(sizeof(char*)*(cnt + 1)); + for (i = 0; i < cnt; i++, buff++) { + args[i] = buff; + while(*buff != '\0') buff++; + } + args[cnt] = NULL; } -#endif /* HAVE_CLOSEFROM */ - if (!(argv[CS_ARGV_WD_IX][0] == '.' && argv[CS_ARGV_WD_IX][1] == '\0') - && chdir(argv[CS_ARGV_WD_IX]) < 0) - return 1; + if (o_buff + size != buff) { + errno = EINVAL; + goto child_error; + } + + DEBUG_PRINT("read ack"); + do { + ErtsSysForkerProto proto; + res = read(pipes[0], &proto, sizeof(proto)); + if (res > 0) { + ASSERT(proto.action == ErtsSysForkerProtoAction_Ack); + ASSERT(res == sizeof(proto)); + } + } while(res < 0 && (errno == EINTR || errno == ERRNO_BLOCK)); + if (res < 1) { + errno = EPIPE; + goto child_error; + } + + DEBUG_PRINT("Do that forking business: '%s'\n",cmd); + + /* When the dup2'ing below is done, only + fd's 0, 1, 2 and maybe 3, 4 should survive the + exec. All other fds (i.e. the unix domain sockets + and stray pipe ends) should have CLOEXEC set on them + so they will be closed when the exec happens */ + if (flags & FORKER_FLAG_USE_STDIO) { + /* stdin for process */ + if (flags & FORKER_FLAG_DO_WRITE && + dup2(pipes[0], 0) < 0) + goto child_error; + /* stdout for process */ + if (flags & FORKER_FLAG_DO_READ && + dup2(pipes[1], 1) < 0) + goto child_error; + } + else { /* XXX will fail if pipes[0] == 4 (unlikely..) */ + if (flags & FORKER_FLAG_DO_READ && dup2(pipes[1], 4) < 0) + goto child_error; + if (flags & FORKER_FLAG_DO_WRITE && dup2(pipes[0], 3) < 0) + goto child_error; + } + + if (dup2(pipes[2], 2) < 0) + goto child_error; + + if (wd && chdir(wd) < 0) + goto child_error; #if defined(USE_SETPGRP_NOARGS) /* SysV */ (void) setpgrp(); @@ -131,34 +256,301 @@ main(int argc, char *argv[]) (void) setsid(); #endif + close(pipes[0]); + close(pipes[1]); + close(pipes[2]); + sys_sigrelease(SIGCHLD); - sys_sigrelease(SIGINT); - sys_sigrelease(SIGUSR1); - - if (erts_spawn_executable) { - if (argv[CS_ARGV_NO_OF_ARGS + 1] == NULL) { - execl(argv[CS_ARGV_NO_OF_ARGS],argv[CS_ARGV_NO_OF_ARGS], - (char *) NULL); - } else { - execv(argv[CS_ARGV_NO_OF_ARGS],&(argv[CS_ARGV_NO_OF_ARGS + 1])); - } + + if (args) { + /* spawn_executable */ + execve(cmd, args, new_environ); } else { - execl(SHELL, "sh", "-c", argv[CS_ARGV_CMD_IX], (char *) NULL); + execle(SHELL, "sh", "-c", cmd, (char *) NULL, new_environ); } - return 1; +child_error: + DEBUG_PRINT("exec error: %d\r\n",errno); + _exit(128 + errno); +} + + +/* + * [OTP-3906] + * Solaris signal management gets confused when threads are used and a + * lot of child processes dies. The confusion results in that SIGCHLD + * signals aren't delivered to the emulator which in turn results in + * a lot of defunct processes in the system. + * + * The problem seems to appear when a signal is frequently + * blocked/unblocked at the same time as the signal is frequently + * propagated. The child waiter thread is a workaround for this problem. + * The SIGCHLD signal is always blocked (in all threads), and the child + * waiter thread fetches the signal by a call to sigwait(). See + * child_waiter(). + * + * This should be a non-issue since the fork:ing was moved outside of + * the emulator into erl_child_setup. I'm leaving the comment here + * for posterity. */ + +static void handle_sigchld(int sig) { + int buff[2], res; + + sys_sigblock(SIGCHLD); + + while ((buff[0] = waitpid((pid_t)(-1), buff+1, WNOHANG)) > 0) { + do { + res = write(sigchld_pipe[1], buff, sizeof(buff)); + } while (res < 0 && errno == EINTR); + if (res <= 0) + ABORT("Failed to write to sigchld_pipe (%d): %d (%d)", sigchld_pipe[1], res, errno); + DEBUG_PRINT("Reap child %d (%d)", buff[0], buff[1]); + } + + sys_sigrelease(SIGCHLD); } #if defined(__ANDROID__) static int system_properties_fd(void) { - int fd; + static int fd = -2; char *env; + if (fd != -2) return fd; env = getenv("ANDROID_PROPERTY_WORKSPACE"); if (!env) { + fd = -1; return -1; } fd = atoi(env); return fd; } #endif /* __ANDROID__ */ + +int +main(int argc, char *argv[]) +{ + /* This fd should be open from beam */ + int uds_fd = 3, max_fd = 3; +#ifndef HAVE_CLOSEFROM + int i; +#endif + struct sigaction sa; + + if (argc < 1 || sscanf(argv[1],"%d",&max_files) != 1) { + ABORT("Invalid arguments to child_setup"); + } + +/* We close all fds except the uds from beam. + All other fds from now on will have the + CLOEXEC flags set on them. This means that we + only have to close a very limited number of fds + after we fork before the exec. */ +#if defined(HAVE_CLOSEFROM) + closefrom(4); +#else + for (i = 4; i < max_files; i++) +#if defined(__ANDROID__) + if (i != system_properties_fd()) +#endif + (void) close(i); +#endif + + if (pipe(sigchld_pipe) < 0) { + ABORT("Failed to setup sigchld pipe (%d)", errno); + } + + SET_CLOEXEC(sigchld_pipe[0]); + SET_CLOEXEC(sigchld_pipe[1]); + + max_fd = max_fd < sigchld_pipe[0] ? sigchld_pipe[0] : max_fd; + + sa.sa_handler = &handle_sigchld; + sigemptyset(&sa.sa_mask); + sa.sa_flags = SA_RESTART | SA_NOCLDSTOP; + if (sigaction(SIGCHLD, &sa, 0) == -1) { + perror(0); + exit(1); + } + + forker_hash_init(); + + SET_CLOEXEC(uds_fd); + + DEBUG_PRINT("Starting forker %d", max_files); + + while (1) { + fd_set read_fds; + int res; + FD_ZERO(&read_fds); + FD_SET(uds_fd, &read_fds); + FD_SET(sigchld_pipe[0], &read_fds); + DEBUG_PRINT("child_setup selecting on %d, %d (%d)", + uds_fd, sigchld_pipe[0], max_fd); + res = select(max_fd+1, &read_fds, NULL, NULL, NULL); + + if (res < 0) { + if (errno == EINTR) continue; + ABORT("Select failed: %d (%d)",res, errno); + } + + if (FD_ISSET(uds_fd, &read_fds)) { + int pipes[3], res, os_pid; + ErtsSysForkerProto proto; + errno = 0; + if ((res = sys_uds_read(uds_fd, (char*)&proto, sizeof(proto), + pipes, 3, MSG_DONTWAIT)) < 0) { + if (errno == EINTR) + continue; + DEBUG_PRINT("erl_child_setup failed to read from uds: %d, %d", res, errno); + _exit(0); + } + + if (res == 0) { + DEBUG_PRINT("uds was closed!"); + _exit(0); + } + /* Since we use unix domain sockets and send the entire data in + one go we *should* get the entire payload at once. */ + ASSERT(res == sizeof(proto)); + ASSERT(proto.action == ErtsSysForkerProtoAction_Start); + + sys_sigblock(SIGCHLD); + + errno = 0; + + os_pid = fork(); + if (os_pid == 0) + start_new_child(pipes); + + add_os_pid_to_port_id_mapping(proto.u.start.port_id, os_pid); + + /* We write an ack here, but expect the reply on + the pipes[0] inside the fork */ + proto.action = ErtsSysForkerProtoAction_Go; + proto.u.go.os_pid = os_pid; + proto.u.go.error_number = errno; + while (write(pipes[1], &proto, sizeof(proto)) < 0 && errno == EINTR) + ; /* remove gcc warning */ + +#ifdef FORKER_PROTO_START_ACK + proto.action = ErtsSysForkerProtoAction_StartAck; + while (write(uds_fd, &proto, sizeof(proto)) < 0 && errno == EINTR) + ; /* remove gcc warning */ +#endif + + sys_sigrelease(SIGCHLD); + close(pipes[0]); + close(pipes[1]); + close(pipes[2]); + } + + if (FD_ISSET(sigchld_pipe[0], &read_fds)) { + int ibuff[2]; + ErtsSysForkerProto proto; + res = read(sigchld_pipe[0], ibuff, sizeof(ibuff)); + if (res <= 0) { + if (errno == EINTR) + continue; + ABORT("Failed to read from sigchld pipe: %d (%d)", res, errno); + } + + proto.u.sigchld.port_id = get_port_id((pid_t)(ibuff[0])); + + if (proto.u.sigchld.port_id == THE_NON_VALUE) + continue; /* exit status report not requested */ + + proto.action = ErtsSysForkerProtoAction_SigChld; + proto.u.sigchld.error_number = ibuff[1]; + DEBUG_PRINT("send %s to %d", buff, uds_fd); + if (write(uds_fd, &proto, sizeof(proto)) < 0) { + if (errno == EINTR) + continue; + /* The uds was close, which most likely means that the VM + has exited. This will be detected when we try to read + from the uds_fd. */ + DEBUG_PRINT("Failed to write to uds: %d (%d)", uds_fd, errno); + } + } + } + return 1; +} + +typedef struct exit_status { + HashBucket hb; + pid_t os_pid; + Eterm port_id; +} ErtsSysExitStatus; + +static Hash *forker_hash; + +static void add_os_pid_to_port_id_mapping(Eterm port_id, pid_t os_pid) +{ + if (port_id != THE_NON_VALUE) { + /* exit status report requested */ + ErtsSysExitStatus es; + es.os_pid = os_pid; + es.port_id = port_id; + hash_put(forker_hash, &es); + } +} + +static Eterm get_port_id(pid_t os_pid) +{ + ErtsSysExitStatus est, *es; + Eterm port_id; + est.os_pid = os_pid; + es = hash_remove(forker_hash, &est); + if (!es) return THE_NON_VALUE; + port_id = es->port_id; + free(es); + return port_id; +} + +static int fcmp(void *a, void *b) +{ + ErtsSysExitStatus *sa = a; + ErtsSysExitStatus *sb = b; + return !(sa->os_pid == sb->os_pid); +} + +static HashValue fhash(void *e) +{ + ErtsSysExitStatus *se = e; + Uint32 val = se->os_pid; + val = (val+0x7ed55d16) + (val<<12); + val = (val^0xc761c23c) ^ (val>>19); + val = (val+0x165667b1) + (val<<5); + val = (val+0xd3a2646c) ^ (val<<9); + val = (val+0xfd7046c5) + (val<<3); + val = (val^0xb55a4f09) ^ (val>>16); + return val; +} + +static void *falloc(void *e) +{ + ErtsSysExitStatus *se = e; + ErtsSysExitStatus *ne = malloc(sizeof(ErtsSysExitStatus)); + ne->os_pid = se->os_pid; + ne->port_id = se->port_id; + return ne; +} + +static void *meta_alloc(int type, size_t size) { return malloc(size); } +static void meta_free(int type, void *p) { free(p); } + +static int forker_hash_init(void) +{ + HashFunctions forker_hash_functions; + forker_hash_functions.hash = fhash; + forker_hash_functions.cmp = fcmp; + forker_hash_functions.alloc = falloc; + forker_hash_functions.free = free; + forker_hash_functions.meta_alloc = meta_alloc; + forker_hash_functions.meta_free = meta_free; + forker_hash_functions.meta_print = NULL; + + forker_hash = hash_new(0, "forker_hash", + 16, forker_hash_functions); + + return 1; +} diff --git a/erts/emulator/sys/unix/erl_child_setup.h b/erts/emulator/sys/unix/erl_child_setup.h new file mode 100644 index 0000000000..a28b136bfc --- /dev/null +++ b/erts/emulator/sys/unix/erl_child_setup.h @@ -0,0 +1,77 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2015-2015. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + * + * This file defines the interface inbetween erts and child_setup. + */ + +#ifndef _ERL_UNIX_FORKER_H +#define _ERL_UNIX_FORKER_H + +#include "sys.h" + +#ifdef __FreeBSD__ +/* The freebsd sendmsg man page explicitly states that + you should not close fds before they are known + to have reached the other side, so this Ack protects + against that. */ +#define FORKER_PROTO_START_ACK 1 +#endif + +#define FORKER_ARGV_NO_OF_ARGS 3 +#define FORKER_ARGV_PROGNAME_IX 0 /* Program name */ +#define FORKER_ARGV_MAX_FILES 1 /* max_files */ + +#define FORKER_FLAG_USE_STDIO (1 << 0) /* dup the pipe to stdin/stderr */ +#define FORKER_FLAG_EXIT_STATUS (1 << 1) /* send the exit status to parent */ +#define FORKER_FLAG_DO_READ (1 << 2) /* dup write fd */ +#define FORKER_FLAG_DO_WRITE (1 << 3) /* dup read fd */ + +#if SIZEOF_VOID_P == SIZEOF_LONG +typedef unsigned long ErtsSysPortId; +#elif SIZEOF_VOID_P == SIZEOF_INT +typedef unsigned int ErtsSysPortId; +#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG +typedef unsigned long long ErtsSysPortId; +#endif + +typedef struct ErtsSysForkerProto_ { + enum { + ErtsSysForkerProtoAction_Start, + ErtsSysForkerProtoAction_StartAck, + ErtsSysForkerProtoAction_Go, + ErtsSysForkerProtoAction_SigChld, + ErtsSysForkerProtoAction_Ack + } action; + union { + struct { + ErtsSysPortId port_id; + int fds[3]; + } start; + struct { + pid_t os_pid; + int error_number; + } go; + struct { + ErtsSysPortId port_id; + int error_number; + } sigchld; + } u; +} ErtsSysForkerProto; + +#endif /* #ifndef _ERL_UNIX_FORKER_H */ diff --git a/erts/emulator/sys/unix/erl_main.c b/erts/emulator/sys/unix/erl_main.c index c417bea622..972b93a505 100644 --- a/erts/emulator/sys/unix/erl_main.c +++ b/erts/emulator/sys/unix/erl_main.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * Copyright Ericsson AB 2000-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index 8d4e98bf3a..241540b894 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2011. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -30,9 +30,7 @@ #include <limits.h> #include <stdlib.h> #include <string.h> -#ifndef QNX #include <memory.h> -#endif #if defined(__sun__) && defined(__SVR4) && !defined(__EXTENSIONS__) # define __EXTENSIONS__ @@ -92,11 +90,6 @@ #include <ieeefp.h> #endif -#ifdef QNX -#include <process.h> -#include <sys/qnx_glob.h> -#endif - #include <pwd.h> #ifndef HZ @@ -108,6 +101,10 @@ #endif #include <netdb.h> +#ifdef HAVE_MACH_ABSOLUTE_TIME +#include <mach/mach_time.h> +#endif + #ifdef HAVE_POSIX_MEMALIGN # define ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC 1 #endif @@ -136,13 +133,6 @@ # define ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT #endif -#ifndef ENABLE_CHILD_WAITER_THREAD -# ifdef ERTS_SMP -# define ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN -void erts_check_children(void); -# endif -#endif - typedef void *GETENV_STATE; /* @@ -171,6 +161,7 @@ typedef long long ErtsSysHrTime; #endif typedef ErtsMonotonicTime ErtsSystemTime; +typedef ErtsSysHrTime ErtsSysPerfCounter; #define ERTS_MONOTONIC_TIME_MIN (((ErtsMonotonicTime) 1) << 63) #define ERTS_MONOTONIC_TIME_MAX (~ERTS_MONOTONIC_TIME_MIN) @@ -219,6 +210,7 @@ ErtsSystemTime erts_os_system_time(void); * It may or may not be monotonic. */ ErtsSysHrTime erts_sys_hrtime(void); +#define ERTS_HRTIME_UNIT (1000*1000*1000) struct erts_sys_time_read_only_data__ { #ifdef ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__ @@ -227,6 +219,8 @@ struct erts_sys_time_read_only_data__ { #ifdef ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ void (*os_times)(ErtsMonotonicTime *, ErtsSystemTime *); #endif + ErtsSysPerfCounter (*perf_counter)(void); + ErtsSysPerfCounter perf_counter_unit; int ticks_per_sec; }; @@ -280,7 +274,24 @@ erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) #endif /* ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT */ /* - * + * Functions for getting the performance counter + */ + +ERTS_GLB_INLINE ErtsSysPerfCounter erts_sys_perf_counter(void); +#define erts_sys_perf_counter_unit() erts_sys_time_data__.r.o.perf_counter_unit + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE ErtsSysPerfCounter +erts_sys_perf_counter() +{ + return (*erts_sys_time_data__.r.o.perf_counter)(); +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +/* + * Functions for measuring CPU time */ #if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME_CPU_TIME)) @@ -310,7 +321,7 @@ 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); +extern void sys_init_suspend_handler(void); /* * Handling of floating point exceptions. @@ -425,19 +436,6 @@ void erts_sys_unblock_fpe(int); #define ERTS_FP_ERROR_THOROUGH(p, f, A) __ERTS_FP_ERROR_THOROUGH(&(p)->fp_exception, f, A) -#ifdef NEED_CHILD_SETUP_DEFINES -/* The child setup argv[] */ -#define CS_ARGV_PROGNAME_IX 0 /* Program name */ -#define CS_ARGV_UNBIND_IX 1 /* Unbind from cpu */ -#define CS_ARGV_WD_IX 2 /* Working directory */ -#define CS_ARGV_CMD_IX 3 /* Command */ -#define CS_ARGV_FD_CR_IX 4 /* Fd close range */ -#define CS_ARGV_DUP2_OP_IX(N) ((N) + 5) /* dup2 operations */ - -#define CS_ARGV_NO_OF_DUP2_OPS 3 /* Number of dup2 ops */ -#define CS_ARGV_NO_OF_ARGS 8 /* Number of arguments */ -#endif /* #ifdef NEED_CHILD_SETUP_DEFINES */ - /* Threads */ #ifdef USE_THREADS extern int init_async(int); diff --git a/erts/emulator/sys/unix/erl_unix_sys_ddll.c b/erts/emulator/sys/unix/erl_unix_sys_ddll.c index daed5af1b6..8f1ceac883 100644 --- a/erts/emulator/sys/unix/erl_unix_sys_ddll.c +++ b/erts/emulator/sys/unix/erl_unix_sys_ddll.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2013. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index d94b37430e..6fb86f6dda 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -49,7 +49,6 @@ #include <sys/ioctl.h> #endif -#define NEED_CHILD_SETUP_DEFINES #define ERTS_WANT_BREAK_HANDLING #define ERTS_WANT_GOT_SIGUSR1 #define WANT_NONBLOCKING /* must define this to pull in defs from sys.h */ @@ -67,7 +66,7 @@ #include "erl_mseg.h" extern char **environ; -static erts_smp_rwmtx_t environ_rwmtx; +erts_smp_rwmtx_t environ_rwmtx; #define MAX_VSIZE 16 /* Max number of entries allowed in an I/O * vector sock_sendv(). @@ -76,89 +75,12 @@ static erts_smp_rwmtx_t environ_rwmtx; * Don't need global.h, but bif_table.h (included by bif.h), * won't compile otherwise */ -#include "global.h" +#include "global.h" #include "bif.h" -#include "erl_sys_driver.h" #include "erl_check_io.h" #include "erl_cpu_topology.h" -#ifndef DISABLE_VFORK -#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] - * Solaris signal management gets confused when threads are used and a - * lot of child processes dies. The confusion results in that SIGCHLD - * signals aren't delivered to the emulator which in turn results in - * a lot of defunct processes in the system. - * - * The problem seems to appear when a signal is frequently - * blocked/unblocked at the same time as the signal is frequently - * propagated. The child waiter thread is a workaround for this problem. - * The SIGCHLD signal is always blocked (in all threads), and the child - * waiter thread fetches the signal by a call to sigwait(). See - * child_waiter(). - */ - -typedef struct ErtsSysReportExit_ ErtsSysReportExit; -struct ErtsSysReportExit_ { - ErtsSysReportExit *next; - Eterm port; - int pid; - int ifd; - int ofd; -#if CHLDWTHR && !defined(ERTS_SMP) - int status; -#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; - int ofd, packet_bytes; - ErtsSysReportExit *report_exit; - int pid; - int alive; - int status; - int terminating; - ErtsSysBlocking *blocking; -} *driver_data; /* indexed by fd */ - -static ErtsSysReportExit *report_exit_list; -#if CHLDWTHR && !defined(ERTS_SMP) -static ErtsSysReportExit *report_exit_transit_list; -#endif - extern int driver_interrupt(int, int); extern void do_break(void); @@ -170,33 +92,6 @@ extern void erts_sys_init_float(void); extern void erl_crash_dump(char* file, int line, char* fmt, ...); -#define DIR_SEPARATOR_CHAR '/' - -#if defined(__ANDROID__) -#define SHELL "/system/bin/sh" -#else -#define SHELL "/bin/sh" -#endif /* __ANDROID__ */ - - -#if defined(DEBUG) -#define ERL_BUILD_TYPE_MARKER ".debug" -#elif defined(PURIFY) -#define ERL_BUILD_TYPE_MARKER ".purify" -#elif defined(QUANTIFY) -#define ERL_BUILD_TYPE_MARKER ".quantify" -#elif defined(PURECOV) -#define ERL_BUILD_TYPE_MARKER ".purecov" -#elif defined(VALGRIND) -#define ERL_BUILD_TYPE_MARKER ".valgrind" -#else /* opt */ -#define ERL_BUILD_TYPE_MARKER -#endif - -#define CHILD_SETUP_PROG_NAME "child_setup" ERL_BUILD_TYPE_MARKER -#if !DISABLE_VFORK -static char *child_setup_prog; -#endif #ifdef DEBUG static int debug_log = 0; @@ -220,58 +115,20 @@ static volatile int have_prepared_crash_dump; (have_prepared_crash_dump++) #endif -static erts_smp_atomic_t sys_misc_mem_sz; +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}; +#if !defined(ETHR_UNUSABLE_SIGUSRX) && defined(ERTS_THR_HAVE_SIG_FUNCS) 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 -#if CHLDWTHR -static erts_tid_t child_waiter_tid; -/* chld_stat_mtx is used to protect against concurrent accesses - of the driver_data fields pid, alive, and status. */ -erts_cnd_t chld_stat_cnd; -static long children_alive; -#define CHLD_STAT_LOCK erts_mtx_lock(&chld_stat_mtx) -#define CHLD_STAT_UNLOCK erts_mtx_unlock(&chld_stat_mtx) -#define CHLD_STAT_WAIT erts_cnd_wait(&chld_stat_cnd, &chld_stat_mtx) -#define CHLD_STAT_SIGNAL erts_cnd_signal(&chld_stat_cnd) -#elif defined(ERTS_SMP) /* ------------------------------------------------- */ -#define CHLD_STAT_LOCK erts_mtx_lock(&chld_stat_mtx) -#define CHLD_STAT_UNLOCK erts_mtx_unlock(&chld_stat_mtx) - -#else /* ------------------------------------------------------------------- */ -#define CHLD_STAT_LOCK -#define CHLD_STAT_UNLOCK -static volatile int children_died; #endif - -static struct fd_data { - char pbuf[4]; /* hold partial packet bytes */ - int psz; /* size of pbuf */ - char *buf; - char *cpos; - int sz; - int remain; /* for input on fd */ -} *fd_data; /* indexed by fd */ - -/* static FUNCTION(int, write_fill, (int, char*, int)); unused? */ -static void note_child_death(int, int); - -#if CHLDWTHR -static void* child_waiter(void *); -#endif +jmp_buf erts_sys_sigsegv_jmp; static int crashdump_companion_cube_fd = -1; @@ -453,9 +310,10 @@ MALLOC_USE_HASH(1); #ifdef USE_THREADS #ifdef ERTS_THR_HAVE_SIG_FUNCS + /* * Child thread inherits parents signal mask at creation. In order to - * guarantee that the main thread will receive all SIGINT, SIGCHLD, and + * guarantee that the main thread will receive all SIGINT, and * SIGUSR1 signals sent to the process, we block these signals in the * parent thread when creating a new thread. */ @@ -551,14 +409,11 @@ erts_sys_pre_init(void) #ifdef ERTS_THR_HAVE_SIG_FUNCS sigemptyset(&thr_create_sigmask); sigaddset(&thr_create_sigmask, SIGINT); /* block interrupt */ - sigaddset(&thr_create_sigmask, SIGCHLD); /* block child signals */ sigaddset(&thr_create_sigmask, SIGUSR1); /* block user defined signal */ #endif erts_thr_init(&eid); - report_exit_list = NULL; - #ifdef ERTS_ENABLE_LOCK_COUNT erts_lcnt_init(); #endif @@ -569,17 +424,6 @@ erts_sys_pre_init(void) #ifdef USE_THREADS -#if CHLDWTHR || defined(ERTS_SMP) - erts_mtx_init(&chld_stat_mtx, "child_status"); -#endif -#if CHLDWTHR -#ifndef ERTS_SMP - report_exit_transit_list = NULL; -#endif - 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); @@ -589,9 +433,6 @@ erts_sys_pre_init(void) erts_got_sigusr1 = 0; have_prepared_crash_dump = 0; #endif -#if !CHLDWTHR && !defined(ERTS_SMP) - children_died = 0; -#endif #endif /* USE_THREADS */ @@ -628,39 +469,6 @@ erts_sys_pre_init(void) void erl_sys_init(void) { -#if !DISABLE_VFORK - { - int res; - char bindir[MAXPATHLEN]; - size_t bindirsz = sizeof(bindir); - Uint csp_path_sz; - - res = erts_sys_getenv_raw("BINDIR", bindir, &bindirsz); - if (res != 0) { - if (res < 0) - erts_exit(1, - "Environment variable BINDIR is not set\n"); - if (res > 0) - erts_exit(1, - "Value of environment variable BINDIR is too large\n"); - } - if (bindir[0] != DIR_SEPARATOR_CHAR) - erts_exit(1, - "Environment variable BINDIR does not contain an" - " absolute path\n"); - csp_path_sz = (strlen(bindir) - + 1 /* DIR_SEPARATOR_CHAR */ - + sizeof(CHILD_SETUP_PROG_NAME) - + 1); - child_setup_prog = erts_alloc(ERTS_ALC_T_CS_PROG_PATH, csp_path_sz); - erts_smp_atomic_add_nob(&sys_misc_mem_sz, csp_path_sz); - erts_snprintf(child_setup_prog, csp_path_sz, - "%s%c%s", - bindir, - DIR_SEPARATOR_CHAR, - CHILD_SETUP_PROG_NAME); - } -#endif #ifdef USE_SETLINEBUF setlinebuf(stdout); @@ -872,7 +680,7 @@ sigusr1_exit(void) #else -#ifdef ERTS_SMP +#ifdef ERTS_SYS_SUSPEND_SIGNAL void sys_thr_suspend(erts_tid_t tid) { erts_thr_kill(tid, ERTS_SYS_SUSPEND_SIGNAL); @@ -900,7 +708,7 @@ static RETSIGTYPE user_signal1(int signum) #endif } -#ifdef ERTS_SMP +#ifdef ERTS_SYS_SUSPEND_SIGNAL #if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) static RETSIGTYPE suspend_signal(void) #else @@ -913,7 +721,7 @@ static RETSIGTYPE suspend_signal(int signum) res = read(sig_suspend_fds[0], buf, sizeof(int)); } while (res < 0 && errno == EINTR); } -#endif /* #ifdef ERTS_SMP */ +#endif /* #ifdef ERTS_SYS_SUSPEND_SIGNAL */ #endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ @@ -966,53 +774,20 @@ void init_break_handler(void) sys_signal(SIGINT, request_break); #ifndef ETHR_UNUSABLE_SIGUSRX 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_signal(SIGQUIT, do_quit); } -int sys_max_files(void) +void sys_init_suspend_handler(void) { - return(max_files); -} - -static void block_signals(void) -{ -#if !CHLDWTHR - sys_sigblock(SIGCHLD); -#endif -#ifndef ERTS_SMP - 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); +#ifdef ERTS_SYS_SUSPEND_SIGNAL + sys_signal(ERTS_SYS_SUSPEND_SIGNAL, suspend_signal); #endif - } -static void unblock_signals(void) +int sys_max_files(void) { - /* Update erl_child_setup.c if changed */ -#if !CHLDWTHR - sys_sigrelease(SIGCHLD); -#endif -#ifndef ERTS_SMP - sys_sigrelease(SIGINT); -#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 - + return(max_files); } /************************** OS info *******************************/ @@ -1102,1502 +877,6 @@ void fini_getenv_state(GETENV_STATE *state) erts_smp_rwmtx_runlock(&environ_rwmtx); } - -/************************** Port I/O *******************************/ - - - -/* I. Common stuff */ - -/* - * Decreasing the size of it below 16384 is not allowed. - */ - -/* II. The spawn/fd/vanilla drivers */ - -#define ERTS_SYS_READ_BUF_SZ (64*1024) - -/* 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); -static void output(ErlDrvData, char*, ErlDrvSizeT); -static void outputv(ErlDrvData, ErlIOVec*); -static void stop_select(ErlDrvEvent, void*); - -struct erl_drv_entry spawn_driver_entry = { - spawn_init, - spawn_start, - stop, - output, - ready_input, - ready_output, - "spawn", - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - ERL_DRV_EXTENDED_MARKER, - ERL_DRV_EXTENDED_MAJOR_VERSION, - ERL_DRV_EXTENDED_MINOR_VERSION, - ERL_DRV_FLAG_USE_PORT_LOCKING, - NULL, NULL, - stop_select -}; -struct erl_drv_entry fd_driver_entry = { - NULL, - fd_start, - fd_stop, - output, - ready_input, - ready_output, - "fd", - NULL, - NULL, - fd_control, - NULL, - outputv, -#if FDBLOCK - fd_ready_async, /* ready_async */ -#else - NULL, -#endif - fd_flush, /* flush */ - NULL, /* call */ - NULL, /* event */ - ERL_DRV_EXTENDED_MARKER, - ERL_DRV_EXTENDED_MAJOR_VERSION, - ERL_DRV_EXTENDED_MINOR_VERSION, - 0, /* ERL_DRV_FLAGs */ - NULL, /* handle2 */ - NULL, /* process_exit */ - stop_select -}; -struct erl_drv_entry vanilla_driver_entry = { - NULL, - vanilla_start, - stop, - output, - ready_input, - ready_output, - "vanilla", - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, /* flush */ - NULL, /* call */ - NULL, /* event */ - ERL_DRV_EXTENDED_MARKER, - ERL_DRV_EXTENDED_MAJOR_VERSION, - ERL_DRV_EXTENDED_MINOR_VERSION, - 0, /* ERL_DRV_FLAGs */ - NULL, /* handle2 */ - NULL, /* process_exit */ - stop_select -}; - -/* Handle SIGCHLD signals. */ -#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) -static RETSIGTYPE onchld(void) -#else -static RETSIGTYPE onchld(int signum) -#endif -{ -#if CHLDWTHR - ASSERT(0); /* We should *never* catch a SIGCHLD signal */ -#elif defined(ERTS_SMP) - smp_sig_notify('C'); -#else - children_died = 1; - ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */ -#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 is_blocking) -{ - Port *prt; - ErtsSysReportExit *report_exit; - - if (!exit_status) - report_exit = NULL; - else { - report_exit = erts_alloc(ERTS_ALC_T_PRT_REP_EXIT, - sizeof(ErtsSysReportExit)); - report_exit->next = report_exit_list; - report_exit->port = erts_drvport2id(port_num); - report_exit->pid = pid; - report_exit->ifd = read_write & DO_READ ? ifd : -1; - report_exit->ofd = read_write & DO_WRITE ? ofd : -1; -#if CHLDWTHR && !defined(ERTS_SMP) - report_exit->status = 0; -#endif - report_exit_list = report_exit; - } - - prt = erts_drvport2port(port_num); - if (prt != ERTS_INVALID_ERL_DRV_PORT) - prt->os_pid = pid; - - if (read_write & DO_READ) { - driver_data[ifd].packet_bytes = packet_bytes; - driver_data[ifd].port_num = port_num; - driver_data[ifd].report_exit = report_exit; - 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 */ - driver_data[ifd].ofd = -1; - } - (void) driver_select(port_num, ifd, (ERL_DRV_READ|ERL_DRV_USE), 1); - return(ifd); - } else { /* DO_WRITE only */ - driver_data[ofd].packet_bytes = packet_bytes; - driver_data[ofd].port_num = port_num; - driver_data[ofd].report_exit = report_exit; - driver_data[ofd].ofd = ofd; - 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); - } -} - -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_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, - max_files * sizeof(struct driver_data)); - - for (i = 0; i < max_files; i++) - driver_data[i].pid = -1; - -#if CHLDWTHR - sys_sigblock(SIGCHLD); -#endif - - sys_signal(SIGCHLD, onchld); /* Reap children */ - -#if CHLDWTHR - erts_thr_create(&child_waiter_tid, child_waiter, NULL, &thr_opts); -#endif - - return 1; -} - -static void close_pipes(int ifd[2], int ofd[2], int read_write) -{ - if (read_write & DO_READ) { - (void) close(ifd[0]); - (void) close(ifd[1]); - } - if (read_write & DO_WRITE) { - (void) close(ofd[0]); - (void) close(ofd[1]); - } -} - -static void init_fd_data(int fd, ErlDrvPort port_num) -{ - fd_data[fd].buf = NULL; - fd_data[fd].cpos = NULL; - fd_data[fd].remain = 0; - fd_data[fd].sz = 0; - fd_data[fd].psz = 0; -} - -static char **build_unix_environment(char *block) -{ - int i; - int j; - int len; - char *cp; - char **cpp; - char** old_env; - - ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx)); - - cp = block; - len = 0; - while (*cp != '\0') { - cp += strlen(cp) + 1; - len++; - } - old_env = environ; - while (*old_env++ != NULL) { - len++; - } - - cpp = (char **) erts_alloc_fnf(ERTS_ALC_T_ENVIRONMENT, - sizeof(char *) * (len+1)); - if (cpp == NULL) { - return NULL; - } - - cp = block; - len = 0; - while (*cp != '\0') { - cpp[len] = cp; - cp += strlen(cp) + 1; - len++; - } - - i = len; - for (old_env = environ; *old_env; old_env++) { - char* old = *old_env; - - for (j = 0; j < len; j++) { - char *s, *t; - - s = cpp[j]; - t = old; - while (*s == *t && *s != '=') { - s++, t++; - } - if (*s == '=' && *t == '=') { - break; - } - } - - if (j == len) { /* New version not found */ - cpp[len++] = old; - } - } - - for (j = 0; j < i; ) { - size_t last = strlen(cpp[j])-1; - if (cpp[j][last] == '=' && strchr(cpp[j], '=') == cpp[j]+last) { - cpp[j] = cpp[--len]; - if (len < i) { - i--; - } else { - j++; - } - } - else { - j++; - } - } - - cpp[len] = NULL; - return cpp; -} - -/* - [arndt] In most Unix systems, including Solaris 2.5, 'fork' allocates memory - in swap space for the child of a 'fork', whereas 'vfork' does not do this. - The natural call to use here is therefore 'vfork'. Due to a bug in - 'vfork' in Solaris 2.5 (apparently fixed in 2.6), using 'vfork' - can be dangerous in what seems to be these circumstances: - If the child code under a vfork sets the signal action to SIG_DFL - (or SIG_IGN) - for any signal which was previously set to a signal handler, the - state of the parent is clobbered, so that the later arrival of - such a signal yields a sigsegv in the parent. If the signal was - not set to a signal handler, but ignored, all seems to work. - If you change the forking code below, beware of this. - */ - -static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) -{ -#define CMD_LINE_PREFIX_STR "exec " -#define CMD_LINE_PREFIX_STR_SZ (sizeof(CMD_LINE_PREFIX_STR) - 1) - - int ifd[2], ofd[2], len, pid, i; - char **volatile new_environ; /* volatile since a vfork() then cannot - cause 'new_environ' to be clobbered - in the parent process. */ - int saved_errno; - long res; - char *cmd_line; -#ifndef QNX - int unbind; -#endif -#if !DISABLE_VFORK - int no_vfork; - size_t no_vfork_sz = sizeof(no_vfork); - - no_vfork = (erts_sys_getenv_raw("ERL_NO_VFORK", - (char *) &no_vfork, - &no_vfork_sz) >= 0); -#endif - - switch (opts->read_write) { - case DO_READ: - if (pipe(ifd) < 0) - return ERL_DRV_ERROR_ERRNO; - if (ifd[0] >= max_files) { - close_pipes(ifd, ofd, opts->read_write); - errno = EMFILE; - return ERL_DRV_ERROR_ERRNO; - } - ofd[1] = -1; /* keep purify happy */ - break; - case DO_WRITE: - if (pipe(ofd) < 0) return ERL_DRV_ERROR_ERRNO; - if (ofd[1] >= max_files) { - close_pipes(ifd, ofd, opts->read_write); - errno = EMFILE; - return ERL_DRV_ERROR_ERRNO; - } - ifd[0] = -1; /* keep purify happy */ - break; - case DO_READ|DO_WRITE: - if (pipe(ifd) < 0) return ERL_DRV_ERROR_ERRNO; - errno = EMFILE; /* default for next two conditions */ - if (ifd[0] >= max_files || pipe(ofd) < 0) { - close_pipes(ifd, ofd, DO_READ); - return ERL_DRV_ERROR_ERRNO; - } - if (ofd[1] >= max_files) { - close_pipes(ifd, ofd, opts->read_write); - errno = EMFILE; - return ERL_DRV_ERROR_ERRNO; - } - break; - default: - ASSERT(0); - return ERL_DRV_ERROR_GENERAL; - } - - if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { - /* started with spawn_executable, not with spawn */ - len = strlen(name); - cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, len + 1); - if (!cmd_line) { - close_pipes(ifd, ofd, opts->read_write); - errno = ENOMEM; - return ERL_DRV_ERROR_ERRNO; - } - memcpy((void *) cmd_line,(void *) name, len); - cmd_line[len] = '\0'; - if (access(cmd_line,X_OK) != 0) { - int save_errno = errno; - erts_free(ERTS_ALC_T_TMP, cmd_line); - errno = save_errno; - return ERL_DRV_ERROR_ERRNO; - } - } else { - /* make the string suitable for giving to "sh" */ - len = strlen(name); - cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, - CMD_LINE_PREFIX_STR_SZ + len + 1); - if (!cmd_line) { - close_pipes(ifd, ofd, opts->read_write); - errno = ENOMEM; - return ERL_DRV_ERROR_ERRNO; - } - memcpy((void *) cmd_line, - (void *) CMD_LINE_PREFIX_STR, - CMD_LINE_PREFIX_STR_SZ); - memcpy((void *) (cmd_line + CMD_LINE_PREFIX_STR_SZ), (void *) name, len); - cmd_line[CMD_LINE_PREFIX_STR_SZ + len] = '\0'; - } - - erts_smp_rwmtx_rlock(&environ_rwmtx); - - if (opts->envir == NULL) { - new_environ = environ; - } else if ((new_environ = build_unix_environment(opts->envir)) == NULL) { - erts_smp_rwmtx_runlock(&environ_rwmtx); - erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); - errno = ENOMEM; - return ERL_DRV_ERROR_ERRNO; - } - -#ifndef QNX - /* Block child from SIGINT and SIGUSR1. Must be before fork() - to be safe. */ - block_signals(); - - CHLD_STAT_LOCK; - - unbind = erts_sched_bind_atfork_prepare(); - -#if !DISABLE_VFORK - /* See fork/vfork discussion before this function. */ - if (no_vfork) { -#endif - - DEBUGF(("Using fork\n")); - pid = fork(); - - if (pid == 0) { - /* The child! Setup child... */ - - if (erts_sched_bind_atfork_child(unbind) != 0) - goto child_error; - - /* OBSERVE! - * Keep child setup after vfork() (implemented below and in - * erl_child_setup.c) up to date if changes are made here. - */ - - if (opts->use_stdio) { - if (opts->read_write & DO_READ) { - /* stdout for process */ - if (dup2(ifd[1], 1) < 0) - goto child_error; - if(opts->redir_stderr) - /* stderr for process */ - if (dup2(ifd[1], 2) < 0) - goto child_error; - } - if (opts->read_write & DO_WRITE) - /* stdin for process */ - if (dup2(ofd[0], 0) < 0) - goto child_error; - } - else { /* XXX will fail if ofd[0] == 4 (unlikely..) */ - if (opts->read_write & DO_READ) - if (dup2(ifd[1], 4) < 0) - goto child_error; - if (opts->read_write & DO_WRITE) - if (dup2(ofd[0], 3) < 0) - goto child_error; - } - -#if defined(HAVE_CLOSEFROM) - closefrom(opts->use_stdio ? 3 : 5); -#else - for (i = opts->use_stdio ? 3 : 5; i < max_files; i++) - (void) close(i); -#endif - - if (opts->wd && chdir(opts->wd) < 0) - goto child_error; - -#if defined(USE_SETPGRP_NOARGS) /* SysV */ - (void) setpgrp(); -#elif defined(USE_SETPGRP) /* BSD */ - (void) setpgrp(0, getpid()); -#else /* POSIX */ - (void) setsid(); -#endif - - unblock_signals(); - - if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { - if (opts->argv == NULL) { - execle(cmd_line,cmd_line,(char *) NULL, new_environ); - } else { - if (opts->argv[0] == erts_default_arg0) { - opts->argv[0] = cmd_line; - } - execve(cmd_line, opts->argv, new_environ); - if (opts->argv[0] == cmd_line) { - opts->argv[0] = erts_default_arg0; - } - } - } else { - execle(SHELL, "sh", "-c", cmd_line, (char *) NULL, new_environ); - } - child_error: - _exit(1); - } -#if !DISABLE_VFORK - } -#define ENOUGH_BYTES (44) - else { /* Use vfork() */ - char **cs_argv= erts_alloc(ERTS_ALC_T_TMP,(CS_ARGV_NO_OF_ARGS + 1)* - sizeof(char *)); - char fd_close_range[ENOUGH_BYTES]; /* 44 bytes are enough to */ - char dup2_op[CS_ARGV_NO_OF_DUP2_OPS][ENOUGH_BYTES]; /* hold any "%d:%d" string */ - /* on a 64-bit machine. */ - - /* Setup argv[] for the child setup program (implemented in - erl_child_setup.c) */ - i = 0; - if (opts->use_stdio) { - if (opts->read_write & DO_READ){ - /* stdout for process */ - erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 1); - if(opts->redir_stderr) - /* stderr for process */ - erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 2); - } - if (opts->read_write & DO_WRITE) - /* stdin for process */ - erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ofd[0], 0); - } else { /* XXX will fail if ofd[0] == 4 (unlikely..) */ - if (opts->read_write & DO_READ) - erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 4); - if (opts->read_write & DO_WRITE) - erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ofd[0], 3); - } - for (; i < CS_ARGV_NO_OF_DUP2_OPS; i++) - strcpy(&dup2_op[i][0], "-"); - erts_snprintf(fd_close_range, ENOUGH_BYTES, "%d:%d", opts->use_stdio ? 3 : 5, max_files-1); - - cs_argv[CS_ARGV_PROGNAME_IX] = child_setup_prog; - cs_argv[CS_ARGV_WD_IX] = opts->wd ? opts->wd : "."; - cs_argv[CS_ARGV_UNBIND_IX] = erts_sched_bind_atvfork_child(unbind); - cs_argv[CS_ARGV_FD_CR_IX] = fd_close_range; - for (i = 0; i < CS_ARGV_NO_OF_DUP2_OPS; i++) - cs_argv[CS_ARGV_DUP2_OP_IX(i)] = &dup2_op[i][0]; - - if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { - int num = 0; - int j = 0; - if (opts->argv != NULL) { - for(; opts->argv[num] != NULL; ++num) - ; - } - cs_argv = erts_realloc(ERTS_ALC_T_TMP,cs_argv, (CS_ARGV_NO_OF_ARGS + 1 + num + 1) * sizeof(char *)); - cs_argv[CS_ARGV_CMD_IX] = "-"; - cs_argv[CS_ARGV_NO_OF_ARGS] = cmd_line; - if (opts->argv != NULL) { - for (;opts->argv[j] != NULL; ++j) { - if (opts->argv[j] == erts_default_arg0) { - cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = cmd_line; - } else { - cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = opts->argv[j]; - } - } - } - cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = NULL; - } else { - cs_argv[CS_ARGV_CMD_IX] = cmd_line; /* Command */ - cs_argv[CS_ARGV_NO_OF_ARGS] = NULL; - } - DEBUGF(("Using vfork\n")); - pid = vfork(); - - if (pid == 0) { - /* The child! */ - - /* Observe! - * OTP-4389: The child setup program (implemented in - * erl_child_setup.c) will perform the necessary setup of the - * child before it execs to the user program. This because - * vfork() only allow an *immediate* execve() or _exit() in the - * child. - */ - execve(child_setup_prog, cs_argv, new_environ); - _exit(1); - } - erts_free(ERTS_ALC_T_TMP,cs_argv); - } -#undef ENOUGH_BYTES -#endif - - erts_sched_bind_atfork_parent(unbind); - - if (pid == -1) { - saved_errno = errno; - CHLD_STAT_UNLOCK; - erts_smp_rwmtx_runlock(&environ_rwmtx); - erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); - unblock_signals(); - close_pipes(ifd, ofd, opts->read_write); - errno = saved_errno; - return ERL_DRV_ERROR_ERRNO; - } -#else /* QNX */ - if (opts->use_stdio) { - if (opts->read_write & DO_READ) - qnx_spawn_options.iov[1] = ifd[1]; /* stdout for process */ - if (opts->read_write & DO_WRITE) - qnx_spawn_options.iov[0] = ofd[0]; /* stdin for process */ - } - else { - if (opts->read_write & DO_READ) - qnx_spawn_options.iov[4] = ifd[1]; - if (opts->read_write & DO_WRITE) - qnx_spawn_options.iov[3] = ofd[0]; - } - /* Close fds on exec */ - for (i = 3; i < max_files; i++) - fcntl(i, F_SETFD, 1); - - qnx_spawn_options.flags = _SPAWN_SETSID; - if ((pid = spawnl(P_NOWAIT, SHELL, SHELL, "-c", cmd_line, - (char *) 0)) < 0) { - erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); - reset_qnx_spawn(); - erts_smp_rwmtx_runlock(&environ_rwmtx); - close_pipes(ifd, ofd, opts->read_write); - return ERL_DRV_ERROR_GENERAL; - } - reset_qnx_spawn(); -#endif /* QNX */ - - erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); - - if (new_environ != environ) - erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); - - if (opts->read_write & DO_READ) - (void) close(ifd[1]); - if (opts->read_write & DO_WRITE) - (void) close(ofd[0]); - - if (opts->read_write & DO_READ) { - SET_NONBLOCKING(ifd[0]); - init_fd_data(ifd[0], port_num); - } - if (opts->read_write & DO_WRITE) { - SET_NONBLOCKING(ofd[1]); - init_fd_data(ofd[1], port_num); - } - - res = set_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes, - 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(); - -#if CHLDWTHR - ASSERT(children_alive >= 0); - - if (!(children_alive++)) - CHLD_STAT_SIGNAL; /* Wake up child waiter thread if no children - was alive before we fork()ed ... */ -#endif - /* Don't unlock chld_stat_mtx until now of the same reason as above */ - CHLD_STAT_UNLOCK; - - erts_smp_rwmtx_runlock(&environ_rwmtx); - - return (ErlDrvData)res; -#undef CMD_LINE_PREFIX_STR -#undef CMD_LINE_PREFIX_STR_SZ -} - -#ifdef QNX -static reset_qnx_spawn() -{ - int i; - - /* Reset qnx_spawn_options */ - qnx_spawn_options.flags = 0; - qnx_spawn_options.iov[0] = 0xff; - qnx_spawn_options.iov[1] = 0xff; - qnx_spawn_options.iov[2] = 0xff; - qnx_spawn_options.iov[3] = 0xff; -} -#endif - -#define FD_DEF_HEIGHT 24 -#define FD_DEF_WIDTH 80 -/* Control op */ -#define FD_CTRL_OP_GET_WINSIZE 100 - -static int fd_get_window_size(int fd, Uint32 *width, Uint32 *height) -{ -#ifdef TIOCGWINSZ - struct winsize ws; - if (ioctl(fd,TIOCGWINSZ,&ws) == 0) { - *width = (Uint32) ws.ws_col; - *height = (Uint32) ws.ws_row; - return 0; - } -#endif - return -1; -} - -static ErlDrvSSizeT fd_control(ErlDrvData drv_data, - unsigned int command, - char *buf, ErlDrvSizeT len, - char **rbuf, ErlDrvSizeT rlen) -{ - int fd = (int)(long)drv_data; - char resbuff[2*sizeof(Uint32)]; - switch (command) { - case FD_CTRL_OP_GET_WINSIZE: - { - Uint32 w,h; - if (fd_get_window_size(fd,&w,&h)) - return 0; - memcpy(resbuff,&w,sizeof(Uint32)); - memcpy(resbuff+sizeof(Uint32),&h,sizeof(Uint32)); - } - break; - default: - return 0; - } - if (rlen < 2*sizeof(Uint32)) { - *rbuf = driver_alloc(2*sizeof(Uint32)); - } - memcpy(*rbuf,resbuff,2*sizeof(Uint32)); - return 2*sizeof(Uint32); -} - -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)) - return ERL_DRV_ERROR_GENERAL; - - /* - * Historical: - * - * "Note about nonblocking I/O. - * - * At least on Solaris, setting the write end of a TTY to nonblocking, - * will set the input end to nonblocking as well (and vice-versa). - * If erl is run in a pipeline like this: cat | erl - * the input end of the TTY will be the standard input of cat. - * And cat is not prepared to handle nonblocking I/O." - * - * Actually, the reason for this is not that the tty itself gets set - * in non-blocking mode, but that the "input end" (cat's stdin) and - * the "output end" (erlang's stdout) are typically the "same" file - * descriptor, dup()'ed from a single fd by one of this process' - * ancestors. - * - * The workaround for this problem used to be a rather bad kludge, - * interposing an extra process ("internal cat") between erlang's - * stdout and the original stdout, allowing erlang to set its stdout - * in non-blocking mode without affecting the stdin of the preceding - * process in the pipeline - and being a kludge, it caused all kinds - * of weird problems. - * - * So, this is the current logic: - * - * The only reason to set non-blocking mode on the output fd at all is - * if it's something that can cause a write() to block, of course, - * i.e. primarily if it points to a tty, socket, pipe, or fifo. - * - * If we don't set non-blocking mode when we "should" have, and output - * becomes blocked, the entire runtime system will be suspended - this - * is normally bad of course, and can happen fairly "easily" - e.g. user - * hits ^S on tty - but doesn't necessarily happen. - * - * If we do set non-blocking mode when we "shouldn't" have, the runtime - * system will end up seeing EOF on the input fd (due to the preceding - * process dying), which typically will cause the entire runtime system - * to terminate immediately (due to whatever erlang process is seeing - * the EOF taking it as a signal to halt the system). This is *very* bad. - * - * I.e. we should take a conservative approach, and only set non- - * blocking mode when we a) need to, and b) are reasonably certain - * that it won't be a problem. And as in the example above, the problem - * occurs when input fd and output fd point to different "things". - * - * However, determining that they are not just the same "type" of - * "thing", but actually the same instance of that type of thing, is - * unreasonably complex in many/most cases. - * - * Also, with pipes, sockets, and fifos it's far from obvious that the - * user *wants* non-blocking output: If you're running erlang inside - * some complex pipeline, you're probably not running a real-time system - * that must never stop, but rather *want* it to suspend if the output - * channel is "full". - * - * So, the bottom line: We will only set the output fd non-blocking if - * it points to a tty, and either a) the input fd also points to a tty, - * or b) we can make sure that setting the output fd non-blocking - * doesn't interfere with someone else's input, via a somewhat milder - * kludge than the above. - * - * Also keep in mind that while this code is almost exclusively run as - * a result of an erlang open_port({fd,0,1}, ...), that isn't the only - * 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) { - init_fd_data(opts->ifd, port_num); - } - if (opts->read_write & DO_WRITE) { - init_fd_data(opts->ofd, port_num); - - /* If we don't have a read end, all bets are off - no non-blocking. */ - if (opts->read_write & DO_READ) { - - if (isatty(opts->ofd)) { /* output fd is a tty:-) */ - - if (isatty(opts->ifd)) { /* input fd is also a tty */ - - /* To really do this "right", we should also check that - input and output fd point to the *same* tty - but - this seems like overkill; ttyname() isn't for free, - and this is a very common case - and it's hard to - 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 */ - - /* This is a "problem case", but also common (see the - example above) - i.e. it makes sense to try a bit - harder before giving up on non-blocking mode: Try to - re-open the tty that the output fd points to, and if - successful replace the original one with the "new" fd - obtained this way, and set *that* one in non-blocking - mode. (Yes, this is a kludge.) - - However, re-opening the tty may fail in a couple of - (unusual) cases: - - 1) The name of the tty (or an equivalent one, i.e. - same major/minor number) can't be found, because - it actually lives somewhere other than /dev (or - wherever ttyname() looks for it), and isn't - equivalent to any of those that do live in the - "standard" place - this should be *very* unusual. - - 2) Permissions on the tty don't allow us to open it - - it's perfectly possible to have an fd open to an - object whose permissions wouldn't allow us to open - it. This is not as unusual as it sounds, one case - is if the user has su'ed to someone else (not - root) - we have a read/write fd open to the tty - (because it has been inherited all the way down - here), but we have neither read nor write - permission for the tty. - - In these cases, we finally give up, and don't set the - output fd in non-blocking mode. */ - - char *tty; - int nfd; - - if ((tty = ttyname(opts->ofd)) != NULL && - (nfd = open(tty, O_WRONLY)) != -1) { - dup2(nfd, opts->ofd); - close(nfd); - non_blocking = 1; - SET_NONBLOCKING(opts->ofd); - } - } - } - } - } - CHLD_STAT_LOCK; - res = (ErlDrvData)(long)set_driver_data(port_num, opts->ifd, opts->ofd, - opts->packet_bytes, - opts->read_write, 0, -1, - !non_blocking); - CHLD_STAT_UNLOCK; - return res; -} - -static void clear_fd_data(int fd) -{ - if (fd_data[fd].sz > 0) { - erts_free(ERTS_ALC_T_FD_ENTRY_BUF, (void *) fd_data[fd].buf); - ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= fd_data[fd].sz); - erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*fd_data[fd].sz); - } - fd_data[fd].buf = NULL; - fd_data[fd].sz = 0; - fd_data[fd].remain = 0; - fd_data[fd].cpos = NULL; - fd_data[fd].psz = 0; -} - -static void nbio_stop_fd(ErlDrvPort prt, int fd) -{ - driver_select(prt,fd,DO_READ|DO_WRITE,0); - clear_fd_data(fd); - SET_BLOCKING(fd); -} - -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; - -#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, - SysDriverOpts* opts) -{ - int flags, fd; - ErlDrvData res; - - flags = (opts->read_write == DO_READ ? O_RDONLY : - opts->read_write == DO_WRITE ? O_WRONLY|O_CREAT|O_TRUNC : - O_RDWR|O_CREAT); - if ((fd = open(name, flags, 0666)) < 0) - return ERL_DRV_ERROR_GENERAL; - if (fd >= max_files) { - close(fd); - return ERL_DRV_ERROR_GENERAL; - } - SET_NONBLOCKING(fd); - init_fd_data(fd, port_num); - - CHLD_STAT_LOCK; - res = (ErlDrvData)(long)set_driver_data(port_num, fd, fd, - opts->packet_bytes, - opts->read_write, 0, -1, 0); - CHLD_STAT_UNLOCK; - return res; -} - -/* Note that driver_data[fd].ifd == fd if the port was opened for reading, */ -/* otherwise (i.e. write only) driver_data[fd].ofd = fd. */ - -static void stop(ErlDrvData fd) -{ - ErlDrvPort prt; - int ofd; - - prt = driver_data[(int)(long)fd].port_num; - nbio_stop_fd(prt, (int)(long)fd); - - ofd = driver_data[(int)(long)fd].ofd; - if (ofd != (int)(long)fd && (int)(long)ofd != -1) - nbio_stop_fd(prt, ofd); - else - ofd = -1; - - CHLD_STAT_LOCK; - - /* Mark as unused. */ - driver_data[(int)(long)fd].pid = -1; - - CHLD_STAT_UNLOCK; - - /* SMP note: Close has to be last thing done (open file descriptors work - as locks on driver_data[] entries) */ - driver_select(prt, (int)(long)fd, ERL_DRV_USE, 0); /* close(fd); */ - if (ofd >= 0) { - driver_select(prt, (int)(long)ofd, ERL_DRV_USE, 0); /* close(ofd); */ - } -} - -/* used by fd_driver */ -static void outputv(ErlDrvData e, ErlIOVec* ev) -{ - int fd = (int)(long)e; - ErlDrvPort ix = driver_data[fd].port_num; - int pb = driver_data[fd].packet_bytes; - int ofd = driver_data[fd].ofd; - ssize_t n; - ErlDrvSizeT sz; - char lb[4]; - char* lbp; - ErlDrvSizeT len = ev->size; - - /* (len > ((unsigned long)-1 >> (4-pb)*8)) */ - /* if (pb >= 0 && (len & (((ErlDrvSizeT)1 << (pb*8))) - 1) != len) {*/ - if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) { - driver_failure_posix(ix, EINVAL); - return; /* -1; */ - } - /* Handles 0 <= pb <= 4 only */ - put_int32((Uint32) len, lb); - lbp = lb + (4-pb); - - 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 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); - if (n == ev->size) - return; /* 0;*/ - if (n < 0) { - if ((errno != EINTR) && (errno != ERRNO_BLOCK)) { - driver_failure_posix(ix, errno); - return; /* -1;*/ - } - n = 0; - } - 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; - ErlDrvPort ix = driver_data[fd].port_num; - int pb = driver_data[fd].packet_bytes; - int ofd = driver_data[fd].ofd; - ssize_t n; - ErlDrvSizeT sz; - char lb[4]; - char* lbp; - struct iovec iv[2]; - - /* (len > ((unsigned long)-1 >> (4-pb)*8)) */ - if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) { - driver_failure_posix(ix, EINVAL); - return; /* -1; */ - } - put_int32(len, lb); - lbp = lb + (4-pb); - - if ((sz = driver_sizeq(ix)) > 0) { - driver_enq(ix, lbp, pb); - driver_enq(ix, buf, len); - if (sz + len + pb >= (1 << 13)) - set_busy_port(ix, 1); - } - else { - iv[0].iov_base = lbp; - iv[0].iov_len = pb; /* should work for pb=0 */ - iv[1].iov_base = buf; - iv[1].iov_len = len; - n = writev(ofd, iv, 2); - if (n == pb+len) - return; /* 0; */ - if (n < 0) { - if ((errno != EINTR) && (errno != ERRNO_BLOCK)) { - driver_failure_posix(ix, errno); - return; /* -1; */ - } - n = 0; - } - if (n < pb) { - driver_enq(ix, lbp+n, pb-n); - driver_enq(ix, buf, len); - } - else { - n -= pb; - driver_enq(ix, buf+n, len-n); - } - driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1); - } - return; /* 0; */ -} - -static int port_inp_failure(ErlDrvPort port_num, int ready_fd, int res) - /* Result: 0 (eof) or -1 (error) */ -{ - int err = errno; - - 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; - - if (driver_data[ready_fd].alive) { - /* - * We have eof and want to report exit status, but the process - * hasn't exited yet. When it does report_exit_status() will - * driver_select() this fd which will make sure that we get - * back here with driver_data[ready_fd].alive == 0 and - * driver_data[ready_fd].status set. - */ - CHLD_STAT_UNLOCK; - return 0; - } - else { - int status = driver_data[ready_fd].status; - CHLD_STAT_UNLOCK; - - /* We need not be prepared for stopped/continued processes. */ - if (WIFSIGNALED(status)) - status = 128 + WTERMSIG(status); - else - status = WEXITSTATUS(status); - - driver_report_exit(driver_data[ready_fd].port_num, status); - } - } - driver_failure_eof(port_num); - } else { - driver_failure_posix(port_num, err); - } - return 0; -} - -/* fd is the drv_data that is returned from the */ -/* initial start routine */ -/* ready_fd is the descriptor that is ready to read */ - -static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) -{ - int fd = (int)(long)e; - ErlDrvPort port_num; - int packet_bytes; - int res; - Uint h; - - 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); - res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ); - if (res < 0) { - if ((errno != EINTR) && (errno != ERRNO_BLOCK)) - port_inp_failure(port_num, ready_fd, res); - } - else if (res == 0) - port_inp_failure(port_num, ready_fd, res); - else - driver_output(port_num, (char*) read_buf, res); - erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf); - } - else if (fd_data[ready_fd].remain > 0) { /* We try to read the remainder */ - /* space is allocated in buf */ - res = read(ready_fd, fd_data[ready_fd].cpos, - fd_data[ready_fd].remain); - if (res < 0) { - if ((errno != EINTR) && (errno != ERRNO_BLOCK)) - port_inp_failure(port_num, ready_fd, res); - } - else if (res == 0) { - port_inp_failure(port_num, ready_fd, res); - } - else if (res == fd_data[ready_fd].remain) { /* we're done */ - driver_output(port_num, fd_data[ready_fd].buf, - fd_data[ready_fd].sz); - clear_fd_data(ready_fd); - } - else { /* if (res < fd_data[ready_fd].remain) */ - fd_data[ready_fd].cpos += res; - fd_data[ready_fd].remain -= res; - } - } - else if (fd_data[ready_fd].remain == 0) { /* clean fd */ - byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF, - ERTS_SYS_READ_BUF_SZ); - /* We make one read attempt and see what happens */ - res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ); - if (res < 0) { - if ((errno != EINTR) && (errno != ERRNO_BLOCK)) - port_inp_failure(port_num, ready_fd, res); - } - else if (res == 0) { /* eof */ - port_inp_failure(port_num, ready_fd, res); - } - else if (res < packet_bytes - fd_data[ready_fd].psz) { - memcpy(fd_data[ready_fd].pbuf+fd_data[ready_fd].psz, - read_buf, res); - fd_data[ready_fd].psz += res; - } - else { /* if (res >= packet_bytes) */ - unsigned char* cpos = read_buf; - int bytes_left = res; - - while (1) { - int psz = fd_data[ready_fd].psz; - char* pbp = fd_data[ready_fd].pbuf + psz; - - while(bytes_left && (psz < packet_bytes)) { - *pbp++ = *cpos++; - bytes_left--; - psz++; - } - - if (psz < packet_bytes) { - fd_data[ready_fd].psz = psz; - break; - } - fd_data[ready_fd].psz = 0; - - switch (packet_bytes) { - case 1: h = get_int8(fd_data[ready_fd].pbuf); break; - case 2: h = get_int16(fd_data[ready_fd].pbuf); break; - case 4: h = get_int32(fd_data[ready_fd].pbuf); break; - default: ASSERT(0); return; /* -1; */ - } - - if (h <= (bytes_left)) { - driver_output(port_num, (char*) cpos, h); - cpos += h; - bytes_left -= h; - continue; - } - else { /* The last message we got was split */ - char *buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h); - if (!buf) { - errno = ENOMEM; - port_inp_failure(port_num, ready_fd, -1); - } - else { - erts_smp_atomic_add_nob(&sys_misc_mem_sz, h); - sys_memcpy(buf, cpos, bytes_left); - fd_data[ready_fd].buf = buf; - fd_data[ready_fd].sz = h; - fd_data[ready_fd].remain = h - bytes_left; - fd_data[ready_fd].cpos = buf + bytes_left; - } - break; - } - } - } - erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf); - } -} - - -/* fd is the drv_data that is returned from the */ -/* initial start routine */ -/* ready_fd is the descriptor that is ready to read */ - -static void ready_output(ErlDrvData e, ErlDrvEvent ready_fd) -{ - int fd = (int)(long)e; - ErlDrvPort ix = driver_data[fd].port_num; - int n; - struct iovec* iv; - int vsize; - - - 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; - if ((n = writev(ready_fd, iv, vsize)) > 0) { - if (driver_deq(ix, n) == 0) - set_busy_port(ix, 0); - } - else if (n < 0) { - if (errno == ERRNO_BLOCK || errno == EINTR) - return; /* 0; */ - else { - int res = errno; - driver_select(ix, ready_fd, ERL_DRV_WRITE, 0); - driver_failure_posix(ix, res); - return; /* -1; */ - } - } - return; /* 0; */ -} - -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 = 0; - /* 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); - - do { - res = writev(dd->ofd, iov, iovlen); - } while (res < 0 && errno == EINTR); - if (res < 0) - 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) { - if (dd->blocking->err == ERRNO_BLOCK) { - set_busy_port(port_num, 1); - /* still data left to write in queue */ - driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL); - } else - driver_failure_posix(port_num, dd->blocking->err); - return; /* -1; */ - } - return; /* 0; */ -} - -#endif - void erts_do_break_handling(void) { struct termios temp_mode; @@ -2738,10 +1017,6 @@ erts_sys_unsetenv(char *key) void sys_init_io(void) { - fd_data = (struct fd_data *) - erts_alloc(ERTS_ALC_T_FD_TAB, max_files * sizeof(struct fd_data)); - erts_smp_atomic_add_nob(&sys_misc_mem_sz, - max_files * sizeof(struct fd_data)); } #if (0) /* unused? */ @@ -2935,179 +1210,6 @@ erl_debug(char* fmt, ...) #endif /* DEBUG */ -static ERTS_INLINE void -report_exit_status(ErtsSysReportExit *rep, int status) -{ - Port *pp; -#ifdef ERTS_SMP - CHLD_STAT_UNLOCK; - pp = erts_thr_id2port_sflgs(rep->port, - ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); - CHLD_STAT_LOCK; -#else - pp = erts_id2port_sflgs(rep->port, - NULL, - 0, - ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); -#endif - if (pp) { - if (rep->ifd >= 0) { - driver_data[rep->ifd].alive = 0; - driver_data[rep->ifd].status = status; - (void) driver_select(ERTS_Port2ErlDrvPort(pp), - rep->ifd, - (ERL_DRV_READ|ERL_DRV_USE), - 1); - } - if (rep->ofd >= 0) { - driver_data[rep->ofd].alive = 0; - driver_data[rep->ofd].status = status; - (void) driver_select(ERTS_Port2ErlDrvPort(pp), - rep->ofd, - (ERL_DRV_WRITE|ERL_DRV_USE), - 1); - } -#ifdef ERTS_SMP - erts_thr_port_release(pp); -#else - erts_port_release(pp); -#endif - } - erts_free(ERTS_ALC_T_PRT_REP_EXIT, rep); -} - -#if !CHLDWTHR /* ---------------------------------------------------------- */ - -#define ERTS_REPORT_EXIT_STATUS report_exit_status - -static int check_children(void) -{ - int res = 0; - int pid; - int status; - -#ifndef ERTS_SMP - if (children_died) -#endif - { - sys_sigblock(SIGCHLD); - CHLD_STAT_LOCK; - while ((pid = waitpid(-1, &status, WNOHANG)) > 0) - note_child_death(pid, status); -#ifndef ERTS_SMP - children_died = 0; -#endif - CHLD_STAT_UNLOCK; - sys_sigrelease(SIGCHLD); - res = 1; - } - return res; -} - -#ifdef ERTS_SMP - -void -erts_check_children(void) -{ - (void) check_children(); -} - -#endif - -#elif CHLDWTHR && defined(ERTS_SMP) /* ------------------------------------- */ - -#define ERTS_REPORT_EXIT_STATUS report_exit_status - -#define check_children() (0) - - -#else /* CHLDWTHR && !defined(ERTS_SMP) ------------------------------------ */ - -#define ERTS_REPORT_EXIT_STATUS initiate_report_exit_status - -static ERTS_INLINE void -initiate_report_exit_status(ErtsSysReportExit *rep, int status) -{ - rep->next = report_exit_transit_list; - rep->status = status; - report_exit_transit_list = rep; - erts_sys_schedule_interrupt(1); -} - -static int check_children(void) -{ - int res; - ErtsSysReportExit *rep; - CHLD_STAT_LOCK; - rep = report_exit_transit_list; - res = rep != NULL; - while (rep) { - ErtsSysReportExit *curr_rep = rep; - rep = rep->next; - report_exit_status(curr_rep, curr_rep->status); - } - report_exit_transit_list = NULL; - CHLD_STAT_UNLOCK; - return res; -} - -#endif /* ------------------------------------------------------------------ */ - -static void note_child_death(int pid, int status) -{ - ErtsSysReportExit **repp = &report_exit_list; - ErtsSysReportExit *rep = report_exit_list; - - while (rep) { - if (pid == rep->pid) { - *repp = rep->next; - ERTS_REPORT_EXIT_STATUS(rep, status); - break; - } - repp = &rep->next; - rep = rep->next; - } -} - -#if CHLDWTHR - -static void * -child_waiter(void *unused) -{ - int pid; - int status; - -#ifdef ERTS_ENABLE_LOCK_CHECK - erts_lc_set_thread_name("child waiter"); -#endif - - while(1) { -#ifdef DEBUG - int waitpid_errno; -#endif - pid = waitpid(-1, &status, 0); -#ifdef DEBUG - waitpid_errno = errno; -#endif - CHLD_STAT_LOCK; - if (pid < 0) { - ASSERT(waitpid_errno == ECHILD); - } - else { - children_alive--; - ASSERT(children_alive >= 0); - note_child_death(pid, status); - } - while (!children_alive) - CHLD_STAT_WAIT; /* Wait for children to wait on... :) */ - CHLD_STAT_UNLOCK; - } - - return NULL; -} - -#endif - /* * Called from schedule() when it runs out of runnable processes, * or when Erlang code has performed INPUT_REDUCTIONS reduction @@ -3116,13 +1218,8 @@ child_waiter(void *unused) void erl_sys_schedule(int runnable) { -#ifdef ERTS_SMP ERTS_CHK_IO(!runnable); -#else - ERTS_CHK_IO(runnable ? 0 : !check_children()); -#endif ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); - (void) check_children(); } @@ -3150,10 +1247,6 @@ smp_sig_notify(char c) static void * signal_dispatcher_thread_func(void *unused) { -#if !CHLDWTHR - int initialized = 0; - int notify_check_children = 0; -#endif #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_set_thread_name("signal_dispatcher"); #endif @@ -3191,19 +1284,7 @@ signal_dispatcher_thread_func(void *unused) */ switch (buf[i]) { case 0: /* Emulator initialized */ -#if !CHLDWTHR - initialized = 1; - if (!notify_check_children) -#endif - break; -#if !CHLDWTHR - case 'C': /* SIGCHLD */ - if (initialized) - erts_smp_notify_check_children_needed(); - else - notify_check_children = 1; - break; -#endif + break; case 'I': /* SIGINT */ break_requested(); break; @@ -3248,12 +1329,14 @@ init_smp_sig_notify(void) static void init_smp_sig_suspend(void) { +#ifdef ERTS_SYS_SUSPEND_SIGNAL if (pipe(sig_suspend_fds) < 0) { erts_exit(ERTS_ABORT_EXIT, "Failed to create sig_suspend pipe: %s (%d)\n", erl_errno_id(errno), errno); } +#endif } #ifdef __DARWIN__ diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c new file mode 100644 index 0000000000..ac39b8a389 --- /dev/null +++ b/erts/emulator/sys/unix/sys_drivers.c @@ -0,0 +1,1862 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2016. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#ifdef ISC32 +#define _POSIX_SOURCE +#define _XOPEN_SOURCE +#endif + +#include <sys/times.h> /* ! */ +#include <time.h> +#include <signal.h> +#include <sys/wait.h> +#include <sys/uio.h> +#include <termios.h> +#include <ctype.h> +#include <sys/utsname.h> +#include <sys/select.h> +#include <arpa/inet.h> + +#ifdef ISC32 +#include <sys/bsdtypes.h> +#endif + +#include <termios.h> +#ifdef HAVE_FCNTL_H +#include <fcntl.h> +#endif +#ifdef HAVE_SYS_IOCTL_H +#include <sys/ioctl.h> +#endif + +#define WANT_NONBLOCKING /* must define this to pull in defs from sys.h */ +#include "sys.h" + +#ifdef USE_THREADS +#include "erl_threads.h" +#endif + +extern char **environ; +extern erts_smp_rwmtx_t environ_rwmtx; + +extern erts_smp_atomic_t sys_misc_mem_sz; + +static Eterm forker_port; + +#define MAX_VSIZE 16 /* Max number of entries allowed in an I/O + * vector sock_sendv(). + */ +/* + * Don't need global.h, but erl_cpu_topology.h won't compile otherwise + */ +#include "global.h" +#include "erl_cpu_topology.h" + +#include "erl_sys_driver.h" +#include "sys_uds.h" + +#include "erl_child_setup.h" + +#if defined IOV_MAX +#define MAXIOV IOV_MAX +#elif defined UIO_MAXIOV +#define MAXIOV UIO_MAXIOV +#else +#define MAXIOV 16 +#endif + +#ifdef USE_THREADS +# define FDBLOCK 1 +#else +# define FDBLOCK 0 +#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; + +typedef struct fd_data { + int fd; + char pbuf[4]; /* hold partial packet bytes */ + int psz; /* size of pbuf */ + char *buf; + char *cpos; + int sz; + int remain; /* for input on fd */ +} ErtsSysFdData; + +typedef struct driver_data { + ErlDrvPort port_num; + ErtsSysFdData *ofd; + ErtsSysFdData *ifd; + int packet_bytes; + int pid; + int alive; + int status; + int terminating; + ErtsSysBlocking *blocking; +} ErtsSysDriverData; + +#define DIR_SEPARATOR_CHAR '/' + +#if defined(__ANDROID__) +#define SHELL "/system/bin/sh" +#else +#define SHELL "/bin/sh" +#endif /* __ANDROID__ */ + +#if defined(DEBUG) +#define ERL_BUILD_TYPE_MARKER ".debug" +#elif defined(PURIFY) +#define ERL_BUILD_TYPE_MARKER ".purify" +#elif defined(QUANTIFY) +#define ERL_BUILD_TYPE_MARKER ".quantify" +#elif defined(PURECOV) +#define ERL_BUILD_TYPE_MARKER ".purecov" +#elif defined(VALGRIND) +#define ERL_BUILD_TYPE_MARKER ".valgrind" +#else /* opt */ +#define ERL_BUILD_TYPE_MARKER +#endif + +#ifdef DEBUG +#define close(fd) do { int res = close(fd); ASSERT(res > -1); } while(0) +#endif + +#define CHILD_SETUP_PROG_NAME "erl_child_setup" ERL_BUILD_TYPE_MARKER + +// #define HARD_DEBUG +#ifdef HARD_DEBUG +#define driver_select(port_num, fd, flags, onoff) \ + do { \ + if (((flags) & ERL_DRV_READ) && onoff) \ + fprintf(stderr,"%010d %p: read select %d\r\n", __LINE__, port_num, (int)fd); \ + if (((flags) & ERL_DRV_WRITE) && onoff) \ + fprintf(stderr,"%010d %p: writ select %d\r\n", __LINE__, port_num, (int)fd); \ + if (((flags) & ERL_DRV_READ) && !onoff) \ + fprintf(stderr,"%010d %p: read unsele %d\r\n", __LINE__, port_num, (int)fd); \ + if (((flags) & ERL_DRV_WRITE) && !onoff) \ + fprintf(stderr,"%010d %p: writ unsele %d\r\n", __LINE__, port_num, (int)fd); \ + driver_select_nkp(port_num, fd, flags, onoff); \ + } while(0) +#endif + +/* + * Decreasing the size of it below 16384 is not allowed. + */ + +#define ERTS_SYS_READ_BUF_SZ (64*1024) + +/* I. Initialization */ + +void +erl_sys_late_init(void) +{ + SysDriverOpts opts; +#ifdef ERTS_SMP + Port *port; +#endif + + sys_signal(SIGPIPE, SIG_IGN); /* Ignore - we'll handle the write failure */ + + opts.packet_bytes = 0; + opts.use_stdio = 1; + opts.redir_stderr = 0; + opts.read_write = 0; + opts.hide_window = 0; + opts.wd = NULL; + opts.envir = NULL; + opts.exit_status = 0; + opts.overlapped_io = 0; + opts.spawn_type = ERTS_SPAWN_ANY; + opts.argv = NULL; + opts.parallelism = erts_port_parallelism; + +#ifdef ERTS_SMP + port = +#endif + erts_open_driver(&forker_driver, make_internal_pid(0), "forker", &opts, NULL, NULL); +#ifdef ERTS_SMP + erts_mtx_unlock(port->lock); +#endif +} + +/* II. Prototypes */ + +/* II.I Spawn prototypes */ +static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); +static ErlDrvSSizeT spawn_control(ErlDrvData, unsigned int, char *, + ErlDrvSizeT, char **, ErlDrvSizeT); + +/* II.II Vanilla prototypes */ +static ErlDrvData vanilla_start(ErlDrvPort, char*, SysDriverOpts*); + + +/* II.III FD prototypes */ +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 void fd_stop(ErlDrvData); +static void fd_flush(ErlDrvData); + +/* II.IV Common prototypes */ +static void stop(ErlDrvData); +static void ready_input(ErlDrvData, ErlDrvEvent); +static void ready_output(ErlDrvData, ErlDrvEvent); +static void output(ErlDrvData, char*, ErlDrvSizeT); +static void outputv(ErlDrvData, ErlIOVec*); +static void stop_select(ErlDrvEvent, void*); + +/* II.V Forker prototypes */ +static ErlDrvData forker_start(ErlDrvPort, char*, SysDriverOpts*); +static void forker_stop(ErlDrvData); +static void forker_ready_input(ErlDrvData, ErlDrvEvent); +static void forker_ready_output(ErlDrvData, ErlDrvEvent); +static ErlDrvSSizeT forker_control(ErlDrvData, unsigned int, char *, + ErlDrvSizeT, char **, ErlDrvSizeT); + +/* III Driver entries */ + +/* III.I The spawn driver */ +struct erl_drv_entry spawn_driver_entry = { + NULL, + spawn_start, + stop, + output, + ready_input, + ready_output, + "spawn", + NULL, + NULL, + spawn_control, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING | ERL_DRV_FLAG_USE_INIT_ACK, + NULL, NULL, + stop_select +}; + +/* III.II The fd driver */ +struct erl_drv_entry fd_driver_entry = { + NULL, + fd_start, + fd_stop, + output, + ready_input, + ready_output, + "fd", + NULL, + NULL, + fd_control, + NULL, + outputv, +#if FDBLOCK + fd_ready_async, /* ready_async */ +#else + NULL, +#endif + fd_flush, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, /* ERL_DRV_FLAGs */ + NULL, /* handle2 */ + NULL, /* process_exit */ + stop_select +}; + +/* III.III The vanilla driver */ +struct erl_drv_entry vanilla_driver_entry = { + NULL, + vanilla_start, + stop, + output, + ready_input, + ready_output, + "vanilla", + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, /* ERL_DRV_FLAGs */ + NULL, /* handle2 */ + NULL, /* process_exit */ + stop_select +}; + +/* III.III The forker driver */ +struct erl_drv_entry forker_driver_entry = { + NULL, + forker_start, + forker_stop, + NULL, + forker_ready_input, + forker_ready_output, + "spawn_forker", + NULL, + NULL, + forker_control, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, + NULL, NULL, + stop_select +}; + +/* Untility functions */ + +static int set_blocking_data(ErtsSysDriverData *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 void init_fd_data(ErtsSysFdData *fd_data, int fd) +{ + fd_data->fd = fd; + fd_data->buf = NULL; + fd_data->cpos = NULL; + fd_data->remain = 0; + fd_data->sz = 0; + fd_data->psz = 0; +} + +static ErtsSysDriverData * +create_driver_data(ErlDrvPort port_num, + int ifd, + int ofd, + int packet_bytes, + int read_write, + int exit_status, + int pid, + int is_blocking) +{ + Port *prt; + ErtsSysDriverData *driver_data; + char *data; + int size = sizeof(ErtsSysDriverData); + + if (read_write & DO_READ) + size += sizeof(ErtsSysFdData); + + if ((read_write & DO_WRITE) && + ((ifd != ofd || ofd == -1) || !(read_write & DO_READ))) + size += sizeof(ErtsSysFdData); + + data = erts_alloc(ERTS_ALC_T_DRV_TAB,size); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, size); + + driver_data = (ErtsSysDriverData*)data; + data += sizeof(*driver_data); + + prt = erts_drvport2port(port_num); + if (prt != ERTS_INVALID_ERL_DRV_PORT) + prt->os_pid = pid; + + driver_data->packet_bytes = packet_bytes; + driver_data->port_num = port_num; + driver_data->pid = pid; + driver_data->alive = exit_status ? 1 : 0; + driver_data->status = 0; + driver_data->terminating = 0; + driver_data->blocking = NULL; + + if (read_write & DO_READ) { + driver_data->ifd = (ErtsSysFdData*)data; + data += sizeof(*driver_data->ifd); + init_fd_data(driver_data->ifd, ifd); + driver_select(port_num, ifd, (ERL_DRV_READ|ERL_DRV_USE), 1); + } else { + driver_data->ifd = NULL; + } + + if (read_write & DO_WRITE) { + if (ofd != -1 && ifd == ofd && read_write & DO_READ) { + /* This is for when ifd and ofd are the same fd */ + driver_data->ofd = driver_data->ifd; + } else { + driver_data->ofd = (ErtsSysFdData*)data; + data += sizeof(*driver_data->ofd); + init_fd_data(driver_data->ofd, ofd); + } + if (is_blocking && FDBLOCK) + if (!set_blocking_data(driver_data)) { + erts_free(ERTS_ALC_T_DRV_TAB, driver_data); + return NULL; + } + } else { + driver_data->ofd = NULL; + } + + return driver_data; +} + +/* Spawn driver */ + +static void close_pipes(int ifd[2], int ofd[2]) +{ + close(ifd[0]); + close(ifd[1]); + close(ofd[0]); + close(ofd[1]); +} + +static char **build_unix_environment(char *block) +{ + int i; + int j; + int len; + char *cp; + char **cpp; + char** old_env; + + ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx)); + + cp = block; + len = 0; + while (*cp != '\0') { + cp += strlen(cp) + 1; + len++; + } + old_env = environ; + while (*old_env++ != NULL) { + len++; + } + + cpp = (char **) erts_alloc_fnf(ERTS_ALC_T_ENVIRONMENT, + sizeof(char *) * (len+1)); + if (cpp == NULL) { + return NULL; + } + + cp = block; + len = 0; + while (*cp != '\0') { + cpp[len] = cp; + cp += strlen(cp) + 1; + len++; + } + + i = len; + for (old_env = environ; *old_env; old_env++) { + char* old = *old_env; + + for (j = 0; j < len; j++) { + char *s, *t; + + /* check if cpp[j] equals old + before the = sign, + i.e. + "TMPDIR=/tmp/" */ + s = cpp[j]; + t = old; + while (*s == *t && *s != '=') { + s++, t++; + } + if (*s == '=' && *t == '=') { + break; + } + } + + if (j == len) { /* New version not found */ + cpp[len++] = old; + } + } + + for (j = 0; j < i; ) { + size_t last = strlen(cpp[j])-1; + if (cpp[j][last] == '=' && strchr(cpp[j], '=') == cpp[j]+last) { + cpp[j] = cpp[--len]; + if (len < i) { + i--; + } else { + j++; + } + } + else { + j++; + } + } + + cpp[len] = NULL; + return cpp; +} + +static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, + SysDriverOpts* opts) +{ +#define CMD_LINE_PREFIX_STR "exec " +#define CMD_LINE_PREFIX_STR_SZ (sizeof(CMD_LINE_PREFIX_STR) - 1) + + int len; + char **new_environ; + ErtsSysDriverData *dd; + char *cmd_line; + char wd_buff[MAXPATHLEN+1]; + char *wd; + int ifd[2], ofd[2], stderrfd; + + if (pipe(ifd) < 0) return ERL_DRV_ERROR_ERRNO; + errno = EMFILE; /* default for next three conditions */ + if (ifd[0] >= sys_max_files() || pipe(ofd) < 0) { + close(ifd[0]); + close(ifd[1]); + return ERL_DRV_ERROR_ERRNO; + } + if (ofd[1] >= sys_max_files()) { + close_pipes(ifd, ofd); + errno = EMFILE; + return ERL_DRV_ERROR_ERRNO; + } + + SET_NONBLOCKING(ifd[0]); + SET_NONBLOCKING(ofd[1]); + + stderrfd = opts->redir_stderr ? ifd[1] : dup(2); + + if (stderrfd >= sys_max_files() || stderrfd < 0) { + close_pipes(ifd, ofd); + if (stderrfd > -1) + close(stderrfd); + return ERL_DRV_ERROR_ERRNO; + } + + if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { + /* started with spawn_executable, not with spawn */ + len = strlen(name); + cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, len + 1); + if (!cmd_line) { + close_pipes(ifd, ofd); + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } + memcpy((void *) cmd_line,(void *) name, len); + cmd_line[len] = '\0'; + len = len + 1; + if (access(cmd_line,X_OK) != 0) { + int save_errno = errno; + erts_free(ERTS_ALC_T_TMP, cmd_line); + close_pipes(ifd, ofd); + errno = save_errno; + return ERL_DRV_ERROR_ERRNO; + } + } else { + /* make the string suitable for giving to "sh" */ + len = strlen(name); + cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, + CMD_LINE_PREFIX_STR_SZ + len + 1); + if (!cmd_line) { + close_pipes(ifd, ofd); + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } + memcpy((void *) cmd_line, + (void *) CMD_LINE_PREFIX_STR, + CMD_LINE_PREFIX_STR_SZ); + memcpy((void *) (cmd_line + CMD_LINE_PREFIX_STR_SZ), (void *) name, len); + cmd_line[CMD_LINE_PREFIX_STR_SZ + len] = '\0'; + len = CMD_LINE_PREFIX_STR_SZ + len + 1; + } + + erts_smp_rwmtx_rlock(&environ_rwmtx); + + if (opts->envir == NULL) { + new_environ = environ; + } else if ((new_environ = build_unix_environment(opts->envir)) == NULL) { + erts_smp_rwmtx_runlock(&environ_rwmtx); + close_pipes(ifd, ofd); + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } + + if (opts->wd == NULL) { + if ((wd = getcwd(wd_buff, MAXPATHLEN+1)) == NULL) { + /* on some OSs this call opens a fd in the + background which means that this can + return EMFILE */ + int err = errno; + close_pipes(ifd, ofd); + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + if (new_environ != environ) + erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); + erts_smp_rwmtx_runlock(&environ_rwmtx); + errno = err; + return ERL_DRV_ERROR_ERRNO; + } + } else { + wd = opts->wd; + } + + { + struct iovec *io_vector; + int iov_len = 5; + char nullbuff[] = "\0"; + int j, i = 0, res; + Sint32 buffsz = 0, env_len = 0, argv_len = 0, + flags = (opts->use_stdio ? FORKER_FLAG_USE_STDIO : 0) + | (opts->exit_status ? FORKER_FLAG_EXIT_STATUS : 0) + | (opts->read_write & DO_READ ? FORKER_FLAG_DO_READ : 0) + | (opts->read_write & DO_WRITE ? FORKER_FLAG_DO_WRITE : 0); + + /* count number of elements in environment */ + while(new_environ[env_len] != NULL) + env_len++; + iov_len += 1 + env_len; /* num envs including size int */ + + /* count number of element in argument list */ + if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { + if (opts->argv != NULL) { + while(opts->argv[argv_len] != NULL) + argv_len++; + } else { + argv_len++; + } + iov_len += 1 + argv_len; /* num argvs including size int */ + } + + io_vector = erts_alloc_fnf(ERTS_ALC_T_TMP, sizeof(struct iovec) * iov_len); + + if (!io_vector) { + close_pipes(ifd, ofd); + erts_smp_rwmtx_runlock(&environ_rwmtx); + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + if (new_environ != environ) + erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } + + io_vector[i].iov_base = (void*)&buffsz; + io_vector[i++].iov_len = sizeof(buffsz); + + io_vector[i].iov_base = (void*)&flags; + flags = htonl(flags); + io_vector[i++].iov_len = sizeof(flags); + buffsz += sizeof(flags); + + io_vector[i].iov_base = cmd_line; + io_vector[i++].iov_len = len; + buffsz += len; + + io_vector[i].iov_base = wd; + io_vector[i].iov_len = strlen(io_vector[i].iov_base) + 1; + buffsz += io_vector[i++].iov_len; + + io_vector[i].iov_base = nullbuff; + io_vector[i++].iov_len = 1; + buffsz += io_vector[i-1].iov_len; + + io_vector[i].iov_base = (void*)&env_len; + env_len = htonl(env_len); + io_vector[i++].iov_len = sizeof(env_len); + buffsz += io_vector[i-1].iov_len; + + for (j = 0; new_environ[j] != NULL; j++) { + io_vector[i].iov_base = new_environ[j]; + io_vector[i++].iov_len = strlen(new_environ[j]) + 1; + buffsz += io_vector[i-1].iov_len; + } + + /* only append arguments if this was a spawn_executable */ + if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { + + io_vector[i].iov_base = (void*)&argv_len; + argv_len = htonl(argv_len); + io_vector[i++].iov_len = sizeof(argv_len); + buffsz += io_vector[i-1].iov_len; + + if (opts->argv) { + /* If there are arguments we copy in the references to + them into the iov */ + for (j = 0; opts->argv[j]; j++) { + if (opts->argv[j] == erts_default_arg0) + io_vector[i].iov_base = cmd_line; + else + io_vector[i].iov_base = opts->argv[j]; + io_vector[i].iov_len = strlen(io_vector[i].iov_base) + 1; + buffsz += io_vector[i++].iov_len; + } + } else { + io_vector[i].iov_base = cmd_line; + io_vector[i].iov_len = strlen(io_vector[i].iov_base) + 1; + buffsz += io_vector[i++].iov_len; + } + } + + /* we send the request to do the fork */ + if ((res = writev(ofd[1], io_vector, iov_len > MAXIOV ? MAXIOV : iov_len)) < 0) { + if (errno == ERRNO_BLOCK) { + res = 0; + } else { + int err = errno; + close_pipes(ifd, ofd); + erts_free(ERTS_ALC_T_TMP, io_vector); + if (new_environ != environ) + erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); + erts_smp_rwmtx_runlock(&environ_rwmtx); + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + errno = err; + return ERL_DRV_ERROR_ERRNO; + } + } + + if (res < buffsz) { + /* we only wrote part of the command payload. Enqueue the rest. */ + for (i = 0; i < iov_len; i++) { + driver_enq(port_num, io_vector[i].iov_base, io_vector[i].iov_len); + } + driver_deq(port_num, res); + driver_select(port_num, ofd[1], ERL_DRV_WRITE|ERL_DRV_USE, 1); + } + + erts_free(ERTS_ALC_T_TMP, io_vector); + } + + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + + if (new_environ != environ) + erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); + + erts_smp_rwmtx_runlock(&environ_rwmtx); + + dd = create_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes, + DO_WRITE | DO_READ, opts->exit_status, + 0, 0); + + { + /* send ofd[0] + ifd[1] + stderrfd to forker port */ + ErtsSysForkerProto *proto = + erts_alloc(ERTS_ALC_T_DRV_CTRL_DATA, + sizeof(ErtsSysForkerProto)); + memset(proto, 0, sizeof(ErtsSysForkerProto)); + proto->action = ErtsSysForkerProtoAction_Start; + proto->u.start.fds[0] = ofd[0]; + proto->u.start.fds[1] = ifd[1]; + proto->u.start.fds[2] = stderrfd; + proto->u.start.port_id = opts->exit_status ? erts_drvport2id(port_num) : THE_NON_VALUE; + if (erl_drv_port_control(forker_port, 'S', (char*)proto, sizeof(*proto))) { + /* The forker port has been killed, we close both fd's which will + make open_port throw an epipe error */ + close(ofd[0]); + close(ifd[1]); + } + } + + /* we set these fds to negative to mark if + they should be closed after the handshake */ + if (!(opts->read_write & DO_READ)) + dd->ifd->fd *= -1; + + if (!(opts->read_write & DO_WRITE)) + dd->ofd->fd *= -1; + + return (ErlDrvData)dd; +#undef CMD_LINE_PREFIX_STR +#undef CMD_LINE_PREFIX_STR_SZ +} + +static ErlDrvSSizeT spawn_control(ErlDrvData e, unsigned int cmd, char *buf, + ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen) +{ + ErtsSysDriverData *dd = (ErtsSysDriverData*)e; + ErtsSysForkerProto *proto = (ErtsSysForkerProto *)buf; + + ASSERT(len == sizeof(*proto)); + ASSERT(proto->action == ErtsSysForkerProtoAction_SigChld); + + dd->status = proto->u.sigchld.error_number; + dd->alive = -1; + + if (dd->ifd) + driver_select(dd->port_num, abs(dd->ifd->fd), ERL_DRV_READ | ERL_DRV_USE, 1); + + if (dd->ofd) + driver_select(dd->port_num, abs(dd->ofd->fd), ERL_DRV_WRITE | ERL_DRV_USE, 1); + + return 0; +} + +#define FD_DEF_HEIGHT 24 +#define FD_DEF_WIDTH 80 +/* Control op */ +#define FD_CTRL_OP_GET_WINSIZE 100 + +static int fd_get_window_size(int fd, Uint32 *width, Uint32 *height) +{ +#ifdef TIOCGWINSZ + struct winsize ws; + if (ioctl(fd,TIOCGWINSZ,&ws) == 0) { + *width = (Uint32) ws.ws_col; + *height = (Uint32) ws.ws_row; + return 0; + } +#endif + return -1; +} + +static ErlDrvSSizeT fd_control(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen) +{ + int fd = (int)(long)drv_data; + char resbuff[2*sizeof(Uint32)]; + switch (command) { + case FD_CTRL_OP_GET_WINSIZE: + { + Uint32 w,h; + if (fd_get_window_size(fd,&w,&h)) + return 0; + memcpy(resbuff,&w,sizeof(Uint32)); + memcpy(resbuff+sizeof(Uint32),&h,sizeof(Uint32)); + } + break; + default: + return 0; + } + if (rlen < 2*sizeof(Uint32)) { + *rbuf = driver_alloc(2*sizeof(Uint32)); + } + memcpy(*rbuf,resbuff,2*sizeof(Uint32)); + return 2*sizeof(Uint32); +} + +static ErlDrvData fd_start(ErlDrvPort port_num, char* name, + SysDriverOpts* opts) +{ + int non_blocking = 0; + + if (((opts->read_write & DO_READ) && opts->ifd >= sys_max_files()) || + ((opts->read_write & DO_WRITE) && opts->ofd >= sys_max_files())) + return ERL_DRV_ERROR_GENERAL; + + /* + * Historical: + * + * "Note about nonblocking I/O. + * + * At least on Solaris, setting the write end of a TTY to nonblocking, + * will set the input end to nonblocking as well (and vice-versa). + * If erl is run in a pipeline like this: cat | erl + * the input end of the TTY will be the standard input of cat. + * And cat is not prepared to handle nonblocking I/O." + * + * Actually, the reason for this is not that the tty itself gets set + * in non-blocking mode, but that the "input end" (cat's stdin) and + * the "output end" (erlang's stdout) are typically the "same" file + * descriptor, dup()'ed from a single fd by one of this process' + * ancestors. + * + * The workaround for this problem used to be a rather bad kludge, + * interposing an extra process ("internal cat") between erlang's + * stdout and the original stdout, allowing erlang to set its stdout + * in non-blocking mode without affecting the stdin of the preceding + * process in the pipeline - and being a kludge, it caused all kinds + * of weird problems. + * + * So, this is the current logic: + * + * The only reason to set non-blocking mode on the output fd at all is + * if it's something that can cause a write() to block, of course, + * i.e. primarily if it points to a tty, socket, pipe, or fifo. + * + * If we don't set non-blocking mode when we "should" have, and output + * becomes blocked, the entire runtime system will be suspended - this + * is normally bad of course, and can happen fairly "easily" - e.g. user + * hits ^S on tty - but doesn't necessarily happen. + * + * If we do set non-blocking mode when we "shouldn't" have, the runtime + * system will end up seeing EOF on the input fd (due to the preceding + * process dying), which typically will cause the entire runtime system + * to terminate immediately (due to whatever erlang process is seeing + * the EOF taking it as a signal to halt the system). This is *very* bad. + * + * I.e. we should take a conservative approach, and only set non- + * blocking mode when we a) need to, and b) are reasonably certain + * that it won't be a problem. And as in the example above, the problem + * occurs when input fd and output fd point to different "things". + * + * However, determining that they are not just the same "type" of + * "thing", but actually the same instance of that type of thing, is + * unreasonably complex in many/most cases. + * + * Also, with pipes, sockets, and fifos it's far from obvious that the + * user *wants* non-blocking output: If you're running erlang inside + * some complex pipeline, you're probably not running a real-time system + * that must never stop, but rather *want* it to suspend if the output + * channel is "full". + * + * So, the bottom line: We will only set the output fd non-blocking if + * it points to a tty, and either a) the input fd also points to a tty, + * or b) we can make sure that setting the output fd non-blocking + * doesn't interfere with someone else's input, via a somewhat milder + * kludge than the above. + * + * Also keep in mind that while this code is almost exclusively run as + * a result of an erlang open_port({fd,0,1}, ...), that isn't the only + * 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. + */ + + /* Try to figure out if we can use non-blocking writes */ + if (opts->read_write & DO_WRITE) { + + /* If we don't have a read end, all bets are off - no non-blocking. */ + if (opts->read_write & DO_READ) { + + if (isatty(opts->ofd)) { /* output fd is a tty:-) */ + + if (isatty(opts->ifd)) { /* input fd is also a tty */ + + /* To really do this "right", we should also check that + input and output fd point to the *same* tty - but + this seems like overkill; ttyname() isn't for free, + and this is a very common case - and it's hard to + 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 */ + + /* This is a "problem case", but also common (see the + example above) - i.e. it makes sense to try a bit + harder before giving up on non-blocking mode: Try to + re-open the tty that the output fd points to, and if + successful replace the original one with the "new" fd + obtained this way, and set *that* one in non-blocking + mode. (Yes, this is a kludge.) + + However, re-opening the tty may fail in a couple of + (unusual) cases: + + 1) The name of the tty (or an equivalent one, i.e. + same major/minor number) can't be found, because + it actually lives somewhere other than /dev (or + wherever ttyname() looks for it), and isn't + equivalent to any of those that do live in the + "standard" place - this should be *very* unusual. + + 2) Permissions on the tty don't allow us to open it - + it's perfectly possible to have an fd open to an + object whose permissions wouldn't allow us to open + it. This is not as unusual as it sounds, one case + is if the user has su'ed to someone else (not + root) - we have a read/write fd open to the tty + (because it has been inherited all the way down + here), but we have neither read nor write + permission for the tty. + + In these cases, we finally give up, and don't set the + output fd in non-blocking mode. */ + + char *tty; + int nfd; + + if ((tty = ttyname(opts->ofd)) != NULL && + (nfd = open(tty, O_WRONLY)) != -1) { + dup2(nfd, opts->ofd); + close(nfd); + non_blocking = 1; + SET_NONBLOCKING(opts->ofd); + } + } + } + } + } + return (ErlDrvData)create_driver_data(port_num, opts->ifd, opts->ofd, + opts->packet_bytes, + opts->read_write, 0, -1, + !non_blocking); +} + +static void clear_fd_data(ErtsSysFdData *fdd) +{ + if (fdd->sz > 0) { + erts_free(ERTS_ALC_T_FD_ENTRY_BUF, (void *) fdd->buf); + ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= fdd->sz); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*fdd->sz); + } + fdd->buf = NULL; + fdd->sz = 0; + fdd->remain = 0; + fdd->cpos = NULL; + fdd->psz = 0; +} + +static void nbio_stop_fd(ErlDrvPort prt, ErtsSysFdData *fdd) +{ + driver_select(prt, abs(fdd->fd), DO_READ|DO_WRITE, 0); + clear_fd_data(fdd); + SET_BLOCKING(abs(fdd->fd)); + +} + +static void fd_stop(ErlDrvData ev) /* Does not close the fds */ +{ + ErtsSysDriverData* dd = (ErtsSysDriverData*)ev; + ErlDrvPort prt = dd->port_num; + int sz = sizeof(ErtsSysDriverData); + +#if FDBLOCK + if (dd->blocking) { + erts_free(ERTS_ALC_T_SYS_BLOCKING, dd->blocking); + dd->blocking = NULL; + sz += sizeof(ErtsSysBlocking); + } +#endif + + if (dd->ifd) { + sz += sizeof(ErtsSysFdData); + nbio_stop_fd(prt, dd->ifd); + } + if (dd->ofd && dd->ofd != dd->ifd) { + sz += sizeof(ErtsSysFdData); + nbio_stop_fd(prt, dd->ofd); + } + + erts_free(ERTS_ALC_T_DRV_TAB, dd); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, -sz); +} + +static void fd_flush(ErlDrvData ev) +{ + ErtsSysDriverData* dd = (ErtsSysDriverData*)ev; + if (!dd->terminating) + dd->terminating = 1; +} + +static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name, + SysDriverOpts* opts) +{ + int flags, fd; + ErlDrvData res; + + flags = (opts->read_write == DO_READ ? O_RDONLY : + opts->read_write == DO_WRITE ? O_WRONLY|O_CREAT|O_TRUNC : + O_RDWR|O_CREAT); + if ((fd = open(name, flags, 0666)) < 0) + return ERL_DRV_ERROR_GENERAL; + if (fd >= sys_max_files()) { + close(fd); + return ERL_DRV_ERROR_GENERAL; + } + SET_NONBLOCKING(fd); + + res = (ErlDrvData)(long)create_driver_data(port_num, fd, fd, + opts->packet_bytes, + opts->read_write, 0, -1, 0); + return res; +} + +/* Note that driver_data[fd].ifd == fd if the port was opened for reading, */ +/* otherwise (i.e. write only) driver_data[fd].ofd = fd. */ + +static void stop(ErlDrvData ev) +{ + ErtsSysDriverData* dd = (ErtsSysDriverData*)ev; + ErlDrvPort prt = dd->port_num; + + if (dd->ifd) { + nbio_stop_fd(prt, dd->ifd); + driver_select(prt, abs(dd->ifd->fd), ERL_DRV_USE, 0); /* close(ifd); */ + } + + if (dd->ofd && dd->ofd != dd->ifd) { + nbio_stop_fd(prt, dd->ofd); + driver_select(prt, abs(dd->ofd->fd), ERL_DRV_USE, 0); /* close(ofd); */ + } + + erts_free(ERTS_ALC_T_DRV_TAB, dd); +} + +/* used by fd_driver */ +static void outputv(ErlDrvData e, ErlIOVec* ev) +{ + ErtsSysDriverData *dd = (ErtsSysDriverData*)e; + ErlDrvPort ix = dd->port_num; + int pb = dd->packet_bytes; + int ofd = dd->ofd ? dd->ofd->fd : -1; + ssize_t n; + ErlDrvSizeT sz; + char lb[4]; + char* lbp; + ErlDrvSizeT len = ev->size; + + /* (len > ((unsigned long)-1 >> (4-pb)*8)) */ + /* if (pb >= 0 && (len & (((ErlDrvSizeT)1 << (pb*8))) - 1) != len) {*/ + if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) { + driver_failure_posix(ix, EINVAL); + return; /* -1; */ + } + /* Handles 0 <= pb <= 4 only */ + put_int32((Uint32) len, lb); + lbp = lb + (4-pb); + + ev->iov[0].iov_base = lbp; + ev->iov[0].iov_len = pb; + ev->size += pb; + + if (dd->blocking && FDBLOCK) + driver_pdl_lock(dd->blocking->pdl); + + if ((sz = driver_sizeq(ix)) > 0) { + driver_enqv(ix, ev, 0); + + if (dd->blocking && FDBLOCK) + driver_pdl_unlock(dd->blocking->pdl); + + if (sz + ev->size >= (1 << 13)) + set_busy_port(ix, 1); + } + else if (!dd->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); + if (n == ev->size) + return; /* 0;*/ + if (n < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) { + driver_failure_posix(ix, errno); + return; /* -1;*/ + } + n = 0; + } + 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(dd->blocking->pdl); + driver_async(ix, &dd->blocking->pkey, + fd_async, dd, NULL); + } else { + driver_pdl_unlock(dd->blocking->pdl); + } + } +#endif + /* return 0;*/ +} + +/* Used by spawn_driver and vanilla driver */ +static void output(ErlDrvData e, char* buf, ErlDrvSizeT len) +{ + ErtsSysDriverData *dd = (ErtsSysDriverData*)e; + ErlDrvPort ix = dd->port_num; + int pb = dd->packet_bytes; + int ofd = dd->ofd ? dd->ofd->fd : -1; + ssize_t n; + ErlDrvSizeT sz; + char lb[4]; + char* lbp; + struct iovec iv[2]; + + /* (len > ((unsigned long)-1 >> (4-pb)*8)) */ + if (((pb == 2) && (len > 0xffff)) + || (pb == 1 && len > 0xff) + || dd->pid == 0 /* Attempt at output before port is ready */) { + driver_failure_posix(ix, EINVAL); + return; /* -1; */ + } + put_int32(len, lb); + lbp = lb + (4-pb); + + if ((sz = driver_sizeq(ix)) > 0) { + driver_enq(ix, lbp, pb); + driver_enq(ix, buf, len); + if (sz + len + pb >= (1 << 13)) + set_busy_port(ix, 1); + } + else { + iv[0].iov_base = lbp; + iv[0].iov_len = pb; /* should work for pb=0 */ + iv[1].iov_base = buf; + iv[1].iov_len = len; + n = writev(ofd, iv, 2); + if (n == pb+len) + return; /* 0; */ + if (n < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) { + driver_failure_posix(ix, errno); + return; /* -1; */ + } + n = 0; + } + if (n < pb) { + driver_enq(ix, lbp+n, pb-n); + driver_enq(ix, buf, len); + } + else { + n -= pb; + driver_enq(ix, buf+n, len-n); + } + driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1); + } + return; /* 0; */ +} + +static int port_inp_failure(ErtsSysDriverData *dd, int res) + /* Result: 0 (eof) or -1 (error) */ +{ + int err = errno; + + ASSERT(res <= 0); + if (dd->ifd) { + driver_select(dd->port_num, dd->ifd->fd, ERL_DRV_READ|ERL_DRV_WRITE, 0); + clear_fd_data(dd->ifd); + } + + if (dd->blocking && FDBLOCK) { + driver_pdl_lock(dd->blocking->pdl); + if (driver_sizeq(dd->port_num) > 0) { + driver_pdl_unlock(dd->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) + dd->terminating = 2; + else + dd->terminating = -err; + return 0; + } + driver_pdl_unlock(dd->blocking->pdl); + } + + if (res == 0) { + if (dd->alive == 1) { + /* + * We have eof and want to report exit status, but the process + * hasn't exited yet. When it does ready_input will + * driver_select() this fd which will make sure that we get + * back here with dd->alive == -1 and dd->status set. + */ + return 0; + } + else if (dd->alive == -1) { + int status = dd->status; + + /* We need not be prepared for stopped/continued processes. */ + if (WIFSIGNALED(status)) + status = 128 + WTERMSIG(status); + else + status = WEXITSTATUS(status); + driver_report_exit(dd->port_num, status); + } + driver_failure_eof(dd->port_num); + } else if (dd->ifd) { + erl_drv_init_ack(dd->port_num, ERL_DRV_ERROR_ERRNO); + } else { + driver_failure_posix(dd->port_num, err); + } + return 0; +} + +/* fd is the drv_data that is returned from the */ +/* initial start routine */ +/* ready_fd is the descriptor that is ready to read */ + +static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) +{ + ErtsSysDriverData *dd = (ErtsSysDriverData*)e; + ErlDrvPort port_num; + int packet_bytes; + int res; + Uint h; + + port_num = dd->port_num; + packet_bytes = dd->packet_bytes; + + ASSERT(abs(dd->ifd->fd) == ready_fd); + + if (dd->pid == 0) { + /* the pid is sent from erl_child_setup. spawn driver only. */ + ErtsSysForkerProto proto; + int res; + + if((res = read(ready_fd, &proto, sizeof(proto))) <= 0) { + /* hmm, child setup seems to have closed the pipe too early... + we close the port as there is not much else we can do */ + if (res < 0 && errno == ERRNO_BLOCK) + return; + driver_select(port_num, ready_fd, ERL_DRV_READ, 0); + if (res == 0) + errno = EPIPE; + port_inp_failure(dd, -1); + return; + } + + ASSERT(proto.action == ErtsSysForkerProtoAction_Go); + dd->pid = proto.u.go.os_pid; + + if (dd->pid == -1) { + /* Setup failed! The only reason why this should happen is if + the fork fails. */ + errno = proto.u.go.error_number; + port_inp_failure(dd, -1); + return; + } + + proto.action = ErtsSysForkerProtoAction_Ack; + + if (driver_sizeq(port_num) > 0) { + driver_enq(port_num, (char*)&proto, sizeof(proto)); + } else { + if (write(abs(dd->ofd->fd), &proto, sizeof(proto)) < 0) + if (errno == ERRNO_BLOCK || errno == EINTR) + driver_enq(port_num, (char*)&proto, sizeof(proto)); + /* do nothing on failure here. If the ofd is broken, then + the ifd will probably also be broken and trigger + a port_inp_failure */ + } + + if (dd->ifd->fd < 0) { + driver_select(port_num, abs(dd->ifd->fd), ERL_DRV_READ|ERL_DRV_USE, 0); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, -sizeof(ErtsSysFdData)); + dd->ifd = NULL; + } + + if (dd->ofd->fd < 0 || driver_sizeq(port_num) > 0) + /* we select in order to close fd or write to queue, + child setup will close this fd if fd < 0 */ + driver_select(port_num, abs(dd->ofd->fd), ERL_DRV_WRITE|ERL_DRV_USE, 1); + + erl_drv_set_os_pid(port_num, dd->pid); + erl_drv_init_ack(port_num, e); + return; + } + + if (packet_bytes == 0) { + byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF, + ERTS_SYS_READ_BUF_SZ); + res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ); + if (res < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) + port_inp_failure(dd, res); + } + else if (res == 0) + port_inp_failure(dd, res); + else + driver_output(port_num, (char*) read_buf, res); + erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf); + } + else if (dd->ifd->remain > 0) { /* We try to read the remainder */ + /* space is allocated in buf */ + res = read(ready_fd, dd->ifd->cpos, + dd->ifd->remain); + if (res < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) + port_inp_failure(dd, res); + } + else if (res == 0) { + port_inp_failure(dd, res); + } + else if (res == dd->ifd->remain) { /* we're done */ + driver_output(port_num, dd->ifd->buf, + dd->ifd->sz); + clear_fd_data(dd->ifd); + } + else { /* if (res < dd->ifd->remain) */ + dd->ifd->cpos += res; + dd->ifd->remain -= res; + } + } + else if (dd->ifd->remain == 0) { /* clean fd */ + byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF, + ERTS_SYS_READ_BUF_SZ); + /* We make one read attempt and see what happens */ + res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ); + if (res < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) + port_inp_failure(dd, res); + } + else if (res == 0) { /* eof */ + port_inp_failure(dd, res); + } + else if (res < packet_bytes - dd->ifd->psz) { + memcpy(dd->ifd->pbuf+dd->ifd->psz, + read_buf, res); + dd->ifd->psz += res; + } + else { /* if (res >= packet_bytes) */ + unsigned char* cpos = read_buf; + int bytes_left = res; + + while (1) { + int psz = dd->ifd->psz; + char* pbp = dd->ifd->pbuf + psz; + + while(bytes_left && (psz < packet_bytes)) { + *pbp++ = *cpos++; + bytes_left--; + psz++; + } + + if (psz < packet_bytes) { + dd->ifd->psz = psz; + break; + } + dd->ifd->psz = 0; + + switch (packet_bytes) { + case 1: h = get_int8(dd->ifd->pbuf); break; + case 2: h = get_int16(dd->ifd->pbuf); break; + case 4: h = get_int32(dd->ifd->pbuf); break; + default: ASSERT(0); return; /* -1; */ + } + + if (h <= (bytes_left)) { + driver_output(port_num, (char*) cpos, h); + cpos += h; + bytes_left -= h; + continue; + } + else { /* The last message we got was split */ + char *buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h); + if (!buf) { + errno = ENOMEM; + port_inp_failure(dd, -1); + } + else { + erts_smp_atomic_add_nob(&sys_misc_mem_sz, h); + sys_memcpy(buf, cpos, bytes_left); + dd->ifd->buf = buf; + dd->ifd->sz = h; + dd->ifd->remain = h - bytes_left; + dd->ifd->cpos = buf + bytes_left; + } + break; + } + } + } + erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf); + } +} + + +/* fd is the drv_data that is returned from the */ +/* initial start routine */ +/* ready_fd is the descriptor that is ready to read */ + +static void ready_output(ErlDrvData e, ErlDrvEvent ready_fd) +{ + ErtsSysDriverData *dd = (ErtsSysDriverData*)e; + ErlDrvPort ix = dd->port_num; + int n; + struct iovec* iv; + int vsize; + + if ((iv = (struct iovec*) driver_peekq(ix, &vsize)) == NULL) { + driver_select(ix, ready_fd, ERL_DRV_WRITE, 0); + if (dd->pid > 0 && dd->ofd->fd < 0) { + /* The port was opened with 'in' option, which means we + should close the output fd as soon as the command has + been sent. */ + driver_select(ix, ready_fd, ERL_DRV_WRITE|ERL_DRV_USE, 0); + erts_smp_atomic_add_nob(&sys_misc_mem_sz, -sizeof(ErtsSysFdData)); + dd->ofd = NULL; + } + if (dd->terminating) + driver_failure_atom(dd->port_num,"normal"); + return; /* 0; */ + } + vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize; + if ((n = writev(ready_fd, iv, vsize)) > 0) { + if (driver_deq(ix, n) == 0) + set_busy_port(ix, 0); + } + else if (n < 0) { + if (errno == ERRNO_BLOCK || errno == EINTR) + return; /* 0; */ + else { + int res = errno; + driver_select(ix, ready_fd, ERL_DRV_WRITE, 0); + driver_failure_posix(ix, res); + return; /* -1; */ + } + } + return; /* 0; */ +} + +static void stop_select(ErlDrvEvent fd, void* _) +{ + close((int)fd); +} + +#if FDBLOCK + +static void +fd_async(void *async_data) +{ + int res; + ErtsSysDriverData *dd = (ErtsSysDriverData *)async_data; + SysIOVec *iov0; + SysIOVec *iov; + int iovlen; + int err = 0; + /* 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); + + do { + res = writev(dd->ofd->fd, iov, iovlen); + } while (res < 0 && errno == EINTR); + if (res < 0) + err = errno; + 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) { + ErtsSysDriverData *dd = (ErtsSysDriverData *)thread_data; + ErlDrvPort port_num = dd->port_num; + + ASSERT(dd->blocking); + + 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) { + if (dd->blocking->err == ERRNO_BLOCK) { + set_busy_port(port_num, 1); + /* still data left to write in queue */ + driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL); + } else + driver_failure_posix(port_num, dd->blocking->err); + return; /* -1; */ + } + return; /* 0; */ +} + +#endif + +/* Forker driver */ + +static int forker_fd; + +static ErlDrvData forker_start(ErlDrvPort port_num, char* name, + SysDriverOpts* opts) +{ + + int i; + int fds[2]; + int res, unbind; + char bindir[MAXPATHLEN]; + size_t bindirsz = sizeof(bindir); + Uint csp_path_sz; + char *child_setup_prog; + + forker_port = erts_drvport2id(port_num); + + res = erts_sys_getenv_raw("BINDIR", bindir, &bindirsz); + if (res != 0) { + if (res < 0) + erts_exit(1, + "Environment variable BINDIR is not set\n"); + if (res > 0) + erts_exit(1, + "Value of environment variable BINDIR is too large\n"); + } + if (bindir[0] != DIR_SEPARATOR_CHAR) + erts_exit(1, + "Environment variable BINDIR does not contain an" + " absolute path\n"); + csp_path_sz = (strlen(bindir) + + 1 /* DIR_SEPARATOR_CHAR */ + + sizeof(CHILD_SETUP_PROG_NAME) + + 1); + child_setup_prog = erts_alloc(ERTS_ALC_T_CS_PROG_PATH, csp_path_sz); + erts_snprintf(child_setup_prog, csp_path_sz, + "%s%c%s", + bindir, + DIR_SEPARATOR_CHAR, + CHILD_SETUP_PROG_NAME); + if (socketpair(AF_UNIX, SOCK_STREAM, 0, fds) < 0) { + erts_exit(ERTS_ABORT_EXIT, + "Could not open unix domain socket in spawn_init: %d\n", + errno); + } + + forker_fd = fds[0]; + + unbind = erts_sched_bind_atfork_prepare(); + + i = fork(); + + if (i == 0) { + /* The child */ + char *cs_argv[FORKER_ARGV_NO_OF_ARGS] = + {CHILD_SETUP_PROG_NAME, NULL, NULL}; + char buff[128]; + + erts_sched_bind_atfork_child(unbind); + + snprintf(buff, 128, "%d", sys_max_files()); + cs_argv[FORKER_ARGV_MAX_FILES] = buff; + + /* We preallocate fd 3 for the uds fd */ + if (fds[1] != 3) { + dup2(fds[1], 3); + } + +#if defined(USE_SETPGRP_NOARGS) /* SysV */ + (void) setpgrp(); +#elif defined(USE_SETPGRP) /* BSD */ + (void) setpgrp(0, getpid()); +#else /* POSIX */ + (void) setsid(); +#endif + + execv(child_setup_prog, cs_argv); + _exit(1); + } + + erts_sched_bind_atfork_parent(unbind); + + erts_free(ERTS_ALC_T_CS_PROG_PATH, child_setup_prog); + + close(fds[1]); + + SET_NONBLOCKING(forker_fd); + + driver_select(port_num, forker_fd, ERL_DRV_READ|ERL_DRV_USE, 1); + + return (ErlDrvData)port_num; +} + +static void forker_stop(ErlDrvData e) +{ + /* we probably should do something here, + the port has been closed by the user. */ +} + +static void forker_ready_input(ErlDrvData e, ErlDrvEvent fd) +{ + int res; + ErtsSysForkerProto *proto; + + proto = erts_alloc(ERTS_ALC_T_DRV_CTRL_DATA, sizeof(*proto)); + + if ((res = read(fd, proto, sizeof(*proto))) < 0) { + if (errno == ERRNO_BLOCK) + return; + erts_exit(ERTS_DUMP_EXIT, "Failed to read from erl_child_setup: %d\n", errno); + } + + if (res == 0) + erts_exit(ERTS_DUMP_EXIT, "erl_child_setup closed\n"); + + ASSERT(res == sizeof(*proto)); + +#ifdef FORKER_PROTO_START_ACK + if (proto->action == ErtsSysForkerProtoAction_StartAck) { + /* Ideally we would like to not have to ack each Start + command being sent over the uds, but it would seem + that some operating systems (only observed on FreeBSD) + throw away data on the uds when the socket becomes full, + so we have to. + */ + ErlDrvPort port_num = (ErlDrvPort)e; + int vlen; + SysIOVec *iov = driver_peekq(port_num, &vlen); + ErtsSysForkerProto *proto = (ErtsSysForkerProto *)iov[0].iov_base; + + close(proto->u.start.fds[0]); + close(proto->u.start.fds[1]); + if (proto->u.start.fds[1] != proto->u.start.fds[2]) + close(proto->u.start.fds[2]); + + driver_deq(port_num, sizeof(*proto)); + + if (driver_sizeq(port_num) > 0) + driver_select(port_num, forker_fd, ERL_DRV_WRITE|ERL_DRV_USE, 1); + } else +#endif + { + ASSERT(proto->action == ErtsSysForkerProtoAction_SigChld); + + /* ideally this would be a port_command call, but as command is + already used by the spawn_driver, we use control instead. + Note that when using erl_drv_port_control it is an asynchronous + control. */ + erl_drv_port_control(proto->u.sigchld.port_id, 'S', + (char*)proto, sizeof(*proto)); + } + +} + +static void forker_ready_output(ErlDrvData e, ErlDrvEvent fd) +{ + ErlDrvPort port_num = (ErlDrvPort)e; + +#ifndef FORKER_PROTO_START_ACK + while (driver_sizeq(port_num) > 0) { +#endif + int vlen; + SysIOVec *iov = driver_peekq(port_num, &vlen); + ErtsSysForkerProto *proto = (ErtsSysForkerProto *)iov[0].iov_base; + ASSERT(iov[0].iov_len >= (sizeof(*proto))); + if (sys_uds_write(forker_fd, (char*)proto, sizeof(*proto), + proto->u.start.fds, 3, 0) < 0) { + if (errno == ERRNO_BLOCK) + return; + erts_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno); + } +#ifndef FORKER_PROTO_START_ACK + close(proto->u.start.fds[0]); + close(proto->u.start.fds[1]); + if (proto->u.start.fds[1] != proto->u.start.fds[2]) + close(proto->u.start.fds[2]); + driver_deq(port_num, sizeof(*proto)); + } +#endif + + driver_select(port_num, forker_fd, ERL_DRV_WRITE, 0); +} + +static ErlDrvSSizeT forker_control(ErlDrvData e, unsigned int cmd, char *buf, + ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen) +{ + ErtsSysForkerProto *proto = (ErtsSysForkerProto *)buf; + ErlDrvPort port_num = (ErlDrvPort)e; + int res; + + driver_enq(port_num, buf, len); + if (driver_sizeq(port_num) > sizeof(*proto)) { + return 0; + } + + if ((res = sys_uds_write(forker_fd, (char*)proto, sizeof(*proto), + proto->u.start.fds, 3, 0)) < 0) { + if (errno == ERRNO_BLOCK) { + driver_select(port_num, forker_fd, ERL_DRV_WRITE|ERL_DRV_USE, 1); + return 0; + } + erts_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno); + } + +#ifndef FORKER_PROTO_START_ACK + ASSERT(res == sizeof(*proto)); + close(proto->u.start.fds[0]); + close(proto->u.start.fds[1]); + if (proto->u.start.fds[1] != proto->u.start.fds[2]) + close(proto->u.start.fds[2]); + driver_deq(port_num, sizeof(*proto)); +#endif + + return 0; +} diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c index 8fe7e599e5..6435da086f 100644 --- a/erts/emulator/sys/unix/sys_float.c +++ b/erts/emulator/sys/unix/sys_float.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -53,7 +53,7 @@ static void erts_init_fp_exception(void) void erts_thread_init_fp_exception(void) { unsigned long *fpe = erts_alloc(ERTS_ALC_T_FP_EXCEPTION, sizeof(*fpe)); - *fpe = 0L; + *fpe = 0; erts_tsd_set(fpe_key, fpe); } @@ -102,6 +102,17 @@ void erts_fp_check_init_error(volatile unsigned long *fpexnp) #define __DARWIN__ 1 #endif +/* + * Define two processor and possibly OS-specific primitives: + * + * static void unmask_fpe(void); + * -- unmask invalid, overflow, and divide-by-zero exceptions + * + * static int mask_fpe(void); + * -- mask invalid, overflow, and divide-by-zero exceptions + * -- return non-zero if the previous state was unmasked + */ + #if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__) static void unmask_x87(void) @@ -113,7 +124,6 @@ static void unmask_x87(void) __asm__ __volatile__("fldcw %0" : : "m"(cw)); } -/* mask x87 FPE, return true if the previous state was unmasked */ static int mask_x87(void) { unsigned short cw; @@ -136,7 +146,6 @@ static void unmask_sse2(void) __asm__ __volatile__("ldmxcsr %0" : : "m"(mxcsr)); } -/* mask SSE2 FPE, return true if the previous state was unmasked */ static int mask_sse2(void) { unsigned int mxcsr; @@ -257,21 +266,19 @@ static int cpu_has_sse2(void) } #endif /* !__x86_64__ */ -static void unmask_fpe(void) +static void unmask_fpe_internal(void) { - __asm__ __volatile__("fnclex"); unmask_x87(); if (cpu_has_sse2()) unmask_sse2(); } -static void unmask_fpe_conditional(int unmasked) +static void unmask_fpe(void) { - if (unmasked) - unmask_fpe(); + __asm__ __volatile__("fnclex"); + unmask_fpe_internal(); } -/* mask x86 FPE, return true if the previous state was unmasked */ static int mask_fpe(void) { int unmasked; @@ -285,9 +292,7 @@ static int mask_fpe(void) void erts_restore_fpu(void) { __asm__ __volatile__("fninit"); - unmask_x87(); - if (cpu_has_sse2()) - unmask_sse2(); + unmask_fpe_internal(); } #elif defined(__sparc__) && defined(__linux__) @@ -310,13 +315,6 @@ static void unmask_fpe(void) __asm__ __volatile__(LDX " %0, %%fsr" : : "m"(fsr)); } -static void unmask_fpe_conditional(int unmasked) -{ - if (unmasked) - unmask_fpe(); -} - -/* mask SPARC FPE, return true if the previous state was unmasked */ static int mask_fpe(void) { unsigned long fsr; @@ -431,13 +429,6 @@ static void unmask_fpe(void) set_fpscr(0x80|0x40|0x10); /* VE, OE, ZE; not UE or XE */ } -static void unmask_fpe_conditional(int unmasked) -{ - if (unmasked) - unmask_fpe(); -} - -/* mask PowerPC FPE, return true if the previous state was unmasked */ static int mask_fpe(void) { int unmasked; @@ -447,20 +438,13 @@ static int mask_fpe(void) return unmasked; } -#else +#else /* !(x86 || (sparc && linux) || (powerpc && (linux || darwin))) */ static void unmask_fpe(void) { fpsetmask(FP_X_INV | FP_X_OFL | FP_X_DZ); } -static void unmask_fpe_conditional(int unmasked) -{ - if (unmasked) - unmask_fpe(); -} - -/* mask IEEE FPE, return true if previous state was unmasked */ static int mask_fpe(void) { const fp_except unmasked_mask = FP_X_INV | FP_X_OFL | FP_X_DZ; @@ -472,6 +456,16 @@ static int mask_fpe(void) #endif +/* + * Define a processor and OS-specific SIGFPE handler. + * + * The effect of receiving a SIGFPE should be: + * 1. Update the processor context: + * a) on x86: mask FP exceptions, do not skip faulting instruction + * b) on SPARC and PowerPC: unmask FP exceptions, skip faulting instruction + * 2. call set_current_fp_exception with the PC of the faulting instruction + */ + #if (defined(__linux__) && (defined(__i386__) || defined(__x86_64__) || defined(__sparc__) || defined(__powerpc__))) || (defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__) || defined(__ppc__))) || (defined(__FreeBSD__) && (defined(__x86_64__) || defined(__i386__))) || ((defined(__NetBSD__) || defined(__OpenBSD__)) && defined(__x86_64__)) || (defined(__sun__) && defined(__x86_64__)) #if defined(__linux__) && defined(__i386__) @@ -499,18 +493,8 @@ static int mask_fpe(void) #define mc_pc(mc) ((mc)->gregs[REG_RIP]) #elif defined(__linux__) && defined(__i386__) #define mc_pc(mc) ((mc)->gregs[REG_EIP]) -#elif defined(__DARWIN__) && defined(__i386__) -#ifdef DARWIN_MODERN_MCONTEXT -#define mc_pc(mc) ((mc)->__ss.__eip) -#else -#define mc_pc(mc) ((mc)->ss.eip) -#endif -#elif defined(__DARWIN__) && defined(__x86_64__) -#ifdef DARWIN_MODERN_MCONTEXT -#define mc_pc(mc) ((mc)->__ss.__rip) -#else -#define mc_pc(mc) ((mc)->ss.rip) -#endif +#elif defined(__DARWIN__) +# error "Floating-point exceptions not supported on MacOS X" #elif defined(__FreeBSD__) && defined(__x86_64__) #define mc_pc(mc) ((mc)->mc_rip) #elif defined(__FreeBSD__) && defined(__i386__) @@ -530,8 +514,7 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc) ucontext_t *uc = puc; unsigned long pc; -#if defined(__linux__) -#if defined(__x86_64__) +#if defined(__linux__) && defined(__x86_64__) mcontext_t *mc = &uc->uc_mcontext; fpregset_t fpstate = mc->fpregs; pc = mc_pc(mc); @@ -543,26 +526,26 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc) set encoding makes that a poor solution here. */ fpstate->mxcsr = 0x1F80; fpstate->swd &= ~0xFF; -#elif defined(__i386__) +#elif defined(__linux__) && defined(__i386__) mcontext_t *mc = &uc->uc_mcontext; fpregset_t fpstate = mc->fpregs; pc = mc_pc(mc); if ((fpstate->status >> 16) == X86_FXSR_MAGIC) ((struct _fpstate*)fpstate)->mxcsr = 0x1F80; fpstate->sw &= ~0xFF; -#elif defined(__sparc__) && defined(__arch64__) +#elif defined(__linux__) && defined(__sparc__) && defined(__arch64__) /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */ struct sigcontext *sc = (struct sigcontext*)puc; pc = sc->sigc_regs.tpc; sc->sigc_regs.tpc = sc->sigc_regs.tnpc; sc->sigc_regs.tnpc += 4; -#elif defined(__sparc__) +#elif defined(__linux__) && defined(__sparc__) /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */ struct sigcontext *sc = (struct sigcontext*)puc; pc = sc->si_regs.pc; sc->si_regs.pc = sc->si_regs.npc; sc->si_regs.npc = (unsigned long)sc->si_regs.npc + 4; -#elif defined(__powerpc__) +#elif defined(__linux__) && defined(__powerpc__) #if defined(__powerpc64__) mcontext_t *mc = &uc->uc_mcontext; unsigned long *regs = &mc->gp_regs[0]; @@ -573,19 +556,8 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc) pc = regs[PT_NIP]; regs[PT_NIP] += 4; regs[PT_FPSCR] = 0x80|0x40|0x10; /* VE, OE, ZE; not UE or XE */ -#endif #elif defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__)) -#ifdef DARWIN_MODERN_MCONTEXT - mcontext_t mc = uc->uc_mcontext; - pc = mc_pc(mc); - mc->__fs.__fpu_mxcsr = 0x1F80; - *(unsigned short *)&mc->__fs.__fpu_fsw &= ~0xFF; -#else - mcontext_t mc = uc->uc_mcontext; - pc = mc_pc(mc); - mc->fs.fpu_mxcsr = 0x1F80; - *(unsigned short *)&mc->fs.fpu_fsw &= ~0xFF; -#endif /* DARWIN_MODERN_MCONTEXT */ +# error "Floating-point exceptions not supported on MacOS X" #elif defined(__DARWIN__) && defined(__ppc__) mcontext_t mc = uc->uc_mcontext; pc = mc->ss.srr0; @@ -641,7 +613,7 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc) #endif #if 0 { - char buf[64]; + char buf[128]; snprintf(buf, sizeof buf, "%s: FPE at %p\r\n", __FUNCTION__, (void*)pc); write(2, buf, strlen(buf)); } @@ -726,7 +698,8 @@ int erts_sys_block_fpe(void) void erts_sys_unblock_fpe(int unmasked) { - unmask_fpe_conditional(unmasked); + if (unmasked) + unmask_fpe(); } #endif @@ -838,11 +811,6 @@ sys_chars_to_double(char* buf, double* fp) int matherr(struct exception *exc) { -#if !defined(NO_FPE_SIGNALS) - volatile unsigned long *fpexnp = erts_get_current_fp_exception(); - if (fpexnp != NULL) - *fpexnp = (unsigned long)__builtin_return_address(0); -#endif return 1; } diff --git a/erts/emulator/sys/unix/sys_time.c b/erts/emulator/sys/unix/sys_time.c index 95b3daa4ed..60f8decd96 100644 --- a/erts/emulator/sys/unix/sys_time.c +++ b/erts/emulator/sys/unix/sys_time.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -65,6 +65,8 @@ # include <fcntl.h> #endif +static void init_perf_counter(void); + /******************* Routines for time measurement *********************/ #undef ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__ @@ -404,6 +406,8 @@ sys_init_time(ErtsSysInitTimeResult *init_resp) # error Missing erts_os_system_time() implementation #endif + init_perf_counter(); + } void @@ -908,10 +912,120 @@ erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) #endif +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Performance counter functions * +\* */ + + +/* What resolution to spin to in micro seconds */ +#define RESOLUTION 100 +/* How many iterations to spin */ +#define ITERATIONS 1 +/* How many significant figures to round to */ +#define SIGFIGS 3 + +static ErtsSysPerfCounter calculate_perf_counter_unit(void) { + int i; + ErtsSysPerfCounter pre, post; + double value = 0; + double round_factor; +#if defined(HAVE_GETHRTIME) && defined(GETHRTIME_WITH_CLOCK_GETTIME) + struct timespec basetime,comparetime; +#define __GETTIME(arg) clock_gettime(CLOCK_MONOTONIC,arg) +#define __GETUSEC(arg) (arg.tv_nsec / 1000) +#else + SysTimeval basetime,comparetime; +#define __GETTIME(arg) sys_gettimeofday(arg) +#define __GETUSEC(arg) arg.tv_usec +#endif + + for (i = 0; i < ITERATIONS; i++) { + /* Make sure usec just flipped over at current resolution */ + __GETTIME(&basetime); + do { + __GETTIME(&comparetime); + } while ((__GETUSEC(basetime) / RESOLUTION) == (__GETUSEC(comparetime) / RESOLUTION)); + + pre = erts_sys_perf_counter(); + + __GETTIME(&basetime); + do { + __GETTIME(&comparetime); + } while ((__GETUSEC(basetime) / RESOLUTION) == (__GETUSEC(comparetime) / RESOLUTION)); + + post = erts_sys_perf_counter(); + + value += post - pre; + } + /* After this value is ticks per us */ + value /= (RESOLUTION*ITERATIONS); + + /* We round to 3 significant figures */ + round_factor = pow(10.0, SIGFIGS - ceil(log10(value))); + value = ((ErtsSysPerfCounter)(value * round_factor + 0.5)) / round_factor; + + /* convert to ticks per second */ + return 1000000 * value; +} + +static int have_rdtscp(void) +{ +#if defined(ETHR_X86_RUNTIME_CONF__) + /* On early x86 cpu's the tsc varies with the current speed of the cpu, + which means that the time per tick vary depending on the current + load of the cpu. We do not want this as it would give very scewed + numbers when the cpu is mostly idle. + The linux kernel seems to think that checking for constant and + reliable is enough to trust the counter so we do the same. + + If this test is not good enough, I don't know what we'll do. + Maybe fallback on erts_sys_hrtime always, but that would be a shame as + rdtsc is about 3 times faster than hrtime... */ + return ETHR_X86_RUNTIME_CONF_HAVE_CONSTANT_TSC__ && + ETHR_X86_RUNTIME_CONF_HAVE_TSC_RELIABLE__; +#else + return 0; +#endif +} + +static ErtsSysPerfCounter rdtsc(void) +{ + /* It may have been a good idea to put the cpuid instruction before + the rdtsc, but I decided against it because it is not really + needed for msacc, and it slows it down by quite a bit (5-7 times slower). + As a result though, this timestamp becomes much less + accurate as it might be re-ordered to be executed way before or after this + function is called. + */ + ErtsSysPerfCounter ts; +#if defined(__x86_64__) + __asm__ __volatile__ ("rdtsc\n\t" + "shl $32, %%rdx\n\t" + "or %%rdx, %0" : "=a" (ts) : : "rdx"); +#elif defined(__i386__) + __asm__ __volatile__ ("rdtsc\n\t" + : "=A" (ts) ); +#endif + return ts; +} + +static void init_perf_counter(void) +{ + if (have_rdtscp()) { + erts_sys_time_data__.r.o.perf_counter = rdtsc; + erts_sys_time_data__.r.o.perf_counter_unit = calculate_perf_counter_unit(); + } else { + erts_sys_time_data__.r.o.perf_counter = erts_sys_hrtime; + erts_sys_time_data__.r.o.perf_counter_unit = ERTS_HRTIME_UNIT; + } +} + /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ #ifdef HAVE_GETHRVTIME_PROCFS_IOCTL +/* The code below only has effect on solaris < 10, + needed in order for gehhrvtime to work properly */ int sys_start_hrvtime(void) { long msacct = PR_MSACCT; diff --git a/erts/emulator/sys/unix/sys_uds.c b/erts/emulator/sys/unix/sys_uds.c new file mode 100644 index 0000000000..dd0a3b03ff --- /dev/null +++ b/erts/emulator/sys/unix/sys_uds.c @@ -0,0 +1,155 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2016. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#include "sys_uds.h" + +int +sys_uds_readv(int fd, struct iovec *iov, size_t iov_len, + int *fds, int fd_count, int flags) { + struct msghdr msg; + struct cmsghdr *cmsg = NULL; + char ancillary_buff[256] = {0}; + int res, i = 0; + + /* setup a place to fill in message contents */ + memset(&msg, 0, sizeof(struct msghdr)); + msg.msg_iov = iov; + msg.msg_iovlen = iov_len; + + /* provide space for the ancillary data */ + msg.msg_control = ancillary_buff; + msg.msg_controllen = sizeof(ancillary_buff); + + if((res = recvmsg(fd, &msg, flags)) < 0) { +#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) + /* When some OS X versions run out of fd's + they give EMSGSIZE instead of EMFILE. + We remap this as we want the correct + error to appear for the user */ + if (errno == EMSGSIZE) + errno = EMFILE; +#endif + return res; + } + + if((msg.msg_flags & MSG_CTRUNC) == MSG_CTRUNC) + { + /* We assume that we have given enough space for any header + that are sent to us. So the only remaining reason to get + this flag set is if the caller has run out of file descriptors. + */ + errno = EMFILE; + return -1; + } + + for (cmsg = CMSG_FIRSTHDR(&msg); cmsg; cmsg = CMSG_NXTHDR(&msg, cmsg) ) { + if ((cmsg->cmsg_level == SOL_SOCKET) && + (cmsg->cmsg_type == SCM_RIGHTS)) { + int *cmsg_data = (int *)CMSG_DATA(cmsg); + while ((char*)cmsg_data < (char*)cmsg + cmsg->cmsg_len) { + if (i < fd_count) { + fds[i++] = *cmsg_data++; + } else { + /* for some strange reason, we have received more FD's + than we wanted... close them if we are not running + debug. */ + if(i >= fd_count) abort(); + close(*cmsg_data++); + } + } + } + } + + return res; +} + +int +sys_uds_read(int fd, char *buff, size_t len, + int *fds, int fd_count, int flags) { + struct iovec iov; + iov.iov_base = buff; + iov.iov_len = len; + return sys_uds_readv(fd, &iov, 1, fds, fd_count, flags); +} + + +int +sys_uds_writev(int fd, struct iovec *iov, size_t iov_len, + int *fds, int fd_count, int flags) { + + struct msghdr msg; + struct cmsghdr *cmsg = NULL; + int res, i; + + /* initialize socket message */ + memset(&msg, 0, sizeof(struct msghdr)); + + /* We flatten the iov if it is too long */ + if (iov_len > MAXIOV) { + int size = 0; + char *buff; + for (i = 0; i < iov_len; i++) + size += iov[i].iov_len; + buff = malloc(size); + + for (i = 0; i < iov_len; i++) { + memcpy(buff, iov[i].iov_base, iov[i].iov_len); + buff += iov[i].iov_len; + } + + iov[0].iov_base = buff - size; + iov[0].iov_len = size; + msg.msg_iov = iov; + msg.msg_iovlen = 1; + } else { + msg.msg_iov = iov; + msg.msg_iovlen = iov_len; + } + + /* initialize the ancillary data */ + msg.msg_control = calloc(1, CMSG_SPACE(sizeof(int) * fd_count)); + msg.msg_controllen = CMSG_SPACE(sizeof(int) * fd_count); + + /* copy the fd array into the ancillary data */ + cmsg = CMSG_FIRSTHDR(&msg); + if(!cmsg) abort(); + cmsg->cmsg_level = SOL_SOCKET; + cmsg->cmsg_type = SCM_RIGHTS; + cmsg->cmsg_len = CMSG_LEN(sizeof(int) * fd_count); + memcpy(CMSG_DATA(cmsg), fds, sizeof(int) * fd_count); + + res = sendmsg(fd, &msg, flags); + + if (iov_len > MAXIOV) + free(iov[0].iov_base); + + free(msg.msg_control); + + return res; +} + +int +sys_uds_write(int fd, char *buff, size_t len, + int *fds, int fd_count, int flags) { + struct iovec iov; + iov.iov_base = buff; + iov.iov_len = len; + return sys_uds_writev(fd, &iov, 1, fds, fd_count, flags); +} diff --git a/erts/emulator/sys/unix/sys_uds.h b/erts/emulator/sys/unix/sys_uds.h new file mode 100644 index 0000000000..a598102d5c --- /dev/null +++ b/erts/emulator/sys/unix/sys_uds.h @@ -0,0 +1,57 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2016. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifndef _ERL_UNIX_UDS_H +#define _ERL_UNIX_UDS_H + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#if defined(__sun__) && !defined(_XOPEN_SOURCE) +#define _XOPEN_SOURCE 500 +#endif + +#include <limits.h> + +#include <sys/types.h> +#include <sys/socket.h> +#include <sys/uio.h> + +#if defined IOV_MAX +#define MAXIOV IOV_MAX +#elif defined UIO_MAXIOV +#define MAXIOV UIO_MAXIOV +#else +#define MAXIOV 16 +#endif + +#include "sys.h" + +int sys_uds_readv(int fd, struct iovec *iov, size_t iov_len, + int *fds, int fd_count, int flags); +int sys_uds_read(int fd, char *buff, size_t len, + int *fds, int fd_count, int flags); +int sys_uds_writev(int fd, struct iovec *iov, size_t iov_len, + int *fds, int fd_count, int flags); +int sys_uds_write(int fd, char *buff, size_t len, + int *fds, int fd_count, int flags); + +#endif /* #ifndef _ERL_UNIX_UDS_H */ diff --git a/erts/emulator/sys/win32/dosmap.c b/erts/emulator/sys/win32/dosmap.c index a98065c666..95fbba384b 100644 --- a/erts/emulator/sys/win32/dosmap.c +++ b/erts/emulator/sys/win32/dosmap.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/sys/win32/driver_int.h b/erts/emulator/sys/win32/driver_int.h index b931da52f5..50097d3fd2 100644 --- a/erts/emulator/sys/win32/driver_int.h +++ b/erts/emulator/sys/win32/driver_int.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/sys/win32/erl_main.c b/erts/emulator/sys/win32/erl_main.c index 21d9a58da6..9eee300f48 100644 --- a/erts/emulator/sys/win32/erl_main.c +++ b/erts/emulator/sys/win32/erl_main.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * Copyright Ericsson AB 2000-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c index 547d4b1d21..94f3840b5f 100644 --- a/erts/emulator/sys/win32/erl_poll.c +++ b/erts/emulator/sys/win32/erl_poll.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2007-2011. All Rights Reserved. + * Copyright Ericsson AB 2007-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -27,6 +27,7 @@ #include "erl_alloc.h" #include "erl_poll.h" #include "erl_time.h" +#include "erl_msacc.h" /* * Some debug macros @@ -1188,16 +1189,19 @@ int erts_poll_wait(ErtsPollSet ps, if (timeout > 0 && !erts_atomic32_read_nob(&break_waiter_state)) { HANDLE harr[2] = {ps->event_io_ready, break_happened_event}; int num_h = 2; + ERTS_MSACC_PUSH_STATE_M(); HARDDEBUGF(("Start waiting %d [%d]",num_h, (int) timeout)); ERTS_POLLSET_UNLOCK(ps); #ifdef ERTS_SMP erts_thr_progress_prepare_wait(NULL); #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP); WaitForMultipleObjects(num_h, harr, FALSE, timeout); #ifdef ERTS_SMP erts_thr_progress_finalize_wait(NULL); #endif + ERTS_MSACC_POP_STATE_M(); ERTS_POLLSET_LOCK(ps); HARDDEBUGF(("Stop waiting %d [%d]",num_h, (int) timeout)); woke_up(ps); diff --git a/erts/emulator/sys/win32/erl_win32_sys_ddll.c b/erts/emulator/sys/win32/erl_win32_sys_ddll.c index 7c24a77e31..274133a346 100644 --- a/erts/emulator/sys/win32/erl_win32_sys_ddll.c +++ b/erts/emulator/sys/win32/erl_win32_sys_ddll.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2013. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/sys/win32/erl_win_dyn_driver.h b/erts/emulator/sys/win32/erl_win_dyn_driver.h index 9c699fdba0..6f28d513c2 100644 --- a/erts/emulator/sys/win32/erl_win_dyn_driver.h +++ b/erts/emulator/sys/win32/erl_win_dyn_driver.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2013. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/sys/win32/erl_win_sys.h b/erts/emulator/sys/win32/erl_win_sys.h index 7e8dd8a4ca..7bdfac168b 100644 --- a/erts/emulator/sys/win32/erl_win_sys.h +++ b/erts/emulator/sys/win32/erl_win_sys.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2014. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -183,6 +183,7 @@ typedef LONGLONG ErtsSysHrTime; #endif typedef ErtsMonotonicTime ErtsSystemTime; +typedef ErtsMonotonicTime ErtsSysPerfCounter; ErtsSystemTime erts_os_system_time(void); @@ -213,6 +214,7 @@ ERTS_GLB_INLINE ErtsMonotonicTime erts_os_monotonic_time(void); ERTS_GLB_INLINE void erts_os_times(ErtsMonotonicTime *, ErtsSystemTime *); ERTS_GLB_INLINE ErtsSysHrTime erts_sys_hrtime(void); +ERTS_GLB_INLINE ErtsSysPerfCounter erts_sys_perf_counter(void); #if ERTS_GLB_INLINE_INCL_FUNC_DEF @@ -234,6 +236,18 @@ erts_sys_hrtime(void) return (*erts_sys_time_data__.r.o.sys_hrtime)(); } +ERTS_GLB_INLINE ErtsSysPerfCounter +erts_sys_perf_counter(void) +{ + return (*erts_sys_time_data__.r.o.sys_hrtime)(); +} + +ERTS_GLB_INLINE ErtsSysPerfCounter +erts_sys_perf_counter_unit(void) +{ + return 1000 * 1000 * 1000; +} + #endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ extern void sys_gettimeofday(SysTimeval *tv); diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index 37d3e16256..cf821b05cb 100644 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2014. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -1334,10 +1334,8 @@ spawn_start(ErlDrvPort port_num, char* utf8_name, SysDriverOpts* opts) retval = set_driver_data(dp, hFromChild, hToChild, opts->read_write, opts->exit_status); if (retval != ERL_DRV_ERROR_GENERAL && retval != ERL_DRV_ERROR_ERRNO) { - Port *prt = erts_drvport2port(port_num); - /* We assume that this cannot generate a negative number */ - ASSERT(prt != ERTS_INVALID_ERL_DRV_PORT); - prt->os_pid = (SWord) pid; + /* We assume that this cannot generate a negative number */ + erl_drv_set_os_pid(port_num, pid); } } @@ -1528,8 +1526,8 @@ create_child_process * Parse out the program name from the command line (it can be quoted and * contain spaces). */ - newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, 2048*sizeof(wchar_t)); cmdlength = parse_command(origcmd); + newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, (MAX_PATH+wcslen(origcmd)-cmdlength)*sizeof(wchar_t)); thecommand = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, (cmdlength+1)*sizeof(wchar_t)); wcsncpy(thecommand, origcmd, cmdlength); thecommand[cmdlength] = L'\0'; @@ -3081,6 +3079,8 @@ erl_bin_write(buf, sz, max) } } +#endif /* DEBUG */ + void erl_assert_error(const char* expr, const char* func, const char* file, int line) { @@ -3096,7 +3096,6 @@ erl_assert_error(const char* expr, const char* func, const char* file, int line) DebugBreak(); } -#endif /* DEBUG */ static void check_supported_os_version(void) @@ -3273,6 +3272,12 @@ void erl_sys_init(void) } void +erl_sys_late_init(void) +{ + /* do nothing */ +} + +void erts_sys_schedule_interrupt(int set) { erts_check_io_interrupt(set); diff --git a/erts/emulator/sys/win32/sys_env.c b/erts/emulator/sys/win32/sys_env.c index 67b6e55377..21ef71ad9a 100644 --- a/erts/emulator/sys/win32/sys_env.c +++ b/erts/emulator/sys/win32/sys_env.c @@ -1,7 +1,7 @@ /*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2016. All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
diff --git a/erts/emulator/sys/win32/sys_float.c b/erts/emulator/sys/win32/sys_float.c index 86e822da5b..2b2d6ab7d3 100644 --- a/erts/emulator/sys/win32/sys_float.c +++ b/erts/emulator/sys/win32/sys_float.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2013. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -139,8 +139,7 @@ sys_double_to_chars_ext(double fp, char *buffer, size_t buffer_size, size_t deci int matherr(struct _exception *exc) { - erl_fp_exception = 1; - DEBUGF(("FP exception (matherr) (0x%x) (%d)\n", exc->type, erl_fp_exception)); + DEBUGF(("FP exception (matherr) (0x%x)\n", exc->type)); return 1; } diff --git a/erts/emulator/sys/win32/sys_interrupt.c b/erts/emulator/sys/win32/sys_interrupt.c index a89211fa8e..df838960eb 100644 --- a/erts/emulator/sys/win32/sys_interrupt.c +++ b/erts/emulator/sys/win32/sys_interrupt.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2012. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/sys/win32/sys_time.c b/erts/emulator/sys/win32/sys_time.c index 3cf7f7cf07..e8c67b3928 100644 --- a/erts/emulator/sys/win32/sys_time.c +++ b/erts/emulator/sys/win32/sys_time.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2013. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -397,6 +397,7 @@ sys_init_time(ErtsSysInitTimeResult *init_resp) erts_sys_time_data__.r.o.os_monotonic_time = os_mtime_func; erts_sys_time_data__.r.o.os_times = os_times_func; + erts_sys_time_data__.r.o.sys_hrtime = sys_hrtime_func; init_resp->os_monotonic_time_unit = time_unit; init_resp->have_os_monotonic_time = 1; init_resp->have_corrected_os_monotonic_time = 0; diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 77614d455c..de395dfb97 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2012. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -70,15 +70,18 @@ MODULES= \ hash_SUITE \ hibernate_SUITE \ list_bif_SUITE \ + lttng_SUITE \ map_SUITE \ match_spec_SUITE \ module_info_SUITE \ monitor_SUITE \ + multi_load_SUITE \ nested_SUITE \ nif_SUITE \ node_container_SUITE \ nofrag_SUITE \ num_bif_SUITE \ + message_queue_data_SUITE \ op_SUITE \ port_SUITE \ port_bif_SUITE \ @@ -107,8 +110,11 @@ MODULES= \ trace_meta_SUITE \ trace_call_count_SUITE \ trace_call_time_SUITE \ + tracer_SUITE \ + tracer_test \ scheduler_SUITE \ old_scheduler_SUITE \ + port_trace_SUITE \ unique_SUITE \ z_SUITE \ old_mod \ @@ -157,7 +163,7 @@ RELSYSDIR = $(RELEASE_PATH)/emulator_test # FLAGS # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += # ---------------------------------------------------- # Targets diff --git a/erts/emulator/test/a_SUITE.erl b/erts/emulator/test/a_SUITE.erl index 16f060fe34..880c5a5821 100644 --- a/erts/emulator/test/a_SUITE.erl +++ b/erts/emulator/test/a_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -27,68 +27,43 @@ %%%------------------------------------------------------------------- -module(a_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, long_timers/1, pollset_size/1]). +-export([all/0, suite/0, + long_timers/1, pollset_size/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}]. all() -> [long_timers, pollset_size]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -long_timers(doc) -> - []; -long_timers(suite) -> - []; long_timers(Config) when is_list(Config) -> - Dir = ?config(data_dir, Config), - ?line long_timers_test:start(Dir), - ?line {comment, - "Testcase started! This test will run in parallel with the " - "erts testsuite and ends in the z_SUITE:long_timers testcase."}. + Dir = proplists:get_value(data_dir, Config), + long_timers_test:start(Dir), + {comment, "Testcase started! This test will run in parallel with the " + "erts testsuite and ends in the z_SUITE:long_timers testcase."}. -pollset_size(doc) -> - []; -pollset_size(suite) -> - []; pollset_size(Config) when is_list(Config) -> %% Ensure inet_gethost_native port program started, in order to %% allow other suites to use it... inet_gethost_native:gethostbyname("localhost"), - ?line Parent = self(), - ?line Go = make_ref(), - ?line spawn(fun () -> - Name = pollset_size_testcase_initial_state_holder, - true = register(Name, self()), - ChkIo = get_check_io_info(), - io:format("Initial: ~p~n", [ChkIo]), - Parent ! Go, - receive - {get_initial_check_io_result, Pid} -> - Pid ! {initial_check_io_result, ChkIo} - end - end), - ?line receive Go -> ok end, - ?line {comment, - "Testcase started! This test will run in parallel with the " - "erts testsuite and ends in the z_SUITE:pollset_size testcase."}. + Parent = self(), + Go = make_ref(), + spawn(fun () -> + Name = pollset_size_testcase_initial_state_holder, + true = register(Name, self()), + ChkIo = get_check_io_info(), + io:format("Initial: ~p~n", [ChkIo]), + Parent ! Go, + receive + {get_initial_check_io_result, Pid} -> + Pid ! {initial_check_io_result, ChkIo} + end + end), + receive Go -> ok end, + {comment, "Testcase started! This test will run in parallel with the " + "erts testsuite and ends in the z_SUITE:pollset_size testcase."}. %% %% Internal functions... @@ -106,5 +81,3 @@ display_check_io(ChkIo) -> get_check_io_info() -> z_SUITE:get_check_io_info(). - - diff --git a/erts/emulator/test/after_SUITE.erl b/erts/emulator/test/after_SUITE.erl index 5017a83185..4f20ad3656 100644 --- a/erts/emulator/test/after_SUITE.erl +++ b/erts/emulator/test/after_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,92 +22,66 @@ %% Tests receive after. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, 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, receive_after_blast/1]). --export([init_per_testcase/2, end_per_testcase/2]). - %% Internal exports. -export([timeout_g/0]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. all() -> [t_after, receive_after, receive_after_big, receive_after_errors, receive_var_zero, receive_zero, multi_timeout, receive_after_32bit, receive_after_blast]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(3)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - %% Tests for an old round-off error in 'receive after'." t_after(Config) when is_list(Config) -> - ?line spawn(fun frequent_process/0), - ?line Period = test_server:minutes(1), - ?line Before = erlang:monotonic_time(), + spawn(fun frequent_process/0), + Period = test_server:minutes(1), + Before = erlang:monotonic_time(), receive - after Period -> - ?line After = erlang:monotonic_time(), - ?line report(Period, Before, After) - end. + after Period -> + After = erlang:monotonic_time(), + report(Period, Before, After) + end. report(Period, Before, After) -> 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)} + Percent when Percent > 100.10 -> + ct:fail({too_inaccurate, Percent}); + Percent when Percent < 100.0 -> + ct:fail({too_early, Percent}); + Percent -> + Comment = io_lib:format("Elapsed/expected: ~.2f %", [Percent]), + {comment, lists:flatten(Comment)} end. frequent_process() -> receive - after 100 -> - ?line frequent_process() - end. + after 100 -> + frequent_process() + end. -receive_after(doc) -> - "Test that 'receive after' works (doesn't hang). " - "The test takes 10 seconds to complete."; +%% Test that 'receive after' works (doesn't hang). +%% The test takes 10 seconds to complete. receive_after(Config) when is_list(Config) -> - ?line receive_after1(5000). + receive_after1(5000). receive_after1(1) -> - ?line io:format("Testing: receive after ~p~n", [1]), - ?line receive after 1 -> ok end; + io:format("Testing: receive after ~p~n", [1]), + receive after 1 -> ok end; receive_after1(N) -> - ?line io:format("Testing: receive after ~p~n", [N]), - ?line receive after N -> receive_after1(N div 2) end. + io:format("Testing: receive after ~p~n", [N]), + receive after N -> receive_after1(N div 2) end. receive_after_big(Config) when is_list(Config) -> %% Test that 'receive after' with a 32 bit number works. @@ -119,14 +93,14 @@ receive_after_big1(Timeout) -> erlang:yield(), spawn(fun() -> Self ! here_is_a_message end), ok = receive - here_is_a_message -> - ok - after Timeout -> - %% We test that the timeout can be set, - %% not that an timeout occurs after the appropriate delay - %% (48 days, 56 minutes, 48 seconds)! - timeout - end. + here_is_a_message -> + ok + after Timeout -> + %% We test that the timeout can be set, + %% not that an timeout occurs after the appropriate delay + %% (48 days, 56 minutes, 48 seconds)! + timeout + end. receive_after_big2() -> Self = self(), @@ -147,38 +121,38 @@ receive_after_big2() -> %% Test error cases for 'receive after'. receive_after_errors(Config) when is_list(Config) -> - ?line ?TryAfter(-1), - ?line ?TryAfter(0.0), - ?line ?TryAfter(3.14), - ?line ?TryAfter(16#100000000), - ?line ?TryAfter(392347129847294724972398472984729847129874), - ?line ?TryAfter(16#3fffffffffffffff), - ?line ?TryAfter(16#ffffffffffffffff), - ?line ?TryAfter(-16#100000000), - ?line ?TryAfter(-3891278094774921784123987129848), - ?line ?TryAfter(xxx), + ?TryAfter(-1), + ?TryAfter(0.0), + ?TryAfter(3.14), + ?TryAfter(16#100000000), + ?TryAfter(392347129847294724972398472984729847129874), + ?TryAfter(16#3fffffffffffffff), + ?TryAfter(16#ffffffffffffffff), + ?TryAfter(-16#100000000), + ?TryAfter(-3891278094774921784123987129848), + ?TryAfter(xxx), ok. try_after(Timeout) -> {'EXIT',{timeout_value,_}} = (catch receive after Timeout -> ok end). -receive_var_zero(doc) -> "Test 'after Z', when Z == 0."; +%% Test 'after Z', when Z == 0. receive_var_zero(Config) when is_list(Config) -> self() ! x, self() ! y, Z = zero(), timeout = receive - z -> ok - after Z -> timeout - end, + z -> ok + after Z -> timeout + end, timeout = receive - after Z -> timeout - end, + after Z -> timeout + end, self() ! w, receive x -> ok; Other -> - ?line ?t:fail({bad_message,Other}) + ct:fail({bad_message,Other}) end. zero() -> 0. @@ -188,44 +162,43 @@ receive_zero(Config) when is_list(Config) -> self() ! x, self() ! y, timeout = receive - z -> ok - after 0 -> - timeout - end, + z -> ok + after 0 -> + timeout + end, self() ! w, timeout = receive after 0 -> timeout end, receive - x -> ok; - Other -> - ?line ?t:fail({bad_message,Other}) + x -> ok; + Other -> + ct:fail({bad_message,Other}) end. -multi_timeout(doc) -> - "Test for catching invalid assertion in erl_message.c (in queue_message)." - "This failed (dumped core) with debug-compiled emulator."; +%% Test for catching invalid assertion in erl_message.c (in queue_message) +%% This failed (dumped core) with debug-compiled emulator. multi_timeout(Config) when is_list(Config) -> - ?line P = spawn(?MODULE, timeout_g, []), - ?line P ! a, - ?line P ! b, - ?line receive - after 1000 -> ok - end, - ?line P ! c, - ?line receive - after 1000 -> ok - end, - ?line P ! d, + P = spawn(?MODULE, timeout_g, []), + P ! a, + P ! b, + receive + after 1000 -> ok + end, + P ! c, + receive + after 1000 -> ok + end, + P ! d, ok. timeout_g() -> - ?line receive - a -> ok + receive + a -> ok + end, + receive + after 100000 -> ok end, - ?line receive - after 100000 -> ok - end, ok. %% OTP-7493: Timeout for 32 bit numbers (such as 16#ffffFFFF) could @@ -264,8 +237,8 @@ receive_after_blast(Config) when is_list(Config) -> 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). + 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 aa6a1fbcdc..5fb560d1ec 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2013. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,8 +19,7 @@ -module(alloc_SUITE). -author('[email protected]'). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]). -export([basic/1, coalesce/1, @@ -34,42 +33,20 @@ cpool/1, migration/1]). --export([init_per_testcase/2, end_per_testcase/2]). +-include_lib("common_test/include/ct.hrl"). --include_lib("test_server/include/test_server.hrl"). - --define(DEFAULT_TIMETRAP_SECS, 240). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. all() -> [basic, coalesce, threads, realloc_copy, bucket_index, bucket_mask, rbtree, mseg_clear_cache, erts_mmap, cpool, migration]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - - init_per_testcase(Case, Config) when is_list(Config) -> - Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)), - [{watchdog, Dog}, {testcase, Case}, {debug,false} | Config]. + [{testcase, Case},{debug,false}|Config]. end_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -77,41 +54,15 @@ end_per_testcase(_Case, Config) when is_list(Config) -> %% Testcases %% %% %% -basic(suite) -> []; -basic(doc) -> []; -basic(Cfg) -> ?line drv_case(Cfg). - -coalesce(suite) -> []; -coalesce(doc) -> []; -coalesce(Cfg) -> ?line drv_case(Cfg). - -threads(suite) -> []; -threads(doc) -> []; -threads(Cfg) -> ?line drv_case(Cfg). - -realloc_copy(suite) -> []; -realloc_copy(doc) -> []; -realloc_copy(Cfg) -> ?line drv_case(Cfg). - -bucket_index(suite) -> []; -bucket_index(doc) -> []; -bucket_index(Cfg) -> ?line drv_case(Cfg). - -bucket_mask(suite) -> []; -bucket_mask(doc) -> []; -bucket_mask(Cfg) -> ?line drv_case(Cfg). - -rbtree(suite) -> []; -rbtree(doc) -> []; -rbtree(Cfg) -> ?line drv_case(Cfg). - -mseg_clear_cache(suite) -> []; -mseg_clear_cache(doc) -> []; -mseg_clear_cache(Cfg) -> ?line drv_case(Cfg). - -cpool(suite) -> []; -cpool(doc) -> []; -cpool(Cfg) -> ?line drv_case(Cfg). +basic(Cfg) -> drv_case(Cfg). +coalesce(Cfg) -> drv_case(Cfg). +threads(Cfg) -> drv_case(Cfg). +realloc_copy(Cfg) -> drv_case(Cfg). +bucket_index(Cfg) -> drv_case(Cfg). +bucket_mask(Cfg) -> drv_case(Cfg). +rbtree(Cfg) -> drv_case(Cfg). +mseg_clear_cache(Cfg) -> drv_case(Cfg). +cpool(Cfg) -> drv_case(Cfg). migration(Cfg) -> case erlang:system_info(smp_support) of @@ -122,15 +73,12 @@ migration(Cfg) -> end. erts_mmap(Config) when is_list(Config) -> - case {?t:os_type(), is_halfword_vm()} of - {{unix, _}, false} -> + case os:type() of + {unix, _} -> [erts_mmap_do(Config, SCO, SCRPM, SCRFSD) || SCO <-[true,false], SCRFSD <-[1234,0], SCRPM <- [true,false]]; - - {_,true} -> - {skipped, "No supercarrier support on halfword vm"}; {SkipOs,_} -> - ?line {skipped, + {skipped, lists:flatten(["Not run on " | io_lib:format("~p",[SkipOs])])} end. @@ -153,25 +101,26 @@ erts_mmap_do(Config, SCO, SCRPM, SCRFSD) -> {ok, Node} = start_node(Config, Opts), Self = self(), Ref = make_ref(), - F = fun () -> - SI = erlang:system_info({allocator,mseg_alloc}), - {erts_mmap,EM} = lists:keyfind(erts_mmap, 1, SI), - {supercarrier,SC} = lists:keyfind(supercarrier, 1, EM), - {sizes,Sizes} = lists:keyfind(sizes, 1, SC), - {free_segs,Segs} = lists:keyfind(free_segs,1,SC), - {total,Total} = lists:keyfind(total,1,Sizes), - Total = SCS*1024*1024, - - {reserved,Reserved} = lists:keyfind(reserved,1,Segs), - true = (Reserved >= SCRFSD), - - case {SCO,lists:keyfind(os,1,EM)} of - {true, false} -> ok; - {false, {os,_}} -> ok - end, - - Self ! {Ref, ok} - end, + F = fun() -> + SI = erlang:system_info({allocator,mseg_alloc}), + {erts_mmap,EM} = lists:keyfind(erts_mmap, 1, SI), + {supercarrier,SC} = lists:keyfind(supercarrier, 1, EM), + {sizes,Sizes} = lists:keyfind(sizes, 1, SC), + {free_segs,Segs} = lists:keyfind(free_segs,1,SC), + {total,Total} = lists:keyfind(total,1,Sizes), + io:format("Expecting total ~w, got ~w~n", [SCS*1024*1024,Total]), + Total = SCS*1024*1024, + + {reserved,Reserved} = lists:keyfind(reserved,1,Segs), + true = (Reserved >= SCRFSD), + + case {SCO,lists:keyfind(os,1,EM)} of + {true, false} -> ok; + {false, {os,_}} -> ok + end, + + Self ! {Ref, ok} + end, spawn_link(Node, F), Result = receive {Ref, Rslt} -> Rslt end, @@ -188,28 +137,28 @@ drv_case(Config) -> drv_case(Config, one_shot, ""). drv_case(Config, Mode, NodeOpts) when is_list(Config) -> - case ?t:os_type() of + case os:type() of {Family, _} when Family == unix; Family == win32 -> - ?line {ok, Node} = start_node(Config, NodeOpts), - ?line Self = self(), - ?line Ref = make_ref(), - ?line spawn_link(Node, + {ok, Node} = start_node(Config, NodeOpts), + Self = self(), + Ref = make_ref(), + spawn_link(Node, fun () -> Res = run_drv_case(Config, Mode), Self ! {Ref, Res} end), - ?line Result = receive {Ref, Rslt} -> Rslt end, - ?line stop_node(Node), - ?line Result; + Result = receive {Ref, Rslt} -> Rslt end, + stop_node(Node), + Result; SkipOs -> - ?line {skipped, + {skipped, lists:flatten(["Not run on " | io_lib:format("~p",[SkipOs])])} end. run_drv_case(Config, Mode) -> - DataDir = ?config(data_dir,Config), - CaseName = ?config(testcase,Config), + DataDir = proplists:get_value(data_dir,Config), + CaseName = proplists:get_value(testcase,Config), File = filename:join(DataDir, CaseName), {ok,CaseName,Bin} = compile:file(File, [binary,return_errors]), {module,CaseName} = erlang:load_module(CaseName,Bin), @@ -269,7 +218,6 @@ print_stats(migration) -> io:format("Number of blocks : ~p\n", [Btot]), io:format("Number of carriers: ~p\n", [Ctot]); - print_stats(_) -> ok. tuple_add(T1, T2) -> @@ -341,7 +289,7 @@ repeat_while_loop(Fun, TRef, I) -> flush_log() -> receive {print, Str} -> - ?t:format("~s", [Str]), + io:format("~s", [Str]), flush_log() after 0 -> ok @@ -351,23 +299,23 @@ handle_result(_State, Result0) -> flush_log(), case Result0 of {'EXIT', Error} -> - ?line ?t:fail(Error); + ct:fail(Error); {'EXIT', error, Error} -> - ?line ?t:fail(Error); + ct:fail(Error); {failed, Comment} -> - ?line ?t:fail(Comment); + ct:fail(Comment); {skipped, Comment} -> - ?line {skipped, Comment}; + {skipped, Comment}; {succeeded, ""} -> - ?line succeeded; + succeeded; {succeeded, Comment} -> - ?line {comment, Comment}; + {comment, Comment}; continue -> continue end. start_node(Config, Opts) when is_list(Config), is_list(Opts) -> - case ?config(debug,Config) of + case proplists:get_value(debug,Config) of true -> {ok, node()}; _ -> start_node_1(Config, Opts) end. @@ -376,23 +324,16 @@ start_node_1(Config, Opts) -> Pa = filename:dirname(code:which(?MODULE)), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" - ++ atom_to_list(?config(testcase, Config)) + ++ atom_to_list(proplists:get_value(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}]). + test_server:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). stop_node(Node) when Node =:= node() -> ok; stop_node(Node) -> - ?t:stop_node(Node). - -is_halfword_vm() -> - case {erlang:system_info({wordsize, internal}), - erlang:system_info({wordsize, external})} of - {4, 8} -> true; - {WS, WS} -> false - end. + test_server:stop_node(Node). free_memory() -> %% Free memory in MB. @@ -411,5 +352,6 @@ free_memory() -> TotFree div (1024*1024) catch error : undef -> - ?t:fail({"os_mon not built"}) + ct:fail({"os_mon not built"}) end. + diff --git a/erts/emulator/test/alloc_SUITE_data/cpool.c b/erts/emulator/test/alloc_SUITE_data/cpool.c index 73026cc758..0c41f4d747 100644 --- a/erts/emulator/test/alloc_SUITE_data/cpool.c +++ b/erts/emulator/test/alloc_SUITE_data/cpool.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2013. All Rights Reserved. + * Copyright Ericsson AB 2013-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/alloc_SUITE_data/migration.c b/erts/emulator/test/alloc_SUITE_data/migration.c index b006360043..b9a4de03b3 100644 --- a/erts/emulator/test/alloc_SUITE_data/migration.c +++ b/erts/emulator/test/alloc_SUITE_data/migration.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2014. All Rights Reserved. + * Copyright Ericsson AB 2014-2016. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in diff --git a/erts/emulator/test/alloc_SUITE_data/threads.c b/erts/emulator/test/alloc_SUITE_data/threads.c index 2f5f841e3d..44d982b6c7 100644 --- a/erts/emulator/test/alloc_SUITE_data/threads.c +++ b/erts/emulator/test/alloc_SUITE_data/threads.c @@ -96,16 +96,11 @@ static void fail(int t_no, char *frmt, ...) exit_thread(t_no, 0); } -static Allctr_t *alloc_not_ts = NULL; static Allctr_t *alloc_ts_1 = NULL; static Allctr_t *alloc_ts_2 = NULL; static void stop_allocators(void) { - if (alloc_not_ts) { - STOP_ALC(alloc_not_ts); - alloc_not_ts = NULL; - } if (alloc_ts_1) { STOP_ALC(alloc_ts_1); alloc_ts_1 = NULL; @@ -155,7 +150,6 @@ testcase_run(TestCaseState_t *tcs) if (!IS_THREADS_ENABLED) testcase_skipped(tcs, "Threads not enabled"); - alloc_not_ts = NULL; alloc_ts_1 = NULL; alloc_ts_2 = NULL; @@ -164,16 +158,12 @@ testcase_run(TestCaseState_t *tcs) sprintf(sbct_buf, "%d", SBC_THRESHOLD/1024); memcpy((void *) argv, argv_org, sizeof(argv_org)); - alloc_not_ts = START_ALC("threads_not_ts", 0, argv); - ASSERT(tcs, alloc_not_ts); - memcpy((void *) argv, argv_org, sizeof(argv_org)); alloc_ts_1 = START_ALC("threads_ts_1", 1, argv); ASSERT(tcs, alloc_ts_1); memcpy((void *) argv, argv_org, sizeof(argv_org)); alloc_ts_2 = START_ALC("threads_ts_2", 1, argv); ASSERT(tcs, alloc_ts_2); - ASSERT(tcs, !IS_ALLOC_THREAD_SAFE(alloc_not_ts)); ASSERT(tcs, IS_ALLOC_THREAD_SAFE(alloc_ts_1)); ASSERT(tcs, IS_ALLOC_THREAD_SAFE(alloc_ts_2)); @@ -190,12 +180,7 @@ testcase_run(TestCaseState_t *tcs) threads[i].arg.no_ops_per_bl = NO_OF_OPS_PER_BL; - if (i == 1) { - alc = "threads_not_ts"; - threads[i].arg.no_ops_per_bl *= 2; - threads[i].arg.a = alloc_not_ts; - } - else if (i % 2 == 0) { + if (i % 2 == 0) { alc = "threads_ts_1"; threads[i].arg.a = alloc_ts_1; } diff --git a/erts/emulator/test/async_ports_SUITE.erl b/erts/emulator/test/async_ports_SUITE.erl index c89b3655ff..f0f5fb5687 100644 --- a/erts/emulator/test/async_ports_SUITE.erl +++ b/erts/emulator/test/async_ports_SUITE.erl @@ -1,8 +1,10 @@ -module(async_ports_SUITE). --include_lib("common_test/include/ct.hrl"). +-export([all/0, suite/0]). +-export([permanent_busy_test/1]). +-export([run_loop/5]). --compile(export_all). +-include_lib("common_test/include/ct.hrl"). -define(PACKET_SIZE, (10 * 1024 * 8)). -define(CPORT_DELAY, 100). @@ -11,17 +13,15 @@ -define(TEST_PROCS_COUNT, 2). -define(TC_TIMETRAP_SECONDS, 10). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, ?TC_TIMETRAP_SECONDS}}]. all() -> - [ - permanent_busy_test - ]. + [permanent_busy_test]. permanent_busy_test(Config) -> - ct:timetrap({seconds, ?TC_TIMETRAP_SECONDS}), - ExePath = filename:join(?config(data_dir, Config), "cport"), - + ExePath = filename:join(proplists:get_value(data_dir, Config), "cport"), Self = self(), spawn_link( fun() -> @@ -29,17 +29,16 @@ permanent_busy_test(Config) -> Port = open_port(ExePath), - Testers = - lists:map( - fun(_) -> - erlang:spawn_link(?MODULE, run_loop, - [Self, - Port, - Block, - ?TEST_LOOPS_COUNT, - 0]) - end, - lists:seq(1, ?TEST_PROCS_COUNT)), + Testers = lists:map( + fun(_) -> + spawn_link(?MODULE, run_loop, + [Self, + Port, + Block, + ?TEST_LOOPS_COUNT, + 0]) + end, + lists:seq(1, ?TEST_PROCS_COUNT)), Self ! {test_info, Port, Testers}, endless_flush(Port) end), diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl index 706a4a1c16..6a54fa87e0 100644 --- a/erts/emulator/test/beam_SUITE.erl +++ b/erts/emulator/test/beam_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -24,17 +24,19 @@ init_per_group/2,end_per_group/2, packed_registers/1, apply_last/1, apply_last_bif/1, buildo_mucho/1, heap_sizes/1, big_lists/1, fconv/1, - select_val/1]). + select_val/1, swap_temp_apply/1]). --export([applied/2]). +-export([applied/2,swap_temp_applied/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). +-include_lib("syntax_tools/include/merl.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [packed_registers, apply_last, apply_last_bif, - buildo_mucho, heap_sizes, big_lists, select_val]. + buildo_mucho, heap_sizes, big_lists, select_val, + swap_temp_apply]. groups() -> []. @@ -61,15 +63,15 @@ apply_last(Config) when is_list(Config) -> {Pid, finished} -> stack_size(Pid) after 30000 -> - ?t:fail("applied/2 timed out.") + ct:fail("applied/2 timed out.") end, Pid ! die, - ?t:format("Size: ~p~n", [Size]), + io:format("Size: ~p~n", [Size]), if Size < 700 -> ok; true -> - ?t:fail("10000 apply() grew stack too much.") + ct:fail("10000 apply() grew stack too much.") end, ok. @@ -92,49 +94,46 @@ applied(Starter, N) -> apply_last_bif(Config) when is_list(Config) -> apply(erlang, abs, [1]). -%% Test three high register numbers in a put_list instruction -%% (to test whether packing works properly). +%% Test whether packing works properly. packed_registers(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), - Mod = packed_regs, - Name = filename:join(PrivDir, atom_to_list(Mod) ++ ".erl"), - - %% Generate a module which generates a list of tuples. - %% put_list(A) -> [{A, 600}, {A, 999}, ... {A, 0}]. - Code = gen_packed_regs(600, ["-module("++atom_to_list(Mod)++").\n", - "-export([put_list/1]).\n", - "put_list(A) ->\n["]), - ok = file:write_file(Name, Code), - - %% Compile the module. - io:format("Compiling: ~s\n", [Name]), - CompRc = compile:file(Name, [{outdir, PrivDir}, report]), - io:format("Result: ~p\n",[CompRc]), - {ok, Mod} = CompRc, - - %% Load it. - io:format("Loading...\n",[]), - LoadRc = code:load_abs(filename:join(PrivDir, atom_to_list(Mod))), - {module,_Module} = LoadRc, - - %% Call it and verify result. - Term = {a, b}, - L = Mod:put_list(Term), - verify_packed_regs(L, Term, 600), + Mod = ?FUNCTION_NAME, + + %% Generate scrambled sequence. + Seq0 = [{erlang:phash2(I),I} || I <- lists:seq(0, 260)], + Seq = [I || {_,I} <- lists:sort(Seq0)], + + %% Generate a test modules that uses get_list/3 instructions + %% with high register numbers. + S0 = [begin + VarName = list_to_atom("V"++integer_to_list(V)), + {merl:var(VarName),V} + end || V <- Seq], + Vars = [V || {V,_} <- S0], + NewVars = [begin + VarName = list_to_atom("M"++integer_to_list(V)), + merl:var(VarName) + end || V <- Seq], + S = [?Q("_@Var = id(_@Value@)") || {Var,Value} <- S0], + Code = ?Q(["-module('@Mod@').\n" + "-export([f/0]).\n" + "f() ->\n" + "_@S,\n" + "_ = id(0),\n" + "L = [_@Vars],\n" + "_ = id(1),\n" + "[_@NewVars] = L,\n" %Test get_list/3. + "_ = id(2),\n" + "id([_@Vars,_@NewVars]).\n" + "id(I) -> I.\n"]), + merl:compile_and_load(Code), + CombinedSeq = Seq ++ Seq, + CombinedSeq = Mod:f(), + + %% Clean up. + true = code:delete(Mod), + false = code:purge(Mod), ok. -gen_packed_regs(0, Acc) -> - [Acc|"{A,0}].\n"]; -gen_packed_regs(N, Acc) -> - gen_packed_regs(N-1, [Acc,"{A,",integer_to_list(N)|"},\n"]). - -verify_packed_regs([], _, -1) -> ok; -verify_packed_regs([{Term, N}| T], Term, N) -> - verify_packed_regs(T, Term, N-1); -verify_packed_regs(L, Term, N) -> - ok = io:format("Expected [{~p, ~p}|T]; got\n~p\n", [Term, N, L]), - test_server:fail(). - buildo_mucho(Config) when is_list(Config) -> buildo_mucho_1(), ok. @@ -319,7 +318,7 @@ fconv(Config) when is_list(Config) -> do_fconv(Type) -> try do_fconv(Type, 1.0), - test_server:fail() + ct:fail(no_badarith) catch error:badarith -> ok @@ -347,3 +346,41 @@ do_select_val(X) -> Int when is_integer(Int) -> integer end. + +swap_temp_apply(_Config) -> + {swap_temp_applied,42} = do_swap_temp_apply(41), + not_an_integer = do_swap_temp_apply(not_an_integer), + ok. + +do_swap_temp_apply(Msg) -> + case swap_temp_apply_function(Msg) of + undefined -> Msg; + Type -> + %% The following sequence: + %% move {x,0} {x,2} + %% move {y,0} {x,0} + %% move {x,2} {y,0} + %% apply 1 + %% + %% Would be incorrectly transformed to: + %% swap {x,0} {y,0} + %% apply 1 + %% + %% ({x,1} is the module, {x,2} the function to be applied). + %% + %% If the instructions are to be transformed, the correct + %% transformation is: + %% + %% swap_temp {x,0} {y,0} {x,2} + %% apply 1 + Fields = ?MODULE:Type(Msg), + {Type,Fields} + end. + +swap_temp_apply_function(Int) when is_integer(Int) -> + swap_temp_applied; +swap_temp_apply_function(_) -> + undefined. + +swap_temp_applied(Int) -> + Int+1. diff --git a/erts/emulator/test/beam_literals_SUITE.erl b/erts/emulator/test/beam_literals_SUITE.erl index 9f14ca26e5..09761263e2 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-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,7 +28,7 @@ put_list/1, fconv/1, literal_case_expression/1, increment/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -55,7 +55,7 @@ end_per_group(_GroupName, Config) -> Config. -putting(doc) -> "Test creating lists and tuples containing big number literals."; +%% Test creating lists and tuples containing big number literals. putting(Config) when is_list(Config) -> -773973888575883407313908 = chksum(putting1(8987697898797)). @@ -64,23 +64,22 @@ putting1(X) -> [X|349873987387373], [329878349873|-387394729872], -773973937933873929749873}. -matching_bigs(doc) -> "Test matching of a few big number literals (in Beam," - "select_val/3 will NOT be used)."; +%% Test matching of a few big number literals (in Beam select_val/3 will NOT be used). matching_bigs(Config) when is_list(Config) -> a = matching1(3972907842873739), b = matching1(-389789298378939783333333333333333333784), other = matching1(3141699999999999999999999999999999999), other = matching1(42). -matching_smalls(doc) -> "Test matching small numbers (both positive and negative)."; +%% Test matching small numbers (both positive and negative). matching_smalls(Config) when is_list(Config) -> - ?line a = m_small(-42), - ?line b = m_small(0), - ?line c = m_small(105), - ?line d = m_small(-13), - ?line e = m_small(337848), - ?line other = m_small(324), - ?line other = m_small(-7), + a = m_small(-42), + b = m_small(0), + c = m_small(105), + d = m_small(-13), + e = m_small(337848), + other = m_small(324), + other = m_small(-7), ok. m_small(-42) -> a; @@ -90,17 +89,16 @@ m_small(-13) -> d; m_small(337848) -> e; m_small(_) -> other. -matching_smalls_jt(doc) -> - "Test matching small numbers (both positive and negative). " - "Make sure that a jump table is used."; +%% Test matching small numbers (both positive and negative). +%% Make sure that a jump table is used. matching_smalls_jt(Config) when is_list(Config) -> - ?line a = m_small_jt(-2), - ?line b = m_small_jt(-1), - ?line c = m_small_jt(0), - ?line d = m_small_jt(2), - ?line e = m_small_jt(3), - ?line other = m_small(324), - ?line other = m_small(-7), + a = m_small_jt(-2), + b = m_small_jt(-1), + c = m_small_jt(0), + d = m_small_jt(2), + e = m_small_jt(3), + other = m_small(324), + other = m_small(-7), ok. m_small_jt(-2) -> a; @@ -117,8 +115,7 @@ matching1(-389789298378939783333333333333333333784) -> b; matching1(_) -> other. -matching_more_bigs(doc) -> "Test matching of a big number literals (in Beam," - "a select_val/3 instruction will be used)."; +%% Test matching of a big number literals (in Beam, a select_val/3 instruction will be used) matching_more_bigs(Config) when is_list(Config) -> a = matching2(-999766349740978337), b = matching2(9734097866575478), @@ -137,8 +134,7 @@ matching2(13987294872948990) -> d; matching2(777723896192459245) -> e; matching2(_) -> other. -matching_bigs_and_smalls(doc) -> "Test matching of a mix of big numbers and literals."; -matching_bigs_and_smalls(suite) -> []; +%% Test matching of a mix of big numbers and literals. matching_bigs_and_smalls(Config) when is_list(Config) -> a = matching3(38472928723987239873873), b = matching3(0), @@ -159,30 +155,30 @@ matching3(42) -> e; matching3(-4533) -> f; matching3(_) -> other. -badmatch(doc) -> "Test literal badmatches with big number and floats."; +%% Test literal badmatches with big number and floats. badmatch(Config) when is_list(Config) -> %% We are satisfied if we can load this module and run it. Big = id(32984798729847892498297824872982972978239874), Float = id(3.1415927), - ?line catch a = Big, - ?line catch b = Float, - ?line {'EXIT',{{badmatch,3879373498378993387},_}} = + catch a = Big, + catch b = Float, + {'EXIT',{{badmatch,3879373498378993387},_}} = (catch c = 3879373498378993387), - ?line {'EXIT',{{badmatch,7.0},_}} = (catch d = 7.0), - ?line case Big of - Big -> ok - end, - ?line case Float of - Float -> ok - end, + {'EXIT',{{badmatch,7.0},_}} = (catch d = 7.0), + case Big of + Big -> ok + end, + case Float of + Float -> ok + end, ok. case_clause(Config) when is_list(Config) -> - ?line {'EXIT',{{case_clause,337.0},_}} = (catch case_clause_float()), - ?line {'EXIT',{{try_clause,42.0},_}} = (catch try_case_clause_float()), - ?line {'EXIT',{{case_clause,37932749837839747383847398743789348734987},_}} = + {'EXIT',{{case_clause,337.0},_}} = (catch case_clause_float()), + {'EXIT',{{try_clause,42.0},_}} = (catch try_case_clause_float()), + {'EXIT',{{case_clause,37932749837839747383847398743789348734987},_}} = (catch case_clause_big()), - ?line {'EXIT',{{try_clause,977387349872349870423364354398566348},_}} = + {'EXIT',{{try_clause,977387349872349870423364354398566348},_}} = (catch try_case_clause_big()), ok. @@ -210,8 +206,7 @@ try_case_clause_big() -> error end. -receiving(doc) -> "Test receive with a big number literal (more than 27 bits, " - "less than 32 bits)."; +%% Test receive with a big number literal (more than 27 bits, less than 32 bits). receiving(Config) when is_list(Config) -> Self = self(), spawn(fun() -> Self ! here_is_a_message end), @@ -222,11 +217,11 @@ receiving(Config) when is_list(Config) -> timeout end. -literal_type_tests(doc) -> "Test type tests on literal values."; +%% Test type tests on literal values. 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, + Tests = make_test([{T, L} || T <- type_tests(), L <- literals()]), + Mod = literal_test, Anno = erl_anno:new(0), Func = {function, Anno, test, 0, [{clause,Anno,[],[],Tests}]}, Form = [{attribute,Anno,module,Mod}, @@ -234,22 +229,22 @@ literal_type_tests(Config) when is_list(Config) -> Func, {eof,Anno}], %% Print generated code for inspection. - ?line lists:foreach(fun (F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Form), + lists:foreach(fun (F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Form), %% Test compile:form/1. This implies full optimization (default). - ?line {ok,Mod,Code1} = compile:forms(Form), - ?line {module,Mod} = code:load_binary(Mod, Mod, Code1), - ?line Mod:test(), - ?line true = code:delete(Mod), - ?line code:purge(Mod), + {ok,Mod,Code1} = compile:forms(Form), + {module,Mod} = code:load_binary(Mod, Mod, Code1), + Mod:test(), + true = code:delete(Mod), + code:purge(Mod), %% Test compile:form/2. Turn off all optimizations. - ?line {ok,Mod,Code2} = compile:forms(Form, [binary,report,time, + {ok,Mod,Code2} = compile:forms(Form, [binary,report,time, no_copt,no_postopt]), - ?line {module,Mod} = code:load_binary(Mod, Mod, Code2), - ?line Mod:test(), - ?line true = code:delete(Mod), - ?line code:purge(Mod), + {module,Mod} = code:load_binary(Mod, Mod, Code2), + Mod:test(), + true = code:delete(Mod), + code:purge(Mod), ok. make_test([{is_function=T,L}|Ts]) -> @@ -299,34 +294,34 @@ type_tests() -> put_list(Config) when is_list(Config) -> %% put_list x0 Literal Reg - ?line [Config|8739757395764] = put_list_rqr(Config), - ?line {[Config|7779757395764],Config} = put_list_rqx(Config), - ?line [Config|98765432100000] = put_list_rqy(Config), + [Config|8739757395764] = put_list_rqr(Config), + {[Config|7779757395764],Config} = put_list_rqx(Config), + [Config|98765432100000] = put_list_rqy(Config), %% put_list x Literal Reg - ?line [Config|16#FFFFF77777137483769] = put_list_xqr(ignore, Config), - ?line {[Config|16#AAAAAFFFFF77777],{a,b},Config} = put_list_xqx({a,b}, Config), - ?line [Config|12777765432979879] = put_list_xqy(ignore, Config), + [Config|16#FFFFF77777137483769] = put_list_xqr(ignore, Config), + {[Config|16#AAAAAFFFFF77777],{a,b},Config} = put_list_xqx({a,b}, Config), + [Config|12777765432979879] = put_list_xqy(ignore, Config), %% put_list y Literal Reg - ?line [Config|17424134793676869867] = put_list_yqr(Config), - ?line {[Config|77424134793676869867],Config} = put_list_yqx(Config), - ?line {Config,[Config|16#BCDEFF4241676869867]} = put_list_yqy(Config), + [Config|17424134793676869867] = put_list_yqr(Config), + {[Config|77424134793676869867],Config} = put_list_yqx(Config), + {Config,[Config|16#BCDEFF4241676869867]} = put_list_yqy(Config), %% put_list Literal x0 Reg - ?line [42.0|Config] = put_list_qrr(Config), - ?line [Config,42.0|Config] = put_list_qrx(Config), - ?line [100.0|Config] = put_list_qry(Config), + [42.0|Config] = put_list_qrr(Config), + [Config,42.0|Config] = put_list_qrx(Config), + [100.0|Config] = put_list_qry(Config), %% put_list Literal x1 Reg - ?line [127.0|Config] = put_list_qxr({ignore,me}, Config), - ?line [Config,130.0|Config] = put_list_qxx(ignore, Config), - ?line [99.0|Config] = put_list_qxy(Config), + [127.0|Config] = put_list_qxr({ignore,me}, Config), + [Config,130.0|Config] = put_list_qxx(ignore, Config), + [99.0|Config] = put_list_qxy(Config), %% put_list Literal y0 Reg - ?line [200.0|Config] = put_list_qyr(Config), - ?line [Config,210.0|Config] = put_list_qyx(Config), - ?line [[300.0|Config]|Config] = put_list_qyy(Config), + [200.0|Config] = put_list_qyr(Config), + [Config,210.0|Config] = put_list_qyx(Config), + [[300.0|Config]|Config] = put_list_qyy(Config), ok. @@ -417,8 +412,8 @@ put_list_qyy(Config) -> [Res|Config]. fconv(Config) when is_list(Config) -> - ?line 5.0 = fconv_1(-34444444450.0), - ?line 13.0 = fconv_2(7.0), + 5.0 = fconv_1(-34444444450.0), + 13.0 = fconv_2(7.0), ok. fconv_1(F) when is_float(F) -> @@ -428,19 +423,18 @@ fconv_2(F) when is_float(F) -> 6.0 + F. literal_case_expression(Config) when is_list(Config) -> - ?line DataDir = ?config(data_dir, Config), - ?line Src = filename:join(DataDir, "literal_case_expression"), - ?line {ok,literal_case_expression=Mod,Code} = - compile:file(Src, [from_asm,binary]), - ?line {module,Mod} = code:load_binary(Mod, Src, Code), - ?line ok = Mod:x(), - ?line ok = Mod:y(), - ?line ok = Mod:zi1(), - ?line ok = Mod:zi2(), - ?line ok = Mod:za1(), - ?line ok = Mod:za2(), - ?line true = code:delete(Mod), - ?line code:purge(Mod), + DataDir = proplists:get_value(data_dir, Config), + Src = filename:join(DataDir, "literal_case_expression"), + {ok,literal_case_expression=Mod,Code} = compile:file(Src, [from_asm,binary]), + {module,Mod} = code:load_binary(Mod, Src, Code), + ok = Mod:x(), + ok = Mod:y(), + ok = Mod:zi1(), + ok = Mod:zi2(), + ok = Mod:za1(), + ok = Mod:za2(), + true = code:delete(Mod), + code:purge(Mod), ok. %% Test the i_increment instruction. @@ -452,27 +446,27 @@ increment(Config) when is_list(Config) -> Neg32 = -(1 bsl 27), Big32 = id(1 bsl 32), Result32 = (1 bsl 32) + (1 bsl 27), - ?line Result32 = Big32 + (1 bsl 27), - ?line Result32 = Big32 - Neg32, + Result32 = Big32 + (1 bsl 27), + Result32 = Big32 - Neg32, %% Same thing, but for the 64-bit emulator. Neg64 = -(1 bsl 59), Big64 = id(1 bsl 64), Result64 = (1 bsl 64) + (1 bsl 59), - ?line Result64 = Big64 + (1 bsl 59), - ?line Result64 = Big64 - Neg64, + Result64 = Big64 + (1 bsl 59), + Result64 = Big64 - Neg64, %% Test error handling for the i_increment instruction. Bad = id(bad), - ?line {'EXIT',{badarith,_}} = (catch Bad + 42), + {'EXIT',{badarith,_}} = (catch Bad + 42), %% Small operands, but a big result. Res32 = 1 bsl 27, Small32 = id(Res32-1), - ?line Res32 = Small32 + 1, + Res32 = Small32 + 1, Res64 = 1 bsl 59, Small64 = id(Res64-1), - ?line Res64 = Small64 + 1, + Res64 = Small64 + 1, ok. %% Help functions. diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index d6a771e7b9..26bb416bf0 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,21 +20,22 @@ -module(bif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.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, - init_per_testcase/2,end_per_testcase/2, +-export([all/0, suite/0, display/1, display_huge/0, erl_bif_types/1,guard_bifs_in_erl_bif_types/1, shadow_comments/1, specs/1,improper_bif_stubs/1,auto_imports/1, t_list_to_existing_atom/1,os_env/1,otp_7526/1, binary_to_atom/1,binary_to_existing_atom/1, - atom_to_binary/1,min_max/1, erlang_halt/1]). + atom_to_binary/1,min_max/1, erlang_halt/1, + is_builtin/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [erl_bif_types, guard_bifs_in_erl_bif_types, shadow_comments, @@ -42,37 +43,9 @@ all() -> t_list_to_existing_atom, os_env, otp_7526, display, atom_to_binary, binary_to_atom, binary_to_existing_atom, - min_max, erlang_halt]. + min_max, erlang_halt, is_builtin]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(1)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - - -display(suite) -> - []; -display(doc) -> - ["Uses erlang:display to test that erts_printf does not do deep recursion"]; +%% Uses erlang:display to test that erts_printf does not do deep recursion display(Config) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), {ok, Node} = test_server:start_node(display_huge_term,peer, @@ -117,7 +90,7 @@ erl_bif_types_2(List) -> [_|_] -> io:put_chars("Bifs with bad arity\n"), io:format("~p\n", [BadArity]), - ?line ?t:fail({length(BadArity),bad_arity}) + ct:fail({length(BadArity),bad_arity}) end. erl_bif_types_3(List) -> @@ -141,7 +114,7 @@ erl_bif_types_3(List) -> io:put_chars("Bifs with failing calls to erlang_bif_types:type/3 " "(or with bogus return values):\n"), io:format("~p\n", [BadSmokeTest]), - ?line ?t:fail({length(BadSmokeTest),bad_smoke_test}) + ct:fail({length(BadSmokeTest),bad_smoke_test}) end. guard_bifs_in_erl_bif_types(_Config) -> @@ -162,7 +135,7 @@ guard_bifs_in_erl_bif_types(_Config) -> "The following guard BIFs have no type information " "in erl_bif_types:\n\n", [io_lib:format(" ~p/~p\n", [F,A]) || {F,A} <- Not]]), - ?t:fail() + ct:fail(erl_bif_types) end. shadow_comments(_Config) -> @@ -202,7 +175,7 @@ shadow_comments(_Config) -> "obvious.\n\nThe following comments are missing:\n\n", [io_lib:format("%% Shadowed by erl_bif_types: ~p:~p/~p\n", [M,F,A]) || {M,F,A} <- NoComments]]), - ?t:fail() + ct:fail(bif_stub) end, case NoBifSpecs of @@ -216,7 +189,7 @@ shadow_comments(_Config) -> "Therefore, the following comments should be removed:\n\n", [io_lib:format("%% Shadowed by erl_bif_types: ~p:~p/~p\n", [M,F,A]) || {M,F,A} <- NoBifSpecs]]), - ?t:fail() + ct:fail(erl_bif_types) end. extract_comments(Mod, Path) -> @@ -238,7 +211,7 @@ ensure_erl_bif_types_compiled() -> case erlang:function_exported(erl_bif_types, module_info, 0) of false -> %% Fail cleanly. - ?t:fail("erl_bif_types not compiled"); + ct:fail("erl_bif_types not compiled"); true -> ok end. @@ -276,7 +249,7 @@ specs(_) -> [_|_] -> io:put_chars("The following BIFs don't have specs:\n"), [print_mfa(MFA) || MFA <- NoSpecs], - ?t:fail() + ct:fail(no_spec) end. is_operator({erlang,F,A}) -> @@ -336,7 +309,7 @@ auto_imports([{erlang,F,A}|T], Errors) -> auto_imports([], 0) -> ok; auto_imports([], Errors) -> - ?t:fail({Errors,inconsistencies}). + ct:fail({Errors,inconsistencies}). extract_functions(M, Abstr) -> [{{M,F,A},Body} || {function,_,F,A,Body} <- Abstr]. @@ -355,40 +328,36 @@ check_stub({_,F,A}, B) -> io:put_chars(erl_pp:function(Func)), io:nl(), io:put_chars("The body should be: erlang:nif_error(undef)"), - ?t:fail() + ct:fail(invalid_body) end. t_list_to_existing_atom(Config) when is_list(Config) -> - ?line all = list_to_existing_atom("all"), - ?line ?MODULE = list_to_existing_atom(?MODULE_STRING), - ?line UnlikelyStr = "dsfj923874390867er869fds9864y97jhg3973qerueoru", + all = list_to_existing_atom("all"), + ?MODULE = list_to_existing_atom(?MODULE_STRING), + UnlikelyStr = "dsfj923874390867er869fds9864y97jhg3973qerueoru", try - ?line list_to_existing_atom(UnlikelyStr), - ?line ?t:fail() + list_to_existing_atom(UnlikelyStr), + ct:fail(atom_exists) catch error:badarg -> ok end, %% The compiler has become smarter! We need the call to id/1 in %% the next line. - ?line UnlikelyAtom = list_to_atom(id(UnlikelyStr)), - ?line UnlikelyAtom = list_to_existing_atom(UnlikelyStr), + UnlikelyAtom = list_to_atom(id(UnlikelyStr)), + UnlikelyAtom = list_to_existing_atom(UnlikelyStr), ok. -os_env(doc) -> - []; -os_env(suite) -> - []; os_env(Config) when is_list(Config) -> - ?line EnvVar1 = "MjhgvFDrresdCghN mnjkUYg vfrD", - ?line false = os:getenv(EnvVar1), - ?line true = os:putenv(EnvVar1, "mors"), - ?line "mors" = os:getenv(EnvVar1), - ?line true = os:putenv(EnvVar1, ""), - ?line case os:getenv(EnvVar1) of - "" -> ?line ok; - false -> ?line ok; - BadVal -> ?line ?t:fail(BadVal) + EnvVar1 = "MjhgvFDrresdCghN mnjkUYg vfrD", + false = os:getenv(EnvVar1), + true = os:putenv(EnvVar1, "mors"), + "mors" = os:getenv(EnvVar1), + true = os:putenv(EnvVar1, ""), + case os:getenv(EnvVar1) of + "" -> ok; + false -> ok; + BadVal -> ct:fail(BadVal) end, true = os:putenv(EnvVar1, "mors"), true = os:unsetenv(EnvVar1), @@ -396,19 +365,18 @@ os_env(Config) when is_list(Config) -> true = os:unsetenv(EnvVar1), % unset unset variable %% os:putenv, os:getenv and os:unsetenv currently use a temp %% buffer of size 1024 for storing key+value - ?line os_env_long(1010, 1030, "hej hopp"). + os_env_long(1010, 1030, "hej hopp"). os_env_long(Min, Max, _Value) when Min > Max -> - ?line ok; + ok; os_env_long(Min, Max, Value) -> - ?line EnvVar = lists:duplicate(Min, $X), - ?line true = os:putenv(EnvVar, Value), - ?line Value = os:getenv(EnvVar), + EnvVar = lists:duplicate(Min, $X), + true = os:putenv(EnvVar, Value), + Value = os:getenv(EnvVar), true = os:unsetenv(EnvVar), - ?line os_env_long(Min+1, Max, Value). + os_env_long(Min+1, Max, Value). -otp_7526(doc) -> - ["Test that string:to_integer does not Halloc in wrong order."]; +%% Test that string:to_integer does not Halloc in wrong order. otp_7526(Config) when is_list(Config) -> ok = test_7526(256). @@ -423,15 +391,15 @@ do_test_7526(N,M) -> {Self, Ref} = {self(), make_ref()}, T = erlang:make_tuple(M,0), spawn_opt(fun()-> - L = iterate_7526(N, []), - BadList = [X || X <- L, X =/= 9223372036854775808], - BadLen = length(BadList), - M = length(tuple_to_list(T)), - %%io:format("~b bad conversions: ~p~n", [BadLen, BadList]), - Self ! {done, Ref, BadLen} - end, - [link,{fullsweep_after,0}]), - receive {done, Ref, Len} -> Len end. + L = iterate_7526(N, []), + BadList = [X || X <- L, X =/= 9223372036854775808], + BadLen = length(BadList), + M = length(tuple_to_list(T)), + %%io:format("~b bad conversions: ~p~n", [BadLen, BadList]), + Self ! {done, Ref, BadLen} + end, + [link,{fullsweep_after,0}]), + receive {done, Ref, Len} -> Len end. test_7526(0) -> @@ -455,57 +423,53 @@ binary_to_atom(Config) when is_list(Config) -> LongBin = list_to_binary(Long), %% latin1 - ?line '' = test_binary_to_atom(<<>>, latin1), - ?line '\377' = test_binary_to_atom(<<255>>, latin1), - ?line HalfLongAtom = test_binary_to_atom(HalfLongBin, latin1), - ?line LongAtom = test_binary_to_atom(LongBin, latin1), + '' = test_binary_to_atom(<<>>, latin1), + '\377' = test_binary_to_atom(<<255>>, latin1), + HalfLongAtom = test_binary_to_atom(HalfLongBin, latin1), + LongAtom = test_binary_to_atom(LongBin, latin1), %% utf8 - ?line '' = test_binary_to_atom(<<>>, utf8), - ?line HalfLongAtom = test_binary_to_atom(HalfLongBin, utf8), - ?line HalfLongAtom = test_binary_to_atom(HalfLongBin, unicode), - ?line [] = [C || C <- lists:seq(128, 255), + '' = test_binary_to_atom(<<>>, utf8), + HalfLongAtom = test_binary_to_atom(HalfLongBin, utf8), + HalfLongAtom = test_binary_to_atom(HalfLongBin, unicode), + [] = [C || C <- lists:seq(128, 255), begin list_to_atom([C]) =/= test_binary_to_atom(<<C/utf8>>, utf8) end], %% badarg failures. - ?line fail_binary_to_atom(atom), - ?line fail_binary_to_atom(42), - ?line fail_binary_to_atom({a,b,c}), - ?line fail_binary_to_atom([1,2,3]), - ?line fail_binary_to_atom([]), - ?line fail_binary_to_atom(42.0), - ?line fail_binary_to_atom(self()), - ?line fail_binary_to_atom(make_ref()), - ?line fail_binary_to_atom(<<0:7>>), - ?line fail_binary_to_atom(<<42:13>>), - ?line ?BADARG(binary_to_atom(id(<<>>), blurf)), - ?line ?BADARG(binary_to_atom(id(<<>>), [])), + fail_binary_to_atom(atom), + fail_binary_to_atom(42), + fail_binary_to_atom({a,b,c}), + fail_binary_to_atom([1,2,3]), + fail_binary_to_atom([]), + fail_binary_to_atom(42.0), + fail_binary_to_atom(self()), + fail_binary_to_atom(make_ref()), + fail_binary_to_atom(<<0:7>>), + fail_binary_to_atom(<<42:13>>), + ?BADARG(binary_to_atom(id(<<>>), blurf)), + ?BADARG(binary_to_atom(id(<<>>), [])), %% Bad UTF8 sequences. - ?line ?BADARG(binary_to_atom(id(<<255>>), utf8)), - ?line ?BADARG(binary_to_atom(id(<<255,0>>), utf8)), - ?line ?BADARG(binary_to_atom(id(<<16#C0,16#80>>), utf8)), %Overlong 0. - ?line [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || - C <- lists:seq(256, 16#D7FF)], - ?line [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || - C <- lists:seq(16#E000, 16#FFFD)], - ?line [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || - C <- lists:seq(16#10000, 16#8FFFF)], - ?line [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || - C <- lists:seq(16#90000, 16#10FFFF)], + ?BADARG(binary_to_atom(id(<<255>>), utf8)), + ?BADARG(binary_to_atom(id(<<255,0>>), utf8)), + ?BADARG(binary_to_atom(id(<<16#C0,16#80>>), utf8)), %Overlong 0. + [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(256, 16#D7FF)], + [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(16#E000, 16#FFFD)], + [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(16#10000, 16#8FFFF)], + [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(16#90000, 16#10FFFF)], %% system_limit failures. - ?line ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255>>), utf8)), - ?line ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255,0>>), utf8)), - ?line ?SYS_LIMIT(binary_to_atom(<<0:256/unit:8>>, latin1)), - ?line ?SYS_LIMIT(binary_to_atom(<<0:257/unit:8>>, latin1)), - ?line ?SYS_LIMIT(binary_to_atom(<<0:512/unit:8>>, latin1)), - ?line ?SYS_LIMIT(binary_to_atom(<<0:256/unit:8>>, utf8)), - ?line ?SYS_LIMIT(binary_to_atom(<<0:257/unit:8>>, utf8)), - ?line ?SYS_LIMIT(binary_to_atom(<<0:512/unit:8>>, utf8)), + ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255>>), utf8)), + ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255,0>>), utf8)), + ?SYS_LIMIT(binary_to_atom(<<0:256/unit:8>>, latin1)), + ?SYS_LIMIT(binary_to_atom(<<0:257/unit:8>>, latin1)), + ?SYS_LIMIT(binary_to_atom(<<0:512/unit:8>>, latin1)), + ?SYS_LIMIT(binary_to_atom(<<0:256/unit:8>>, utf8)), + ?SYS_LIMIT(binary_to_atom(<<0:257/unit:8>>, utf8)), + ?SYS_LIMIT(binary_to_atom(<<0:512/unit:8>>, utf8)), ok. test_binary_to_atom(Bin0, Encoding) -> @@ -518,49 +482,49 @@ test_binary_to_atom(Bin0, Encoding) -> fail_binary_to_atom(Bin) -> try - binary_to_atom(Bin, latin1) + binary_to_atom(Bin, latin1) catch - error:badarg -> - ok + error:badarg -> + ok end, try - binary_to_atom(Bin, utf8) + binary_to_atom(Bin, utf8) catch - error:badarg -> - ok + error:badarg -> + ok end, try - binary_to_existing_atom(Bin, latin1) + binary_to_existing_atom(Bin, latin1) catch - error:badarg -> - ok + error:badarg -> + ok end, try - binary_to_existing_atom(Bin, utf8) + binary_to_existing_atom(Bin, utf8) catch - error:badarg -> - ok + error:badarg -> + ok end. binary_to_existing_atom(Config) when is_list(Config) -> - ?line UnlikelyBin = <<"ou0897979655678dsfj923874390867er869fds973qerueoru">>, + UnlikelyBin = <<"ou0897979655678dsfj923874390867er869fds973qerueoru">>, try - ?line binary_to_existing_atom(UnlikelyBin, latin1), - ?line ?t:fail() + binary_to_existing_atom(UnlikelyBin, latin1), + ct:fail(atom_exists) catch error:badarg -> ok end, try - ?line binary_to_existing_atom(UnlikelyBin, utf8), - ?line ?t:fail() + binary_to_existing_atom(UnlikelyBin, utf8), + ct:fail(atom_exists) catch error:badarg -> ok end, - ?line UnlikelyAtom = binary_to_atom(id(UnlikelyBin), latin1), - ?line UnlikelyAtom = binary_to_existing_atom(UnlikelyBin, latin1), + UnlikelyAtom = binary_to_atom(id(UnlikelyBin), latin1), + UnlikelyAtom = binary_to_existing_atom(UnlikelyBin, latin1), ok. @@ -573,32 +537,32 @@ atom_to_binary(Config) when is_list(Config) -> LongBin = list_to_binary(Long), %% latin1 - ?line <<>> = atom_to_binary('', latin1), - ?line <<"abc">> = atom_to_binary(abc, latin1), - ?line <<127>> = atom_to_binary('\177', latin1), - ?line HalfLongBin = atom_to_binary(HalfLongAtom, latin1), - ?line LongBin = atom_to_binary(LongAtom, latin1), + <<>> = atom_to_binary('', latin1), + <<"abc">> = atom_to_binary(abc, latin1), + <<127>> = atom_to_binary('\177', latin1), + HalfLongBin = atom_to_binary(HalfLongAtom, latin1), + LongBin = atom_to_binary(LongAtom, latin1), %% utf8. - ?line <<>> = atom_to_binary('', utf8), - ?line <<>> = atom_to_binary('', unicode), - ?line <<127>> = atom_to_binary('\177', utf8), - ?line <<"abcdef">> = atom_to_binary(abcdef, utf8), - ?line HalfLongBin = atom_to_binary(HalfLongAtom, utf8), - ?line LongAtomBin = atom_to_binary(LongAtom, utf8), - ?line verify_long_atom_bin(LongAtomBin, 0), + <<>> = atom_to_binary('', utf8), + <<>> = atom_to_binary('', unicode), + <<127>> = atom_to_binary('\177', utf8), + <<"abcdef">> = atom_to_binary(abcdef, utf8), + HalfLongBin = atom_to_binary(HalfLongAtom, utf8), + LongAtomBin = atom_to_binary(LongAtom, utf8), + verify_long_atom_bin(LongAtomBin, 0), %% Failing cases. - ?line fail_atom_to_binary(<<1>>), - ?line fail_atom_to_binary(42), - ?line fail_atom_to_binary({a,b,c}), - ?line fail_atom_to_binary([1,2,3]), - ?line fail_atom_to_binary([]), - ?line fail_atom_to_binary(42.0), - ?line fail_atom_to_binary(self()), - ?line fail_atom_to_binary(make_ref()), - ?line ?BADARG(atom_to_binary(id(a), blurf)), - ?line ?BADARG(atom_to_binary(id(b), [])), + fail_atom_to_binary(<<1>>), + fail_atom_to_binary(42), + fail_atom_to_binary({a,b,c}), + fail_atom_to_binary([1,2,3]), + fail_atom_to_binary([]), + fail_atom_to_binary(42.0), + fail_atom_to_binary(self()), + fail_atom_to_binary(make_ref()), + ?BADARG(atom_to_binary(id(a), blurf)), + ?BADARG(atom_to_binary(id(b), [])), ok. verify_long_atom_bin(<<I/utf8,T/binary>>, I) -> @@ -607,74 +571,73 @@ verify_long_atom_bin(<<>>, 255) -> ok. fail_atom_to_binary(Term) -> try - atom_to_binary(Term, latin1) + atom_to_binary(Term, latin1) catch - error:badarg -> - ok + error:badarg -> + ok end, try - atom_to_binary(Term, utf8) + atom_to_binary(Term, utf8) catch - error:badarg -> - ok + error:badarg -> + ok end. min_max(Config) when is_list(Config) -> - ?line a = erlang:min(id(a), a), - ?line a = erlang:min(id(a), b), - ?line a = erlang:min(id(b), a), - ?line b = erlang:min(id(b), b), - ?line a = erlang:max(id(a), a), - ?line b = erlang:max(id(a), b), - ?line b = erlang:max(id(b), a), - ?line b = erlang:max(id(b), b), - - ?line 42.0 = erlang:min(42.0, 42), - ?line 42.0 = erlang:max(42.0, 42), + a = erlang:min(id(a), a), + a = erlang:min(id(a), b), + a = erlang:min(id(b), a), + b = erlang:min(id(b), b), + a = erlang:max(id(a), a), + b = erlang:max(id(a), b), + b = erlang:max(id(b), a), + b = erlang:max(id(b), b), + + 42.0 = erlang:min(42.0, 42), + 42.0 = erlang:max(42.0, 42), %% And now (R14) they are also autoimported! - ?line a = min(id(a), a), - ?line a = min(id(a), b), - ?line a = min(id(b), a), - ?line b = min(id(b), b), - ?line a = max(id(a), a), - ?line b = max(id(a), b), - ?line b = max(id(b), a), - ?line b = max(id(b), b), - - ?line 42.0 = min(42.0, 42), - ?line 42.0 = max(42.0, 42), - + a = min(id(a), a), + a = min(id(a), b), + a = min(id(b), a), + b = min(id(b), b), + a = max(id(a), a), + b = max(id(a), b), + b = max(id(b), a), + b = max(id(b), b), + + 42.0 = min(42.0, 42), + 42.0 = max(42.0, 42), ok. erlang_halt(Config) when is_list(Config) -> try erlang:halt(undefined) of - _-> ?t:fail({erlang,halt,{undefined}}) + _-> ct:fail({erlang,halt,{undefined}}) catch error:badarg -> ok end, try halt(undefined) of - _-> ?t:fail({halt,{undefined}}) + _-> ct:fail({halt,{undefined}}) catch error:badarg -> ok end, try erlang:halt(undefined, []) of - _-> ?t:fail({erlang,halt,{undefined,[]}}) + _-> ct:fail({erlang,halt,{undefined,[]}}) catch error:badarg -> ok end, try halt(undefined, []) of - _-> ?t:fail({halt,{undefined,[]}}) + _-> ct:fail({halt,{undefined,[]}}) catch error:badarg -> ok end, try halt(0, undefined) of - _-> ?t:fail({halt,{0,undefined}}) + _-> ct:fail({halt,{0,undefined}}) catch error:badarg -> ok end, try halt(0, [undefined]) of - _-> ?t:fail({halt,{0,[undefined]}}) + _-> ct:fail({halt,{0,[undefined]}}) catch error:badarg -> ok end, try halt(0, [{undefined,true}]) of - _-> ?t:fail({halt,{0,[{undefined,true}]}}) + _-> ct:fail({halt,{0,[{undefined,true}]}}) catch error:badarg -> ok end, try halt(0, [{flush,undefined}]) of - _-> ?t:fail({halt,{0,[{flush,undefined}]}}) + _-> ct:fail({halt,{0,[{flush,undefined}]}}) catch error:badarg -> ok end, try halt(0, [{flush,true,undefined}]) of - _-> ?t:fail({halt,{0,[{flush,true,undefined}]}}) + _-> ct:fail({halt,{0,[{flush,true,undefined}]}}) catch error:badarg -> ok end, H = hostname(), {ok,N1} = slave:start(H, halt_node1), @@ -716,6 +679,22 @@ wait_until_stable_size(File,PrevSz) -> wait_until_stable_size(File,NewSz) end. +is_builtin(_Config) -> + Exp0 = [{M,F,A} || {M,_} <- code:all_loaded(), + {F,A} <- M:module_info(exports)], + Exp = ordsets:from_list(Exp0), + + %% erlang:apply/3 is considered to be built-in, but is not + %% implemented as other BIFs. + + Builtins0 = [{erlang,apply,3}|erlang:system_info(snifs)], + Builtins = ordsets:from_list(Builtins0), + NotBuiltin = ordsets:subtract(Exp, Builtins), + _ = [true = erlang:is_builtin(M, F, A) || {M,F,A} <- Builtins], + _ = [false = erlang:is_builtin(M, F, A) || {M,F,A} <- NotBuiltin], + + ok. + %% Helpers diff --git a/erts/emulator/test/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl index e8f881f2a4..402751393a 100644 --- a/erts/emulator/test/big_SUITE.erl +++ b/erts/emulator/test/big_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,8 +20,8 @@ -module(big_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-export([all/0, suite/0, groups/0]). + -export([t_div/1, eq_28/1, eq_32/1, eq_big/1, eq_math/1, big_literals/1, borders/1, negative/1, big_float_1/1, big_float_2/1, shift_limit_1/1, powmod/1, system_limit/1, toobig/1, otp_6692/1]). @@ -32,11 +32,12 @@ -export([fac/1, fib/1, pow/2, gcd/2, lcm/2]). --export([init_per_testcase/2, end_per_testcase/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> [t_div, eq_28, eq_32, eq_big, eq_math, big_literals, @@ -46,27 +47,6 @@ all() -> groups() -> [{big_float, [], [big_float_1, big_float_2]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(3)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - %% %% Syntax of data files: %% Expr1 = Expr2. @@ -95,7 +75,7 @@ eq_math(Config) when is_list(Config) -> test(TestFile). -borders(doc) -> "Tests border cases between small/big."; +%% Tests border cases between small/big. borders(Config) when is_list(Config) -> TestFile = test_file(Config, "borders.dat"), test(TestFile). @@ -107,7 +87,7 @@ negative(Config) when is_list(Config) -> %% Find test file test_file(Config, Name) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), filename:join(DataDir, Name). %% @@ -119,12 +99,12 @@ test(File) -> test(File, [node()]). test(File, Nodes) -> - ?line {ok,Fd} = file:open(File, [read]), + {ok,Fd} = file:open(File, [read]), Res = test(File, Fd, Nodes), file:close(Fd), case Res of {0,Cases} -> {comment, integer_to_list(Cases) ++ " cases"}; - {_,_} -> test_server:fail() + {_,_} -> ct:fail("failed") end. test(File, Fd, Ns) -> @@ -156,7 +136,7 @@ multi_match(Ns, Expr) -> multi_match(Ns, Expr, []). multi_match([Node|Ns], Expr, Rs) -> - ?line X = rpc:call(Node, big_SUITE, eval, [Expr]), + X = rpc:call(Node, big_SUITE, eval, [Expr]), if X == 0 -> multi_match(Ns, Expr, Rs); true -> multi_match(Ns, Expr, [{Node,X}|Rs]) end; @@ -248,10 +228,10 @@ lcm(Q, R) -> %% Test case t_div cut in from R2D test suite. t_div(Config) when is_list(Config) -> - ?line 'try'(fun() -> 98765432101234 div 98765432101235 end, 0), + 'try'(fun() -> 98765432101234 div 98765432101235 end, 0), % Big remainder, small quotient. - ?line 'try'(fun() -> 339254531512 div 68719476736 end, 4), + 'try'(fun() -> 339254531512 div 68719476736 end, 4), ok. 'try'(Fun, Result) -> @@ -265,65 +245,60 @@ t_div(Config) when is_list(Config) -> {result, Result} -> 'try'(Iter-1, Fun, Result, [0|Filler]); {result, Other} -> - io:format("Expected ~p; got ~p~n", [Result, Other]), - test_server:fail() + ct:fail("Expected ~p; got ~p~n", [Result, Other]) end. init(ReplyTo, Fun, _Filler) -> ReplyTo ! {result, Fun()}. -big_literals(doc) -> - "Tests that big-number literals work correctly."; +%% Tests that big-number literals work correctly. big_literals(Config) when is_list(Config) -> %% Note: The literal test cannot be compiler on a pre-R4 Beam emulator, %% so we compile it now. - ?line DataDir = ?config(data_dir, Config), - ?line Test = filename:join(DataDir, "literal_test"), - ?line {ok, Mod, Bin} = compile:file(Test, [binary]), - ?line {module, Mod} = code:load_binary(Mod, Mod, Bin), - ?line ok = Mod:t(), + DataDir = proplists:get_value(data_dir, Config), + Test = filename:join(DataDir, "literal_test"), + {ok, Mod, Bin} = compile:file(Test, [binary]), + {module, Mod} = code:load_binary(Mod, Mod, Bin), + ok = Mod:t(), ok. -big_float_1(doc) -> - ["OTP-2436, part 1"]; +%% OTP-2436, part 1 big_float_1(Config) when is_list(Config) -> %% F is a number very close to a maximum float. - ?line F = id(1.7e308), - ?line I = trunc(F), - ?line true = (I == F), - ?line false = (I /= F), - ?line true = (I > F/2), - ?line false = (I =< F/2), - ?line true = (I*2 >= F), - ?line false = (I*2 < F), - ?line true = (I*I > F), - ?line false = (I*I =< F), - - ?line true = (F == I), - ?line false = (F /= I), - ?line false = (F/2 > I), - ?line true = (F/2 =< I), - ?line false = (F >= I*2), - ?line true = (F < I*2), - ?line false = (F > I*I), - ?line true = (F =< I*I), + F = id(1.7e308), + I = trunc(F), + true = (I == F), + false = (I /= F), + true = (I > F/2), + false = (I =< F/2), + true = (I*2 >= F), + false = (I*2 < F), + true = (I*I > F), + false = (I*I =< F), + + true = (F == I), + false = (F /= I), + false = (F/2 > I), + true = (F/2 =< I), + false = (F >= I*2), + true = (F < I*2), + false = (F > I*I), + true = (F =< I*I), ok. -big_float_2(doc) -> - ["OTP-2436, part 2"]; +%% "OTP-2436, part 2 big_float_2(Config) when is_list(Config) -> - ?line F = id(1.7e308), - ?line I = trunc(F), - ?line {'EXIT', _} = (catch 1/(2*I)), - ?line _Ignore = 2/I, - ?line {'EXIT', _} = (catch 4/(2*I)), + F = id(1.7e308), + I = trunc(F), + {'EXIT', _} = (catch 1/(2*I)), + _Ignore = 2/I, + {'EXIT', _} = (catch 4/(2*I)), ok. -shift_limit_1(doc) -> - ["OTP-3256"]; +%% OTP-3256 shift_limit_1(Config) when is_list(Config) -> - ?line case catch (id(1) bsl 100000000) of + case catch (id(1) bsl 100000000) of {'EXIT', {system_limit, _}} -> ok end, @@ -352,16 +327,16 @@ powmod(A, B, C) -> end. system_limit(Config) when is_list(Config) -> - ?line Maxbig = maxbig(), - ?line {'EXIT',{system_limit,_}} = (catch Maxbig+1), - ?line {'EXIT',{system_limit,_}} = (catch -Maxbig-1), - ?line {'EXIT',{system_limit,_}} = (catch 2*Maxbig), - ?line {'EXIT',{system_limit,_}} = (catch bnot Maxbig), - ?line {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bnot'), [Maxbig])), - ?line {'EXIT',{system_limit,_}} = (catch Maxbig bsl 2), - ?line {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bsl'), [Maxbig,2])), - ?line {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 45)), - ?line {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 69)), + Maxbig = maxbig(), + {'EXIT',{system_limit,_}} = (catch Maxbig+1), + {'EXIT',{system_limit,_}} = (catch -Maxbig-1), + {'EXIT',{system_limit,_}} = (catch 2*Maxbig), + {'EXIT',{system_limit,_}} = (catch bnot Maxbig), + {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bnot'), [Maxbig])), + {'EXIT',{system_limit,_}} = (catch Maxbig bsl 2), + {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bsl'), [Maxbig,2])), + {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 45)), + {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 69)), ok. maxbig() -> @@ -372,7 +347,7 @@ maxbig() -> id(I) -> I. toobig(Config) when is_list(Config) -> - ?line {'EXIT',{{badmatch,_},_}} = (catch toobig()), + {'EXIT',{{badmatch,_},_}} = (catch toobig()), ok. toobig() -> @@ -381,12 +356,9 @@ toobig() -> <<ANr:ASize>> = A, % should fail ANr band ANr. -otp_6692(suite) -> - []; -otp_6692(doc) -> - ["Tests for DIV/REM bug reported in OTP-6692"]; +%% Tests for DIV/REM bug reported in OTP-6692 otp_6692(Config) when is_list(Config)-> - ?line loop1(1,1000). + loop1(1,1000). fact(N) -> fact(N,1). diff --git a/erts/emulator/test/big_SUITE_data/literal_test.erl b/erts/emulator/test/big_SUITE_data/literal_test.erl index 1620693bfa..17c4db467a 100644 --- a/erts/emulator/test/big_SUITE_data/literal_test.erl +++ b/erts/emulator/test/big_SUITE_data/literal_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 96ba2f64d4..1c7d278bb0 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -40,7 +40,7 @@ %% phash2(Binary, N) %% --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, @@ -106,17 +106,17 @@ end_per_testcase(_Func, _Config) -> copy_terms(Config) when is_list(Config) -> Self = self(), - ?line Pid = spawn_link(fun() -> copy_server(Self) end), + Pid = spawn_link(fun() -> copy_server(Self) end), F = fun(Term) -> Pid ! Term, receive Term -> ok; Other -> io:format("Sent: ~P\nGot back:~P", [Term,12,Other,12]), - ?t:fail(bad_term) + ct:fail(bad_term) end end, - ?line test_terms(F), + test_terms(F), ok. copy_server(Parent) -> @@ -129,154 +129,152 @@ copy_server(Parent) -> %% Tests list_to_binary/1, binary_to_list/1 and size/1, %% using flat lists. -conversions(suite) -> []; conversions(Config) when is_list(Config) -> - ?line test_bin([]), - ?line test_bin([1]), - ?line test_bin([1, 2]), - ?line test_bin([1, 2, 3]), - ?line test_bin(lists:seq(0, ?heap_binary_size)), - ?line test_bin(lists:seq(0, ?heap_binary_size+1)), - ?line test_bin(lists:seq(0, 255)), - ?line test_bin(lists:duplicate(50000, $@)), + test_bin([]), + test_bin([1]), + test_bin([1, 2]), + test_bin([1, 2, 3]), + test_bin(lists:seq(0, ?heap_binary_size)), + test_bin(lists:seq(0, ?heap_binary_size+1)), + test_bin(lists:seq(0, 255)), + test_bin(lists:duplicate(50000, $@)), %% Binary in list. List = [1,2,3,4,5], - ?line B1 = make_sub_binary(list_to_binary(List)), - ?line 5 = size(B1), - ?line 5 = size(make_unaligned_sub_binary(B1)), - ?line 40 = bit_size(B1), - ?line 40 = bit_size(make_unaligned_sub_binary(B1)), - ?line B2 = list_to_binary([42,B1,19]), - ?line B2 = list_to_binary([42,make_unaligned_sub_binary(B1),19]), - ?line B2 = iolist_to_binary(B2), - ?line B2 = iolist_to_binary(make_unaligned_sub_binary(B2)), - ?line 7 = size(B2), - ?line 7 = size(make_sub_binary(B2)), - ?line 56 = bit_size(B2), - ?line 56 = bit_size(make_sub_binary(B2)), - ?line [42,1,2,3,4,5,19] = binary_to_list(B2), - ?line [42,1,2,3,4,5,19] = binary_to_list(make_sub_binary(B2)), - ?line [42,1,2,3,4,5,19] = binary_to_list(make_unaligned_sub_binary(B2)), - ?line [42,1,2,3,4,5,19] = bitstring_to_list(B2), - ?line [42,1,2,3,4,5,19] = bitstring_to_list(make_sub_binary(B2)), - ?line [42,1,2,3,4,5,19] = bitstring_to_list(make_unaligned_sub_binary(B2)), + B1 = make_sub_binary(list_to_binary(List)), + 5 = size(B1), + 5 = size(make_unaligned_sub_binary(B1)), + 40 = bit_size(B1), + 40 = bit_size(make_unaligned_sub_binary(B1)), + B2 = list_to_binary([42,B1,19]), + B2 = list_to_binary([42,make_unaligned_sub_binary(B1),19]), + B2 = iolist_to_binary(B2), + B2 = iolist_to_binary(make_unaligned_sub_binary(B2)), + 7 = size(B2), + 7 = size(make_sub_binary(B2)), + 56 = bit_size(B2), + 56 = bit_size(make_sub_binary(B2)), + [42,1,2,3,4,5,19] = binary_to_list(B2), + [42,1,2,3,4,5,19] = binary_to_list(make_sub_binary(B2)), + [42,1,2,3,4,5,19] = binary_to_list(make_unaligned_sub_binary(B2)), + [42,1,2,3,4,5,19] = bitstring_to_list(B2), + [42,1,2,3,4,5,19] = bitstring_to_list(make_sub_binary(B2)), + [42,1,2,3,4,5,19] = bitstring_to_list(make_unaligned_sub_binary(B2)), ok. test_bin(List) -> - ?line Size = length(List), - ?line Bin = list_to_binary(List), - ?line Bin = iolist_to_binary(List), - ?line Bin = list_to_bitstring(List), - ?line Size = iolist_size(List), - ?line Size = iolist_size(Bin), - ?line Size = iolist_size(make_unaligned_sub_binary(Bin)), - ?line Size = size(Bin), - ?line Size = size(make_sub_binary(Bin)), - ?line Size = size(make_unaligned_sub_binary(Bin)), - ?line List = binary_to_list(Bin), - ?line List = binary_to_list(make_sub_binary(Bin)), - ?line List = binary_to_list(make_unaligned_sub_binary(Bin)), - ?line List = bitstring_to_list(Bin), - ?line List = bitstring_to_list(make_unaligned_sub_binary(Bin)). + Size = length(List), + Bin = list_to_binary(List), + Bin = iolist_to_binary(List), + Bin = list_to_bitstring(List), + Size = iolist_size(List), + Size = iolist_size(Bin), + Size = iolist_size(make_unaligned_sub_binary(Bin)), + Size = size(Bin), + Size = size(make_sub_binary(Bin)), + Size = size(make_unaligned_sub_binary(Bin)), + List = binary_to_list(Bin), + List = binary_to_list(make_sub_binary(Bin)), + List = binary_to_list(make_unaligned_sub_binary(Bin)), + List = bitstring_to_list(Bin), + List = bitstring_to_list(make_unaligned_sub_binary(Bin)). %% Tests list_to_binary/1, iolist_to_binary/1, list_to_bitstr/1, binary_to_list/1,3, %% bitstr_to_list/1, and size/1, using deep lists. deep_lists(Config) when is_list(Config) -> - ?line test_deep_list(["abc"]), - ?line test_deep_list([[12,13,[123,15]]]), - ?line test_deep_list([[12,13,[lists:seq(0, 255), []]]]), + test_deep_list(["abc"]), + test_deep_list([[12,13,[123,15]]]), + test_deep_list([[12,13,[lists:seq(0, 255), []]]]), ok. test_deep_list(List) -> - ?line FlatList = lists:flatten(List), - ?line Size = length(FlatList), - ?line Bin = list_to_binary(List), - ?line Bin = iolist_to_binary(List), - ?line Bin = iolist_to_binary(Bin), - ?line Bin = list_to_bitstring(List), - ?line Size = size(Bin), - ?line Size = iolist_size(List), - ?line Size = iolist_size(FlatList), - ?line Size = iolist_size(Bin), - ?line Bitsize = bit_size(Bin), - ?line Bitsize = 8*Size, - ?line FlatList = binary_to_list(Bin), - ?line FlatList = bitstring_to_list(Bin), + FlatList = lists:flatten(List), + Size = length(FlatList), + Bin = list_to_binary(List), + Bin = iolist_to_binary(List), + Bin = iolist_to_binary(Bin), + Bin = list_to_bitstring(List), + Size = size(Bin), + Size = iolist_size(List), + Size = iolist_size(FlatList), + Size = iolist_size(Bin), + Bitsize = bit_size(Bin), + Bitsize = 8*Size, + FlatList = binary_to_list(Bin), + FlatList = bitstring_to_list(Bin), io:format("testing plain binary..."), - ?line t_binary_to_list_3(FlatList, Bin, 1, Size), + t_binary_to_list_3(FlatList, Bin, 1, Size), io:format("testing unaligned sub binary..."), - ?line t_binary_to_list_3(FlatList, make_unaligned_sub_binary(Bin), 1, Size). + t_binary_to_list_3(FlatList, make_unaligned_sub_binary(Bin), 1, Size). t_binary_to_list_3(List, Bin, From, To) -> - ?line going_up(List, Bin, From, To), - ?line going_down(List, Bin, From, To), - ?line going_center(List, Bin, From, To). + going_up(List, Bin, From, To), + going_down(List, Bin, From, To), + going_center(List, Bin, From, To). going_up(List, Bin, From, To) when From =< To -> - ?line List = binary_to_list(Bin, From, To), - ?line going_up(tl(List), Bin, From+1, To); + List = binary_to_list(Bin, From, To), + going_up(tl(List), Bin, From+1, To); going_up(_List, _Bin, From, To) when From > To -> ok. going_down(List, Bin, From, To) when To > 0-> - ?line compare(List, binary_to_list(Bin, From, To), To-From+1), - ?line going_down(List, Bin, From, To-1); + compare(List, binary_to_list(Bin, From, To), To-From+1), + going_down(List, Bin, From, To-1); going_down(_List, _Bin, _From, _To) -> ok. going_center(List, Bin, From, To) when From >= To -> - ?line compare(List, binary_to_list(Bin, From, To), To-From+1), - ?line going_center(tl(List), Bin, From+1, To-1); + compare(List, binary_to_list(Bin, From, To), To-From+1), + going_center(tl(List), Bin, From+1, To-1); going_center(_List, _Bin, _From, _To) -> ok. compare([X|Rest1], [X|Rest2], Left) when Left > 0 -> - ?line compare(Rest1, Rest2, Left-1); + compare(Rest1, Rest2, Left-1); compare([_X|_], [_Y|_], _Left) -> - ?line test_server:fail(); + ct:fail("compare fail"); compare(_List, [], 0) -> ok. deep_bitstr_lists(Config) when is_list(Config) -> - ?line {<<7:3>>,[<<7:3>>]} = test_deep_bitstr([<<7:3>>]), - ?line {<<42,5:3>>=Bin,[42,<<5:3>>]=List} = test_deep_bitstr([42,<<5:3>>]), - ?line {Bin,List} = test_deep_bitstr([42|<<5:3>>]), - ?line {Bin,List} = test_deep_bitstr([<<42,5:3>>]), - ?line {Bin,List} = test_deep_bitstr([<<1:3>>,<<10:5>>|<<5:3>>]), - ?line {Bin,List} = test_deep_bitstr([<<1:3>>,<<10:5>>,<<5:3>>]), - ?line {Bin,List} = test_deep_bitstr([[<<1:3>>,<<10:5>>],[],<<5:3>>]), - ?line {Bin,List} = test_deep_bitstr([[[<<1:3>>]|<<10:5>>],[],<<5:3>>]), - ?line {Bin,List} = test_deep_bitstr([[<<0:1>>,<<0:1>>,[],<<1:1>>,<<10:5>>], + {<<7:3>>,[<<7:3>>]} = test_deep_bitstr([<<7:3>>]), + {<<42,5:3>>=Bin,[42,<<5:3>>]=List} = test_deep_bitstr([42,<<5:3>>]), + {Bin,List} = test_deep_bitstr([42|<<5:3>>]), + {Bin,List} = test_deep_bitstr([<<42,5:3>>]), + {Bin,List} = test_deep_bitstr([<<1:3>>,<<10:5>>|<<5:3>>]), + {Bin,List} = test_deep_bitstr([<<1:3>>,<<10:5>>,<<5:3>>]), + {Bin,List} = test_deep_bitstr([[<<1:3>>,<<10:5>>],[],<<5:3>>]), + {Bin,List} = test_deep_bitstr([[[<<1:3>>]|<<10:5>>],[],<<5:3>>]), + {Bin,List} = test_deep_bitstr([[<<0:1>>,<<0:1>>,[],<<1:1>>,<<10:5>>], <<1:1>>,<<0:1>>,<<1:1>>]), ok. test_deep_bitstr(List) -> - %%?line {'EXIT',{badarg,_}} = list_to_binary(List), + %%{'EXIT',{badarg,_}} = list_to_binary(List), Bin = list_to_bitstring(List), {Bin,bitstring_to_list(Bin)}. -bad_list_to_binary(suite) -> []; bad_list_to_binary(Config) when is_list(Config) -> - ?line test_bad_bin(atom), - ?line test_bad_bin(42), - ?line test_bad_bin([1|2]), - ?line test_bad_bin([256]), - ?line test_bad_bin([255, [256]]), - ?line test_bad_bin([-1]), - ?line test_bad_bin([atom_in_list]), - ?line test_bad_bin([[<<8>>]|bad_tail]), + test_bad_bin(atom), + test_bad_bin(42), + test_bad_bin([1|2]), + test_bad_bin([256]), + test_bad_bin([255, [256]]), + test_bad_bin([-1]), + test_bad_bin([atom_in_list]), + test_bad_bin([[<<8>>]|bad_tail]), {'EXIT',{badarg,_}} = (catch list_to_binary(id(<<1,2,3>>))), {'EXIT',{badarg,_}} = (catch list_to_binary(id([<<42:7>>]))), {'EXIT',{badarg,_}} = (catch list_to_bitstring(id(<<1,2,3>>))), %% Funs used to be implemented as a type of binary internally. - ?line test_bad_bin(fun(X, Y) -> X*Y end), - ?line test_bad_bin([1,fun(X) -> X + 1 end,2|fun() -> 0 end]), - ?line test_bad_bin([fun(X) -> X + 1 end]), + test_bad_bin(fun(X, Y) -> X*Y end), + test_bad_bin([1,fun(X) -> X + 1 end,2|fun() -> 0 end]), + test_bad_bin([fun(X) -> X + 1 end]), %% Test iolists that do not fit in the address space. %% Unfortunately, it would be too slow to test in a 64-bit emulator. @@ -287,15 +285,15 @@ bad_list_to_binary(Config) when is_list(Config) -> huge_iolists() -> FourGigs = 1 bsl 32, - ?line Sizes = [FourGigs+N || N <- lists:seq(0, 64)] ++ + Sizes = [FourGigs+N || N <- lists:seq(0, 64)] ++ [1 bsl N || N <- lists:seq(33, 37)], - ?line Base = <<0:(1 bsl 20)/unit:8>>, + Base = <<0:(1 bsl 20)/unit:8>>, [begin L = build_iolist(Sz, Base), - ?line {'EXIT',{system_limit,_}} = (catch list_to_binary([L])), - ?line {'EXIT',{system_limit,_}} = (catch list_to_bitstring([L])), - ?line {'EXIT',{system_limit,_}} = (catch binary:list_to_bin([L])), - ?line {'EXIT',{system_limit,_}} = (catch iolist_to_binary(L)) + {'EXIT',{system_limit,_}} = (catch list_to_binary([L])), + {'EXIT',{system_limit,_}} = (catch list_to_bitstring([L])), + {'EXIT',{system_limit,_}} = (catch binary:list_to_bin([L])), + {'EXIT',{system_limit,_}} = (catch iolist_to_binary(L)) end || Sz <- Sizes], ok. @@ -305,15 +303,15 @@ test_bad_bin(List) -> {'EXIT',{badarg,_}} = (catch list_to_bitstring(List)), {'EXIT',{badarg,_}} = (catch iolist_size(List)). -bad_binary_to_list(doc) -> "Tries binary_to_list/1,3 with bad arguments."; +%% Tries binary_to_list/1,3 with bad arguments. bad_binary_to_list(Config) when is_list(Config) -> - ?line bad_bin_to_list(fun(X) -> X * 42 end), + bad_bin_to_list(fun(X) -> X * 42 end), GoodBin = list_to_binary(lists:seq(1, 10)), - ?line bad_bin_to_list(fun(X) -> X * 44 end, 1, 2), - ?line bad_bin_to_list(GoodBin, 0, 1), - ?line bad_bin_to_list(GoodBin, 2, 1), - ?line bad_bin_to_list(GoodBin, 11, 11), + bad_bin_to_list(fun(X) -> X * 44 end, 1, 2), + bad_bin_to_list(GoodBin, 0, 1), + bad_bin_to_list(GoodBin, 2, 1), + bad_bin_to_list(GoodBin, 11, 11), {'EXIT',{badarg,_}} = (catch binary_to_list(id(<<42:7>>))), ok. @@ -327,63 +325,61 @@ bad_bin_to_list(Bin, First, Last) -> %% Tries to split a binary at all possible positions. -t_split_binary(suite) -> []; t_split_binary(Config) when is_list(Config) -> - ?line L = lists:seq(0, ?heap_binary_size-5), %Heap binary. - ?line B = list_to_binary(L), - ?line split(L, B, size(B)), + L = lists:seq(0, ?heap_binary_size-5), %Heap binary. + B = list_to_binary(L), + split(L, B, size(B)), %% Sub binary of heap binary. - ?line split(L, make_sub_binary(B), size(B)), + split(L, make_sub_binary(B), size(B)), {X,_Y} = split_binary(B, size(B) div 2), - ?line split(binary_to_list(X), X, size(X)), + split(binary_to_list(X), X, size(X)), %% Unaligned sub binary of heap binary. - ?line split(L, make_unaligned_sub_binary(B), size(B)), + split(L, make_unaligned_sub_binary(B), size(B)), {X,_Y} = split_binary(B, size(B) div 2), - ?line split(binary_to_list(X), X, size(X)), + split(binary_to_list(X), X, size(X)), %% Reference-counted binary. - ?line L2 = lists:seq(0, ?heap_binary_size+1), - ?line B2 = list_to_binary(L2), - ?line split(L2, B2, size(B2)), + L2 = lists:seq(0, ?heap_binary_size+1), + B2 = list_to_binary(L2), + split(L2, B2, size(B2)), %% Sub binary of reference-counted binary. - ?line split(L2, make_sub_binary(B2), size(B2)), + split(L2, make_sub_binary(B2), size(B2)), {X2,_Y2} = split_binary(B2, size(B2) div 2), - ?line split(binary_to_list(X2), X2, size(X2)), + split(binary_to_list(X2), X2, size(X2)), %% Unaligned sub binary of reference-counted binary. - ?line split(L2, make_unaligned_sub_binary(B2), size(B2)), + split(L2, make_unaligned_sub_binary(B2), size(B2)), {X2,_Y2} = split_binary(B2, size(B2) div 2), - ?line split(binary_to_list(X2), X2, size(X2)), + split(binary_to_list(X2), X2, size(X2)), ok. split(L, B, Pos) when Pos > 0 -> - ?line {B1, B2} = split_binary(B, Pos), - ?line B1 = list_to_binary(lists:sublist(L, 1, Pos)), - ?line B2 = list_to_binary(lists:nthtail(Pos, L)), - ?line split(L, B, Pos-1); + {B1, B2} = split_binary(B, Pos), + B1 = list_to_binary(lists:sublist(L, 1, Pos)), + B2 = list_to_binary(lists:nthtail(Pos, L)), + split(L, B, Pos-1); split(_L, _B, 0) -> ok. -bad_split(doc) -> "Tries split_binary/2 with bad arguments."; -bad_split(suite) -> []; +%% Tries split_binary/2 with bad arguments. bad_split(Config) when is_list(Config) -> GoodBin = list_to_binary([1,2,3]), - ?line bad_split(GoodBin, -1), - ?line bad_split(GoodBin, 4), - ?line bad_split(GoodBin, a), + bad_split(GoodBin, -1), + bad_split(GoodBin, 4), + bad_split(GoodBin, a), %% Funs are a kind of binaries. - ?line bad_split(fun(_X) -> 1 end, 1), + bad_split(fun(_X) -> 1 end, 1), ok. bad_split(Bin, Pos) -> {'EXIT',{badarg,_}} = (catch split_binary(Bin, Pos)). -t_hash(doc) -> "Test hash/2 with different type of binaries."; +%% Test hash/2 with different type of binaries. t_hash(Config) when is_list(Config) -> test_hash([]), test_hash([253]), @@ -396,36 +392,34 @@ test_hash(List) -> Bin = list_to_binary(List), Sbin = make_sub_binary(List), Unaligned = make_unaligned_sub_binary(Sbin), - ?line test_hash_1(Bin, Sbin, Unaligned, fun erlang:hash/2), - ?line test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash/2), - ?line test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash2/2). + test_hash_1(Bin, Sbin, Unaligned, fun erlang:hash/2), + test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash/2), + test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash2/2). test_hash_1(Bin, Sbin, Unaligned, Hash) when is_function(Hash, 2) -> N = 65535, case {Hash(Bin, N),Hash(Sbin, N),Hash(Unaligned, N)} of {H,H,H} -> ok; {H1,H2,H3} -> - io:format("Different hash values: ~p, ~p, ~p\n", [H1,H2,H3]), - ?t:fail() + ct:fail("Different hash values: ~p, ~p, ~p\n", [H1,H2,H3]) end. -bad_size(doc) -> "Try bad arguments to size/1."; -bad_size(suite) -> []; +%% Try bad arguments to size/1. bad_size(Config) when is_list(Config) -> - ?line {'EXIT',{badarg,_}} = (catch size(fun(X) -> X + 33 end)), + {'EXIT',{badarg,_}} = (catch size(fun(X) -> X + 33 end)), ok. bad_term_to_binary(Config) when is_list(Config) -> T = id({a,b,c}), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, not_a_list)), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [blurf])), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,-1}])), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,10}])), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,cucumber}])), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed}])), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{version,1}|bad_tail])), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{minor_version,-1}])), - ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{minor_version,x}])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, not_a_list)), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [blurf])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,-1}])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,10}])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,cucumber}])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed}])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{version,1}|bad_tail])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{minor_version,-1}])), + {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{minor_version,x}])), ok. @@ -464,7 +458,7 @@ terms(Config) when is_list(Config) -> UnalignedC = make_unaligned_sub_binary(BinC), Term = binary_to_term_stress(UnalignedC) end, - ?line test_terms(TestFun), + test_terms(TestFun), ok. terms_compression_levels(Term, UncompressedSz, Level) when Level < 10 -> @@ -476,7 +470,7 @@ terms_compression_levels(Term, UncompressedSz, Level) when Level < 10 -> terms_compression_levels(_, _, _) -> ok. terms_float(Config) when is_list(Config) -> - ?line test_floats(fun(Term) -> + test_floats(fun(Term) -> Bin0 = term_to_binary(Term, [{minor_version,0}]), Term = binary_to_term_stress(Bin0), Bin1 = term_to_binary(Term), @@ -492,22 +486,21 @@ terms_float(Config) when is_list(Config) -> float_middle_endian(Config) when is_list(Config) -> %% Testing for roundtrip is not enough. - ?line <<131,70,63,240,0,0,0,0,0,0>> = term_to_binary(1.0, [{minor_version,1}]), - ?line 1.0 = binary_to_term_stress(<<131,70,63,240,0,0,0,0,0,0>>). + <<131,70,63,240,0,0,0,0,0,0>> = term_to_binary(1.0, [{minor_version,1}]), + 1.0 = binary_to_term_stress(<<131,70,63,240,0,0,0,0,0,0>>). external_size(Config) when is_list(Config) -> %% Build a term whose external size only fits in a big num (on 32-bit CPU). - ?line external_size_1(16#11111111111111117777777777777777888889999, 0, 16#FFFFFFF), + external_size_1(16#11111111111111117777777777777777888889999, 0, 16#FFFFFFF), %% Test that the same binary aligned and unaligned has the same external size. - ?line Bin = iolist_to_binary([1,2,3,96]), - ?line Unaligned = make_unaligned_sub_binary(Bin), + Bin = iolist_to_binary([1,2,3,96]), + Unaligned = make_unaligned_sub_binary(Bin), case {erlang:external_size(Bin),erlang:external_size(Unaligned)} of {X,X} -> ok; {Sz1,Sz2} -> - io:format(" Aligned size: ~p\n", [Sz1]), - io:format("Unaligned size: ~p\n", [Sz2]), - ?line ?t:fail() + ct:fail(" Aligned size: ~p\n" + "Unaligned size: ~p\n", [Sz1,Sz2]) end, true = (erlang:external_size(Bin) =:= erlang:external_size(Bin, [{minor_version, 1}])), true = (erlang:external_size(Unaligned) =:= erlang:external_size(Unaligned, [{minor_version, 1}])). @@ -521,30 +514,29 @@ external_size_1(Term, Size0, Limit) when Size0 < Limit -> external_size_1(_, _, _) -> ok. t_iolist_size(Config) when is_list(Config) -> - ?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>>, - ?line Powers = [1 bsl N || N <- lists:seq(2, 37)], - ?line Sizes0 = [[N - random:uniform(N div 2), - lists:seq(N-2, N+2), - N+N div 2, - N + random:uniform(N div 2)] || - N <- Powers], + _ = rand:uniform(), %Seed generator + io:format("Seed: ~p", [rand:export_seed()]), + + Base = <<0:(1 bsl 20)/unit:8>>, + Powers = [1 bsl N || N <- lists:seq(2, 37)], + Sizes0 = [[N - rand:uniform(N div 2), + lists:seq(N-2, N+2), + N+N div 2, + N + rand:uniform(N div 2)] || + N <- Powers], + %% Test sizes around 1^32 more thoroughly. FourGigs = 1 bsl 32, - ?line Sizes1 = [FourGigs+N || N <- lists:seq(-8, 40)] ++ Sizes0, - ?line Sizes2 = lists:flatten(Sizes1), - ?line Sizes = lists:usort(Sizes2), + Sizes1 = [FourGigs+N || N <- lists:seq(-8, 40)] ++ Sizes0, + Sizes2 = lists:flatten(Sizes1), + Sizes = lists:usort(Sizes2), io:format("~p sizes:", [length(Sizes)]), io:format("~p\n", [Sizes]), - ?line [Sz = iolist_size(build_iolist(Sz, Base)) || Sz <- Sizes], + _ = [Sz = iolist_size(build_iolist(Sz, Base)) || Sz <- Sizes], ok. build_iolist(N, Base) when N < 16 -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> <<Bin:N/binary,_/binary>> = Base, Bin; @@ -552,7 +544,7 @@ build_iolist(N, Base) when N < 16 -> lists:seq(1, N) end; build_iolist(N, Base) when N =< byte_size(Base) -> - case random:uniform(3) of + case rand:uniform(3) of 1 -> <<Bin:N/binary,_/binary>> = Base, Bin; @@ -570,7 +562,7 @@ build_iolist(N, Base) when N =< byte_size(Base) -> end end; build_iolist(N0, Base) -> - Small = random:uniform(15), + Small = rand:uniform(15), Seq = lists:seq(1, Small), N = N0 - Small, case N rem 2 of @@ -583,33 +575,32 @@ build_iolist(N0, Base) -> end. -bad_binary_to_term_2(doc) -> "OTP-4053."; -bad_binary_to_term_2(suite) -> []; +%% OTP-4053 bad_binary_to_term_2(Config) when is_list(Config) -> - ?line {ok, N} = test_server:start_node(plopp, slave, []), - ?line R = rpc:call(N, erlang, binary_to_term, [<<131,111,255,255,255,0>>]), - ?line case R of + {ok, N} = test_server:start_node(plopp, slave, []), + R = rpc:call(N, erlang, binary_to_term, [<<131,111,255,255,255,0>>]), + case R of {badrpc, {'EXIT', _}} -> ok; _Other -> - test_server:fail({rpcresult, R}) + ct:fail({rpcresult, R}) end, - ?line test_server:stop_node(N), + test_server:stop_node(N), ok. -bad_binary_to_term(doc) -> "Try bad input to binary_to_term/1."; +%% Try bad input to binary_to_term/1. bad_binary_to_term(Config) when is_list(Config) -> - ?line bad_bin_to_term(an_atom), - ?line bad_bin_to_term({an,tuple}), - ?line bad_bin_to_term({a,list}), - ?line bad_bin_to_term(fun() -> self() end), - ?line bad_bin_to_term(fun(X) -> 42*X end), - ?line bad_bin_to_term(fun(X, Y) -> {X,Y} end), - ?line bad_bin_to_term(fun(X, Y, Z) -> {X,Y,Z} end), - ?line bad_bin_to_term(bit_sized_binary(term_to_binary({you,should,'not',see,this,term}))), + bad_bin_to_term(an_atom), + bad_bin_to_term({an,tuple}), + bad_bin_to_term({a,list}), + bad_bin_to_term(fun() -> self() end), + bad_bin_to_term(fun(X) -> 42*X end), + bad_bin_to_term(fun(X, Y) -> {X,Y} end), + bad_bin_to_term(fun(X, Y, Z) -> {X,Y,Z} end), + bad_bin_to_term(bit_sized_binary(term_to_binary({you,should,'not',see,this,term}))), %% Bad float. - ?line bad_bin_to_term(<<131,70,-1:64>>), + bad_bin_to_term(<<131,70,-1:64>>), ok. bad_bin_to_term(BadBin) -> @@ -618,25 +609,24 @@ bad_bin_to_term(BadBin) -> bad_bin_to_term(BadBin,Opts) -> {'EXIT',{badarg,_}} = (catch binary_to_term_stress(BadBin,Opts)). -safe_binary_to_term2(doc) -> "Test safety options for binary_to_term/2"; +%% Test safety options for binary_to_term/2 safe_binary_to_term2(Config) when is_list(Config) -> - ?line bad_bin_to_term(<<131,100,0,14,"undefined_atom">>, [safe]), - ?line bad_bin_to_term(<<131,100,0,14,"other_bad_atom">>, [safe]), + bad_bin_to_term(<<131,100,0,14,"undefined_atom">>, [safe]), + bad_bin_to_term(<<131,100,0,14,"other_bad_atom">>, [safe]), BadHostAtom = <<100,0,14,"badguy@badhost">>, Empty = <<0,0,0,0>>, BadRef = <<131,114,0,3,BadHostAtom/binary,0,<<0,0,0,255>>/binary, Empty/binary,Empty/binary>>, - ?line bad_bin_to_term(BadRef, [safe]), % good ref, with a bad atom - ?line fullsweep_after = binary_to_term_stress(<<131,100,0,15,"fullsweep_after">>, [safe]), % should be a good atom + bad_bin_to_term(BadRef, [safe]), % good ref, with a bad atom + fullsweep_after = binary_to_term_stress(<<131,100,0,15,"fullsweep_after">>, [safe]), % should be a good atom BadExtFun = <<131,113,100,0,4,98,108,117,101,100,0,4,109,111,111,110,97,3>>, - ?line bad_bin_to_term(BadExtFun, [safe]), + bad_bin_to_term(BadExtFun, [safe]), ok. %% Tests bad input to binary_to_term/1. -bad_terms(suite) -> []; bad_terms(Config) when is_list(Config) -> - ?line test_terms(fun corrupter/1), + test_terms(fun corrupter/1), {'EXIT',{badarg,_}} = (catch binary_to_term(<<131,$M,3:32,0,11,22,33>>)), {'EXIT',{badarg,_}} = (catch binary_to_term(<<131,$M,3:32,9,11,22,33>>)), {'EXIT',{badarg,_}} = (catch binary_to_term(<<131,$M,0:32,1,11,22,33>>)), @@ -669,7 +659,7 @@ corrupter(Term) -> corrupter0(Term). corrupter0(Term) -> - ?line try + try S = io_lib:format("About to corrupt: ~P", [Term,12]), io:put_chars(S) catch @@ -677,42 +667,41 @@ corrupter0(Term) -> io:format("About to corrupt: <<bit-level-binary:~p", [bit_size(Term)]) end, - ?line Bin = term_to_binary(Term), - ?line corrupter(Bin, size(Bin)-1), - ?line CompressedBin = term_to_binary(Term, [compressed]), - ?line corrupter(CompressedBin, size(CompressedBin)-1). + Bin = term_to_binary(Term), + corrupter(Bin, size(Bin)-1), + CompressedBin = term_to_binary(Term, [compressed]), + corrupter(CompressedBin, size(CompressedBin)-1). corrupter(Bin, Pos) when Pos >= 0 -> - ?line {ShorterBin, Rest} = split_binary(Bin, Pos), - ?line catch binary_to_term_stress(ShorterBin), %% emulator shouldn't crash - ?line MovedBin = list_to_binary([ShorterBin]), - ?line catch binary_to_term_stress(MovedBin), %% emulator shouldn't crash + {ShorterBin, Rest} = split_binary(Bin, Pos), + catch binary_to_term_stress(ShorterBin), %% emulator shouldn't crash + MovedBin = list_to_binary([ShorterBin]), + catch binary_to_term_stress(MovedBin), %% emulator shouldn't crash %% Bit faults, shouldn't crash <<Byte,Tail/binary>> = Rest, Fun = fun(M) -> FaultyByte = Byte bxor M, catch binary_to_term_stress(<<ShorterBin/binary, FaultyByte, Tail/binary>>) end, - ?line lists:foreach(Fun,[1,2,4,8,16,32,64,128,255]), - ?line corrupter(Bin, Pos-1); + lists:foreach(Fun,[1,2,4,8,16,32,64,128,255]), + corrupter(Bin, Pos-1); corrupter(_Bin, _) -> ok. -more_bad_terms(suite) -> []; more_bad_terms(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line BadFile = filename:join(Data, "bad_binary"), - ?line ok = io:format("File: ~s\n", [BadFile]), - ?line case file:read_file(BadFile) of + Data = proplists:get_value(data_dir, Config), + BadFile = filename:join(Data, "bad_binary"), + ok = io:format("File: ~s\n", [BadFile]), + case file:read_file(BadFile) of {ok,Bin} -> - ?line {'EXIT',{badarg,_}} = (catch binary_to_term_stress(Bin)), + {'EXIT',{badarg,_}} = (catch binary_to_term_stress(Bin)), ok; Other -> - ?line ?t:fail(Other) + ct:fail(Other) end. otp_5484(Config) when is_list(Config) -> - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( <<131, @@ -725,7 +714,7 @@ otp_5484(Config) when is_list(Config) -> 255, 106>>)), - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( <<131, @@ -737,13 +726,13 @@ otp_5484(Config) when is_list(Config) -> 2, 106>>)), - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( %% A old-type fun in a list containing a bad creator pid. <<131,108,0,0,0,1,117,0,0,0,0,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,255,255,0,25,255,0,0,0,0,100,0,1,116,97,0,98,6,142,121,72,106>>)), - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( %% A new-type fun in a list containing a bad creator pid. @@ -755,7 +744,7 @@ otp_5484(Config) when is_list(Config) -> 106, %[] instead of an atom. 0,0,0,27,0,0,0,0,0,106>>)), - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( %% A new-type fun in a list containing a bad module. @@ -766,7 +755,7 @@ otp_5484(Config) when is_list(Config) -> 107,0,1,64, %String instead of atom (same length). 97,0,98,6,64,82,230,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,0,0,0,48,0,0,0,0,0,97,42,97,7,106>>)), - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( %% A new-type fun in a list containing a bad index. @@ -778,7 +767,7 @@ otp_5484(Config) when is_list(Config) -> 104,0, %Tuple {} instead of integer. 98,6,64,82,230,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,0,0,0,48,0,0,0,0,0,97,42,97,7,106>>)), - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( %% A new-type fun in a list containing a bad unique value. @@ -792,46 +781,46 @@ otp_5484(Config) when is_list(Config) -> 103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,0,0,0,48,0,0,0,0,0,97,42,97,7,106>>)), %% An absurdly large atom. - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress(iolist_to_binary([<<131,100,65000:16>>| lists:duplicate(65000, 42)]))), %% Longer than 255 characters. - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress(iolist_to_binary([<<131,100,256:16>>| lists:duplicate(256, 42)]))), %% OTP-7218. Thanks to Matthew Dempsky. Also make sure that we %% cover the other error cases for external funs (EXPORT_EXT). - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( <<131, 113, %EXPORT_EXP 97,13, %Integer: 13 97,13, %Integer: 13 97,13>>)), %Integer: 13 - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( <<131, 113, %EXPORT_EXP 100,0,1,64, %Atom: '@' 97,13, %Integer: 13 97,13>>)), %Integer: 13 - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( <<131, 113, %EXPORT_EXP 100,0,1,64, %Atom: '@' 100,0,1,64, %Atom: '@' 106>>)), %NIL - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( <<131, 113, %EXPORT_EXP 100,0,1,64, %Atom: '@' 100,0,1,64, %Atom: '@' 98,255,255,255,255>>)), %Integer: -1 - ?line {'EXIT',_} = + {'EXIT',_} = (catch binary_to_term_stress( <<131, 113, %EXPORT_EXP @@ -840,7 +829,7 @@ otp_5484(Config) when is_list(Config) -> 113,97,13,97,13,97,13>>)), %fun 13:13/13 %% Bad funs. - ?line {'EXIT',_} = (catch binary_to_term_stress(fake_fun(0, lists:seq(0, 256)))), + {'EXIT',_} = (catch binary_to_term_stress(fake_fun(0, lists:seq(0, 256)))), ok. fake_fun(Arity, Env0) -> @@ -863,9 +852,9 @@ fake_fun(Arity, Env0) -> %% More bad terms submitted by Matthias Lang. otp_5933(Config) when is_list(Config) -> - ?line try_bad_lengths(<<131,$m>>), %binary - ?line try_bad_lengths(<<131,$n>>), %bignum - ?line try_bad_lengths(<<131,$o>>), %huge bignum + try_bad_lengths(<<131,$m>>), %binary + try_bad_lengths(<<131,$n>>), %bignum + try_bad_lengths(<<131,$o>>), %huge bignum ok. try_bad_lengths(B) -> @@ -884,7 +873,7 @@ otp_6817(Config) when is_list(Config) -> %% Floats are only validated when the heap fragment has been allocated. BadFloat = <<131,99,53,46,48,$X,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,101,45,48,49,0,0,0,0,0>>, - ?line otp_6817_try_bin(BadFloat), + otp_6817_try_bin(BadFloat), %% {Binary,BadFloat}: When the error in float is discovered, a refc-binary %% has been allocated and the list of refc-binaries goes through the @@ -904,7 +893,7 @@ otp_6817(Config) when is_list(Config) -> 230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248, 249,250,251,252,253,254,255,99,51,46,49,52,$B,$l,$u,$r,$f,48,48,48,48,48,48, 48,48,49,50,52,51,52,101,43,48,48,0,0,0,0,0>>, - ?line otp_6817_try_bin(BinAndFloat), + otp_6817_try_bin(BinAndFloat), %% {Fun,BadFloat} FunAndFloat = @@ -912,14 +901,14 @@ otp_6817(Config) when is_list(Config) -> 71,8,0,0,0,0,0,0,0,0,100,0,1,116,97,0,98,5,175,169,123,103,100,0,13,110,111, 110,111,100,101,64,110,111,104,111,115,116,0,0,0,41,0,0,0,0,0,99,50,46,55,48, $Y,57,57,57,57,57,57,57,57,57,57,57,57,57,54,52,52,55,101,43,48,48,0,0,0,0,0>>, - ?line otp_6817_try_bin(FunAndFloat), + otp_6817_try_bin(FunAndFloat), %% [ExternalPid|BadFloat] ExtPidAndFloat = <<131,108,0,0,0,1,103,100,0,13,107,97,108,108,101,64,115,116,114,105,100,101, 114,0,0,0,36,0,0,0,0,2,99,48,46,$@,48,48,48,48,48,48,48,48,48,48,48,48,48,48, 48,48,48,48,48,101,43,48,48,0,0,0,0,0>>, - ?line otp_6817_try_bin(ExtPidAndFloat), + otp_6817_try_bin(ExtPidAndFloat), ok. otp_6817_try_bin(Bin) -> @@ -937,8 +926,7 @@ otp_6817_try_bin(Bin) -> %% Will crash if the bug is present. erlang:garbage_collect(). -otp_8117(doc) -> "Some bugs in binary_to_term when 32-bit integers are negative."; -otp_8117(suite) -> []; +%% Some bugs in binary_to_term when 32-bit integers are negative. otp_8117(Config) when is_list(Config) -> [otp_8117_do(Op,-(1 bsl N)) || Op <- ['fun',named_fun,list,tuple], N <- lists:seq(0,31)], @@ -947,23 +935,22 @@ otp_8117(Config) when is_list(Config) -> otp_8117_do('fun',Neg) -> % Fun with negative num_free FunBin = term_to_binary(fun() -> ok end), - ?line <<B1:27/binary,_NumFree:32,Rest/binary>> = FunBin, - ?line bad_bin_to_term(<<B1/binary,Neg:32,Rest/binary>>); + <<B1:27/binary,_NumFree:32,Rest/binary>> = FunBin, + bad_bin_to_term(<<B1/binary,Neg:32,Rest/binary>>); otp_8117_do(named_fun,Neg) -> % Named fun with negative num_free FunBin = term_to_binary(fun F() -> F end), - ?line <<B1:27/binary,_NumFree:32,Rest/binary>> = FunBin, - ?line bad_bin_to_term(<<B1/binary,Neg:32,Rest/binary>>); + <<B1:27/binary,_NumFree:32,Rest/binary>> = FunBin, + bad_bin_to_term(<<B1/binary,Neg:32,Rest/binary>>); otp_8117_do(list,Neg) -> %% List with negative length - ?line bad_bin_to_term(<<131,104,2,108,Neg:32,97,11,104,1,97,12,97,13,106,97,14>>); + bad_bin_to_term(<<131,104,2,108,Neg:32,97,11,104,1,97,12,97,13,106,97,14>>); otp_8117_do(tuple,Neg) -> %% Tuple with negative arity - ?line bad_bin_to_term(<<131,104,2,105,Neg:32,97,11,97,12,97,13,97,14>>). + bad_bin_to_term(<<131,104,2,105,Neg:32,97,11,97,12,97,13,97,14>>). -ordering(doc) -> "Tests ordering of binaries."; -ordering(suite) -> []; +%% Tests ordering of binaries. ordering(Config) when is_list(Config) -> B1 = list_to_binary([7,8,9]), B2 = make_sub_binary([1,2,3,4]), @@ -972,54 +959,54 @@ ordering(Config) when is_list(Config) -> %% From R8 binaries are compared as strings. - ?line false = B1 == B2, - ?line false = B1 =:= B2, - ?line true = B1 /= B2, - ?line true = B1 =/= B2, + false = B1 == B2, + false = B1 =:= B2, + true = B1 /= B2, + true = B1 =/= B2, - ?line true = B1 > B2, - ?line true = B2 < B3, - ?line true = B2 =< B1, - ?line true = B2 =< B3, + true = B1 > B2, + true = B2 < B3, + true = B2 =< B1, + true = B2 =< B3, - ?line true = B2 =:= Unaligned, - ?line true = B2 == Unaligned, - ?line true = Unaligned < B3, - ?line true = Unaligned =< B3, + true = B2 =:= Unaligned, + true = B2 == Unaligned, + true = Unaligned < B3, + true = Unaligned =< B3, %% Binaries are greater than all other terms. - ?line true = B1 > 0, - ?line true = B1 > 39827491247298471289473333333333333333333333333333, - ?line true = B1 > -3489274937438742190467869234328742398347, - ?line true = B1 > 3.14, - ?line true = B1 > [], - ?line true = B1 > [a], - ?line true = B1 > {a}, - ?line true = B1 > self(), - ?line true = B1 > make_ref(), - ?line true = B1 > xxx, - ?line true = B1 > fun() -> 1 end, - ?line true = B1 > fun erlang:send/2, - - ?line Path = ?config(priv_dir, Config), - ?line AFile = filename:join(Path, "vanilla_file"), - ?line Port = open_port(AFile, [out]), - ?line true = B1 > Port, - - ?line true = B1 >= 0, - ?line true = B1 >= 39827491247298471289473333333333333333333333333333, - ?line true = B1 >= -3489274937438742190467869234328742398347, - ?line true = B1 >= 3.14, - ?line true = B1 >= [], - ?line true = B1 >= [a], - ?line true = B1 >= {a}, - ?line true = B1 >= self(), - ?line true = B1 >= make_ref(), - ?line true = B1 >= xxx, - ?line true = B1 >= fun() -> 1 end, - ?line true = B1 >= fun erlang:send/2, - ?line true = B1 >= Port, + true = B1 > 0, + true = B1 > 39827491247298471289473333333333333333333333333333, + true = B1 > -3489274937438742190467869234328742398347, + true = B1 > 3.14, + true = B1 > [], + true = B1 > [a], + true = B1 > {a}, + true = B1 > self(), + true = B1 > make_ref(), + true = B1 > xxx, + true = B1 > fun() -> 1 end, + true = B1 > fun erlang:send/2, + + Path = proplists:get_value(priv_dir, Config), + AFile = filename:join(Path, "vanilla_file"), + Port = open_port(AFile, [out]), + true = B1 > Port, + + true = B1 >= 0, + true = B1 >= 39827491247298471289473333333333333333333333333333, + true = B1 >= -3489274937438742190467869234328742398347, + true = B1 >= 3.14, + true = B1 >= [], + true = B1 >= [a], + true = B1 >= {a}, + true = B1 >= self(), + true = B1 >= make_ref(), + true = B1 >= xxx, + true = B1 >= fun() -> 1 end, + true = B1 >= fun erlang:send/2, + true = B1 >= Port, ok. @@ -1032,153 +1019,153 @@ unaligned_order(Config) when is_list(Config) -> test_unaligned_order(I, J) -> Align = {I,J}, io:format("~p ~p", [I,J]), - ?line true = test_unaligned_order_1('=:=', <<1,2,3,16#AA,16#7C,4,16#5F,5,16#5A>>, + true = test_unaligned_order_1('=:=', <<1,2,3,16#AA,16#7C,4,16#5F,5,16#5A>>, <<1,2,3,16#AA,16#7C,4,16#5F,5,16#5A>>, Align), - ?line false = test_unaligned_order_1('=/=', <<1,2,3>>, <<1,2,3>>, Align), - ?line true = test_unaligned_order_1('==', <<4,5,6>>, <<4,5,6>>, Align), - ?line false = test_unaligned_order_1('/=', <<1,2,3>>, <<1,2,3>>, Align), + false = test_unaligned_order_1('=/=', <<1,2,3>>, <<1,2,3>>, Align), + true = test_unaligned_order_1('==', <<4,5,6>>, <<4,5,6>>, Align), + false = test_unaligned_order_1('/=', <<1,2,3>>, <<1,2,3>>, Align), - ?line true = test_unaligned_order_1('<', <<1,2>>, <<1,2,3>>, Align), - ?line true = test_unaligned_order_1('=<', <<1,2>>, <<1,2,3>>, Align), - ?line true = test_unaligned_order_1('=<', <<1,2,7,8>>, <<1,2,7,8>>, Align), + true = test_unaligned_order_1('<', <<1,2>>, <<1,2,3>>, Align), + true = test_unaligned_order_1('=<', <<1,2>>, <<1,2,3>>, Align), + true = test_unaligned_order_1('=<', <<1,2,7,8>>, <<1,2,7,8>>, Align), ok. test_unaligned_order_1(Op, A, B, {Aa,Ba}) -> erlang:Op(unaligned_sub_bin(A, Aa), unaligned_sub_bin(B, Ba)). test_terms(Test_Func) -> - ?line Test_Func(atom), - ?line Test_Func(''), - ?line Test_Func('a'), - ?line Test_Func('ab'), - ?line Test_Func('abc'), - ?line Test_Func('abcd'), - ?line Test_Func('abcde'), - ?line Test_Func('abcdef'), - ?line Test_Func('abcdefg'), - ?line Test_Func('abcdefgh'), - - ?line Test_Func(fun() -> ok end), + Test_Func(atom), + Test_Func(''), + Test_Func('a'), + Test_Func('ab'), + Test_Func('abc'), + Test_Func('abcd'), + Test_Func('abcde'), + Test_Func('abcdef'), + Test_Func('abcdefg'), + Test_Func('abcdefgh'), + + Test_Func(fun() -> ok end), X = id([a,{b,c},c]), Y = id({x,y,z}), Z = id(1 bsl 8*257), - ?line Test_Func(fun() -> X end), - ?line Test_Func(fun() -> {X,Y} end), - ?line Test_Func([fun() -> {X,Y,Z} end, + Test_Func(fun() -> X end), + Test_Func(fun() -> {X,Y} end), + Test_Func([fun() -> {X,Y,Z} end, fun() -> {Z,X,Y} end, fun() -> {Y,Z,X} end]), - ?line Test_Func({trace_ts,{even_bigger,{some_data,fun() -> ok end}},{1,2,3}}), - ?line Test_Func({trace_ts,{even_bigger,{some_data,<<1,2,3,4,5,6,7,8,9,10>>}}, + Test_Func({trace_ts,{even_bigger,{some_data,fun() -> ok end}},{1,2,3}}), + Test_Func({trace_ts,{even_bigger,{some_data,<<1,2,3,4,5,6,7,8,9,10>>}}, {1,2,3}}), - ?line Test_Func(1), - ?line Test_Func(42), - ?line Test_Func(-23), - ?line Test_Func(256), - ?line Test_Func(25555), - ?line Test_Func(-3333), + Test_Func(1), + Test_Func(42), + Test_Func(-23), + Test_Func(256), + Test_Func(25555), + Test_Func(-3333), - ?line Test_Func(1.0), + Test_Func(1.0), - ?line Test_Func(183749783987483978498378478393874), - ?line Test_Func(-37894183749783987483978498378478393874), + Test_Func(183749783987483978498378478393874), + Test_Func(-37894183749783987483978498378478393874), Very_Big = very_big_num(), - ?line Test_Func(Very_Big), - ?line Test_Func(-Very_Big+1), - - ?line Test_Func([]), - ?line Test_Func("abcdef"), - ?line Test_Func([a, b, 1, 2]), - ?line Test_Func([a|b]), - - ?line Test_Func({}), - ?line Test_Func({1}), - ?line Test_Func({a, b}), - ?line Test_Func({a, b, c}), - ?line Test_Func(list_to_tuple(lists:seq(0, 255))), - ?line Test_Func(list_to_tuple(lists:seq(0, 256))), - - ?line Test_Func(make_ref()), - ?line Test_Func([make_ref(), make_ref()]), - - ?line Test_Func(make_port()), - - ?line Test_Func(make_pid()), - - ?line Test_Func(Bin0 = list_to_binary(lists:seq(0, 14))), - ?line Test_Func(Bin1 = list_to_binary(lists:seq(0, ?heap_binary_size))), - ?line Test_Func(Bin2 = list_to_binary(lists:seq(0, ?heap_binary_size+1))), - ?line Test_Func(Bin3 = list_to_binary(lists:seq(0, 255))), - - ?line Test_Func(make_unaligned_sub_binary(Bin0)), - ?line Test_Func(make_unaligned_sub_binary(Bin1)), - ?line Test_Func(make_unaligned_sub_binary(Bin2)), - ?line Test_Func(make_unaligned_sub_binary(Bin3)), - - ?line Test_Func(make_sub_binary(lists:seq(42, 43))), - ?line Test_Func(make_sub_binary([42,43,44])), - ?line Test_Func(make_sub_binary([42,43,44,45])), - ?line Test_Func(make_sub_binary([42,43,44,45,46])), - ?line Test_Func(make_sub_binary([42,43,44,45,46,47])), - ?line Test_Func(make_sub_binary([42,43,44,45,46,47,48])), - ?line Test_Func(make_sub_binary(lists:seq(42, 49))), - ?line Test_Func(make_sub_binary(lists:seq(0, 14))), - ?line Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size))), - ?line Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size+1))), - ?line Test_Func(make_sub_binary(lists:seq(0, 255))), - - ?line Test_Func(make_unaligned_sub_binary(lists:seq(42, 43))), - ?line Test_Func(make_unaligned_sub_binary([42,43,44])), - ?line Test_Func(make_unaligned_sub_binary([42,43,44,45])), - ?line Test_Func(make_unaligned_sub_binary([42,43,44,45,46])), - ?line Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47])), - ?line Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47,48])), - ?line Test_Func(make_unaligned_sub_binary(lists:seq(42, 49))), - ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, 14))), - ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size))), - ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size+1))), - ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, 255))), + Test_Func(Very_Big), + Test_Func(-Very_Big+1), + + Test_Func([]), + Test_Func("abcdef"), + Test_Func([a, b, 1, 2]), + Test_Func([a|b]), + + Test_Func({}), + Test_Func({1}), + Test_Func({a, b}), + Test_Func({a, b, c}), + Test_Func(list_to_tuple(lists:seq(0, 255))), + Test_Func(list_to_tuple(lists:seq(0, 256))), + + Test_Func(make_ref()), + Test_Func([make_ref(), make_ref()]), + + Test_Func(make_port()), + + Test_Func(make_pid()), + + Test_Func(Bin0 = list_to_binary(lists:seq(0, 14))), + Test_Func(Bin1 = list_to_binary(lists:seq(0, ?heap_binary_size))), + Test_Func(Bin2 = list_to_binary(lists:seq(0, ?heap_binary_size+1))), + Test_Func(Bin3 = list_to_binary(lists:seq(0, 255))), + + Test_Func(make_unaligned_sub_binary(Bin0)), + Test_Func(make_unaligned_sub_binary(Bin1)), + Test_Func(make_unaligned_sub_binary(Bin2)), + Test_Func(make_unaligned_sub_binary(Bin3)), + + Test_Func(make_sub_binary(lists:seq(42, 43))), + Test_Func(make_sub_binary([42,43,44])), + Test_Func(make_sub_binary([42,43,44,45])), + Test_Func(make_sub_binary([42,43,44,45,46])), + Test_Func(make_sub_binary([42,43,44,45,46,47])), + Test_Func(make_sub_binary([42,43,44,45,46,47,48])), + Test_Func(make_sub_binary(lists:seq(42, 49))), + Test_Func(make_sub_binary(lists:seq(0, 14))), + Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size))), + Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size+1))), + Test_Func(make_sub_binary(lists:seq(0, 255))), + + Test_Func(make_unaligned_sub_binary(lists:seq(42, 43))), + Test_Func(make_unaligned_sub_binary([42,43,44])), + Test_Func(make_unaligned_sub_binary([42,43,44,45])), + Test_Func(make_unaligned_sub_binary([42,43,44,45,46])), + Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47])), + Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47,48])), + Test_Func(make_unaligned_sub_binary(lists:seq(42, 49))), + Test_Func(make_unaligned_sub_binary(lists:seq(0, 14))), + Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size))), + Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size+1))), + Test_Func(make_unaligned_sub_binary(lists:seq(0, 255))), %% Bit level binaries. - ?line Test_Func(<<1:1>>), - ?line Test_Func(<<2:2>>), - ?line Test_Func(<<42:10>>), - ?line Test_Func(list_to_bitstring([<<5:6>>|lists:seq(0, 255)])), + Test_Func(<<1:1>>), + Test_Func(<<2:2>>), + Test_Func(<<42:10>>), + Test_Func(list_to_bitstring([<<5:6>>|lists:seq(0, 255)])), - ?line Test_Func(F = fun(A) -> 42*A end), - ?line Test_Func(lists:duplicate(32, F)), + Test_Func(F = fun(A) -> 42*A end), + Test_Func(lists:duplicate(32, F)), - ?line Test_Func(FF = fun binary_SUITE:all/0), - ?line Test_Func(lists:duplicate(32, FF)), + Test_Func(FF = fun binary_SUITE:all/0), + Test_Func(lists:duplicate(32, FF)), ok. test_floats(Test_Func) -> - ?line Test_Func(5.5), - ?line Test_Func(-15.32), - ?line Test_Func(1.2435e25), - ?line Test_Func(1.2333e-20), - ?line Test_Func(199.0e+15), + Test_Func(5.5), + Test_Func(-15.32), + Test_Func(1.2435e25), + Test_Func(1.2333e-20), + Test_Func(199.0e+15), ok. very_big_num() -> very_big_num(33, 1). very_big_num(Left, Result) when Left > 0 -> - ?line very_big_num(Left-1, Result*256); + very_big_num(Left-1, Result*256); very_big_num(0, Result) -> - ?line Result. + Result. make_port() -> - ?line open_port({spawn, efile}, [eof]). + open_port({spawn, efile}, [eof]). make_pid() -> - ?line spawn_link(?MODULE, sleeper, []). + spawn_link(?MODULE, sleeper, []). sleeper() -> - ?line receive after infinity -> ok end. + receive after infinity -> ok end. %% Test that binaries are garbage collected properly. @@ -1218,7 +1205,7 @@ gc_test1(Pid) -> receive {Pid,done} -> ok after 10000 -> - ?line ?t:fail() + ct:fail("timeout") end. %% Like split binary, but returns REFC binaries. Only useful for gc_test/1. @@ -1237,7 +1224,7 @@ gc() -> gc1() -> ok. bit_sized_binary_sizes(Config) when is_list(Config) -> - ?line [bsbs_1(A) || A <- lists:seq(1, 8)], + [bsbs_1(A) || A <- lists:seq(1, 8)], ok. bsbs_1(A) -> @@ -1279,13 +1266,13 @@ obsolete_funs(Config) when is_list(Config) -> X = id({1,2,3}), Y = id([a,b,c,d]), Z = id({x,y,z}), - ?line obsolete_fun(fun() -> ok end), - ?line obsolete_fun(fun() -> X end), - ?line obsolete_fun(fun(A) -> {A,X} end), - ?line obsolete_fun(fun() -> {X,Y} end), - ?line obsolete_fun(fun() -> {X,Y,Z} end), + obsolete_fun(fun() -> ok end), + obsolete_fun(fun() -> X end), + obsolete_fun(fun(A) -> {A,X} end), + obsolete_fun(fun() -> {X,Y} end), + obsolete_fun(fun() -> {X,Y,Z} end), - ?line obsolete_fun(fun ?MODULE:all/1), + obsolete_fun(fun ?MODULE:all/1), erts_debug:set_internal_state(available_internal_state, false), ok. @@ -1312,41 +1299,41 @@ no_fun_roundtrip(Term) -> %% but recognized by binary_to_term/1. robustness(Config) when is_list(Config) -> - ?line [] = binary_to_term_stress(<<131,107,0,0>>), %Empty string. - ?line [] = binary_to_term_stress(<<131,108,0,0,0,0,106>>), %Zero-length list. + [] = binary_to_term_stress(<<131,107,0,0>>), %Empty string. + [] = binary_to_term_stress(<<131,108,0,0,0,0,106>>), %Zero-length list. %% {[],a} where [] is a zero-length list. - ?line {[],a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,106,100,0,1,97>>), + {[],a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,106,100,0,1,97>>), %% {42,a} where 42 is a zero-length list with 42 in the tail. - ?line {42,a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,97,42,100,0,1,97>>), + {42,a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,97,42,100,0,1,97>>), %% {{x,y},a} where {x,y} is a zero-length list with {x,y} in the tail. - ?line {{x,y},a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0, + {{x,y},a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0, 104,2,100,0,1,120,100,0,1, 121,100,0,1,97>>), %% Bignums fitting in 32 bits. - ?line 16#7FFFFFFF = binary_to_term_stress(<<131,98,127,255,255,255>>), - ?line -1 = binary_to_term_stress(<<131,98,255,255,255,255>>), + 16#7FFFFFFF = binary_to_term_stress(<<131,98,127,255,255,255>>), + -1 = binary_to_term_stress(<<131,98,255,255,255,255>>), ok. %% OTP-8180: Test several terms that have been known to crash the emulator. %% (Thanks to Scott Lystig Fritchie.) otp_8180(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line Wc = filename:join(Data, "zzz.*"), + Data = proplists:get_value(data_dir, Config), + Wc = filename:join(Data, "zzz.*"), Files = filelib:wildcard(Wc), [run_otp_8180(F) || F <- Files], ok. run_otp_8180(Name) -> io:format("~s", [Name]), - ?line {ok,Bins} = file:consult(Name), + {ok,Bins} = file:consult(Name), [begin io:format("~p\n", [Bin]), - ?line {'EXIT',{badarg,_}} = (catch binary_to_term_stress(Bin)) + {'EXIT',{badarg,_}} = (catch binary_to_term_stress(Bin)) end || Bin <- Bins], ok. @@ -1518,7 +1505,7 @@ cmp_old_impl(Config) when is_list(Config) -> false -> {skipped, "No "++Rel++" available"}; true -> - {ok, Node} = ?t:start_node(list_to_atom(atom_to_list(?MODULE)++"_"++Rel), + {ok, Node} = test_server:start_node(list_to_atom(atom_to_list(?MODULE)++"_"++Rel), peer, [{args, " -setcookie "++Cookie}, {erl, [{release, Rel}]}]), @@ -1560,7 +1547,7 @@ cmp_old_impl(Config) when is_list(Config) -> cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(1000000)))]}), cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(10000000)))]}), - ?t:stop_node(Node), + test_server:stop_node(Node), ok end. @@ -1604,7 +1591,7 @@ bit_sized_binary(Bin0) -> unaligned_sub_bin(Bin, 0) -> Bin; unaligned_sub_bin(Bin0, Offs) -> - F = random:uniform(256), + F = rand:uniform(256), Roffs = 8-Offs, Bin1 = <<F:Offs,Bin0/binary,F:Roffs>>, Sz = size(Bin0), diff --git a/erts/emulator/test/bs_bincomp_SUITE.erl b/erts/emulator/test/bs_bincomp_SUITE.erl index dcd13c19df..c481e93e41 100644 --- a/erts/emulator/test/bs_bincomp_SUITE.erl +++ b/erts/emulator/test/bs_bincomp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -131,7 +131,7 @@ tracing(Config) when is_list(Config) -> random_binary() -> Seq = [1,2,3,4,5,6,7,8,9,10], - << <<($a + random:uniform($z - $a)):8>> || _ <- Seq >>. + << <<($a + rand:uniform($z - $a)):8>> || _ <- Seq >>. random_binaries(N) when N > 0 -> random_binary(), diff --git a/erts/emulator/test/bs_bit_binaries_SUITE.erl b/erts/emulator/test/bs_bit_binaries_SUITE.erl index a07fd7609c..d393bc5b91 100644 --- a/erts/emulator/test/bs_bit_binaries_SUITE.erl +++ b/erts/emulator/test/bs_bit_binaries_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -30,7 +30,7 @@ big_binary_to_and_from_list/1,send_and_receive/1, send_and_receive_alot/1,append/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -57,9 +57,9 @@ end_per_group(_GroupName, Config) -> misc(Config) when is_list(Config) -> - ?line <<1:100>> = id(<<1:100>>), - ?line {ok,ok} = {match(7),match(9)}, - ?line {ok,ok} = {match1(15),match1(31)}, + <<1:100>> = id(<<1:100>>), + {ok,ok} = {match(7),match(9)}, + {ok,ok} = {match1(15),match1(31)}, ok. @@ -76,70 +76,70 @@ match1(N) -> ok. test_bit_size(Config) when is_list(Config) -> - ?line 101 = bit_size(<<1:101>>), - ?line 1001 = bit_size(<<1:1001>>), - ?line 80 = bit_size(<<1:80>>), - ?line 800 = bit_size(<<1:800>>), - ?line Bin = <<0:16#1000000>>, - ?line BigBin = list_to_bitstring([Bin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), - ?line 16#10000001 = erlang:bit_size(BigBin), + 101 = bit_size(<<1:101>>), + 1001 = bit_size(<<1:1001>>), + 80 = bit_size(<<1:80>>), + 800 = bit_size(<<1:800>>), + Bin = <<0:16#1000000>>, + BigBin = list_to_bitstring([Bin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), + 16#10000001 = erlang:bit_size(BigBin), %% Only run these on computers with lots of memory %% HugeBin = list_to_bitstring([BigBin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), %% 16#100000011 = bit_size(HugeBin), - ?line 0 = bit_size(<<>>), + 0 = bit_size(<<>>), ok. horrid_match(Config) when is_list(Config) -> - ?line <<1:4,B:24/bitstring>> = <<1:4,42:24/little>>, - ?line <<42:24/little>> = B, + <<1:4,B:24/bitstring>> = <<1:4,42:24/little>>, + <<42:24/little>> = B, ok. test_bitstr(Config) when is_list(Config) -> - ?line <<1:7,B/bitstring>> = <<1:7,<<1:1,6>>/bitstring>>, - ?line <<1:1,6>> = B, - ?line B = <<1:1,6>>, + <<1:7,B/bitstring>> = <<1:7,<<1:1,6>>/bitstring>>, + <<1:1,6>> = B, + B = <<1:1,6>>, ok. asymmetric_tests(Config) when is_list(Config) -> - ?line <<1:12>> = <<0,1:4>>, - ?line <<0,1:4>> = <<1:12>>, - ?line <<1:1,X/bitstring>> = <<128,255,0,0:2>>, - ?line <<1,254,0,0:1>> = X, - ?line X = <<1,254,0,0:1>>, - ?line <<1:1,X1:25/bitstring>> = <<128,255,0,0:2>>, - ?line <<1,254,0,0:1>> = X1, - ?line X1 = <<1,254,0,0:1>>, + <<1:12>> = <<0,1:4>>, + <<0,1:4>> = <<1:12>>, + <<1:1,X/bitstring>> = <<128,255,0,0:2>>, + <<1,254,0,0:1>> = X, + X = <<1,254,0,0:1>>, + <<1:1,X1:25/bitstring>> = <<128,255,0,0:2>>, + <<1,254,0,0:1>> = X1, + X1 = <<1,254,0,0:1>>, ok. big_asymmetric_tests(Config) when is_list(Config) -> - ?line <<1:875,1:12>> = <<1:875,0,1:4>>, - ?line <<1:875,0,1:4>> = <<1:875,1:12>>, - ?line <<1:1,X/bitstring>> = <<128,255,0,0:2,1:875>>, - ?line <<1,254,0,0:1,1:875>> = X, - ?line X = <<1,254,0,0:1,1:875>>, - ?line <<1:1,X1:900/bitstring>> = <<128,255,0,0:2,1:875>>, - ?line <<1,254,0,0:1,1:875>> = X1, - ?line X1 = <<1,254,0,0:1,1:875>>, + <<1:875,1:12>> = <<1:875,0,1:4>>, + <<1:875,0,1:4>> = <<1:875,1:12>>, + <<1:1,X/bitstring>> = <<128,255,0,0:2,1:875>>, + <<1,254,0,0:1,1:875>> = X, + X = <<1,254,0,0:1,1:875>>, + <<1:1,X1:900/bitstring>> = <<128,255,0,0:2,1:875>>, + <<1,254,0,0:1,1:875>> = X1, + X1 = <<1,254,0,0:1,1:875>>, ok. binary_to_and_from_list(Config) when is_list(Config) -> - ?line <<1,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1,2,3,4,1:1>>)), - ?line [1,2,3,4,<<1:1>>] = bitstring_to_list(<<1,2,3,4,1:1>>), - ?line <<1:1,1,2,3,4>> = list_to_bitstring([<<1:1>>,1,2,3,4]), - ?line [128,129,1,130,<<0:1>>] = bitstring_to_list(<<1:1,1,2,3,4>>), + <<1,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1,2,3,4,1:1>>)), + [1,2,3,4,<<1:1>>] = bitstring_to_list(<<1,2,3,4,1:1>>), + <<1:1,1,2,3,4>> = list_to_bitstring([<<1:1>>,1,2,3,4]), + [128,129,1,130,<<0:1>>] = bitstring_to_list(<<1:1,1,2,3,4>>), ok. big_binary_to_and_from_list(Config) when is_list(Config) -> - ?line <<1:800,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1:800,2,3,4,1:1>>)), - ?line [1,2,3,4|_Rest1] = bitstring_to_list(<<1,2,3,4,1:800,1:1>>), - ?line <<1:801,1,2,3,4>> = list_to_bitstring([<<1:801>>,1,2,3,4]), + <<1:800,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1:800,2,3,4,1:1>>)), + [1,2,3,4|_Rest1] = bitstring_to_list(<<1,2,3,4,1:800,1:1>>), + <<1:801,1,2,3,4>> = list_to_bitstring([<<1:801>>,1,2,3,4]), ok. send_and_receive(Config) when is_list(Config) -> - ?line Bin = <<1,2:7>>, + Bin = <<1,2:7>>, Pid = spawn_link(fun() -> receiver(Bin) end), - ?line Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}, - ?line receive + Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}, + receive ok -> ok end. @@ -176,8 +176,8 @@ receiver_alot(Bin) -> append(Config) when is_list(Config) -> cs_init(), - ?line <<(-1):256/signed-unit:8>> = cs(do_append(id(<<>>), 256*8)), - ?line <<(-1):256/signed-unit:8>> = cs(do_append2(id(<<>>), 256*4)), + <<(-1):256/signed-unit:8>> = cs(do_append(id(<<>>), 256*8)), + <<(-1):256/signed-unit:8>> = cs(do_append2(id(<<>>), 256*4)), <<(-1):256/signed-unit:8>> = cs(do_append3(id(<<>>), 256*8)), cs_end(). diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl index 7ed99f5b4e..941cb435f7 100644 --- a/erts/emulator/test/bs_construct_SUITE.erl +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,8 +22,7 @@ -module(bs_construct_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, test1/1, test2/1, test3/1, test4/1, test5/1, testf/1, not_used/1, in_guard/1, mem_leak/1, coerce_to_float/1, bjorn/1, @@ -31,9 +30,11 @@ copy_writable_binary/1, kostis/1, dynamic/1, bs_add/1, otp_7422/1, zero_width/1, bad_append/1, bs_add_overflow/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 10}}]. all() -> [test1, test2, test3, test4, test5, testf, not_used, @@ -42,21 +43,6 @@ all() -> copy_writable_binary, kostis, dynamic, bs_add, otp_7422, zero_width, bad_append, bs_add_overflow]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - big(1) -> 57285702734876389752897683. @@ -68,9 +54,9 @@ r(L) -> -define(T(B, L), {B, ??B, L}). -define(N(B), {B, ??B, unknown}). --define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])). +-define(FAIL(Expr), fail_check(catch Expr, ??Expr, [])). --define(FAIL_VARS(Expr, Vars), ?line fail_check(catch Expr, ??Expr, Vars)). +-define(FAIL_VARS(Expr, Vars), fail_check(catch Expr, ??Expr, Vars)). l(I_13, I_big1) -> [ @@ -189,7 +175,7 @@ one_test({C_bin, E_bin, Str, Bytes}) when is_list(Bytes) -> true -> io:format("ERROR: Compiled: ~p. Expected ~p. Got ~p.~n", [Str, Bytes, binary_to_list(C_bin)]), - test_server:fail(comp) + ct:fail(comp) end, if E_bin == Bin -> @@ -197,7 +183,7 @@ one_test({C_bin, E_bin, Str, Bytes}) when is_list(Bytes) -> true -> io:format("ERROR: Interpreted: ~p. Expected ~p. Got ~p.~n", [Str, Bytes, binary_to_list(E_bin)]), - test_server:fail(comp) + ct:fail(comp) end; one_test({C_bin, E_bin, Str, Result}) -> io:format(" ~s ~p~n", [Str, C_bin]), @@ -218,7 +204,7 @@ one_test({C_bin, E_bin, Str, Result}) -> io:format("ERROR: Compiled not equal to interpreted:" "~n ~p, ~p.~n", [binary_to_list(C_bin), binary_to_list(E_bin)]), - test_server:fail(comp); + ct:fail(comp); 0 -> ok; %% For situations where the final bits may not matter, like @@ -253,23 +239,22 @@ fail_check({'EXIT',{badarg,_}}, Str, Vars) -> try evaluate(Str, Vars) of Res -> io:format("Interpreted result: ~p", [Res]), - ?t:fail(did_not_fail_in_intepreted_code) + ct:fail(did_not_fail_in_intepreted_code) catch error:badarg -> ok end; fail_check(Res, _, _) -> io:format("Compiled result: ~p", [Res]), - ?t:fail(did_not_fail_in_compiled_code). + ct:fail(did_not_fail_in_compiled_code). %%% Simple working cases -test1(suite) -> []; test1(Config) when is_list(Config) -> - ?line I_13 = i(13), - ?line I_big1 = big(1), - ?line Vars = [{'I_13', I_13}, + I_13 = i(13), + I_big1 = big(1), + Vars = [{'I_13', I_13}, {'I_big1', I_big1}], - ?line lists:foreach(fun one_test/1, eval_list(l(I_13, I_big1), Vars)). + lists:foreach(fun one_test/1, eval_list(l(I_13, I_big1), Vars)). %%% Misc @@ -285,10 +270,9 @@ gen(N, S, A) -> gen_l(N, S, A) -> [?T(<<A:S/little, A:(N-S)/little>>, comp(N, A, S))]. -test2(suite) -> []; test2(Config) when is_list(Config) -> - ?line test2(0, 8, 2#10101010101010101), - ?line test2(0, 8, 2#1111111111). + test2(0, 8, 2#10101010101010101), + test2(0, 8, 2#1111111111). test2(End, End, _) -> ok; @@ -313,10 +297,9 @@ t3() -> ?N(<<>>) ]. -test3(suite) -> []; test3(Config) when is_list(Config) -> - ?line Vars = [], - ?line lists:foreach(fun one_test/1, eval_list(t3(), Vars)). + Vars = [], + lists:foreach(fun one_test/1, eval_list(t3(), Vars)). gen_u(N, S, A) -> [?N(<<A:S, A:(N-S)>>)]. @@ -324,10 +307,9 @@ gen_u(N, S, A) -> gen_u_l(N, S, A) -> [?N(<<A:S/little, A:(N-S)/little>>)]. -test4(suite) -> []; test4(Config) when is_list(Config) -> - ?line test4(0, 16, 2#10101010101010101), - ?line test4(0, 16, 2#1111111111). + test4(0, 16, 2#10101010101010101), + test4(0, 16, 2#1111111111). test4(End, End, _) -> ok; @@ -345,11 +327,10 @@ gen_b(N, S, A) -> [?T(<<A:S/binary-unit:1, A:(N-S)/binary-unit:1>>, binary_to_list(<<A:S/binary-unit:1, A:(N-S)/binary-unit:1>>))]. -test5(suite) -> []; -test5(doc) -> ["OTP-3995"]; +%% OTP-3995 test5(Config) when is_list(Config) -> - ?line test5(0, 8, <<73>>), - ?line test5(0, 8, <<68>>). + test5(0, 8, <<73>>), + test5(0, 8, <<68>>). test5(End, End, _) -> ok; @@ -363,47 +344,46 @@ test5(S, A) -> lists:foreach(fun one_test/1, eval_list(gen_b(N, S, A), Vars)). %%% Failure cases -testf(suite) -> []; testf(Config) when is_list(Config) -> - ?line ?FAIL(<<3.14>>), - ?line ?FAIL(<<<<1,2>>>>), + ?FAIL(<<3.14>>), + ?FAIL(<<<<1,2>>>>), - ?line ?FAIL(<<2.71/binary>>), - ?line ?FAIL(<<24334/binary>>), - ?line ?FAIL(<<24334344294788947129487129487219847/binary>>), + ?FAIL(<<2.71/binary>>), + ?FAIL(<<24334/binary>>), + ?FAIL(<<24334344294788947129487129487219847/binary>>), BigInt = id(24334344294788947129487129487219847), - ?line ?FAIL_VARS(<<BigInt/binary>>, [{'BigInt',BigInt}]), - ?line ?FAIL_VARS(<<42,BigInt/binary>>, [{'BigInt',BigInt}]), - ?line ?FAIL_VARS(<<BigInt:2/binary>>, [{'BigInt',BigInt}]), + ?FAIL_VARS(<<BigInt/binary>>, [{'BigInt',BigInt}]), + ?FAIL_VARS(<<42,BigInt/binary>>, [{'BigInt',BigInt}]), + ?FAIL_VARS(<<BigInt:2/binary>>, [{'BigInt',BigInt}]), %% One negative field size, but the sum of field sizes will be 1 byte. %% Make sure that we reject that properly. I_minus_777 = id(-777), I_minus_2047 = id(-2047), - ?line ?FAIL_VARS(<<I_minus_777:2048/unit:8,57:I_minus_2047/unit:8>>, + ?FAIL_VARS(<<I_minus_777:2048/unit:8,57:I_minus_2047/unit:8>>, ordsets:from_list([{'I_minus_777',I_minus_777}, {'I_minus_2047',I_minus_2047}])), - ?line ?FAIL(<<<<1,2,3>>/float>>), + ?FAIL(<<<<1,2,3>>/float>>), %% Negative field widths. - ?line testf_1(-8, <<1,2,3,4,5>>), - ?line ?FAIL(<<0:(-(1 bsl 100))>>), + testf_1(-8, <<1,2,3,4,5>>), + ?FAIL(<<0:(-(1 bsl 100))>>), - ?line ?FAIL(<<42:(-16)>>), - ?line ?FAIL(<<3.14:(-8)/float>>), - ?line ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>), - ?line ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>), - ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>), - ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>), + ?FAIL(<<42:(-16)>>), + ?FAIL(<<3.14:(-8)/float>>), + ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>), + ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>), + ?FAIL(<<<<23,56,0,2>>:(anka)>>), + ?FAIL(<<<<23,56,0,2>>:(anka)>>), %% Unit failures. - ?line ?FAIL(<<<<1:1>>/binary>>), + ?FAIL(<<<<1:1>>/binary>>), Sz = id(1), - ?line ?FAIL_VARS(<<<<1:Sz>>/binary>>, [{'Sz',Sz}]), - ?line {'EXIT',{badarg,_}} = (catch <<<<1:(id(1))>>/binary>>), - ?line ?FAIL(<<<<7,8,9>>/binary-unit:16>>), - ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:16>>), - ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:17>>), + ?FAIL_VARS(<<<<1:Sz>>/binary>>, [{'Sz',Sz}]), + {'EXIT',{badarg,_}} = (catch <<<<1:(id(1))>>/binary>>), + ?FAIL(<<<<7,8,9>>/binary-unit:16>>), + ?FAIL(<<<<7,8,9,3:7>>/binary-unit:16>>), + ?FAIL(<<<<7,8,9,3:7>>/binary-unit:17>>), ok. @@ -413,14 +393,13 @@ testf_1(W, B) -> ?FAIL_VARS(<<3.14:W/float>>, Vars), ?FAIL_VARS(<<B:W/binary>>, [{'B',B}|Vars]). -not_used(doc) -> - "Test that constructed binaries that are not used will still give an exception."; +%% Test that constructed binaries that are not used will still give an exception. not_used(Config) when is_list(Config) -> - ?line ok = not_used1(3, <<"dum">>), - ?line {'EXIT',{badarg,_}} = (catch not_used1(3, "dum")), - ?line {'EXIT',{badarg,_}} = (catch not_used2(444, -2)), - ?line {'EXIT',{badarg,_}} = (catch not_used2(444, anka)), - ?line {'EXIT',{badarg,_}} = (catch not_used3(444)), + ok = not_used1(3, <<"dum">>), + {'EXIT',{badarg,_}} = (catch not_used1(3, "dum")), + {'EXIT',{badarg,_}} = (catch not_used2(444, -2)), + {'EXIT',{badarg,_}} = (catch not_used2(444, anka)), + {'EXIT',{badarg,_}} = (catch not_used3(444)), ok. not_used1(I, BinString) -> @@ -436,11 +415,11 @@ not_used3(I) -> ok. in_guard(Config) when is_list(Config) -> - ?line 1 = in_guard(<<16#74ad:16>>, 16#e95, 5), - ?line 2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>), - ?line 3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415), - ?line 3 = in_guard(<<16#FBCD:14,3/float,3:2>>, 16#FBCD, 3), - ?line 3 = in_guard(<<16#FBCD:14,(2 bsl 226)/float,3:2>>, 16#FBCD, 2 bsl 226), + 1 = in_guard(<<16#74ad:16>>, 16#e95, 5), + 2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>), + 3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415), + 3 = in_guard(<<16#FBCD:14,3/float,3:2>>, 16#FBCD, 3), + 3 = in_guard(<<16#FBCD:14,(2 bsl 226)/float,3:2>>, 16#FBCD, 2 bsl 226), nope = in_guard(<<1>>, 42, b), nope = in_guard(<<1>>, a, b), nope = in_guard(<<1,2>>, 1, 1), @@ -454,16 +433,16 @@ in_guard(Bin, A, B) when <<A:14,B/float,3:2>> == Bin -> 3; in_guard(Bin, A, B) when {a,b,<<A:14,B/float,3:2>>} == Bin -> cant_happen; in_guard(_, _, _) -> nope. -mem_leak(doc) -> "Make sure that construction has no memory leak"; +%% Make sure that construction has no memory leak mem_leak(Config) when is_list(Config) -> - ?line B = make_bin(16, <<0>>), - ?line mem_leak(1024, B), + B = make_bin(16, <<0>>), + mem_leak(1024, B), ok. mem_leak(0, _) -> ok; mem_leak(N, B) -> - ?line big_bin(B, <<23>>), - ?line {'EXIT',{badarg,_}} = (catch big_bin(B, bad)), + big_bin(B, <<23>>), + {'EXIT',{badarg,_}} = (catch big_bin(B, bad)), mem_leak(N-1, B). big_bin(B1, B2) -> @@ -477,18 +456,18 @@ make_bin(0, Acc) -> Acc; make_bin(N, Acc) -> make_bin(N-1, <<Acc/binary,Acc/binary>>). -define(COF(Int0), - ?line (fun(Int) -> + (fun(Int) -> true = <<Int:32/float>> =:= <<(float(Int)):32/float>>, true = <<Int:64/float>> =:= <<(float(Int)):64/float>> end)(nonliteral(Int0)), - ?line true = <<Int0:32/float>> =:= <<(float(Int0)):32/float>>, - ?line true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>). + true = <<Int0:32/float>> =:= <<(float(Int0)):32/float>>, + true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>). -define(COF64(Int0), - ?line (fun(Int) -> + (fun(Int) -> true = <<Int:64/float>> =:= <<(float(Int)):64/float>> end)(nonliteral(Int0)), - ?line true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>). + true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>). nonliteral(X) -> X. @@ -507,7 +486,7 @@ coerce_to_float(Config) when is_list(Config) -> ok. bjorn(Config) when is_list(Config) -> - ?line error = bjorn_1(), + error = bjorn_1(), ok. bjorn_1() -> @@ -535,46 +514,47 @@ do_something() -> throw(blurf). huge_float_field(Config) when is_list(Config) -> - ?line {'EXIT',{badarg,_}} = (catch <<0.0:9/float-unit:8>>), - ?line huge_float_check(catch <<0.0:67108865/float-unit:64>>), - ?line huge_float_check(catch <<0.0:((1 bsl 26)+1)/float-unit:64>>), - ?line huge_float_check(catch <<0.0:(id(67108865))/float-unit:64>>), -%% ?line huge_float_check(catch <<0.0:((1 bsl 60)+1)/float-unit:64>>), - ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 26)+1)/float-unit:64>>), -%% ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 60)+1)/float-unit:64>>), + {'EXIT',{badarg,_}} = (catch <<0.0:9/float-unit:8>>), + huge_float_check(catch <<0.0:67108865/float-unit:64>>), + huge_float_check(catch <<0.0:((1 bsl 26)+1)/float-unit:64>>), + huge_float_check(catch <<0.0:(id(67108865))/float-unit:64>>), +%% huge_float_check(catch <<0.0:((1 bsl 60)+1)/float-unit:64>>), + huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 26)+1)/float-unit:64>>), +%% huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 60)+1)/float-unit:64>>), ok. huge_float_check({'EXIT',{system_limit,_}}) -> ok; huge_float_check({'EXIT',{badarg,_}}) -> ok. huge_binary(Config) when is_list(Config) -> - ?line 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>), - ?line garbage_collect(), + ct:timetrap({seconds, 30}), + 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>), + garbage_collect(), {Shift,Return} = case free_mem() of undefined -> %% This test has to be inlined inside the case to %% use a literal Shift - ?line garbage_collect(), - ?line id(<<0:((1 bsl 32)-1)>>), + garbage_collect(), + id(<<0:((1 bsl 32)-1)>>), {32,ok}; Mb when Mb > 600 -> - ?line garbage_collect(), - ?line id(<<0:((1 bsl 32)-1)>>), + garbage_collect(), + id(<<0:((1 bsl 32)-1)>>), {32,ok}; Mb when Mb > 300 -> - ?line garbage_collect(), - ?line id(<<0:((1 bsl 31)-1)>>), + garbage_collect(), + id(<<0:((1 bsl 31)-1)>>), {31,"Limit huge binaries to 256 Mb"}; _ -> - ?line garbage_collect(), - ?line id(<<0:((1 bsl 30)-1)>>), + garbage_collect(), + id(<<0:((1 bsl 30)-1)>>), {30,"Limit huge binary to 128 Mb"} end, - ?line garbage_collect(), - ?line id(<<0:((1 bsl Shift)-1)>>), - ?line garbage_collect(), - ?line id(<<0:(id((1 bsl Shift)-1))>>), - ?line garbage_collect(), + garbage_collect(), + id(<<0:((1 bsl Shift)-1)>>), + garbage_collect(), + id(<<0:(id((1 bsl Shift)-1))>>), + garbage_collect(), case Return of ok -> ok; Comment -> {comment, Comment} @@ -609,16 +589,16 @@ free_mem() -> system_limit(Config) when is_list(Config) -> WordSize = erlang:system_info(wordsize), BitsPerWord = WordSize * 8, - ?line {'EXIT',{system_limit,_}} = + {'EXIT',{system_limit,_}} = (catch <<0:(id(0)),42:(id(1 bsl BitsPerWord))>>), - ?line {'EXIT',{system_limit,_}} = + {'EXIT',{system_limit,_}} = (catch <<42:(id(1 bsl BitsPerWord)),0:(id(0))>>), - ?line {'EXIT',{system_limit,_}} = + {'EXIT',{system_limit,_}} = (catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>), %% Would fail to load. - ?line {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 67)>>), - ?line {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 64)+1)>>), + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 67)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 64)+1)>>), case WordSize of 4 -> @@ -628,60 +608,59 @@ system_limit(Config) when is_list(Config) -> end. system_limit_32() -> - ?line {'EXIT',{badarg,_}} = (catch <<42:(-1)>>), - ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>), - ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>), - ?line {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), - ?line {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), - ?line {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), - ?line {'EXIT',{system_limit,_}} = + {'EXIT',{badarg,_}} = (catch <<42:(-1)>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), %% The size would be silently truncated, resulting in a crash. - ?line {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 35)>>), - ?line {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 32)+1)>>), + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 35)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 32)+1)>>), %% Would fail to load. - ?line {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>), - ?line {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>), + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>), ok. badarg(Config) when is_list(Config) -> - ?line {'EXIT',{badarg,_}} = + {'EXIT',{badarg,_}} = (catch <<0:(id(1 bsl 100)),0:(id(-1))>>), - ?line {'EXIT',{badarg,_}} = + {'EXIT',{badarg,_}} = (catch <<0:(id(1 bsl 100)),0:(id(-(1 bsl 70)))>>), - ?line {'EXIT',{badarg,_}} = + {'EXIT',{badarg,_}} = (catch <<0:(id(-(1 bsl 70))),0:(id(1 bsl 100))>>), - ?line {'EXIT',{badarg,_}} = + {'EXIT',{badarg,_}} = (catch <<(id(<<>>))/binary,0:(id(-(1 bsl 100)))>>), ok. copy_writable_binary(Config) when is_list(Config) -> - ?line [copy_writable_binary_1(I) || I <- lists:seq(0, 256)], + [copy_writable_binary_1(I) || I <- lists:seq(0, 256)], ok. copy_writable_binary_1(_) -> - ?line Bin0 = <<(id(<<>>))/binary,0,1,2,3,4,5,6,7>>, - ?line SubBin = make_sub_bin(Bin0), - ?line id(<<42,34,55,Bin0/binary>>), %Make reallocation likelier. - ?line Pid = spawn(fun() -> + Bin0 = <<(id(<<>>))/binary,0,1,2,3,4,5,6,7>>, + SubBin = make_sub_bin(Bin0), + id(<<42,34,55,Bin0/binary>>), %Make reallocation likelier. + Pid = spawn(fun() -> copy_writable_binary_holder(Bin0, SubBin) end), - ?line Tab = ets:new(holder, []), - ?line ets:insert(Tab, {17,Bin0}), - ?line ets:insert(Tab, {42,SubBin}), - ?line id(<<Bin0/binary,0:(64*1024*8)>>), - ?line Pid ! self(), - ?line [{17,Bin0}] = ets:lookup(Tab, 17), - ?line [{42,Bin0}] = ets:lookup(Tab, 42), + Tab = ets:new(holder, []), + ets:insert(Tab, {17,Bin0}), + ets:insert(Tab, {42,SubBin}), + id(<<Bin0/binary,0:(64*1024*8)>>), + Pid ! self(), + [{17,Bin0}] = ets:lookup(Tab, 17), + [{42,Bin0}] = ets:lookup(Tab, 42), receive {Pid,Bin0,Bin0} -> ok; Other -> - io:format("Unexpected message: ~p", [Other]), - ?line ?t:fail() + ct:fail("Unexpected message: ~p", [Other]) end, ok. @@ -722,8 +701,8 @@ have_250_terabytes_of_ram() -> false. %% give the same result. dynamic(Config) when is_list(Config) -> - ?line dynamic_1(fun dynamic_big/5), - ?line dynamic_1(fun dynamic_little/5), + dynamic_1(fun dynamic_big/5), + dynamic_1(fun dynamic_little/5), ok. dynamic_1(Dynamic) -> @@ -802,32 +781,32 @@ bs_add(Config) when is_list(Config) -> return], %% Write assembly file and assemble it. - ?line PrivDir = ?config(priv_dir, Config), - ?line RootName = filename:join(PrivDir, atom_to_list(Mod)), - ?line AsmFile = RootName ++ ".S", - ?line {ok,Fd} = file:open(AsmFile, [write]), - ?line [io:format(Fd, "~p. \n", [T]) || T <- Code], - ?line ok = file:close(Fd), - ?line {ok,Mod} = compile:file(AsmFile, [from_asm,report,{outdir,PrivDir}]), - ?line LoadRc = code:load_abs(RootName), - ?line {module,_Module} = LoadRc, + PrivDir = proplists:get_value(priv_dir, Config), + RootName = filename:join(PrivDir, atom_to_list(Mod)), + AsmFile = RootName ++ ".S", + {ok,Fd} = file:open(AsmFile, [write]), + [io:format(Fd, "~p. \n", [T]) || T <- Code], + ok = file:close(Fd), + {ok,Mod} = compile:file(AsmFile, [from_asm,report,{outdir,PrivDir}]), + LoadRc = code:load_abs(RootName), + {module,_Module} = LoadRc, %% Find smallest positive bignum. - ?line SmallestBig = smallest_big(), - ?line io:format("~p\n", [SmallestBig]), - ?line Expected = SmallestBig + N, + SmallestBig = smallest_big(), + io:format("~p\n", [SmallestBig]), + Expected = SmallestBig + N, DoTest = fun() -> exit(Mod:bs_add(SmallestBig, -SmallestBig)) end, - ?line {Pid,Mref} = spawn_monitor(DoTest), + {Pid,Mref} = spawn_monitor(DoTest), receive {'DOWN',Mref,process,Pid,Res} -> ok end, - ?line Expected = Res, + Expected = Res, %% Clean up. - ?line ok = file:delete(AsmFile), - ?line ok = file:delete(code:which(Mod)), + ok = file:delete(AsmFile), + ok = file:delete(code:which(Mod)), ok. @@ -868,17 +847,17 @@ otp_7422_bin(N) when N < 512 -> otp_7422_bin(_) -> ok. zero_width(Config) when is_list(Config) -> - ?line Z = id(0), + Z = id(0), Small = id(42), Big = id(1 bsl 128), - ?line <<>> = <<Small:Z>>, - ?line <<>> = <<Small:0>>, - ?line <<>> = <<Big:Z>>, - ?line <<>> = <<Big:0>>, + <<>> = <<Small:Z>>, + <<>> = <<Small:0>>, + <<>> = <<Big:Z>>, + <<>> = <<Big:0>>, - ?line {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>), - ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):Z>>), - ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):0>>), + {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>), + {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):Z>>), + {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):0>>), ok. @@ -935,8 +914,8 @@ bs_add_overflow(Config) -> Large = <<0:((1 bsl 30)-1)>>, {'EXIT',{system_limit,_}} = (catch <<Large/bits, Large/bits, Large/bits, Large/bits, - Large/bits, Large/bits, Large/bits, Large/bits, - Large/bits>>), + Large/bits, Large/bits, Large/bits, Large/bits, + Large/bits>>), ok end. diff --git a/erts/emulator/test/bs_match_bin_SUITE.erl b/erts/emulator/test/bs_match_bin_SUITE.erl index ba79643e69..f5c996ae9e 100644 --- a/erts/emulator/test/bs_match_bin_SUITE.erl +++ b/erts/emulator/test/bs_match_bin_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -24,7 +24,7 @@ init_per_group/2,end_per_group/2, byte_split_binary/1,bit_split_binary/1,match_huge_bin/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -47,33 +47,33 @@ end_per_group(_GroupName, Config) -> Config. -byte_split_binary(doc) -> "Tries to split a binary at all byte-aligned positions."; +%% Tries to split a binary at all byte-aligned positions. byte_split_binary(Config) when is_list(Config) -> - ?line L = lists:seq(0, 57), - ?line B = mkbin(L), - ?line byte_split(L, B, size(B)), - ?line Unaligned = make_unaligned_sub_binary(B), - ?line byte_split(L, Unaligned, size(Unaligned)). + L = lists:seq(0, 57), + B = mkbin(L), + byte_split(L, B, size(B)), + Unaligned = make_unaligned_sub_binary(B), + byte_split(L, Unaligned, size(Unaligned)). byte_split(L, B, Pos) when Pos >= 0 -> - ?line Sz1 = Pos, - ?line Sz2 = size(B) - Pos, - ?line <<B1:Sz1/binary,B2:Sz2/binary>> = B, - ?line B1 = list_to_binary(lists:sublist(L, 1, Pos)), - ?line B2 = list_to_binary(lists:nthtail(Pos, L)), - ?line byte_split(L, B, Pos-1); + Sz1 = Pos, + Sz2 = size(B) - Pos, + <<B1:Sz1/binary,B2:Sz2/binary>> = B, + B1 = list_to_binary(lists:sublist(L, 1, Pos)), + B2 = list_to_binary(lists:nthtail(Pos, L)), + byte_split(L, B, Pos-1); byte_split(_, _, _) -> ok. -bit_split_binary(doc) -> "Tries to split a binary at all positions."; +%% Tries to split a binary at all positions. bit_split_binary(Config) when is_list(Config) -> Fun = fun(Bin, List, SkipBef, N) -> - ?line SkipAft = 8*size(Bin) - N - SkipBef, + SkipAft = 8*size(Bin) - N - SkipBef, %%io:format("~p, ~p, ~p", [SkipBef,N,SkipAft]), - ?line <<_:SkipBef,OutBin:N/binary-unit:1,_:SkipAft>> = Bin, - ?line OutBin = make_bin_from_list(List, N) + <<_:SkipBef,OutBin:N/binary-unit:1,_:SkipAft>> = Bin, + OutBin = make_bin_from_list(List, N) end, - ?line bit_split_binary1(Fun, erlang:md5(<<1,2,3>>)), - ?line bit_split_binary1(Fun, + bit_split_binary1(Fun, erlang:md5(<<1,2,3>>)), + bit_split_binary1(Fun, make_unaligned_sub_binary(erlang:md5(<<1,2,3>>))), ok. @@ -119,19 +119,19 @@ make_unaligned_sub_binary(Bin0) -> id(I) -> I. match_huge_bin(Config) when is_list(Config) -> - ?line Bin = <<0:(1 bsl 27),13:8>>, - ?line skip_huge_bin_1(1 bsl 27, Bin), - ?line 16777216 = match_huge_bin_1(1 bsl 27, Bin), + Bin = <<0:(1 bsl 27),13:8>>, + skip_huge_bin_1(1 bsl 27, Bin), + 16777216 = match_huge_bin_1(1 bsl 27, Bin), %% Test overflowing the size of a binary field. - ?line nomatch = overflow_huge_bin_skip_32(Bin), - ?line nomatch = overflow_huge_bin_32(Bin), - ?line nomatch = overflow_huge_bin_skip_64(Bin), - ?line nomatch = overflow_huge_bin_64(Bin), + nomatch = overflow_huge_bin_skip_32(Bin), + nomatch = overflow_huge_bin_32(Bin), + nomatch = overflow_huge_bin_skip_64(Bin), + nomatch = overflow_huge_bin_64(Bin), %% Size in variable - ?line ok = overflow_huge_bin(Bin, lists:seq(25, 32)++lists:seq(50, 64)), - ?line ok = overflow_huge_bin_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok = overflow_huge_bin(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok = overflow_huge_bin_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), ok. diff --git a/erts/emulator/test/bs_match_int_SUITE.erl b/erts/emulator/test/bs_match_int_SUITE.erl index 368f71978d..a7bd4b8ac3 100644 --- a/erts/emulator/test/bs_match_int_SUITE.erl +++ b/erts/emulator/test/bs_match_int_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -24,7 +24,7 @@ integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1, match_huge_int/1,bignum/1,unaligned_32_bit/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(lists, [seq/2]). @@ -51,22 +51,22 @@ end_per_group(_GroupName, Config) -> integer(Config) when is_list(Config) -> - ?line 0 = get_int(mkbin([])), - ?line 0 = get_int(mkbin([0])), - ?line 42 = get_int(mkbin([42])), - ?line 255 = get_int(mkbin([255])), - ?line 256 = get_int(mkbin([1,0])), - ?line 257 = get_int(mkbin([1,1])), - ?line 258 = get_int(mkbin([1,2])), - ?line 258 = get_int(mkbin([1,2])), - ?line 65534 = get_int(mkbin([255,254])), - ?line 16776455 = get_int(mkbin([255,253,7])), - ?line 4245492555 = get_int(mkbin([253,13,19,75])), - ?line 4294967294 = get_int(mkbin([255,255,255,254])), - ?line 4294967295 = get_int(mkbin([255,255,255,255])), - ?line Eight = [200,1,19,128,222,42,97,111], - ?line cmp128(Eight, uint(Eight)), - ?line fun_clause(catch get_int(mkbin(seq(1,5)))), + 0 = get_int(mkbin([])), + 0 = get_int(mkbin([0])), + 42 = get_int(mkbin([42])), + 255 = get_int(mkbin([255])), + 256 = get_int(mkbin([1,0])), + 257 = get_int(mkbin([1,1])), + 258 = get_int(mkbin([1,2])), + 258 = get_int(mkbin([1,2])), + 65534 = get_int(mkbin([255,254])), + 16776455 = get_int(mkbin([255,253,7])), + 4245492555 = get_int(mkbin([253,13,19,75])), + 4294967294 = get_int(mkbin([255,255,255,254])), + 4294967295 = get_int(mkbin([255,255,255,255])), + Eight = [200,1,19,128,222,42,97,111], + cmp128(Eight, uint(Eight)), + fun_clause(catch get_int(mkbin(seq(1,5)))), ok. get_int(Bin) -> @@ -89,13 +89,13 @@ cmp128(<<I:128>>, I) -> equal; cmp128(_, _) -> not_equal. signed_integer(Config) when is_list(Config) -> - ?line {no_match,_} = sint(mkbin([])), - ?line {no_match,_} = sint(mkbin([1,2,3])), - ?line 127 = sint(mkbin([127])), - ?line -1 = sint(mkbin([255])), - ?line -128 = sint(mkbin([128])), - ?line 42 = sint(mkbin([42,255])), - ?line 127 = sint(mkbin([127,255])). + {no_match,_} = sint(mkbin([])), + {no_match,_} = sint(mkbin([1,2,3])), + 127 = sint(mkbin([127])), + -1 = sint(mkbin([255])), + -128 = sint(mkbin([128])), + 42 = sint(mkbin([42,255])), + 127 = sint(mkbin([127,255])). sint(Bin) -> case Bin of @@ -130,7 +130,7 @@ dynamic(Bin, S1, S2, A, B) -> _Other -> erlang:error(badmatch, [Bin,S1,S2,A,B]) end. -more_dynamic(doc) -> "Extract integers at different alignments and of different sizes."; +%% Extract integers at different alignments and of different sizes. more_dynamic(Config) when is_list(Config) -> % Unsigned big-endian numbers. @@ -139,7 +139,7 @@ more_dynamic(Config) when is_list(Config) -> <<_:SkipBef,Int:N,_:SkipAft>> = Bin, Int = make_int(List, N, 0) end, - ?line more_dynamic1(Unsigned, erlang:md5(mkbin([42]))), + more_dynamic1(Unsigned, erlang:md5(mkbin([42]))), %% Signed big-endian numbers. Signed = fun(Bin, List, SkipBef, N) -> @@ -151,10 +151,10 @@ more_dynamic(Config) when is_list(Config) -> io:format("Bin = ~p,", [Bin]), io:format("SkipBef = ~p, N = ~p", [SkipBef,N]), io:format("Expected ~p, got ~p", [Int,Other]), - ?t:fail() + ct:fail(signed_big_endian_fail) end end, - ?line more_dynamic1(Signed, erlang:md5(mkbin([43]))), + more_dynamic1(Signed, erlang:md5(mkbin([43]))), %% Unsigned little-endian numbers. UnsLittle = fun(Bin, List, SkipBef, N) -> @@ -162,7 +162,7 @@ more_dynamic(Config) when is_list(Config) -> <<_:SkipBef,Int:N/little,_:SkipAft>> = Bin, Int = make_int(big_to_little(List, N), N, 0) end, - ?line more_dynamic1(UnsLittle, erlang:md5(mkbin([44]))), + more_dynamic1(UnsLittle, erlang:md5(mkbin([44]))), %% Signed little-endian numbers. SignLittle = fun(Bin, List, SkipBef, N) -> @@ -171,7 +171,7 @@ more_dynamic(Config) when is_list(Config) -> Little = big_to_little(List, N), Int = make_signed_int(Little, N) end, - ?line more_dynamic1(SignLittle, erlang:md5(mkbin([45]))), + more_dynamic1(SignLittle, erlang:md5(mkbin([45]))), ok. @@ -227,23 +227,23 @@ mkbin(L) when is_list(L) -> list_to_binary(L). mml(Config) when is_list(Config) -> - ?line single_byte_binary = mml_choose(<<42>>), - ?line multi_byte_binary = mml_choose(<<42,43>>). + single_byte_binary = mml_choose(<<42>>), + multi_byte_binary = mml_choose(<<42,43>>). mml_choose(<<_A:8>>) -> single_byte_binary; mml_choose(<<_A:8,_T/binary>>) -> multi_byte_binary. match_huge_int(Config) when is_list(Config) -> Sz = 1 bsl 27, - ?line Bin = <<0:Sz,13:8>>, - ?line skip_huge_int_1(Sz, Bin), - ?line 0 = match_huge_int_1(Sz, Bin), + Bin = <<0:Sz,13:8>>, + skip_huge_int_1(Sz, Bin), + 0 = match_huge_int_1(Sz, Bin), %% Test overflowing the size of an integer field. - ?line nomatch = overflow_huge_int_skip_32(Bin), + nomatch = overflow_huge_int_skip_32(Bin), case erlang:system_info(wordsize) of 4 -> - ?line nomatch = overflow_huge_int_32(Bin); + nomatch = overflow_huge_int_32(Bin); 8 -> %% An attempt will be made to allocate heap space for %% the bignum (which will probably fail); only if the @@ -251,15 +251,15 @@ match_huge_int(Config) when is_list(Config) -> %% the binary is too small. ok end, - ?line nomatch = overflow_huge_int_skip_64(Bin), - ?line nomatch = overflow_huge_int_64(Bin), + nomatch = overflow_huge_int_skip_64(Bin), + nomatch = overflow_huge_int_64(Bin), %% Test overflowing the size of an integer field using variables as sizes. - ?line Sizes = case erlang:system_info(wordsize) of + Sizes = case erlang:system_info(wordsize) of 4 -> lists:seq(25, 32); 8 -> [] end ++ lists:seq(50, 64), - ?line ok = overflow_huge_int_unit128(Bin, Sizes), + ok = overflow_huge_int_unit128(Bin, Sizes), ok. @@ -326,19 +326,19 @@ overflow_huge_int_64(<<Int:9223372036854775808/unit:128,0,_/binary>>) -> {8,Int} overflow_huge_int_64(_) -> nomatch. bignum(Config) when is_list(Config) -> - ?line Bin = id(<<42,0:1024/unit:8,43>>), - ?line <<42:1025/little-integer-unit:8,_:8>> = Bin, - ?line <<_:8,43:1025/integer-unit:8>> = Bin, + Bin = id(<<42,0:1024/unit:8,43>>), + <<42:1025/little-integer-unit:8,_:8>> = Bin, + <<_:8,43:1025/integer-unit:8>> = Bin, - ?line BignumBin = id(<<0:512/unit:8,258254417031933722623:9/unit:8>>), - ?line <<258254417031933722623:(512+9)/unit:8>> = BignumBin, + BignumBin = id(<<0:512/unit:8,258254417031933722623:9/unit:8>>), + <<258254417031933722623:(512+9)/unit:8>> = BignumBin, erlang:garbage_collect(), %Search for holes in debug-build. ok. unaligned_32_bit(Config) when is_list(Config) -> %% There used to be a risk for heap overflow (fixed in R11B-5). - ?line L = unaligned_32_bit_1(<<-1:(64*1024)>>), - ?line unaligned_32_bit_verify(L, 1638). + L = unaligned_32_bit_1(<<-1:(64*1024)>>), + unaligned_32_bit_verify(L, 1638). unaligned_32_bit_1(<<1:1,U:32,_:7,T/binary>>) -> [U|unaligned_32_bit_1(T)]; diff --git a/erts/emulator/test/bs_match_misc_SUITE.erl b/erts/emulator/test/bs_match_misc_SUITE.erl index e875dc859c..17759d78f3 100644 --- a/erts/emulator/test/bs_match_misc_SUITE.erl +++ b/erts/emulator/test/bs_match_misc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2011. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,17 +19,18 @@ %% -module(bs_match_misc_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1, kenneth/1,encode_binary/1,native/1,happi/1, size_var/1,wiger/1,x0_context/1,huge_float_field/1, writable_binary_matched/1,otp_7198/1,unordered_bindings/1, float_middle_endian/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 10}}]. all() -> [bound_var, bound_tail, t_float, little_float, sean, @@ -37,39 +38,24 @@ all() -> x0_context, huge_float_field, writable_binary_matched, otp_7198, unordered_bindings, float_middle_endian]. -groups() -> - []. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -bound_var(doc) -> "Test matching of bound variables."; +%% Test matching of bound variables. bound_var(Config) when is_list(Config) -> - ?line ok = bound_var(42, 13, <<42,13>>), - ?line nope = bound_var(42, 13, <<42,255>>), - ?line nope = bound_var(42, 13, <<154,255>>), + ok = bound_var(42, 13, <<42,13>>), + nope = bound_var(42, 13, <<42,255>>), + nope = bound_var(42, 13, <<154,255>>), ok. bound_var(A, B, <<A:8,B:8>>) -> ok; bound_var(_, _, _) -> nope. -bound_tail(doc) -> "Test matching of a bound tail."; +%% Test matching of a bound tail. bound_tail(Config) when is_list(Config) -> - ?line ok = bound_tail(<<>>, <<13,14>>), - ?line ok = bound_tail(<<2,3>>, <<1,1,2,3>>), - ?line nope = bound_tail(<<2,3>>, <<1,1,2,7>>), - ?line nope = bound_tail(<<2,3>>, <<1,1,2,3,4>>), - ?line nope = bound_tail(<<2,3>>, <<>>), + ok = bound_tail(<<>>, <<13,14>>), + ok = bound_tail(<<2,3>>, <<1,1,2,3>>), + nope = bound_tail(<<2,3>>, <<1,1,2,7>>), + nope = bound_tail(<<2,3>>, <<1,1,2,3,4>>), + nope = bound_tail(<<2,3>>, <<>>), ok. bound_tail(T, <<_:16,T/binary>>) -> ok; @@ -79,26 +65,26 @@ t_float(Config) when is_list(Config) -> F = f1(), G = f_one(), - ?line G = match_float(<<63,128,0,0>>, 32, 0), - ?line G = match_float(<<63,240,0,0,0,0,0,0>>, 64, 0), + G = match_float(<<63,128,0,0>>, 32, 0), + G = match_float(<<63,240,0,0,0,0,0,0>>, 64, 0), - ?line fcmp(F, match_float(<<F:32/float>>, 32, 0)), - ?line fcmp(F, match_float(<<F:64/float>>, 64, 0)), - ?line fcmp(F, match_float(<<1:1,F:32/float,127:7>>, 32, 1)), - ?line fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), - ?line fcmp(F, match_float(<<1:13,F:32/float,127:3>>, 32, 13)), - ?line fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), + fcmp(F, match_float(<<F:32/float>>, 32, 0)), + fcmp(F, match_float(<<F:64/float>>, 64, 0)), + fcmp(F, match_float(<<1:1,F:32/float,127:7>>, 32, 1)), + fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), + fcmp(F, match_float(<<1:13,F:32/float,127:3>>, 32, 13)), + fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), - ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16, 0)), - ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16#7fffffff, 0)), + {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16, 0)), + {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16#7fffffff, 0)), ok. float_middle_endian(Config) when is_list(Config) -> F = 9007199254740990.0, % turns to -NaN when word-swapped - ?line fcmp(F, match_float(<<F:64/float>>, 64, 0)), - ?line fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), - ?line fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), + fcmp(F, match_float(<<F:64/float>>, 64, 0)), + fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), + fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), ok. @@ -115,15 +101,15 @@ little_float(Config) when is_list(Config) -> F = f2(), G = f_one(), - ?line G = match_float_little(<<0,0,0,0,0,0,240,63>>, 64, 0), - ?line G = match_float_little(<<0,0,128,63>>, 32, 0), + G = match_float_little(<<0,0,0,0,0,0,240,63>>, 64, 0), + G = match_float_little(<<0,0,128,63>>, 32, 0), - ?line fcmp(F, match_float_little(<<F:32/float-little>>, 32, 0)), - ?line fcmp(F, match_float_little(<<F:64/float-little>>, 64, 0)), - ?line fcmp(F, match_float_little(<<1:1,F:32/float-little,127:7>>, 32, 1)), - ?line fcmp(F, match_float_little(<<1:1,F:64/float-little,127:7>>, 64, 1)), - ?line fcmp(F, match_float_little(<<1:13,F:32/float-little,127:3>>, 32, 13)), - ?line fcmp(F, match_float_little(<<1:13,F:64/float-little,127:3>>, 64, 13)), + fcmp(F, match_float_little(<<F:32/float-little>>, 32, 0)), + fcmp(F, match_float_little(<<F:64/float-little>>, 64, 0)), + fcmp(F, match_float_little(<<1:1,F:32/float-little,127:7>>, 32, 1)), + fcmp(F, match_float_little(<<1:1,F:64/float-little,127:7>>, 64, 1)), + fcmp(F, match_float_little(<<1:13,F:32/float-little,127:3>>, 32, 13)), + fcmp(F, match_float_little(<<1:13,F:64/float-little,127:3>>, 64, 13)), ok. @@ -151,16 +137,16 @@ f_one() -> 1.0. sean(Config) when is_list(Config) -> - ?line small = sean1(<<>>), - ?line small = sean1(<<1>>), - ?line small = sean1(<<1,2>>), - ?line small = sean1(<<1,2,3>>), - ?line large = sean1(<<1,2,3,4>>), - - ?line small = sean1(<<4>>), - ?line small = sean1(<<4,5>>), - ?line small = sean1(<<4,5,6>>), - ?line {'EXIT',{function_clause,_}} = (catch sean1(<<4,5,6,7>>)), + small = sean1(<<>>), + small = sean1(<<1>>), + small = sean1(<<1,2>>), + small = sean1(<<1,2,3>>), + large = sean1(<<1,2,3,4>>), + + small = sean1(<<4>>), + small = sean1(<<4,5>>), + small = sean1(<<4,5,6>>), + {'EXIT',{function_clause,_}} = (catch sean1(<<4,5,6,7>>)), ok. sean1(<<B/binary>>) when byte_size(B) < 4 -> small; @@ -292,28 +278,28 @@ getBase64Char(_Else) -> -define(M(F), <<F>> = <<F>>). native(Config) when is_list(Config) -> - ?line ?M(3.14:64/native-float), - ?line ?M(333:16/native), - ?line ?M(38658345:32/native), + ?M(3.14:64/native-float), + ?M(333:16/native), + ?M(38658345:32/native), case <<1:16/native>> of <<0,1>> -> native_big(); <<1,0>> -> native_little() end. native_big() -> - ?line <<37.33:64/native-float>> = <<37.33:64/big-float>>, - ?line <<3974:16/native-integer>> = <<3974:16/big-integer>>, + <<37.33:64/native-float>> = <<37.33:64/big-float>>, + <<3974:16/native-integer>> = <<3974:16/big-integer>>, {comment,"Big endian"}. native_little() -> - ?line <<37869.32343:64/native-float>> = <<37869.32343:64/little-float>>, - ?line <<7974:16/native-integer>> = <<7974:16/little-integer>>, + <<37869.32343:64/native-float>> = <<37869.32343:64/little-float>>, + <<7974:16/native-integer>> = <<7974:16/little-integer>>, {comment,"Little endian"}. happi(Config) when is_list(Config) -> Bin = <<".123">>, - ?line <<"123">> = lex_digits1(Bin, 1, []), - ?line <<"123">> = lex_digits2(Bin, 1, []), + <<"123">> = lex_digits1(Bin, 1, []), + <<"123">> = lex_digits2(Bin, 1, []), ok. lex_digits1(<<$., Rest/binary>>,_Val,_Acc) -> @@ -334,16 +320,16 @@ dec(A) -> A-$0. size_var(Config) when is_list(Config) -> - ?line {<<45>>,<<>>} = split(<<1:16,45>>), - ?line {<<45>>,<<46,47>>} = split(<<1:16,45,46,47>>), - ?line {<<45,46>>,<<47>>} = split(<<2:16,45,46,47>>), + {<<45>>,<<>>} = split(<<1:16,45>>), + {<<45>>,<<46,47>>} = split(<<1:16,45,46,47>>), + {<<45,46>>,<<47>>} = split(<<2:16,45,46,47>>), - ?line {<<45,46,47>>,<<48>>} = split_2(<<16:8,3:16,45,46,47,48>>), + {<<45,46,47>>,<<48>>} = split_2(<<16:8,3:16,45,46,47,48>>), - ?line {<<45,46>>,<<47>>} = split(2, <<2:16,45,46,47>>), - ?line {'EXIT',{function_clause,_}} = (catch split(42, <<2:16,45,46,47>>)), + {<<45,46>>,<<47>>} = split(2, <<2:16,45,46,47>>), + {'EXIT',{function_clause,_}} = (catch split(42, <<2:16,45,46,47>>)), - ?line <<"cdef">> = skip(<<2:8,"abcdef">>), + <<"cdef">> = skip(<<2:8,"abcdef">>), ok. @@ -359,11 +345,11 @@ split_2(<<N0:8,N:N0,B:N/binary,T/binary>>) -> skip(<<N:8,_:N/binary,T/binary>>) -> T. wiger(Config) when is_list(Config) -> - ?line ok1 = wcheck(<<3>>), - ?line ok2 = wcheck(<<1,2,3>>), - ?line ok3 = wcheck(<<4>>), - ?line {error,<<1,2,3,4>>} = wcheck(<<1,2,3,4>>), - ?line {error,<<>>} = wcheck(<<>>), + ok1 = wcheck(<<3>>), + ok2 = wcheck(<<1,2,3>>), + ok3 = wcheck(<<4>>), + {error,<<1,2,3,4>>} = wcheck(<<1,2,3,4>>), + {error,<<>>} = wcheck(<<>>), ok. wcheck(<<A>>) when A==3-> @@ -396,24 +382,24 @@ x0_2(_, Bin) -> x0_3(_, Bin) -> case Bin of - <<_:72,7:8,_/binary>> -> - ?line ?t:fail(); - <<_:64,0:16,_/binary>> -> - ?line ?t:fail(); - <<_:64,42:16,123456:32,_/binary>> -> - ok + <<_:72,7:8,_/binary>> -> + ct:fail(bs_matched_1); + <<_:64,0:16,_/binary>> -> + ct:fail(bs_matched_2); + <<_:64,42:16,123456:32,_/binary>> -> + ok end. huge_float_field(Config) when is_list(Config) -> Sz = 1 bsl 27, - ?line Bin = <<0:Sz>>, + Bin = <<0:Sz>>, - ?line nomatch = overflow_huge_float_skip_32(Bin), - ?line nomatch = overflow_huge_float_32(Bin), + nomatch = overflow_huge_float_skip_32(Bin), + nomatch = overflow_huge_float_32(Bin), - ?line ok = overflow_huge_float(Bin, lists:seq(25, 32)++lists:seq(50, 64)), - ?line ok = overflow_huge_float_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok = overflow_huge_float(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok = overflow_huge_float_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), ok. overflow_huge_float_skip_32(<<_:4294967296/float,0,_/binary>>) -> 1; % 1 bsl 32 @@ -455,15 +441,15 @@ overflow_huge_float(_, []) -> ok. overflow_huge_float_unit128(Bin, [Sz0|Sizes]) -> Sz = id(1 bsl Sz0), case Bin of - <<_:Sz/float-unit:128,0,_/binary>> -> - {error,Sz}; - _ -> - case Bin of - <<Var:Sz/float-unit:128,0,_/binary>> -> - {error,Sz,Var}; - _ -> - overflow_huge_float_unit128(Bin, Sizes) - end + <<_:Sz/float-unit:128,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <<Var:Sz/float-unit:128,0,_/binary>> -> + {error,Sz,Var}; + _ -> + overflow_huge_float_unit128(Bin, Sizes) + end end; overflow_huge_float_unit128(_, []) -> ok. @@ -473,25 +459,24 @@ overflow_huge_float_unit128(_, []) -> ok. %% writable_binary_matched(Config) when is_list(Config) -> - ?line WritableBin = create_writeable_binary(), - ?line writable_binary_matched(WritableBin, WritableBin, 500). + WritableBin = create_writeable_binary(), + writable_binary_matched(WritableBin, WritableBin, 500). writable_binary_matched(<<0>>, _, N) -> - if - N =:= 0 -> ok; - true -> - put(grow_heap, [N|get(grow_heap)]), - ?line WritableBin = create_writeable_binary(), - ?line writable_binary_matched(WritableBin, WritableBin, N-1) + if N =:= 0 -> ok; + true -> + put(grow_heap, [N|get(grow_heap)]), + WritableBin = create_writeable_binary(), + writable_binary_matched(WritableBin, WritableBin, N-1) end; writable_binary_matched(<<B:8,T/binary>>, WritableBin0, N) -> - ?line WritableBin = writable_binary(WritableBin0, B), + WritableBin = writable_binary(WritableBin0, B), writable_binary_matched(T, WritableBin, N). writable_binary(WritableBin0, B) when is_binary(WritableBin0) -> %% Heavy append to force the binary to move. - ?line WritableBin = <<WritableBin0/binary,0:(size(WritableBin0))/unit:8,B>>, - ?line id(<<(id(0)):128/unit:8>>), + WritableBin = <<WritableBin0/binary,0:(size(WritableBin0))/unit:8,B>>, + id(<<(id(0)):128/unit:8>>), WritableBin. create_writeable_binary() -> @@ -502,7 +487,7 @@ otp_7198(Config) when is_list(Config) -> %% increase the number of saved positions, the thing word was not updated %% to account for the new size. Therefore, if there was a garbage collection, %% the new slots would be included in the garbage collection. - ?line [do_otp_7198(FillerSize) || FillerSize <- lists:seq(0, 256)], + [do_otp_7198(FillerSize) || FillerSize <- lists:seq(0, 256)], ok. do_otp_7198(FillerSize) -> @@ -512,8 +497,7 @@ do_otp_7198(FillerSize) -> {'DOWN',Ref,process,Pid,normal} -> ok; {'DOWN',Ref,process,Pid,Reason} -> - io:format("unexpected: ~p", [Reason]), - ?line ?t:fail() + ct:fail("unexpected: ~p", [Reason]) end. do_otp_7198_test(_) -> @@ -540,27 +524,27 @@ otp_7198_scan(<<>>, TokAcc) -> otp_7198_scan(<<D, Z, Rest/binary>>, TokAcc) when (D =:= $D orelse D =:= $d) and ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> - otp_7198_scan(<<Z, Rest/binary>>, ['AND' | TokAcc]); + otp_7198_scan(<<Z, Rest/binary>>, ['AND' | TokAcc]); otp_7198_scan(<<D>>, TokAcc) when (D =:= $D) or (D =:= $d) -> - otp_7198_scan(<<>>, ['AND' | TokAcc]); + otp_7198_scan(<<>>, ['AND' | TokAcc]); otp_7198_scan(<<N, Z, Rest/binary>>, TokAcc) when (N =:= $N orelse N =:= $n) and ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> - otp_7198_scan(<<Z, Rest/binary>>, ['NOT' | TokAcc]); + otp_7198_scan(<<Z, Rest/binary>>, ['NOT' | TokAcc]); otp_7198_scan(<<C, Rest/binary>>, TokAcc) when (C >= $A) and (C =< $Z); (C >= $a) and (C =< $z); (C >= $0) and (C =< $9) -> - case Rest of - <<$:, R/binary>> -> - otp_7198_scan(R, [{'FIELD', C} | TokAcc]); - _ -> - otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc]) - end. + case Rest of + <<$:, R/binary>> -> + otp_7198_scan(R, [{'FIELD', C} | TokAcc]); + _ -> + otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc]) + end. unordered_bindings(Config) when is_list(Config) -> {<<1,2,3,4>>,<<42,42>>,<<3,3,3>>} = diff --git a/erts/emulator/test/bs_match_tail_SUITE.erl b/erts/emulator/test/bs_match_tail_SUITE.erl index 58b0d3fef6..cbebc554c7 100644 --- a/erts/emulator/test/bs_match_tail_SUITE.erl +++ b/erts/emulator/test/bs_match_tail_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,61 +21,46 @@ -module(bs_match_tail_SUITE). -author('[email protected]'). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2,aligned/1,unaligned/1,zero_tail/1]). +-export([all/0, suite/0, + aligned/1,unaligned/1,zero_tail/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [aligned, unaligned, zero_tail]. -groups() -> - []. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -aligned(doc) -> "Test aligned tails."; +%% Test aligned tails. aligned(Config) when is_list(Config) -> - ?line Tail1 = mkbin([]), - ?line {258,Tail1} = al_get_tail_used(mkbin([1,2])), - ?line Tail2 = mkbin(lists:seq(1, 127)), - ?line {35091,Tail2} = al_get_tail_used(mkbin([137,19|Tail2])), - - ?line 64896 = al_get_tail_unused(mkbin([253,128])), - ?line 64895 = al_get_tail_unused(mkbin([253,127|lists:seq(42, 255)])), - - ?line Tail3 = mkbin(lists:seq(0, 19)), - ?line {0,Tail1} = get_dyn_tail_used(Tail1, 0), - ?line {0,Tail3} = get_dyn_tail_used(mkbin([Tail3]), 0), - ?line {73,Tail3} = get_dyn_tail_used(mkbin([73|Tail3]), 8), - - ?line 0 = get_dyn_tail_unused(mkbin([]), 0), - ?line 233 = get_dyn_tail_unused(mkbin([233]), 8), - ?line 23 = get_dyn_tail_unused(mkbin([23,22,2]), 8), + Tail1 = mkbin([]), + {258,Tail1} = al_get_tail_used(mkbin([1,2])), + Tail2 = mkbin(lists:seq(1, 127)), + {35091,Tail2} = al_get_tail_used(mkbin([137,19|Tail2])), + + 64896 = al_get_tail_unused(mkbin([253,128])), + 64895 = al_get_tail_unused(mkbin([253,127|lists:seq(42, 255)])), + + Tail3 = mkbin(lists:seq(0, 19)), + {0,Tail1} = get_dyn_tail_used(Tail1, 0), + {0,Tail3} = get_dyn_tail_used(mkbin([Tail3]), 0), + {73,Tail3} = get_dyn_tail_used(mkbin([73|Tail3]), 8), + + 0 = get_dyn_tail_unused(mkbin([]), 0), + 233 = get_dyn_tail_unused(mkbin([233]), 8), + 23 = get_dyn_tail_unused(mkbin([23,22,2]), 8), ok. al_get_tail_used(<<A:16,T/binary>>) -> {A,T}. al_get_tail_unused(<<A:16,_/binary>>) -> A. -unaligned(doc) -> "Test that an non-aligned tail cannot be matched out."; +%% Test that an non-aligned tail cannot be matched out. unaligned(Config) when is_list(Config) -> - ?line {'EXIT',{function_clause,_}} = (catch get_tail_used(mkbin([42]))), - ?line {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_used(mkbin([137]), 3)), - ?line {'EXIT',{function_clause,_}} = (catch get_tail_unused(mkbin([42,33]))), - ?line {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_unused(mkbin([44]), 7)), + {'EXIT',{function_clause,_}} = (catch get_tail_used(mkbin([42]))), + {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_used(mkbin([137]), 3)), + {'EXIT',{function_clause,_}} = (catch get_tail_unused(mkbin([42,33]))), + {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_unused(mkbin([44]), 7)), ok. get_tail_used(<<A:1,T/binary>>) -> {A,T}. @@ -90,11 +75,11 @@ get_dyn_tail_unused(Bin, Sz) -> <<A:Sz,_/binary>> = Bin, A. -zero_tail(doc) -> "Test that zero tails are tested correctly."; +%% Test that zero tails are tested correctly. zero_tail(Config) when is_list(Config) -> - ?line 7 = (catch test_zero_tail(mkbin([7]))), - ?line {'EXIT',{function_clause,_}} = (catch test_zero_tail(mkbin([1,2]))), - ?line {'EXIT',{function_clause,_}} = (catch test_zero_tail2(mkbin([1,2,3]))), + 7 = (catch test_zero_tail(mkbin([7]))), + {'EXIT',{function_clause,_}} = (catch test_zero_tail(mkbin([1,2]))), + {'EXIT',{function_clause,_}} = (catch test_zero_tail2(mkbin([1,2,3]))), ok. test_zero_tail(<<A:8>>) -> A. @@ -102,7 +87,3 @@ test_zero_tail(<<A:8>>) -> A. test_zero_tail2(<<_A:4,_B:4>>) -> ok. mkbin(L) when is_list(L) -> list_to_binary(L). - - - - diff --git a/erts/emulator/test/bs_utf_SUITE.erl b/erts/emulator/test/bs_utf_SUITE.erl index 0625c22163..a344f5c456 100644 --- a/erts/emulator/test/bs_utf_SUITE.erl +++ b/erts/emulator/test/bs_utf_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2011. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,52 +20,28 @@ -module(bs_utf_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([all/0, suite/0, utf8_roundtrip/1,utf16_roundtrip/1,utf32_roundtrip/1, utf8_illegal_sequences/1,utf16_illegal_sequences/1, utf32_illegal_sequences/1, bad_construction/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])). +-define(FAIL(Expr), fail_check(catch Expr, ??Expr, [])). -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(6)), - [{watchdog,Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 6}}]. all() -> [utf8_roundtrip, utf16_roundtrip, utf32_roundtrip, utf8_illegal_sequences, utf16_illegal_sequences, utf32_illegal_sequences, bad_construction]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - utf8_roundtrip(Config) when is_list(Config) -> - ?line utf8_roundtrip(0, 16#D7FF), - ?line utf8_roundtrip(16#E000, 16#10FFFF), + utf8_roundtrip(0, 16#D7FF), + utf8_roundtrip(16#E000, 16#10FFFF), ok. utf8_roundtrip(First, Last) when First =< Last -> @@ -83,10 +59,9 @@ utf16_roundtrip(Config) when is_list(Config) -> Big = fun utf16_big_roundtrip/1, Little = fun utf16_little_roundtrip/1, PidRefs = [spawn_monitor(fun() -> - do_utf16_roundtrip(Fun) - end) || Fun <- [Big,Little]], - [receive {'DOWN',Ref,process,Pid,Reason} -> normal=Reason end || - {Pid,Ref} <- PidRefs], + do_utf16_roundtrip(Fun) + end) || Fun <- [Big,Little]], + [receive {'DOWN',Ref,process,Pid,Reason} -> normal=Reason end || {Pid,Ref} <- PidRefs], ok. do_utf16_roundtrip(Fun) -> @@ -154,20 +129,20 @@ utf32_little_roundtrip(Char) -> ok. utf8_illegal_sequences(Config) when is_list(Config) -> - ?line fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. - ?line fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. + fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. + fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. %% Illegal first character. - ?line [fail(<<I,16#8F,16#8F,16#8F>>) || I <- lists:seq(16#80, 16#BF)], + [fail(<<I,16#8F,16#8F,16#8F>>) || I <- lists:seq(16#80, 16#BF)], %% Short sequences. - ?line short_sequences(16#80, 16#10FFFF), + short_sequences(16#80, 16#10FFFF), %% Overlong sequences. (Using more bytes than necessary %% is not allowed.) - ?line overlong(0, 127, 2), - ?line overlong(128, 16#7FF, 3), - ?line overlong(16#800, 16#FFFF, 4), + overlong(0, 127, 2), + overlong(128, 16#7FF, 3), + overlong(16#800, 16#FFFF, 4), ok. fail_range(Char, End) when Char =< End -> @@ -187,9 +162,9 @@ short_sequences(Char, End) -> short_sequences_1(Char, Step, End) when Char =< End -> CharEnd = lists:min([Char+Step-1,End]), [spawn_monitor(fun() -> - io:format("~p - ~p\n", [Char,CharEnd]), - do_short_sequences(Char, CharEnd) - end)|short_sequences_1(Char+Step, Step, End)]; + io:format("~p - ~p\n", [Char,CharEnd]), + do_short_sequences(Char, CharEnd) + end)|short_sequences_1(Char+Step, Step, End)]; short_sequences_1(_, _, _) -> []. do_short_sequences(Char, End) when Char =< End -> @@ -228,9 +203,9 @@ overlong(_, _, _) -> ok. overlong(Char, NumBytes) when NumBytes < 5 -> case int_to_utf8(Char, NumBytes) of <<Char/utf8>>=Bin -> - ?t:fail({illegal_encoding_accepted,Bin,Char}); + ct:fail({illegal_encoding_accepted,Bin,Char}); <<OtherChar/utf8>>=Bin -> - ?t:fail({illegal_encoding_accepted,Bin,Char,OtherChar}); + ct:fail({illegal_encoding_accepted,Bin,Char,OtherChar}); _ -> ok end, overlong(Char, NumBytes+1); @@ -241,16 +216,16 @@ fail(Bin) -> fail_1(make_unaligned(Bin)). fail_1(<<Char/utf8>>=Bin) -> - ?t:fail({illegal_encoding_accepted,Bin,Char}); + ct:fail({illegal_encoding_accepted,Bin,Char}); fail_1(_) -> ok. utf16_illegal_sequences(Config) when is_list(Config) -> - ?line utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. - ?line utf16_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. + utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. + utf16_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line lonely_hi_surrogate(16#D800, 16#DFFF), - ?line leading_lo_surrogate(16#DC00, 16#DFFF), + lonely_hi_surrogate(16#D800, 16#DFFF), + leading_lo_surrogate(16#DC00, 16#DFFF), ok. @@ -265,9 +240,9 @@ lonely_hi_surrogate(Char, End) when Char =< End -> BinLittle = <<Char:16/little>>, case {BinBig,BinLittle} of {<<Bad/big-utf16>>,_} -> - ?t:fail({lonely_hi_surrogate_accepted,Bad}); + ct:fail({lonely_hi_surrogate_accepted,Bad}); {_,<<Bad/little-utf16>>} -> - ?t:fail({lonely_hi_surrogate_accepted,Bad}); + ct:fail({lonely_hi_surrogate_accepted,Bad}); {_,_} -> ok end, @@ -284,9 +259,9 @@ leading_lo_surrogate(HiSurr, LoSurr, End) when LoSurr =< End -> BinLittle = <<HiSurr:16/little,LoSurr:16/little>>, case {BinBig,BinLittle} of {<<Bad/big-utf16,_/bits>>,_} -> - ?t:fail({leading_lo_surrogate_accepted,Bad}); + ct:fail({leading_lo_surrogate_accepted,Bad}); {_,<<Bad/little-utf16,_/bits>>} -> - ?t:fail({leading_lo_surrogate_accepted,Bad}); + ct:fail({leading_lo_surrogate_accepted,Bad}); {_,_} -> ok end, @@ -294,20 +269,20 @@ leading_lo_surrogate(HiSurr, LoSurr, End) when LoSurr =< End -> leading_lo_surrogate(_, _, _) -> ok. utf32_illegal_sequences(Config) when is_list(Config) -> - ?line utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. - ?line utf32_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line utf32_fail_range(-100, -1), + utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. + utf32_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. + utf32_fail_range(-100, -1), ok. utf32_fail_range(Char, End) when Char =< End -> {'EXIT',_} = (catch <<Char/big-utf32>>), {'EXIT',_} = (catch <<Char/little-utf32>>), case {<<Char:32>>,<<Char:32/little>>} of - {<<Unexpected/utf32>>,_} -> - ?line ?t:fail(Unexpected); - {_,<<Unexpected/little-utf32>>} -> - ?line ?t:fail(Unexpected); - {_,_} -> ok + {<<Unexpected/utf32>>,_} -> + ct:fail(Unexpected); + {_,<<Unexpected/little-utf32>>} -> + ct:fail(Unexpected); + {_,_} -> ok end, utf32_fail_range(Char+1, End); utf32_fail_range(_, _) -> ok. @@ -387,14 +362,14 @@ fail_check({'EXIT',{badarg,_}}, Str, Vars) -> try evaluate(Str, Vars) of Res -> io:format("Interpreted result: ~p", [Res]), - ?t:fail(did_not_fail_in_intepreted_code) + ct:fail(did_not_fail_in_intepreted_code) catch error:badarg -> ok end; fail_check(Res, _, _) -> io:format("Compiled result: ~p", [Res]), - ?t:fail(did_not_fail_in_compiled_code). + ct:fail(did_not_fail_in_compiled_code). evaluate(Str, Vars) -> {ok,Tokens,_} = @@ -406,4 +381,3 @@ evaluate(Str, Vars) -> end. id(I) -> I. - diff --git a/erts/emulator/test/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl index 6a2588aadd..bb0632ae08 100644 --- a/erts/emulator/test/busy_port_SUITE.erl +++ b/erts/emulator/test/busy_port_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,8 +20,7 @@ -module(busy_port_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2,end_per_testcase/2, +-export([all/0, suite/0, end_per_testcase/2, io_to_busy/1, message_order/1, send_3/1, system_monitor/1, no_trap_exit/1, no_trap_exit_unlinked/1, trap_exit/1, multiple_writers/1, @@ -29,12 +28,14 @@ -compile(export_all). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Internal exports. -export([init/2]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. all() -> [io_to_busy, message_order, send_3, system_monitor, @@ -43,21 +44,6 @@ all() -> scheduling_delay_busy,scheduling_delay_busy_nosuspend, scheduling_busy_link]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - end_per_testcase(_Case, Config) when is_list(Config) -> case whereis(busy_drv_server) of undefined -> @@ -76,17 +62,14 @@ end_per_testcase(_Case, Config) when is_list(Config) -> %% Tests I/O operations to a busy port, to make sure a suspended send %% operation is correctly restarted. This used to crash Beam. -io_to_busy(suite) -> []; io_to_busy(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(30)), + ct:timetrap({seconds, 30}), - ?line start_busy_driver(Config), - ?line process_flag(trap_exit, true), - ?line Writer = fun_spawn(fun writer/0), - ?line Generator = fun_spawn(fun() -> generator(100, Writer) end), - ?line wait_for([Writer, Generator]), - - ?line test_server:timetrap_cancel(Dog), + start_busy_driver(Config), + process_flag(trap_exit, true), + Writer = fun_spawn(fun writer/0), + Generator = fun_spawn(fun() -> generator(100, Writer) end), + wait_for([Writer, Generator]), ok. generator(N, Writer) -> @@ -130,27 +113,24 @@ forget(_) -> %% Test the interaction of busy ports and message sending. %% This used to cause the wrong message to be received. -message_order(suite) -> {req, dynamic_loading}; message_order(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - - ?line start_busy_driver(Config), - ?line Self = self(), - ?line Busy = fun_spawn(fun () -> send_to_busy_1(Self) end), - ?line receive after 1000 -> ok end, - ?line Busy ! first, - ?line Busy ! second, - ?line receive after 1 -> ok end, - ?line unlock_slave(), - ?line Busy ! third, - ?line receive - {Busy, first} -> - ok; - Other -> - test_server:fail({unexpected_message, Other}) - end, - - ?line test_server:timetrap_cancel(Dog), + ct:timetrap({seconds, 10}), + + start_busy_driver(Config), + Self = self(), + Busy = fun_spawn(fun () -> send_to_busy_1(Self) end), + receive after 1000 -> ok end, + Busy ! first, + Busy ! second, + receive after 1 -> ok end, + unlock_slave(), + Busy ! third, + receive + {Busy, first} -> + ok; + Other -> + ct:fail({unexpected_message, Other}) + end, ok. send_to_busy_1(Parent) -> @@ -164,80 +144,64 @@ send_to_busy_1(Parent) -> end. %% Test the bif send/3 -send_3(suite) -> {req,dynamic_loading}; -send_3(doc) -> ["Test the BIF send/3"]; send_3(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), + ct:timetrap({seconds, 10}), %% - ?line start_busy_driver(Config), - ?line {Owner,Slave} = get_slave(), - ?line ok = erlang:send(Slave, {Owner,{command,"set busy"}}, - [nosuspend]), + start_busy_driver(Config), + {Owner,Slave} = get_slave(), + ok = erlang:send(Slave, {Owner,{command,"set busy"}}, [nosuspend]), receive after 100 -> ok end, % ensure command reached port - ?line nosuspend = erlang:send(Slave, {Owner,{command,"busy"}}, - [nosuspend]), - ?line unlock_slave(), - ?line ok = erlang:send(Slave, {Owner,{command,"not busy"}}, - [nosuspend]), - ?line ok = command(stop), - %% - ?line test_server:timetrap_cancel(Dog), + nosuspend = erlang:send(Slave, {Owner,{command,"busy"}}, [nosuspend]), + unlock_slave(), + ok = erlang:send(Slave, {Owner,{command,"not busy"}}, [nosuspend]), + ok = command(stop), ok. %% Test the erlang:system_monitor(Pid, [busy_port]) -system_monitor(suite) -> {req,dynamic_loading}; -system_monitor(doc) -> ["Test erlang:system_monitor({Pid,[busy_port]})."]; system_monitor(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Self = self(), + ct:timetrap({seconds, 10}), + Self = self(), %% - ?line OldMonitor = erlang:system_monitor(Self, [busy_port]), - ?line {Self,[busy_port]} = erlang:system_monitor(), - ?line Void = make_ref(), - ?line start_busy_driver(Config), - ?line {Owner,Slave} = get_slave(), - ?line Master = command(get_master), - ?line Parent = self(), - ?line Busy = - spawn_link( - fun() -> - (catch port_command(Slave, "set busy")), - receive {Parent,alpha} -> ok end, - (catch port_command(Slave, "busy")), - (catch port_command(Slave, "free")), - Parent ! {self(),alpha}, - command(lock), - receive {Parent,beta} -> ok end, - command({port_command,"busy"}), - command({port_command,"free"}), - Parent ! {self(),beta} - end), - ?line Void = rec(Void), - ?line Busy ! {self(),alpha}, - ?line {monitor,Busy,busy_port,Slave} = rec(Void), - ?line unlock_slave(), - ?line {Busy,alpha} = rec(Void), - ?line Void = rec(Void), - ?line Busy ! {self(), beta}, - ?line {monitor,Owner,busy_port,Slave} = rec(Void), - ?line port_command(Master, "u"), - ?line {Busy,beta} = rec(Void), - ?line Void = rec(Void), - ?line _NewMonitor = erlang:system_monitor(OldMonitor), - ?line OldMonitor = erlang:system_monitor(), - ?line OldMonitor = erlang:system_monitor(OldMonitor), - %% - ?line test_server:timetrap_cancel(Dog), + OldMonitor = erlang:system_monitor(Self, [busy_port]), + {Self,[busy_port]} = erlang:system_monitor(), + Void = make_ref(), + start_busy_driver(Config), + {Owner,Slave} = get_slave(), + Master = command(get_master), + Parent = self(), + Busy = spawn_link( + fun() -> + (catch port_command(Slave, "set busy")), + receive {Parent,alpha} -> ok end, + (catch port_command(Slave, "busy")), + (catch port_command(Slave, "free")), + Parent ! {self(),alpha}, + command(lock), + receive {Parent,beta} -> ok end, + command({port_command,"busy"}), + command({port_command,"free"}), + Parent ! {self(),beta} + end), + Void = rec(Void), + Busy ! {self(),alpha}, + {monitor,Busy,busy_port,Slave} = rec(Void), + unlock_slave(), + {Busy,alpha} = rec(Void), + Void = rec(Void), + Busy ! {self(), beta}, + {monitor,Owner,busy_port,Slave} = rec(Void), + port_command(Master, "u"), + {Busy,beta} = rec(Void), + Void = rec(Void), + _NewMonitor = erlang:system_monitor(OldMonitor), + OldMonitor = erlang:system_monitor(), + OldMonitor = erlang:system_monitor(OldMonitor), ok. - - rec(Tag) -> receive X -> X after 1000 -> Tag end. - - %% Assuming the following scenario, %% %% +---------------+ +-----------+ @@ -248,65 +212,59 @@ rec(Tag) -> %% %% tests that the suspended process is killed if the port is killed. -no_trap_exit(suite) -> []; no_trap_exit(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line process_flag(trap_exit, true), - ?line Pid = fun_spawn(fun no_trap_exit_process/3, - [self(), linked, Config]), - ?line receive - {Pid, port_created, Port} -> - io:format("Process ~w created port ~w", [Pid, Port]), - ?line exit(Port, die); - Other1 -> - test_server:fail({unexpected_message, Other1}) - end, - ?line receive - {'EXIT', Pid, die} -> - ok; - Other2 -> - test_server:fail({unexpected_message, Other2}) - end, - - ?line test_server:timetrap_cancel(Dog), + ct:timetrap({seconds, 10}), + process_flag(trap_exit, true), + Pid = fun_spawn(fun no_trap_exit_process/3, [self(), linked, Config]), + receive + {Pid, port_created, Port} -> + io:format("Process ~w created port ~w", [Pid, Port]), + exit(Port, die); + Other1 -> + ct:fail({unexpected_message, Other1}) + end, + receive + {'EXIT', Pid, die} -> + ok; + Other2 -> + ct:fail({unexpected_message, Other2}) + end, ok. %% The same scenario as above, but the port has been explicitly %% unlinked from the process. -no_trap_exit_unlinked(suite) -> []; no_trap_exit_unlinked(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line process_flag(trap_exit, true), - ?line Pid = fun_spawn(fun no_trap_exit_process/3, - [self(), unlink, Config]), - ?line receive - {Pid, port_created, Port} -> - io:format("Process ~w created port ~w", [Pid, Port]), - ?line exit(Port, die); - Other1 -> - test_server:fail({unexpected_message, Other1}) - end, - ?line receive - {'EXIT', Pid, normal} -> - ok; - Other2 -> - test_server:fail({unexpected_message, Other2}) - end, - ?line test_server:timetrap_cancel(Dog), + ct:timetrap({seconds, 10}), + process_flag(trap_exit, true), + Pid = fun_spawn(fun no_trap_exit_process/3, + [self(), unlink, Config]), + receive + {Pid, port_created, Port} -> + io:format("Process ~w created port ~w", [Pid, Port]), + exit(Port, die); + Other1 -> + ct:fail({unexpected_message, Other1}) + end, + receive + {'EXIT', Pid, normal} -> + ok; + Other2 -> + ct:fail({unexpected_message, Other2}) + end, ok. no_trap_exit_process(ResultTo, Link, Config) -> - ?line load_busy_driver(Config), - ?line _Master = open_port({spawn, "busy_drv master"}, [eof]), - ?line Slave = open_port({spawn, "busy_drv slave"}, [eof]), - ?line case Link of - linked -> ok; - unlink -> unlink(Slave) - end, - ?line (catch port_command(Slave, "lock port")), - ?line ResultTo ! {self(), port_created, Slave}, - ?line (catch port_command(Slave, "suspend me")), + load_busy_driver(Config), + _Master = open_port({spawn, "busy_drv master"}, [eof]), + Slave = open_port({spawn, "busy_drv slave"}, [eof]), + case Link of + linked -> ok; + unlink -> unlink(Slave) + end, + (catch port_command(Slave, "lock port")), + ResultTo ! {self(), port_created, Slave}, + (catch port_command(Slave, "suspend me")), ok. %% Assuming the following scenario, @@ -320,36 +278,34 @@ no_trap_exit_process(ResultTo, Link, Config) -> %% tests that the suspended process is scheduled runnable and %% receives an 'EXIT' message if the port is killed. -trap_exit(suite) -> []; trap_exit(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Pid = fun_spawn(fun busy_port_exit_process/2, [self(), Config]), - ?line receive + ct:timetrap({seconds, 10}), + Pid = fun_spawn(fun busy_port_exit_process/2, [self(), Config]), + receive {Pid, port_created, Port} -> io:format("Process ~w created port ~w", [Pid, Port]), - ?line unlink(Pid), - ?line {status, suspended} = process_info(Pid, status), - ?line exit(Port, die); + unlink(Pid), + {status, suspended} = process_info(Pid, status), + exit(Port, die); Other1 -> - test_server:fail({unexpected_message, Other1}) + ct:fail({unexpected_message, Other1}) end, - ?line receive + receive {Pid, ok} -> ok; Other2 -> - test_server:fail({unexpected_message, Other2}) + ct:fail({unexpected_message, Other2}) end, - ?line test_server:timetrap_cancel(Dog), ok. busy_port_exit_process(ResultTo, Config) -> - ?line process_flag(trap_exit, true), - ?line load_busy_driver(Config), - ?line _Master = open_port({spawn, "busy_drv master"}, [eof]), - ?line Slave = open_port({spawn, "busy_drv slave"}, [eof]), - ?line (catch port_command(Slave, "lock port")), - ?line ResultTo ! {self(), port_created, Slave}, - ?line (catch port_command(Slave, "suspend me")), + process_flag(trap_exit, true), + load_busy_driver(Config), + _Master = open_port({spawn, "busy_drv master"}, [eof]), + Slave = open_port({spawn, "busy_drv slave"}, [eof]), + (catch port_command(Slave, "lock port")), + ResultTo ! {self(), port_created, Slave}, + (catch port_command(Slave, "suspend me")), receive {'EXIT', Slave, die} -> ResultTo ! {self(), ok}; @@ -362,19 +318,18 @@ busy_port_exit_process(ResultTo, Config) -> %% This should work even if some of the processes have terminated %% in the meantime. -multiple_writers(suite) -> []; multiple_writers(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line start_busy_driver(Config), - ?line process_flag(trap_exit, true), + ct:timetrap({seconds, 10}), + start_busy_driver(Config), + process_flag(trap_exit, true), %% Start the waiters and make sure they have blocked. - ?line W1 = fun_spawn(fun quick_writer/0), - ?line W2 = fun_spawn(fun quick_writer/0), - ?line W3 = fun_spawn(fun quick_writer/0), - ?line W4 = fun_spawn(fun quick_writer/0), - ?line W5 = fun_spawn(fun quick_writer/0), - ?line test_server:sleep(500), % Make sure writers have blocked. + W1 = fun_spawn(fun quick_writer/0), + W2 = fun_spawn(fun quick_writer/0), + W3 = fun_spawn(fun quick_writer/0), + W4 = fun_spawn(fun quick_writer/0), + W5 = fun_spawn(fun quick_writer/0), + test_server:sleep(500), % Make sure writers have blocked. %% Kill two of the processes. exit(W1, kill), @@ -383,10 +338,8 @@ multiple_writers(Config) when is_list(Config) -> receive {'EXIT', W3, killed} -> ok end, %% Unlock the port. The surviving processes should be become runnable. - ?line unlock_slave(), - ?line wait_for([W2, W4, W5]), - - ?line test_server:timetrap_cancel(Dog), + unlock_slave(), + wait_for([W2, W4, W5]), ok. quick_writer() -> @@ -402,205 +355,193 @@ soft_busy_driver(Config) when is_list(Config) -> hs_test(Config, false). hs_test(Config, HardBusy) when is_list(Config) -> - ?line DrvName = case HardBusy of - true -> 'hard_busy_drv'; - false -> 'soft_busy_drv' - end, - ?line erl_ddll:start(), - ?line Path = ?config(data_dir, Config), + DrvName = case HardBusy of + true -> 'hard_busy_drv'; + false -> 'soft_busy_drv' + end, + erl_ddll:start(), + Path = proplists:get_value(data_dir, Config), case erl_ddll:load_driver(Path, DrvName) of - ok -> ok; - {error, Error} -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - ?line ?t:fail() + ok -> ok; + {error, Error} -> + ct:fail(erl_ddll:format_error(Error)) end, - ?line Port = open_port({spawn, DrvName}, []), - + Port = open_port({spawn, DrvName}, []), + NotSuspended = fun (Proc) -> - chk_not_value({status,suspended}, - process_info(Proc, status)) - end, + chk_not_value({status,suspended}, + process_info(Proc, status)) + end, NotBusyEnd = fun (Proc, Res, Time) -> - receive - {Port, caller, Proc} -> ok - after - 500 -> exit(missing_caller_message) - end, - chk_value({return, true}, Res), - chk_range(0, Time, 100) - end, + receive + {Port, caller, Proc} -> ok + after + 500 -> exit(missing_caller_message) + end, + chk_value({return, true}, Res), + chk_range(0, Time, 100) + end, ForceEnd = fun (Proc, Res, Time) -> - case HardBusy of - false -> - NotBusyEnd(Proc, Res, Time); - true -> - chk_value({error, notsup}, Res), - chk_range(0, Time, 100), - receive - Msg -> exit({unexpected_msg, Msg}) - after - 500 -> ok - end - end - end, + case HardBusy of + false -> + NotBusyEnd(Proc, Res, Time); + true -> + chk_value({error, notsup}, Res), + chk_range(0, Time, 100), + receive + Msg -> exit({unexpected_msg, Msg}) + after + 500 -> ok + end + end + end, BadArg = fun (_Proc, Res, Time) -> - chk_value({error, badarg}, Res), - chk_range(0, Time, 100) - end, + chk_value({error, badarg}, Res), + chk_range(0, Time, 100) + end, %% Not busy %% Not busy; nosuspend option - ?line hs_busy_pcmd(Port, [nosuspend], NotSuspended, NotBusyEnd), + hs_busy_pcmd(Port, [nosuspend], NotSuspended, NotBusyEnd), %% Not busy; force option - ?line hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd), + hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd), %% Not busy; force and nosuspend option - ?line hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd), + hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd), %% Not busy; no option - ?line hs_busy_pcmd(Port, [], NotSuspended, NotBusyEnd), + hs_busy_pcmd(Port, [], NotSuspended, NotBusyEnd), %% Not busy; bad option - ?line hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg), + hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg), %% Make busy - ?line erlang:port_control(Port, $B, []), + erlang:port_control(Port, $B, []), %% Busy; nosuspend option - ?line hs_busy_pcmd(Port, [nosuspend], NotSuspended, - fun (_Proc, Res, Time) -> - chk_value({return, false}, Res), - chk_range(0, Time, 100), - receive - Msg -> exit({unexpected_msg, Msg}) - after - 500 -> ok - end - end), + hs_busy_pcmd(Port, [nosuspend], NotSuspended, + fun (_Proc, Res, Time) -> + chk_value({return, false}, Res), + chk_range(0, Time, 100), + receive + Msg -> exit({unexpected_msg, Msg}) + after + 500 -> ok + end + end), %% Busy; force option - ?line hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd), + hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd), %% Busy; force and nosuspend option - ?line hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd), + hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd), %% Busy; bad option - ?line hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg), + hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg), %% no option on busy port - ?line hs_busy_pcmd(Port, [], - fun (Proc) -> - receive after 1000 -> ok end, - chk_value({status,suspended}, - process_info(Proc, status)), - - %% Make not busy - erlang:port_control(Port, $N, []) - end, - fun (_Proc, Res, Time) -> - chk_value({return, true}, Res), - chk_range(1000, Time, 2000) - end), - - ?line true = erlang:port_close(Port), - ?line ok = erl_ddll:unload_driver(DrvName), - ?line ok = erl_ddll:stop(), - ?line ok. + hs_busy_pcmd(Port, [], + fun (Proc) -> + receive after 1000 -> ok end, + chk_value({status,suspended}, + process_info(Proc, status)), + + %% Make not busy + erlang:port_control(Port, $N, []) + end, + fun (_Proc, Res, Time) -> + chk_value({return, true}, Res), + chk_range(1000, Time, 2000) + end), + + true = erlang:port_close(Port), + ok = erl_ddll:unload_driver(DrvName), + ok = erl_ddll:stop(), + ok. hs_busy_pcmd(Prt, Opts, StartFun, EndFun) -> Tester = self(), P = spawn_link(fun () -> - erlang:yield(), - Tester ! {self(), doing_port_command}, - Start = erlang:monotonic_time(micro_seconds), - Res = try {return, - port_command(Prt, [], Opts)} - catch Exception:Error -> {Exception, Error} - end, - End = erlang:monotonic_time(micro_seconds), - Time = round((End - Start)/1000), - Tester ! {self(), port_command_result, Res, Time} - end), + erlang:yield(), + Tester ! {self(), doing_port_command}, + Start = erlang:monotonic_time(micro_seconds), + Res = try {return, + port_command(Prt, [], Opts)} + catch Exception:Error -> {Exception, Error} + end, + End = erlang:monotonic_time(micro_seconds), + Time = round((End - Start)/1000), + Tester ! {self(), port_command_result, Res, Time} + end), receive - {P, doing_port_command} -> - ok + {P, doing_port_command} -> + ok end, StartFun(P), receive - {P, port_command_result, Res, Time} -> - EndFun(P, Res, Time) + {P, port_command_result, Res, Time} -> + EndFun(P, Res, Time) end. scheduling_delay_busy(Config) -> - - Scenario = - [{1,{spawn,[{var,drvname},undefined]}}, - {2,{call,[{var,1},open_port]}}, - {3,{spawn,[{var,2},{var,1}]}}, - {0,{ack,[{var,1},{busy,1,250}]}}, - {0,{cast,[{var,3},{command,2}]}}, - [{0,{cast,[{var,3},{command,I}]}} - || I <- lists:seq(3,50)], - {0,{cast,[{var,3},take_control]}}, - {0,{cast,[{var,1},{new_owner,{var,3}}]}}, - {0,{cast,[{var,3},close]}}, - {0,{timer,sleep,[300]}}, - {0,{erlang,port_command,[{var,2},<<$N>>,[force]]}}, - [{0,{cast,[{var,1},{command,I}]}} - || I <- lists:seq(101,127)] - ,{10,{call,[{var,3},get_data]}} - ], + Scenario = [{1,{spawn,[{var,drvname},undefined]}}, + {2,{call,[{var,1},open_port]}}, + {3,{spawn,[{var,2},{var,1}]}}, + {0,{ack,[{var,1},{busy,1,250}]}}, + {0,{cast,[{var,3},{command,2}]}}, + [{0,{cast,[{var,3},{command,I}]}} || I <- lists:seq(3,50)], + {0,{cast,[{var,3},take_control]}}, + {0,{cast,[{var,1},{new_owner,{var,3}}]}}, + {0,{cast,[{var,3},close]}}, + {0,{timer,sleep,[300]}}, + {0,{erlang,port_command,[{var,2},<<$N>>,[force]]}}, + [{0,{cast,[{var,1},{command,I}]}} || I <- lists:seq(101,127)], + {10,{call,[{var,3},get_data]}}], Validation = [{seq,10,lists:seq(1,50)}], - port_scheduling(Scenario,Validation,?config(data_dir,Config)). + port_scheduling(Scenario,Validation,proplists:get_value(data_dir,Config)). scheduling_delay_busy_nosuspend(Config) -> - - Scenario = - [{1,{spawn,[{var,drvname},undefined]}}, - {2,{call,[{var,1},open_port]}}, - {0,{cast,[{var,1},{command,1,100}]}}, - {0,{cast,[{var,1},{busy,2}]}}, - {0,{timer,sleep,[200]}}, % ensure reached port - {10,{call,[{var,1},{command,3,[nosuspend]}]}}, - {0,{timer,sleep,[200]}}, - {0,{erlang,port_command,[{var,2},<<$N>>,[force]]}}, - {0,{cast,[{var,1},close]}}, - {20,{call,[{var,1},get_data]}} - ], + Scenario = [{1,{spawn,[{var,drvname},undefined]}}, + {2,{call,[{var,1},open_port]}}, + {0,{cast,[{var,1},{command,1,100}]}}, + {0,{cast,[{var,1},{busy,2}]}}, + {0,{timer,sleep,[200]}}, % ensure reached port + {10,{call,[{var,1},{command,3,[nosuspend]}]}}, + {0,{timer,sleep,[200]}}, + {0,{erlang,port_command,[{var,2},<<$N>>,[force]]}}, + {0,{cast,[{var,1},close]}}, + {20,{call,[{var,1},get_data]}}], Validation = [{eq,10,nosuspend},{seq,20,[1,2]}], - port_scheduling(Scenario,Validation,?config(data_dir,Config)). + port_scheduling(Scenario,Validation,proplists:get_value(data_dir,Config)). scheduling_busy_link(Config) -> - - Scenario = - [{1,{spawn,[{var,drvname},undefined]}}, - {2,{call,[{var,1},open_port]}}, - {3,{spawn,[{var,2},{var,1}]}}, - {0,{cast,[{var,1},unlink]}}, - {0,{cast,[{var,1},{busy,1}]}}, - {0,{cast,[{var,1},{command,2}]}}, - {0,{cast,[{var,1},link]}}, - {0,{timer,sleep,[1000]}}, - {0,{ack,[{var,3},take_control]}}, - {0,{cast,[{var,1},{new_owner,{var,3}}]}}, - {0,{cast,[{var,3},close]}}, - {10,{call,[{var,3},get_data]}}, - {20,{call,[{var,1},get_exit]}} - ], + Scenario = [{1,{spawn,[{var,drvname},undefined]}}, + {2,{call,[{var,1},open_port]}}, + {3,{spawn,[{var,2},{var,1}]}}, + {0,{cast,[{var,1},unlink]}}, + {0,{cast,[{var,1},{busy,1}]}}, + {0,{cast,[{var,1},{command,2}]}}, + {0,{cast,[{var,1},link]}}, + {0,{timer,sleep,[1000]}}, + {0,{ack,[{var,3},take_control]}}, + {0,{cast,[{var,1},{new_owner,{var,3}}]}}, + {0,{cast,[{var,3},close]}}, + {10,{call,[{var,3},get_data]}}, + {20,{call,[{var,1},get_exit]}}], Validation = [{seq,10,[1]}, {seq,20,[{'EXIT',noproc}]}], - port_scheduling(Scenario,Validation,?config(data_dir,Config)). + port_scheduling(Scenario,Validation,proplists:get_value(data_dir,Config)). process_init(DrvName,Owner) -> process_flag(trap_exit,true), @@ -699,11 +640,11 @@ handle_msg(close,Port,Owner,_Data) -> handle_msg(get_data,Port,_Owner,{[],_Exit}) -> %% Wait for data if it has not arrived yet receive - {Port,{data,Data}} -> - Data + {Port,{data,Data}} -> + Data after 2000 -> - pal("~p",[erlang:process_info(self())]), - exit(did_not_get_port_data) + pal("~p",[erlang:process_info(self())]), + exit(did_not_get_port_data) end; handle_msg(get_data,_Port,Owner,{Data,Exit}) -> pal("GetData",[]), @@ -753,8 +694,7 @@ port_scheduling(Scenario,Validation,Path) -> case erl_ddll:load_driver(Path, DrvName) of ok -> ok; {error, Error} -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - ?line ?t:fail() + ct:fail(erl_ddll:format_error(Error)) end, Data = run_scenario(lists:flatten(Scenario),[{drvname,DrvName}]), @@ -860,7 +800,7 @@ wait_for(Pids) -> {'EXIT', Pid, normal} -> wait_for(lists:delete(Pid, Pids)); Other -> - test_server:fail({bad_exit, Other}) + ct:fail({bad_exit, Other}) end. fun_spawn(Fun) -> @@ -896,39 +836,38 @@ fun_spawn(Fun, Args) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% load_busy_driver(Config) when is_list(Config) -> - ?line DataDir = ?config(data_dir, Config), - ?line erl_ddll:start(), + DataDir = proplists:get_value(data_dir, Config), + erl_ddll:start(), case erl_ddll:load_driver(DataDir, "busy_drv") of ok -> ok; {error, Error} -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - ?line ?t:fail() + ct:fail(erl_ddll:format_error(Error)) end. %%% Interface functions. start_busy_driver(Config) when is_list(Config) -> - ?line Pid = spawn_link(?MODULE, init, [Config, self()]), - ?line receive + Pid = spawn_link(?MODULE, init, [Config, self()]), + receive {Pid, started} -> ok; Other -> - test_server:fail({unexpected_message, Other}) + ct:fail({unexpected_message, Other}) end. unlock_slave() -> command(unlock). get_slave() -> - ?line command(get_slave). + command(get_slave). %% Internal functions. command(Msg) -> - ?line whereis(busy_drv_server) ! {self(), Msg}, - ?line receive - {busy_drv_reply, Reply} -> - Reply + whereis(busy_drv_server) ! {self(), Msg}, + receive + {busy_drv_reply, Reply} -> + Reply end. %%% Server. diff --git a/erts/emulator/test/busy_port_SUITE_data/Makefile.src b/erts/emulator/test/busy_port_SUITE_data/Makefile.src index 0f2842e515..ae6378a6ff 100644 --- a/erts/emulator/test/busy_port_SUITE_data/Makefile.src +++ b/erts/emulator/test/busy_port_SUITE_data/Makefile.src @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2013. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c b/erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c index f83fa1eeaa..c4e0f13f06 100644 --- a/erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c +++ b/erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c b/erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c index be913cf56e..ffaca18e90 100644 --- a/erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c +++ b/erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2013. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/busy_port_SUITE_data/scheduling_drv.c b/erts/emulator/test/busy_port_SUITE_data/scheduling_drv.c index 40e42b6ac2..296b3f21de 100644 --- a/erts/emulator/test/busy_port_SUITE_data/scheduling_drv.c +++ b/erts/emulator/test/busy_port_SUITE_data/scheduling_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2013. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c b/erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c index 3c5bafb451..8a98f050f1 100644 --- a/erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c +++ b/erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl index 064404a038..6ba6301c7c 100644 --- a/erts/emulator/test/call_trace_SUITE.erl +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,66 +21,46 @@ -module(call_trace_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, - hipe/1,process_specs/1,basic/1,flags/1,errors/1,pam/1,change_pam/1, - return_trace/1,exception_trace/1,on_load/1,deep_exception/1, - upgrade/1, - exception_nocatch/1,bit_syntax/1]). +-export([all/0, suite/0, + init_per_testcase/2,end_per_testcase/2, + hipe/1,process_specs/1,basic/1,flags/1,errors/1,pam/1,change_pam/1, + return_trace/1,exception_trace/1,on_load/1,deep_exception/1, + upgrade/1, + exception_nocatch/1,bit_syntax/1]). %% Helper functions. -export([bar/0,foo/0,foo/1,foo/2,expect/1,worker_foo/1,pam_foo/2,nasty/0, - id/1,deep/3,deep_1/3,deep_2/2,deep_3/2,deep_4/1,deep_5/1, - bs_sum_a/2,bs_sum_b/2]). + id/1,deep/3,deep_1/3,deep_2/2,deep_3/2,deep_4/1,deep_5/1, + bs_sum_a/2,bs_sum_b/2]). %% Debug -export([abbr/1,abbr/2]). - --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(P, 20). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 30}}]. all() -> Common = [errors, on_load], NotHipe = [process_specs, basic, flags, pam, change_pam, - upgrade, - return_trace, exception_trace, deep_exception, - exception_nocatch, bit_syntax], + upgrade, + return_trace, exception_trace, deep_exception, + exception_nocatch, bit_syntax], Hipe = [hipe], case test_server:is_native(call_trace_SUITE) of - true -> Hipe ++ Common; - false -> NotHipe ++ Common + true -> Hipe ++ Common; + false -> NotHipe ++ Common end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:seconds(30)), - [{watchdog, Dog}|Config]. + Config. end_per_testcase(_Func, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - %% Reloading the module will clear all trace patterns, and %% in a debug-compiled emulator run assertions of the counters %% for the number of traced exported functions in this module. @@ -88,51 +68,63 @@ end_per_testcase(_Func, Config) -> c:l(?MODULE). hipe(Config) when is_list(Config) -> - ?line 0 = erlang:trace_pattern({?MODULE,worker_foo,1}, true), - ?line 0 = erlang:trace_pattern({?MODULE,worker_foo,1}, true, [local]), - ?line AllFuncs = erlang:trace_pattern({'_','_','_'}, true), + 0 = erlang:trace_pattern({?MODULE,worker_foo,1}, true), + 0 = erlang:trace_pattern({?MODULE,worker_foo,1}, true, [local]), + AllFuncs = erlang:trace_pattern({'_','_','_'}, true), %% Make sure that a traced, exported function can still be found. - ?line true = erlang:function_exported(error_handler, undefined_function, 3), - ?line AllFuncs = erlang:trace_pattern({'_','_','_'}, false), + true = erlang:function_exported(error_handler, undefined_function, 3), + AllFuncs = erlang:trace_pattern({'_','_','_'}, false), ok. -process_specs(doc) -> - "Tests 'all', 'new', and 'existing' for specifying processes."; -process_specs(suite) -> []; +%% Tests 'all', 'new', and 'existing' for specifying processes. process_specs(Config) when is_list(Config) -> - ?line Tracer = start_tracer(), - ?line {flags,[call]} = trace_info(self(), flags), - ?line {tracer,Tracer} = trace_info(self(), tracer), - ?line trace_func({?MODULE,worker_foo,1}, []), - - %% Test the 'new' flag. - - ?line {Work1A,Work1B} = start_and_trace(new, [1,2,3], A1B={3,2,1}), - {flags,[]} = trace_info(Work1A, flags), - {tracer,[]} = trace_info(Work1A, tracer), - {tracer,Tracer} = trace_info(Work1B, tracer), - {flags,[call]} = trace_info(Work1B, flags), - ?line expect({trace,Work1B,call,{?MODULE,worker_foo,[A1B]}}), - ?line unlink(Work1B), - ?line Mref = erlang:monitor(process, Work1B), - ?line exit(Work1B, kill), - receive - {'DOWN',Mref,_,_,_} -> ok - end, - ?line undefined = trace_info(Work1B, flags), - ?line {flags,[]} = trace_info(new, flags), - ?line {tracer,[]} = trace_info(new, tracer), - - %% Test the 'existing' flag. - ?line {Work2A,_Work2B} = start_and_trace(existing, A2A=[5,6,7], [7,6,5]), - ?line expect({trace,Work2A,call,{?MODULE,worker_foo,[A2A]}}), - - %% Test the 'all' flag. - ?line {Work3A,Work3B} = start_and_trace(all, A3A=[12,13], A3B=[13,12]), - ?line expect({trace,Work3A,call,{?MODULE,worker_foo,[A3A]}}), - ?line expect({trace,Work3B,call,{?MODULE,worker_foo,[A3B]}}), - + Tracer = start_tracer(), + {flags,[call]} = trace_info(self(), flags), + {tracer,Tracer} = trace_info(self(), tracer), + trace_func({?MODULE,worker_foo,1}, []), + + %% Test the 'new' and 'new_processes' flags. + + New = fun(Flag) -> + {Work1A,Work1B} = start_and_trace(Flag, [1,2,3], A1B={3,2,1}), + {flags,[]} = trace_info(Work1A, flags), + {tracer,[]} = trace_info(Work1A, tracer), + {tracer,Tracer} = trace_info(Work1B, tracer), + {flags,[call]} = trace_info(Work1B, flags), + expect({trace,Work1B,call,{?MODULE,worker_foo,[A1B]}}), + unlink(Work1B), + Mref = erlang:monitor(process, Work1B), + exit(Work1B, kill), + receive + {'DOWN',Mref,_,_,_} -> ok + end, + undefined = trace_info(Work1B, flags), + {flags,[]} = trace_info(Flag, flags), + {tracer,[]} = trace_info(Flag, tracer) + end, + New(new), + New(new_processes), + + %% Test the 'existing' and 'existing_processes' flags. + Existing = + fun(Flag) -> + {Work2A,_Work2B} = start_and_trace(Flag, A2A=[5,6,7], [7,6,5]), + expect({trace,Work2A,call,{?MODULE,worker_foo,[A2A]}}) + end, + Existing(existing), + Existing(existing_processes), + + %% Test the 'all' and 'processes' flags. + All = + fun(Flag) -> + {Work3A,Work3B} = start_and_trace(Flag, A3A=[12,13], A3B=[13,12]), + expect({trace,Work3A,call,{?MODULE,worker_foo,[A3A]}}), + expect({trace,Work3B,call,{?MODULE,worker_foo,[A3B]}}) + end, + All(all), + All(processes), + ok. start_and_trace(Flag, A1, A2) -> @@ -142,33 +134,33 @@ start_and_trace(Flag, A1, A2) -> call_worker(W1, A1), call_worker(W2, A2), case Flag of - new -> - {flags,[call]} = trace_info(new, flags), - {tracer,_} = trace_info(new, tracer); - _Other -> - ok + new -> + {flags,[call]} = trace_info(new, flags), + {tracer,_} = trace_info(new, tracer); + _Other -> + ok end, trace_pid(Flag, false, [call]), {W1,W2}. start_worker() -> - ?line spawn(fun worker_loop/0). + spawn(fun worker_loop/0). call_worker(Pid, Arg) -> Pid ! {self(),{call,Arg}}, receive - {result,Res} -> Res + {result,Res} -> Res after 5000 -> - ?line ?t:fail(no_answer_from_worker) + ct:fail(no_answer_from_worker) end. worker_loop() -> receive - {From,{call,Arg}} -> - From ! {result,?MODULE:worker_foo(Arg)}, - worker_loop(); - Other -> - exit({unexpected_message,Other}) + {From,{call,Arg}} -> + From ! {result,?MODULE:worker_foo(Arg)}, + worker_loop(); + Other -> + exit({unexpected_message,Other}) end. worker_foo(_Arg) -> @@ -177,98 +169,98 @@ worker_foo(_Arg) -> %% Basic test of the call tracing (we trace one process). basic(_Config) -> case test_server:is_native(lists) of - true -> {skip,"lists is native"}; - false -> basic() + true -> {skip,"lists is native"}; + false -> basic() end. basic() -> - ?line start_tracer(), - ?line trace_info(self(), flags), - ?line trace_info(self(), tracer), - ?line 0 = trace_func({?MODULE,no_such_function,0}, []), - ?line {traced,undefined} = - trace_info({?MODULE,no_such_function,0}, traced), - ?line {match_spec, undefined} = - trace_info({?MODULE,no_such_function,0}, match_spec), + start_tracer(), + trace_info(self(), flags), + trace_info(self(), tracer), + 0 = trace_func({?MODULE,no_such_function,0}, []), + {traced,undefined} = + trace_info({?MODULE,no_such_function,0}, traced), + {match_spec, undefined} = + trace_info({?MODULE,no_such_function,0}, match_spec), %% Trace some functions... - ?line trace_func({lists,'_','_'}, []), + trace_func({lists,'_','_'}, []), %% Make sure that tracing the same functions more than once %% does not cause any problems. - ?line 3 = trace_func({?MODULE,foo,'_'}, true), - ?line 3 = trace_func({?MODULE,foo,'_'}, true), - ?line 1 = trace_func({?MODULE,bar,0}, true), - ?line 1 = trace_func({?MODULE,bar,0}, true), - ?line {traced,global} = trace_info({?MODULE,bar,0}, traced), - ?line 1 = trace_func({erlang,list_to_integer,1}, true), - ?line {traced,global} = trace_info({erlang,list_to_integer,1}, traced), + 3 = trace_func({?MODULE,foo,'_'}, true), + 3 = trace_func({?MODULE,foo,'_'}, true), + 1 = trace_func({?MODULE,bar,0}, true), + 1 = trace_func({?MODULE,bar,0}, true), + {traced,global} = trace_info({?MODULE,bar,0}, traced), + 1 = trace_func({erlang,list_to_integer,1}, true), + {traced,global} = trace_info({erlang,list_to_integer,1}, traced), %% ... and call them... - ?line AList = [x,y,z], - ?line true = lists:member(y, AList), - ?line foo0 = ?MODULE:foo(), - ?line 4 = ?MODULE:foo(3), - ?line 11 = ?MODULE:foo(7, 4), - ?line ok = ?MODULE:bar(), - ?line 42 = list_to_integer(non_literal("42")), + AList = [x,y,z], + true = lists:member(y, AList), + foo0 = ?MODULE:foo(), + 4 = ?MODULE:foo(3), + 11 = ?MODULE:foo(7, 4), + ok = ?MODULE:bar(), + 42 = list_to_integer(non_literal("42")), %% ... make sure the we got trace messages (but not for ?MODULE:expect/1). - ?line Self = self(), - ?line ?MODULE:expect({trace,Self,call,{lists,member,[y,AList]}}), - ?line ?MODULE:expect({trace,Self,call,{?MODULE,foo,[]}}), - ?line ?MODULE:expect({trace,Self,call,{?MODULE,foo,[3]}}), - ?line ?MODULE:expect({trace,Self,call,{?MODULE,foo,[7,4]}}), - ?line ?MODULE:expect({trace,Self,call,{?MODULE,bar,[]}}), - ?line ?MODULE:expect({trace,Self,call,{erlang,list_to_integer,["42"]}}), + Self = self(), + ?MODULE:expect({trace,Self,call,{lists,member,[y,AList]}}), + ?MODULE:expect({trace,Self,call,{?MODULE,foo,[]}}), + ?MODULE:expect({trace,Self,call,{?MODULE,foo,[3]}}), + ?MODULE:expect({trace,Self,call,{?MODULE,foo,[7,4]}}), + ?MODULE:expect({trace,Self,call,{?MODULE,bar,[]}}), + ?MODULE:expect({trace,Self,call,{erlang,list_to_integer,["42"]}}), %% Turn off trace for this module and call functions... - ?line trace_func({?MODULE,'_','_'}, false), - ?line {traced,false} = trace_info({?MODULE,bar,0}, traced), - ?line foo0 = ?MODULE:foo(), - ?line 4 = ?MODULE:foo(3), - ?line 11 = ?MODULE:foo(7, 4), - ?line ok = ?MODULE:bar(), - ?line [1,2,3,4,5,6,7,8,9,10] = lists:seq(1, 10), - ?line 777 = list_to_integer(non_literal("777")), + trace_func({?MODULE,'_','_'}, false), + {traced,false} = trace_info({?MODULE,bar,0}, traced), + foo0 = ?MODULE:foo(), + 4 = ?MODULE:foo(3), + 11 = ?MODULE:foo(7, 4), + ok = ?MODULE:bar(), + [1,2,3,4,5,6,7,8,9,10] = lists:seq(1, 10), + 777 = list_to_integer(non_literal("777")), %% ... turn on all trace messages... - ?line trace_func({'_','_','_'}, false), - ?line [b,a] = lists:reverse([a,b]), + trace_func({'_','_','_'}, false), + [b,a] = lists:reverse([a,b]), %% Read out the remaing trace messages. - ?line ?MODULE:expect({trace,Self,call,{lists,seq,[1,10]}}), - ?line ?MODULE:expect({trace,Self,call,{erlang,list_to_integer,["777"]}}), + ?MODULE:expect({trace,Self,call,{lists,seq,[1,10]}}), + ?MODULE:expect({trace,Self,call,{erlang,list_to_integer,["777"]}}), receive - Any -> - ?line ?t:fail({unexpected_message,Any}) + Any -> + ct:fail({unexpected_message,Any}) after 1 -> - ok + ok end, %% Turn on and then off tracing on all external functions. %% This might cause the emulator to crasch later if it doesn't %% restore all export entries properly. - ?line AllFuncs = trace_func({'_','_','_'}, true), + AllFuncs = trace_func({'_','_','_'}, true), io:format("AllFuncs = ~p", [AllFuncs]), %% Make sure that a traced, exported function can still be found. - ?line true = erlang:function_exported(error_handler, undefined_function, 3), - ?line AllFuncs = trace_func({'_','_','_'}, false), - ?line erlang:trace_delivered(all), + true = erlang:function_exported(error_handler, undefined_function, 3), + AllFuncs = trace_func({'_','_','_'}, false), + erlang:trace_delivered(all), receive - {trace_delivered,_,_} -> ok + {trace_delivered,_,_} -> ok end, c:flush(), % Print the traces messages. c:flush(), % Print the traces messages. - ?line {traced,false} = trace_info({erlang,list_to_integer,1}, traced), + {traced,false} = trace_info({erlang,list_to_integer,1}, traced), ok. @@ -287,8 +279,8 @@ foo(X, Y) -> X+Y. %% This test case was written to verify that we do not change %% any behaviour with the introduction of "block-free" upgrade in R16. %% In short: Do not refer to this test case as an authority of how it must work. -upgrade(doc) -> - "Test tracing on module being upgraded"; + +%% Test tracing on module being upgraded upgrade(Config) when is_list(Config) -> V1 = compile_version(my_upgrade_test, 1, Config), V2 = compile_version(my_upgrade_test, 2, Config), @@ -304,8 +296,8 @@ upgrade_do(V1, V2, TraceLocalVersion) -> trace_func({my_upgrade_test,'_','_'}, [], [global]), case TraceLocalVersion of - true -> trace_func({my_upgrade_test,local_version,0}, [], [local]); - _ -> ok + true -> trace_func({my_upgrade_test,local_version,0}, [], [local]); + _ -> ok end, 1 = my_upgrade_test:version(), 1 = my_upgrade_test:do_local(), @@ -320,15 +312,15 @@ upgrade_do(V1, V2, TraceLocalVersion) -> expect({trace,Self,call,{my_upgrade_test,do_local,[]}}), expect({trace,Self,call,{my_upgrade_test,do_real_local,[]}}), case TraceLocalVersion of - true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); - _ -> ok + true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); + _ -> ok end, expect({trace,Self,call,{my_upgrade_test,make_fun_exp,[]}}), expect({trace,Self,call,{my_upgrade_test,make_fun_local,[]}}), expect({trace,Self,call,{my_upgrade_test,version,[]}}), % F1_exp case TraceLocalVersion of - true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); % F1_loc - _ -> ok + true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); % F1_loc + _ -> ok end, {module,my_upgrade_test} = erlang:load_module(my_upgrade_test, V2), @@ -350,8 +342,8 @@ upgrade_do(V1, V2, TraceLocalVersion) -> trace_func({my_upgrade_test,'_','_'}, [], [global]), case TraceLocalVersion of - true -> trace_func({my_upgrade_test,local_version,0}, [], [local]); - _ -> ok + true -> trace_func({my_upgrade_test,local_version,0}, [], [local]); + _ -> ok end, 2 = my_upgrade_test:version(), 2 = my_upgrade_test:do_local(), @@ -363,13 +355,13 @@ upgrade_do(V1, V2, TraceLocalVersion) -> expect({trace,Self,call,{my_upgrade_test,do_local,[]}}), expect({trace,Self,call,{my_upgrade_test,do_real_local,[]}}), case TraceLocalVersion of - true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); - _ -> ok + true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); + _ -> ok end, expect({trace,Self,call,{my_upgrade_test,version,[]}}), % F2_exp case TraceLocalVersion of - true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); % F2_loc - _ -> ok + true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); % F2_loc + _ -> ok end, true = erlang:delete_module(my_upgrade_test), @@ -385,10 +377,10 @@ upgrade_do(V1, V2, TraceLocalVersion) -> ok. compile_version(Module, Version, Config) -> - Data = ?config(data_dir, Config), + Data = proplists:get_value(data_dir, Config), File = filename:join(Data, atom_to_list(Module)), {ok,Module,Bin} = compile:file(File, [{d,'VERSION',Version}, - binary,report]), + binary,report]), Bin. @@ -397,162 +389,157 @@ compile_version(Module, Version, Config) -> %% Also, test the '{tracer,Pid}' option. flags(_Config) -> case test_server:is_native(filename) of - true -> {skip,"filename is native"}; - false -> flags() + true -> {skip,"filename is native"}; + false -> flags() end. flags() -> - ?line Tracer = start_tracer_loop(), - ?line trace_pid(self(), true, [call,{tracer,Tracer}]), + Tracer = start_tracer_loop(), + trace_pid(self(), true, [call,{tracer,Tracer}]), %% Trace some functions... - ?line trace_func({filename,'_','_'}, true), + trace_func({filename,'_','_'}, true), %% ... and call them... - ?line Self = self(), - ?line filename:absname("nisse"), - ?line ?MODULE:expect({trace,Self,call,{filename,absname,["nisse"]}}), - ?line trace_pid(Self, true, [call,arity]), - ?line filename:absname("kalle"), - ?line filename:absname("kalle", "/root"), - ?line ?MODULE:expect({trace,Self,call,{filename,absname,1}}), - ?line ?MODULE:expect({trace,Self,call,{filename,absname,2}}), - ?line trace_info(Self, flags), + Self = self(), + filename:absname("nisse"), + ?MODULE:expect({trace,Self,call,{filename,absname,["nisse"]}}), + trace_pid(Self, true, [call,arity]), + filename:absname("kalle"), + filename:absname("kalle", "/root"), + ?MODULE:expect({trace,Self,call,{filename,absname,1}}), + ?MODULE:expect({trace,Self,call,{filename,absname,2}}), + trace_info(Self, flags), %% Timestamp + arity. flag_test(fun() -> - ?line trace_pid(Self, true, [timestamp]), - ?line "dum" = filename:basename("/abcd/dum"), - ?line Ts = expect({trace_ts,Self,call,{filename,basename,1},ts}), - ?line trace_info(Self, flags), - Ts - end), + trace_pid(Self, true, [timestamp]), + "dum" = filename:basename("/abcd/dum"), + Ts = expect({trace_ts,Self,call,{filename,basename,1},ts}), + trace_info(Self, flags), + Ts + end), %% Timestamp. - ?line AnArg = "/abcd/hejsan", + AnArg = "/abcd/hejsan", flag_test(fun() -> - ?line trace_pid(Self, false, [arity]), - ?line "hejsan" = filename:basename(AnArg), - ?line Ts = expect({trace_ts,Self,call, - {filename,basename,[AnArg]},ts}), - ?line trace_info(Self, flags), - Ts - end), + trace_pid(Self, false, [arity]), + "hejsan" = filename:basename(AnArg), + Ts = expect({trace_ts,Self,call, + {filename,basename,[AnArg]},ts}), + trace_info(Self, flags), + Ts + end), %% All flags turned off. - ?line trace_pid(Self, false, [timestamp]), - ?line AnotherArg = filename:join(AnArg, "hoppsan"), - ?line "hoppsan" = filename:basename(AnotherArg), - ?line expect({trace,Self,call,{filename,join,[AnArg,"hoppsan"]}}), - ?line expect({trace,Self,call,{filename,basename,[AnotherArg]}}), - ?line trace_info(Self, flags), - + trace_pid(Self, false, [timestamp]), + AnotherArg = filename:join(AnArg, "hoppsan"), + "hoppsan" = filename:basename(AnotherArg), + expect({trace,Self,call,{filename,join,[AnArg,"hoppsan"]}}), + expect({trace,Self,call,{filename,basename,[AnotherArg]}}), + trace_info(Self, flags), + ok. flag_test(Test) -> Now = now(), Ts = Test(), case timer:now_diff(Ts, Now) of - Time when Time < 5*1000000 -> - %% Reasonable short time. - ok; - _Diff -> - %% Too large difference. - io:format("Now = ~p\n", [Now]), - io:format("Ts = ~p\n", [Ts]), - ?line ?t:fail() + Time when Time < 5*1000000 -> + %% Reasonable short time. + ok; + _Diff -> + %% Too large difference. + ct:fail("Now = ~p, Ts = ~p", [Now, Ts]) end, flag_test_cpu_timestamp(Test). flag_test_cpu_timestamp(Test) -> try erlang:trace(all, true, [cpu_timestamp]) of - _ -> - io:format("CPU timestamps"), - Ts = Test(), - erlang:trace(all, false, [cpu_timestamp]), - Origin = {0,0,0}, - Hour = 3600*1000000, - case timer:now_diff(Ts, Origin) of - Diff when Diff < 4*Hour -> - %% In the worst case, CPU timestamps count from when this - %% Erlang emulator was started. The above test is a conservative - %% test that all CPU timestamps should pass. - ok; - _Time -> - io:format("Strange CPU timestamp: ~p", [Ts]), - ?line ?t:fail() - end, - io:format("Turned off CPU timestamps") + _ -> + io:format("CPU timestamps"), + Ts = Test(), + erlang:trace(all, false, [cpu_timestamp]), + Origin = {0,0,0}, + Hour = 3600*1000000, + case timer:now_diff(Ts, Origin) of + Diff when Diff < 4*Hour -> + %% In the worst case, CPU timestamps count from when this + %% Erlang emulator was started. The above test is a conservative + %% test that all CPU timestamps should pass. + ok; + _Time -> + ct:fail("Strange CPU timestamp: ~p", [Ts]) + end, + io:format("Turned off CPU timestamps") catch - error:badarg -> ok + error:badarg -> ok end. -errors(doc) -> "Test bad arguments for trace/3 and trace_pattern/3."; -errors(suite) -> []; +%% Test bad arguments for trace/3 and trace_pattern/3. errors(Config) when is_list(Config) -> - ?line expect_badarg_pid(aaa, true, []), - ?line expect_badarg_pid({pid,dum}, false, []), - ?line expect_badarg_func({'_','_',1}, []), - ?line expect_badarg_func({'_',gosh,1}, []), - ?line expect_badarg_func({xxx,'_',2}, []), - ?line expect_badarg_func({xxx,yyy,b}, glurp), + expect_badarg_pid(aaa, true, []), + expect_badarg_pid({pid,dum}, false, []), + expect_badarg_func({'_','_',1}, []), + expect_badarg_func({'_',gosh,1}, []), + expect_badarg_func({xxx,'_',2}, []), + expect_badarg_func({xxx,yyy,b}, glurp), ok. expect_badarg_pid(What, How, Flags) -> case catch erlang:trace(What, How, Flags) of - {'EXIT',{badarg,Where}} -> - io:format("trace(~p, ~p, ~p) ->\n {'EXIT',{badarg,~p}}", - [What,How,Flags,Where]), - ok; - Other -> - io:format("trace(~p, ~p, ~p) -> ~p", - [What,How,Flags,Other]), - ?t:fail({unexpected,Other}) + {'EXIT',{badarg,Where}} -> + io:format("trace(~p, ~p, ~p) ->\n {'EXIT',{badarg,~p}}", + [What,How,Flags,Where]), + ok; + Other -> + io:format("trace(~p, ~p, ~p) -> ~p", + [What,How,Flags,Other]), + ct:fail({unexpected,Other}) end. expect_badarg_func(MFA, Pattern) -> case catch erlang:trace_pattern(MFA, Pattern) of - {'EXIT',{badarg,Where}} -> - io:format("trace_pattern(~p, ~p) ->\n {'EXIT',{badarg,~p}}", - [MFA,Pattern,Where]), - ok; - Other -> - io:format("trace_pattern(~p, ~p) -> ~p", - [MFA, Pattern, Other]), - ?t:fail({unexpected,Other}) + {'EXIT',{badarg,Where}} -> + io:format("trace_pattern(~p, ~p) ->\n {'EXIT',{badarg,~p}}", + [MFA,Pattern,Where]), + ok; + Other -> + io:format("trace_pattern(~p, ~p) -> ~p", + [MFA, Pattern, Other]), + ct:fail({unexpected,Other}) end. -pam(doc) -> "Basic test of PAM."; -pam(suite) -> []; +%% Basic test of PAM. pam(Config) when is_list(Config) -> - ?line start_tracer(), - ?line Self = self(), + start_tracer(), + Self = self(), %% Build the match program. - ?line Prog1 = {[{a,tuple},'$1'],[],[]}, - ?line Prog2 = {[{a,bigger,tuple},'$1'],[],[{message,'$1'}]}, - ?line MatchProg = [Prog1,Prog2], - ?line pam_trace(MatchProg), + Prog1 = {[{a,tuple},'$1'],[],[]}, + Prog2 = {[{a,bigger,tuple},'$1'],[],[{message,'$1'}]}, + MatchProg = [Prog1,Prog2], + pam_trace(MatchProg), %% Do some calls. - ?line ?MODULE:pam_foo(not_a_tuple, [a,b]), - ?line ?MODULE:pam_foo({a,tuple}, [a,list]), - ?line ?MODULE:pam_foo([this,one,will,'not',match], dummy_arg), - ?line LongList = lists:seq(1,10), - ?line ?MODULE:pam_foo({a,bigger,tuple}, LongList), + ?MODULE:pam_foo(not_a_tuple, [a,b]), + ?MODULE:pam_foo({a,tuple}, [a,list]), + ?MODULE:pam_foo([this,one,will,'not',match], dummy_arg), + LongList = lists:seq(1,10), + ?MODULE:pam_foo({a,bigger,tuple}, LongList), %% Check that we get the correct trace messages. - ?line expect({trace,Self,call,{?MODULE,pam_foo,[{a,tuple},[a,list]]}}), - ?line expect({trace,Self,call, - {?MODULE,pam_foo,[{a,bigger,tuple},LongList]}, - LongList}), + expect({trace,Self,call,{?MODULE,pam_foo,[{a,tuple},[a,list]]}}), + expect({trace,Self,call, + {?MODULE,pam_foo,[{a,bigger,tuple},LongList]}, + LongList}), - ?line trace_func({?MODULE,pam_foo,'_'}, false), + trace_func({?MODULE,pam_foo,'_'}, false), ok. pam_trace(Prog) -> @@ -567,38 +554,38 @@ pam_foo(A, B) -> %% Test changing PAM programs for a function. change_pam(_Config) -> case test_server:is_native(lists) of - true -> {skip,"lists is native"}; - false -> change_pam() + true -> {skip,"lists is native"}; + false -> change_pam() end. change_pam() -> - ?line start_tracer(), - ?line Self = self(), + start_tracer(), + Self = self(), %% Install the first match program. %% Test using timestamp at the same time. - ?line trace_pid(Self, true, [call,arity,timestamp]), - ?line Prog1 = [{['$1','$2'],[],[{message,'$1'}]}], - ?line change_pam_trace(Prog1), - ?line [x,y] = lists:append(id([x]), id([y])), - ?line {heap_size,_} = erlang:process_info(Self, heap_size), - ?line expect({trace_ts,Self,call,{lists,append,2},[x],ts}), - ?line expect({trace_ts,Self,call,{erlang,process_info,2},Self,ts}), + trace_pid(Self, true, [call,arity,timestamp]), + Prog1 = [{['$1','$2'],[],[{message,'$1'}]}], + change_pam_trace(Prog1), + [x,y] = lists:append(id([x]), id([y])), + {heap_size,_} = erlang:process_info(Self, heap_size), + expect({trace_ts,Self,call,{lists,append,2},[x],ts}), + expect({trace_ts,Self,call,{erlang,process_info,2},Self,ts}), %% Install a new PAM program. - ?line Prog2 = [{['$1','$2'],[],[{message,'$2'}]}], - ?line change_pam_trace(Prog2), - ?line [xx,yy] = lists:append(id([xx]), id([yy])), - ?line {current_function,_} = erlang:process_info(Self, current_function), - ?line expect({trace_ts,Self,call,{lists,append,2},[yy],ts}), - ?line expect({trace_ts,Self,call,{erlang,process_info,2},current_function,ts}), + Prog2 = [{['$1','$2'],[],[{message,'$2'}]}], + change_pam_trace(Prog2), + [xx,yy] = lists:append(id([xx]), id([yy])), + {current_function,_} = erlang:process_info(Self, current_function), + expect({trace_ts,Self,call,{lists,append,2},[yy],ts}), + expect({trace_ts,Self,call,{erlang,process_info,2},current_function,ts}), - ?line 1 = trace_func({lists,append,2}, false), - ?line 1 = trace_func({erlang,process_info,2}, false), - ?line {match_spec,false} = trace_info({lists,append,2}, match_spec), - ?line {match_spec,false} = trace_info({erlang,process_info,2}, match_spec), + 1 = trace_func({lists,append,2}, false), + 1 = trace_func({erlang,process_info,2}, false), + {match_spec,false} = trace_info({lists,append,2}, match_spec), + {match_spec,false} = trace_info({erlang,process_info,2}, match_spec), ok. @@ -611,71 +598,71 @@ change_pam_trace(Prog) -> return_trace(_Config) -> case test_server:is_native(lists) of - true -> {skip,"lists is native"}; - false -> return_trace() + true -> {skip,"lists is native"}; + false -> return_trace() end. return_trace() -> X = {save,me}, - ?line start_tracer(), - ?line Self = self(), + start_tracer(), + Self = self(), %% Test call and return trace and timestamp. - ?line trace_pid(Self, true, [call,timestamp]), + trace_pid(Self, true, [call,timestamp]), Stupid = {pointless,tuple}, - ?line Prog1 = [{['$1','$2'],[],[{return_trace},{message,{Stupid}}]}], - ?line 1 = trace_func({lists,append,2}, Prog1), - ?line 1 = trace_func({erlang,process_info,2}, Prog1), - ?line {match_spec,Prog1} = trace_info({lists,append,2}, match_spec), - ?line {match_spec,Prog1} = trace_info({erlang,process_info,2}, match_spec), + Prog1 = [{['$1','$2'],[],[{return_trace},{message,{Stupid}}]}], + 1 = trace_func({lists,append,2}, Prog1), + 1 = trace_func({erlang,process_info,2}, Prog1), + {match_spec,Prog1} = trace_info({lists,append,2}, match_spec), + {match_spec,Prog1} = trace_info({erlang,process_info,2}, match_spec), - ?line [x,y] = lists:append(id([x]), id([y])), + [x,y] = lists:append(id([x]), id([y])), Current = {current_function,{?MODULE,return_trace,0}}, - ?line Current = erlang:process_info(Self, current_function), - ?line expect({trace_ts,Self,call,{lists,append,[[x],[y]]},Stupid,ts}), - ?line expect({trace_ts,Self,return_from,{lists,append,2},[x,y],ts}), - ?line expect({trace_ts,Self,call,{erlang,process_info,[Self,current_function]}, - Stupid,ts}), - ?line expect({trace_ts,Self,return_from,{erlang,process_info,2},Current,ts}), + Current = erlang:process_info(Self, current_function), + expect({trace_ts,Self,call,{lists,append,[[x],[y]]},Stupid,ts}), + expect({trace_ts,Self,return_from,{lists,append,2},[x,y],ts}), + expect({trace_ts,Self,call,{erlang,process_info,[Self,current_function]}, + Stupid,ts}), + expect({trace_ts,Self,return_from,{erlang,process_info,2},Current,ts}), %% Try catch/exit. - ?line 1 = trace_func({?MODULE,nasty,0}, [{[],[],[{return_trace},{message,false}]}]), - ?line {'EXIT',good_bye} = (catch ?MODULE:nasty()), - ?line 1 = trace_func({?MODULE,nasty,0}, false), + 1 = trace_func({?MODULE,nasty,0}, [{[],[],[{return_trace},{message,false}]}]), + {'EXIT',good_bye} = (catch ?MODULE:nasty()), + 1 = trace_func({?MODULE,nasty,0}, false), %% Turn off trace. - ?line 1 = trace_func({lists,append,2}, false), - ?line 1 = trace_func({erlang,process_info,2}, false), - ?line {match_spec,false} = trace_info({lists,append,2}, match_spec), - ?line {match_spec,false} = trace_info({erlang,process_info,2}, match_spec), + 1 = trace_func({lists,append,2}, false), + 1 = trace_func({erlang,process_info,2}, false), + {match_spec,false} = trace_info({lists,append,2}, match_spec), + {match_spec,false} = trace_info({erlang,process_info,2}, match_spec), %% No timestamp, no trace message for call. - ?line trace_pid(Self, false, [timestamp]), - ?line Prog2 = [{['$1','$2'],[],[{return_trace},{message,false}]}, - {['$1'],[],[{return_trace},{message,false}]}], - ?line 1 = trace_func({lists,seq,2}, Prog2), - ?line 1 = trace_func({erlang,atom_to_list,1}, Prog2), - ?line {match_spec,Prog2} = trace_info({lists,seq,2}, match_spec), - ?line {match_spec,Prog2} = trace_info({erlang,atom_to_list,1}, match_spec), + trace_pid(Self, false, [timestamp]), + Prog2 = [{['$1','$2'],[],[{return_trace},{message,false}]}, + {['$1'],[],[{return_trace},{message,false}]}], + 1 = trace_func({lists,seq,2}, Prog2), + 1 = trace_func({erlang,atom_to_list,1}, Prog2), + {match_spec,Prog2} = trace_info({lists,seq,2}, match_spec), + {match_spec,Prog2} = trace_info({erlang,atom_to_list,1}, match_spec), - ?line lists:seq(2, 7), - ?line _ = atom_to_list(non_literal(nisse)), - ?line expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}), - ?line expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}), + lists:seq(2, 7), + _ = atom_to_list(non_literal(nisse)), + expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}), + expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}), %% Turn off trace. - ?line 1 = trace_func({lists,seq,2}, false), - ?line 1 = trace_func({erlang,atom_to_list,1}, false), - ?line {match_spec,false} = trace_info({lists,seq,2}, match_spec), - ?line {match_spec,false} = trace_info({erlang,atom_to_list,1}, match_spec), + 1 = trace_func({lists,seq,2}, false), + 1 = trace_func({erlang,atom_to_list,1}, false), + {match_spec,false} = trace_info({lists,seq,2}, match_spec), + {match_spec,false} = trace_info({erlang,atom_to_list,1}, match_spec), + + {save,me} = X, - ?line {save,me} = X, - ok. nasty() -> @@ -683,396 +670,393 @@ nasty() -> exception_trace(_Config) -> case test_server:is_native(lists) of - true -> {skip,"lists is native"}; - false -> exception_trace() + true -> {skip,"lists is native"}; + false -> exception_trace() end. exception_trace() -> X = {save,me}, - ?line start_tracer(), - ?line Self = self(), + start_tracer(), + Self = self(), %% Test call and return trace and timestamp. - ?line trace_pid(Self, true, [call,timestamp]), + trace_pid(Self, true, [call,timestamp]), Stupid = {pointless,tuple}, - ?line Prog1 = [{['$1','$2'],[],[{exception_trace},{message,{Stupid}}]}], - ?line 1 = trace_func({lists,append,2}, Prog1), - ?line 1 = trace_func({erlang,process_info,2}, Prog1), - ?line {match_spec,Prog1} = trace_info({lists,append,2}, match_spec), - ?line {match_spec,Prog1} = - trace_info({erlang,process_info,2}, match_spec), - - ?line [x,y] = lists:append(id([x]), id([y])), + Prog1 = [{['$1','$2'],[],[{exception_trace},{message,{Stupid}}]}], + 1 = trace_func({lists,append,2}, Prog1), + 1 = trace_func({erlang,process_info,2}, Prog1), + {match_spec,Prog1} = trace_info({lists,append,2}, match_spec), + {match_spec,Prog1} = + trace_info({erlang,process_info,2}, match_spec), + + [x,y] = lists:append(id([x]), id([y])), Current = {current_function,{?MODULE,exception_trace,0}}, - ?line Current = erlang:process_info(Self, current_function), - ?line expect({trace_ts,Self,call,{lists,append,[[x],[y]]},Stupid,ts}), - ?line expect({trace_ts,Self,return_from,{lists,append,2},[x,y],ts}), - ?line expect({trace_ts,Self,call,{erlang,process_info, - [Self,current_function]}, - Stupid,ts}), - ?line expect({trace_ts,Self,return_from, - {erlang,process_info,2},Current,ts}), + Current = erlang:process_info(Self, current_function), + expect({trace_ts,Self,call,{lists,append,[[x],[y]]},Stupid,ts}), + expect({trace_ts,Self,return_from,{lists,append,2},[x,y],ts}), + expect({trace_ts,Self,call,{erlang,process_info, + [Self,current_function]}, + Stupid,ts}), + expect({trace_ts,Self,return_from, + {erlang,process_info,2},Current,ts}), %% Try catch/exit. - ?line 1 = trace_func({?MODULE,nasty,0}, - [{[],[],[{exception_trace},{message,false}]}]), - ?line {'EXIT',good_bye} = (catch ?MODULE:nasty()), - ?line expect({trace_ts,Self,exception_from, - {?MODULE,nasty,0},{exit,good_bye},ts}), - ?line 1 = trace_func({?MODULE,nasty,0}, false), + 1 = trace_func({?MODULE,nasty,0}, + [{[],[],[{exception_trace},{message,false}]}]), + {'EXIT',good_bye} = (catch ?MODULE:nasty()), + expect({trace_ts,Self,exception_from, + {?MODULE,nasty,0},{exit,good_bye},ts}), + 1 = trace_func({?MODULE,nasty,0}, false), %% Turn off trace. - ?line 1 = trace_func({lists,append,2}, false), - ?line 1 = trace_func({erlang,process_info,2}, false), - ?line {match_spec,false} = trace_info({lists,append,2}, match_spec), - ?line {match_spec,false} = - trace_info({erlang,process_info,2}, match_spec), + 1 = trace_func({lists,append,2}, false), + 1 = trace_func({erlang,process_info,2}, false), + {match_spec,false} = trace_info({lists,append,2}, match_spec), + {match_spec,false} = + trace_info({erlang,process_info,2}, match_spec), %% No timestamp, no trace message for call. - ?line trace_pid(Self, false, [timestamp]), - ?line Prog2 = [{['$1','$2'],[],[{exception_trace},{message,false}]}, - {['$1'],[],[{exception_trace},{message,false}]}], - ?line 1 = trace_func({lists,seq,2}, Prog2), - ?line 1 = trace_func({erlang,atom_to_list,1}, Prog2), - ?line {match_spec,Prog2} = trace_info({lists,seq,2}, match_spec), - ?line {match_spec,Prog2} = - trace_info({erlang,atom_to_list,1}, match_spec), + trace_pid(Self, false, [timestamp]), + Prog2 = [{['$1','$2'],[],[{exception_trace},{message,false}]}, + {['$1'],[],[{exception_trace},{message,false}]}], + 1 = trace_func({lists,seq,2}, Prog2), + 1 = trace_func({erlang,atom_to_list,1}, Prog2), + {match_spec,Prog2} = trace_info({lists,seq,2}, match_spec), + {match_spec,Prog2} = + trace_info({erlang,atom_to_list,1}, match_spec), - ?line lists:seq(2, 7), - ?line _ = atom_to_list(non_literal(nisse)), - ?line expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}), - ?line expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}), + lists:seq(2, 7), + _ = atom_to_list(non_literal(nisse)), + expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}), + expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}), %% Turn off trace. - ?line 1 = trace_func({lists,seq,2}, false), - ?line 1 = trace_func({erlang,atom_to_list,1}, false), - ?line {match_spec,false} = trace_info({lists,seq,2}, match_spec), - ?line {match_spec,false} = - trace_info({erlang,atom_to_list,1}, match_spec), + 1 = trace_func({lists,seq,2}, false), + 1 = trace_func({erlang,atom_to_list,1}, false), + {match_spec,false} = trace_info({lists,seq,2}, match_spec), + {match_spec,false} = + trace_info({erlang,atom_to_list,1}, match_spec), - ?line expect(), - ?line {save,me} = X, + expect(), + {save,me} = X, ok. -on_load(doc) -> "Test the on_load argument for trace_pattern/3."; -on_load(suite) -> []; +%% Test the on_load argument for trace_pattern/3. on_load(Config) when is_list(Config) -> - ?line 0 = erlang:trace_pattern(on_load, []), - ?line {traced,global} = erlang:trace_info(on_load, traced), - ?line {match_spec,[]} = erlang:trace_info(on_load, match_spec), + 0 = erlang:trace_pattern(on_load, []), + {traced,global} = erlang:trace_info(on_load, traced), + {match_spec,[]} = erlang:trace_info(on_load, match_spec), - ?line 0 = erlang:trace_pattern(on_load, true, [local]), - ?line {traced,local} = erlang:trace_info(on_load, traced), - ?line {match_spec,[]} = erlang:trace_info(on_load, match_spec), + 0 = erlang:trace_pattern(on_load, true, [local]), + {traced,local} = erlang:trace_info(on_load, traced), + {match_spec,[]} = erlang:trace_info(on_load, match_spec), - ?line 0 = erlang:trace_pattern(on_load, false, [local]), - ?line {traced,false} = erlang:trace_info(on_load, traced), - ?line {match_spec,false} = erlang:trace_info(on_load, match_spec), + 0 = erlang:trace_pattern(on_load, false, [local]), + {traced,false} = erlang:trace_info(on_load, traced), + {match_spec,false} = erlang:trace_info(on_load, match_spec), - ?line Pam1 = [{[],[],[{message,false}]}], - ?line 0 = erlang:trace_pattern(on_load, Pam1), - ?line {traced,global} = erlang:trace_info(on_load, traced), - ?line {match_spec,Pam1} = erlang:trace_info(on_load, match_spec), + Pam1 = [{[],[],[{message,false}]}], + 0 = erlang:trace_pattern(on_load, Pam1), + {traced,global} = erlang:trace_info(on_load, traced), + {match_spec,Pam1} = erlang:trace_info(on_load, match_spec), - ?line 0 = erlang:trace_pattern(on_load, true, [local]), - ?line 0 = erlang:trace_pattern(on_load, false, [local]), + 0 = erlang:trace_pattern(on_load, true, [local]), + 0 = erlang:trace_pattern(on_load, false, [local]), ok. -deep_exception(doc) -> "Test the new exception trace."; -deep_exception(suite) -> []; +%% Test the new exception trace. deep_exception(Config) when is_list(Config) -> deep_exception(). deep_exception() -> - ?line start_tracer(), - ?line Self = self(), - ?line N = 200000, - ?line LongImproperList = seq(1, N-1, N), - + start_tracer(), + Self = self(), + N = 200000, + LongImproperList = seq(1, N-1, N), + Prog = [{'_',[],[{exception_trace}]}], -%% ?line 1 = trace_pid(Self, true, [call]), - ?line 1 = trace_func({?MODULE,deep,'_'}, Prog), - ?line 1 = trace_func({?MODULE,deep_1,'_'}, Prog), - ?line 1 = trace_func({?MODULE,deep_2,'_'}, Prog), - ?line 1 = trace_func({?MODULE,deep_3,'_'}, Prog), - ?line 1 = trace_func({?MODULE,deep_4,'_'}, Prog), - ?line 1 = trace_func({?MODULE,deep_5,'_'}, Prog), - ?line 1 = trace_func({?MODULE,id,'_'}, Prog), - ?line 1 = trace_func({erlang,'++','_'}, Prog), - ?line 1 = trace_func({erlang,exit,1}, Prog), - ?line 1 = trace_func({erlang,throw,1}, Prog), - ?line 2 = trace_func({erlang,error,'_'}, Prog), - ?line 1 = trace_func({lists,reverse,2}, Prog), - - ?line deep_exception(?LINE, exit, [paprika], 1, - [{trace,Self,call,{erlang,exit,[paprika]}}, - {trace,Self,exception_from,{erlang,exit,1}, - {exit,paprika}}], - exception_from, {exit,paprika}), - ?line deep_exception(?LINE, throw, [3.14], 2, - [{trace,Self,call,{erlang,throw,[3.14]}}, - {trace,Self,exception_from,{erlang,throw,1}, - {throw,3.14}}], - exception_from, {throw,3.14}), - ?line deep_exception(?LINE, error, [{paprika}], 3, - [{trace,Self,call,{erlang,error,[{paprika}]}}, - {trace,Self,exception_from,{erlang,error,1}, - {error,{paprika}}}], - exception_from, {error,{paprika}}), - ?line deep_exception(?LINE, error, ["{paprika}",[]], 3, - [{trace,Self,call,{erlang,error,["{paprika}",[]]}}, - {trace,Self,exception_from,{erlang,error,2}, - {error,"{paprika}"}}], - exception_from, {error,"{paprika}"}), - ?line deep_exception(?LINE, id, [broccoli], 4, [], - return_from, broccoli), - ?line deep_exception( - ?LINE, append, [1,2], 5, - [{trace,Self,call,{erlang,'++',[1,2]}}, - {trace,Self,exception_from,{erlang,'++',2},{error,badarg}}], - exception_from, {error,badarg}), - ?line deep_exception(?LINE, '=', [1,2], 6, [], - exception_from, {error,{badmatch,2}}), + %% 1 = trace_pid(Self, true, [call]), + 1 = trace_func({?MODULE,deep,'_'}, Prog), + 1 = trace_func({?MODULE,deep_1,'_'}, Prog), + 1 = trace_func({?MODULE,deep_2,'_'}, Prog), + 1 = trace_func({?MODULE,deep_3,'_'}, Prog), + 1 = trace_func({?MODULE,deep_4,'_'}, Prog), + 1 = trace_func({?MODULE,deep_5,'_'}, Prog), + 1 = trace_func({?MODULE,id,'_'}, Prog), + 1 = trace_func({erlang,'++','_'}, Prog), + 1 = trace_func({erlang,exit,1}, Prog), + 1 = trace_func({erlang,throw,1}, Prog), + 2 = trace_func({erlang,error,'_'}, Prog), + 1 = trace_func({lists,reverse,2}, Prog), + + deep_exception(?LINE, exit, [paprika], 1, + [{trace,Self,call,{erlang,exit,[paprika]}}, + {trace,Self,exception_from,{erlang,exit,1}, + {exit,paprika}}], + exception_from, {exit,paprika}), + deep_exception(?LINE, throw, [3.14], 2, + [{trace,Self,call,{erlang,throw,[3.14]}}, + {trace,Self,exception_from,{erlang,throw,1}, + {throw,3.14}}], + exception_from, {throw,3.14}), + deep_exception(?LINE, error, [{paprika}], 3, + [{trace,Self,call,{erlang,error,[{paprika}]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,{paprika}}}], + exception_from, {error,{paprika}}), + deep_exception(?LINE, error, ["{paprika}",[]], 3, + [{trace,Self,call,{erlang,error,["{paprika}",[]]}}, + {trace,Self,exception_from,{erlang,error,2}, + {error,"{paprika}"}}], + exception_from, {error,"{paprika}"}), + deep_exception(?LINE, id, [broccoli], 4, [], + return_from, broccoli), + deep_exception( + ?LINE, append, [1,2], 5, + [{trace,Self,call,{erlang,'++',[1,2]}}, + {trace,Self,exception_from,{erlang,'++',2},{error,badarg}}], + exception_from, {error,badarg}), + deep_exception(?LINE, '=', [1,2], 6, [], + exception_from, {error,{badmatch,2}}), %% - ?line io:format("== Subtest: ~w", [?LINE]), - ?line try lists:reverse(LongImproperList, []) of - R1 -> test_server:fail({returned,abbr(R1)}) - catch error:badarg -> ok - end, - ?line expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) - when is_list(L1), is_list(L2), S == Self -> - next; - ({trace,S,exception_from, - {lists,reverse,2},{error,badarg}}) - when S == Self -> - expected; - ('_') -> - {trace,Self,exception_from, - {lists,reverse,2},{error,badarg}}; - (_) -> - {unexpected, - {trace,Self,exception_from, - {lists,reverse,2},{error,badarg}}} - end), - ?line deep_exception(?LINE, deep_5, [1,2], 7, - [{trace,Self,call,{erlang,error,[undef]}}, - {trace,Self,exception_from,{erlang,error,1}, - {error,undef}}], - exception_from, {error,undef}), - ?line deep_exception(?LINE, deep_5, [undef], 8, - [{trace,Self,call,{?MODULE,deep_5,[undef]}}, - {trace,Self,exception_from,{?MODULE,deep_5,1}, - {error,function_clause}}], - exception_from, {error,function_clause}), - + io:format("== Subtest: ~w", [?LINE]), + try lists:reverse(LongImproperList, []) of + R1 -> ct:fail({returned,abbr(R1)}) + catch error:badarg -> ok + end, + expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) + when is_list(L1), is_list(L2), S == Self -> + next; + ({trace,S,exception_from, + {lists,reverse,2},{error,badarg}}) + when S == Self -> + expected; + ('_') -> + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}; + (_) -> + {unexpected, + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}} + end), + deep_exception(?LINE, deep_5, [1,2], 7, + [{trace,Self,call,{erlang,error,[undef]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,undef}}], + exception_from, {error,undef}), + deep_exception(?LINE, deep_5, [undef], 8, + [{trace,Self,call,{?MODULE,deep_5,[undef]}}, + {trace,Self,exception_from,{?MODULE,deep_5,1}, + {error,function_clause}}], + exception_from, {error,function_clause}), + %% Apply %% - ?line deep_exception(?LINE, apply, [erlang,error,[[mo|rot]]], 1, - [{trace,Self,call,{erlang,error,[[mo|rot]]}}, - {trace,Self,exception_from,{erlang,error,1}, - {error,[mo|rot]}}], - exception_from, {error,[mo|rot]}), - ?line deep_exception(?LINE, apply, [erlang,error,[[mo|"rot"],[]]], 1, - [{trace,Self,call,{erlang,error,[[mo|"rot"],[]]}}, - {trace,Self,exception_from,{erlang,error,2}, - {error,[mo|"rot"]}}], - exception_from, {error,[mo|"rot"]}), - ?line Morot = make_ref(), - ?line deep_exception(?LINE, apply, [erlang,throw,[Morot]], 3, - [{trace,Self,call,{erlang,throw,[Morot]}}, - {trace,Self,exception_from,{erlang,throw,1}, - {throw,Morot}}], - exception_from, {throw,Morot}), - ?line deep_exception(?LINE, apply, [erlang,exit,[["morot"|Morot]]], 2, - [{trace,Self,call,{erlang,exit,[["morot"|Morot]]}}, - {trace,Self,exception_from,{erlang,exit,1}, - {exit,["morot"|Morot]}}], - exception_from, {exit,["morot"|Morot]}), - ?line deep_exception( - ?LINE, apply, [?MODULE,id,[spenat]], 4, - [{trace,Self,call,{?MODULE,id,[spenat]}}, - {trace,Self,return_from,{?MODULE,id,1},spenat}], - return_from, spenat), - ?line deep_exception( - ?LINE, apply, [erlang,'++',[1,2]], 5, - [{trace,Self,call,{erlang,'++',[1,2]}}, - {trace,Self,exception_from,{erlang,'++',2},{error,badarg}}], - exception_from, {error,badarg}), - ?line io:format("== Subtest: ~w", [?LINE]), - ?line try apply(lists, reverse, [LongImproperList, []]) of - R2 -> test_server:fail({returned,abbr(R2)}) - catch error:badarg -> ok - end, - ?line expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) - when is_list(L1), is_list(L2), S == Self -> - next; - ({trace,S,exception_from, - {lists,reverse,2},{error,badarg}}) - when S == Self -> - expected; - ('_') -> - {trace,Self,exception_from, - {lists,reverse,2},{error,badarg}}; - (_) -> - {unexpected, - {trace,Self,exception_from, - {lists,reverse,2},{error,badarg}}} - end), - ?line deep_exception(?LINE, apply, [?MODULE,deep_5,[1,2]], 7, - [{trace,Self,call,{erlang,error,[undef]}}, - {trace,Self,exception_from,{erlang,error,1}, - {error,undef}}], - exception_from, {error,undef}), - ?line deep_exception(?LINE, apply, [?MODULE,deep_5,[undef]], 8, - [{trace,Self,call,{?MODULE,deep_5,[undef]}}, - {trace,Self,exception_from,{?MODULE,deep_5,1}, - {error,function_clause}}], - exception_from, {error,function_clause}), + deep_exception(?LINE, apply, [erlang,error,[[mo|rot]]], 1, + [{trace,Self,call,{erlang,error,[[mo|rot]]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,[mo|rot]}}], + exception_from, {error,[mo|rot]}), + deep_exception(?LINE, apply, [erlang,error,[[mo|"rot"],[]]], 1, + [{trace,Self,call,{erlang,error,[[mo|"rot"],[]]}}, + {trace,Self,exception_from,{erlang,error,2}, + {error,[mo|"rot"]}}], + exception_from, {error,[mo|"rot"]}), + Morot = make_ref(), + deep_exception(?LINE, apply, [erlang,throw,[Morot]], 3, + [{trace,Self,call,{erlang,throw,[Morot]}}, + {trace,Self,exception_from,{erlang,throw,1}, + {throw,Morot}}], + exception_from, {throw,Morot}), + deep_exception(?LINE, apply, [erlang,exit,[["morot"|Morot]]], 2, + [{trace,Self,call,{erlang,exit,[["morot"|Morot]]}}, + {trace,Self,exception_from,{erlang,exit,1}, + {exit,["morot"|Morot]}}], + exception_from, {exit,["morot"|Morot]}), + deep_exception( + ?LINE, apply, [?MODULE,id,[spenat]], 4, + [{trace,Self,call,{?MODULE,id,[spenat]}}, + {trace,Self,return_from,{?MODULE,id,1},spenat}], + return_from, spenat), + deep_exception( + ?LINE, apply, [erlang,'++',[1,2]], 5, + [{trace,Self,call,{erlang,'++',[1,2]}}, + {trace,Self,exception_from,{erlang,'++',2},{error,badarg}}], + exception_from, {error,badarg}), + io:format("== Subtest: ~w", [?LINE]), + try apply(lists, reverse, [LongImproperList, []]) of + R2 -> ct:fail({returned,abbr(R2)}) + catch error:badarg -> ok + end, + expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) + when is_list(L1), is_list(L2), S == Self -> + next; + ({trace,S,exception_from, + {lists,reverse,2},{error,badarg}}) + when S == Self -> + expected; + ('_') -> + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}; + (_) -> + {unexpected, + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}} + end), + deep_exception(?LINE, apply, [?MODULE,deep_5,[1,2]], 7, + [{trace,Self,call,{erlang,error,[undef]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,undef}}], + exception_from, {error,undef}), + deep_exception(?LINE, apply, [?MODULE,deep_5,[undef]], 8, + [{trace,Self,call,{?MODULE,deep_5,[undef]}}, + {trace,Self,exception_from,{?MODULE,deep_5,1}, + {error,function_clause}}], + exception_from, {error,function_clause}), %% Apply of fun %% - ?line deep_exception(?LINE, apply, - [fun () -> - erlang:error([{"palsternacka",3.14},17]) - end, []], 1, - [{trace,Self,call, - {erlang,error,[[{"palsternacka",3.14},17]]}}, - {trace,Self,exception_from,{erlang,error,1}, - {error,[{"palsternacka",3.14},17]}}], - exception_from, {error,[{"palsternacka",3.14},17]}), - ?line deep_exception(?LINE, apply, - [fun () -> - erlang:error(["palsternacka",17], []) - end, []], 1, - [{trace,Self,call, - {erlang,error,[["palsternacka",17],[]]}}, - {trace,Self,exception_from,{erlang,error,2}, - {error,["palsternacka",17]}}], - exception_from, {error,["palsternacka",17]}), - ?line deep_exception(?LINE, apply, - [fun () -> erlang:throw(Self) end, []], 2, - [{trace,Self,call,{erlang,throw,[Self]}}, - {trace,Self,exception_from,{erlang,throw,1}, - {throw,Self}}], - exception_from, {throw,Self}), - ?line deep_exception(?LINE, apply, - [fun () -> - erlang:exit({1,2,3,4,[5,palsternacka]}) - end, []], 3, - [{trace,Self,call, - {erlang,exit,[{1,2,3,4,[5,palsternacka]}]}}, - {trace,Self,exception_from,{erlang,exit,1}, - {exit,{1,2,3,4,[5,palsternacka]}}}], - exception_from, {exit,{1,2,3,4,[5,palsternacka]}}), - ?line deep_exception(?LINE, apply, - [fun () -> ?MODULE:id(bladsallad) end, []], 4, - [{trace,Self,call,{?MODULE,id,[bladsallad]}}, - {trace,Self,return_from,{?MODULE,id,1},bladsallad}], - return_from, bladsallad), - ?line deep_exception(?LINE, apply, - [fun (A, B) -> A ++ B end, [1,2]], 5, - [{trace,Self,call,{erlang,'++',[1,2]}}, - {trace,Self,exception_from, - {erlang,'++',2},{error,badarg}}], - exception_from, {error,badarg}), - ?line deep_exception(?LINE, apply, [fun (A, B) -> A = B end, [1,2]], 6, - [], - exception_from, {error,{badmatch,2}}), - ?line io:format("== Subtest: ~w", [?LINE]), - ?line try apply(fun() -> lists:reverse(LongImproperList, []) end, []) of - R3 -> test_server:fail({returned,abbr(R3)}) - catch error:badarg -> ok - end, - ?line expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) - when is_list(L1), is_list(L2), S == Self -> - next; - ({trace,S,exception_from, - {lists,reverse,2},{error,badarg}}) - when S == Self -> - expected; - ('_') -> - {trace,Self,exception_from, - {lists,reverse,2},{error,badarg}}; - (_) -> - {unexpected, - {trace,Self,exception_from, - {lists,reverse,2},{error,badarg}}} - end), - ?line deep_exception(?LINE, apply, - [fun () -> ?MODULE:deep_5(1,2) end, []], 7, - [{trace,Self,call,{erlang,error,[undef]}}, - {trace,Self,exception_from,{erlang,error,1}, - {error,undef}}], - exception_from, {error,undef}), - ?line deep_exception(?LINE, apply, - [fun () -> ?MODULE:deep_5(undef) end, []], 8, - [{trace,Self,call,{?MODULE,deep_5,[undef]}}, - {trace,Self,exception_from,{?MODULE,deep_5,1}, - {error,function_clause}}], - exception_from, {error,function_clause}), - - ?line trace_func({?MODULE,'_','_'}, false), - ?line trace_func({erlang,'_','_'}, false), - ?line trace_func({lists,'_','_'}, false), - ?line expect(), - ?line ok. + deep_exception(?LINE, apply, + [fun () -> + erlang:error([{"palsternacka",3.14},17]) + end, []], 1, + [{trace,Self,call, + {erlang,error,[[{"palsternacka",3.14},17]]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,[{"palsternacka",3.14},17]}}], + exception_from, {error,[{"palsternacka",3.14},17]}), + deep_exception(?LINE, apply, + [fun () -> + erlang:error(["palsternacka",17], []) + end, []], 1, + [{trace,Self,call, + {erlang,error,[["palsternacka",17],[]]}}, + {trace,Self,exception_from,{erlang,error,2}, + {error,["palsternacka",17]}}], + exception_from, {error,["palsternacka",17]}), + deep_exception(?LINE, apply, + [fun () -> erlang:throw(Self) end, []], 2, + [{trace,Self,call,{erlang,throw,[Self]}}, + {trace,Self,exception_from,{erlang,throw,1}, + {throw,Self}}], + exception_from, {throw,Self}), + deep_exception(?LINE, apply, + [fun () -> + erlang:exit({1,2,3,4,[5,palsternacka]}) + end, []], 3, + [{trace,Self,call, + {erlang,exit,[{1,2,3,4,[5,palsternacka]}]}}, + {trace,Self,exception_from,{erlang,exit,1}, + {exit,{1,2,3,4,[5,palsternacka]}}}], + exception_from, {exit,{1,2,3,4,[5,palsternacka]}}), + deep_exception(?LINE, apply, + [fun () -> ?MODULE:id(bladsallad) end, []], 4, + [{trace,Self,call,{?MODULE,id,[bladsallad]}}, + {trace,Self,return_from,{?MODULE,id,1},bladsallad}], + return_from, bladsallad), + deep_exception(?LINE, apply, + [fun (A, B) -> A ++ B end, [1,2]], 5, + [{trace,Self,call,{erlang,'++',[1,2]}}, + {trace,Self,exception_from, + {erlang,'++',2},{error,badarg}}], + exception_from, {error,badarg}), + deep_exception(?LINE, apply, [fun (A, B) -> A = B end, [1,2]], 6, + [], + exception_from, {error,{badmatch,2}}), + io:format("== Subtest: ~w", [?LINE]), + try apply(fun() -> lists:reverse(LongImproperList, []) end, []) of + R3 -> ct:fail({returned,abbr(R3)}) + catch error:badarg -> ok + end, + expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) + when is_list(L1), is_list(L2), S == Self -> + next; + ({trace,S,exception_from, + {lists,reverse,2},{error,badarg}}) + when S == Self -> + expected; + ('_') -> + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}; + (_) -> + {unexpected, + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}} + end), + deep_exception(?LINE, apply, + [fun () -> ?MODULE:deep_5(1,2) end, []], 7, + [{trace,Self,call,{erlang,error,[undef]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,undef}}], + exception_from, {error,undef}), + deep_exception(?LINE, apply, + [fun () -> ?MODULE:deep_5(undef) end, []], 8, + [{trace,Self,call,{?MODULE,deep_5,[undef]}}, + {trace,Self,exception_from,{?MODULE,deep_5,1}, + {error,function_clause}}], + exception_from, {error,function_clause}), + + trace_func({?MODULE,'_','_'}, false), + trace_func({erlang,'_','_'}, false), + trace_func({lists,'_','_'}, false), + expect(), + ok. deep_exception(Line, B, Q, N, Extra, Tag, R) -> - ?line Self = self(), - ?line io:format("== Subtest: ~w", [Line]), - ?line Result = ?MODULE:deep(N, B, Q), - ?line Result = deep_expect(Self, B, Q, N, Extra, Tag, R). + Self = self(), + io:format("== Subtest: ~w", [Line]), + Result = ?MODULE:deep(N, B, Q), + Result = deep_expect(Self, B, Q, N, Extra, Tag, R). deep_expect(Self, B, Q, N, Extra, Tag, R) -> - ?line expect({trace,Self,call,{?MODULE,deep,[N,B,Q]}}), - ?line Result = deep_expect_N(Self, B, Q, N, Extra, Tag, R), - ?line expect({trace,Self,return_from,{?MODULE,deep,3},Result}), - ?line Result. + expect({trace,Self,call,{?MODULE,deep,[N,B,Q]}}), + Result = deep_expect_N(Self, B, Q, N, Extra, Tag, R), + expect({trace,Self,return_from,{?MODULE,deep,3},Result}), + Result. deep_expect_N(Self, B, Q, N, Extra, Tag, R) -> deep_expect_N(Self, B, Q, N, Extra, Tag, R, N). deep_expect_N(Self, B, Q, N, Extra, Tag, R, J) when J > 0 -> - ?line expect({trace,Self,call,{?MODULE,deep_1,[J,B,Q]}}), - ?line deep_expect_N(Self, B, Q, N, Extra, Tag, R, J-1); + expect({trace,Self,call,{?MODULE,deep_1,[J,B,Q]}}), + deep_expect_N(Self, B, Q, N, Extra, Tag, R, J-1); deep_expect_N(Self, B, Q, N, Extra, Tag, R, 0) -> - ?line expect({trace,Self,call,{?MODULE,deep_2,[B,Q]}}), - ?line expect({trace,Self,call,{?MODULE,deep_3,[B,Q]}}), - ?line expect({trace,Self,return_from,{?MODULE,deep_3,2},{B,Q}}), - ?line expect({trace,Self,call,{?MODULE,deep_4,[{B,Q}]}}), - ?line expect({trace,Self,call,{?MODULE,id,[{B,Q}]}}), - ?line expect({trace,Self,return_from,{?MODULE,id,1},{B,Q}}), - ?line deep_expect_Extra(Self, N, Extra, Tag, R), - ?line expect({trace,Self,Tag,{?MODULE,deep_4,1},R}), - ?line expect({trace,Self,Tag,{?MODULE,deep_2,2},R}), - ?line deep_expect_N(Self, N, Tag, R). + expect({trace,Self,call,{?MODULE,deep_2,[B,Q]}}), + expect({trace,Self,call,{?MODULE,deep_3,[B,Q]}}), + expect({trace,Self,return_from,{?MODULE,deep_3,2},{B,Q}}), + expect({trace,Self,call,{?MODULE,deep_4,[{B,Q}]}}), + expect({trace,Self,call,{?MODULE,id,[{B,Q}]}}), + expect({trace,Self,return_from,{?MODULE,id,1},{B,Q}}), + deep_expect_Extra(Self, N, Extra, Tag, R), + expect({trace,Self,Tag,{?MODULE,deep_4,1},R}), + expect({trace,Self,Tag,{?MODULE,deep_2,2},R}), + deep_expect_N(Self, N, Tag, R). deep_expect_Extra(Self, N, [E|Es], Tag, R) -> - ?line expect(E), - ?line deep_expect_Extra(Self, N, Es, Tag, R); + expect(E), + deep_expect_Extra(Self, N, Es, Tag, R); deep_expect_Extra(_Self, _N, [], _Tag, _R) -> - ?line ok. + ok. deep_expect_N(Self, N, Tag, R) when N > 0 -> - ?line expect({trace,Self,Tag,{?MODULE,deep_1,3},R}), - ?line deep_expect_N(Self, N-1, Tag, R); + expect({trace,Self,Tag,{?MODULE,deep_1,3},R}), + deep_expect_N(Self, N-1, Tag, R); deep_expect_N(_Self, 0, return_from, R) -> - ?line {value,R}; + {value,R}; deep_expect_N(_Self, 0, exception_from, R) -> - ?line R. + R. -exception_nocatch(doc) -> "Test the new exception trace."; -exception_nocatch(suite) -> []; +%% Test the new exception trace. exception_nocatch(Config) when is_list(Config) -> exception_nocatch(). @@ -1082,78 +1066,78 @@ exception_nocatch() -> Deep4LocBadmatch = get_deep_4_loc({'=',[a,b]}), Prog = [{'_',[],[{exception_trace}]}], - ?line 1 = erlang:trace_pattern({?MODULE,deep_1,'_'}, Prog), - ?line 1 = erlang:trace_pattern({?MODULE,deep_2,'_'}, Prog), - ?line 1 = erlang:trace_pattern({?MODULE,deep_3,'_'}, Prog), - ?line 1 = erlang:trace_pattern({?MODULE,deep_4,'_'}, Prog), - ?line 1 = erlang:trace_pattern({?MODULE,deep_5,'_'}, Prog), - ?line 1 = erlang:trace_pattern({?MODULE,id,'_'}, Prog), - ?line 1 = erlang:trace_pattern({erlang,exit,1}, Prog), - ?line 1 = erlang:trace_pattern({erlang,throw,1}, Prog), - ?line 2 = erlang:trace_pattern({erlang,error,'_'}, Prog), - ?line Q1 = {make_ref(),Prog}, - ?line T1 = - exception_nocatch(?LINE, exit, [Q1], 3, - [{trace,t1,call,{erlang,exit,[Q1]}}, - {trace,t1,exception_from,{erlang,exit,1}, - {exit,Q1}}], - exception_from, {exit,Q1}), - ?line expect({trace,T1,exit,Q1}), - ?line Q2 = {cake,14.125}, - ?line T2 = - exception_nocatch(?LINE, throw, [Q2], 2, - [{trace,t2,call,{erlang,throw,[Q2]}}, - {trace,t2,exception_from,{erlang,throw,1}, - {error,{nocatch,Q2}}}], - exception_from, {error,{nocatch,Q2}}), - ?line expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2],[]}, - {?MODULE,deep_4,1, - Deep4LocThrow}]}}), - ?line Q3 = {dump,[dump,{dump}]}, - ?line T3 = - exception_nocatch(?LINE, error, [Q3], 4, - [{trace,t3,call,{erlang,error,[Q3]}}, - {trace,t3,exception_from,{erlang,error,1}, - {error,Q3}}], - exception_from, {error,Q3}), - ?line expect({trace,T3,exit,{Q3,[{erlang,error,[Q3],[]}, - {?MODULE,deep_4,1,Deep4LocError}]}}), - ?line T4 = - exception_nocatch(?LINE, '=', [17,4711], 5, [], - exception_from, {error,{badmatch,4711}}), - ?line expect({trace,T4,exit,{{badmatch,4711}, - [{?MODULE,deep_4,1,Deep4LocBadmatch}]}}), + 1 = erlang:trace_pattern({?MODULE,deep_1,'_'}, Prog), + 1 = erlang:trace_pattern({?MODULE,deep_2,'_'}, Prog), + 1 = erlang:trace_pattern({?MODULE,deep_3,'_'}, Prog), + 1 = erlang:trace_pattern({?MODULE,deep_4,'_'}, Prog), + 1 = erlang:trace_pattern({?MODULE,deep_5,'_'}, Prog), + 1 = erlang:trace_pattern({?MODULE,id,'_'}, Prog), + 1 = erlang:trace_pattern({erlang,exit,1}, Prog), + 1 = erlang:trace_pattern({erlang,throw,1}, Prog), + 2 = erlang:trace_pattern({erlang,error,'_'}, Prog), + Q1 = {make_ref(),Prog}, + T1 = + exception_nocatch(?LINE, exit, [Q1], 3, + [{trace,t1,call,{erlang,exit,[Q1]}}, + {trace,t1,exception_from,{erlang,exit,1}, + {exit,Q1}}], + exception_from, {exit,Q1}), + expect({trace,T1,exit,Q1}), + Q2 = {cake,14.125}, + T2 = + exception_nocatch(?LINE, throw, [Q2], 2, + [{trace,t2,call,{erlang,throw,[Q2]}}, + {trace,t2,exception_from,{erlang,throw,1}, + {error,{nocatch,Q2}}}], + exception_from, {error,{nocatch,Q2}}), + expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2],[]}, + {?MODULE,deep_4,1, + Deep4LocThrow}]}}), + Q3 = {dump,[dump,{dump}]}, + T3 = + exception_nocatch(?LINE, error, [Q3], 4, + [{trace,t3,call,{erlang,error,[Q3]}}, + {trace,t3,exception_from,{erlang,error,1}, + {error,Q3}}], + exception_from, {error,Q3}), + expect({trace,T3,exit,{Q3,[{erlang,error,[Q3],[]}, + {?MODULE,deep_4,1,Deep4LocError}]}}), + T4 = + exception_nocatch(?LINE, '=', [17,4711], 5, [], + exception_from, {error,{badmatch,4711}}), + expect({trace,T4,exit,{{badmatch,4711}, + [{?MODULE,deep_4,1,Deep4LocBadmatch}]}}), %% - ?line erlang:trace_pattern({?MODULE,'_','_'}, false), - ?line erlang:trace_pattern({erlang,'_','_'}, false), - ?line expect(), - ?line ok. + erlang:trace_pattern({?MODULE,'_','_'}, false), + erlang:trace_pattern({erlang,'_','_'}, false), + expect(), + ok. get_deep_4_loc(Arg) -> try - deep_4(Arg), - ?t:fail(should_not_return_to_here) + deep_4(Arg), + ct:fail(should_not_return_to_here) catch - _:_ -> - [{?MODULE,deep_4,1,Loc0}|_] = erlang:get_stacktrace(), - Loc0 + _:_ -> + [{?MODULE,deep_4,1,Loc0}|_] = erlang:get_stacktrace(), + Loc0 end. exception_nocatch(Line, B, Q, N, Extra, Tag, R) -> - ?line io:format("== Subtest: ~w", [Line]), - ?line Go = make_ref(), - ?line Tracee = - spawn(fun () -> - receive - Go -> - deep_1(N, B, Q) - end - end), - ?line 1 = erlang:trace(Tracee, true, [call,return_to,procs]), - ?line Tracee ! Go, - ?line deep_expect_N(Tracee, B, Q, N-1, - [setelement(2, T, Tracee) || T <- Extra], Tag, R), - ?line Tracee. + io:format("== Subtest: ~w", [Line]), + Go = make_ref(), + Tracee = + spawn(fun () -> + receive + Go -> + deep_1(N, B, Q) + end + end), + 1 = erlang:trace(Tracee, true, [call,return_to,procs]), + Tracee ! Go, + deep_expect_N(Tracee, B, Q, N-1, + [setelement(2, T, Tracee) || T <- Extra], Tag, R), + Tracee. %% Make sure that code that uses the optimized bit syntax matching %% can be traced without crashing the emulator. (Actually, it seems @@ -1161,22 +1145,22 @@ exception_nocatch(Line, B, Q, N, Extra, Tag, R) -> %% will keep the test case anyway.) bit_syntax(Config) when is_list(Config) -> - ?line start_tracer(), - ?line 1 = trace_func({?MODULE,bs_sum_a,'_'}, []), - ?line 1 = trace_func({?MODULE,bs_sum_b,'_'}, []), + start_tracer(), + 1 = trace_func({?MODULE,bs_sum_a,'_'}, []), + 1 = trace_func({?MODULE,bs_sum_b,'_'}, []), - ?line 6 = call_bs_sum_a(<<1,2,3>>), - ?line 10 = call_bs_sum_b(<<1,2,3,4>>), + 6 = call_bs_sum_a(<<1,2,3>>), + 10 = call_bs_sum_b(<<1,2,3,4>>), - ?line trace_func({?MODULE,'_','_'}, false), - ?line erlang:trace_delivered(all), + trace_func({?MODULE,'_','_'}, false), + erlang:trace_delivered(all), receive - {trace_delivered,_,_} -> ok + {trace_delivered,_,_} -> ok end, - + Self = self(), - ?line expect({trace,Self,call,{?MODULE,bs_sum_a,[<<2,3>>,1]}}), - ?line expect({trace,Self,call,{?MODULE,bs_sum_b,[1,<<2,3,4>>]}}), + expect({trace,Self,call,{?MODULE,bs_sum_a,[<<2,3>>,1]}}), + expect({trace,Self,call,{?MODULE,bs_sum_b,[1,<<2,3,4>>]}}), ok. @@ -1191,7 +1175,7 @@ bs_sum_a(<<>>, Acc) -> Acc. bs_sum_b(Acc, <<H,T/binary>>) -> bs_sum_b(H+Acc, T); bs_sum_b(Acc, <<>>) -> Acc. - + @@ -1199,98 +1183,98 @@ bs_sum_b(Acc, <<>>) -> Acc. expect() -> case flush() of - [] -> ok; - Msgs -> - test_server:fail({unexpected,abbr(Msgs)}) + [] -> ok; + Msgs -> + ct:fail({unexpected,abbr(Msgs)}) end. expect({trace_ts,Pid,Type,MFA,Term,ts}=Message) -> receive - M -> - case M of - {trace_ts,Pid,Type,MFA,Term,Ts}=MessageTs -> - ok = io:format("Expected and got ~p", [abbr(MessageTs)]), - Ts; - _ -> - io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), - test_server:fail({unexpected,abbr([M|flush()])}) - end + M -> + case M of + {trace_ts,Pid,Type,MFA,Term,Ts}=MessageTs -> + ok = io:format("Expected and got ~p", [abbr(MessageTs)]), + Ts; + _ -> + io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), + ct:fail({unexpected,abbr([M|flush()])}) + end after 5000 -> - io:format("Expected ~p; got nothing", [abbr(Message)]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [abbr(Message)]), + ct:fail(no_trace_message) end; expect({trace_ts,Pid,Type,MFA,ts}=Message) -> receive - M -> - case M of - {trace_ts,Pid,Type,MFA,Ts} -> - ok = io:format("Expected and got ~p", [abbr(M)]), - Ts; - _ -> - io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), - test_server:fail({unexpected,abbr([M|flush()])}) - end + M -> + case M of + {trace_ts,Pid,Type,MFA,Ts} -> + ok = io:format("Expected and got ~p", [abbr(M)]), + Ts; + _ -> + io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), + ct:fail({unexpected,abbr([M|flush()])}) + end after 5000 -> - io:format("Expected ~p; got nothing", [abbr(Message)]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [abbr(Message)]), + ct:fail(no_trace_message) end; expect(Validator) when is_function(Validator) -> receive - M -> - case Validator(M) of - expected -> - ok = io:format("Expected and got ~p", [abbr(M)]); - next -> - ok = io:format("Expected and got ~p", [abbr(M)]), - expect(Validator); - {unexpected,Message} -> - io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), - test_server:fail({unexpected,abbr([M|flush()])}) - end + M -> + case Validator(M) of + expected -> + ok = io:format("Expected and got ~p", [abbr(M)]); + next -> + ok = io:format("Expected and got ~p", [abbr(M)]), + expect(Validator); + {unexpected,Message} -> + io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), + ct:fail({unexpected,abbr([M|flush()])}) + end after 5000 -> - io:format("Expected ~p; got nothing", [abbr(Validator('_'))]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [abbr(Validator('_'))]), + ct:fail(no_trace_message) end; expect(Message) -> receive - M -> - case M of - Message -> - ok = io:format("Expected and got ~p", [abbr(Message)]); - Other -> - io:format("Expected ~p; got ~p", - [abbr(Message),abbr(Other)]), - test_server:fail({unexpected,abbr([Other|flush()])}) - end + M -> + case M of + Message -> + ok = io:format("Expected and got ~p", [abbr(Message)]); + Other -> + io:format("Expected ~p; got ~p", + [abbr(Message),abbr(Other)]), + ct:fail({unexpected,abbr([Other|flush()])}) + end after 5000 -> - io:format("Expected ~p; got nothing", [abbr(Message)]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [abbr(Message)]), + ct:fail(no_trace_message) end. trace_info(What, Key) -> get(tracer) ! {apply,self(),{erlang,trace_info,[What,Key]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("erlang:trace_info(~p, ~p) -> ~p", - [What,Key,Res]), + [What,Key,Res]), Res. - + trace_func(MFA, MatchSpec) -> trace_func(MFA, MatchSpec, []). trace_func(MFA, MatchSpec, Flags) -> get(tracer) ! {apply,self(),{erlang,trace_pattern,[MFA, MatchSpec, Flags]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("trace_pattern(~p, ~p, ~p) -> ~p", [MFA,MatchSpec,Flags,Res]), Res. trace_pid(Pid, On, Flags) -> get(tracer) ! {apply,self(),{erlang,trace,[Pid,On,Flags]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("trace(~p, ~p, ~p) -> ~p", [Pid,On,Flags,Res]), Res. @@ -1310,19 +1294,19 @@ tracer(RelayTo) -> tracer_loop(RelayTo) -> receive - {apply,From,{M,F,A}} -> - From ! {apply_result,apply(M, F, A)}, - tracer_loop(RelayTo); - Msg -> - RelayTo ! Msg, - tracer_loop(RelayTo) + {apply,From,{M,F,A}} -> + From ! {apply_result,apply(M, F, A)}, + tracer_loop(RelayTo); + Msg -> + RelayTo ! Msg, + tracer_loop(RelayTo) end. id(I) -> I. deep(N, Class, Reason) -> try ?MODULE:deep_1(N, Class, Reason) of - Value -> {value,Value} + Value -> {value,Value} catch C:R -> {C,R} end. @@ -1339,30 +1323,30 @@ deep_3(Class, Reason) -> deep_4(CR) -> case ?MODULE:id(CR) of - {exit,[Reason]} -> - erlang:exit(Reason); - {throw,[Reason]} -> - erlang:throw(Reason); - {error,[Reason,Arglist]} -> - erlang:error(Reason, Arglist); - {error,[Reason]} -> - erlang:error(Reason); - {id,[Reason]} -> - Reason; - {reverse,[A,B]} -> - lists:reverse(A, B); - {append,[A,B]} -> - A ++ B; - {apply,[Fun,Args]} -> - erlang:apply(Fun, Args); - {apply,[M,F,Args]} -> - erlang:apply(M, F, Args); - {deep_5,[A,B]} -> - ?MODULE:deep_5(A, B); - {deep_5,[A]} -> - ?MODULE:deep_5(A); - {'=',[A,B]} -> - A = B + {exit,[Reason]} -> + erlang:exit(Reason); + {throw,[Reason]} -> + erlang:throw(Reason); + {error,[Reason,Arglist]} -> + erlang:error(Reason, Arglist); + {error,[Reason]} -> + erlang:error(Reason); + {id,[Reason]} -> + Reason; + {reverse,[A,B]} -> + lists:reverse(A, B); + {append,[A,B]} -> + A ++ B; + {apply,[Fun,Args]} -> + erlang:apply(Fun, Args); + {apply,[M,F,Args]} -> + erlang:apply(M, F, Args); + {deep_5,[A,B]} -> + ?MODULE:deep_5(A, B); + {deep_5,[A]} -> + ?MODULE:deep_5(A); + {'=',[A,B]} -> + A = B end. deep_5(A) when is_integer(A) -> @@ -1370,9 +1354,9 @@ deep_5(A) when is_integer(A) -> flush() -> receive X -> - [X|flush()] + [X|flush()] after 1000 -> - [] + [] end. %% Abbreviate large complex terms @@ -1395,10 +1379,10 @@ abbr_tuple(_, _, _, R) -> %% abbr_list(_, 0, R) -> case io_lib:printable_list(R) of - true -> - reverse(R, "..."); - false -> - reverse(R, '...') + true -> + reverse(R, "..."); + false -> + reverse(R, '...') end; abbr_list([H|T], N, R) -> M = N-1, diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 9f318a38be..29b95ef674 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,17 +19,17 @@ %% -module(code_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - versions/1,new_binary_types/1, - t_check_process_code/1,t_check_old_code/1, - t_check_process_code_ets/1, - external_fun/1,get_chunk/1,module_md5/1,make_stub/1, - make_stub_many_funs/1,constant_pools/1,constant_refc_binaries/1, - false_dependency/1,coverage/1,fun_confusion/1]). +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1, + versions/1,new_binary_types/1, + t_check_process_code/1,t_check_old_code/1, + t_check_process_code_ets/1, + external_fun/1,get_chunk/1,module_md5/1,make_stub/1, + make_stub_many_funs/1,constant_pools/1,constant_refc_binaries/1, + false_dependency/1,coverage/1,fun_confusion/1, + t_copy_literals/1]). -define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -38,10 +38,7 @@ all() -> t_check_process_code_ets, t_check_old_code, external_fun, get_chunk, module_md5, make_stub, make_stub_many_funs, constant_pools, constant_refc_binaries, false_dependency, - coverage, fun_confusion]. - -groups() -> - []. + coverage, fun_confusion, t_copy_literals]. init_per_suite(Config) -> erts_debug:set_internal_state(available_internal_state, true), @@ -51,12 +48,6 @@ end_per_suite(_Config) -> catch erts_debug:set_internal_state(available_internal_state, false), ok. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - %% Make sure that only two versions of a module can be loaded. versions(Config) when is_list(Config) -> V1 = compile_version(1, Config), @@ -77,10 +68,10 @@ versions(Config) when is_list(Config) -> _ = monitor(process, P1), _ = monitor(process, P2), receive - {'DOWN',_,process,P1,normal} -> ok + {'DOWN',_,process,P1,normal} -> ok end, receive - {'DOWN',_,process,P2,normal} -> ok + {'DOWN',_,process,P2,normal} -> ok end, true = erlang:purge_module(versions), true = erlang:delete_module(versions), @@ -88,84 +79,84 @@ versions(Config) when is_list(Config) -> ok. compile_version(Version, Config) -> - Data = ?config(data_dir, Config), + Data = proplists:get_value(data_dir, Config), File = filename:join(Data, "versions"), {ok,versions,Bin} = compile:file(File, [{d,'VERSION',Version}, - binary,report]), + binary,report]), Bin. load_version(Code, Ver) -> case erlang:load_module(versions, Code) of - {module,versions} -> - Pid = spawn_link(versions, loop, []), - Ver = versions:version(), - Ver = check_version(Pid), - {ok,Pid,Ver}; - Error -> - Error + {module,versions} -> + Pid = spawn_link(versions, loop, []), + Ver = versions:version(), + Ver = check_version(Pid), + {ok,Pid,Ver}; + Error -> + Error end. check_version(Pid) -> Pid ! {self(),version}, receive - {Pid,version,Version} -> - Version + {Pid,version,Version} -> + Version end. new_binary_types(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - ?line {ok,my_code_test,Bin} = compile:file(File, [binary]), - ?line {module,my_code_test} = erlang:load_module(my_code_test, - make_sub_binary(Bin)), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), - - ?line {module,my_code_test} = erlang:load_module(my_code_test, - make_unaligned_sub_binary(Bin)), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + {ok,my_code_test,Bin} = compile:file(File, [binary]), + {module,my_code_test} = erlang:load_module(my_code_test, + make_sub_binary(Bin)), + true = erlang:delete_module(my_code_test), + true = erlang:purge_module(my_code_test), + + {module,my_code_test} = erlang:load_module(my_code_test, + make_unaligned_sub_binary(Bin)), + true = erlang:delete_module(my_code_test), + true = erlang:purge_module(my_code_test), %% Try heap binaries and bad binaries. - ?line {error,badfile} = erlang:load_module(my_code_test, <<1,2>>), - ?line {error,badfile} = erlang:load_module(my_code_test, - make_sub_binary(<<1,2>>)), - ?line {error,badfile} = erlang:load_module(my_code_test, - make_unaligned_sub_binary(<<1,2>>)), - ?line {'EXIT',{badarg,_}} = (catch erlang:load_module(my_code_test, - bit_sized_binary(Bin))), + {error,badfile} = erlang:load_module(my_code_test, <<1,2>>), + {error,badfile} = erlang:load_module(my_code_test, + make_sub_binary(<<1,2>>)), + {error,badfile} = erlang:load_module(my_code_test, + make_unaligned_sub_binary(<<1,2>>)), + {'EXIT',{badarg,_}} = (catch erlang:load_module(my_code_test, + bit_sized_binary(Bin))), ok. t_check_process_code(Config) when is_list(Config) -> - ?line Priv = ?config(priv_dir, Config), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - ?line Code = filename:join(Priv, "my_code_test"), + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + Code = filename:join(Priv, "my_code_test"), - ?line {ok,my_code_test} = c:c(File, [{outdir,Priv}]), + {ok,my_code_test} = c:c(File, [{outdir,Priv}]), - ?line MyFun = fun(X, Y) -> X + Y end, %Confuse things. - ?line F = my_code_test:make_fun(42), - ?line 2 = fun_refc(F), - ?line MyFun2 = fun(X, Y) -> X * Y end, %Confuse things. - ?line 44 = F(2), + MyFun = fun(X, Y) -> X + Y end, %Confuse things. + F = my_code_test:make_fun(42), + 2 = fun_refc(F), + MyFun2 = fun(X, Y) -> X * Y end, %Confuse things. + 44 = F(2), %% Delete the module and call the fun again. - ?line true = erlang:delete_module(my_code_test), - ?line 2 = fun_refc(F), - ?line 45 = F(3), - ?line {'EXIT',{undef,_}} = (catch my_code_test:make_fun(33)), + true = erlang:delete_module(my_code_test), + 2 = fun_refc(F), + 45 = F(3), + {'EXIT',{undef,_}} = (catch my_code_test:make_fun(33)), %% The fun should still be there, preventing purge. - ?line true = erlang:check_process_code(self(), my_code_test), + true = erlang:check_process_code(self(), my_code_test), gc(), gc(), %Place funs on the old heap. - ?line true = erlang:check_process_code(self(), my_code_test), + true = erlang:check_process_code(self(), my_code_test), %% Using the funs here guarantees that they will not be prematurely garbed. - ?line 48 = F(6), - ?line 3 = MyFun(1, 2), - ?line 12 = MyFun2(3, 4), + 48 = F(6), + 3 = MyFun(1, 2), + 12 = MyFun2(3, 4), %% Kill all funs. t_check_process_code1(Code, []). @@ -173,64 +164,64 @@ t_check_process_code(Config) when is_list(Config) -> %% The real fun was killed, but we have some fakes which look similar. t_check_process_code1(Code, Fakes) -> - ?line MyFun = fun(X, Y) -> X + Y + 1 end, %Confuse things. - ?line false = erlang:check_process_code(self(), my_code_test), - ?line 4 = MyFun(1, 2), + MyFun = fun(X, Y) -> X + Y + 1 end, %Confuse things. + false = erlang:check_process_code(self(), my_code_test), + 4 = MyFun(1, 2), t_check_process_code2(Code, Fakes). t_check_process_code2(Code, _) -> - ?line false = erlang:check_process_code(self(), my_code_test), - ?line true = erlang:purge_module(my_code_test), + false = erlang:check_process_code(self(), my_code_test), + true = erlang:purge_module(my_code_test), %% In the next test we will load the same module twice. - ?line {module,my_code_test} = code:load_abs(Code), - ?line F = my_code_test:make_fun(37), - ?line 2 = fun_refc(F), - ?line false = erlang:check_process_code(self(), my_code_test), - ?line {module,my_code_test} = code:load_abs(Code), - ?line 2 = fun_refc(F), + {module,my_code_test} = code:load_abs(Code), + F = my_code_test:make_fun(37), + 2 = fun_refc(F), + false = erlang:check_process_code(self(), my_code_test), + {module,my_code_test} = code:load_abs(Code), + 2 = fun_refc(F), %% Still false because the fun with the same identify is found %% in the current code. - ?line false = erlang:check_process_code(self(), my_code_test), - + false = erlang:check_process_code(self(), my_code_test), + %% Some fake funs in the same module should not do any difference. - ?line false = erlang:check_process_code(self(), my_code_test), + false = erlang:check_process_code(self(), my_code_test), 38 = F(1), t_check_process_code3(Code, F, []). t_check_process_code3(Code, F, Fakes) -> Pid = spawn_link(fun() -> body(F, Fakes) end), - ?line true = erlang:purge_module(my_code_test), - ?line false = erlang:check_process_code(self(), my_code_test), - ?line false = erlang:check_process_code(Pid, my_code_test), + true = erlang:purge_module(my_code_test), + false = erlang:check_process_code(self(), my_code_test), + false = erlang:check_process_code(Pid, my_code_test), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:check_process_code(self(), my_code_test), - ?line true = erlang:check_process_code(Pid, my_code_test), + true = erlang:delete_module(my_code_test), + true = erlang:check_process_code(self(), my_code_test), + true = erlang:check_process_code(Pid, my_code_test), 39 = F(2), t_check_process_code4(Code, Pid). t_check_process_code4(_Code, Pid) -> Pid ! drop_funs, receive after 1 -> ok end, - ?line false = erlang:check_process_code(Pid, my_code_test), + false = erlang:check_process_code(Pid, my_code_test), ok. body(F, Fakes) -> receive - jog -> - 40 = F(3), - erlang:garbage_collect(), - body(F, Fakes); - drop_funs -> - dropped_body() + jog -> + 40 = F(3), + erlang:garbage_collect(), + body(F, Fakes); + drop_funs -> + dropped_body() end. dropped_body() -> receive - X -> exit(X) + X -> exit(X) end. gc() -> @@ -238,61 +229,60 @@ gc() -> gc1(). gc1() -> ok. -t_check_process_code_ets(doc) -> - "Test check_process_code/2 in combination with a fun obtained from an ets table."; +%% Test check_process_code/2 in combination with a fun obtained from an ets table. t_check_process_code_ets(Config) when is_list(Config) -> case test_server:is_native(?MODULE) of - true -> - {skip,"Native code"}; - false -> - do_check_process_code_ets(Config) + true -> + {skip,"Native code"}; + false -> + do_check_process_code_ets(Config) end. do_check_process_code_ets(Config) -> - ?line Priv = ?config(priv_dir, Config), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - - ?line erlang:purge_module(my_code_test), - ?line erlang:delete_module(my_code_test), - ?line {ok,my_code_test} = c:c(File, [{outdir,Priv}]), - - ?line T = ets:new(my_code_test, []), - ?line ets:insert(T, {7,my_code_test:make_fun(107)}), - ?line ets:insert(T, {8,my_code_test:make_fun(108)}), - ?line erlang:delete_module(my_code_test), - ?line false = erlang:check_process_code(self(), my_code_test), + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + + erlang:purge_module(my_code_test), + erlang:delete_module(my_code_test), + {ok,my_code_test} = c:c(File, [{outdir,Priv}]), + + T = ets:new(my_code_test, []), + ets:insert(T, {7,my_code_test:make_fun(107)}), + ets:insert(T, {8,my_code_test:make_fun(108)}), + erlang:delete_module(my_code_test), + false = erlang:check_process_code(self(), my_code_test), Body = fun() -> - [{7,F1}] = ets:lookup(T, 7), - [{8,F2}] = ets:lookup(T, 8), - IdleLoop = fun() -> receive _X -> ok end end, - RecLoop = fun(Again) -> - receive - call -> 110 = F1(3), - 100 = F2(-8), - Again(Again); - {drop_funs,To} -> - To ! funs_dropped, - IdleLoop() - end - end, - true = erlang:check_process_code(self(), my_code_test), - RecLoop(RecLoop) - end, - ?line Pid = spawn_link(Body), + [{7,F1}] = ets:lookup(T, 7), + [{8,F2}] = ets:lookup(T, 8), + IdleLoop = fun() -> receive _X -> ok end end, + RecLoop = fun(Again) -> + receive + call -> 110 = F1(3), + 100 = F2(-8), + Again(Again); + {drop_funs,To} -> + To ! funs_dropped, + IdleLoop() + end + end, + true = erlang:check_process_code(self(), my_code_test), + RecLoop(RecLoop) + end, + Pid = spawn_link(Body), receive after 1 -> ok end, - ?line true = erlang:check_process_code(Pid, my_code_test), + true = erlang:check_process_code(Pid, my_code_test), Pid ! call, Pid ! {drop_funs,self()}, receive - funs_dropped -> ok; - Other -> ?t:fail({unexpected,Other}) + funs_dropped -> ok; + Other -> ct:fail({unexpected,Other}) after 10000 -> - ?line ?t:fail(no_funs_dropped_answer) + ct:fail(no_funs_dropped_answer) end, - ?line false = erlang:check_process_code(Pid, my_code_test), + false = erlang:check_process_code(Pid, my_code_test), ok. fun_refc(F) -> @@ -302,89 +292,89 @@ fun_refc(F) -> %% Test the erlang:check_old_code/1 BIF. t_check_old_code(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), - ?line erlang:purge_module(my_code_test), - ?line erlang:delete_module(my_code_test), - ?line catch erlang:purge_module(my_code_test), + erlang:purge_module(my_code_test), + erlang:delete_module(my_code_test), + catch erlang:purge_module(my_code_test), + + false = erlang:check_old_code(my_code_test), + + {ok,my_code_test,Code} = compile:file(File, [binary]), + {module,my_code_test} = code:load_binary(my_code_test, File, Code), - ?line false = erlang:check_old_code(my_code_test), + false = erlang:check_old_code(my_code_test), + {module,my_code_test} = code:load_binary(my_code_test, File, Code), + true = erlang:check_old_code(my_code_test), - ?line {ok,my_code_test,Code} = compile:file(File, [binary]), - ?line {module,my_code_test} = code:load_binary(my_code_test, File, Code), - - ?line false = erlang:check_old_code(my_code_test), - ?line {module,my_code_test} = code:load_binary(my_code_test, File, Code), - ?line true = erlang:check_old_code(my_code_test), + true = erlang:purge_module(my_code_test), + true = erlang:delete_module(my_code_test), + true = erlang:purge_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), - ?line true = erlang:delete_module(my_code_test), - ?line true = erlang:purge_module(my_code_test), + {'EXIT',_} = (catch erlang:check_old_code([])), - ?line {'EXIT',_} = (catch erlang:check_old_code([])), - ok. external_fun(Config) when is_list(Config) -> - ?line false = erlang:function_exported(another_code_test, x, 1), + false = erlang:function_exported(another_code_test, x, 1), AnotherCodeTest = id(another_code_test), ExtFun = fun AnotherCodeTest:x/1, - ?line {'EXIT',{undef,_}} = (catch ExtFun(answer)), - ?line false = erlang:function_exported(another_code_test, x, 1), - ?line false = lists:member(another_code_test, erlang:loaded()), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "another_code_test"), - ?line {ok,another_code_test,Code} = compile:file(File, [binary,report]), - ?line {module,another_code_test} = erlang:load_module(another_code_test, Code), - ?line 42 = ExtFun(answer), + {'EXIT',{undef,_}} = (catch ExtFun(answer)), + false = erlang:function_exported(another_code_test, x, 1), + false = lists:member(another_code_test, erlang:loaded()), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "another_code_test"), + {ok,another_code_test,Code} = compile:file(File, [binary,report]), + {module,another_code_test} = erlang:load_module(another_code_test, Code), + 42 = ExtFun(answer), ok. get_chunk(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - ?line {ok,my_code_test,Code} = compile:file(File, [binary]), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + {ok,my_code_test,Code} = compile:file(File, [binary]), %% Should work. - ?line Chunk = get_chunk_ok("Atom", Code), - ?line Chunk = get_chunk_ok("Atom", make_sub_binary(Code)), - ?line Chunk = get_chunk_ok("Atom", make_unaligned_sub_binary(Code)), + Chunk = get_chunk_ok("Atom", Code), + Chunk = get_chunk_ok("Atom", make_sub_binary(Code)), + Chunk = get_chunk_ok("Atom", make_unaligned_sub_binary(Code)), %% Should fail. - ?line {'EXIT',{badarg,_}} = (catch code:get_chunk(bit_sized_binary(Code), "Atom")), - ?line {'EXIT',{badarg,_}} = (catch code:get_chunk(Code, "bad chunk id")), + {'EXIT',{badarg,_}} = (catch code:get_chunk(bit_sized_binary(Code), "Atom")), + {'EXIT',{badarg,_}} = (catch code:get_chunk(Code, "bad chunk id")), %% Invalid beam code or missing chunk should return 'undefined'. - ?line undefined = code:get_chunk(<<"not a beam module">>, "Atom"), - ?line undefined = code:get_chunk(Code, "XXXX"), + undefined = code:get_chunk(<<"not a beam module">>, "Atom"), + undefined = code:get_chunk(Code, "XXXX"), ok. get_chunk_ok(Chunk, Code) -> case code:get_chunk(Code, Chunk) of - Bin when is_binary(Bin) -> Bin + Bin when is_binary(Bin) -> Bin end. module_md5(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "my_code_test"), - ?line {ok,my_code_test,Code} = compile:file(File, [binary]), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + {ok,my_code_test,Code} = compile:file(File, [binary]), %% Should work. - ?line Chunk = module_md5_ok(Code), - ?line Chunk = module_md5_ok(make_sub_binary(Code)), - ?line Chunk = module_md5_ok(make_unaligned_sub_binary(Code)), + Chunk = module_md5_ok(Code), + Chunk = module_md5_ok(make_sub_binary(Code)), + Chunk = module_md5_ok(make_unaligned_sub_binary(Code)), %% Should fail. - ?line {'EXIT',{badarg,_}} = (catch code:module_md5(bit_sized_binary(Code))), + {'EXIT',{badarg,_}} = (catch code:module_md5(bit_sized_binary(Code))), %% Invalid beam code should return 'undefined'. - ?line undefined = code:module_md5(<<"not a beam module">>), + undefined = code:module_md5(<<"not a beam module">>), ok. - + module_md5_ok(Code) -> case code:module_md5(Code) of - Bin when is_binary(Bin), size(Bin) =:= 16 -> Bin + Bin when is_binary(Bin), size(Bin) =:= 16 -> Bin end. @@ -392,106 +382,106 @@ 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]), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "my_code_test"), + {ok,my_code_test,Code} = compile:file(File, [binary]), - ?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), + my_code_test = code:make_stub_module(my_code_test, Code, {[],[],MD5}), + true = erlang:delete_module(my_code_test), + 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), + my_code_test = code:make_stub_module(my_code_test, + make_unaligned_sub_binary(Code), + {[],[],MD5}), + true = erlang:delete_module(my_code_test), + 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), + my_code_test = code:make_stub_module(my_code_test, zlib:gzip(Code), + {[],[],MD5}), + true = erlang:delete_module(my_code_test), + true = erlang:purge_module(my_code_test), %% Should fail. - ?line {'EXIT',{badarg,_}} = - (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, {[],[],MD5})), + {'EXIT',{badarg,_}} = + (catch code:make_stub_module(my_code_test, <<"bad">>, {[],[],MD5})), + {'EXIT',{badarg,_}} = + (catch code:make_stub_module(my_code_test, + bit_sized_binary(Code), + {[],[],MD5})), + {'EXIT',{badarg,_}} = + (catch code:make_stub_module(my_code_test_with_wrong_name, + 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]), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "many_funs"), + {ok,many_funs,Code} = compile:file(File, [binary]), - ?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), + many_funs = code:make_stub_module(many_funs, Code, {[],[],MD5}), + true = erlang:delete_module(many_funs), + true = erlang:purge_module(many_funs), + many_funs = code:make_stub_module(many_funs, + make_unaligned_sub_binary(Code), + {[],[],MD5}), + true = erlang:delete_module(many_funs), + true = erlang:purge_module(many_funs), %% Should fail. - ?line {'EXIT',{badarg,_}} = - (catch code:make_stub_module(many_funs, <<"bad">>, {[],[],MD5})), - ?line {'EXIT',{badarg,_}} = - (catch code:make_stub_module(many_funs, - bit_sized_binary(Code), - {[],[],MD5})), + {'EXIT',{badarg,_}} = + (catch code:make_stub_module(many_funs, <<"bad">>, {[],[],MD5})), + {'EXIT',{badarg,_}} = + (catch code:make_stub_module(many_funs, + bit_sized_binary(Code), + {[],[],MD5})), ok. constant_pools(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "literals"), - ?line {ok,literals,Code} = compile:file(File, [report,binary]), - ?line {module,literals} = erlang:load_module(literals, - make_sub_binary(Code)), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "literals"), + {ok,literals,Code} = compile:file(File, [report,binary]), + {module,literals} = erlang:load_module(literals, + make_sub_binary(Code)), %% Initialize. - ?line A = literals:a(), - ?line B = literals:b(), - ?line C = literals:huge_bignum(), - ?line process_flag(trap_exit, true), + A = literals:a(), + B = literals:b(), + C = literals:huge_bignum(), + process_flag(trap_exit, true), Self = self(), %% Have a process WITHOUT old heap that references the literals %% in the 'literals' module. - ?line NoOldHeap = spawn_link(fun() -> no_old_heap(Self) end), + NoOldHeap = spawn_link(fun() -> no_old_heap(Self) end), receive go -> ok end, - ?line true = erlang:delete_module(literals), - ?line false = erlang:check_process_code(NoOldHeap, literals), - ?line erlang:check_process_code(self(), literals), - ?line true = erlang:purge_module(literals), - ?line NoOldHeap ! done, - ?line receive - {'EXIT',NoOldHeap,{A,B,C}} -> - ok; - Other -> - ?line ?t:fail({unexpected,Other}) - end, - ?line {module,literals} = erlang:load_module(literals, Code), + true = erlang:delete_module(literals), + false = erlang:check_process_code(NoOldHeap, literals), + erlang:check_process_code(self(), literals), + true = erlang:purge_module(literals), + NoOldHeap ! done, + receive + {'EXIT',NoOldHeap,{A,B,C}} -> + ok; + Other -> + ct:fail({unexpected,Other}) + end, + {module,literals} = erlang:load_module(literals, Code), %% Have a process WITH an old heap that references the literals %% in the 'literals' module. - ?line OldHeap = spawn_link(fun() -> old_heap(Self) end), + OldHeap = spawn_link(fun() -> old_heap(Self) end), receive go -> ok end, - ?line true = erlang:delete_module(literals), - ?line false = erlang:check_process_code(OldHeap, literals), - ?line erlang:check_process_code(self(), literals), - ?line erlang:purge_module(literals), - ?line OldHeap ! done, + true = erlang:delete_module(literals), + false = erlang:check_process_code(OldHeap, literals), + erlang:check_process_code(self(), literals), + erlang:purge_module(literals), + OldHeap ! done, receive - {'EXIT',OldHeap,{A,B,C,[1,2,3|_]=Seq}} when length(Seq) =:= 16 -> - ok + {'EXIT',OldHeap,{A,B,C,[1,2,3|_]=Seq}} when length(Seq) =:= 16 -> + ok end. no_old_heap(Parent) -> @@ -500,8 +490,8 @@ no_old_heap(Parent) -> Res = {A,B,literals:huge_bignum()}, Parent ! go, receive - done -> - exit(Res) + done -> + exit(Res) end. old_heap(Parent) -> @@ -511,16 +501,16 @@ old_heap(Parent) -> create_old_heap(), Parent ! go, receive - done -> - exit(Res) + done -> + exit(Res) end. create_old_heap() -> case process_info(self(), [heap_size,total_heap_size]) of - [{heap_size,Sz},{total_heap_size,Total}] when Sz < Total -> - ok; - _ -> - create_old_heap() + [{heap_size,Sz},{total_heap_size,Total}] when Sz < Total -> + ok; + _ -> + create_old_heap() end. constant_refc_binaries(Config) when is_list(Config) -> @@ -529,7 +519,7 @@ constant_refc_binaries(Config) when is_list(Config) -> io:format("Binary data (bytes) before test: ~p\n", [Bef]), %% Compile the the literals module. - Data = ?config(data_dir, Config), + Data = proplists:get_value(data_dir, Config), File = filename:join(Data, "literals"), {ok,literals,Code} = compile:file(File, [report,binary]), @@ -554,29 +544,29 @@ constant_refc_binaries(Config) when is_list(Config) -> io:format("Binary data (bytes) after test: ~p", [Aft]), Diff = Aft - Bef, if - Diff < 0 -> - io:format("~p less bytes", [abs(Diff)]); - Diff > 0 -> - io:format("~p more bytes", [Diff]); - true -> - ok + Diff < 0 -> + io:format("~p less bytes", [abs(Diff)]); + Diff > 0 -> + io:format("~p more bytes", [Diff]); + true -> + ok end, %% Test for leaks. We must accept some natural variations in %% the size of allocated binaries. if - Diff > 64*1024 -> - ?t:fail(binary_leak); - true -> - ok + Diff > 64*1024 -> + ct:fail(binary_leak); + true -> + ok end. memory_binary() -> try - erlang:memory(binary) + erlang:memory(binary) catch - error:notsup -> - 0 + error:notsup -> + 0 end. provoke_mem_leak(0, _, _) -> ok; @@ -586,19 +576,19 @@ provoke_mem_leak(N, Code, Check) -> %% Create several processes with references to the literal binary. Self = self(), Pids = [spawn_link(fun() -> - create_binaries(Self, NumRefs, Check) - end) || NumRefs <- lists:seq(1, 10)], + create_binaries(Self, NumRefs, Check) + end) || NumRefs <- lists:seq(1, 10)], [receive {started,Pid} -> ok end || Pid <- Pids], %% Make the code old and remove references to the constant pool %% in all processes. true = erlang:delete_module(literals), Ms = [spawn_monitor(fun() -> - false = erlang:check_process_code(Pid, literals) - end) || Pid <- Pids], + false = erlang:check_process_code(Pid, literals) + end) || Pid <- Pids], [receive - {'DOWN',R,process,P,normal} -> - ok + {'DOWN',R,process,P,normal} -> + ok end || {P,R} <- Ms], %% Purge the code. @@ -606,14 +596,14 @@ provoke_mem_leak(N, Code, Check) -> %% Tell the processes that the code has been purged. [begin - monitor(process, Pid), - Pid ! purged + monitor(process, Pid), + Pid ! purged end || Pid <- Pids], %% Wait for all processes to terminate. [receive - {'DOWN',_,process,Pid,normal} -> - ok + {'DOWN',_,process,Pid,normal} -> + ok end || Pid <- Pids], %% We now expect that the binary has been deallocated. @@ -625,112 +615,112 @@ create_binaries(Parent, NumRefs, Check) -> {bits,Bits} = literals:bits(), Parent ! {started,self()}, receive - purged -> - %% The code has been purged. Now make sure that - %% the binaries haven't been corrupted. - Check = erlang:md5(Bin), - [Bin = B || B <- Bins], - <<42:13,Bin/binary>> = Bits, - - %% Remove all references to the binaries - %% Doing it explicitly like this ensures that - %% the binaries are gone when the parent process - %% receives the 'DOWN' message. - erlang:garbage_collect() + purged -> + %% The code has been purged. Now make sure that + %% the binaries haven't been corrupted. + Check = erlang:md5(Bin), + [Bin = B || B <- Bins], + <<42:13,Bin/binary>> = Bits, + + %% Remove all references to the binaries + %% Doing it explicitly like this ensures that + %% the binaries are gone when the parent process + %% receives the 'DOWN' message. + erlang:garbage_collect() end. wait_for_memory_deallocations() -> try - erts_debug:set_internal_state(wait, deallocations) + erts_debug:set_internal_state(wait, deallocations) catch - error:undef -> - erts_debug:set_internal_state(available_internal_state, true), - wait_for_memory_deallocations() + error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + wait_for_memory_deallocations() end. %% OTP-7559: c_p->cp could contain garbage and create a false dependency %% to a module in a process. (Thanks to Richard Carlsson.) false_dependency(Config) when is_list(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "cpbugx"), - ?line {ok,cpbugx,Code} = compile:file(File, [binary,report]), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "cpbugx"), + {ok,cpbugx,Code} = compile:file(File, [binary,report]), do_false_dependency(fun cpbugx:before/0, Code), do_false_dependency(fun cpbugx:before2/0, Code), do_false_dependency(fun cpbugx:before3/0, Code), -%% %% Spawn process. Make sure it has called cpbugx:before/0 and returned. -%% Parent = self(), -%% ?line Pid = spawn_link(fun() -> false_dependency_loop(Parent) end), -%% ?line receive initialized -> ok end, + %% %% Spawn process. Make sure it has called cpbugx:before/0 and returned. + %% Parent = self(), + %% Pid = spawn_link(fun() -> false_dependency_loop(Parent) end), + %% receive initialized -> ok end, + + %% %% Reload the module. Make sure the process is still alive. + %% {module,cpbugx} = erlang:load_module(cpbugx, Bin), + %% io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))), + %% true = is_process_alive(Pid), -%% %% Reload the module. Make sure the process is still alive. -%% ?line {module,cpbugx} = erlang:load_module(cpbugx, Bin), -%% ?line io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))), -%% ?line true = is_process_alive(Pid), + %% %% There should not be any dependency to cpbugx. + %% false = erlang:check_process_code(Pid, cpbugx), -%% %% There should not be any dependency to cpbugx. -%% ?line false = erlang:check_process_code(Pid, cpbugx), - -%% %% Kill the process. -%% ?line unlink(Pid), exit(Pid, kill), + %% %% Kill the process. + %% unlink(Pid), exit(Pid, kill), ok. do_false_dependency(Init, Code) -> - ?line {module,cpbugx} = erlang:load_module(cpbugx, Code), + {module,cpbugx} = erlang:load_module(cpbugx, Code), %% Spawn process. Make sure it has the appropriate init function %% and returned. CP should not contain garbage after the return. Parent = self(), - ?line Pid = spawn_link(fun() -> false_dependency_loop(Parent, Init, true) end), - ?line receive initialized -> ok end, + Pid = spawn_link(fun() -> false_dependency_loop(Parent, Init, true) end), + receive initialized -> ok end, %% Reload the module. Make sure the process is still alive. - ?line {module,cpbugx} = erlang:load_module(cpbugx, Code), - ?line io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))), - ?line true = is_process_alive(Pid), + {module,cpbugx} = erlang:load_module(cpbugx, Code), + io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))), + true = is_process_alive(Pid), %% There should not be any dependency to cpbugx. - ?line false = erlang:check_process_code(Pid, cpbugx), + false = erlang:check_process_code(Pid, cpbugx), %% Kill the process and completely unload the code. - ?line unlink(Pid), exit(Pid, kill), - ?line true = erlang:purge_module(cpbugx), - ?line true = erlang:delete_module(cpbugx), - ?line code:is_module_native(cpbugx), % test is_module_native on deleted code - ?line true = erlang:purge_module(cpbugx), - ?line code:is_module_native(cpbugx), % test is_module_native on purged code + unlink(Pid), exit(Pid, kill), + true = erlang:purge_module(cpbugx), + true = erlang:delete_module(cpbugx), + code:is_module_native(cpbugx), % test is_module_native on deleted code + true = erlang:purge_module(cpbugx), + code:is_module_native(cpbugx), % test is_module_native on purged code ok. - + false_dependency_loop(Parent, Init, SendInitAck) -> Init(), case SendInitAck of - true -> Parent ! initialized; - false -> void - %% Just send one init-ack. I guess the point of this test - %% wasn't to fill parents msg-queue (?). Seen to cause - %% out-of-mem (on halfword-vm for some reason) by - %% 91 million msg in queue. /sverker + true -> Parent ! initialized; + false -> void + %% Just send one init-ack. I guess the point of this test + %% wasn't to fill parents msg-queue (?). Seen to cause + %% out-of-mem (on halfword-vm for some reason) by + %% 91 million msg in queue. /sverker end, receive - _ -> false_dependency_loop(Parent, Init, false) + _ -> false_dependency_loop(Parent, Init, false) end. coverage(Config) when is_list(Config) -> - ?line code:is_module_native(?MODULE), - ?line {'EXIT',{badarg,_}} = (catch erlang:purge_module({a,b,c})), - ?line {'EXIT',{badarg,_}} = (catch code:is_module_native({a,b,c})), - ?line {'EXIT',{badarg,_}} = (catch erlang:check_process_code(not_a_pid, ?MODULE)), - ?line {'EXIT',{badarg,_}} = (catch erlang:check_process_code(self(), [not_a_module])), - ?line {'EXIT',{badarg,_}} = (catch erlang:delete_module([a,b,c])), - ?line {'EXIT',{badarg,_}} = (catch erlang:module_loaded(42)), + code:is_module_native(?MODULE), + {'EXIT',{badarg,_}} = (catch erlang:purge_module({a,b,c})), + {'EXIT',{badarg,_}} = (catch code:is_module_native({a,b,c})), + {'EXIT',{badarg,_}} = (catch erlang:check_process_code(not_a_pid, ?MODULE)), + {'EXIT',{badarg,_}} = (catch erlang:check_process_code(self(), [not_a_module])), + {'EXIT',{badarg,_}} = (catch erlang:delete_module([a,b,c])), + {'EXIT',{badarg,_}} = (catch erlang:module_loaded(42)), ok. fun_confusion(Config) when is_list(Config) -> - Data = ?config(data_dir, Config), + Data = proplists:get_value(data_dir, Config), Src = filename:join(Data, "fun_confusion"), Mod = fun_confusion, @@ -753,6 +743,80 @@ compile_load(Mod, Src, Ver) -> {module,Mod} = code:load_binary(Mod, "fun_confusion.beam", Code1), ok. + +t_copy_literals(Config) when is_list(Config) -> + %% Compile the the literals module. + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "literals"), + {ok,literals,Code} = compile:file(File, [report,binary]), + {module,literals} = erlang:load_module(literals, Code), + + N = 30, + Me = self(), + %% reload literals code every 567 ms + Rel = spawn_link(fun() -> reloader(literals,Code,567) end), + %% add new literal msgs to the loop every 789 ms + Sat = spawn_link(fun() -> saturate(Me,789) end), + %% run for 10s + _ = spawn_link(fun() -> receive after 10000 -> Me ! done end end), + ok = chase_msg(N, Me), + %% cleanup + Rel ! done, + Sat ! done, + ok = flush(), + ok. + + +chase_msg(0, Pid) -> + chase_loop(Pid); +chase_msg(N, Master) -> + Pid = spawn_link(fun() -> chase_msg(N - 1,Master) end), + chase_loop(Pid). + +chase_loop(Pid) -> + receive + done -> + Pid ! done, + ok; + {_From,Msg} -> + Pid ! {self(), Msg}, + ok = traverse(Msg), + chase_loop(Pid) + end. + +saturate(Pid,Time) -> + Es = [msg1,msg2,msg3,msg4,msg5], + Msg = [literals:E()||E <- Es], + Pid ! {self(), Msg}, + receive + done -> ok + after Time -> + saturate(Pid,Time) + end. + +traverse([]) -> ok; +traverse([H|T]) -> + ok = traverse(H), + traverse(T); +traverse(T) when is_tuple(T) -> ok; +traverse(B) when is_binary(B) -> ok; +traverse(I) when is_integer(I) -> ok; +traverse(#{ 1 := V1, b := V2 }) -> + ok = traverse(V1), + ok = traverse(V2), + ok. + + +reloader(Mod,Code,Time) -> + receive + done -> ok + after Time -> + code:purge(Mod), + {module,Mod} = erlang:load_module(Mod, Code), + reloader(Mod,Code,Time) + end. + + %% Utilities. make_sub_binary(Bin) when is_binary(Bin) -> @@ -775,4 +839,7 @@ bit_sized_binary(Bin0) -> BitSize = 8*size(Bin) + 1, Bin. +flush() -> + receive _ -> flush() after 0 -> ok end. + id(I) -> I. diff --git a/erts/emulator/test/code_SUITE_data/another_code_test.erl b/erts/emulator/test/code_SUITE_data/another_code_test.erl index f6f9e32996..5708ec682c 100644 --- a/erts/emulator/test/code_SUITE_data/another_code_test.erl +++ b/erts/emulator/test/code_SUITE_data/another_code_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/code_SUITE_data/cpbugx.erl b/erts/emulator/test/code_SUITE_data/cpbugx.erl index ea01ce411b..ae2075c867 100644 --- a/erts/emulator/test/code_SUITE_data/cpbugx.erl +++ b/erts/emulator/test/code_SUITE_data/cpbugx.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/code_SUITE_data/fun_confusion.erl b/erts/emulator/test/code_SUITE_data/fun_confusion.erl index 8d42937d3c..35279f241d 100644 --- a/erts/emulator/test/code_SUITE_data/fun_confusion.erl +++ b/erts/emulator/test/code_SUITE_data/fun_confusion.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/code_SUITE_data/literals.erl b/erts/emulator/test/code_SUITE_data/literals.erl index 9802d9d3f9..7c3b0ebe73 100644 --- a/erts/emulator/test/code_SUITE_data/literals.erl +++ b/erts/emulator/test/code_SUITE_data/literals.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,6 +20,7 @@ -module(literals). -export([a/0,b/0,huge_bignum/0,binary/0,unused_binaries/0,bits/0]). +-export([msg1/0,msg2/0,msg3/0,msg4/0,msg5/0]). a() -> {a,42.0,[7,38877938333399637266518333334747]}. @@ -101,3 +102,9 @@ unused_binaries() -> bits() -> {bits,<<42:13,?MB_1>>}. + +msg1() -> "halloj". +msg2() -> {"hello","world"}. +msg3() -> <<"halloj">>. +msg4() -> #{ 1=> "hello", b => "world"}. +msg5() -> {1,2,3,4,5,6}. diff --git a/erts/emulator/test/code_SUITE_data/many_funs.erl b/erts/emulator/test/code_SUITE_data/many_funs.erl index e832f271d0..ada570feee 100644 --- a/erts/emulator/test/code_SUITE_data/many_funs.erl +++ b/erts/emulator/test/code_SUITE_data/many_funs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/code_SUITE_data/my_code_test.erl b/erts/emulator/test/code_SUITE_data/my_code_test.erl index 57d867a5ac..d2386157d6 100644 --- a/erts/emulator/test/code_SUITE_data/my_code_test.erl +++ b/erts/emulator/test/code_SUITE_data/my_code_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/code_SUITE_data/versions.erl b/erts/emulator/test/code_SUITE_data/versions.erl index 0e2d92c8f1..56407e877a 100644 --- a/erts/emulator/test/code_SUITE_data/versions.erl +++ b/erts/emulator/test/code_SUITE_data/versions.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/code_parallel_load_SUITE.erl b/erts/emulator/test/code_parallel_load_SUITE.erl index b7ac0420cd..827add71e5 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-2014. All Rights Reserved. +%% Copyright Ericsson AB 2012-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,49 +19,34 @@ %% -module(code_parallel_load_SUITE). --export([ - all/0, - suite/0, - init_per_suite/1, - end_per_suite/1, - init_per_testcase/2, - end_per_testcase/2 - ]). - --export([ - multiple_load_check_purge_repeat/1, - many_load_distributed_only_once/1 - ]). +-export([all/0, + suite/0, + init_per_testcase/2, + end_per_testcase/2]). + +-export([multiple_load_check_purge_repeat/1, + many_load_distributed_only_once/1]). -define(model, code_parallel_load_SUITE_model). -define(interval, 50). -define(number_of_processes, 160). -define(passes, 4). +-include_lib("common_test/include/ct.hrl"). --include_lib("test_server/include/test_server.hrl"). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. all() -> - [ - multiple_load_check_purge_repeat, - many_load_distributed_only_once - ]. - - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. + [ multiple_load_check_purge_repeat, + many_load_distributed_only_once ]. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(3)), - [{watchdog, Dog}|Config]. + Config. end_per_testcase(_Func, Config) -> - SConf = ?config(save_config, Config), + SConf = proplists:get_value(save_config, Config), Pids = proplists:get_value(purge_pids, SConf), case check_old_code(?model) of @@ -72,9 +57,7 @@ end_per_testcase(_Func, Config) -> true -> check_and_purge_processes_code(Pids, ?model); _ -> ok end, - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - + ok. multiple_load_check_purge_repeat(_Conf) -> Ts = [v1,v2,v3,v4,v5,v6], diff --git a/erts/emulator/test/crypto_SUITE.erl b/erts/emulator/test/crypto_SUITE.erl index 3622592586..afb1be7332 100644 --- a/erts/emulator/test/crypto_SUITE.erl +++ b/erts/emulator/test/crypto_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,65 +20,44 @@ -module(crypto_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - t_md5/1,t_md5_update/1,error/1,unaligned_context/1,random_lists/1, - misc_errors/1]). +-export([all/0, suite/0, + t_md5/1,t_md5_update/1,error/1,unaligned_context/1,random_lists/1, + misc_errors/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}]. all() -> [t_md5, t_md5_update, error, unaligned_context, random_lists, misc_errors]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - - -misc_errors(doc) -> - ["Test crc32, adler32 and md5 error cases not covered by other tests"]; -misc_errors(suite) -> - []; +%% Test crc32, adler32 and md5 error cases not covered by other tests" misc_errors(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(2)), - ?line 1 = erlang:adler32([]), - ?line L = lists:duplicate(600,3), - ?line 1135871753 = erlang:adler32(L), - ?line L2 = lists:duplicate(22000,3), - ?line 1100939744 = erlang:adler32(L2), - ?line {'EXIT', {badarg,_}} = (catch erlang:adler32(L++[a])), - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32(L++[a])), - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32([1,2,3|<<25:7>>])), - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32([1,2,3|4])), - ?line Big = 111111111111111111111111111111, - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32(Big,<<"hej">>)), - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32(25,[1,2,3|4])), - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(Big,3,3)), - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(3,Big,3)), - ?line {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(3,3,Big)), - ?line {'EXIT', {badarg,_}} = (catch erlang:adler32(Big,<<"hej">>)), - ?line {'EXIT', {badarg,_}} = (catch erlang:adler32(25,[1,2,3|4])), - ?line {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(Big,3,3)), - ?line {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(3,Big,3)), - ?line {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(3,3,Big)), - ?line {'EXIT', {badarg,_}} = (catch erlang:md5_update(<<"hej">>,<<"hej">>)), - ?line {'EXIT', {badarg,_}} = (catch erlang:md5_final(<<"hej">>)), - ?line test_server:timetrap_cancel(Dog), + ct:timetrap({minutes, 2}), + 1 = erlang:adler32([]), + L = lists:duplicate(600,3), + 1135871753 = erlang:adler32(L), + L2 = lists:duplicate(22000,3), + 1100939744 = erlang:adler32(L2), + {'EXIT', {badarg,_}} = (catch erlang:adler32(L++[a])), + {'EXIT', {badarg,_}} = (catch erlang:crc32(L++[a])), + {'EXIT', {badarg,_}} = (catch erlang:crc32([1,2,3|<<25:7>>])), + {'EXIT', {badarg,_}} = (catch erlang:crc32([1,2,3|4])), + Big = 111111111111111111111111111111, + {'EXIT', {badarg,_}} = (catch erlang:crc32(Big,<<"hej">>)), + {'EXIT', {badarg,_}} = (catch erlang:crc32(25,[1,2,3|4])), + {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(Big,3,3)), + {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(3,Big,3)), + {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(3,3,Big)), + {'EXIT', {badarg,_}} = (catch erlang:adler32(Big,<<"hej">>)), + {'EXIT', {badarg,_}} = (catch erlang:adler32(25,[1,2,3|4])), + {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(Big,3,3)), + {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(3,Big,3)), + {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(3,3,Big)), + {'EXIT', {badarg,_}} = (catch erlang:md5_update(<<"hej">>,<<"hej">>)), + {'EXIT', {badarg,_}} = (catch erlang:md5_final(<<"hej">>)), ok. @@ -93,7 +72,7 @@ nicesplit(N,L) -> nicesplit(0,Tail,Acc) -> {lists:reverse(Acc),Tail}; nicesplit(_,[],Acc) -> - {lists:reverse(Acc),[]}; + {lists:reverse(Acc),[]}; nicesplit(N,[H|Tail],Acc) -> nicesplit(N-1,Tail,[H|Acc]). @@ -102,17 +81,17 @@ run_in_para([],_) -> run_in_para(FunList,Schedulers) -> {ThisTime,NextTime} = nicesplit(Schedulers,FunList), case length(ThisTime) of - 1 -> - [{L,Fun}] = ThisTime, - try - Fun() + 1 -> + [{L,Fun}] = ThisTime, + try + Fun() catch - _:Reason -> - exit({error_at_line,L,Reason}) - end; + _:Reason -> + exit({error_at_line,L,Reason}) + end; _ -> - These = [ {L,erlang:spawn_monitor(F)} || {L,F} <- ThisTime ], - collect_workers(These) + These = [ {L,erlang:spawn_monitor(F)} || {L,F} <- ThisTime ], + collect_workers(These) end, run_in_para(NextTime,Schedulers). @@ -120,159 +99,147 @@ collect_workers([]) -> ok; collect_workers([{L,{Pid,Ref}}|T]) -> receive - {'DOWN',Ref,process,Pid,normal} -> - collect_workers(T); - {'DOWN',Ref,process,Pid,Other} -> - exit({error_at_line,L,Other}) + {'DOWN',Ref,process,Pid,normal} -> + collect_workers(T); + {'DOWN',Ref,process,Pid,Other} -> + exit({error_at_line,L,Other}) end. -random_lists(doc) -> - ["Test crc32, adler32 and md5 on a number of pseudo-randomly generated " - "lists."]; -random_lists(suite) -> - []; +%% Test crc32, adler32 and md5 on a number of pseudo-randomly generated lists. random_lists(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(5)), - ?line Num = erlang:system_info(schedulers_online), - ?line B = list_to_binary( - lists:duplicate( - (erlang:system_info(context_reductions)*10) - 50,$!)), - ?line CRC32_1 = fun(L) -> erlang:crc32(L) end, - ?line CRC32_2 = fun(L) -> ?REF:crc32(L) end, - ?line ADLER32_1 = fun(L) -> erlang:adler32(L) end, - ?line ADLER32_2 = fun(L) -> ?REF:adler32(L) end, - ?line MD5_1 = fun(L) -> erlang:md5(L) end, - ?line MD5_2 = fun(L) -> ?REF:md5_final( - ?REF:md5_update(?REF:md5_init(),L)) end, - ?line MD5_3 = fun(L) -> erlang:md5_final( - erlang:md5_update(erlang:md5_init(),L)) end, - ?line CRC32_1_L = fun(L) -> erlang:crc32([B|L]) end, - ?line CRC32_2_L = fun(L) -> ?REF:crc32([B|L]) end, - ?line ADLER32_1_L = fun(L) -> erlang:adler32([B|L]) end, - ?line ADLER32_2_L = fun(L) -> ?REF:adler32([B|L]) end, - ?line MD5_1_L = fun(L) -> erlang:md5([B|L]) end, - ?line MD5_2_L = fun(L) -> ?REF:md5_final( - ?REF:md5_update(?REF:md5_init(),[B|L])) end, - ?line MD5_3_L = fun(L) -> erlang:md5_final( - erlang:md5_update( - erlang:md5_init(),[B|L])) end, - ?line Wlist0 = - [{?LINE, fun() -> random_iolist:run(150, CRC32_1, CRC32_2) end}, - {?LINE, fun() -> random_iolist:run(150, ADLER32_1, ADLER32_2) end}, - {?LINE, fun() -> random_iolist:run(150,MD5_1,MD5_2) end}, - {?LINE, fun() -> random_iolist:run(150,MD5_1,MD5_3) end}, - {?LINE, fun() -> random_iolist:run(150, CRC32_1_L, CRC32_2_L) end}, - {?LINE, - fun() -> random_iolist:run(150, ADLER32_1_L, ADLER32_2_L) end}, - {?LINE, fun() -> random_iolist:run(150,MD5_1_L,MD5_2_L) end}, - {?LINE, fun() -> random_iolist:run(150,MD5_1_L,MD5_3_L) end}], - ?line run_in_para(Wlist0,Num), - ?line CRC32_1_2 = fun(L1,L2) -> erlang:crc32([L1,L2]) end, - ?line CRC32_2_2 = fun(L1,L2) -> erlang:crc32(erlang:crc32(L1),L2) end, - ?line CRC32_3_2 = fun(L1,L2) -> erlang:crc32_combine( - erlang:crc32(L1), - erlang:crc32(L2), - erlang:iolist_size(L2)) - end, - ?line ADLER32_1_2 = fun(L1,L2) -> erlang:adler32([L1,L2]) end, - ?line ADLER32_2_2 = fun(L1,L2) -> erlang:adler32( - erlang:adler32(L1),L2) end, - ?line ADLER32_3_2 = fun(L1,L2) -> erlang:adler32_combine( - erlang:adler32(L1), - erlang:adler32(L2), - erlang:iolist_size(L2)) - end, - ?line MD5_1_2 = fun(L1,L2) -> erlang:md5([L1,L2]) end, - ?line MD5_2_2 = fun(L1,L2) -> - erlang:md5_final( - erlang:md5_update( - erlang:md5_update( - erlang:md5_init(), - L1), - L2)) - end, - ?line CRC32_1_L_2 = fun(L1,L2) -> erlang:crc32([[B|L1],[B|L2]]) end, - ?line CRC32_2_L_2 = fun(L1,L2) -> erlang:crc32( - erlang:crc32([B|L1]),[B|L2]) end, - ?line CRC32_3_L_2 = fun(L1,L2) -> erlang:crc32_combine( - erlang:crc32([B|L1]), - erlang:crc32([B|L2]), - erlang:iolist_size([B|L2])) - end, - ?line ADLER32_1_L_2 = fun(L1,L2) -> erlang:adler32([[B|L1],[B|L2]]) end, - ?line ADLER32_2_L_2 = fun(L1,L2) -> erlang:adler32( - erlang:adler32([B|L1]), - [B|L2]) - end, - ?line ADLER32_3_L_2 = fun(L1,L2) -> erlang:adler32_combine( - erlang:adler32([B|L1]), - erlang:adler32([B|L2]), - erlang:iolist_size([B|L2])) - end, - ?line MD5_1_L_2 = fun(L1,L2) -> erlang:md5([[B|L1],[B|L2]]) end, - ?line MD5_2_L_2 = fun(L1,L2) -> - erlang:md5_final( - erlang:md5_update( - erlang:md5_update( - erlang:md5_init(), - [B|L1]), - [B|L2])) - end, - ?line Wlist1 = - [{?LINE, fun() -> random_iolist:run2(150,CRC32_1_2,CRC32_2_2) end}, - {?LINE, fun() -> random_iolist:run2(150,CRC32_1_2,CRC32_3_2) end}, - {?LINE, fun() -> random_iolist:run2(150,ADLER32_1_2,ADLER32_2_2) end}, - {?LINE, fun() -> random_iolist:run2(150,ADLER32_1_2,ADLER32_3_2) end}, - {?LINE, fun() -> random_iolist:run2(150,MD5_1_2,MD5_2_2) end}, - {?LINE, fun() -> random_iolist:run2(150,CRC32_1_L_2,CRC32_2_L_2) end}, - {?LINE, fun() -> random_iolist:run2(150,CRC32_1_L_2,CRC32_3_L_2) end}, - {?LINE, - fun() -> random_iolist:run2(150,ADLER32_1_L_2,ADLER32_2_L_2) end}, - {?LINE, - fun() -> random_iolist:run2(150,ADLER32_1_L_2,ADLER32_3_L_2) end}, - {?LINE, fun() -> random_iolist:run2(150,MD5_1_L_2,MD5_2_L_2) end}], - ?line run_in_para(Wlist1,Num), - ?line test_server:timetrap_cancel(Dog), + ct:timetrap({minutes, 5}), + Num = erlang:system_info(schedulers_online), + B = list_to_binary( + lists:duplicate( + (erlang:system_info(context_reductions)*10) - 50,$!)), + CRC32_1 = fun(L) -> erlang:crc32(L) end, + CRC32_2 = fun(L) -> ?REF:crc32(L) end, + ADLER32_1 = fun(L) -> erlang:adler32(L) end, + ADLER32_2 = fun(L) -> ?REF:adler32(L) end, + MD5_1 = fun(L) -> erlang:md5(L) end, + MD5_2 = fun(L) -> ?REF:md5_final( + ?REF:md5_update(?REF:md5_init(),L)) end, + MD5_3 = fun(L) -> erlang:md5_final( + erlang:md5_update(erlang:md5_init(),L)) end, + CRC32_1_L = fun(L) -> erlang:crc32([B|L]) end, + CRC32_2_L = fun(L) -> ?REF:crc32([B|L]) end, + ADLER32_1_L = fun(L) -> erlang:adler32([B|L]) end, + ADLER32_2_L = fun(L) -> ?REF:adler32([B|L]) end, + MD5_1_L = fun(L) -> erlang:md5([B|L]) end, + MD5_2_L = fun(L) -> ?REF:md5_final( + ?REF:md5_update(?REF:md5_init(),[B|L])) end, + MD5_3_L = fun(L) -> erlang:md5_final( + erlang:md5_update( + erlang:md5_init(),[B|L])) end, + Wlist0 = + [{?LINE, fun() -> random_iolist:run(150, CRC32_1, CRC32_2) end}, + {?LINE, fun() -> random_iolist:run(150, ADLER32_1, ADLER32_2) end}, + {?LINE, fun() -> random_iolist:run(150,MD5_1,MD5_2) end}, + {?LINE, fun() -> random_iolist:run(150,MD5_1,MD5_3) end}, + {?LINE, fun() -> random_iolist:run(150, CRC32_1_L, CRC32_2_L) end}, + {?LINE, + fun() -> random_iolist:run(150, ADLER32_1_L, ADLER32_2_L) end}, + {?LINE, fun() -> random_iolist:run(150,MD5_1_L,MD5_2_L) end}, + {?LINE, fun() -> random_iolist:run(150,MD5_1_L,MD5_3_L) end}], + run_in_para(Wlist0,Num), + CRC32_1_2 = fun(L1,L2) -> erlang:crc32([L1,L2]) end, + CRC32_2_2 = fun(L1,L2) -> erlang:crc32(erlang:crc32(L1),L2) end, + CRC32_3_2 = fun(L1,L2) -> erlang:crc32_combine( + erlang:crc32(L1), + erlang:crc32(L2), + erlang:iolist_size(L2)) + end, + ADLER32_1_2 = fun(L1,L2) -> erlang:adler32([L1,L2]) end, + ADLER32_2_2 = fun(L1,L2) -> erlang:adler32( + erlang:adler32(L1),L2) end, + ADLER32_3_2 = fun(L1,L2) -> erlang:adler32_combine( + erlang:adler32(L1), + erlang:adler32(L2), + erlang:iolist_size(L2)) + end, + MD5_1_2 = fun(L1,L2) -> erlang:md5([L1,L2]) end, + MD5_2_2 = fun(L1,L2) -> + erlang:md5_final( + erlang:md5_update( + erlang:md5_update( + erlang:md5_init(), + L1), + L2)) + end, + CRC32_1_L_2 = fun(L1,L2) -> erlang:crc32([[B|L1],[B|L2]]) end, + CRC32_2_L_2 = fun(L1,L2) -> erlang:crc32( + erlang:crc32([B|L1]),[B|L2]) end, + CRC32_3_L_2 = fun(L1,L2) -> erlang:crc32_combine( + erlang:crc32([B|L1]), + erlang:crc32([B|L2]), + erlang:iolist_size([B|L2])) + end, + ADLER32_1_L_2 = fun(L1,L2) -> erlang:adler32([[B|L1],[B|L2]]) end, + ADLER32_2_L_2 = fun(L1,L2) -> erlang:adler32( + erlang:adler32([B|L1]), + [B|L2]) + end, + ADLER32_3_L_2 = fun(L1,L2) -> erlang:adler32_combine( + erlang:adler32([B|L1]), + erlang:adler32([B|L2]), + erlang:iolist_size([B|L2])) + end, + MD5_1_L_2 = fun(L1,L2) -> erlang:md5([[B|L1],[B|L2]]) end, + MD5_2_L_2 = fun(L1,L2) -> + erlang:md5_final( + erlang:md5_update( + erlang:md5_update( + erlang:md5_init(), + [B|L1]), + [B|L2])) + end, + Wlist1 = + [{?LINE, fun() -> random_iolist:run2(150,CRC32_1_2,CRC32_2_2) end}, + {?LINE, fun() -> random_iolist:run2(150,CRC32_1_2,CRC32_3_2) end}, + {?LINE, fun() -> random_iolist:run2(150,ADLER32_1_2,ADLER32_2_2) end}, + {?LINE, fun() -> random_iolist:run2(150,ADLER32_1_2,ADLER32_3_2) end}, + {?LINE, fun() -> random_iolist:run2(150,MD5_1_2,MD5_2_2) end}, + {?LINE, fun() -> random_iolist:run2(150,CRC32_1_L_2,CRC32_2_L_2) end}, + {?LINE, fun() -> random_iolist:run2(150,CRC32_1_L_2,CRC32_3_L_2) end}, + {?LINE, + fun() -> random_iolist:run2(150,ADLER32_1_L_2,ADLER32_2_L_2) end}, + {?LINE, + fun() -> random_iolist:run2(150,ADLER32_1_L_2,ADLER32_3_L_2) end}, + {?LINE, fun() -> random_iolist:run2(150,MD5_1_L_2,MD5_2_L_2) end}], + run_in_para(Wlist1,Num), ok. -%% -%% -t_md5(doc) -> - ["Generate MD5 message digests and check the result. Examples are " - "from RFC-1321."]; +%% Generate MD5 message digests and check the result. Examples are from RFC-1321. t_md5(Config) when is_list(Config) -> - ?line t_md5_test("", "d41d8cd98f00b204e9800998ecf8427e"), - ?line t_md5_test("a", "0cc175b9c0f1b6a831c399e269772661"), - ?line t_md5_test("abc", "900150983cd24fb0d6963f7d28e17f72"), - ?line t_md5_test(["message ","digest"], "f96b697d7cb7938d525a2f31aaf161d0"), - ?line t_md5_test(["message ",unaligned_sub_bin(<<"digest">>)], - "f96b697d7cb7938d525a2f31aaf161d0"), - ?line t_md5_test("abcdefghijklmnopqrstuvwxyz", - "c3fcd3d76192e4007dfb496cca67e13b"), - ?line t_md5_test("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" - "0123456789", - "d174ab98d277d9f5a5611c2c9f419d9f"), - ?line t_md5_test("12345678901234567890123456789012345678901234567890" - "123456789012345678901234567890", - "57edf4a22be3c955ac49da2e2107b67a"), + t_md5_test("", "d41d8cd98f00b204e9800998ecf8427e"), + t_md5_test("a", "0cc175b9c0f1b6a831c399e269772661"), + t_md5_test("abc", "900150983cd24fb0d6963f7d28e17f72"), + t_md5_test(["message ","digest"], "f96b697d7cb7938d525a2f31aaf161d0"), + t_md5_test(["message ",unaligned_sub_bin(<<"digest">>)], + "f96b697d7cb7938d525a2f31aaf161d0"), + t_md5_test("abcdefghijklmnopqrstuvwxyz", + "c3fcd3d76192e4007dfb496cca67e13b"), + t_md5_test("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" + "0123456789", + "d174ab98d277d9f5a5611c2c9f419d9f"), + t_md5_test("12345678901234567890123456789012345678901234567890" + "123456789012345678901234567890", + "57edf4a22be3c955ac49da2e2107b67a"), ok. -%% -%% -t_md5_update(doc) -> - ["Generate MD5 message using md5_init, md5_update, and md5_final, and" - "check the result. Examples are from RFC-1321."]; +%% Generate MD5 message using md5_init, md5_update, and md5_final, and +%% check the result. Examples are from RFC-1321. t_md5_update(Config) when is_list(Config) -> - ?line t_md5_update_1(fun(Str) -> Str end), - ?line t_md5_update_1(fun(Str) -> list_to_binary(Str) end), - ?line t_md5_update_1(fun(Str) -> unaligned_sub_bin(list_to_binary(Str)) end), + t_md5_update_1(fun(Str) -> Str end), + t_md5_update_1(fun(Str) -> list_to_binary(Str) end), + t_md5_update_1(fun(Str) -> unaligned_sub_bin(list_to_binary(Str)) end), ok. t_md5_update_1(Tr) when is_function(Tr, 1) -> Ctx = erlang:md5_init(), Ctx1 = erlang:md5_update(Ctx, Tr("ABCDEFGHIJKLMNOPQRSTUVWXYZ")), Ctx2 = erlang:md5_update(Ctx1, Tr("abcdefghijklmnopqrstuvwxyz" - "0123456789")), + "0123456789")), m(erlang:md5_final(Ctx2), hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")), ok. @@ -280,28 +247,28 @@ t_md5_update_1(Tr) when is_function(Tr, 1) -> %% %% error(Config) when is_list(Config) -> - ?line {'EXIT',{badarg,_}} = (catch erlang:md5(bit_sized_binary(<<"abc">>))), - ?line Ctx0 = erlang:md5_init(), - ?line {'EXIT',{badarg,_}} = - (catch erlang:md5_update(Ctx0, bit_sized_binary(<<"abcfjldjd">>))), - ?line {'EXIT',{badarg,_}} = - (catch erlang:md5_update(Ctx0, ["something",bit_sized_binary(<<"abcfjldjd">>)])), - ?line {'EXIT',{badarg,_}} = - (catch erlang:md5_update(bit_sized_binary(Ctx0), "something")), - ?line {'EXIT',{badarg,_}} = (catch erlang:md5_final(bit_sized_binary(Ctx0))), - ?line m(erlang:md5_final(Ctx0), hexstr2bin("d41d8cd98f00b204e9800998ecf8427e")), + {'EXIT',{badarg,_}} = (catch erlang:md5(bit_sized_binary(<<"abc">>))), + Ctx0 = erlang:md5_init(), + {'EXIT',{badarg,_}} = + (catch erlang:md5_update(Ctx0, bit_sized_binary(<<"abcfjldjd">>))), + {'EXIT',{badarg,_}} = + (catch erlang:md5_update(Ctx0, ["something",bit_sized_binary(<<"abcfjldjd">>)])), + {'EXIT',{badarg,_}} = + (catch erlang:md5_update(bit_sized_binary(Ctx0), "something")), + {'EXIT',{badarg,_}} = (catch erlang:md5_final(bit_sized_binary(Ctx0))), + m(erlang:md5_final(Ctx0), hexstr2bin("d41d8cd98f00b204e9800998ecf8427e")), ok. %% %% unaligned_context(Config) when is_list(Config) -> - ?line Ctx0 = erlang:md5_init(), - ?line Ctx1 = erlang:md5_update(unaligned_sub_bin(Ctx0), "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), - ?line Ctx = erlang:md5_update(unaligned_sub_bin(Ctx1), - "abcdefghijklmnopqrstuvwxyz0123456789"), - ?line m(erlang:md5_final(unaligned_sub_bin(Ctx)), - hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")), + Ctx0 = erlang:md5_init(), + Ctx1 = erlang:md5_update(unaligned_sub_bin(Ctx0), "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), + Ctx = erlang:md5_update(unaligned_sub_bin(Ctx1), + "abcdefghijklmnopqrstuvwxyz0123456789"), + m(erlang:md5_final(unaligned_sub_bin(Ctx)), + hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")), ok. %% @@ -347,5 +314,3 @@ bit_sized_binary(Bin0) -> Bin. id(I) -> I. - - diff --git a/erts/emulator/test/crypto_reference.erl b/erts/emulator/test/crypto_reference.erl index 7797eacd75..950b0c1560 100644 --- a/erts/emulator/test/crypto_reference.erl +++ b/erts/emulator/test/crypto_reference.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/ddll_SUITE.erl b/erts/emulator/test/ddll_SUITE.erl index cabd6472d4..93b6f2d956 100644 --- a/erts/emulator/test/ddll_SUITE.erl +++ b/erts/emulator/test/ddll_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -31,30 +31,31 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, ddll_test/1, errors/1, - reference_count/1, - kill_port/1, dont_kill_port/1]). +-export([all/0, suite/0, + ddll_test/1, errors/1, reference_count/1, + kill_port/1, dont_kill_port/1]). -export([unload_on_process_exit/1, delayed_unload_with_ports/1, - unload_due_to_process_exit/1, - no_unload_due_to_process_exit/1, no_unload_due_to_process_exit_2/1, - unload_reload_thingie/1, unload_reload_thingie_2/1, - unload_reload_thingie_3/1, reload_pending/1, reload_pending_kill/1, - load_fail_init/1, - reload_pending_fail_init/1, - more_error_codes/1, forced_port_killing/1, - no_trap_exit_and_kill_ports/1, - monitor_demonitor/1, monitor_demonitor_load/1, new_interface/1, - lock_driver/1]). + unload_due_to_process_exit/1, + no_unload_due_to_process_exit/1, no_unload_due_to_process_exit_2/1, + unload_reload_thingie/1, unload_reload_thingie_2/1, + unload_reload_thingie_3/1, reload_pending/1, reload_pending_kill/1, + load_fail_init/1, + reload_pending_fail_init/1, + more_error_codes/1, forced_port_killing/1, + no_trap_exit_and_kill_ports/1, + monitor_demonitor/1, monitor_demonitor_load/1, new_interface/1, + lock_driver/1]). % Private exports -export([echo_loader/2, nice_echo_loader/2 ,properties/1, load_and_unload/1]). -import(ordsets, [subtract/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 10}}]. all() -> [ddll_test, errors, reference_count, kill_port, @@ -70,1057 +71,931 @@ all() -> no_trap_exit_and_kill_ports, monitor_demonitor, monitor_demonitor_load, new_interface, lock_driver]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -unload_on_process_exit(suite) -> - []; -unload_on_process_exit(doc) -> - ["Check that the driver is unloaded on process exit"]; +%% Check that the driver is unloaded on process exit unload_on_process_exit(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), + Path = proplists:get_value(data_dir, Config), + false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), Parent = self(), - ?line Pid = spawn(fun() -> - receive go -> ok end, - erl_ddll:try_load(Path, echo_drv, []), - Parent ! gone, - receive go -> ok end, - erl_ddll:loaded_drivers(), - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), - ?line false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), + Pid = spawn(fun() -> + receive go -> ok end, + erl_ddll:try_load(Path, echo_drv, []), + Parent ! gone, + receive go -> ok end, + erl_ddll:loaded_drivers(), + exit(banan) + end), + Ref = erlang:monitor(process,Pid), + false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), Pid ! go, - ?line receive - gone -> ok + receive + gone -> ok end, - ?line true = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), + true = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), Pid ! go, - ?line receive - {'DOWN', Ref, process, Pid, banan} -> - ok + receive + {'DOWN', Ref, process, Pid, banan} -> + ok end, receive after 500 -> ok end, - ?line false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), - ?line test_server:timetrap_cancel(Dog), + false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), ok. -delayed_unload_with_ports(suite) -> - []; -delayed_unload_with_ports(doc) -> - ["Check that the driver is unloaded when the last port is closed"]; +%% Check that the driver is unloaded when the last port is closed delayed_unload_with_ports(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:try_load(Path, echo_drv, []), - ?line erl_ddll:try_load(Path, echo_drv, []), - ?line Port = open_port({spawn, echo_drv}, [eof]), - ?line 1 = erl_ddll:info(echo_drv, port_count), - ?line Port2 = open_port({spawn, echo_drv}, [eof]), - ?line 2 = erl_ddll:info(echo_drv, port_count), - ?line {ok,pending_process} = erl_ddll:try_unload(echo_drv,[{monitor, pending_driver}]), - ?line {ok,pending_driver,Ref} = erl_ddll:try_unload(echo_drv,[{monitor, pending_driver}]), - ?line ok = receive _ -> false after 0 -> ok end, - ?line Port ! {self(), close}, - ?line ok = receive {Port,closed} -> ok after 1000 -> false end, - ?line 1 = erl_ddll:info(echo_drv, port_count), - ?line Port2 ! {self(), close}, - ?line ok = receive {Port2,closed} -> ok after 1000 -> false end, - ?line ok = receive {'DOWN', Ref, driver, echo_drv, unloaded} -> ok after 1000 -> false end, - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + erl_ddll:try_load(Path, echo_drv, []), + erl_ddll:try_load(Path, echo_drv, []), + Port = open_port({spawn, echo_drv}, [eof]), + 1 = erl_ddll:info(echo_drv, port_count), + Port2 = open_port({spawn, echo_drv}, [eof]), + 2 = erl_ddll:info(echo_drv, port_count), + {ok,pending_process} = erl_ddll:try_unload(echo_drv,[{monitor, pending_driver}]), + {ok,pending_driver,Ref} = erl_ddll:try_unload(echo_drv,[{monitor, pending_driver}]), + ok = receive _ -> false after 0 -> ok end, + Port ! {self(), close}, + ok = receive {Port,closed} -> ok after 1000 -> false end, + 1 = erl_ddll:info(echo_drv, port_count), + Port2 ! {self(), close}, + ok = receive {Port2,closed} -> ok after 1000 -> false end, + ok = receive {'DOWN', Ref, driver, echo_drv, unloaded} -> ok after 1000 -> false end, ok. -unload_due_to_process_exit(suite) -> - []; -unload_due_to_process_exit(doc) -> - ["Check that the driver with ports is unloaded on process exit"]; +%% Check that the driver with ports is unloaded on process exit unload_due_to_process_exit(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - spawn(F3), - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - _Port2 = open_port({spawn, echo_drv}, [eof]), - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, - ?line test_server:timetrap_cancel(Dog), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, ok. -no_unload_due_to_process_exit(suite) -> - []; -no_unload_due_to_process_exit(doc) -> - ["Check that a driver with driver loaded in another process is not unloaded on process exit"]; +%% Check that a driver with driver loaded in another process is not unloaded on process exit no_unload_due_to_process_exit(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - spawn(F3), - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - _Port2 = open_port({spawn, echo_drv}, [eof]), - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []), Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive X -> {error, X} after 300 -> ok end, - ?line ok = unload_expect_fast(echo_drv,[]), - ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, - ?line test_server:timetrap_cancel(Dog), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive X -> {error, X} after 300 -> ok end, + ok = unload_expect_fast(echo_drv,[]), + ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, ok. -no_unload_due_to_process_exit_2(suite) -> - []; -no_unload_due_to_process_exit_2(doc) -> - ["Check that a driver with open ports in another process is not unloaded on process exit"]; +%% Check that a driver with open ports in another process is not unloaded on process exit no_unload_due_to_process_exit_2(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - spawn(F3), - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - _Port2 = open_port({spawn, echo_drv}, [eof]), - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line Port = open_port({spawn, echo_drv}, [eof]), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + Port = open_port({spawn, echo_drv}, [eof]), Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive X -> {error, X} after 300 -> ok end, - ?line erlang:port_close(Port), - ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, - ?line test_server:timetrap_cancel(Dog), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive X -> {error, X} after 300 -> ok end, + erlang:port_close(Port), + ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, ok. -unload_reload_thingie(suite) -> - []; -unload_reload_thingie(doc) -> - ["Check delayed unload and reload"]; +%% Check delayed unload and reload unload_reload_thingie(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded_only}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - spawn(F3), - receive go -> ok end, - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded_only}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + spawn(F3), + receive go -> ok end, + exit(banan) + end), + Ref = erlang:monitor(process,Pid), + Pid ! go, + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {ok,pending_driver,Ref3} = erl_ddll:try_unload(echo_drv,[{monitor,pending}]), + Ref4 = erl_ddll:monitor(driver,{echo_drv,loaded}), + ok = receive {'DOWN',Ref4, driver,echo_drv,load_cancelled} -> ok after 1000 -> false end, + {ok,already_loaded} = erl_ddll:try_load(Path, echo_drv, []), + ok = receive {'UP',Ref3, driver,echo_drv,unload_cancelled} -> ok after 1000 -> false end, Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {ok,pending_driver,Ref3} = erl_ddll:try_unload(echo_drv,[{monitor,pending}]), - ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,loaded}), - ?line ok = receive {'DOWN',Ref4, driver,echo_drv,load_cancelled} -> ok after 1000 -> false end, - ?line {ok,already_loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line ok = receive {'UP',Ref3, driver,echo_drv,unload_cancelled} -> ok after 1000 -> false end, - ?line Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line [{Parent,1}] = erl_ddll:info(echo_drv, processes), - ?line 0 = erl_ddll:info(echo_drv, port_count), - ?line ok = unload_expect_fast(echo_drv,[{monitor,pending}]), - ?line ok = receive - {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok - after 300 -> error - end, - ?line ok = receive X -> {error, X} after 300 -> ok end, - ?line test_server:timetrap_cancel(Dog), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + [{Parent,1}] = erl_ddll:info(echo_drv, processes), + 0 = erl_ddll:info(echo_drv, port_count), + ok = unload_expect_fast(echo_drv,[{monitor,pending}]), + ok = receive + {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok + after 300 -> error + end, + ok = receive X -> {error, X} after 300 -> ok end, ok. -unload_reload_thingie_2(suite) -> - []; -unload_reload_thingie_2(doc) -> - ["Check delayed unload and reload"]; +%% Check delayed unload and reload unload_reload_thingie_2(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded_only}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - spawn(F3), - receive go -> ok end, - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded_only}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + spawn(F3), + receive go -> ok end, + exit(banan) + end), + Ref = erlang:monitor(process,Pid), + Pid ! go, + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {ok,pending_driver,Ref3} = erl_ddll:try_load(Path, echo_drv, + [{monitor,pending_driver},{reload,pending_driver}]), + Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {ok,pending_driver,Ref3} = erl_ddll:try_load(Path,echo_drv,[{monitor,pending_driver},{reload,pending_driver}]), - ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}), - ?line Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive {'DOWN',Ref4, driver,echo_drv,unloaded} -> ok after 1000 -> false end, - ?line ok = receive {'UP',Ref3, driver,echo_drv,loaded} -> ok after 1000 -> false end, - ?line [{Parent,1}] = erl_ddll:info(echo_drv, processes), - ?line 0 = erl_ddll:info(echo_drv, port_count), - ?line ok = receive - {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok - after 300 -> error - end, - ?line ok = unload_expect_fast(echo_drv,[{monitor,pending}]), - ?line ok = receive X -> {error, X} after 300 -> ok end, - ?line test_server:timetrap_cancel(Dog), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive {'DOWN',Ref4, driver,echo_drv,unloaded} -> ok after 1000 -> false end, + ok = receive {'UP',Ref3, driver,echo_drv,loaded} -> ok after 1000 -> false end, + [{Parent,1}] = erl_ddll:info(echo_drv, processes), + 0 = erl_ddll:info(echo_drv, port_count), + ok = receive + {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok + after 300 -> error + end, + ok = unload_expect_fast(echo_drv,[{monitor,pending}]), + ok = receive X -> {error, X} after 300 -> ok end, ok. -unload_reload_thingie_3(suite) -> - []; -unload_reload_thingie_3(doc) -> - ["Check delayed unload and reload failure"]; +%% Check delayed unload and reload failure unload_reload_thingie_3(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - spawn(F3), - receive go -> ok end, - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + spawn(F3), + receive go -> ok end, + exit(banan) + end), + Ref = erlang:monitor(process,Pid), + Pid ! go, + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {ok,pending_driver,Ref3} = erl_ddll:try_load(filename:join([Path,"skrumpf"]), echo_drv, + [{monitor,pending_driver},{reload,pending_driver}]), + Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {ok,pending_driver,Ref3} = erl_ddll:try_load(filename:join([Path,"skrumpf"]),echo_drv,[{monitor,pending_driver},{reload,pending_driver}]), - ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}), - ?line Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive - {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok - after 300 -> error - end, - ?line ok = receive {'DOWN',Ref4,driver,echo_drv,unloaded} -> ok after 300 -> false end, - ?line ok = receive - {'DOWN',Ref3, driver,echo_drv,{load_failure,_}} -> ok - after 1000 -> false - end, - ?line {'EXIT',_} = (catch erl_ddll:info(echo_drv, port_count)), - ?line {error, not_loaded} = erl_ddll:try_unload(echo_drv,[{monitor,pending}]), - ?line ok = receive X -> {error, X} after 300 -> ok end, - ?line test_server:timetrap_cancel(Dog), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive + {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok + after 300 -> error + end, + ok = receive {'DOWN',Ref4,driver,echo_drv,unloaded} -> ok after 300 -> false end, + ok = receive + {'DOWN',Ref3, driver,echo_drv,{load_failure,_}} -> ok + after 1000 -> false + end, + {'EXIT',_} = (catch erl_ddll:info(echo_drv, port_count)), + {error, not_loaded} = erl_ddll:try_unload(echo_drv,[{monitor,pending}]), + ok = receive X -> {error, X} after 300 -> ok end, ok. -reload_pending(suite) -> []; -reload_pending(doc) -> ["Reload a driver that is pending on a user"]; +%% Reload a driver that is pending on a user reload_pending(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - spawn(F3), - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - _Port2 = open_port({spawn, echo_drv}, [eof]), - Parent ! opened, - receive go -> ok end, - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + Parent ! opened, + receive go -> ok end, + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line Port = open_port({spawn, echo_drv}, [eof]), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []), + Port = open_port({spawn, echo_drv}, [eof]), Pid ! go, - ?line receive opened -> ok end, - ?line {error, pending_process} = - erl_ddll:try_load(Path, echo_drv, - [{reload,pending_driver}, - {monitor,pending_driver}]), - ?line {ok, pending_process, Ref3} = - erl_ddll:try_load(Path, echo_drv, - [{reload,pending}, - {monitor,pending}]), - ?line ok = receive X -> {error, X} after 300 -> ok end, + receive opened -> ok end, + {error, pending_process} = + erl_ddll:try_load(Path, echo_drv, + [{reload,pending_driver}, + {monitor,pending_driver}]), + {ok, pending_process, Ref3} = + erl_ddll:try_load(Path, echo_drv, + [{reload,pending}, + {monitor,pending}]), + ok = receive X -> {error, X} after 300 -> ok end, Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive Y -> {error, Y} after 300 -> ok end, - ?line erlang:port_close(Port), - ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, - ?line ok = receive {'UP', Ref3, driver, echo_drv, loaded} -> ok after 300 -> error end, + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive Y -> {error, Y} after 300 -> ok end, + erlang:port_close(Port), + ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, + ok = receive {'UP', Ref3, driver, echo_drv, loaded} -> ok after 300 -> error end, [{Parent,1}] = erl_ddll:info(echo_drv,processes), - ?line ok = receive Z -> {error, Z} after 300 -> ok end, - ?line test_server:timetrap_cancel(Dog), + ok = receive Z -> {error, Z} after 300 -> ok end, ok. -load_fail_init(suite) -> []; -load_fail_init(doc) -> ["Tests failure in the init in driver struct."]; +%% Tests failure in the init in driver struct. load_fail_init(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line PathFailing = ?config(priv_dir, Config), - ?line [_|_] = AllFailInits = filelib:wildcard("echo_drv_fail_init.*",Path), - ?line lists:foreach(fun(Name) -> - Src = filename:join([Path,Name]), - Ext = filename:extension(Name), - Dst =filename:join([PathFailing,"echo_drv"++Ext]), - file:delete(Dst), - {ok,_} = file:copy(Src,Dst) - end, - AllFailInits), - ?line [_|_] = filelib:wildcard("echo_drv.*",PathFailing), - ?line {error, driver_init_failed} = erl_ddll:try_load(PathFailing, - echo_drv, - [{monitor,pending}]), - ?line ok = receive XX -> - {unexpected,XX} - after 300 -> - ok - end, - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + PathFailing = proplists:get_value(priv_dir, Config), + [_|_] = AllFailInits = filelib:wildcard("echo_drv_fail_init.*",Path), + lists:foreach(fun(Name) -> + Src = filename:join([Path,Name]), + Ext = filename:extension(Name), + Dst =filename:join([PathFailing,"echo_drv"++Ext]), + file:delete(Dst), + {ok,_} = file:copy(Src,Dst) + end, + AllFailInits), + [_|_] = filelib:wildcard("echo_drv.*",PathFailing), + {error, driver_init_failed} = erl_ddll:try_load(PathFailing, + echo_drv, + [{monitor,pending}]), + ok = receive XX -> + {unexpected,XX} + after 300 -> + ok + end, ok. -reload_pending_fail_init(suite) -> []; -reload_pending_fail_init(doc) -> ["Reload a driver that is pending but init fails"]; +%% Reload a driver that is pending but init fails reload_pending_fail_init(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line PathFailing = ?config(priv_dir, Config), - ?line [_|_] = AllFailInits = filelib:wildcard("echo_drv_fail_init.*",Path), - ?line lists:foreach(fun(Name) -> - Src = filename:join([Path,Name]), - Ext = filename:extension(Name), - Dst =filename:join([PathFailing,"echo_drv"++Ext]), - file:delete(Dst), - {ok,_} = file:copy(Src,Dst) - end, - AllFailInits), - ?line [_|_] = filelib:wildcard("echo_drv.*",PathFailing), - ?line Parent = self(), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - receive go -> ok end, - {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - spawn(F3), - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - _Port2 = open_port({spawn, echo_drv}, [eof]), - Parent ! opened, - receive go -> ok end, - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + PathFailing = proplists:get_value(priv_dir, Config), + [_|_] = AllFailInits = filelib:wildcard("echo_drv_fail_init.*",Path), + lists:foreach(fun(Name) -> + Src = filename:join([Path,Name]), + Ext = filename:extension(Name), + Dst =filename:join([PathFailing,"echo_drv"++Ext]), + file:delete(Dst), + {ok,_} = file:copy(Src,Dst) + end, + AllFailInits), + [_|_] = filelib:wildcard("echo_drv.*",PathFailing), + Parent = self(), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + Parent ! opened, + receive go -> ok end, + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line Port = open_port({spawn, echo_drv}, [eof]), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []), + Port = open_port({spawn, echo_drv}, [eof]), Pid ! go, - ?line receive opened -> ok end, - ?line {ok, pending_process, Ref3} = - erl_ddll:try_load(PathFailing, echo_drv, - [{reload,pending}, - {monitor,pending}]), - ?line ok = receive X -> {error, X} after 300 -> ok end, + receive opened -> ok end, + {ok, pending_process, Ref3} = + erl_ddll:try_load(PathFailing, echo_drv, + [{reload,pending}, + {monitor,pending}]), + ok = receive X -> {error, X} after 300 -> ok end, Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive Y -> {error, Y} after 300 -> ok end, - ?line erlang:port_close(Port), - ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, - ?line ok = receive {'DOWN', Ref3, driver, echo_drv, {load_failure,driver_init_failed}} -> ok after 300 -> error end, - ?line {'EXIT',{badarg,_}} = (catch erl_ddll:info(echo_drv,processes)), - - ?line ok = receive Z -> {error, Z} after 300 -> ok end, - ?line test_server:timetrap_cancel(Dog), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive Y -> {error, Y} after 300 -> ok end, + erlang:port_close(Port), + ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, + ok = receive {'DOWN', Ref3, driver, echo_drv, {load_failure,driver_init_failed}} -> ok after 300 -> error end, + {'EXIT',{badarg,_}} = (catch erl_ddll:info(echo_drv,processes)), + + ok = receive Z -> {error, Z} after 300 -> ok end, ok. -reload_pending_kill(suite) -> []; -reload_pending_kill(doc) -> ["Reload a driver with kill_ports option " - "that is pending on a user"]; +%% Reload a driver with kill_ports option that is pending on a user reload_pending_kill(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line OldFlag = process_flag(trap_exit,true), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - process_flag(trap_exit,true), - receive go -> ok end, - {ok, loaded} = erl_ddll:try_load(Path, echo_drv, [{driver_options,[kill_ports]}]), - spawn(F3), - receive go -> ok end, - Port = open_port({spawn, echo_drv}, [eof]), - Port2 = open_port({spawn, echo_drv}, [eof]), - Parent ! opened, - receive go -> ok end, - receive - {'EXIT', Port2, driver_unloaded} -> - Parent ! first_exit - end, - receive - {'EXIT', Port, driver_unloaded} -> - Parent ! second_exit - end, - receive go -> ok end, - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + OldFlag = process_flag(trap_exit,true), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + process_flag(trap_exit,true), + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, [{driver_options,[kill_ports]}]), + spawn(F3), + receive go -> ok end, + Port = open_port({spawn, echo_drv}, [eof]), + Port2 = open_port({spawn, echo_drv}, [eof]), + Parent ! opened, + receive go -> ok end, + receive + {'EXIT', Port2, driver_unloaded} -> + Parent ! first_exit + end, + receive + {'EXIT', Port, driver_unloaded} -> + Parent ! second_exit + end, + receive go -> ok end, + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, [{driver_options,[kill_ports]}]), - ?line {error,inconsistent} = erl_ddll:try_load(Path, echo_drv, []), - ?line Port = open_port({spawn, echo_drv}, [eof]), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, [{driver_options,[kill_ports]}]), + {error,inconsistent} = erl_ddll:try_load(Path, echo_drv, []), + Port = open_port({spawn, echo_drv}, [eof]), Pid ! go, - ?line receive opened -> ok end, - ?line {error, pending_process} = - erl_ddll:try_load(Path, echo_drv, - [{driver_options,[kill_ports]}, - {reload,pending_driver}, - {monitor,pending_driver}]), - ?line {ok, pending_process, Ref3} = - erl_ddll:try_load(Path, echo_drv, - [{driver_options,[kill_ports]}, - {reload,pending}, - {monitor,pending}]), - ?line ok = receive - {'EXIT', Port, driver_unloaded} -> - ok - after 300 -> error - end, + receive opened -> ok end, + {error, pending_process} = + erl_ddll:try_load(Path, echo_drv, + [{driver_options,[kill_ports]}, + {reload,pending_driver}, + {monitor,pending_driver}]), + {ok, pending_process, Ref3} = + erl_ddll:try_load(Path, echo_drv, + [{driver_options,[kill_ports]}, + {reload,pending}, + {monitor,pending}]), + ok = receive + {'EXIT', Port, driver_unloaded} -> + ok + after 300 -> error + end, Pid ! go, - ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, - ?line ok = receive {'UP', Ref3, driver, echo_drv, loaded} -> ok after 300 -> error end, - ?line [_,_] = erl_ddll:info(echo_drv,processes), - ?line ok = receive first_exit -> ok after 300 -> error end, - ?line ok = receive second_exit -> ok after 300 -> error end, - ?line 0 = erl_ddll:info(echo_drv,port_count), - ?line ok = receive X -> {error, X} after 300 -> ok end, + ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, + ok = receive {'UP', Ref3, driver, echo_drv, loaded} -> ok after 300 -> error end, + [_,_] = erl_ddll:info(echo_drv,processes), + ok = receive first_exit -> ok after 300 -> error end, + ok = receive second_exit -> ok after 300 -> error end, + 0 = erl_ddll:info(echo_drv,port_count), + ok = receive X -> {error, X} after 300 -> ok end, Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive Y -> {error, Y} after 300 -> ok end, - ?line Port2 = open_port({spawn, echo_drv}, [eof]), - ?line true = is_port(Port2), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive Y -> {error, Y} after 300 -> ok end, + Port2 = open_port({spawn, echo_drv}, [eof]), + true = is_port(Port2), [{Parent,1}] = erl_ddll:info(echo_drv,processes), - ?line 1 = erl_ddll:info(echo_drv,port_count), - ?line erlang:port_close(Port2), - ?line ok = receive {'EXIT', Port2, normal} -> ok after 300 -> error end, - ?line 0 = erl_ddll:info(echo_drv,port_count), - ?line [{Parent,1}] = erl_ddll:info(echo_drv,processes), - ?line Port3 = open_port({spawn, echo_drv}, [eof]), - ?line {ok, pending_driver, Ref4} = - erl_ddll:try_unload(echo_drv,[{monitor,pending_driver}]), - ?line ok = receive - {'EXIT', Port3, driver_unloaded} -> - ok - after 300 -> error - end, - ?line ok = receive {'DOWN', Ref4, driver, echo_drv, unloaded} -> ok after 300 -> error end, + 1 = erl_ddll:info(echo_drv,port_count), + erlang:port_close(Port2), + ok = receive {'EXIT', Port2, normal} -> ok after 300 -> error end, + 0 = erl_ddll:info(echo_drv,port_count), + [{Parent,1}] = erl_ddll:info(echo_drv,processes), + Port3 = open_port({spawn, echo_drv}, [eof]), + {ok, pending_driver, Ref4} = + erl_ddll:try_unload(echo_drv,[{monitor,pending_driver}]), + ok = receive + {'EXIT', Port3, driver_unloaded} -> + ok + after 300 -> error + end, + ok = receive {'DOWN', Ref4, driver, echo_drv, unloaded} -> ok after 300 -> error end, io:format("Port = ~w, Port2 = ~w, Port3 = ~w~n",[Port,Port2,Port3]), - ?line ok = receive Z -> {error, Z} after 300 -> ok end, - ?line process_flag(trap_exit,OldFlag), - ?line test_server:timetrap_cancel(Dog), + ok = receive Z -> {error, Z} after 300 -> ok end, + process_flag(trap_exit,OldFlag), ok. -more_error_codes(suite) -> - []; -more_error_codes(doc) -> - ["Some more error code checking"]; +%% Some more error code checking more_error_codes(Config) when is_list(Config) -> - ?line {error,Err} = erl_ddll:try_load("./echo_dr",echo_dr,[]), - ?line true = is_list(erl_ddll:format_error(Err)), - ?line true = is_list(erl_ddll:format_error(not_loaded)), + {error,Err} = erl_ddll:try_load("./echo_dr",echo_dr,[]), + true = is_list(erl_ddll:format_error(Err)), + true = is_list(erl_ddll:format_error(not_loaded)), ok. -forced_port_killing(suite) -> - []; -forced_port_killing(doc) -> - ["Check kill_ports option to try_unload "]; +%% Check kill_ports option to try_unload forced_port_killing(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line OldFlag=process_flag(trap_exit,true), - ?line Parent = self(), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line spawn(F3), - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line Port = open_port({spawn, echo_drv}, [eof]), - ?line Port2 = open_port({spawn, echo_drv}, [eof]), - ?line {ok, pending_driver, Ref1} = - erl_ddll:try_unload(echo_drv,[{monitor,pending_driver},kill_ports]), - ?line ok = receive - {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok - after 300 -> error - end, - ?line ok = receive {'EXIT',Port,driver_unloaded} -> ok after 300 -> false end, - ?line ok = receive {'EXIT',Port2,driver_unloaded} -> ok after 300 -> false end, - ?line ok = receive {'DOWN',Ref1, driver, echo_drv, unloaded} -> ok after 300 -> false end, - ?line process_flag(trap_exit,OldFlag), - ?line ok = receive X -> {error, X} after 300 -> ok end, - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + OldFlag=process_flag(trap_exit,true), + Parent = self(), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + Port = open_port({spawn, echo_drv}, [eof]), + Port2 = open_port({spawn, echo_drv}, [eof]), + {ok, pending_driver, Ref1} = + erl_ddll:try_unload(echo_drv,[{monitor,pending_driver},kill_ports]), + ok = receive + {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok + after 300 -> error + end, + ok = receive {'EXIT',Port,driver_unloaded} -> ok after 300 -> false end, + ok = receive {'EXIT',Port2,driver_unloaded} -> ok after 300 -> false end, + ok = receive {'DOWN',Ref1, driver, echo_drv, unloaded} -> ok after 300 -> false end, + process_flag(trap_exit,OldFlag), + ok = receive X -> {error, X} after 300 -> ok end, ok. -no_trap_exit_and_kill_ports(suite) -> - []; -no_trap_exit_and_kill_ports(doc) -> - ["Check delayed unload and reload with no trap_exit"]; +%% Check delayed unload and reload with no trap_exit no_trap_exit_and_kill_ports(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line Parent = self(), - ?line OldFlag=process_flag(trap_exit,true), - ?line F3 = fun() -> - Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), - receive X -> Parent ! {got,X} end - end, - ?line Pid = spawn(fun() -> - process_flag(trap_exit,false), - receive go -> ok end, - {ok, loaded} = erl_ddll:try_load(Path, echo_drv, - [{driver_options,[kill_ports]}]), - spawn(F3), - receive go -> ok end, - _Port = open_port({spawn, echo_drv}, [eof]), - _Port2 = open_port({spawn, echo_drv}, [eof]), - exit(banan) - end), - ?line Ref = erlang:monitor(process,Pid), + Path = proplists:get_value(data_dir, Config), + Parent = self(), + OldFlag=process_flag(trap_exit,true), + F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + Pid = spawn(fun() -> + process_flag(trap_exit,false), + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, + [{driver_options,[kill_ports]}]), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + exit(banan) + end), + Ref = erlang:monitor(process,Pid), Pid ! go, - ?line {ok,Ref2} = receive - R when is_reference(R) -> {ok,R}; - Other -> {error, Other} - after 500 -> {error, timeout} - end, - ?line {error, inconsistent} = erl_ddll:try_load(Path, echo_drv, []), - ?line MyPort = open_port({spawn, echo_drv}, [eof]), + {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + {error, inconsistent} = erl_ddll:try_load(Path, echo_drv, []), + MyPort = open_port({spawn, echo_drv}, [eof]), Pid ! go, - ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, - ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, - ?line ok = receive {'EXIT',MyPort,driver_unloaded} -> ok after 300 -> error end, - ?line process_flag(trap_exit,OldFlag), - ?line test_server:timetrap_cancel(Dog), + ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, + ok = receive {'EXIT',MyPort,driver_unloaded} -> ok after 300 -> error end, + process_flag(trap_exit,OldFlag), ok. -monitor_demonitor(suite) -> - []; -monitor_demonitor(doc) -> - ["Check monitor and demonitor of drivers"]; +%% Check monitor and demonitor of drivers monitor_demonitor(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:try_load(Path, echo_drv, []), - ?line Ref = erl_ddll:monitor(driver,{echo_drv,unloaded}), - ?line Self = self(), - ?line [{Self,1}] = erl_ddll:info(echo_drv,awaiting_unload), - ?line true = erl_ddll:demonitor(Ref), - ?line [] = erl_ddll:info(echo_drv,awaiting_unload), - ?line erl_ddll:try_unload(echo_drv,[]), - ?line ok = receive _ -> error after 300 -> ok end, - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + erl_ddll:try_load(Path, echo_drv, []), + Ref = erl_ddll:monitor(driver,{echo_drv,unloaded}), + Self = self(), + [{Self,1}] = erl_ddll:info(echo_drv,awaiting_unload), + true = erl_ddll:demonitor(Ref), + [] = erl_ddll:info(echo_drv,awaiting_unload), + erl_ddll:try_unload(echo_drv,[]), + ok = receive _ -> error after 300 -> ok end, ok. -monitor_demonitor_load(suite) -> - []; -monitor_demonitor_load(doc) -> - ["Check monitor/demonitor of driver loading"]; +%% Check monitor/demonitor of driver loading monitor_demonitor_load(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line {ok,loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line Port = open_port({spawn, echo_drv}, [eof]), - ?line Ref = erl_ddll:monitor(driver,{echo_drv,loaded}), - ?line ok = receive {'UP',Ref,driver,echo_drv,loaded} -> ok after 500 -> error end, - ?line {ok, pending_driver} = erl_ddll:try_unload(echo_drv,[]), - ?line Ref2 = erl_ddll:monitor(driver,{echo_drv,loaded}), - ?line ok = receive {'DOWN',Ref2,driver,echo_drv,load_cancelled} -> ok after 0 -> error end, - ?line {ok,already_loaded} = erl_ddll:try_load(Path, echo_drv, []), - ?line {ok, pending_driver} = - erl_ddll:try_load(Path, echo_drv, [{reload,pending_driver}]), - ?line Ref3 = erl_ddll:monitor(driver,{echo_drv,loaded}), - ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}), - ?line ok = receive _ -> error after 300 -> ok end, - ?line Self = self(), - ?line [{Self,1}] = erl_ddll:info(echo_drv,awaiting_load), - ?line true = erl_ddll:demonitor(Ref3), - ?line [] = erl_ddll:info(echo_drv,awaiting_load), - ?line erlang:port_close(Port), - ?line ok = receive {'DOWN',Ref4,driver,echo_drv,unloaded} -> ok after 300 -> error end, - ?line ok = receive _ -> error after 300 -> ok end, - ?line ok = unload_expect_fast(echo_drv,[]), - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + {ok,loaded} = erl_ddll:try_load(Path, echo_drv, []), + Port = open_port({spawn, echo_drv}, [eof]), + Ref = erl_ddll:monitor(driver,{echo_drv,loaded}), + ok = receive {'UP',Ref,driver,echo_drv,loaded} -> ok after 500 -> error end, + {ok, pending_driver} = erl_ddll:try_unload(echo_drv,[]), + Ref2 = erl_ddll:monitor(driver,{echo_drv,loaded}), + ok = receive {'DOWN',Ref2,driver,echo_drv,load_cancelled} -> ok after 0 -> error end, + {ok,already_loaded} = erl_ddll:try_load(Path, echo_drv, []), + {ok, pending_driver} = + erl_ddll:try_load(Path, echo_drv, [{reload,pending_driver}]), + Ref3 = erl_ddll:monitor(driver,{echo_drv,loaded}), + Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}), + ok = receive _ -> error after 300 -> ok end, + Self = self(), + [{Self,1}] = erl_ddll:info(echo_drv,awaiting_load), + true = erl_ddll:demonitor(Ref3), + [] = erl_ddll:info(echo_drv,awaiting_load), + erlang:port_close(Port), + ok = receive {'DOWN',Ref4,driver,echo_drv,unloaded} -> ok after 300 -> error end, + ok = receive _ -> error after 300 -> ok end, + ok = unload_expect_fast(echo_drv,[]), ok. -new_interface(suite) -> - []; -new_interface(doc) -> - ["Test the new load/unload/reload interface"]; +%% Test the new load/unload/reload interface new_interface(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), % Typical scenario - ?line ok = erl_ddll:load(Path, echo_drv), - ?line Port = open_port({spawn, echo_drv}, [eof]), - ?line ok = erl_ddll:unload(echo_drv), - ?line Port ! {self(), {command, "text"}}, - ?line ok = receive - {Port, {data, "text"}} -> ok; - _ -> error - after - 1000 -> error - end, - ?line Ref = erl_ddll:monitor(driver,{echo_drv,unloaded}), - ?line ok = receive X -> {error, X} after 300 -> ok end, - ?line erlang:port_close(Port), - ?line ok = receive {'DOWN', Ref, driver, echo_drv, unloaded} -> ok after 300 -> error end, + ok = erl_ddll:load(Path, echo_drv), + Port = open_port({spawn, echo_drv}, [eof]), + ok = erl_ddll:unload(echo_drv), + Port ! {self(), {command, "text"}}, + ok = receive + {Port, {data, "text"}} -> ok; + _ -> error + after + 1000 -> error + end, + Ref = erl_ddll:monitor(driver,{echo_drv,unloaded}), + ok = receive X -> {error, X} after 300 -> ok end, + erlang:port_close(Port), + ok = receive {'DOWN', Ref, driver, echo_drv, unloaded} -> ok after 300 -> error end, % More than one user - ?line ok = erl_ddll:load(Path, echo_drv), - ?line Ref2 = erl_ddll:monitor(driver,{echo_drv,unloaded}), - ?line ok = erl_ddll:load(Path, echo_drv), - ?line ok = erl_ddll:load(Path, echo_drv), - ?line Port2 = open_port({spawn, echo_drv}, [eof]), - ?line ok = erl_ddll:unload(echo_drv), - ?line Port2 ! {self(), {command, "text"}}, - ?line ok = receive - {Port2, {data, "text"}} -> ok; - _ -> error - after - 1000 -> error - end, - ?line ok = erl_ddll:unload(echo_drv), - ?line Port2 ! {self(), {command, "text"}}, - ?line ok = receive - {Port2, {data, "text"}} -> ok; - _ -> error - after - 1000 -> error - end, - ?line ok = erl_ddll:unload(echo_drv), - ?line Port2 ! {self(), {command, "text"}}, - ?line ok = receive - {Port2, {data, "text"}} -> ok; - _ -> error - after - 1000 -> error - end, - ?line ok = receive X2 -> {error, X2} after 300 -> ok end, - ?line ok = erl_ddll:load(Path, echo_drv), - ?line ok = receive {'UP', Ref2, driver, echo_drv, unload_cancelled} -> ok after 300 -> error end, - ?line Ref3 = erl_ddll:monitor(driver,{echo_drv,unloaded_only}), - ?line erlang:port_close(Port2), - ?line ok = receive X3 -> {error, X3} after 300 -> ok end, - ?line ok = erl_ddll:unload(echo_drv), - ?line ok = receive {'DOWN', Ref3, driver, echo_drv, unloaded} -> ok after 300 -> error end, - ?line test_server:timetrap_cancel(Dog), + ok = erl_ddll:load(Path, echo_drv), + Ref2 = erl_ddll:monitor(driver,{echo_drv,unloaded}), + ok = erl_ddll:load(Path, echo_drv), + ok = erl_ddll:load(Path, echo_drv), + Port2 = open_port({spawn, echo_drv}, [eof]), + ok = erl_ddll:unload(echo_drv), + Port2 ! {self(), {command, "text"}}, + ok = receive + {Port2, {data, "text"}} -> ok; + _ -> error + after + 1000 -> error + end, + ok = erl_ddll:unload(echo_drv), + Port2 ! {self(), {command, "text"}}, + ok = receive + {Port2, {data, "text"}} -> ok; + _ -> error + after + 1000 -> error + end, + ok = erl_ddll:unload(echo_drv), + Port2 ! {self(), {command, "text"}}, + ok = receive + {Port2, {data, "text"}} -> ok; + _ -> error + after + 1000 -> error + end, + ok = receive X2 -> {error, X2} after 300 -> ok end, + ok = erl_ddll:load(Path, echo_drv), + ok = receive {'UP', Ref2, driver, echo_drv, unload_cancelled} -> ok after 300 -> error end, + Ref3 = erl_ddll:monitor(driver,{echo_drv,unloaded_only}), + erlang:port_close(Port2), + ok = receive X3 -> {error, X3} after 300 -> ok end, + ok = erl_ddll:unload(echo_drv), + ok = receive {'DOWN', Ref3, driver, echo_drv, unloaded} -> ok after 300 -> error end, ok. - - + + ddll_test(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), - %?line {error,{already_started,ErlDdllPid}} = erl_ddll:start(), - %?line ErlDdllPid = whereis(ddll_server), + %{error,{already_started,ErlDdllPid}} = erl_ddll:start(), + %ErlDdllPid = whereis(ddll_server), %% Load the echo driver and verify that it was loaded. {ok,L1,L2}=load_echo_driver(Path), %% Verify that the driver works. - ?line Port = open_port({spawn, echo_drv}, [eof]), - ?line {hej, "hopp",4711,123445567436543653} = - erlang:port_call(Port,{hej, "hopp",4711,123445567436543653}), - ?line {hej, "hopp",4711,123445567436543653} = - erlang:port_call(Port,47,{hej, "hopp",4711,123445567436543653}), - ?line Port ! {self(), {command, "text"}}, - ?line 1 = receive - {Port, {data, "text"}} -> 1; - _Other -> 2 - after - 1000 -> 2 - end, - ?line Port ! {self(), close}, - ?line receive {Port, closed} -> ok end, - -%% %% Unload the driver and verify that it was unloaded. - ok = unload_echo_driver(L1,L2), - -%% %?line {error, {already_started, _}} = erl_ddll:start(), - - ?line test_server:timetrap_cancel(Dog), + Port = open_port({spawn, echo_drv}, [eof]), + {hej, "hopp",4711,123445567436543653} = + erlang:port_call(Port,{hej, "hopp",4711,123445567436543653}), + {hej, "hopp",4711,123445567436543653} = + erlang:port_call(Port,47,{hej, "hopp",4711,123445567436543653}), + Port ! {self(), {command, "text"}}, + 1 = receive + {Port, {data, "text"}} -> 1; + _Other -> 2 + after + 1000 -> 2 + end, + Port ! {self(), close}, + receive {Port, closed} -> ok end, + + %% %% Unload the driver and verify that it was unloaded. + ok = unload_echo_driver(L1,L2), + + %% %{error, {already_started, _}} = erl_ddll:start(), ok. %% Tests errors having to do with bad drivers. errors(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), - ?line {ok, L1} = erl_ddll:loaded_drivers(), + {ok, L1} = erl_ddll:loaded_drivers(), - ?line {error, {open_error, _}} = erl_ddll:load_driver(Path, bad_name), - ?line {error, driver_init_failed} = erl_ddll:load_driver(Path, initfail_drv), - ?line {error, bad_driver_name} = erl_ddll:load_driver(Path, wrongname_drv), + {error, {open_error, _}} = erl_ddll:load_driver(Path, bad_name), + {error, driver_init_failed} = erl_ddll:load_driver(Path, initfail_drv), + {error, bad_driver_name} = erl_ddll:load_driver(Path, wrongname_drv), %% We assume that there is a statically linked driver named "ddll": - ?line {error, linked_in_driver} = erl_ddll:unload_driver(efile), - ?line {error, not_loaded} = erl_ddll:unload_driver("__pucko_driver__"), - + {error, linked_in_driver} = erl_ddll:unload_driver(efile), + {error, not_loaded} = erl_ddll:unload_driver("__pucko_driver__"), + case os:type() of - {unix, _} -> - ?line {error, no_driver_init} = - erl_ddll:load_driver(Path, noinit_drv); - _ -> - ok + {unix, _} -> + {error, no_driver_init} = + erl_ddll:load_driver(Path, noinit_drv); + _ -> + ok end, - ?line {ok, L1} = erl_ddll:loaded_drivers(), - - ?line test_server:timetrap_cancel(Dog), + {ok, L1} = erl_ddll:loaded_drivers(), ok. -reference_count(doc) -> - ["Check that drivers are unloaded when their reference count ", - "reaches zero, and that they cannot be unloaded while ", - "they are still referenced."]; +%% Check that drivers are unloaded when their reference count +%% reaches zero, and that they cannot be unloaded while +%% they are still referenced. reference_count(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), %% Spawn a process that loads the driver (and holds a reference %% to it). Pid1=spawn_link(?MODULE, echo_loader, [Path, self()]), receive - {Pid1, echo_loaded} -> ok - after 2000 -> test_server:fail("echo_loader failed to start.") + {Pid1, echo_loaded} -> ok + after 2000 -> ct:fail("echo_loader failed to start.") end, Pid1 ! {self(), die}, - ?line test_server:sleep(200), % Give time to unload. + test_server:sleep(200), % Give time to unload. % Verify that the driver was automaticly unloaded when the % process died. - ?line {error, not_loaded}=erl_ddll:unload_driver(echo_drv), - - ?line test_server:timetrap_cancel(Dog), + {error, not_loaded}=erl_ddll:unload_driver(echo_drv), ok. % Loads the echo driver, send msg to started, sits and waits to % get a signal to die, then unloads the driver and terminates. echo_loader(Path, Starter) -> - ?line {ok, L1, L2}=load_echo_driver(Path), - ?line Starter ! {self(), echo_loaded}, + {ok, L1, L2}=load_echo_driver(Path), + Starter ! {self(), echo_loaded}, receive - {Starter, die} -> - ?line unload_echo_driver(L1,L2) + {Starter, die} -> + unload_echo_driver(L1,L2) end. % Loads the echo driver, send msg to started, sits and waits to % get a signal to die, then unloads the driver and terminates. nice_echo_loader(Path, Starter) -> - ?line {ok, L1, L2}=load_nice_echo_driver(Path), - ?line Starter ! {self(), echo_loaded}, + {ok, L1, L2}=load_nice_echo_driver(Path), + Starter ! {self(), echo_loaded}, receive - {Starter, die} -> - ?line unload_echo_driver(L1,L2) + {Starter, die} -> + unload_echo_driver(L1,L2) end. -kill_port(doc) -> - ["Test that a port that uses a driver is killed when the ", - "process that loaded the driver dies."]; +%% Test that a port that uses a driver is killed when the +%% process that loaded the driver dies. kill_port(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), %% Spawn a process that loads the driver (and holds a reference %% to it). - ?line Pid1=spawn(?MODULE, echo_loader, [Path, self()]), - ?line receive - {Pid1, echo_loaded} -> - ok - after 3000 -> - ?line exit(Pid1, kill), - ?line test_server:fail("echo_loader failed to start.") - end, + Pid1=spawn(?MODULE, echo_loader, [Path, self()]), + receive + {Pid1, echo_loaded} -> + ok + after 3000 -> + exit(Pid1, kill), + ct:fail("echo_loader failed to start.") + end, % Spawn off a port that uses the driver. - ?line Port = open_port({spawn, echo_drv}, [eof]), + Port = open_port({spawn, echo_drv}, [eof]), % Kill the process / unload the driver. - ?line process_flag(trap_exit, true), - ?line exit(Pid1, kill), - ?line test_server:sleep(200), % Give some time to unload. - ?line {error, not_loaded} = erl_ddll:unload_driver(echo_drv), + process_flag(trap_exit, true), + exit(Pid1, kill), + test_server:sleep(200), % Give some time to unload. + {error, not_loaded} = erl_ddll:unload_driver(echo_drv), % See if the port is killed. receive - {'EXIT', Port, Reason} -> - io:format("Port exited with reason ~w", [Reason]) + {'EXIT', Port, Reason} -> + io:format("Port exited with reason ~w", [Reason]) after 5000 -> - ?line test_server:fail("Echo port did not terminate.") + ct:fail("Echo port did not terminate.") end, - - %% Cleanup and exit. - ?line test_server:timetrap_cancel(Dog), ok. -dont_kill_port(doc) -> - ["Test that a port that uses a driver is not killed when the ", - "process that loaded the driver dies and it's nicely opened."]; +%% Test that a port that uses a driver is not killed when the +%% process that loaded the driver dies and it's nicely opened. dont_kill_port(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), %% Spawn a process that loads the driver (and holds a reference %% to it). - ?line Pid1=spawn(?MODULE, nice_echo_loader, [Path, self()]), - ?line receive - {Pid1, echo_loaded} -> - ok - after 3000 -> - ?line exit(Pid1, kill), - ?line test_server:fail("echo_loader failed to start.") - end, + Pid1=spawn(?MODULE, nice_echo_loader, [Path, self()]), + receive + {Pid1, echo_loaded} -> + ok + after 3000 -> + exit(Pid1, kill), + ct:fail("echo_loader failed to start.") + end, % Spawn off a port that uses the driver. - ?line Port = open_port({spawn, echo_drv}, [eof]), + Port = open_port({spawn, echo_drv}, [eof]), % Kill the process / unload the driver. - ?line process_flag(trap_exit, true), - ?line exit(Pid1, kill), - ?line test_server:sleep(200), % Give some time to unload. - ?line {hej, "hopp",4711,123445567436543653} = - erlang:port_call(Port,{hej, "hopp",4711,123445567436543653}), - ?line [] = erl_ddll:info(echo_drv,processes), + process_flag(trap_exit, true), + exit(Pid1, kill), + test_server:sleep(200), % Give some time to unload. + {hej, "hopp",4711,123445567436543653} = + erlang:port_call(Port,{hej, "hopp",4711,123445567436543653}), + [] = erl_ddll:info(echo_drv,processes), %% unload should work with no owner - ?line ok = erl_ddll:unload_driver(echo_drv), %Kill ports while at it + ok = erl_ddll:unload_driver(echo_drv), %Kill ports while at it % See if the port is killed. receive - {'EXIT', Port, Reason} -> - io:format("Port exited with reason ~w", [Reason]) + {'EXIT', Port, Reason} -> + io:format("Port exited with reason ~w", [Reason]) after 5000 -> - ?line test_server:fail("Echo port did not terminate.") + ct:fail("Echo port did not terminate.") end, - - %% Cleanup and exit. - ?line test_server:timetrap_cancel(Dog), ok. -properties(doc) -> ["Test that a process that loaded a driver ", - "is the only process that can unload it."]; +%% Test that a process that loaded a driver +%% is the only process that can unload it. properties(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), % Let another process load the echo driver. Pid=spawn_link(?MODULE, echo_loader, [Path, self()]), receive - {Pid, echo_loaded} -> ok - after 2000 -> test_server:fail("echo_loader failed to start.") + {Pid, echo_loaded} -> ok + after 2000 -> ct:fail("echo_loader failed to start.") end, % Try to unload the driver from this process (the wrong one). - ?line {error, _} = erl_ddll:unload_driver(echo_drv), - ?line {ok, Drivers} = erl_ddll:loaded_drivers(), - ?line case lists:member("echo_drv", Drivers) of - true -> - ok; - false -> - test_server:fail("Unload from wrong process " - "succeeded.") - end, + {error, _} = erl_ddll:unload_driver(echo_drv), + {ok, Drivers} = erl_ddll:loaded_drivers(), + case lists:member("echo_drv", Drivers) of + true -> + ok; + false -> + ct:fail("Unload from wrong process succeeded.") + end, % Unload the driver and terminate dummy process. - ?line Pid ! {self(), die}, - ?line test_server:sleep(200), % Give time to unload. - ?line test_server:timetrap_cancel(Dog), + Pid ! {self(), die}, + test_server:sleep(200), % Give time to unload. ok. -load_and_unload(doc) -> ["Load two drivers and unload them in load order."]; +%% Load two drivers and unload them in load order. load_and_unload(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line Path = ?config(data_dir, Config), - ?line {ok, Loaded_drivers1} = erl_ddll:loaded_drivers(), - ?line ok = erl_ddll:load_driver(Path, echo_drv), - ?line ok = erl_ddll:load_driver(Path, dummy_drv), - ?line ok = erl_ddll:unload_driver(echo_drv), - ?line ok = erl_ddll:unload_driver(dummy_drv), - ?line {ok, Loaded_drivers2} = erl_ddll:loaded_drivers(), - ?line Set1 = ordsets:from_list(Loaded_drivers1), - ?line Set2 = ordsets:from_list(Loaded_drivers2), - ?line io:format("~p == ~p\n", [Loaded_drivers1, Loaded_drivers2]), - ?line [] = ordsets:to_list(ordsets:subtract(Set2, Set1)), - - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + {ok, Loaded_drivers1} = erl_ddll:loaded_drivers(), + ok = erl_ddll:load_driver(Path, echo_drv), + ok = erl_ddll:load_driver(Path, dummy_drv), + ok = erl_ddll:unload_driver(echo_drv), + ok = erl_ddll:unload_driver(dummy_drv), + {ok, Loaded_drivers2} = erl_ddll:loaded_drivers(), + Set1 = ordsets:from_list(Loaded_drivers1), + Set2 = ordsets:from_list(Loaded_drivers2), + io:format("~p == ~p\n", [Loaded_drivers1, Loaded_drivers2]), + [] = ordsets:to_list(ordsets:subtract(Set2, Set1)), ok. -lock_driver(suite) -> - []; -lock_driver(doc) -> - ["Check multiple calls to driver_lock_driver"]; +%% Check multiple calls to driver_lock_driver lock_driver(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line {ok, _} = erl_ddll:try_load(Path, lock_drv, []), - ?line Port1 = open_port({spawn, lock_drv}, [eof]), - ?line Port2 = open_port({spawn, lock_drv}, [eof]), - ?line true = erl_ddll:info(lock_drv,permanent), - ?line erlang:port_close(Port1), - ?line erlang:port_close(Port2), - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + {ok, _} = erl_ddll:try_load(Path, lock_drv, []), + Port1 = open_port({spawn, lock_drv}, [eof]), + Port2 = open_port({spawn, lock_drv}, [eof]), + true = erl_ddll:info(lock_drv,permanent), + erlang:port_close(Port1), + erlang:port_close(Port2), ok. - + % Load and unload the echo_drv driver. % Make sure that the driver doesn't exist before we load it, % and that it exists before we unload it. load_echo_driver(Path) -> - ?line {ok, L1} = erl_ddll:loaded_drivers(), - ?line ok = erl_ddll:load_driver(Path, echo_drv), - ?line {ok, L2} = erl_ddll:loaded_drivers(), - ?line ["echo_drv"] = ordsets:to_list(subtract(ordsets:from_list(L2), - ordsets:from_list(L1))), + {ok, L1} = erl_ddll:loaded_drivers(), + ok = erl_ddll:load_driver(Path, echo_drv), + {ok, L2} = erl_ddll:loaded_drivers(), + ["echo_drv"] = ordsets:to_list(subtract(ordsets:from_list(L2), + ordsets:from_list(L1))), {ok,L1,L2}. load_nice_echo_driver(Path) -> - ?line {ok, L1} = erl_ddll:loaded_drivers(), - ?line ok = erl_ddll:load(Path, echo_drv), - ?line {ok, L2} = erl_ddll:loaded_drivers(), - ?line ["echo_drv"] = ordsets:to_list(subtract(ordsets:from_list(L2), - ordsets:from_list(L1))), + {ok, L1} = erl_ddll:loaded_drivers(), + ok = erl_ddll:load(Path, echo_drv), + {ok, L2} = erl_ddll:loaded_drivers(), + ["echo_drv"] = ordsets:to_list(subtract(ordsets:from_list(L2), + ordsets:from_list(L1))), {ok,L1,L2}. unload_echo_driver(L1,L2) -> - ?line {ok, L2} = erl_ddll:loaded_drivers(), - ?line ok = erl_ddll:unload_driver(echo_drv), - ?line {ok, L3} = erl_ddll:loaded_drivers(), - ?line [] = ordsets:to_list(subtract(ordsets:from_list(L3), - ordsets:from_list(L1))), + {ok, L2} = erl_ddll:loaded_drivers(), + ok = erl_ddll:unload_driver(echo_drv), + {ok, L3} = erl_ddll:loaded_drivers(), + [] = ordsets:to_list(subtract(ordsets:from_list(L3), + ordsets:from_list(L1))), ok. unload_expect_fast(Driver,XFlags) -> {ok, pending_driver, Ref} = - erl_ddll:try_unload(Driver, - [{monitor,pending_driver}]++XFlags), + erl_ddll:try_unload(Driver, + [{monitor,pending_driver}]++XFlags), receive - {'DOWN', Ref, driver, Driver, unloaded} -> - case lists:member(atom_to_list(Driver),element(2,erl_ddll:loaded_drivers())) of - true -> - {error, {still_there, Driver}}; - false -> - ok - end + {'DOWN', Ref, driver, Driver, unloaded} -> + case lists:member(atom_to_list(Driver),element(2,erl_ddll:loaded_drivers())) of + true -> + {error, {still_there, Driver}}; + false -> + ok + end after 1000 -> - {error,{unable_to_unload, Driver}} + {error,{unable_to_unload, Driver}} end. diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl index 6a5ca20ac3..54ee4d5567 100644 --- a/erts/emulator/test/decode_packet_SUITE.erl +++ b/erts/emulator/test/decode_packet_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,15 +22,16 @@ -module(decode_packet_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --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, - basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1, otp_8536/1, +-export([all/0, suite/0,groups/0, + init_per_testcase/2,end_per_testcase/2, + basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1, otp_8536/1, otp_9389/1, otp_9389_line/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [basic, packet_size, neg, http, line, ssl, otp_8536, @@ -39,69 +40,49 @@ all() -> groups() -> []. -init_per_suite(Config) -> +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + rand:seed(exsplus), + io:format("*** SEED: ~p ***\n", [rand:export_seed()]), Config. -end_per_suite(_Config) -> +end_per_testcase(_Func, _Config) -> ok. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - 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)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -basic(doc) -> []; -basic(suite) -> []; basic(Config) when is_list(Config) -> - ?line Packet = <<101,22,203,54,175>>, - ?line Rest = <<123,34,0,250>>, - ?line Bin = <<Packet/binary,Rest/binary>>, - ?line {ok, Bin, <<>>} = decode_pkt(raw,Bin), + Packet = <<101,22,203,54,175>>, + Rest = <<123,34,0,250>>, + Bin = <<Packet/binary,Rest/binary>>, + {ok, Bin, <<>>} = decode_pkt(raw,Bin), - ?line {more, 5+1} = decode_pkt(1,<<5,1,2,3,4>>), - ?line {more, 5+2} = decode_pkt(2,<<0,5,1,2,3,4>>), - ?line {more, 5+4} = decode_pkt(4,<<0,0,0,5,1,2,3,4>>), + {more, 5+1} = decode_pkt(1,<<5,1,2,3,4>>), + {more, 5+2} = decode_pkt(2,<<0,5,1,2,3,4>>), + {more, 5+4} = decode_pkt(4,<<0,0,0,5,1,2,3,4>>), - ?line {more, undefined} = decode_pkt(1,<<>>), - ?line {more, undefined} = decode_pkt(2,<<0>>), - ?line {more, undefined} = decode_pkt(4,<<0,0,0>>), + {more, undefined} = decode_pkt(1,<<>>), + {more, undefined} = decode_pkt(2,<<0>>), + {more, undefined} = decode_pkt(4,<<0,0,0>>), Types = [1,2,4,asn1,sunrm,cdr,fcgi,tpkt,ssl_tls], %% Run tests for different header types and bit offsets. lists:foreach(fun({Type,Bits})->basic_pack(Type,Packet,Rest,Bits), - more_length(Type,Packet,Bits) end, - [{T,B} || T<-Types, B<-lists:seq(0,32)]), + more_length(Type,Packet,Bits) end, + [{T,B} || T<-Types, B<-lists:seq(0,32)]), ok. basic_pack(Type,Body,Rest,BitOffs) -> - ?line {Bin,Unpacked,_} = pack(Type,Body,Rest,BitOffs), - ?line {ok, Unpacked, Rest} = decode_pkt(Type,Bin), + {Bin,Unpacked,_} = pack(Type,Body,Rest,BitOffs), + {ok, Unpacked, Rest} = decode_pkt(Type,Bin), case Rest of - <<>> -> ok; - _ -> - ?line <<_:1,NRest/bits>> = Rest, - basic_pack(Type,Body,NRest,BitOffs) + <<>> -> ok; + _ -> + <<_:1,NRest/bits>> = Rest, + basic_pack(Type,Body,NRest,BitOffs) end. more_length(Type,Body,BitOffs) -> - ?line {Bin,_,_} = pack(Type,Body,<<>>,BitOffs), + {Bin,_,_} = pack(Type,Body,<<>>,BitOffs), HdrSize = byte_size(Bin) - byte_size(Body), more_length_do(Type,HdrSize,Bin,byte_size(Bin)). @@ -110,17 +91,17 @@ more_length_do(_,_,_,0) -> more_length_do(Type,HdrSize,Bin,Size) -> TrySize = (Size*3) div 4, NSize = if TrySize < HdrSize -> Size - 1; - true -> TrySize - end, + true -> TrySize + end, {B1,_} = split_binary(Bin,NSize), - ?line {more, Length} = decode_pkt(Type,B1), + {more, Length} = decode_pkt(Type,B1), case Length of - L when L=:=byte_size(Bin) -> ok; - undefined when NSize<HdrSize -> ok + L when L=:=byte_size(Bin) -> ok; + undefined when NSize<HdrSize -> ok end, more_length_do(Type,HdrSize,Bin,NSize). - + pack(Type,Packet,Rest) -> {Bin,Unpacked} = pack(Type,Packet), @@ -136,7 +117,7 @@ pack(Type,Body,Rest,BitOffs) -> {Packet,Unpacked} = pack(Type,Body), %% Make Bin a sub-bin with an arbitrary bitoffset within Orig - Prefix = random:uniform(1 bsl BitOffs) - 1, + Prefix = rand:uniform(1 bsl BitOffs) - 1, Orig = <<Prefix:BitOffs,Packet/binary,Rest/bits>>, <<_:BitOffs,Bin/bits>> = Orig, {Bin,Unpacked,Orig}. @@ -151,212 +132,206 @@ pack(4,Bin) -> Psz = byte_size(Bin), {<<Psz:32,Bin/binary>>, Bin}; pack(asn1,Bin) -> - Ident = case random:uniform(3) of - 1 -> <<17>>; - 2 -> <<16#1f,16#81,17>>; - 3 -> <<16#1f,16#81,16#80,16#80,17>> - end, + Ident = case rand:uniform(3) of + 1 -> <<17>>; + 2 -> <<16#1f,16#81,17>>; + 3 -> <<16#1f,16#81,16#80,16#80,17>> + end, Psz = byte_size(Bin), - Length = case random:uniform(4) of - 1 when Psz < 128 -> - <<Psz:8>>; - R when R=<2 andalso Psz < 16#10000 -> - <<16#82,Psz:16>>; - R when R=<3 andalso Psz < 16#1000000 -> - <<16#83,Psz:24>>; - _ when Psz < 16#100000000 -> - <<16#84,Psz:32>> - end, + Length = case rand:uniform(4) of + 1 when Psz < 128 -> + <<Psz:8>>; + R when R=<2 andalso Psz < 16#10000 -> + <<16#82,Psz:16>>; + R when R=<3 andalso Psz < 16#1000000 -> + <<16#83,Psz:24>>; + _ when Psz < 16#100000000 -> + <<16#84,Psz:32>> + end, Res = <<Ident/binary,Length/binary,Bin/binary>>, {Res,Res}; pack(sunrm,Bin) -> Psz = byte_size(Bin), Res = if Psz < 16#80000000 -> - <<Psz:32,Bin/binary>> - end, + <<Psz:32,Bin/binary>> + end, {Res,Res}; pack(cdr,Bin) -> GIOP = <<"GIOP">>, - Major = random:uniform(256) - 1, - Minor = random:uniform(256) - 1, - MType = random:uniform(256) - 1, + Major = rand:uniform(256) - 1, + Minor = rand:uniform(256) - 1, + MType = rand:uniform(256) - 1, Psz = byte_size(Bin), - Res = case random:uniform(2) of - 1 -> <<GIOP/binary,Major:8,Minor:8,0:8,MType:8,Psz:32/big,Bin/binary>>; - 2 -> <<GIOP/binary,Major:8,Minor:8,1:8,MType:8,Psz:32/little,Bin/binary>> - end, + Res = case rand:uniform(2) of + 1 -> <<GIOP/binary,Major:8,Minor:8,0:8,MType:8,Psz:32/big,Bin/binary>>; + 2 -> <<GIOP/binary,Major:8,Minor:8,1:8,MType:8,Psz:32/little,Bin/binary>> + end, {Res,Res}; pack(fcgi,Bin) -> Ver = 1, - Type = random:uniform(256) - 1, - Id = random:uniform(65536) - 1, - PaddSz = random:uniform(16) - 1, + Type = rand:uniform(256) - 1, + Id = rand:uniform(65536) - 1, + PaddSz = rand:uniform(16) - 1, Psz = byte_size(Bin), - Reserv = random:uniform(256) - 1, + Reserv = rand:uniform(256) - 1, Padd = case PaddSz of - 0 -> <<>>; - _ -> list_to_binary([random:uniform(256)-1 - || _<- lists:seq(1,PaddSz)]) - end, + 0 -> <<>>; + _ -> list_to_binary([rand:uniform(256)-1 + || _<- lists:seq(1,PaddSz)]) + end, Res = <<Ver:8,Type:8,Id:16,Psz:16/big,PaddSz:8,Reserv:8,Bin/binary>>, {<<Res/binary,Padd/binary>>, Res}; pack(tpkt,Bin) -> Ver = 3, - Reserv = random:uniform(256) - 1, + Reserv = rand:uniform(256) - 1, Size = byte_size(Bin) + 4, Res = <<Ver:8,Reserv:8,Size:16,Bin/binary>>, {Res, Res}; pack(ssl_tls,Bin) -> - Content = case (random:uniform(256) - 1) of - C when C<128 -> C; - _ -> v2hello - end, - Major = random:uniform(256) - 1, - Minor = random:uniform(256) - 1, + Content = case (rand:uniform(256) - 1) of + C when C<128 -> C; + _ -> v2hello + end, + Major = rand:uniform(256) - 1, + Minor = rand:uniform(256) - 1, pack_ssl(Content,Major,Minor,Bin). pack_ssl(Content, Major, Minor, Body) -> case Content of - v2hello -> - Size = byte_size(Body), - Res = <<1:1,(Size+3):15, 1:8, Major:8, Minor:8, Body/binary>>, - C = 22, - Data = <<1:8, (Size+2):24, Major:8, Minor:8, Body/binary>>; - C when is_integer(C) -> - Size = byte_size(Body), - Res = <<Content:8, Major:8, Minor:8, Size:16, Body/binary>>, - Data = Body + v2hello -> + Size = byte_size(Body), + Res = <<1:1,(Size+3):15, 1:8, Major:8, Minor:8, Body/binary>>, + C = 22, + Data = <<1:8, (Size+2):24, Major:8, Minor:8, Body/binary>>; + C when is_integer(C) -> + Size = byte_size(Body), + Res = <<Content:8, Major:8, Minor:8, Size:16, Body/binary>>, + Data = Body end, {Res, {ssl_tls,[],C,{Major,Minor}, Data}}. -packet_size(doc) -> []; -packet_size(suite) -> []; packet_size(Config) when is_list(Config) -> - ?line Packet = <<101,22,203,54,175>>, - ?line Rest = <<123,34,0,250>>, + Packet = <<101,22,203,54,175>>, + Rest = <<123,34,0,250>>, F = fun({Type,Max})-> - ?line {Bin,Unpacked} = pack(Type,Packet,Rest), - ?line case decode_pkt(Type,Bin,[{packet_size,Max}]) of - {ok,Unpacked,Rest} when Max=:=0; Max>=byte_size(Packet) -> - ok; - {error,_} when Max<byte_size(Packet), Max=/=0 -> - ok; - {error,_} when Type=:=fcgi, Max=/=0 -> - %% packet includes random amount of padding - ok - end - end, - ?line lists:foreach(F, [{T,D} || T<-[1,2,4,asn1,sunrm,cdr,fcgi,tpkt,ssl_tls], - D<-lists:seq(0, byte_size(Packet)*2)]), + {Bin,Unpacked} = pack(Type,Packet,Rest), + case decode_pkt(Type,Bin,[{packet_size,Max}]) of + {ok,Unpacked,Rest} when Max=:=0; Max>=byte_size(Packet) -> + ok; + {error,_} when Max<byte_size(Packet), Max=/=0 -> + ok; + {error,_} when Type=:=fcgi, Max=/=0 -> + %% packet includes random amount of padding + ok + end + end, + lists:foreach(F, [{T,D} || T<-[1,2,4,asn1,sunrm,cdr,fcgi,tpkt,ssl_tls], + D<-lists:seq(0, byte_size(Packet)*2)]), %% Test OTP-8102, "negative" 4-byte sizes. lists:foreach(fun(Size) -> - ?line {error,_} = decode_pkt(4,<<Size:32,Packet/binary>>) - end, - lists:seq(-10,-1)), + {error,_} = decode_pkt(4,<<Size:32,Packet/binary>>) + end, + lists:seq(-10,-1)), %% Test OTP-9389, long HTTP header lines. Opts = [{packet_size, 128}], Pkt = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /", string:chars($Y, 64), "\r\n\r\n"]), <<Pkt1:50/binary, Pkt2/binary>> = Pkt, - ?line {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} = - erlang:decode_packet(http, Pkt1, Opts), - ?line {ok, {http_header,_,'Host',_,"localhost"}, Rest2} = - erlang:decode_packet(httph, Rest1, Opts), - ?line {more, undefined} = erlang:decode_packet(httph, Rest2, Opts), - ?line {ok, {http_header,_,"Link",_,_}, _} = - erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts), + {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} = + erlang:decode_packet(http, Pkt1, Opts), + {ok, {http_header,_,'Host',_,"localhost"}, Rest2} = + erlang:decode_packet(httph, Rest1, Opts), + {more, undefined} = erlang:decode_packet(httph, Rest2, Opts), + {ok, {http_header,_,"Link",_,_}, _} = + erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts), Pkt3 = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /", string:chars($Y, 129), "\r\n\r\n"]), - ?line {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest3} = - erlang:decode_packet(http, Pkt3, Opts), - ?line {ok, {http_header,_,'Host',_,"localhost"}, Rest4} = - erlang:decode_packet(httph, Rest3, Opts), - ?line {error, invalid} = erlang:decode_packet(httph, Rest4, Opts), + {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest3} = + erlang:decode_packet(http, Pkt3, Opts), + {ok, {http_header,_,'Host',_,"localhost"}, Rest4} = + erlang:decode_packet(httph, Rest3, Opts), + {error, invalid} = erlang:decode_packet(httph, Rest4, Opts), ok. -neg(doc) -> []; -neg(suite) -> []; neg(Config) when is_list(Config) -> - ?line Bin = <<"dummy">>, + Bin = <<"dummy">>, Fun = fun()->dummy end, - + BadargF = fun(T,B,Opts)-> {'EXIT',{badarg,_}} = (catch decode_pkt(T,B,Opts)) end, %% Invalid Type args lists:foreach(fun(T)-> BadargF(T,Bin,[]) end, - [3,-1,5,2.0,{2},unknown,[],"line",Bin,Fun,self()]), + [3,-1,5,2.0,{2},unknown,[],"line",Bin,Fun,self()]), %% Invalid Bin args lists:foreach(fun(B)-> BadargF(0,B,[]) end, - [3,2.0,unknown,[],"Bin",[Bin],{Bin},Fun,self()]), + [3,2.0,unknown,[],"Bin",[Bin],{Bin},Fun,self()]), %% Invalid options InvOpts = [2,false,self(),Bin,"Options",Fun, - packet_size,{packet_size},{packet_size,0,false}, - {packet_size,-1},{packet_size,100.0},{packet_size,false}, - {line_length,-1},{line_length,100.0},{line_length,false}], + packet_size,{packet_size},{packet_size,0,false}, + {packet_size,-1},{packet_size,100.0},{packet_size,false}, + {line_length,-1},{line_length,100.0},{line_length,false}], lists:foreach(fun(Opt)-> BadargF(0,Bin,Opt), - BadargF(0,Bin,[Opt]), - BadargF(0,Bin,[Opt,{packet_size,1000}]), - BadargF(0,Bin,[{packet_size,1000},Opt]) end, - InvOpts), + BadargF(0,Bin,[Opt]), + BadargF(0,Bin,[Opt,{packet_size,1000}]), + BadargF(0,Bin,[{packet_size,1000},Opt]) end, + InvOpts), ok. -http(doc) -> []; -http(suite) -> []; http(Config) when is_list(Config) -> - ?line <<"foo">> = http_do(http_request("foo")), - ?line <<" bar">> = http_do(http_request(" bar")), - ?line <<"Hello!">> = http_do(http_response("Hello!")), + <<"foo">> = http_do(http_request("foo")), + <<" bar">> = http_do(http_request(" bar")), + <<"Hello!">> = http_do(http_response("Hello!")), %% Test all known header atoms Val = "dummy value", ValB = list_to_binary(Val), Rest = <<"Rest">>, HdrF = fun(Str,N) -> - ?line StrA = list_to_atom(Str), - ?line StrB = list_to_binary(Str), - ?line Bin = <<StrB/binary,": ",ValB/binary,"\r\n",Rest/binary>>, - ?line {ok, {http_header,N,StrA,undefined,Val}, Rest} = decode_pkt(httph,Bin), - ?line {ok, {http_header,N,StrA,undefined,ValB}, Rest} = decode_pkt(httph_bin,Bin), - ?line N + 1 - end, - ?line lists:foldl(HdrF, 1, http_hdr_strings()), + StrA = list_to_atom(Str), + StrB = list_to_binary(Str), + Bin = <<StrB/binary,": ",ValB/binary,"\r\n",Rest/binary>>, + {ok, {http_header,N,StrA,undefined,Val}, Rest} = decode_pkt(httph,Bin), + {ok, {http_header,N,StrA,undefined,ValB}, Rest} = decode_pkt(httph_bin,Bin), + N + 1 + end, + lists:foldl(HdrF, 1, http_hdr_strings()), %% Test all known method atoms MethF = fun(Meth) -> - ?line MethA = list_to_atom(Meth), - ?line MethB = list_to_binary(Meth), - ?line Bin = <<MethB/binary," /invalid/url HTTP/1.0\r\n",Rest/binary>>, - ?line {ok, {http_request,MethA,{abs_path,"/invalid/url"},{1,0}}, - Rest} = decode_pkt(http,Bin), - ?line {ok, {http_request,MethA,{abs_path,<<"/invalid/url">>},{1,0}}, - Rest} = decode_pkt(http_bin,Bin) - end, - ?line lists:foreach(MethF, http_meth_strings()), + MethA = list_to_atom(Meth), + MethB = list_to_binary(Meth), + Bin = <<MethB/binary," /invalid/url HTTP/1.0\r\n",Rest/binary>>, + {ok, {http_request,MethA,{abs_path,"/invalid/url"},{1,0}}, + Rest} = decode_pkt(http,Bin), + {ok, {http_request,MethA,{abs_path,<<"/invalid/url">>},{1,0}}, + Rest} = decode_pkt(http_bin,Bin) + end, + lists:foreach(MethF, http_meth_strings()), %% Test all uri variants UriF = fun({Str,ResL,ResB}) -> - Bin = <<"GET ",(list_to_binary(Str))/binary," HTTP/1.1\r\n",Rest/binary>>, - {ok, {http_request, 'GET', ResL, {1,1}}, Rest} = decode_pkt(http,Bin), - {ok, {http_request, 'GET', ResB, {1,1}}, Rest} = decode_pkt(http_bin,Bin) - end, + Bin = <<"GET ",(list_to_binary(Str))/binary," HTTP/1.1\r\n",Rest/binary>>, + {ok, {http_request, 'GET', ResL, {1,1}}, Rest} = decode_pkt(http,Bin), + {ok, {http_request, 'GET', ResB, {1,1}}, Rest} = decode_pkt(http_bin,Bin) + end, lists:foreach(UriF, http_uri_variants()), %% Response with empty phrase - ?line {ok,{http_response,{1,1},200,[]},<<>>} = decode_pkt(http, <<"HTTP/1.1 200\r\n">>, []), - ?line {ok,{http_response,{1,1},200,<<>>},<<>>} = decode_pkt(http_bin, <<"HTTP/1.1 200\r\n">>, []), + {ok,{http_response,{1,1},200,[]},<<>>} = decode_pkt(http, <<"HTTP/1.1 200\r\n">>, []), + {ok,{http_response,{1,1},200,<<>>},<<>>} = decode_pkt(http_bin, <<"HTTP/1.1 200\r\n">>, []), ok. - + http_with_bin(http) -> http_bin; http_with_bin(httph) -> @@ -367,88 +342,88 @@ http_do(Tup) -> http_do({Bin, []}, _) -> Bin; http_do({Bin,[{_Line,PL,PB}|Tail]}, Type) -> - ?line {ok, PL, Rest} = decode_pkt(Type,Bin), - ?line {ok, PB, Rest} = decode_pkt(http_with_bin(Type),Bin), + {ok, PL, Rest} = decode_pkt(Type,Bin), + {ok, PB, Rest} = decode_pkt(http_with_bin(Type),Bin), %% Same tests again but as SubBin - PreLen = random:uniform(64), - Prefix = random:uniform(1 bsl PreLen) - 1, - SufLen = random:uniform(64), - Suffix = random:uniform(1 bsl SufLen) - 1, + PreLen = rand:uniform(64), + Prefix = rand:uniform(1 bsl PreLen) - 1, + SufLen = rand:uniform(64), + Suffix = rand:uniform(1 bsl SufLen) - 1, Orig = <<Prefix:PreLen, Bin/bits, Suffix:SufLen>>, BinLen = bit_size(Bin), <<_:PreLen, SubBin:BinLen/bits, _/bits>> = Orig, % Make SubBin - ?line SubBin = Bin, % just to make sure + SubBin = Bin, % just to make sure - ?line {ok, PL, Rest} = decode_pkt(Type,SubBin), - ?line {ok, PB, Rest} = decode_pkt(http_with_bin(Type),SubBin), + {ok, PL, Rest} = decode_pkt(Type,SubBin), + {ok, PB, Rest} = decode_pkt(http_with_bin(Type),SubBin), http_do({Rest, Tail}, httph). http_request(Msg) -> QnA = [{"POST /invalid/url HTTP/1.1\r\n", - {http_request, 'POST', {abs_path, "/invalid/url" }, {1,1}}, - {http_request, 'POST', {abs_path,<<"/invalid/url">>}, {1,1}}}, - {"Connection: close\r\n", - {http_header,2,'Connection',undefined, "close"}, - {http_header,2,'Connection',undefined,<<"close">>}}, - {"Host\t : localhost:8000\r\n", % white space before : - {http_header,14,'Host',undefined, "localhost:8000"}, - {http_header,14,'Host',undefined,<<"localhost:8000">>}}, - {"User-Agent: perl post\r\n", - {http_header,24,'User-Agent',undefined, "perl post"}, - {http_header,24,'User-Agent',undefined,<<"perl post">>}}, - {"Content-Length: 4\r\n", - {http_header,38,'Content-Length',undefined, "4"}, - {http_header,38,'Content-Length',undefined,<<"4">>}}, - {"Content-Type: text/xml; charset=utf-8\r\n", - {http_header,42,'Content-Type',undefined, "text/xml; charset=utf-8"}, - {http_header,42,'Content-Type',undefined,<<"text/xml; charset=utf-8">>}}, - {"Other-Field: with some text\r\n", - {http_header,0, "Other-Field" ,undefined, "with some text"}, - {http_header,0,<<"Other-Field">>,undefined,<<"with some text">>}}, - {"Make-sure-a-LONG-HEaDer-fIeLd-is-fORMATTED-NicelY: with some text\r\n", - {http_header,0, "Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely" ,undefined, "with some text"}, - {http_header,0,<<"Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely">>,undefined,<<"with some text">>}}, - {"Multi-Line: Once upon a time in a land far far away,\r\n" - " there lived a princess imprisoned in the highest tower\r\n" - " of the most haunted castle.\r\n", - {http_header,0, "Multi-Line" ,undefined, "Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle."}, - {http_header,0,<<"Multi-Line">>,undefined,<<"Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle.">>}}, - {"\r\n", - http_eoh, - http_eoh}], + {http_request, 'POST', {abs_path, "/invalid/url" }, {1,1}}, + {http_request, 'POST', {abs_path,<<"/invalid/url">>}, {1,1}}}, + {"Connection: close\r\n", + {http_header,2,'Connection',undefined, "close"}, + {http_header,2,'Connection',undefined,<<"close">>}}, + {"Host\t : localhost:8000\r\n", % white space before : + {http_header,14,'Host',undefined, "localhost:8000"}, + {http_header,14,'Host',undefined,<<"localhost:8000">>}}, + {"User-Agent: perl post\r\n", + {http_header,24,'User-Agent',undefined, "perl post"}, + {http_header,24,'User-Agent',undefined,<<"perl post">>}}, + {"Content-Length: 4\r\n", + {http_header,38,'Content-Length',undefined, "4"}, + {http_header,38,'Content-Length',undefined,<<"4">>}}, + {"Content-Type: text/xml; charset=utf-8\r\n", + {http_header,42,'Content-Type',undefined, "text/xml; charset=utf-8"}, + {http_header,42,'Content-Type',undefined,<<"text/xml; charset=utf-8">>}}, + {"Other-Field: with some text\r\n", + {http_header,0, "Other-Field" ,undefined, "with some text"}, + {http_header,0,<<"Other-Field">>,undefined,<<"with some text">>}}, + {"Make-sure-a-LONG-HEaDer-fIeLd-is-fORMATTED-NicelY: with some text\r\n", + {http_header,0, "Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely" ,undefined, "with some text"}, + {http_header,0,<<"Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely">>,undefined,<<"with some text">>}}, + {"Multi-Line: Once upon a time in a land far far away,\r\n" + " there lived a princess imprisoned in the highest tower\r\n" + " of the most haunted castle.\r\n", + {http_header,0, "Multi-Line" ,undefined, "Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle."}, + {http_header,0,<<"Multi-Line">>,undefined,<<"Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle.">>}}, + {"\r\n", + http_eoh, + http_eoh}], Bin = lists:foldl(fun({Line,_,_},Acc) -> LineBin = list_to_binary(Line), - <<Acc/binary,LineBin/binary>> end, - <<"">>, QnA), + <<Acc/binary,LineBin/binary>> end, + <<"">>, QnA), MsgBin = list_to_binary(Msg), {<<Bin/binary,MsgBin/binary>>, QnA}. http_response(Msg) -> QnA = [{"HTTP/1.0 404 Object Not Found\r\n", - {http_response, {1,0}, 404, "Object Not Found"}, - {http_response, {1,0}, 404, <<"Object Not Found">>}}, - {"Server: inets/4.7.16\r\n", - {http_header, 30, 'Server', undefined, "inets/4.7.16"}, - {http_header, 30, 'Server', undefined, <<"inets/4.7.16">>}}, - {"Date: Fri, 04 Jul 2008 17:16:22 GMT\r\n", - {http_header, 3, 'Date', undefined, "Fri, 04 Jul 2008 17:16:22 GMT"}, - {http_header, 3, 'Date', undefined, <<"Fri, 04 Jul 2008 17:16:22 GMT">>}}, - {"Content-Type: text/html\r\n", - {http_header, 42, 'Content-Type', undefined, "text/html"}, - {http_header, 42, 'Content-Type', undefined, <<"text/html">>}}, - {"Content-Length: 207\r\n", - {http_header, 38, 'Content-Length', undefined, "207"}, - {http_header, 38, 'Content-Length', undefined, <<"207">>}}, - {"\r\n", - http_eoh, - http_eoh}], + {http_response, {1,0}, 404, "Object Not Found"}, + {http_response, {1,0}, 404, <<"Object Not Found">>}}, + {"Server: inets/4.7.16\r\n", + {http_header, 30, 'Server', undefined, "inets/4.7.16"}, + {http_header, 30, 'Server', undefined, <<"inets/4.7.16">>}}, + {"Date: Fri, 04 Jul 2008 17:16:22 GMT\r\n", + {http_header, 3, 'Date', undefined, "Fri, 04 Jul 2008 17:16:22 GMT"}, + {http_header, 3, 'Date', undefined, <<"Fri, 04 Jul 2008 17:16:22 GMT">>}}, + {"Content-Type: text/html\r\n", + {http_header, 42, 'Content-Type', undefined, "text/html"}, + {http_header, 42, 'Content-Type', undefined, <<"text/html">>}}, + {"Content-Length: 207\r\n", + {http_header, 38, 'Content-Length', undefined, "207"}, + {http_header, 38, 'Content-Length', undefined, <<"207">>}}, + {"\r\n", + http_eoh, + http_eoh}], Bin = lists:foldl(fun({Line,_,_},Acc) -> LineBin = list_to_binary(Line), - <<Acc/binary,LineBin/binary>> end, - <<"">>, QnA), + <<Acc/binary,LineBin/binary>> end, + <<"">>, QnA), MsgBin = list_to_binary(Msg), {<<Bin/binary,MsgBin/binary>>, QnA}. @@ -489,60 +464,56 @@ http_uri_variants() -> {"something_else", "something_else", <<"something_else">>}]. -line(doc) -> []; -line(suite) -> []; line(Config) when is_list(Config) -> Text = <<"POST /invalid/url HTTP/1.1\r\n" - "Connection: close\r\n" - "Host\t : localhost:8000\r\n" - "User-Agent: perl post\r\n" - "Content-Length: 4\r\n" - "Content-Type: text/xml; charset=utf-8\r\n" - "Other-Field: with some text\r\n" - "Multi-Line: Once upon a time in a land far far away,\r\n" - " there lived a princess imprisoned in the highest tower\r\n" - " of the most haunted castle.\r\n" - "\r\nThe residue">>, + "Connection: close\r\n" + "Host\t : localhost:8000\r\n" + "User-Agent: perl post\r\n" + "Content-Length: 4\r\n" + "Content-Type: text/xml; charset=utf-8\r\n" + "Other-Field: with some text\r\n" + "Multi-Line: Once upon a time in a land far far away,\r\n" + " there lived a princess imprisoned in the highest tower\r\n" + " of the most haunted castle.\r\n" + "\r\nThe residue">>, lists:foreach(fun(MaxLen) -> line_do(Text,MaxLen) end, - [0,7,19,29,37]), + [0,7,19,29,37]), ok. line_do(Bin,MaxLen) -> Res = decode_pkt(line,Bin,[{line_length,MaxLen}]), MyRes = decode_line(Bin,MaxLen), - ?line MyRes = Res, + MyRes = Res, case Res of - {ok,_,Rest} -> - line_do(Rest,MaxLen); - {more,undefined} -> - ok + {ok,_,Rest} -> + line_do(Rest,MaxLen); + {more,undefined} -> + ok end. - + % Emulates decode_packet(line,Bin,[{line_length,MaxLen}]) decode_line(Bin,MaxLen) -> - ?line case find_in_binary($\n,Bin) of - notfound when MaxLen>0 andalso byte_size(Bin) >= MaxLen -> - {LineB,Rest} = split_binary(Bin,MaxLen), - {ok,LineB,Rest}; - notfound -> - {more,undefined}; - Pos when MaxLen>0 andalso Pos > MaxLen -> - {LineB,Rest} = split_binary(Bin,MaxLen), - {ok,LineB,Rest}; - Pos -> - {LineB,Rest} = split_binary(Bin,Pos), - {ok,LineB,Rest} + case find_in_binary($\n,Bin) of + notfound when MaxLen>0 andalso byte_size(Bin) >= MaxLen -> + {LineB,Rest} = split_binary(Bin,MaxLen), + {ok,LineB,Rest}; + notfound -> + {more,undefined}; + Pos when MaxLen>0 andalso Pos > MaxLen -> + {LineB,Rest} = split_binary(Bin,MaxLen), + {ok,LineB,Rest}; + Pos -> + {LineB,Rest} = split_binary(Bin,Pos), + {ok,LineB,Rest} end. find_in_binary(Byte, Bin) -> case string:chr(binary_to_list(Bin),Byte) of - 0 -> notfound; - P -> P + 0 -> notfound; + P -> P end. -ssl(doc) -> []; -ssl(suite) -> []; ssl(Config) when is_list(Config) -> Major = 34, Minor = 17, @@ -550,15 +521,15 @@ ssl(Config) when is_list(Config) -> Rest = <<23,123,203,12,234>>, F = fun(Content) -> - {Packet,Unpacked} = pack_ssl(Content, Major, Minor, Body), - Bin = <<Packet/binary,Rest/binary>>, - ?line {ok, Unpacked, Rest} = decode_pkt(ssl_tls, Bin) - end, + {Packet,Unpacked} = pack_ssl(Content, Major, Minor, Body), + Bin = <<Packet/binary,Rest/binary>>, + {ok, Unpacked, Rest} = decode_pkt(ssl_tls, Bin) + end, F(25), F(v2hello), ok. -otp_8536(doc) -> ["Corrupt sub-binary-strings from httph_bin"]; +%% Corrupt sub-binary-strings from httph_bin otp_8536(Config) when is_list(Config) -> lists:foreach(fun otp_8536_do/1, lists:seq(1,50)), ok. @@ -571,7 +542,7 @@ otp_8536_do(N) -> Bin = <<Hdr/binary, ": ", Data/binary, "\r\n\r\n">>, io:format("Bin='~p'\n",[Bin]), - ?line {ok,{http_header,0,Hdr2,undefined,Data2},<<"\r\n">>} = decode_pkt(httph_bin, Bin, []), + {ok,{http_header,0,Hdr2,undefined,Data2},<<"\r\n">>} = decode_pkt(httph_bin, Bin, []), %% Do something to trash the C-stack, how about another decode_packet: decode_pkt(httph_bin,<<Letters/binary, ": ", Data/binary, "\r\n\r\n">>, []), @@ -587,8 +558,7 @@ decode_pkt(Type,Bin,Opts) -> %%io:format(" -> ~p\n",[Res]), Res. -otp_9389(doc) -> ["Verify line_length works correctly for HTTP headers"]; -otp_9389(suite) -> []; +%% Verify line_length works correctly for HTTP headers otp_9389(Config) when is_list(Config) -> Opts = [{packet_size, 16384}, {line_length, 3000}], Pkt = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /", @@ -596,26 +566,25 @@ otp_9389(Config) when is_list(Config) -> "\r\nContent-Length: 0\r\n\r\n"]), <<Pkt1:5000/binary, Pkt2/binary>> = Pkt, {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} = - erlang:decode_packet(http, Pkt1, Opts), + erlang:decode_packet(http, Pkt1, Opts), {ok, {http_header,_,'Host',_,"localhost"}, Rest2} = - erlang:decode_packet(httph, Rest1, Opts), + erlang:decode_packet(httph, Rest1, Opts), {more, undefined} = erlang:decode_packet(httph, Rest2, Opts), {ok, {http_header,_,"Link",_,Link}, Rest3} = - erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts), + erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts), true = (length(Link) > 8000), {ok, {http_header,_,'Content-Length',_,"0"}, <<"\r\n">>} = - erlang:decode_packet(httph, Rest3, Opts), + erlang:decode_packet(httph, Rest3, Opts), ok. -otp_9389_line(doc) -> ["Verify packet_size works correctly for line mode"]; -otp_9389_line(suite) -> []; +%% Verify packet_size works correctly for line mode otp_9389_line(Config) when is_list(Config) -> Opts = [{packet_size, 20}], Line1 = <<"0123456789012345678\n">>, Line2 = <<"0123456789\n">>, Line3 = <<"01234567890123456789\n">>, Pkt = list_to_binary([Line1, Line2, Line3]), - ?line {ok, Line1, Rest1} = erlang:decode_packet(line, Pkt, Opts), - ?line {ok, Line2, Rest2} = erlang:decode_packet(line, Rest1, Opts), - ?line {error, invalid} = erlang:decode_packet(line, Rest2, Opts), + {ok, Line1, Rest1} = erlang:decode_packet(line, Pkt, Opts), + {ok, Line2, Rest2} = erlang:decode_packet(line, Rest1, Opts), + {error, invalid} = erlang:decode_packet(line, Rest2, Opts), ok. diff --git a/erts/emulator/test/dgawd_handler.erl b/erts/emulator/test/dgawd_handler.erl index bba69ef87e..52cdd26427 100644 --- a/erts/emulator/test/dgawd_handler.erl +++ b/erts/emulator/test/dgawd_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2010. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index 151fab0a0e..d0096fb1bc 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -33,41 +33,40 @@ %% Tests distribution and the tcp driver. --include_lib("test_server/include/test_server.hrl"). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - ping/1, bulk_send_small/1, - bulk_send_big/1, bulk_send_bigbig/1, - local_send_small/1, local_send_big/1, - local_send_legal/1, link_to_busy/1, exit_to_busy/1, - lost_exit/1, link_to_dead/1, link_to_dead_new_node/1, - applied_monitor_node/1, ref_port_roundtrip/1, nil_roundtrip/1, - trap_bif_1/1, trap_bif_2/1, trap_bif_3/1, - stop_dist/1, - dist_auto_connect_never/1, dist_auto_connect_once/1, - dist_parallel_send/1, - atom_roundtrip/1, - unicode_atom_roundtrip/1, - atom_roundtrip_r15b/1, - contended_atom_cache_entry/1, - contended_unicode_atom_cache_entry/1, - bad_dist_structure/1, - bad_dist_ext_receive/1, - bad_dist_ext_process_info/1, - bad_dist_ext_control/1, - bad_dist_ext_connection_id/1]). - --export([init_per_testcase/2, end_per_testcase/2]). +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, suite/0, groups/0, + ping/1, bulk_send_small/1, + bulk_send_big/1, bulk_send_bigbig/1, + local_send_small/1, local_send_big/1, + local_send_legal/1, link_to_busy/1, exit_to_busy/1, + lost_exit/1, link_to_dead/1, link_to_dead_new_node/1, + applied_monitor_node/1, ref_port_roundtrip/1, nil_roundtrip/1, + trap_bif_1/1, trap_bif_2/1, trap_bif_3/1, + stop_dist/1, + dist_auto_connect_never/1, dist_auto_connect_once/1, + dist_parallel_send/1, + atom_roundtrip/1, + unicode_atom_roundtrip/1, + atom_roundtrip_r15b/1, + contended_atom_cache_entry/1, + contended_unicode_atom_cache_entry/1, + bad_dist_structure/1, + bad_dist_ext_receive/1, + bad_dist_ext_process_info/1, + bad_dist_ext_control/1, + bad_dist_ext_connection_id/1]). %% Internal exports. -export([sender/3, receiver2/2, dummy_waiter/0, dead_process/0, - roundtrip/1, bounce/1, do_dist_auto_connect/1, inet_rpc_server/1, - dist_parallel_sender/3, dist_parallel_receiver/0, - dist_evil_parallel_receiver/0, + roundtrip/1, bounce/1, do_dist_auto_connect/1, inet_rpc_server/1, + dist_parallel_sender/3, dist_parallel_receiver/0, + dist_evil_parallel_receiver/0, sendersender/4, sendersender2/4]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. all() -> [ping, {group, bulk_send}, {group, local_send}, @@ -90,80 +89,54 @@ groups() -> [bad_dist_ext_receive, bad_dist_ext_process_info, bad_dist_ext_control, bad_dist_ext_connection_id]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - --define(DEFAULT_TIMETRAP, 4*60*1000). - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?DEFAULT_TIMETRAP), - [{watchdog, Dog},{testcase, Func}|Config]. - -end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -ping(doc) -> - ["Tests pinging a node in different ways."]; +%% Tests pinging a node in different ways. ping(Config) when is_list(Config) -> Times = 1024, %% Ping a non-existing node many times. This used to crash the emulator %% on Windows. - ?line Host = hostname(), - ?line BadName = list_to_atom("__pucko__@" ++ Host), - ?line io:format("Pinging ~s (assumed to not exist)", [BadName]), - ?line test_server:do_times(Times, fun() -> pang = net_adm:ping(BadName) - end), + Host = hostname(), + BadName = list_to_atom("__pucko__@" ++ Host), + io:format("Pinging ~s (assumed to not exist)", [BadName]), + test_server:do_times(Times, fun() -> pang = net_adm:ping(BadName) + end), %% Pings another node. - ?line {ok, OtherNode} = start_node(distribution_SUITE_other), - ?line io:format("Pinging ~s (assumed to exist)", [OtherNode]), - ?line test_server:do_times(Times, fun() -> pong = net_adm:ping(OtherNode) end), - ?line stop_node(OtherNode), + {ok, OtherNode} = start_node(distribution_SUITE_other), + io:format("Pinging ~s (assumed to exist)", [OtherNode]), + test_server:do_times(Times, fun() -> pong = net_adm:ping(OtherNode) end), + stop_node(OtherNode), %% Pings our own node many times. - ?line Node = node(), - ?line io:format("Pinging ~s (the same node)", [Node]), - ?line test_server:do_times(Times, fun() -> pong = net_adm:ping(Node) end), + Node = node(), + io:format("Pinging ~s (the same node)", [Node]), + test_server:do_times(Times, fun() -> pong = net_adm:ping(Node) end), ok. bulk_send_small(Config) when is_list(Config) -> - ?line bulk_send(64, 32). + bulk_send(64, 32). bulk_send_big(Config) when is_list(Config) -> - ?line bulk_send(32, 64). + bulk_send(32, 64). bulk_send_bigbig(Config) when is_list(Config) -> - ?line bulk_sendsend(32*5, 4). + bulk_sendsend(32*5, 4). bulk_send(Terms, BinSize) -> - ?line Dog = test_server:timetrap(test_server:seconds(30)), - - ?line io:format("Sending ~w binaries, each of size ~w K", - [Terms, BinSize]), - ?line {ok, Node} = start_node(bulk_receiver), - ?line Recv = spawn(Node, erlang, apply, [fun receiver/2, [0, 0]]), - ?line Bin = list_to_binary(lists:duplicate(BinSize*1024, 253)), - ?line Size = Terms*size(Bin), - ?line {Elapsed, {Terms, Size}} = test_server:timecall(?MODULE, sender, - [Recv, Bin, Terms]), - ?line stop_node(Node), - - ?line test_server:timetrap_cancel(Dog), + ct:timetrap({seconds, 30}), + + io:format("Sending ~w binaries, each of size ~w K", [Terms, BinSize]), + {ok, Node} = start_node(bulk_receiver), + Recv = spawn(Node, erlang, apply, [fun receiver/2, [0, 0]]), + Bin = list_to_binary(lists:duplicate(BinSize*1024, 253)), + Size = Terms*size(Bin), + {Elapsed, {Terms, Size}} = test_server:timecall(?MODULE, sender, + [Recv, Bin, Terms]), + stop_node(Node), {comment, integer_to_list(trunc(Size/1024/max(1,Elapsed)+0.5)) ++ " K/s"}. bulk_sendsend(Terms, BinSize) -> @@ -173,29 +146,29 @@ bulk_sendsend(Terms, BinSize) -> true -> MonitorCount1 / MonitorCount2 end, Comment = integer_to_list(Rate1) ++ " K/s, " ++ - integer_to_list(Rate2) ++ " K/s, " ++ - integer_to_list(MonitorCount1) ++ " monitor msgs, " ++ - integer_to_list(MonitorCount2) ++ " monitor msgs, " ++ - float_to_list(Ratio) ++ " monitor ratio", + integer_to_list(Rate2) ++ " K/s, " ++ + integer_to_list(MonitorCount1) ++ " monitor msgs, " ++ + integer_to_list(MonitorCount2) ++ " monitor msgs, " ++ + float_to_list(Ratio) ++ " monitor ratio", if - %% A somewhat arbitrary ratio, but hopefully one that will - %% accommodate a wide range of CPU speeds. - Ratio > 8.0 -> - {comment,Comment}; - true -> - io:put_chars(Comment), - ?line ?t:fail(ratio_too_low) + %% A somewhat arbitrary ratio, but hopefully one that will + %% accommodate a wide range of CPU speeds. + Ratio > 8.0 -> + {comment,Comment}; + true -> + io:put_chars(Comment), + ct:fail(ratio_too_low) end. bulk_sendsend2(Terms, BinSize, BusyBufSize) -> - ?line Dog = test_server:timetrap(test_server:seconds(30)), + ct:timetrap({seconds, 30}), - ?line io:format("Sending ~w binaries, each of size ~w K", - [Terms, BinSize]), - ?line {ok, NodeRecv} = start_node(bulk_receiver), - ?line Recv = spawn(NodeRecv, erlang, apply, [fun receiver/2, [0, 0]]), - ?line Bin = list_to_binary(lists:duplicate(BinSize*1024, 253)), - %%?line Size = Terms*size(Bin), + io:format("Sending ~w binaries, each of size ~w K", + [Terms, BinSize]), + {ok, NodeRecv} = start_node(bulk_receiver), + Recv = spawn(NodeRecv, erlang, apply, [fun receiver/2, [0, 0]]), + Bin = list_to_binary(lists:duplicate(BinSize*1024, 253)), + %%Size = Terms*size(Bin), %% SLF LEFT OFF HERE. %% When the caller uses small hunks, like 4k via @@ -206,23 +179,21 @@ bulk_sendsend2(Terms, BinSize, BusyBufSize) -> %% default busy size and "+zdbbl 5", and if the 5 case gets %% "many many more" monitor messages, then we know we're working. - ?line {ok, NodeSend} = start_node(bulk_sender, "+zdbbl " ++ integer_to_list(BusyBufSize)), - ?line _Send = spawn(NodeSend, erlang, apply, [fun sendersender/4, [self(), Recv, Bin, Terms]]), - ?line {Elapsed, {_TermsN, SizeN}, MonitorCount} = - receive {sendersender, BigRes} -> + {ok, NodeSend} = start_node(bulk_sender, "+zdbbl " ++ integer_to_list(BusyBufSize)), + _Send = spawn(NodeSend, erlang, apply, [fun sendersender/4, [self(), Recv, Bin, Terms]]), + {Elapsed, {_TermsN, SizeN}, MonitorCount} = + receive {sendersender, BigRes} -> BigRes - end, - ?line stop_node(NodeRecv), - ?line stop_node(NodeSend), - - ?line test_server:timetrap_cancel(Dog), + end, + stop_node(NodeRecv), + stop_node(NodeSend), {trunc(SizeN/1024/Elapsed+0.5), MonitorCount}. sender(To, _Bin, 0) -> To ! {done, self()}, receive - Any -> - Any + Any -> + Any end; sender(To, Bin, Left) -> To ! {term, Bin}, @@ -233,9 +204,9 @@ sender(To, Bin, Left) -> sendersender(Parent, To, Bin, Left) -> erlang:system_monitor(self(), [busy_dist_port]), [spawn(fun() -> sendersender2(To, Bin, Left, false) end) || - _ <- lists:seq(1,1)], + _ <- lists:seq(1,1)], {USec, {Res, MonitorCount}} = - timer:tc(?MODULE, sendersender2, [To, Bin, Left, true]), + timer:tc(?MODULE, sendersender2, [To, Bin, Left, true]), Parent ! {sendersender, {USec/1000000, Res, MonitorCount}}. sendersender2(To, Bin, Left, SendDone) -> @@ -243,22 +214,22 @@ sendersender2(To, Bin, Left, SendDone) -> sendersender3(To, _Bin, 0, SendDone, MonitorCount) -> if SendDone -> - To ! {done, self()}; + To ! {done, self()}; true -> - ok + ok end, receive {monitor, _Pid, _Type, _Info} -> sendersender3(To, _Bin, 0, SendDone, MonitorCount + 1) after 0 -> - if SendDone -> - receive - Any when is_tuple(Any), size(Any) == 2 -> - {Any, MonitorCount} - end; - true -> - exit(normal) - end + if SendDone -> + receive + Any when is_tuple(Any), size(Any) == 2 -> + {Any, MonitorCount} + end; + true -> + exit(normal) + end end; sendersender3(To, Bin, Left, SendDone, MonitorCount) -> To ! {term, Bin}, @@ -269,80 +240,74 @@ sendersender3(To, Bin, Left, SendDone, MonitorCount) -> receiver(Terms, Size) -> receive - {term, Bin} -> - receiver(Terms+1, Size+size(Bin)); - {done, ReplyTo} -> - ReplyTo ! {Terms, Size} + {term, Bin} -> + receiver(Terms+1, Size+size(Bin)); + {done, ReplyTo} -> + ReplyTo ! {Terms, Size} end. -local_send_big(doc) -> - ["Sends several big message to an non-registered process on ", - "the local node."]; +%% Sends several big message to an non-registered process on the local node. local_send_big(Config) when is_list(Config) -> - Data0=local_send_big(doc)++ - ["Tests sending small and big messages to a non-existing ", - "local registered process."], + Data0= ["Tests sending small and big messages to a non-existing ", + "local registered process."], Data1=[Data0,[Data0, Data0, [Data0], Data0],Data0], Data2=Data0++lists:flatten(Data1)++ - list_to_binary(lists:flatten(Data1)), + list_to_binary(lists:flatten(Data1)), Func=fun() -> Data2= {arbitrary_name, node()} ! Data2 end, - ?line test_server:do_times(4096, Func), + test_server:do_times(4096, Func), ok. -local_send_small(doc) -> - ["Sends a small message to an non-registered process on the ", - "local node."]; +%% Sends a small message to an non-registered process on the local node. local_send_small(Config) when is_list(Config) -> Data={some_stupid, "arbitrary", 'Data'}, Func=fun() -> Data= {unregistered_name, node()} ! Data end, - ?line test_server:do_times(4096, Func), + test_server:do_times(4096, Func), ok. -local_send_legal(doc) -> - ["Sends data to a registered process on the local node, ", - "as if it was on another node."]; +%% Sends data to a registered process on the local node, as if it was on another node. local_send_legal(Config) when is_list(Config) -> Times=16384, - Data={local_send_legal(doc), local_send_legal(doc)}, + Txt = "Some Not so random Data", + Data={[Txt,Txt,Txt], [Txt,Txt,Txt]}, Pid=spawn(?MODULE,receiver2, [0, 0]) , - ?line true=register(registered_process, Pid), + true=register(registered_process, Pid), Func=fun() -> Data={registered_process, node()} ! Data end, TotalSize=size(Data)*Times, - ?line test_server:do_times(Times, Func), + test_server:do_times(Times, Func), % Check that all msgs really came through. Me=self(), - ?line {done, Me}= - {registered_process, node()} ! {done, Me}, + {done, Me}= + {registered_process, node()} ! {done, Me}, receive - {Times, TotalSize} -> - ok; - _ -> - test_server:fail("Wrong number of msgs received.") + {Times, TotalSize} -> + ok; + _ -> + ct:fail("Wrong number of msgs received.") end, ok. receiver2(Num, TotSize) -> receive - {done, ReplyTo} -> - ReplyTo ! {Num, TotSize}; - Stuff -> - receiver2(Num+1, TotSize+size(Stuff)) + {done, ReplyTo} -> + ReplyTo ! {Num, TotSize}; + Stuff -> + receiver2(Num+1, TotSize+size(Stuff)) end. -link_to_busy(doc) -> "Test that link/1 to a busy distribution port works."; +%% Test that link/1 to a busy distribution port works. link_to_busy(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {ok, Node} = start_node(link_to_busy), - ?line Recv = spawn(Node, erlang, apply, [fun sink/1, [link_to_busy_sink]]), + ct:timetrap({seconds, 60}), + {ok, Node} = start_node(link_to_busy), + Recv = spawn(Node, erlang, apply, [fun sink/1, [link_to_busy_sink]]), Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of - "true" -> start_busy_dist_port_tracer(); - _ -> false - end, + "true" -> start_busy_dist_port_tracer(); + _ -> false + end, %% We will spawn off a process which will try to link to the other %% node. The linker process will not actually run until this @@ -351,20 +316,19 @@ link_to_busy(Config) when is_list(Config) -> %% process will block, too, because of the because busy port, %% and will later be restarted. - ?line do_busy_test(Node, fun () -> linker(Recv) end), + do_busy_test(Node, fun () -> linker(Recv) end), %% Same thing, but we apply link/1 instead of calling it directly. - ?line do_busy_test(Node, fun () -> applied_linker(Recv) end), + do_busy_test(Node, fun () -> applied_linker(Recv) end), %% Same thing again, but we apply link/1 in the tail of a function. - ?line do_busy_test(Node, fun () -> tail_applied_linker(Recv) end), + do_busy_test(Node, fun () -> tail_applied_linker(Recv) end), %% Done. - ?line stop_node(Node), - ?line stop_busy_dist_port_tracer(Tracer), - ?line test_server:timetrap_cancel(Dog), + stop_node(Node), + stop_busy_dist_port_tracer(Tracer), ok. linker(Pid) -> @@ -379,16 +343,16 @@ applied_linker(Pid) -> tail_applied_linker(Pid) -> apply(erlang, link, [Pid]). - -exit_to_busy(doc) -> "Test that exit/2 to a busy distribution port works."; + +%% Test that exit/2 to a busy distribution port works. exit_to_busy(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line {ok, Node} = start_node(exit_to_busy), + ct:timetrap({seconds, 60}), + {ok, Node} = start_node(exit_to_busy), Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of - "true" -> start_busy_dist_port_tracer(); - _ -> false - end, + "true" -> start_busy_dist_port_tracer(); + _ -> false + end, %% We will spawn off a process which will try to exit a process on %% the other node. That process will not actually run until this @@ -397,59 +361,58 @@ exit_to_busy(Config) when is_list(Config) -> %% too, because of the busy distribution port, and will be allowed %% to continue when the port becomes non-busy. - ?line Recv1 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), - ?line M1 = erlang:monitor(process, Recv1), - ?line do_busy_test(Node, fun () -> joey_killer(Recv1) end), - ?line receive - {'DOWN', M1, process, Recv1, R1} -> - ?line joey_said_die = R1 - end, + Recv1 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), + M1 = erlang:monitor(process, Recv1), + do_busy_test(Node, fun () -> joey_killer(Recv1) end), + receive + {'DOWN', M1, process, Recv1, R1} -> + joey_said_die = R1 + end, %% Same thing, but tail call to exit/2. - ?line Recv2 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), - ?line M2 = erlang:monitor(process, Recv2), - ?line do_busy_test(Node, fun () -> tail_joey_killer(Recv2) end), - ?line receive - {'DOWN', M2, process, Recv2, R2} -> - ?line joey_said_die = R2 - end, + Recv2 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), + M2 = erlang:monitor(process, Recv2), + do_busy_test(Node, fun () -> tail_joey_killer(Recv2) end), + receive + {'DOWN', M2, process, Recv2, R2} -> + joey_said_die = R2 + end, %% Same thing, but we apply exit/2 instead of calling it directly. - ?line Recv3 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), - ?line M3 = erlang:monitor(process, Recv3), - ?line do_busy_test(Node, fun () -> applied_joey_killer(Recv3) end), - ?line receive - {'DOWN', M3, process, Recv3, R3} -> - ?line joey_said_die = R3 - end, + Recv3 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), + M3 = erlang:monitor(process, Recv3), + do_busy_test(Node, fun () -> applied_joey_killer(Recv3) end), + receive + {'DOWN', M3, process, Recv3, R3} -> + joey_said_die = R3 + end, %% Same thing again, but we apply exit/2 in the tail of a function. - ?line Recv4 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), - ?line M4 = erlang:monitor(process, Recv4), - ?line do_busy_test(Node, fun () -> tail_applied_joey_killer(Recv4) end), - ?line receive - {'DOWN', M4, process, Recv4, R4} -> - ?line joey_said_die = R4 - end, - + Recv4 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), + M4 = erlang:monitor(process, Recv4), + do_busy_test(Node, fun () -> tail_applied_joey_killer(Recv4) end), + receive + {'DOWN', M4, process, Recv4, R4} -> + joey_said_die = R4 + end, + %% Done. - ?line stop_node(Node), - ?line stop_busy_dist_port_tracer(Tracer), - ?line test_server:timetrap_cancel(Dog), + stop_node(Node), + stop_busy_dist_port_tracer(Tracer), ok. make_busy_data() -> Size = 1024*1024, Key = '__busy__port__data__', case get(Key) of - undefined -> - Data = list_to_binary(lists:duplicate(Size, 253)), - put(Key, Data), - Data; - Data -> - true = is_binary(Data), - true = size(Data) == Size, - Data + undefined -> + Data = list_to_binary(lists:duplicate(Size, 253)), + put(Key, Data), + Data; + Data -> + true = is_binary(Data), + true = size(Data) == Size, + Data end. make_busy(Node, Time) when is_integer(Time) -> @@ -458,27 +421,27 @@ make_busy(Node, Time) when is_integer(Time) -> Data = make_busy_data(), %% first make port busy Pid = spawn_link(fun () -> - forever(fun () -> - dport_reg_send(Node, - '__noone__', - Data) - end) - end), + forever(fun () -> + dport_reg_send(Node, + '__noone__', + Data) + end) + end), receive after Own -> ok end, until(fun () -> - case process_info(Pid, status) of - {status, suspended} -> true; - _ -> false - end - end), + case process_info(Pid, status) of + {status, suspended} -> true; + _ -> false + end + end), %% then dist entry make_busy(Node, [nosuspend], Data), Pid. make_busy(Node, Opts, Data) -> case erlang:send({'__noone__', Node}, Data, Opts) of - nosuspend -> nosuspend; - _ -> make_busy(Node, Opts, Data) + nosuspend -> nosuspend; + _ -> make_busy(Node, Opts, Data) end. unmake_busy(Pid) -> @@ -491,29 +454,29 @@ do_busy_test(Node, Fun) -> receive after 100 -> ok end, Pinfo = process_info(P, [status, current_function]), unmake_busy(Busy), - ?t:format("~p : ~p~n", [P, Pinfo]), + io:format("~p : ~p~n", [P, Pinfo]), case Pinfo of - undefined -> - receive - {'DOWN', M, process, P, Reason} -> - ?t:format("~p died with exit reason ~p~n", [P, Reason]) - end, - ?t:fail(premature_death); - _ -> - %% Don't match arity; it is different in debug and - %% optimized emulator - [{status, suspended}, - {current_function, {erlang, bif_return_trap, _}}] = Pinfo, - receive - {'DOWN', M, process, P, Reason} -> - ?t:format("~p died with exit reason ~p~n", [P, Reason]), - normal = Reason - end + undefined -> + receive + {'DOWN', M, process, P, Reason} -> + io:format("~p died with exit reason ~p~n", [P, Reason]) + end, + ct:fail(premature_death); + _ -> + %% Don't match arity; it is different in debug and + %% optimized emulator + [{status, suspended}, + {current_function, {erlang, bif_return_trap, _}}] = Pinfo, + receive + {'DOWN', M, process, P, Reason} -> + io:format("~p died with exit reason ~p~n", [P, Reason]), + normal = Reason + end end. remote_is_process_alive(Pid) -> rpc:call(node(Pid), erlang, is_process_alive, - [Pid]). + [Pid]). joey_killer(Pid) -> exit(Pid, joey_said_die), @@ -535,234 +498,227 @@ sink(Name) -> sink1() -> receive - _Any -> sink1() + _Any -> sink1() end. -lost_exit(doc) -> - "Test that EXIT and DOWN messages send to another node are not lost if " - "the distribution port is busy."; +%% Test that EXIT and DOWN messages send to another node are not lost if +%% the distribution port is busy. lost_exit(Config) when is_list(Config) -> - ?line {ok, Node} = start_node(lost_exit), + {ok, Node} = start_node(lost_exit), Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of - "true" -> start_busy_dist_port_tracer(); - _ -> false - end, + "true" -> start_busy_dist_port_tracer(); + _ -> false + end, Self = self(), Die = make_ref(), - ?line R1 = spawn(fun () -> receive after infinity -> ok end end), - ?line MR1 = erlang:monitor(process, R1), - - ?line {L1, ML1} = spawn_monitor(fun() -> - link(R1), - Self ! {self(), linked}, - receive - Die -> - exit(controlled_suicide) - end - end), - - ?line R2 = spawn(fun () -> - M = erlang:monitor(process, L1), - receive - {'DOWN', M, process, L1, R} -> - Self ! {self(), got_down_message, L1, R} - end - end), - - ?line receive {L1, linked} -> ok end, - + R1 = spawn(fun () -> receive after infinity -> ok end end), + MR1 = erlang:monitor(process, R1), + + {L1, ML1} = spawn_monitor(fun() -> + link(R1), + Self ! {self(), linked}, + receive + Die -> + exit(controlled_suicide) + end + end), + + R2 = spawn(fun () -> + M = erlang:monitor(process, L1), + receive + {'DOWN', M, process, L1, R} -> + Self ! {self(), got_down_message, L1, R} + end + end), + + receive {L1, linked} -> ok end, + Busy = make_busy(Node, 2000), receive after 100 -> ok end, L1 ! Die, - ?line receive - {'DOWN', ML1, process, L1, RL1} -> - ?line controlled_suicide = RL1 - end, + receive + {'DOWN', ML1, process, L1, RL1} -> + controlled_suicide = RL1 + end, receive after 500 -> ok end, unmake_busy(Busy), - ?line receive - {'DOWN', MR1, process, R1, RR1} -> - ?line controlled_suicide = RR1 - end, - - ?line receive - {R2, got_down_message, L1, RR2} -> - ?line controlled_suicide = RR2 - end, + receive + {'DOWN', MR1, process, R1, RR1} -> + controlled_suicide = RR1 + end, + + receive + {R2, got_down_message, L1, RR2} -> + controlled_suicide = RR2 + end, %% Done. - ?line stop_busy_dist_port_tracer(Tracer), - ?line stop_node(Node), + stop_busy_dist_port_tracer(Tracer), + stop_node(Node), ok. dummy_waiter() -> receive after infinity -> - ok + ok end. -link_to_dead(doc) -> - ["Test that linking to a dead remote process gives an EXIT message ", - "AND that the link is teared down."]; +%% Test that linking to a dead remote process gives an EXIT message +%% AND that the link is teared down. link_to_dead(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line {ok, Node} = start_node(link_to_dead), -% ?line monitor_node(Node, true), - ?line net_adm:ping(Node), %% Ts_cross_server workaround. - ?line Pid = spawn(Node, ?MODULE, dead_process, []), + process_flag(trap_exit, true), + {ok, Node} = start_node(link_to_dead), + % monitor_node(Node, true), + net_adm:ping(Node), %% Ts_cross_server workaround. + Pid = spawn(Node, ?MODULE, dead_process, []), receive after 5000 -> ok end, - ?line link(Pid), - ?line receive - {'EXIT', Pid, noproc} -> - ok; - Other -> - ?line test_server:fail({unexpected_message, Other}) - after 5000 -> - ?line test_server:fail(nothing_received) - end, - ?line {links, Links} = process_info(self(), links), - ?line io:format("Pid=~p, links=~p", [Pid, Links]), - ?line false = lists:member(Pid, Links), - ?line stop_node(Node), - ?line receive - Message -> - ?line test_server:fail({unexpected_message, Message}) - after 3000 -> - ok - end, + link(Pid), + receive + {'EXIT', Pid, noproc} -> + ok; + Other -> + ct:fail({unexpected_message, Other}) + after 5000 -> + ct:fail(nothing_received) + end, + {links, Links} = process_info(self(), links), + io:format("Pid=~p, links=~p", [Pid, Links]), + false = lists:member(Pid, Links), + stop_node(Node), + receive + Message -> + ct:fail({unexpected_message, Message}) + after 3000 -> + ok + end, ok. - + dead_process() -> erlang:error(die). -link_to_dead_new_node(doc) -> - ["Test that linking to a pid on node that has gone and restarted gives ", - "the correct EXIT message (OTP-2304)."]; +%% Test that linking to a pid on node that has gone and restarted gives +%% the correct EXIT message (OTP-2304). link_to_dead_new_node(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), + process_flag(trap_exit, true), %% Start the node, get a Pid and stop the node again. - ?line {ok, Node} = start_node(link_to_dead_new_node), - ?line Pid = spawn(Node, ?MODULE, dead_process, []), - ?line stop_node(Node), + {ok, Node} = start_node(link_to_dead_new_node), + Pid = spawn(Node, ?MODULE, dead_process, []), + stop_node(Node), %% Start a new node with the same name. - ?line {ok, Node} = start_node(link_to_dead_new_node), - ?line link(Pid), - ?line receive - {'EXIT', Pid, noproc} -> - ok; - Other -> - ?line test_server:fail({unexpected_message, Other}) - after 5000 -> - ?line test_server:fail(nothing_received) - end, + {ok, Node} = start_node(link_to_dead_new_node), + link(Pid), + receive + {'EXIT', Pid, noproc} -> + ok; + Other -> + ct:fail({unexpected_message, Other}) + after 5000 -> + ct:fail(nothing_received) + end, %% Make sure that the link wasn't created. - ?line {links, Links} = process_info(self(), links), - ?line io:format("Pid=~p, links=~p", [Pid, Links]), - ?line false = lists:member(Pid, Links), - ?line stop_node(Node), - ?line receive - Message -> - ?line test_server:fail({unexpected_message, Message}) - after 3000 -> - ok - end, + {links, Links} = process_info(self(), links), + io:format("Pid=~p, links=~p", [Pid, Links]), + false = lists:member(Pid, Links), + stop_node(Node), + receive + Message -> + ct:fail({unexpected_message, Message}) + after 3000 -> + ok + end, ok. -applied_monitor_node(doc) -> - "Test that monitor_node/2 works when applied."; +%% Test that monitor_node/2 works when applied. applied_monitor_node(Config) when is_list(Config) -> - ?line NonExisting = list_to_atom("__non_existing__@" ++ hostname()), + NonExisting = list_to_atom("__non_existing__@" ++ hostname()), %% Tail-recursive call to apply (since the node is non-existing, %% there will be a trap). - ?line true = tail_apply(erlang, monitor_node, [NonExisting, true]), - ?line [{nodedown, NonExisting}] = test_server:messages_get(), + true = tail_apply(erlang, monitor_node, [NonExisting, true]), + [{nodedown, NonExisting}] = test_server:messages_get(), %% Ordinary call (with trap). - ?line true = apply(erlang, monitor_node, [NonExisting, true]), - ?line [{nodedown, NonExisting}] = test_server:messages_get(), - + true = apply(erlang, monitor_node, [NonExisting, true]), + [{nodedown, NonExisting}] = test_server:messages_get(), + ok. tail_apply(M, F, A) -> apply(M, F, A). -ref_port_roundtrip(doc) -> - "Test that sending a port or reference to another node and back again " - "doesn't correct them in any way."; +%% Test that sending a port or reference to another node and back again +%% doesn't correct them in any way. ref_port_roundtrip(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line Port = open_port({spawn, efile}, []), - ?line Ref = make_ref(), - ?line {ok, Node} = start_node(ref_port_roundtrip), - ?line net_adm:ping(Node), - ?line Term = {Port, Ref}, - ?line io:format("Term before: ~p", [show_term(Term)]), - ?line Pid = spawn_link(Node, ?MODULE, roundtrip, [Term]), - ?line receive after 5000 -> ok end, - ?line stop_node(Node), - ?line receive - {'EXIT', Pid, {Port, Ref}} -> - ?line io:format("Term after: ~p", [show_term(Term)]), - ok; - Other -> - ?line io:format("Term after: ~p", [show_term(Term)]), - ?line test_server:fail({unexpected, Other}) - after 10000 -> - ?line test_server:fail(timeout) - end, + process_flag(trap_exit, true), + Port = open_port({spawn, efile}, []), + Ref = make_ref(), + {ok, Node} = start_node(ref_port_roundtrip), + net_adm:ping(Node), + Term = {Port, Ref}, + io:format("Term before: ~p", [show_term(Term)]), + Pid = spawn_link(Node, ?MODULE, roundtrip, [Term]), + receive after 5000 -> ok end, + stop_node(Node), + receive + {'EXIT', Pid, {Port, Ref}} -> + io:format("Term after: ~p", [show_term(Term)]), + ok; + Other -> + io:format("Term after: ~p", [show_term(Term)]), + ct:fail({unexpected, Other}) + after 10000 -> + ct:fail(timeout) + end, ok. roundtrip(Term) -> exit(Term). -nil_roundtrip(doc) -> - "Test that the smallest external term [] aka NIL can be sent to " - "another node node and back again."; +%% Test that the smallest external term [] aka NIL can be sent to +%% another node node and back again. nil_roundtrip(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line {ok, Node} = start_node(nil_roundtrip), - ?line net_adm:ping(Node), - ?line Pid = spawn_link(Node, ?MODULE, bounce, [self()]), - ?line Pid ! [], - ?line receive - [] -> - ?line receive - {'EXIT', Pid, []} -> - ?line stop_node(Node), - ok - end - end. + process_flag(trap_exit, true), + {ok, Node} = start_node(nil_roundtrip), + net_adm:ping(Node), + Pid = spawn_link(Node, ?MODULE, bounce, [self()]), + Pid ! [], + receive + [] -> + receive + {'EXIT', Pid, []} -> + stop_node(Node), + ok + end + end. bounce(Dest) -> receive Msg -> - Dest ! Msg, - exit(Msg) + Dest ! Msg, + exit(Msg) end. show_term(Term) -> binary_to_list(term_to_binary(Term)). -stop_dist(doc) -> - ["Tests behaviour after net_kernel:stop (OTP-2586)."]; +%% Tests behaviour after net_kernel:stop (OTP-2586). stop_dist(Config) when is_list(Config) -> - ?line Str = os:cmd(atom_to_list(lib:progname()) - ++ " -noshell -pa " - ++ ?config(data_dir, Config) - ++ " -s run"), + Str = os:cmd(atom_to_list(lib:progname()) + ++ " -noshell -pa " + ++ proplists:get_value(data_dir, Config) + ++ " -s run"), %% The "true" may be followed by an error report, so ignore anything that %% follows it. - ?line "true\n"++_ = Str, + "true\n"++_ = Str, %% "May fail on FreeBSD due to differently configured name lookup - ask Arndt", %% if you can find him. @@ -770,37 +726,31 @@ stop_dist(Config) when is_list(Config) -> ok. -trap_bif_1(doc) -> - [""]; trap_bif_1(Config) when is_list(Config) -> - ?line {true} = tr1(), + {true} = tr1(), ok. -trap_bif_2(doc) -> - [""]; trap_bif_2(Config) when is_list(Config) -> - ?line {true} = tr2(), + {true} = tr2(), ok. -trap_bif_3(doc) -> - [""]; trap_bif_3(Config) when is_list(Config) -> - ?line {hoo} = tr3(), + {hoo} = tr3(), ok. tr1() -> - ?line NonExisting = 'abc@boromir', - ?line X = erlang:monitor_node(NonExisting, true), + NonExisting = 'abc@boromir', + X = erlang:monitor_node(NonExisting, true), {X}. tr2() -> - ?line NonExisting = 'abc@boromir', - ?line X = apply(erlang, monitor_node, [NonExisting, true]), + NonExisting = 'abc@boromir', + X = apply(erlang, monitor_node, [NonExisting, true]), {X}. tr3() -> - ?line NonExisting = 'abc@boromir', - ?line X = {NonExisting, glirp} ! hoo, + NonExisting = 'abc@boromir', + X = {NonExisting, glirp} ! hoo, {X}. @@ -821,60 +771,61 @@ tr3() -> % * n2 gets pang when pinging n1 % * n2 forces connection by using net_kernel:connect_node (ovverrides) % * n2 gets pong when pinging n1. -dist_auto_connect_once(doc) -> "Test the dist_auto_connect once kernel parameter"; + +%% Test the dist_auto_connect once kernel parameter dist_auto_connect_once(Config) when is_list(Config) -> - ?line Sock = start_relay_node(dist_auto_connect_relay_node,[]), - ?line NN = inet_rpc_nodename(Sock), - ?line Sock2 = start_relay_node(dist_auto_connect_once_node, - "-kernel dist_auto_connect once"), - ?line NN2 = inet_rpc_nodename(Sock2), - ?line {ok,[]} = do_inet_rpc(Sock,erlang,nodes,[]), - ?line {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), - ?line {ok,[NN2]} = do_inet_rpc(Sock,erlang,nodes,[]), - ?line {ok,[NN]} = do_inet_rpc(Sock2,erlang,nodes,[]), - ?line [_,HostPartPeer] = string:tokens(atom_to_list(NN),"@"), - ?line [_,MyHostPart] = string:tokens(atom_to_list(node()),"@"), + Sock = start_relay_node(dist_auto_connect_relay_node,[]), + NN = inet_rpc_nodename(Sock), + Sock2 = start_relay_node(dist_auto_connect_once_node, + "-kernel dist_auto_connect once"), + NN2 = inet_rpc_nodename(Sock2), + {ok,[]} = do_inet_rpc(Sock,erlang,nodes,[]), + {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), + {ok,[NN2]} = do_inet_rpc(Sock,erlang,nodes,[]), + {ok,[NN]} = do_inet_rpc(Sock2,erlang,nodes,[]), + [_,HostPartPeer] = string:tokens(atom_to_list(NN),"@"), + [_,MyHostPart] = string:tokens(atom_to_list(node()),"@"), % Give net_kernel a chance to change the state of the node to up to. - ?line receive after 1000 -> ok end, + receive after 1000 -> ok end, case HostPartPeer of - MyHostPart -> - ?line ok = stop_relay_node(Sock), - ?line {ok,pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]); - _ -> - ?line {ok, true} = do_inet_rpc(Sock,net_kernel,disconnect,[NN2]), - receive - after 500 -> ok - end + MyHostPart -> + ok = stop_relay_node(Sock), + {ok,pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]); + _ -> + {ok, true} = do_inet_rpc(Sock,net_kernel,disconnect,[NN2]), + receive + after 500 -> ok + end end, - ?line {ok, []} = do_inet_rpc(Sock2,erlang,nodes,[]), + {ok, []} = do_inet_rpc(Sock2,erlang,nodes,[]), Sock3 = case HostPartPeer of - MyHostPart -> - ?line start_relay_node(dist_auto_connect_relay_node,[]); - _ -> - Sock - end, - ?line TS1 = timestamp(), - ?line {ok, pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]), - ?line TS2 = timestamp(), + MyHostPart -> + start_relay_node(dist_auto_connect_relay_node,[]); + _ -> + Sock + end, + TS1 = timestamp(), + {ok, pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]), + TS2 = timestamp(), RefT = net_kernel:connecttime() - 1000, - ?line true = ((TS2 - TS1) < RefT), - ?line TS3 = timestamp(), - ?line {ok, true} = do_inet_rpc(Sock2,erlang,monitor_node, - [NN,true,[allow_passive_connect]]), - ?line TS4 = timestamp(), - ?line true = ((TS4 - TS3) > RefT), - ?line {ok, pong} = do_inet_rpc(Sock3,net_adm,ping,[NN2]), - ?line {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), - ?line {ok, true} = do_inet_rpc(Sock3,net_kernel,disconnect,[NN2]), + true = ((TS2 - TS1) < RefT), + TS3 = timestamp(), + {ok, true} = do_inet_rpc(Sock2,erlang,monitor_node, + [NN,true,[allow_passive_connect]]), + TS4 = timestamp(), + true = ((TS4 - TS3) > RefT), + {ok, pong} = do_inet_rpc(Sock3,net_adm,ping,[NN2]), + {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), + {ok, true} = do_inet_rpc(Sock3,net_kernel,disconnect,[NN2]), receive after 500 -> ok end, - ?line {ok, pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]), - ?line {ok, true} = do_inet_rpc(Sock2,net_kernel,connect_node,[NN]), - ?line {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), - ?line stop_relay_node(Sock3), - ?line stop_relay_node(Sock2). - + {ok, pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]), + {ok, true} = do_inet_rpc(Sock2,net_kernel,connect_node,[NN]), + {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), + stop_relay_node(Sock3), + stop_relay_node(Sock2). + %% Start a relay node and a lonely (dist_auto_connect never) node. @@ -883,51 +834,51 @@ dist_auto_connect_once(Config) when is_list(Config) -> %% Result is sent here through relay node. dist_auto_connect_never(Config) when is_list(Config) -> Self = self(), - ?line {ok, RelayNode} = - start_node(dist_auto_connect_relay), - ?line spawn(RelayNode, - fun() -> - register(dist_auto_connect_relay, self()), - dist_auto_connect_relay(Self) - end), - ?line {ok, Handle} = dist_auto_connect_start(dist_auto_connect, never), - ?line Result = - receive - {do_dist_auto_connect, ok} -> - ok; - {do_dist_auto_connect, Error} -> - {error, Error}; - Other -> - {error, Other} - after 32000 -> - timeout - end, - ?line stop_node(RelayNode), - ?line Stopped = dist_auto_connect_stop(Handle), - ?line Junk = - receive - {do_dist_auto_connect, _} = J -> - J - after 0 -> - ok - end, - ?line {ok, ok, ok} = {Result, Stopped, Junk}, + {ok, RelayNode} = + start_node(dist_auto_connect_relay), + spawn(RelayNode, + fun() -> + register(dist_auto_connect_relay, self()), + dist_auto_connect_relay(Self) + end), + {ok, Handle} = dist_auto_connect_start(dist_auto_connect, never), + Result = + receive + {do_dist_auto_connect, ok} -> + ok; + {do_dist_auto_connect, Error} -> + {error, Error}; + Other -> + {error, Other} + after 32000 -> + timeout + end, + stop_node(RelayNode), + Stopped = dist_auto_connect_stop(Handle), + Junk = + receive + {do_dist_auto_connect, _} = J -> + J + after 0 -> + ok + end, + {ok, ok, ok} = {Result, Stopped, Junk}, ok. do_dist_auto_connect([never]) -> Node = list_to_atom("dist_auto_connect_relay@" ++ hostname()), io:format("~p:do_dist_auto_connect([false]) Node=~p~n", - [?MODULE, Node]), + [?MODULE, Node]), Ping = net_adm:ping(Node), io:format("~p:do_dist_auto_connect([false]) Ping=~p~n", - [?MODULE, Ping]), + [?MODULE, Ping]), Result = case Ping of - pang -> ok; - _ -> {error, Ping} - end, + pang -> ok; + _ -> {error, Ping} + end, io:format("~p:do_dist_auto_connect([false]) Result=~p~n", - [?MODULE, Result]), + [?MODULE, Result]), net_kernel:connect_node(Node), catch {dist_auto_connect_relay, Node} ! {do_dist_auto_connect, Result}; % receive after 1000 -> ok end, @@ -935,10 +886,10 @@ do_dist_auto_connect([never]) -> do_dist_auto_connect(Arg) -> io:format("~p:do_dist_auto_connect(~p)~n", - [?MODULE, Arg]), + [?MODULE, Arg]), receive after 10000 -> ok end, halt(). - + dist_auto_connect_start(Name, Value) when is_atom(Name) -> dist_auto_connect_start(atom_to_list(Name), Value); @@ -948,16 +899,16 @@ dist_auto_connect_start(Name, Value) when is_list(Name), is_atom(Value) -> ValueStr = atom_to_list(Value), Cookie = atom_to_list(erlang:get_cookie()), Cmd = lists:concat( - [%"xterm -e ", - atom_to_list(lib:progname()), -% " -noinput ", - " -detached ", - long_or_short(), " ", Name, - " -setcookie ", Cookie, - " -pa ", ModuleDir, - " -s ", atom_to_list(?MODULE), - " do_dist_auto_connect ", ValueStr, - " -kernel dist_auto_connect ", ValueStr]), + [%"xterm -e ", + atom_to_list(lib:progname()), + % " -noinput ", + " -detached ", + long_or_short(), " ", Name, + " -setcookie ", Cookie, + " -pa ", ModuleDir, + " -s ", atom_to_list(?MODULE), + " do_dist_auto_connect ", ValueStr, + " -kernel dist_auto_connect ", ValueStr]), io:format("~p:dist_auto_connect_start() cmd: ~p~n", [?MODULE, Cmd]), Port = open_port({spawn, Cmd}, [stream]), {ok, {Port, Node}}. @@ -975,102 +926,83 @@ dist_auto_connect_stop(Port, _Node, Pid, N) when is_integer(N), N =< 0 -> Result; dist_auto_connect_stop(Port, Node, Pid, N) when is_integer(N) -> case net_adm:ping(Node) of - pong -> - receive after 100 -> ok end, - dist_auto_connect_stop(Port, Node, Pid, N-100); - pang -> - exit(Pid, normal), - catch erlang:port_close(Port), - io:format("~p:dist_auto_connect_stop() ok~n", [?MODULE]), - ok + pong -> + receive after 100 -> ok end, + dist_auto_connect_stop(Port, Node, Pid, N-100); + pang -> + exit(Pid, normal), + catch erlang:port_close(Port), + io:format("~p:dist_auto_connect_stop() ok~n", [?MODULE]), + ok end. dist_auto_connect_relay(Parent) -> receive X -> - catch Parent ! X + catch Parent ! X end, dist_auto_connect_relay(Parent). -dist_parallel_send(doc) -> - []; -dist_parallel_send(suite) -> - []; dist_parallel_send(Config) when is_list(Config) -> - ?line {ok, RNode} = start_node(dist_parallel_receiver), - ?line {ok, SNode} = start_node(dist_parallel_sender), - ?line WatchDog = spawn_link( - fun () -> - TRef = erlang:start_timer((?DEFAULT_TIMETRAP - div 2), - self(), - oops), - receive - {timeout, TRef, _ } -> - spawn(SNode, - fun () -> - abort(timeout) - end), - spawn(RNode, - fun () -> - abort(timeout) - end) -%% rpc:cast(SNode, erlang, halt, -%% ["Timetrap (sender)"]), -%% rpc:cast(RNode, erlang, halt, -%% ["Timetrap (receiver)"]) - end - end), - ?line MkSndrs = fun (Receiver) -> - lists:map(fun (_) -> - spawn_link(SNode, - ?MODULE, - dist_parallel_sender, - [self(), - Receiver, - 1000]) - end, - lists:seq(1, 64)) - end, - ?line SndrsStart = fun (Sndrs) -> - Parent = self(), - spawn_link( - SNode, - fun () -> - lists:foreach(fun (P) -> - P ! {go, Parent} - end, - Sndrs) - end) - end, - ?line SndrsWait = fun (Sndrs) -> - lists:foreach(fun (P) -> - receive {P, done} -> ok end - end, - Sndrs) - end, - ?line DPR = spawn_link(RNode, ?MODULE, dist_parallel_receiver, []), - ?line Sndrs1 = MkSndrs(DPR), - ?line SndrsStart(Sndrs1), - ?line SndrsWait(Sndrs1), - ?line unlink(DPR), - ?line exit(DPR, bang), - - ?line DEPR = spawn_link(RNode, ?MODULE, dist_evil_parallel_receiver, []), - ?line Sndrs2 = MkSndrs(DEPR), - ?line SndrsStart(Sndrs2), - ?line SndrsWait(Sndrs2), - ?line unlink(DEPR), - ?line exit(DEPR, bang), - - ?line unlink(WatchDog), - ?line exit(WatchDog, bang), - - ?line stop_node(RNode), - ?line stop_node(SNode), - - ?line ok. + {ok, RNode} = start_node(dist_parallel_receiver), + {ok, SNode} = start_node(dist_parallel_sender), + WatchDog = spawn_link( + fun () -> + TRef = erlang:start_timer((2*60*1000), self(), oops), + receive + {timeout, TRef, _ } -> + spawn(SNode, fun () -> abort(timeout) end), + spawn(RNode, fun () -> abort(timeout) end) + %% rpc:cast(SNode, erlang, halt, + %% ["Timetrap (sender)"]), + %% rpc:cast(RNode, erlang, halt, + %% ["Timetrap (receiver)"]) + end + end), + MkSndrs = fun (Receiver) -> + lists:map(fun (_) -> + spawn_link(SNode, + ?MODULE, + dist_parallel_sender, + [self(), Receiver, 1000]) + end, lists:seq(1, 64)) + end, + SndrsStart = fun (Sndrs) -> + Parent = self(), + spawn_link(SNode, + fun () -> + lists:foreach(fun (P) -> + P ! {go, Parent} + end, Sndrs) + end) + end, + SndrsWait = fun (Sndrs) -> + lists:foreach(fun (P) -> + receive {P, done} -> ok end + end, Sndrs) + end, + DPR = spawn_link(RNode, ?MODULE, dist_parallel_receiver, []), + Sndrs1 = MkSndrs(DPR), + SndrsStart(Sndrs1), + SndrsWait(Sndrs1), + unlink(DPR), + exit(DPR, bang), + + DEPR = spawn_link(RNode, ?MODULE, dist_evil_parallel_receiver, []), + Sndrs2 = MkSndrs(DEPR), + SndrsStart(Sndrs2), + SndrsWait(Sndrs2), + unlink(DEPR), + exit(DEPR, bang), + + unlink(WatchDog), + exit(WatchDog, bang), + + stop_node(RNode), + stop_node(SNode), + + ok. do_dist_parallel_sender(Parent, _Receiver, 0) -> Parent ! {self(), done}; @@ -1092,71 +1024,72 @@ dist_evil_parallel_receiver() -> dist_evil_parallel_receiver(). atom_roundtrip(Config) when is_list(Config) -> - ?line AtomData = atom_data(), - ?line verify_atom_data(AtomData), - ?line {ok, Node} = start_node(Config), - ?line do_atom_roundtrip(Node, AtomData), - ?line stop_node(Node), - ?line ok. + AtomData = atom_data(), + verify_atom_data(AtomData), + {ok, Node} = start_node(Config), + do_atom_roundtrip(Node, AtomData), + stop_node(Node), + ok. atom_roundtrip_r15b(Config) when is_list(Config) -> - case ?t:is_release_available("r15b") of - true -> - ?line AtomData = atom_data(), - ?line verify_atom_data(AtomData), - ?line {ok, Node} = start_node(Config, [], "r15b"), - ?line do_atom_roundtrip(Node, AtomData), - ?line stop_node(Node), - ?line ok; - false -> - ?line {skip,"No OTP R15B available"} + case test_server:is_release_available("r15b") of + true -> + ct:timetrap({minutes, 6}), + AtomData = atom_data(), + verify_atom_data(AtomData), + {ok, Node} = start_node(Config, [], "r15b"), + do_atom_roundtrip(Node, AtomData), + stop_node(Node), + ok; + false -> + {skip,"No OTP R15B available"} end. unicode_atom_roundtrip(Config) when is_list(Config) -> - ?line AtomData = unicode_atom_data(), - ?line verify_atom_data(AtomData), - ?line {ok, Node} = start_node(Config), - ?line do_atom_roundtrip(Node, AtomData), - ?line stop_node(Node), - ?line ok. + AtomData = unicode_atom_data(), + verify_atom_data(AtomData), + {ok, Node} = start_node(Config), + do_atom_roundtrip(Node, AtomData), + stop_node(Node), + ok. do_atom_roundtrip(Node, AtomData) -> - ?line Parent = self(), - ?line Proc = spawn_link(Node, fun () -> verify_atom_data_loop(Parent) end), - ?line Proc ! {self(), AtomData}, - ?line receive {Proc, AD1} -> AtomData = AD1 end, - ?line Proc ! {self(), AtomData}, - ?line receive {Proc, AD2} -> AtomData = AD2 end, - ?line RevAtomData = lists:reverse(AtomData), - ?line Proc ! {self(), RevAtomData}, - ?line receive {Proc, RAD1} -> RevAtomData = RAD1 end, - ?line unlink(Proc), - ?line exit(Proc, bang), - ?line ok. + Parent = self(), + Proc = spawn_link(Node, fun () -> verify_atom_data_loop(Parent) end), + Proc ! {self(), AtomData}, + receive {Proc, AD1} -> AtomData = AD1 end, + Proc ! {self(), AtomData}, + receive {Proc, AD2} -> AtomData = AD2 end, + RevAtomData = lists:reverse(AtomData), + Proc ! {self(), RevAtomData}, + receive {Proc, RAD1} -> RevAtomData = RAD1 end, + unlink(Proc), + exit(Proc, bang), + ok. verify_atom_data_loop(From) -> receive - {From, AtomData} -> - verify_atom_data(AtomData), - From ! {self(), AtomData}, - verify_atom_data_loop(From) + {From, AtomData} -> + verify_atom_data(AtomData), + From ! {self(), AtomData}, + verify_atom_data_loop(From) end. atom_data() -> lists:map(fun (N) -> - ATxt = "a"++integer_to_list(N), - {list_to_atom(ATxt), ATxt} - end, - lists:seq(1, 2000)). + ATxt = "a"++integer_to_list(N), + {list_to_atom(ATxt), ATxt} + end, + lists:seq(1, 2000)). verify_atom_data(AtomData) -> lists:foreach(fun ({Atom, AtomTxt}) when is_atom(Atom) -> - AtomTxt = atom_to_list(Atom); - ({PPR, AtomTxt}) -> - % Pid, Port, or Ref - AtomTxt = atom_to_list(node(PPR)) - end, - AtomData). + AtomTxt = atom_to_list(Atom); + ({PPR, AtomTxt}) -> + % Pid, Port, or Ref + AtomTxt = atom_to_list(node(PPR)) + end, + AtomData). uc_atom_tup(ATxt) -> Atom = string_to_atom(ATxt), @@ -1209,9 +1142,8 @@ unicode_atom_data() -> uc_atom_tup(lists:seq(65500, 65754)), uc_atom_tup(lists:seq(65500, 65563)) | lists:map(fun (N) -> - uc_atom_tup(lists:seq(64000+N, 64254+N)) - end, - lists:seq(1, 2000))]. + uc_atom_tup(lists:seq(64000+N, 64254+N)) + end, lists:seq(1, 2000))]. contended_atom_cache_entry(Config) when is_list(Config) -> contended_atom_cache_entry_test(Config, latin1). @@ -1220,79 +1152,77 @@ contended_unicode_atom_cache_entry(Config) when is_list(Config) -> contended_atom_cache_entry_test(Config, unicode). contended_atom_cache_entry_test(Config, Type) -> - ?line TestServer = self(), - ?line ProcessPairs = 10, - ?line Msgs = 100000, - ?line {ok, SNode} = start_node(Config), - ?line {ok, RNode} = start_node(Config), - ?line Success = make_ref(), - ?line spawn_link( - SNode, - fun () -> - erts_debug:set_internal_state(available_internal_state, - true), - Master = self(), - CIX = get_cix(), - TestAtoms = case Type of - latin1 -> - get_conflicting_atoms(CIX, - ProcessPairs); - unicode -> - get_conflicting_unicode_atoms(CIX, - ProcessPairs) - end, - io:format("Testing with the following atoms all using " - "cache index ~p:~n ~w~n", - [CIX, TestAtoms]), - Ps = lists:map( - fun (A) -> - Ref = make_ref(), - R = spawn_link( - RNode, - fun () -> - Atom = receive - {Ref, txt, ATxt} -> - case Type of - latin1 -> - list_to_atom(ATxt); - unicode -> - string_to_atom(ATxt) - end - end, - receive_ref_atom(Ref, - Atom, - Msgs), - Master ! {self(), success} - end), - S = spawn_link( - SNode, - fun () -> - receive go -> ok end, - R ! {Ref, - txt, - atom_to_list(A)}, - send_ref_atom(R, Ref, A, Msgs) - end), - {S, R} - end, - TestAtoms), - lists:foreach(fun ({S, _}) -> - S ! go - end, - Ps), - lists:foreach(fun ({_, R}) -> - receive {R, success} -> ok end - end, - Ps), - TestServer ! Success - end), - ?line receive - Success -> - ok - end, - ?line stop_node(SNode), - ?line stop_node(RNode), - ?line ok. + TestServer = self(), + ProcessPairs = 10, + Msgs = 100000, + {ok, SNode} = start_node(Config), + {ok, RNode} = start_node(Config), + Success = make_ref(), + spawn_link( + SNode, + fun () -> + erts_debug:set_internal_state(available_internal_state, + true), + Master = self(), + CIX = get_cix(), + TestAtoms = case Type of + latin1 -> + get_conflicting_atoms(CIX, + ProcessPairs); + unicode -> + get_conflicting_unicode_atoms(CIX, + ProcessPairs) + end, + io:format("Testing with the following atoms all using " + "cache index ~p:~n ~w~n", + [CIX, TestAtoms]), + Ps = lists:map( + fun (A) -> + Ref = make_ref(), + R = spawn_link(RNode, + fun () -> + Atom = receive + {Ref, txt, ATxt} -> + case Type of + latin1 -> + list_to_atom(ATxt); + unicode -> + string_to_atom(ATxt) + end + end, + receive_ref_atom(Ref, + Atom, + Msgs), + Master ! {self(), success} + end), + S = spawn_link(SNode, + fun () -> + receive go -> ok end, + R ! {Ref, + txt, + atom_to_list(A)}, + send_ref_atom(R, Ref, A, Msgs) + end), + {S, R} + end, + TestAtoms), + lists:foreach(fun ({S, _}) -> + S ! go + end, + Ps), + lists:foreach(fun ({_, R}) -> + receive {R, success} -> ok end + end, + Ps), + TestServer ! Success + end), + receive + Success -> + ok + end, + stop_node(SNode), + stop_node(RNode), + ok. send_ref_atom(_To, _Ref, _Atom, 0) -> ok; @@ -1304,11 +1234,11 @@ receive_ref_atom(_Ref, _Atom, 0) -> ok; receive_ref_atom(Ref, Atom, N) -> receive - {Ref, Value} -> - Atom = Value + {Ref, Value} -> + Atom = Value end, receive_ref_atom(Ref, Atom, N-1). - + get_cix() -> get_cix(1000). @@ -1316,34 +1246,34 @@ get_cix(CIX) when is_integer(CIX), CIX < 0 -> get_cix(0); get_cix(CIX) when is_integer(CIX) -> get_cix(CIX, - unwanted_cixs(), - erts_debug:get_internal_state(max_atom_out_cache_index)). + unwanted_cixs(), + erts_debug:get_internal_state(max_atom_out_cache_index)). get_cix(CIX, Unwanted, MaxCIX) when CIX > MaxCIX -> get_cix(0, Unwanted, MaxCIX); get_cix(CIX, Unwanted, MaxCIX) -> case lists:member(CIX, Unwanted) of - true -> get_cix(CIX+1, Unwanted, MaxCIX); - false -> CIX + true -> get_cix(CIX+1, Unwanted, MaxCIX); + false -> CIX end. unwanted_cixs() -> lists:map(fun (Node) -> - erts_debug:get_internal_state({atom_out_cache_index, - Node}) - end, - nodes()). - - + erts_debug:get_internal_state({atom_out_cache_index, + Node}) + end, + nodes()). + + get_conflicting_atoms(_CIX, 0) -> []; get_conflicting_atoms(CIX, N) -> 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)]; - _ -> - get_conflicting_atoms(CIX, N) + CIX -> + [Atom|get_conflicting_atoms(CIX, N-1)]; + _ -> + get_conflicting_atoms(CIX, N) end. get_conflicting_unicode_atoms(_CIX, 0) -> @@ -1351,10 +1281,10 @@ get_conflicting_unicode_atoms(_CIX, 0) -> get_conflicting_unicode_atoms(CIX, N) -> 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)]; - _ -> - get_conflicting_unicode_atoms(CIX, N) + CIX -> + [Atom|get_conflicting_unicode_atoms(CIX, N-1)]; + _ -> + get_conflicting_unicode_atoms(CIX, N) end. -define(COOKIE, ''). @@ -1376,482 +1306,474 @@ get_conflicting_unicode_atoms(CIX, N) -> -define(DOP_MONITOR_P_EXIT, 21). start_monitor(Offender,P) -> - ?line Parent = self(), - ?line Q = spawn(Offender, - fun () -> - Ref = erlang:monitor(process,P), - Parent ! {self(),ref,Ref}, - receive - just_stay_alive -> ok - end - end), - ?line Ref = receive - {Q,ref,R} -> - R - after 5000 -> - error - end, + Parent = self(), + Q = spawn(Offender, + fun () -> + Ref = erlang:monitor(process,P), + Parent ! {self(),ref,Ref}, + receive + just_stay_alive -> ok + end + end), + Ref = receive + {Q,ref,R} -> + R + after 5000 -> + error + end, io:format("Ref is ~p~n",[Ref]), ok. start_link(Offender,P) -> - ?line Parent = self(), - ?line Q = spawn(Offender, - fun () -> - process_flag(trap_exit,true), - link(P), - Parent ! {self(),ref,P}, - receive - just_stay_alive -> ok - end - end), - ?line Ref = receive - {Q,ref,R} -> - R - after 5000 -> - error - end, + Parent = self(), + Q = spawn(Offender, + fun () -> + process_flag(trap_exit,true), + link(P), + Parent ! {self(),ref,P}, + receive + just_stay_alive -> ok + end + end), + Ref = receive + {Q,ref,R} -> + R + after 5000 -> + error + end, io:format("Ref is ~p~n",[Ref]), ok. -bad_dist_structure(suite) -> - []; -bad_dist_structure(doc) -> - ["Test dist messages with valid structure (binary to term ok) but malformed" - "control content"]; +%% Test dist messages with valid structure (binary to term ok) but malformed control content bad_dist_structure(Config) when is_list(Config) -> - %process_flag(trap_exit,true), - ODog = ?config(watchdog, Config), - ?t:timetrap_cancel(ODog), - Dog = ?t:timetrap(?t:seconds(15)), - - ?line {ok, Offender} = start_node(bad_dist_structure_offender), - ?line {ok, Victim} = start_node(bad_dist_structure_victim), - ?line start_node_monitors([Offender,Victim]), - ?line Parent = self(), - ?line P = spawn(Victim, - fun () -> - process_flag(trap_exit,true), - Parent ! {self(), started}, - receive check_msgs -> ok end, - bad_dist_struct_check_msgs([one, - two]), - Parent ! {self(), messages_checked}, - receive done -> ok end - end), - ?line receive {P, started} -> ok end, - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line verify_up(Offender, Victim), - ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), - ?line start_monitor(Offender,P), - ?line P ! one, - ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_monitor(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal,normal},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_link(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_LINK},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_link(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_UNLINK,'replace'},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_link(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_UNLINK,'replace',make_ref()},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_link(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_UNLINK,make_ref(),P},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_link(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_UNLINK,normal,normal},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_monitor(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_monitor(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P,normal},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_monitor(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line start_monitor(Offender,P), - ?line send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P,normal},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT,'replace',P},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT,make_ref(),normal,normal},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT_TT,'replace',token,P},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT_TT,make_ref(),token,normal,normal},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT2,'replace',P},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT2,make_ref(),normal,normal},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT2_TT,'replace',token,P},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_EXIT2_TT,make_ref(),token,normal,normal},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace'},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace','atomic'},2), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace',P},0), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name},2,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name,token},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace',''},2,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',P},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name,{token}},2,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_SEND_TT,'',P},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_SEND_TT,'',name,token},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_SEND,''},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_SEND,'',name},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line send_bad_structure(Offender, P,{?DOP_SEND,'',P,{token}},0,{message}), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line P ! two, - ?line P ! check_msgs, - ?line receive - {P, messages_checked} -> ok - after 5000 -> - exit(victim_is_dead) - end, - - ?line {message_queue_len, 0} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - - ?line unlink(P), - ?line P ! done, - ?line stop_node(Offender), - ?line stop_node(Victim), - ?t:timetrap_cancel(Dog), + ct:timetrap({seconds, 15}), + + {ok, Offender} = start_node(bad_dist_structure_offender), + {ok, Victim} = start_node(bad_dist_structure_victim), + start_node_monitors([Offender,Victim]), + Parent = self(), + P = spawn(Victim, + fun () -> + process_flag(trap_exit,true), + Parent ! {self(), started}, + receive check_msgs -> ok end, + bad_dist_struct_check_msgs([one, + two]), + Parent ! {self(), messages_checked}, + receive done -> ok end + end), + receive {P, started} -> ok end, + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), + start_monitor(Offender,P), + P ! one, + send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_monitor(Offender,P), + send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal,normal},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_link(Offender,P), + send_bad_structure(Offender, P,{?DOP_LINK},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_link(Offender,P), + send_bad_structure(Offender, P,{?DOP_UNLINK,'replace'},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_link(Offender,P), + send_bad_structure(Offender, P,{?DOP_UNLINK,'replace',make_ref()},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_link(Offender,P), + send_bad_structure(Offender, P,{?DOP_UNLINK,make_ref(),P},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_link(Offender,P), + send_bad_structure(Offender, P,{?DOP_UNLINK,normal,normal},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_monitor(Offender,P), + send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_monitor(Offender,P), + send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P,normal},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_monitor(Offender,P), + send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + start_monitor(Offender,P), + send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P,normal},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT,'replace',P},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT,make_ref(),normal,normal},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT_TT,'replace',token,P},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT_TT,make_ref(),token,normal,normal},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT2,'replace',P},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT2,make_ref(),normal,normal},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT2_TT,'replace',token,P},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_EXIT2_TT,make_ref(),token,normal,normal},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace'},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace','atomic'},2), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace',P},0), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name},2,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name,token},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace',''},2,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',P},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name,{token}},2,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_SEND_TT,'',P},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_SEND_TT,'',name,token},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_SEND,''},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_SEND,'',name},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + send_bad_structure(Offender, P,{?DOP_SEND,'',P,{token}},0,{message}), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + P ! two, + P ! check_msgs, + receive + {P, messages_checked} -> ok + after 5000 -> + exit(victim_is_dead) + end, + + {message_queue_len, 0} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + unlink(P), + P ! done, + stop_node(Offender), + stop_node(Victim), ok. bad_dist_ext_receive(Config) when is_list(Config) -> - ?line {ok, Offender} = start_node(bad_dist_ext_receive_offender), - ?line {ok, Victim} = start_node(bad_dist_ext_receive_victim), - ?line start_node_monitors([Offender,Victim]), - - ?line Parent = self(), - - ?line P = spawn_link(Victim, - fun () -> - Parent ! {self(), started}, - receive check_msgs -> ok end, - bad_dist_ext_check_msgs([one, - two, - three]), - Parent ! {self(), messages_checked}, - receive done -> ok end - end), - - ?line receive {P, started} -> ok end, - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line verify_up(Offender, Victim), - ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), - ?line P ! one, - ?line send_bad_msg(Offender, P), - ?line P ! two, - ?line verify_down(Offender, connection_closed, Victim, killed), - ?line {message_queue_len, 2} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - - ?line Suspended = make_ref(), - ?line S = spawn(Victim, - fun () -> - erlang:suspend_process(P), - Parent ! Suspended, - receive after infinity -> ok end - end), - ?line MS = erlang:monitor(process, S), - ?line receive Suspended -> ok end, - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line verify_up(Offender, Victim), - ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), - ?line send_bad_msgs(Offender, P, 5), - ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), - ?line P ! three, - ?line send_bad_msgs(Offender, P, 5), + {ok, Offender} = start_node(bad_dist_ext_receive_offender), + {ok, Victim} = start_node(bad_dist_ext_receive_victim), + start_node_monitors([Offender,Victim]), + + Parent = self(), + + P = spawn_link(Victim, + fun () -> + Parent ! {self(), started}, + receive check_msgs -> ok end, + bad_dist_ext_check_msgs([one, + two, + three]), + Parent ! {self(), messages_checked}, + receive done -> ok end + end), + + receive {P, started} -> ok end, + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), + P ! one, + send_bad_msg(Offender, P), + P ! two, + verify_down(Offender, connection_closed, Victim, killed), + {message_queue_len, 2} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + Suspended = make_ref(), + S = spawn(Victim, + fun () -> + erlang:suspend_process(P), + Parent ! Suspended, + receive after infinity -> ok end + end), + MS = erlang:monitor(process, S), + receive Suspended -> ok end, + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), + send_bad_msgs(Offender, P, 5), + true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), + P ! three, + send_bad_msgs(Offender, P, 5), %% Make sure bad msgs has reached Victim - ?line rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), - - ?line verify_still_up(Offender, Victim), - ?line {message_queue_len, 13} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - - ?line exit(S, bang), - ?line receive {'DOWN', MS, process, S, bang} -> ok end, - ?line verify_down(Offender, connection_closed, Victim, killed), - ?line {message_queue_len, 3} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - - ?line P ! check_msgs, - ?line receive {P, messages_checked} -> ok end, - - ?line {message_queue_len, 0} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - - ?line P ! done, - ?line unlink(P), - ?line verify_no_down(Offender, Victim), - ?line stop_node(Offender), - ?line stop_node(Victim). + rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), + + verify_still_up(Offender, Victim), + {message_queue_len, 13} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + exit(S, bang), + receive {'DOWN', MS, process, S, bang} -> ok end, + verify_down(Offender, connection_closed, Victim, killed), + {message_queue_len, 3} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + P ! check_msgs, + receive {P, messages_checked} -> ok end, + + {message_queue_len, 0} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + P ! done, + unlink(P), + verify_no_down(Offender, Victim), + stop_node(Offender), + stop_node(Victim). bad_dist_ext_process_info(Config) when is_list(Config) -> - ?line {ok, Offender} = start_node(bad_dist_ext_process_info_offender), - ?line {ok, Victim} = start_node(bad_dist_ext_process_info_victim), - ?line start_node_monitors([Offender,Victim]), - - ?line Parent = self(), - ?line P = spawn_link(Victim, - fun () -> - Parent ! {self(), started}, - receive check_msgs -> ok end, - bad_dist_ext_check_msgs([one, two]), - Parent ! {self(), messages_checked}, - receive done -> ok end - end), - - ?line receive {P, started} -> ok end, - ?line P ! one, - - ?line Suspended = make_ref(), - ?line S = spawn(Victim, - fun () -> - erlang:suspend_process(P), - Parent ! Suspended, - receive after infinity -> ok end - end), - - ?line receive Suspended -> ok end, - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line verify_up(Offender, Victim), - ?line send_bad_msgs(Offender, P, 5), - - ?line P ! two, - ?line send_bad_msgs(Offender, P, 5), + {ok, Offender} = start_node(bad_dist_ext_process_info_offender), + {ok, Victim} = start_node(bad_dist_ext_process_info_victim), + start_node_monitors([Offender,Victim]), + + Parent = self(), + P = spawn_link(Victim, + fun () -> + Parent ! {self(), started}, + receive check_msgs -> ok end, + bad_dist_ext_check_msgs([one, two]), + Parent ! {self(), messages_checked}, + receive done -> ok end + end), + + receive {P, started} -> ok end, + P ! one, + + Suspended = make_ref(), + S = spawn(Victim, + fun () -> + erlang:suspend_process(P), + Parent ! Suspended, + receive after infinity -> ok end + end), + + receive Suspended -> ok end, + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + send_bad_msgs(Offender, P, 5), + + P ! two, + send_bad_msgs(Offender, P, 5), %% Make sure bad msgs has reached Victim - ?line rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), - - ?line verify_still_up(Offender, Victim), - ?line {message_queue_len, 12} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - ?line verify_still_up(Offender, Victim), - ?line [{message_queue_len, 2}, - {messages, [one, two]}] - = rpc:call(Victim, erlang, process_info, [P, [message_queue_len, - messages]]), - ?line verify_down(Offender, connection_closed, Victim, killed), - - ?line P ! check_msgs, - ?line exit(S, bang), - ?line receive {P, messages_checked} -> ok end, - - ?line {message_queue_len, 0} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - - ?line P ! done, - ?line unlink(P), - ?line verify_no_down(Offender, Victim), - ?line stop_node(Offender), - ?line stop_node(Victim). + rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), + + verify_still_up(Offender, Victim), + {message_queue_len, 12} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + verify_still_up(Offender, Victim), + [{message_queue_len, 2}, + {messages, [one, two]}] + = rpc:call(Victim, erlang, process_info, [P, [message_queue_len, + messages]]), + verify_down(Offender, connection_closed, Victim, killed), + + P ! check_msgs, + exit(S, bang), + receive {P, messages_checked} -> ok end, + + {message_queue_len, 0} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + P ! done, + unlink(P), + verify_no_down(Offender, Victim), + stop_node(Offender), + stop_node(Victim). bad_dist_ext_control(Config) when is_list(Config) -> - ?line {ok, Offender} = start_node(bad_dist_ext_control_offender), - ?line {ok, Victim} = start_node(bad_dist_ext_control_victim), - ?line start_node_monitors([Offender,Victim]), + {ok, Offender} = start_node(bad_dist_ext_control_offender), + {ok, Victim} = start_node(bad_dist_ext_control_victim), + start_node_monitors([Offender,Victim]), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line verify_up(Offender, Victim), - ?line send_bad_dhdr(Offender, Victim), - ?line verify_down(Offender, connection_closed, Victim, killed), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + send_bad_dhdr(Offender, Victim), + verify_down(Offender, connection_closed, Victim, killed), - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line verify_up(Offender, Victim), - ?line send_bad_ctl(Offender, Victim), - ?line verify_down(Offender, connection_closed, Victim, killed), + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + send_bad_ctl(Offender, Victim), + verify_down(Offender, connection_closed, Victim, killed), - ?line verify_no_down(Offender, Victim), - ?line stop_node(Offender), - ?line stop_node(Victim). + verify_no_down(Offender, Victim), + stop_node(Offender), + stop_node(Victim). bad_dist_ext_connection_id(Config) when is_list(Config) -> - ?line {ok, Offender} = start_node(bad_dist_ext_connection_id_offender), - ?line {ok, Victim} = start_node(bad_dist_ext_connection_id_victim), - ?line start_node_monitors([Offender,Victim]), - - ?line Parent = self(), - ?line P = spawn_link(Victim, - fun () -> - Parent ! {self(), started}, - receive check_msgs -> ok end, - bad_dist_ext_check_msgs([]), - Parent ! {self(), messages_checked}, - receive done -> ok end - end), - - ?line receive {P, started} -> ok end, - ?line Suspended = make_ref(), - ?line S = spawn(Victim, - fun () -> - erlang:suspend_process(P), - Parent ! Suspended, - receive after infinity -> ok end - end), - ?line MS = erlang:monitor(process, S), - ?line receive Suspended -> ok end, - ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), - ?line verify_up(Offender, Victim), - ?line send_bad_msg(Offender, P), + {ok, Offender} = start_node(bad_dist_ext_connection_id_offender), + {ok, Victim} = start_node(bad_dist_ext_connection_id_victim), + start_node_monitors([Offender,Victim]), + + Parent = self(), + P = spawn_link(Victim, + fun () -> + Parent ! {self(), started}, + receive check_msgs -> ok end, + bad_dist_ext_check_msgs([]), + Parent ! {self(), messages_checked}, + receive done -> ok end + end), + + receive {P, started} -> ok end, + Suspended = make_ref(), + S = spawn(Victim, + fun () -> + erlang:suspend_process(P), + Parent ! Suspended, + receive after infinity -> ok end + end), + MS = erlang:monitor(process, S), + receive Suspended -> ok end, + pong = rpc:call(Victim, net_adm, ping, [Offender]), + verify_up(Offender, Victim), + send_bad_msg(Offender, P), %% Make sure bad msg has reached Victim - ?line rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), + rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), - ?line {message_queue_len, 1} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + {message_queue_len, 1} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - ?line true = rpc:call(Offender, net_kernel, disconnect, [Victim]), - ?line verify_down(Offender, disconnect, Victim, connection_closed), - ?line pong = rpc:call(Offender, net_adm, ping, [Victim]), + true = rpc:call(Offender, net_kernel, disconnect, [Victim]), + verify_down(Offender, disconnect, Victim, connection_closed), + pong = rpc:call(Offender, net_adm, ping, [Victim]), - ?line verify_up(Offender, Victim), + verify_up(Offender, Victim), %% We have a new connection between Offender and Victim, bad message %% should not bring it down. - ?line {message_queue_len, 1} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + {message_queue_len, 1} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - ?line exit(S, bang), - ?line receive {'DOWN', MS, process, S, bang} -> ok end, + exit(S, bang), + receive {'DOWN', MS, process, S, bang} -> ok end, %% Wait for a while (if the connection is taken down it might take a %% while). - ?line receive after 2000 -> ok end, - ?line verify_still_up(Offender, Victim), + receive after 2000 -> ok end, + verify_still_up(Offender, Victim), + + P ! check_msgs, + receive {P, messages_checked} -> ok end, - ?line P ! check_msgs, - ?line receive {P, messages_checked} -> ok end, + {message_queue_len, 0} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - ?line {message_queue_len, 0} - = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), - - ?line verify_still_up(Offender, Victim), - ?line P ! done, - ?line unlink(P), - ?line verify_no_down(Offender, Victim), - ?line stop_node(Offender), - ?line stop_node(Victim). + verify_still_up(Offender, Victim), + P ! done, + unlink(P), + verify_no_down(Offender, Victim), + stop_node(Offender), + stop_node(Victim). bad_dist_struct_check_msgs([]) -> receive - Msg -> - exit({unexpected_message, Msg}) + Msg -> + exit({unexpected_message, Msg}) after 0 -> - ok + ok end; bad_dist_struct_check_msgs([M|Ms]) -> receive - {'EXIT',_,_} = EM -> - io:format("Ignoring exit message: ~p~n",[EM]), - bad_dist_struct_check_msgs([M|Ms]); - Msg -> - M = Msg, - bad_dist_struct_check_msgs(Ms) + {'EXIT',_,_} = EM -> + io:format("Ignoring exit message: ~p~n",[EM]), + bad_dist_struct_check_msgs([M|Ms]); + Msg -> + M = Msg, + bad_dist_struct_check_msgs(Ms) end. bad_dist_ext_check_msgs([]) -> receive - Msg -> - exit({unexpected_message, Msg}) + Msg -> + exit({unexpected_message, Msg}) after 0 -> - ok + ok end; bad_dist_ext_check_msgs([M|Ms]) -> receive - Msg -> - M = Msg, - bad_dist_ext_check_msgs(Ms) + Msg -> + M = Msg, + bad_dist_ext_check_msgs(Ms) end. - + dport_reg_send(Node, Name, Msg) -> DPrt = case dport(Node) of - undefined -> - pong = net_adm:ping(Node), - dport(Node); - Prt -> - Prt - end, + undefined -> + pong = net_adm:ping(Node), + dport(Node); + Prt -> + Prt + end, port_command(DPrt, [dmsg_hdr(), - dmsg_ext({?DOP_REG_SEND, - self(), - ?COOKIE, - Name}), - dmsg_ext(Msg)]). + dmsg_ext({?DOP_REG_SEND, + self(), + ?COOKIE, + Name}), + dmsg_ext(Msg)]). dport_send(To, Msg) -> Node = node(To), DPrt = case dport(Node) of - undefined -> - pong = net_adm:ping(Node), - dport(Node); - Prt -> - Prt - end, + undefined -> + pong = net_adm:ping(Node), + dport(Node); + Prt -> + Prt + end, port_command(DPrt, [dmsg_hdr(), - dmsg_ext({?DOP_SEND, - ?COOKIE, - To}), - dmsg_ext(Msg)]). + dmsg_ext({?DOP_SEND, + ?COOKIE, + To}), + dmsg_ext(Msg)]). send_bad_structure(Offender,Victim,Bad,WhereToPutSelf) -> send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,[]). send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) -> Parent = self(), Done = make_ref(), spawn(Offender, - fun () -> - Node = node(Victim), - pong = net_adm:ping(Node), - DPrt = dport(Node), - Bad1 = case WhereToPutSelf of - 0 -> - Bad; - N when N > 0 -> - setelement(N,Bad,self()) - end, - DData = [dmsg_hdr(), - dmsg_ext(Bad1)] ++ - case PayLoad of - [] -> []; - _Other -> [dmsg_ext(PayLoad)] - end, - port_command(DPrt, DData), - Parent ! {DData,Done} - end), + fun () -> + Node = node(Victim), + pong = net_adm:ping(Node), + DPrt = dport(Node), + Bad1 = case WhereToPutSelf of + 0 -> + Bad; + N when N > 0 -> + setelement(N,Bad,self()) + end, + DData = [dmsg_hdr(), + dmsg_ext(Bad1)] ++ + case PayLoad of + [] -> []; + _Other -> [dmsg_ext(PayLoad)] + end, + port_command(DPrt, DData), + Parent ! {DData,Done} + end), receive - {WhatSent,Done} -> - io:format("Offender sent ~p~n",[WhatSent]), - ok + {WhatSent,Done} -> + io:format("Offender sent ~p~n",[WhatSent]), + ok after 5000 -> - exit(unable_to_send) + exit(unable_to_send) end. - + %% send_bad_msgs(): %% Send a valid distribution header and control message @@ -1861,21 +1783,21 @@ send_bad_msg(BadNode, To) -> send_bad_msgs(BadNode, To, 1). send_bad_msgs(BadNode, To, Repeat) when is_atom(BadNode), - is_pid(To), - is_integer(Repeat) -> + is_pid(To), + is_integer(Repeat) -> Parent = self(), Done = make_ref(), spawn_link(BadNode, - fun () -> - Node = node(To), - pong = net_adm:ping(Node), - DPrt = dport(Node), - DData = [dmsg_hdr(), - dmsg_ext({?DOP_SEND, ?COOKIE, To}), - dmsg_bad_atom_cache_ref()], - repeat(fun () -> port_command(DPrt, DData) end, Repeat), - Parent ! Done - end), + fun () -> + Node = node(To), + pong = net_adm:ping(Node), + DPrt = dport(Node), + DData = [dmsg_hdr(), + dmsg_ext({?DOP_SEND, ?COOKIE, To}), + dmsg_bad_atom_cache_ref()], + repeat(fun () -> port_command(DPrt, DData) end, Repeat), + Parent ! Done + end), receive Done -> ok end. %% send_bad_ctl(): @@ -1884,24 +1806,24 @@ send_bad_ctl(BadNode, ToNode) when is_atom(BadNode), is_atom(ToNode) -> Parent = self(), Done = make_ref(), spawn_link(BadNode, - fun () -> - pong = net_adm:ping(ToNode), - %% We creat a valid ctl msg and replace an - %% atom with an invalid atom cache reference - <<131,Replace/binary>> = term_to_binary(replace), - Ctl = dmsg_ext({?DOP_REG_SEND, - self(), - ?COOKIE, - replace}), - CtlBeginSize = size(Ctl) - size(Replace), - <<CtlBegin:CtlBeginSize/binary, Replace/binary>> = Ctl, - port_command(dport(ToNode), - [dmsg_fake_hdr2(), - CtlBegin, - dmsg_bad_atom_cache_ref(), - dmsg_ext({a, message})]), - Parent ! Done - end), + fun () -> + pong = net_adm:ping(ToNode), + %% We creat a valid ctl msg and replace an + %% atom with an invalid atom cache reference + <<131,Replace/binary>> = term_to_binary(replace), + Ctl = dmsg_ext({?DOP_REG_SEND, + self(), + ?COOKIE, + replace}), + CtlBeginSize = size(Ctl) - size(Replace), + <<CtlBegin:CtlBeginSize/binary, Replace/binary>> = Ctl, + port_command(dport(ToNode), + [dmsg_fake_hdr2(), + CtlBegin, + dmsg_bad_atom_cache_ref(), + dmsg_ext({a, message})]), + Parent ! Done + end), receive Done -> ok end. %% send_bad_dhr(): @@ -1910,17 +1832,17 @@ send_bad_dhdr(BadNode, ToNode) when is_atom(BadNode), is_atom(ToNode) -> Parent = self(), Done = make_ref(), spawn_link(BadNode, - fun () -> - pong = net_adm:ping(ToNode), - port_command(dport(ToNode), dmsg_bad_hdr()), - Parent ! Done - end), + fun () -> + pong = net_adm:ping(ToNode), + port_command(dport(ToNode), dmsg_bad_hdr()), + Parent ! Done + end), receive Done -> ok end. dport(Node) when is_atom(Node) -> case catch erts_debug:get_internal_state(available_internal_state) of - true -> true; - _ -> erts_debug:set_internal_state(available_internal_state, true) + true -> true; + _ -> erts_debug:set_internal_state(available_internal_state, true) end, erts_debug:get_internal_state({dist_port, Node}). @@ -1933,7 +1855,7 @@ dmsg_bad_hdr() -> [131, % Version Magic $D, % Dist header 255]. % 255 atom references - + %% dmsg_fake_hdr1() -> %% A = <<"fake header atom 1">>, @@ -1974,21 +1896,21 @@ start_node(Name, Args, Rel) when is_atom(Name), is_list(Rel) -> Pa = filename:dirname(code:which(?MODULE)), Cookie = atom_to_list(erlang:get_cookie()), RelArg = case Rel of - [] -> []; - _ -> [{erl,[{release,Rel}]}] - end, + [] -> []; + _ -> [{erl,[{release,Rel}]}] + end, test_server:start_node(Name, slave, - [{args, - Args++" -setcookie "++Cookie++" -pa \""++Pa++"\""} - | RelArg]); + [{args, + Args++" -setcookie "++Cookie++" -pa \""++Pa++"\""} + | RelArg]); start_node(Config, Args, Rel) when is_list(Config), is_list(Rel) -> 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])))), + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive])))), start_node(Name, Args, Rel). stop_node(Node) -> @@ -1999,13 +1921,13 @@ freeze_node(Node, MS) -> DoingIt = make_ref(), Freezer = self(), spawn_link(Node, - fun () -> - erts_debug:set_internal_state(available_internal_state, - true), - dport_send(Freezer, DoingIt), - receive after Own -> ok end, - erts_debug:set_internal_state(block, MS+Own) - end), + fun () -> + erts_debug:set_internal_state(available_internal_state, + true), + dport_send(Freezer, DoingIt), + receive after Own -> ok end, + erts_debug:set_internal_state(block, MS+Own) + end), receive DoingIt -> ok end, receive after Own -> ok end. @@ -2016,46 +1938,46 @@ do_inet_rpc({_,_,Sock},M,F,A) -> Bin = term_to_binary({M,F,A}), gen_tcp:send(Sock,Bin), case gen_tcp:recv(Sock,0) of - {ok, Bin2} -> - T = binary_to_term(Bin2), - {ok,T}; - Else -> - {error, Else} + {ok, Bin2} -> + T = binary_to_term(Bin2), + {ok,T}; + Else -> + {error, Else} end. inet_rpc_server([Host, PortList]) -> Port = list_to_integer(PortList), {ok, Sock} = gen_tcp:connect(Host, Port,[binary, {packet, 4}, - {active, false}]), + {active, false}]), inet_rpc_server_loop(Sock). inet_rpc_server_loop(Sock) -> case gen_tcp:recv(Sock,0) of - {ok, Bin} -> - {M,F,A} = binary_to_term(Bin), - Res = (catch apply(M,F,A)), - RB = term_to_binary(Res), - gen_tcp:send(Sock,RB), - inet_rpc_server_loop(Sock); - _ -> - erlang:halt() + {ok, Bin} -> + {M,F,A} = binary_to_term(Bin), + Res = (catch apply(M,F,A)), + RB = term_to_binary(Res), + gen_tcp:send(Sock,RB), + inet_rpc_server_loop(Sock); + _ -> + erlang:halt() end. - + start_relay_node(Node, Args) -> Pa = filename:dirname(code:which(?MODULE)), Cookie = "NOT"++atom_to_list(erlang:get_cookie()), {ok, LSock} = gen_tcp:listen(0, [binary, {packet, 4}, - {active, false}]), + {active, false}]), {ok, Port} = inet:port(LSock), {ok, Host} = inet:gethostname(), RunArg = "-run " ++ atom_to_list(?MODULE) ++ " inet_rpc_server " ++ - Host ++ " " ++ integer_to_list(Port), + Host ++ " " ++ integer_to_list(Port), {ok, NN} = - test_server:start_node(Node, peer, - [{args, Args ++ - " -setcookie "++Cookie++" -pa "++Pa++" "++ - RunArg}]), + test_server:start_node(Node, peer, + [{args, Args ++ + " -setcookie "++Cookie++" -pa "++Pa++" "++ + RunArg}]), [N,H] = string:tokens(atom_to_list(NN),"@"), {ok, Sock} = gen_tcp:accept(LSock), pang = net_adm:ping(NN), @@ -2070,28 +1992,28 @@ wait_dead(N,H,0) -> {error,{not_dead,N,H}}; wait_dead(N,H,X) -> case erl_epmd:port_please(N,H) of - {port,_,_} -> - receive - after 1000 -> - ok - end, - wait_dead(N,H,X-1); - noport -> - ok; - Else -> - {error, {unexpected, Else}} + {port,_,_} -> + receive + after 1000 -> + ok + end, + wait_dead(N,H,X-1); + noport -> + ok; + Else -> + {error, {unexpected, Else}} end. - + start_node_monitors(Nodes) -> Master = self(), lists:foreach(fun (Node) -> - spawn(Node, - fun () -> - node_monitor(Master) - end) - end, - Nodes), + spawn(Node, + fun () -> + node_monitor(Master) + end) + end, + Nodes), ok. node_monitor(Master) -> @@ -2100,42 +2022,42 @@ node_monitor(Master) -> net_kernel:monitor_nodes(true, Opts), Nodes1 = nodes(connected), case lists:sort(Nodes0) == lists:sort(Nodes1) of - true -> - lists:foreach(fun (Node) -> - Master ! {nodeup, node(), Node} - end, - 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), - flush_node_changes(), - node_monitor(Master) + true -> + lists:foreach(fun (Node) -> + Master ! {nodeup, node(), Node} + end, + Nodes0), + io:format("~p ~p: ~p~n", [node(), erlang:system_time(micro_seconds), Nodes0]), + node_monitor_loop(Master); + false -> + net_kernel:monitor_nodes(false, Opts), + flush_node_changes(), + node_monitor(Master) end. flush_node_changes() -> receive - {NodeChange, _Node, _InfoList} when NodeChange == nodeup; - NodeChange == nodedown -> - flush_node_changes() + {NodeChange, _Node, _InfoList} when NodeChange == nodeup; + NodeChange == nodedown -> + flush_node_changes() after 0 -> - ok + ok end. node_monitor_loop(Master) -> receive - {nodeup, Node, _InfoList} = Msg -> - Master ! {nodeup, node(), Node}, - ?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 - {value, {nodedown_reason, R}} -> R; - _ -> undefined - end, - Master ! {nodedown, node(), Node, Reason}, - ?t:format("~p ~p: ~p~n", [node(), erlang:system_time(micro_seconds), Msg]), - node_monitor_loop(Master) + {nodeup, Node, _InfoList} = Msg -> + Master ! {nodeup, node(), Node}, + io: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 + {value, {nodedown_reason, R}} -> R; + _ -> undefined + end, + Master ! {nodedown, node(), Node, Reason}, + io:format("~p ~p: ~p~n", [node(), erlang:system_time(micro_seconds), Msg]), + node_monitor_loop(Master) end. verify_up(A, B) -> @@ -2149,16 +2071,16 @@ verify_still_up(A, B) -> verify_no_down(A, B) -> receive - {nodedown, A, B, _} = Msg0 -> - ?t:fail(Msg0) + {nodedown, A, B, _} = Msg0 -> + ct:fail(Msg0) after 0 -> - ok + ok end, receive - {nodedown, B, A, _} = Msg1 -> - ?t:fail(Msg1) + {nodedown, B, A, _} = Msg1 -> + ct:fail(Msg1) after 0 -> - ok + ok end. %% verify_down(A, B) -> @@ -2167,12 +2089,12 @@ verify_no_down(A, B) -> verify_down(A, ReasonA, B, ReasonB) -> receive - {nodedown, A, B, _} = Msg0 -> - {nodedown, A, B, ReasonA} = Msg0 + {nodedown, A, B, _} = Msg0 -> + {nodedown, A, B, ReasonA} = Msg0 end, receive - {nodedown, B, A, _} = Msg1 -> - {nodedown, B, A, ReasonB} = Msg1 + {nodedown, B, A, _} = Msg1 -> + {nodedown, B, A, ReasonB} = Msg1 end, ok. @@ -2192,17 +2114,17 @@ from(_, []) -> []. long_or_short() -> case net_kernel:longnames() of - true -> " -name "; - false -> " -sname " + true -> " -name "; + false -> " -sname " end. until(Fun) -> case Fun() of - true -> - ok; - false -> - receive after 10 -> ok end, - until(Fun) + true -> + ok; + false -> + receive after 10 -> ok end, + until(Fun) end. forever(Fun) -> @@ -2227,9 +2149,9 @@ stop_busy_dist_port_tracer(_) -> busy_dist_port_tracer() -> receive - {monitor, _SuspendedProcess, busy_dist_port, _Port} = M -> - erlang:display(M), - busy_dist_port_tracer() + {monitor, _SuspendedProcess, busy_dist_port, _Port} = M -> + erlang:display(M), + busy_dist_port_tracer() end. repeat(_Fun, 0) -> @@ -2242,38 +2164,38 @@ string_to_atom_ext(String) -> Utf8List = string_to_utf8_list(String), Len = length(Utf8List), case Len < 256 of - true -> - [?SMALL_ATOM_UTF8_EXT, Len | Utf8List]; - false -> - [?ATOM_UTF8_EXT, Len bsr 8, Len band 16#ff | Utf8List] + true -> + [?SMALL_ATOM_UTF8_EXT, Len | Utf8List]; + false -> + [?ATOM_UTF8_EXT, Len bsr 8, Len band 16#ff | Utf8List] end. string_to_atom(String) -> binary_to_term(list_to_binary([?VERSION_MAGIC - | string_to_atom_ext(String)])). + | string_to_atom_ext(String)])). string_to_utf8_list([]) -> []; string_to_utf8_list([CP|CPs]) when is_integer(CP), - 0 =< CP, - CP =< 16#7F -> + 0 =< CP, + CP =< 16#7F -> [CP | string_to_utf8_list(CPs)]; string_to_utf8_list([CP|CPs]) when is_integer(CP), - 16#80 =< CP, - CP =< 16#7FF -> + 16#80 =< CP, + CP =< 16#7FF -> [16#C0 bor (CP bsr 6), 16#80 bor (16#3F band CP) | string_to_utf8_list(CPs)]; string_to_utf8_list([CP|CPs]) when is_integer(CP), - 16#800 =< CP, - CP =< 16#FFFF -> + 16#800 =< CP, + CP =< 16#FFFF -> [16#E0 bor (CP bsr 12), 16#80 bor (16#3F band (CP bsr 6)), 16#80 bor (16#3F band CP) | string_to_utf8_list(CPs)]; string_to_utf8_list([CP|CPs]) when is_integer(CP), - 16#10000 =< CP, - CP =< 16#10FFFF -> + 16#10000 =< CP, + CP =< 16#10FFFF -> [16#F0 bor (CP bsr 18), 16#80 bor (16#3F band (CP bsr 12)), 16#80 bor (16#3F band (CP bsr 6)), @@ -2283,47 +2205,47 @@ string_to_utf8_list([CP|CPs]) when is_integer(CP), utf8_list_to_string([]) -> []; utf8_list_to_string([B|Bs]) when is_integer(B), - 0 =< B, - B =< 16#7F -> + 0 =< B, + B =< 16#7F -> [B | utf8_list_to_string(Bs)]; utf8_list_to_string([B0, B1 | Bs]) when is_integer(B0), - 16#C0 =< B0, - B0 =< 16#DF, - is_integer(B1), - 16#80 =< B1, - B1 =< 16#BF -> + 16#C0 =< B0, + B0 =< 16#DF, + is_integer(B1), + 16#80 =< B1, + B1 =< 16#BF -> [(((B0 band 16#1F) bsl 6) - bor (B1 band 16#3F)) + bor (B1 band 16#3F)) | utf8_list_to_string(Bs)]; utf8_list_to_string([B0, B1, B2 | Bs]) when is_integer(B0), - 16#E0 =< B0, - B0 =< 16#EF, - is_integer(B1), - 16#80 =< B1, - B1 =< 16#BF, - is_integer(B2), - 16#80 =< B2, - B2 =< 16#BF -> + 16#E0 =< B0, + B0 =< 16#EF, + is_integer(B1), + 16#80 =< B1, + B1 =< 16#BF, + is_integer(B2), + 16#80 =< B2, + B2 =< 16#BF -> [(((B0 band 16#F) bsl 12) - bor ((B1 band 16#3F) bsl 6) - bor (B2 band 16#3F)) + bor ((B1 band 16#3F) bsl 6) + bor (B2 band 16#3F)) | utf8_list_to_string(Bs)]; utf8_list_to_string([B0, B1, B2, B3 | Bs]) when is_integer(B0), - 16#F0 =< B0, - B0 =< 16#F7, - is_integer(B1), - 16#80 =< B1, - B1 =< 16#BF, - is_integer(B2), - 16#80 =< B2, - B2 =< 16#BF, - is_integer(B3), - 16#80 =< B3, - B3 =< 16#BF -> + 16#F0 =< B0, + B0 =< 16#F7, + is_integer(B1), + 16#80 =< B1, + B1 =< 16#BF, + is_integer(B2), + 16#80 =< B2, + B2 =< 16#BF, + is_integer(B3), + 16#80 =< B3, + B3 =< 16#BF -> [(((B0 band 16#7) bsl 18) - bor ((B1 band 16#3F) bsl 12) - bor ((B2 band 16#3F) bsl 6) - bor (B3 band 16#3F)) + bor ((B1 band 16#3F) bsl 12) + bor ((B2 band 16#3F) bsl 6) + bor (B3 band 16#3F)) | utf8_list_to_string(Bs)]. mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) -> @@ -2331,17 +2253,17 @@ mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) -> mk_pid({NodeNameExt, Creation}, Number, Serial); mk_pid({NodeNameExt, Creation}, Number, Serial) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PID_EXT, - NodeNameExt, - uint32_be(Number), - uint32_be(Serial), - uint8(Creation)])) of - Pid when is_pid(Pid) -> - Pid; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_pid, [{NodeNameExt, Creation}, Number, Serial]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?PID_EXT, + NodeNameExt, + uint32_be(Number), + uint32_be(Serial), + uint8(Creation)])) of + Pid when is_pid(Pid) -> + Pid; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_pid, [{NodeNameExt, Creation}, Number, Serial]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end. mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> @@ -2349,59 +2271,59 @@ mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> mk_port({NodeNameExt, Creation}, Number); mk_port({NodeNameExt, Creation}, Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PORT_EXT, - NodeNameExt, - uint32_be(Number), - uint8(Creation)])) of - Port when is_port(Port) -> - Port; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_port, [{NodeNameExt, Creation}, Number]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?PORT_EXT, + NodeNameExt, + uint32_be(Number), + uint8(Creation)])) of + Port when is_port(Port) -> + Port; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_port, [{NodeNameExt, Creation}, Number]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end. mk_ref({NodeName, Creation}, [Number] = NL) when is_atom(NodeName), - is_integer(Creation), - is_integer(Number) -> + is_integer(Creation), + is_integer(Number) -> <<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName), mk_ref({NodeNameExt, Creation}, NL); mk_ref({NodeNameExt, Creation}, [Number]) when is_integer(Creation), - is_integer(Number) -> + is_integer(Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?REFERENCE_EXT, - NodeNameExt, - uint32_be(Number), - uint8(Creation)])) of - Ref when is_reference(Ref) -> - Ref; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_ref, [{NodeNameExt, Creation}, [Number]]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?REFERENCE_EXT, + NodeNameExt, + uint32_be(Number), + uint8(Creation)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeNameExt, Creation}, [Number]]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end; mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName), - is_integer(Creation), - is_list(Numbers) -> + is_integer(Creation), + is_list(Numbers) -> <<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName), mk_ref({NodeNameExt, Creation}, Numbers); mk_ref({NodeNameExt, Creation}, Numbers) when is_integer(Creation), - is_list(Numbers) -> + is_list(Numbers) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?NEW_REFERENCE_EXT, - uint16_be(length(Numbers)), - NodeNameExt, - uint8(Creation), - lists:map(fun (N) -> - uint32_be(N) - end, - Numbers)])) of - Ref when is_reference(Ref) -> - Ref; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_ref, [{NodeNameExt, Creation}, Numbers]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?NEW_REFERENCE_EXT, + uint16_be(length(Numbers)), + NodeNameExt, + uint8(Creation), + lists:map(fun (N) -> + uint32_be(N) + end, + Numbers)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeNameExt, Creation}, Numbers]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end. diff --git a/erts/emulator/test/distribution_SUITE_data/run.erl b/erts/emulator/test/distribution_SUITE_data/run.erl index d5ed139369..f574b2c02c 100644 --- a/erts/emulator/test/distribution_SUITE_data/run.erl +++ b/erts/emulator/test/distribution_SUITE_data/run.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index 4211c49848..f134a197aa 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -29,64 +29,64 @@ -module(driver_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, - - a_test/1, - outputv_echo/1, - timer_measure/1, - timer_cancel/1, - timer_change/1, - timer_delay/1, - queue_echo/1, - outputv_errors/1, - driver_unloaded/1, - io_ready_exit/1, - use_fallback_pollset/1, - bad_fd_in_pollset/1, - driver_event/1, - fd_change/1, - steal_control/1, - otp_6602/1, - driver_system_info_base_ver/1, - driver_system_info_prev_ver/1, - driver_system_info_current_ver/1, - driver_monitor/1, - - ioq_exit_ready_input/1, - ioq_exit_ready_output/1, - ioq_exit_timeout/1, - ioq_exit_ready_async/1, - ioq_exit_event/1, - ioq_exit_ready_input_async/1, - ioq_exit_ready_output_async/1, - ioq_exit_timeout_async/1, - ioq_exit_event_async/1, - zero_extended_marker_garb_drv/1, - invalid_extended_marker_drv/1, - larger_major_vsn_drv/1, - larger_minor_vsn_drv/1, - smaller_major_vsn_drv/1, - smaller_minor_vsn_drv/1, - peek_non_existing_queue/1, - otp_6879/1, - caller/1, - many_events/1, - missing_callbacks/1, - smp_select/1, - driver_select_use/1, - thread_mseg_alloc_cache_clean/1, - otp_9302/1, - thr_free_drv/1, - async_blast/1, - thr_msg_blast/1, - consume_timeslice/1, - z_test/1]). + end_per_suite/1, init_per_group/2,end_per_group/2, + init_per_testcase/2, + end_per_testcase/2, + + a_test/1, + outputv_echo/1, + timer_measure/1, + timer_cancel/1, + timer_change/1, + timer_delay/1, + queue_echo/1, + outputv_errors/1, + driver_unloaded/1, + io_ready_exit/1, + use_fallback_pollset/1, + bad_fd_in_pollset/1, + driver_event/1, + fd_change/1, + steal_control/1, + otp_6602/1, + driver_system_info_base_ver/1, + driver_system_info_prev_ver/1, + driver_system_info_current_ver/1, + driver_monitor/1, + + ioq_exit_ready_input/1, + ioq_exit_ready_output/1, + ioq_exit_timeout/1, + ioq_exit_ready_async/1, + ioq_exit_event/1, + ioq_exit_ready_input_async/1, + ioq_exit_ready_output_async/1, + ioq_exit_timeout_async/1, + ioq_exit_event_async/1, + zero_extended_marker_garb_drv/1, + invalid_extended_marker_drv/1, + larger_major_vsn_drv/1, + larger_minor_vsn_drv/1, + smaller_major_vsn_drv/1, + smaller_minor_vsn_drv/1, + peek_non_existing_queue/1, + otp_6879/1, + caller/1, + many_events/1, + missing_callbacks/1, + smp_select/1, + driver_select_use/1, + thread_mseg_alloc_cache_clean/1, + otp_9302/1, + thr_free_drv/1, + async_blast/1, + thr_msg_blast/1, + consume_timeslice/1, + z_test/1]). -export([bin_prefix/2]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). % First byte in communication with the timer driver @@ -119,22 +119,22 @@ -define(heap_binary_size, 64). init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(2)), case catch erts_debug:get_internal_state(available_internal_state) of - true -> ok; - _ -> erts_debug:set_internal_state(available_internal_state, true) + true -> ok; + _ -> erts_debug:set_internal_state(available_internal_state, true) end, erlang:display({init_per_testcase, Case}), - ?line 0 = element(1, erts_debug:get_internal_state(check_io_debug)), - [{watchdog, Dog},{testcase, Case}|Config]. + 0 = element(1, erts_debug:get_internal_state(check_io_debug)), + [{testcase, Case}|Config]. end_per_testcase(Case, Config) -> - Dog = ?config(watchdog, Config), erlang:display({end_per_testcase, Case}), - ?line 0 = element(1, erts_debug:get_internal_state(check_io_debug)), - ?t:timetrap_cancel(Dog). + 0 = element(1, erts_debug:get_internal_state(check_io_debug)), + ok. -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> %% Keep a_test first and z_test last... [a_test, outputv_errors, outputv_echo, queue_echo, {group, timer}, @@ -179,42 +179,42 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. -outputv_errors(doc) -> "Test sending bad types to port with an outputv-capable driver."; +%% Test sending bad types to port with an outputv-capable driver. outputv_errors(Config) when is_list(Config) -> - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:start(), - ?line ok = load_driver(Path, outputv_drv), + Path = proplists:get_value(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, outputv_drv), outputv_bad_types(fun(T) -> - ?line outputv_errors_1(T), - ?line outputv_errors_1([1|T]), - ?line L = [1,2,3], - ?line outputv_errors_1([L,T]), - ?line outputv_errors_1([L|T]) - end), + outputv_errors_1(T), + outputv_errors_1([1|T]), + L = [1,2,3], + outputv_errors_1([L,T]), + outputv_errors_1([L|T]) + end), outputv_errors_1(42), %% Test iolists that do not fit in the address space. %% Unfortunately, it would be too slow to test in a 64-bit emulator. case erlang:system_info(wordsize) of - 4 -> outputv_huge_iolists(); - _ -> ok + 4 -> outputv_huge_iolists(); + _ -> ok end. outputv_bad_types(Test) -> Types = [-1,256,atom,42.0,{a,b,c},make_ref(),fun() -> 42 end, - [1|2],<<1:1>>,<<1:9>>,<<1:15>>], + [1|2],<<1:1>>,<<1:9>>,<<1:15>>], _ = [Test(Type) || Type <- Types], ok. outputv_huge_iolists() -> FourGigs = 1 bsl 32, - ?line Sizes = [FourGigs+N || N <- lists:seq(0, 64)] ++ - [1 bsl N || N <- lists:seq(33, 37)], - ?line Base = <<0:(1 bsl 20)/unit:8>>, + Sizes = [FourGigs+N || N <- lists:seq(0, 64)] ++ + [1 bsl N || N <- lists:seq(33, 37)], + Base = <<0:(1 bsl 20)/unit:8>>, [begin - ?line L = build_iolist(Sz, Base), - ?line outputv_errors_1(L) + L = build_iolist(Sz, Base), + outputv_errors_1(L) end || Sz <- Sizes], ok. @@ -224,95 +224,94 @@ outputv_errors_1(Term) -> port_close(Port). build_iolist(N, Base) when N < 16 -> - case random:uniform(3) of - 1 -> - <<Bin:N/binary,_/binary>> = Base, - Bin; - _ -> - lists:seq(1, N) + case rand:uniform(3) of + 1 -> + <<Bin:N/binary,_/binary>> = Base, + Bin; + _ -> + lists:seq(1, N) end; build_iolist(N, Base) when N =< byte_size(Base) -> - case random:uniform(3) of - 1 -> - <<Bin:N/binary,_/binary>> = Base, - Bin; - 2 -> - <<Bin:N/binary,_/binary>> = Base, - [Bin]; - 3 -> - case N rem 2 of - 0 -> - L = build_iolist(N div 2, Base), - [L,L]; - 1 -> - L = build_iolist(N div 2, Base), - [L,L,45] - end + case rand:uniform(3) of + 1 -> + <<Bin:N/binary,_/binary>> = Base, + Bin; + 2 -> + <<Bin:N/binary,_/binary>> = Base, + [Bin]; + 3 -> + case N rem 2 of + 0 -> + L = build_iolist(N div 2, Base), + [L,L]; + 1 -> + L = build_iolist(N div 2, Base), + [L,L,45] + end end; build_iolist(N0, Base) -> - Small = random:uniform(15), + Small = rand:uniform(15), Seq = lists:seq(1, Small), N = N0 - Small, case N rem 2 of - 0 -> - L = build_iolist(N div 2, Base), - [L,L|Seq]; - 1 -> - L = build_iolist(N div 2, Base), - [47,L,L|Seq] + 0 -> + L = build_iolist(N div 2, Base), + [L,L|Seq]; + 1 -> + L = build_iolist(N div 2, Base), + [47,L,L|Seq] end. -outputv_echo(doc) -> ["Test echoing data with a driver that supports outputv."]; +%% Test echoing data with a driver that supports outputv. outputv_echo(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(10)), + ct:timetrap({minutes, 10}), Name = 'outputv_drv', P = start_driver(Config, Name, true), - ?line ov_test(P, {bin,0}), - ?line ov_test(P, {bin,1}), - ?line ov_test(P, {bin,2}), - ?line ov_test(P, {bin,3}), - ?line ov_test(P, {bin,4}), - ?line ov_test(P, {bin,5}), - ?line ov_test(P, {bin,6}), - ?line ov_test(P, {bin,7}), - ?line ov_test(P, {bin,8}), - ?line ov_test(P, {bin,15}), - ?line ov_test(P, {bin,16}), - ?line ov_test(P, {bin,17}), - - ?line ov_test(P, {list,0}), - ?line ov_test(P, {list,1}), - ?line ov_test(P, {list,2}), - ?line ov_test(P, [int,int,{list,0},int]), - ?line ov_test(P, [int,int,{list,1},int]), - ?line ov_test(P, [int,int,{list,2}]), - ?line ov_test(P, [{list,3},int,int,{list,2}]), - ?line ov_test(P, {list,33}), - - ?line ov_test(P, [{bin,0}]), - ?line ov_test(P, [{bin,1}]), - ?line ov_test(P, [{bin,2}]), - ?line ov_test(P, [{bin,3}]), - ?line ov_test(P, [{bin,4}]), - ?line ov_test(P, [{bin,5}]), - ?line ov_test(P, [{bin,6},int]), - ?line ov_test(P, [int,{bin,3}]), - ?line ov_test(P, [int|{bin,4}]), - ?line ov_test(P, [{bin,17},int,{bin,13}|{bin,3}]), - - ?line ov_test(P, [int,{bin,17},int,{bin,?heap_binary_size+1}|{bin,3}]), + ov_test(P, {bin,0}), + ov_test(P, {bin,1}), + ov_test(P, {bin,2}), + ov_test(P, {bin,3}), + ov_test(P, {bin,4}), + ov_test(P, {bin,5}), + ov_test(P, {bin,6}), + ov_test(P, {bin,7}), + ov_test(P, {bin,8}), + ov_test(P, {bin,15}), + ov_test(P, {bin,16}), + ov_test(P, {bin,17}), + + ov_test(P, {list,0}), + ov_test(P, {list,1}), + ov_test(P, {list,2}), + ov_test(P, [int,int,{list,0},int]), + ov_test(P, [int,int,{list,1},int]), + ov_test(P, [int,int,{list,2}]), + ov_test(P, [{list,3},int,int,{list,2}]), + ov_test(P, {list,33}), + + ov_test(P, [{bin,0}]), + ov_test(P, [{bin,1}]), + ov_test(P, [{bin,2}]), + ov_test(P, [{bin,3}]), + ov_test(P, [{bin,4}]), + ov_test(P, [{bin,5}]), + ov_test(P, [{bin,6},int]), + ov_test(P, [int,{bin,3}]), + ov_test(P, [int|{bin,4}]), + ov_test(P, [{bin,17},int,{bin,13}|{bin,3}]), + + ov_test(P, [int,{bin,17},int,{bin,?heap_binary_size+1}|{bin,3}]), stop_driver(P, Name), - ?line test_server:timetrap_cancel(Dog), ok. ov_test(Port, Template) -> Self = self(), spawn_opt(erlang, apply, [fun () -> ov_test(Self, Port, Template) end,[]], - [link,{fullsweep_after,0}]), + [link,{fullsweep_after,0}]), receive - done -> ok + done -> ok end. ov_test(Parent, Port, Template) -> @@ -354,21 +353,20 @@ ov_send_and_test(Port, Data, ExpectedResult) -> io:format("~p ! ~P", [Port,Data,12]), Port ! {self(),{command,Data}}, receive - {Port,{data,ReturnData}} -> - io:format("~p returned ~P", [Port,ReturnData,12]), - compare(ReturnData, ExpectedResult); - {Port,{data,OtherData}} -> - io:format("~p returned WRONG data ~p", [Port,OtherData]), - ?line test_server:fail(); - Wrong -> - ?line test_server:fail({unexpected_port_or_data,Wrong}) + {Port,{data,ReturnData}} -> + io:format("~p returned ~P", [Port,ReturnData,12]), + compare(ReturnData, ExpectedResult); + {Port,{data,OtherData}} -> + ct:fail("~p returned WRONG data ~p", [Port,OtherData]); + Wrong -> + ct:fail({unexpected_port_or_data,Wrong}) end. compare(Got, Expected) -> case {list_to_binary([Got]),list_to_binary([Expected])} of - {B,B} -> ok; - {_Gb,_Eb} -> - ?t:fail(got_bad_data) + {B,B} -> ok; + {_Gb,_Eb} -> + ct:fail(got_bad_data) end. @@ -377,146 +375,138 @@ compare(Got, Expected) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -timer_measure(doc) -> ["Check that timers time out in good time."]; +%% Check that timers time out in good time. timer_measure(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(1)), Name = 'timer_drv', - ?line Port = start_driver(Config, Name, false), + Port = start_driver(Config, Name, false), - ?line try_timeouts(Port, 8997), + try_timeouts(Port, 8997), - ?line stop_driver(Port, Name), - ?line test_server:timetrap_cancel(Dog), + stop_driver(Port, Name), ok. try_timeouts(_, 0) -> ok; try_timeouts(Port, Timeout) -> - ?line TimeBefore = erlang:monotonic_time(), - ?line erlang:port_command(Port, <<?START_TIMER,Timeout:32>>), + TimeBefore = erlang:monotonic_time(), + 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]), - if - Elapsed < Timeout -> - ?line ?t:fail(too_short); - Elapsed > Timeout + ?delay -> - ?line ?t:fail(too_long); - true -> - try_timeouts(Port, Timeout div 2) - end + {Port,{data,[?TIMER]}} -> + Elapsed = erl_millisecs() - erl_millisecs(TimeBefore), + io:format("Elapsed: ~p Timeout: ~p\n", [Elapsed, Timeout]), + if + Elapsed < Timeout -> + ct:fail(too_short); + Elapsed > Timeout + ?delay -> + ct:fail(too_long); + true -> + try_timeouts(Port, Timeout div 2) + end after Timeout + ?delay -> - ?line test_server:fail("driver failed to timeout") + ct:fail("driver failed to timeout") end. -timer_cancel(doc) -> ["Try cancelling timers set in a driver."]; +%% Try cancelling timers set in a driver. timer_cancel(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(1)), Name = 'timer_drv', - ?line Port = start_driver(Config, Name, false), + Port = start_driver(Config, Name, false), - ?line try_cancel(Port, 10000), + try_cancel(Port, 10000), - ?line stop_driver(Port, Name), - ?line test_server:timetrap_cancel(Dog), + stop_driver(Port, Name), ok. - + try_cancel(Port, Timeout) -> - ?line T_before = erl_millisecs(), + T_before = erl_millisecs(), Port ! {self(),{command,<<?START_TIMER,(Timeout + ?delay):32>>}}, receive - {Port, {data, [?TIMER]}} -> - ?line test_server:fail("driver timed out before cancelling it") + {Port, {data, [?TIMER]}} -> + ct:fail("driver timed out before cancelling it") after Timeout -> - Port ! {self(), {command, [?CANCEL_TIMER]}}, - receive - {Port, {data, [?TIMER]}} -> - ?line test_server:fail("driver timed out after cancelling it"); - {Port, {data, [?CANCELLED]}} -> - ?line Time_milli_secs = erl_millisecs() - T_before, - - io:format("Time_milli_secs: ~p Timeout: ~p\n", - [Time_milli_secs, Timeout]), - if - Time_milli_secs > (Timeout + ?delay) -> - ?line test_server:fail("too long real time"); - Timeout == 0 -> ok; - true -> try_cancel(Port, Timeout div 2) - end - after ?delay -> - test_server:fail("No message from driver") - end + Port ! {self(), {command, [?CANCEL_TIMER]}}, + receive + {Port, {data, [?TIMER]}} -> + ct:fail("driver timed out after cancelling it"); + {Port, {data, [?CANCELLED]}} -> + Time_milli_secs = erl_millisecs() - T_before, + + io:format("Time_milli_secs: ~p Timeout: ~p\n", + [Time_milli_secs, Timeout]), + if + Time_milli_secs > (Timeout + ?delay) -> + ct:fail("too long real time"); + Timeout == 0 -> ok; + true -> try_cancel(Port, Timeout div 2) + end + after ?delay -> + ct:fail("No message from driver") + end end. %% Test that timers don't time out too early if we do a sleep %% before setting a timer. timer_delay(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(1)), Name = 'timer_drv', - ?line Port = start_driver(Config, Name, false), + Port = start_driver(Config, Name, false), - ?line TimeBefore = erlang:monotonic_time(), + TimeBefore = erlang:monotonic_time(), Timeout0 = 350, - ?line erlang:port_command(Port, <<?DELAY_START_TIMER,Timeout0:32>>), + erlang:port_command(Port, <<?DELAY_START_TIMER,Timeout0:32>>), Timeout = Timeout0 + - case os:type() of - {win32,_} -> 0; %Driver doesn't sleep on Windows. - _ -> 1000 - end, + case os:type() of + {win32,_} -> 0; %Driver doesn't sleep on Windows. + _ -> 1000 + end, receive - {Port,{data,[?TIMER]}} -> - ?line Elapsed = erl_millisecs() - erl_millisecs(TimeBefore), - io:format("Elapsed time: ~p Timeout: ~p\n", - [Elapsed,Timeout]), - if - Elapsed < Timeout -> - ?line ?t:fail(too_short); - Elapsed > Timeout + ?delay -> - ?line ?t:fail(too_long); - true -> - ok - end + {Port,{data,[?TIMER]}} -> + Elapsed = erl_millisecs() - erl_millisecs(TimeBefore), + io:format("Elapsed time: ~p Timeout: ~p\n", + [Elapsed,Timeout]), + if + Elapsed < Timeout -> + ct:fail(too_short); + Elapsed > Timeout + ?delay -> + ct:fail(too_long); + true -> + ok + end end, - ?line stop_driver(Port, Name), - ?line test_server:timetrap_cancel(Dog), + stop_driver(Port, Name), ok. %% Test that driver_set_timer with new timout really changes %% the timer (ticket OTP-5942), it didn't work before timer_change(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(1)), Name = 'timer_drv', - ?line Port = start_driver(Config, Name, false), + Port = start_driver(Config, Name, false), - ?line try_change_timer(Port, 10000), + try_change_timer(Port, 10000), - ?line stop_driver(Port, Name), - ?line test_server:timetrap_cancel(Dog), + stop_driver(Port, Name), ok. - + try_change_timer(_Port, 0) -> ok; try_change_timer(Port, Timeout) -> - ?line Timeout_3 = Timeout*3, - ?line TimeBefore = erlang:monotonic_time(), - ?line erlang:port_command(Port, <<?START_TIMER,Timeout_3:32>>), - ?line erlang:port_command(Port, <<?START_TIMER,Timeout:32>>), + Timeout_3 = Timeout*3, + TimeBefore = erlang:monotonic_time(), + erlang:port_command(Port, <<?START_TIMER,Timeout_3:32>>), + 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]), - if - Elapsed < Timeout -> - ?line ?t:fail(too_short); - Elapsed > Timeout + ?delay -> - ?line ?t:fail(too_long); - true -> - try_timeouts(Port, Timeout div 2) - end + {Port,{data,[?TIMER]}} -> + Elapsed = erl_millisecs() - erl_millisecs(TimeBefore), + io:format("Elapsed: ~p Timeout: ~p\n", [Elapsed,Timeout]), + if + Elapsed < Timeout -> + ct:fail(too_short); + Elapsed > Timeout + ?delay -> + ct:fail(too_long); + true -> + try_timeouts(Port, Timeout div 2) + end after Timeout + ?delay -> - ?line test_server:fail("driver failed to timeout") + ct:fail("driver failed to timeout") end. @@ -524,49 +514,47 @@ try_change_timer(Port, Timeout) -> %% Queue test suites %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -queue_echo(doc) -> - ["1) Queue up data in a driver that uses the full driver_queue API to do this." - "2) Get the data back, a random amount at a time."]; +%% 1) Queue up data in a driver that uses the full driver_queue API to do this. +%% 2) Get the data back, a random amount at a time. queue_echo(Config) when is_list(Config) -> - case ?t:is_native(?MODULE) of - true -> exit(crashes_native_code); - false -> queue_echo_1(Config) + case test_server:is_native(?MODULE) of + true -> exit(crashes_native_code); + false -> queue_echo_1(Config) end. queue_echo_1(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(10)), + ct:timetrap({minutes, 10}), Name = 'queue_drv', - ?line P = start_driver(Config, Name, true), - - ?line q_echo(P, [{?ENQ, {list,1}}, - {?ENQ, {list,0}}, - {?ENQ, {bin,0}}, - {?ENQ, {bin,1}}, - {?ENQ, {bin,2}}, - {?ENQ, {bin,3}}, - {?ENQ, {bin,4}}, - {?ENQ, {bin,5}}, - {?ENQ, {bin,600}}, - {?PUSHQ, {list,0}}, - {?PUSHQ, {list,1}}, - {?PUSHQ, {bin,0}}, - {?PUSHQ, {bin,1}}, - {?PUSHQ, {bin,888}}, - {?ENQ_BIN, {bin,0}}, - {?ENQ_BIN, {bin,1}}, - {?ENQ_BIN, {bin,2}}, - {?ENQ_BIN, {bin,3}}, - {?ENQ_BIN, {bin,4}}, - {?ENQ_BIN, {bin,777}}, - {?PUSHQ_BIN, {bin,0}}, - {?PUSHQ_BIN, {bin,1}}, - {?PUSHQ_BIN, {bin,334}}, - {?ENQV, [{bin,0},{list,1},{bin,1},{bin,555}]}, - {?ENQV, [{bin,0},{list,1},{bin,1}]}, - {?PUSHQV, [{bin,0},{list,1},{bin,1},{bin,319}]}]), - - ?line stop_driver(P, Name), - ?line test_server:timetrap_cancel(Dog), + P = start_driver(Config, Name, true), + + q_echo(P, [{?ENQ, {list,1}}, + {?ENQ, {list,0}}, + {?ENQ, {bin,0}}, + {?ENQ, {bin,1}}, + {?ENQ, {bin,2}}, + {?ENQ, {bin,3}}, + {?ENQ, {bin,4}}, + {?ENQ, {bin,5}}, + {?ENQ, {bin,600}}, + {?PUSHQ, {list,0}}, + {?PUSHQ, {list,1}}, + {?PUSHQ, {bin,0}}, + {?PUSHQ, {bin,1}}, + {?PUSHQ, {bin,888}}, + {?ENQ_BIN, {bin,0}}, + {?ENQ_BIN, {bin,1}}, + {?ENQ_BIN, {bin,2}}, + {?ENQ_BIN, {bin,3}}, + {?ENQ_BIN, {bin,4}}, + {?ENQ_BIN, {bin,777}}, + {?PUSHQ_BIN, {bin,0}}, + {?PUSHQ_BIN, {bin,1}}, + {?PUSHQ_BIN, {bin,334}}, + {?ENQV, [{bin,0},{list,1},{bin,1},{bin,555}]}, + {?ENQV, [{bin,0},{list,1},{bin,1}]}, + {?PUSHQV, [{bin,0},{list,1},{bin,1},{bin,319}]}]), + + stop_driver(P, Name), ok. q_echo(Port, SpecList) -> @@ -606,7 +594,7 @@ q_echo(Port, SpecList) -> feed_and_dequeue(Port, HeapData, 2), feed_and_dequeue(Port, HeapData, 3), feed_and_dequeue(Port, HeapData, 4), - + io:format("\n"). feed_and_dequeue(Port, Data, DeqSize) -> @@ -626,9 +614,9 @@ feed_driver(Port, [], ExpectedInPort, Qb) -> {ExpectedInPort,Qb}; feed_driver(Port, [{Method0,Data}|T], Expected_return, Qb_before) -> Method = case Method0 of - ?RANDOM -> uniform(6)-1; - Other -> Other - end, + ?RANDOM -> uniform(6)-1; + Other -> Other + end, Size = size(list_to_binary([Data])), %% *********************************************************************** @@ -643,22 +631,21 @@ feed_driver(Port, [{Method0,Data}|T], Expected_return, Qb_before) -> Qb_in_driver = bytes_queued(Port), case Qb_before + Size of - Qb_in_driver -> ok; - Sum -> - io:format("Qb_before: ~p\n" - "Qb_before+Size: ~p\n" - "Qb_in_driver: ~p", - [Qb_before,Sum,Qb_in_driver]), - ?t:fail() + Qb_in_driver -> ok; + Sum -> + ct:fail("Qb_before: ~p\n" + "Qb_before+Size: ~p\n" + "Qb_in_driver: ~p", + [Qb_before,Sum,Qb_in_driver]) end, X_return = case Method of - ?ENQ -> list_to_binary([Expected_return,Data]); - ?PUSHQ -> list_to_binary([Data,Expected_return]); - ?PUSHQ_BIN -> list_to_binary([Data,Expected_return]); - ?ENQ_BIN -> list_to_binary([Expected_return,Data]); - ?PUSHQV -> list_to_binary([Data,Expected_return]); - ?ENQV -> list_to_binary([Expected_return,Data]) - end, + ?ENQ -> list_to_binary([Expected_return,Data]); + ?PUSHQ -> list_to_binary([Data,Expected_return]); + ?PUSHQ_BIN -> list_to_binary([Data,Expected_return]); + ?ENQ_BIN -> list_to_binary([Expected_return,Data]); + ?PUSHQV -> list_to_binary([Data,Expected_return]); + ?ENQV -> list_to_binary([Expected_return,Data]) + end, feed_driver(Port, T, X_return, Qb_before + Size). %% method_name(0) -> pushq; @@ -676,26 +663,22 @@ compare_return(Port, _Data_list, 0, _Back_len) -> 0 = bytes_queued(Port); compare_return(Port, QueuedInPort0, Len_to_get, DeqSize) -> case bytes_queued(Port) of - Len_to_get -> ok; - BytesInQueue -> - io:format("Len_to_get: ~p", [Len_to_get]), - io:format("Bytes in queue: ~p", [BytesInQueue]), - ?line test_server:fail() + Len_to_get -> ok; + BytesInQueue -> + ct:fail("Len_to_get: ~p\nBytes in queue: ~p", [Len_to_get,BytesInQueue]) end, BytesToDequeue = if (DeqSize > Len_to_get) -> Len_to_get; - true -> DeqSize - end, + true -> DeqSize + end, Dequeued = read_head(Port, BytesToDequeue), case bin_prefix(Dequeued, QueuedInPort0) of - true -> - deq(Port, BytesToDequeue), - <<_:BytesToDequeue/binary,QueuedInPort/binary>> = QueuedInPort0, - compare_return(Port, QueuedInPort, Len_to_get - BytesToDequeue, DeqSize); - false -> - io:format("Bytes to dequeue: ~p", [BytesToDequeue]), - io:format("Dequeued: ~p", [Dequeued]), - io:format("Queued in port: ~P", [QueuedInPort0,12]), - ?t:fail() + true -> + deq(Port, BytesToDequeue), + <<_:BytesToDequeue/binary,QueuedInPort/binary>> = QueuedInPort0, + compare_return(Port, QueuedInPort, Len_to_get - BytesToDequeue, DeqSize); + false -> + ct:fail("Bytes to dequeue: ~p\nDequeued: ~p\nQueued in port: ~P", + [BytesToDequeue, Dequeued, QueuedInPort0,12]) end. %% bin_prefix(PrefixBinary, Binary) @@ -713,8 +696,8 @@ queue_op(Port, Method, Data) -> bytes_queued(Port) -> case erlang:port_control(Port, ?BYTES_QUEUED, []) of - <<I:32>> -> I; - Bad -> ?t:fail({bad_result,Bad}) + <<I:32>> -> I; + Bad -> ct:fail({bad_result,Bad}) end. deq(Port, Size) -> @@ -724,83 +707,77 @@ read_head(Port, Size) -> erlang:port_control(Port, ?READ_HEAD, <<Size:32>>). -driver_unloaded(doc) -> - []; -driver_unloaded(suite) -> - []; driver_unloaded(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line Drv = timer_drv, - ?line User = self(), - ?line Loaded = make_ref(), - ?line Die = make_ref(), - ?line Loader = spawn(fun () -> - erl_ddll:start(), - ok = load_driver(?config(data_dir, - Config), - Drv), - User ! Loaded, - receive Die -> exit(bye) end - end), - ?line receive Loaded -> ok end, - ?line Port = open_port({spawn, Drv}, []), - ?line Loader ! Die, - ?line receive - {'EXIT', Port, Reason} -> - ?line driver_unloaded = Reason - %% Reason used to be -1 - end. - - -io_ready_exit(doc) -> []; -io_ready_exit(suite) -> []; + process_flag(trap_exit, true), + Drv = timer_drv, + User = self(), + Loaded = make_ref(), + Die = make_ref(), + Loader = spawn(fun () -> + erl_ddll:start(), + ok = load_driver(proplists:get_value(data_dir, + Config), + Drv), + User ! Loaded, + receive Die -> exit(bye) end + end), + receive Loaded -> ok end, + Port = open_port({spawn, Drv}, []), + Loader ! Die, + receive + {'EXIT', Port, Reason} -> + driver_unloaded = Reason + %% Reason used to be -1 + end. + + io_ready_exit(Config) when is_list(Config) -> - ?line OTE = process_flag(trap_exit, true), - ?line Test = self(), - ?line Dgawd = spawn(fun () -> - ok = dgawd_handler:install(), - Mon = erlang:monitor(process, Test), - Test ! dgawd_handler_started, - receive - {'DOWN', Mon, _, _, _} -> ok; - stop_dgawd_handler -> ok - end, - dgawd_handler:restore(), - Test ! dgawd_handler_stopped - end), - ?line receive dgawd_handler_started -> ok end, - ?line Drv = io_ready_exit_drv, - ?line erl_ddll:start(), - ?line ok = load_driver(?config(data_dir, Config), Drv), - ?line Port = open_port({spawn, Drv}, []), - ?line case erlang:port_control(Port, 0, "") of - "ok" -> - receive - {'EXIT', Port, Reason} -> - ?line case Reason of - ready_output_driver_failure -> - ?t:format("Exited in output_ready()~n"), - ?line ok; - ready_input_driver_failure -> - ?t:format("Exited in input_ready()~n"), - ?line ok; - Error -> ?line ?t:fail(Error) - end - end, - receive after 2000 -> ok end, - ?line false = dgawd_handler:got_dgawd_report(), - ?line Dgawd ! stop_dgawd_handler, - ?line receive dgawd_handler_stopped -> ok end, - ?line process_flag(trap_exit, OTE), - ?line ok; - "nyiftos" -> - ?line process_flag(trap_exit, OTE), - ?line {skipped, "Not yet implemented for this OS"}; - Error -> - ?line process_flag(trap_exit, OTE), - ?line ?t:fail({unexpected_control_result, Error}) - end. - + OTE = process_flag(trap_exit, true), + Test = self(), + Dgawd = spawn(fun () -> + ok = dgawd_handler:install(), + Mon = erlang:monitor(process, Test), + Test ! dgawd_handler_started, + receive + {'DOWN', Mon, _, _, _} -> ok; + stop_dgawd_handler -> ok + end, + dgawd_handler:restore(), + Test ! dgawd_handler_stopped + end), + receive dgawd_handler_started -> ok end, + Drv = io_ready_exit_drv, + erl_ddll:start(), + ok = load_driver(proplists:get_value(data_dir, Config), Drv), + Port = open_port({spawn, Drv}, []), + case erlang:port_control(Port, 0, "") of + "ok" -> + receive + {'EXIT', Port, Reason} -> + case Reason of + ready_output_driver_failure -> + io:format("Exited in output_ready()~n"), + ok; + ready_input_driver_failure -> + io:format("Exited in input_ready()~n"), + ok; + Error -> ct:fail(Error) + end + end, + receive after 2000 -> ok end, + false = dgawd_handler:got_dgawd_report(), + Dgawd ! stop_dgawd_handler, + receive dgawd_handler_stopped -> ok end, + process_flag(trap_exit, OTE), + ok; + "nyiftos" -> + process_flag(trap_exit, OTE), + {skipped, "Not yet implemented for this OS"}; + Error -> + process_flag(trap_exit, OTE), + ct:fail({unexpected_control_result, Error}) + end. + -define(CHKIO_STOP, 0). -define(CHKIO_USE_FALLBACK_POLLSET, 1). @@ -812,138 +789,128 @@ io_ready_exit(Config) when is_list(Config) -> -define(CHKIO_SMP_SELECT, 7). -define(CHKIO_DRV_USE, 8). -use_fallback_pollset(doc) -> []; -use_fallback_pollset(suite) -> []; use_fallback_pollset(Config) when is_list(Config) -> FlbkFun = fun () -> - ChkIoDuring = erlang:system_info(check_io), - case lists:keysearch(fallback_poll_set_size, - 1, - ChkIoDuring) of - {value, - {fallback_poll_set_size, N}} when N > 0 -> - ?line ok; - Error -> - ?line ?t:fail({failed_to_use_fallback, Error}) - end - end, - ?line {BckupTest, Handel, OkRes} - = case chkio_test_init(Config) of - {erts_poll_info, ChkIo} = Hndl -> - case lists:keysearch(fallback, 1, ChkIo) of - {value, {fallback, B}} when B =/= false -> - ?line {FlbkFun, Hndl, ok}; - _ -> - ?line {fun () -> ok end, - Hndl, - {comment, - "This implementation does not use " - "a fallback pollset"}} - end; - Skip -> - {fun () -> ok end, Skip, ok} - end, - ?line case chkio_test_fini(chkio_test(Handel, - ?CHKIO_USE_FALLBACK_POLLSET, - fun () -> - ?line sleep(1000), - ?line BckupTest() - end)) of - {skipped, _} = Res -> ?line Res; - _ -> ?line OkRes - end. - -bad_fd_in_pollset(doc) -> []; -bad_fd_in_pollset(suite) -> []; + ChkIoDuring = erlang:system_info(check_io), + case lists:keysearch(fallback_poll_set_size, + 1, + ChkIoDuring) of + {value, + {fallback_poll_set_size, N}} when N > 0 -> + ok; + Error -> + ct:fail({failed_to_use_fallback, Error}) + end + end, + {BckupTest, Handel, OkRes} + = case chkio_test_init(Config) of + {erts_poll_info, ChkIo} = Hndl -> + case lists:keysearch(fallback, 1, ChkIo) of + {value, {fallback, B}} when B =/= false -> + {FlbkFun, Hndl, ok}; + _ -> + {fun () -> ok end, + Hndl, + {comment, + "This implementation does not use " + "a fallback pollset"}} + end; + Skip -> + {fun () -> ok end, Skip, ok} + end, + case chkio_test_fini(chkio_test(Handel, + ?CHKIO_USE_FALLBACK_POLLSET, + fun () -> + sleep(1000), + BckupTest() + end)) of + {skipped, _} = Res -> Res; + _ -> OkRes + end. + bad_fd_in_pollset(Config) when is_list(Config) -> - ?line chkio_test_fini(chkio_test(chkio_test_init(Config), - ?CHKIO_BAD_FD_IN_POLLSET, - fun () -> ?line sleep(1000) end)). + chkio_test_fini(chkio_test(chkio_test_init(Config), + ?CHKIO_BAD_FD_IN_POLLSET, + fun () -> sleep(1000) end)). -driver_event(doc) -> []; -driver_event(suite) -> []; driver_event(Config) when is_list(Config) -> - ?line chkio_test_fini(chkio_test(chkio_test_init(Config), - ?CHKIO_DRIVER_EVENT, - fun () -> ?line sleep(1000) end)). + chkio_test_fini(chkio_test(chkio_test_init(Config), + ?CHKIO_DRIVER_EVENT, + fun () -> sleep(1000) end)). -fd_change(doc) -> []; -fd_change(suite) -> []; fd_change(Config) when is_list(Config) -> - ?line chkio_test_fini(chkio_test(chkio_test_init(Config), - ?CHKIO_FD_CHANGE, - fun () -> ?line sleep(1000) end)). + chkio_test_fini(chkio_test(chkio_test_init(Config), + ?CHKIO_FD_CHANGE, + fun () -> sleep(1000) end)). -steal_control(doc) -> []; -steal_control(suite) -> []; steal_control(Config) when is_list(Config) -> - ?line chkio_test_fini(case chkio_test_init(Config) of - {erts_poll_info, _} = Hndl -> - ?line steal_control_test(Hndl); - Skip -> - ?line Skip - end). + chkio_test_fini(case chkio_test_init(Config) of + {erts_poll_info, _} = Hndl -> + steal_control_test(Hndl); + Skip -> + Skip + end). steal_control_test(Hndl = {erts_poll_info, Before}) -> - ?line Port = open_chkio_port(), - ?line case erlang:port_control(Port, ?CHKIO_STEAL_AUX, "") of - [$f,$d,$s,$:| _] = FdList -> - ?line chk_chkio_port(Port), - sleep(500), - ?line chk_chkio_port(Port), - ?line Res = chkio_test(Hndl, - ?CHKIO_STEAL, - FdList, - fun () -> - ?line chk_chkio_port(Port), - ?line sleep(500), - ?line chk_chkio_port(Port) - end), - ?line case erlang:port_control(Port, ?CHKIO_STOP, "") of - "ok" -> - ?line chk_chkio_port(Port), - ?line ok; - StopErr -> - ?line chk_chkio_port(Port), - ?line ?t:fail({stop_error, StopErr}) - end, - ?line close_chkio_port(Port), - ?line Res; - [$s,$k,$i,$p,$:,$\ |Skip] -> - ?line chk_chkio_port(Port), - ?line close_chkio_port(Port), - {chkio_test_result, - {skipped, Skip}, - Before}; - StartErr -> - ?line chk_chkio_port(Port), - ?line ?t:fail({start_error, StartErr}) - end. + Port = open_chkio_port(), + case erlang:port_control(Port, ?CHKIO_STEAL_AUX, "") of + [$f,$d,$s,$:| _] = FdList -> + chk_chkio_port(Port), + sleep(500), + chk_chkio_port(Port), + Res = chkio_test(Hndl, + ?CHKIO_STEAL, + FdList, + fun () -> + chk_chkio_port(Port), + sleep(500), + chk_chkio_port(Port) + end), + case erlang:port_control(Port, ?CHKIO_STOP, "") of + "ok" -> + chk_chkio_port(Port), + ok; + StopErr -> + chk_chkio_port(Port), + ct:fail({stop_error, StopErr}) + end, + close_chkio_port(Port), + Res; + [$s,$k,$i,$p,$:,$\ |Skip] -> + chk_chkio_port(Port), + close_chkio_port(Port), + {chkio_test_result, + {skipped, Skip}, + Before}; + StartErr -> + chk_chkio_port(Port), + ct:fail({start_error, StartErr}) + end. chkio_test_init(Config) when is_list(Config) -> - ?line ChkIo = get_stable_check_io_info(), - ?line case catch lists:keysearch(name, 1, ChkIo) of - {value, {name, erts_poll}} -> - ?line ?t:format("Before test: ~p~n", [ChkIo]), - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:start(), - ?line ok = load_driver(Path, 'chkio_drv'), - ?line process_flag(trap_exit, true), - ?line {erts_poll_info, ChkIo}; - _ -> - ?line {skipped, "Test written to test erts_poll() which isn't used"} - end. - + ChkIo = get_stable_check_io_info(), + case catch lists:keysearch(name, 1, ChkIo) of + {value, {name, erts_poll}} -> + io:format("Before test: ~p~n", [ChkIo]), + Path = proplists:get_value(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, 'chkio_drv'), + process_flag(trap_exit, true), + {erts_poll_info, ChkIo}; + _ -> + {skipped, "Test written to test erts_poll() which isn't used"} + end. + chkio_test_fini({skipped, _} = Res) -> Res; chkio_test_fini({chkio_test_result, Res, Before}) -> - ?line ok = erl_ddll:unload_driver('chkio_drv'), - ?line ok = erl_ddll:stop(), - ?line After = get_stable_check_io_info(), - ?line ?t:format("After test: ~p~n", [After]), - ?line verify_chkio_state(Before, After), - ?line Res. + ok = erl_ddll:unload_driver('chkio_drv'), + ok = erl_ddll:stop(), + After = get_stable_check_io_info(), + io:format("After test: ~p~n", [After]), + verify_chkio_state(Before, After), + Res. open_chkio_port() -> open_port({spawn, 'chkio_drv'}, []). @@ -951,269 +918,255 @@ open_chkio_port() -> close_chkio_port(Port) when is_port(Port) -> true = erlang:port_close(Port), receive - {'EXIT', Port, normal} -> - ok; - {'EXIT', Port, Reason} -> - ?t:fail({abnormal_port_exit, Port, Reason}); - {Port, Message} -> - ?t:fail({strange_message_from_port, Message}) + {'EXIT', Port, normal} -> + ok; + {'EXIT', Port, Reason} -> + ct:fail({abnormal_port_exit, Port, Reason}); + {Port, Message} -> + ct:fail({strange_message_from_port, Message}) end. chk_chkio_port(Port) -> receive - {'EXIT', Port, Reason} when Reason /= normal -> - ?t:fail({port_exited, Port, Reason}) + {'EXIT', Port, Reason} when Reason /= normal -> + ct:fail({port_exited, Port, Reason}) after 0 -> - ok + ok end. - + chkio_test({skipped, _} = Res, _Test, _Fun) -> - ?line Res; + Res; chkio_test({erts_poll_info, _Before} = EPI, Test, Fun) when is_integer(Test) -> chkio_test(EPI, Test, "", Fun). chkio_test({skipped, _} = Res, _Test, _TestArgs, _Fun) -> - ?line Res; + Res; chkio_test({erts_poll_info, Before}, - Test, - TestArgs, - Fun) when is_integer(Test), - is_list(TestArgs) -> - ?line Port = open_chkio_port(), - ?line case erlang:port_control(Port, Test, TestArgs) of - "ok" -> - ?line chk_chkio_port(Port), - ?line Fun(), - ?line During = erlang:system_info(check_io), - ?line erlang:display(During), - ?line 0 = element(1, erts_debug:get_internal_state(check_io_debug)), - ?line ?t:format("During test: ~p~n", [During]), - ?line chk_chkio_port(Port), - ?line case erlang:port_control(Port, ?CHKIO_STOP, "") of - Res when is_list(Res) -> - ?line chk_chkio_port(Port), - ?line ?t:format("~s", [Res]), - ?line close_chkio_port(Port), - ?line Res, - ?line case Res of - [$c,$o,$m,$m,$e,$n,$t,$:,$\ |Cmnt] -> - ?line {chkio_test_result, - {comment, Cmnt}, - Before}; - _ -> - ?line {chkio_test_result, - Res, - Before} - end; - StopErr -> - ?line chk_chkio_port(Port), - ?line ?t:fail({stop_error, StopErr}) - end; - [$s,$k,$i,$p,$:,$\ |Skip] -> - ?line chk_chkio_port(Port), - ?line close_chkio_port(Port), - {chkio_test_result, - {skipped, Skip}, - Before}; - StartErr -> - ?line chk_chkio_port(Port), - ?line ?t:fail({start_error, StartErr}) - end. + Test, + TestArgs, + Fun) when is_integer(Test), + is_list(TestArgs) -> + Port = open_chkio_port(), + case erlang:port_control(Port, Test, TestArgs) of + "ok" -> + chk_chkio_port(Port), + Fun(), + During = erlang:system_info(check_io), + erlang:display(During), + 0 = element(1, erts_debug:get_internal_state(check_io_debug)), + io:format("During test: ~p~n", [During]), + chk_chkio_port(Port), + case erlang:port_control(Port, ?CHKIO_STOP, "") of + Res when is_list(Res) -> + chk_chkio_port(Port), + io:format("~s", [Res]), + close_chkio_port(Port), + Res, + case Res of + [$c,$o,$m,$m,$e,$n,$t,$:,$\ |Cmnt] -> + {chkio_test_result, + {comment, Cmnt}, + Before}; + _ -> + {chkio_test_result, + Res, + Before} + end; + StopErr -> + chk_chkio_port(Port), + ct:fail({stop_error, StopErr}) + end; + [$s,$k,$i,$p,$:,$\ |Skip] -> + chk_chkio_port(Port), + close_chkio_port(Port), + {chkio_test_result, + {skipped, Skip}, + Before}; + StartErr -> + chk_chkio_port(Port), + ct:fail({start_error, StartErr}) + end. verify_chkio_state(Before, After) -> - ?line TotSetSize = lists:keysearch(total_poll_set_size, 1, Before), - ?line TotSetSize = lists:keysearch(total_poll_set_size, 1, After), - ?line case lists:keysearch(fallback, 1, Before) of - {value,{fallback,false}} -> - ?line ok; - _ -> - ?line BckupSetSize = lists:keysearch(fallback_poll_set_size, - 1, - Before), - ?line BckupSetSize = lists:keysearch(fallback_poll_set_size, - 1, - After) - end, - ?line ok. + TotSetSize = lists:keysearch(total_poll_set_size, 1, Before), + TotSetSize = lists:keysearch(total_poll_set_size, 1, After), + case lists:keysearch(fallback, 1, Before) of + {value,{fallback,false}} -> + ok; + _ -> + BckupSetSize = lists:keysearch(fallback_poll_set_size, + 1, + Before), + BckupSetSize = lists:keysearch(fallback_poll_set_size, + 1, + After) + end, + ok. get_stable_check_io_info() -> ChkIo = erlang:system_info(check_io), PendUpdNo = case lists:keysearch(pending_updates, 1, ChkIo) of - {value, {pending_updates, PendNo}} -> - PendNo; - false -> - 0 - end, + {value, {pending_updates, PendNo}} -> + PendNo; + false -> + 0 + end, {value, {active_fds, ActFds}} = lists:keysearch(active_fds, 1, ChkIo), case {PendUpdNo, ActFds} of - {0, 0} -> - ChkIo; - _ -> - receive after 10 -> ok end, - get_stable_check_io_info() + {0, 0} -> + ChkIo; + _ -> + receive after 10 -> ok end, + get_stable_check_io_info() end. -otp_6602(doc) -> ["Missed port lock when stealing control of fd from a " - "driver that didn't use the same lock. The lock checker " - "used to trigger on this and dump core."]; -otp_6602(suite) -> - []; +%% Missed port lock when stealing control of fd from a +%% driver that didn't use the same lock. The lock checker +%% used to trigger on this and dump core. otp_6602(Config) when is_list(Config) -> - ?line {ok, Node} = start_node(Config), - ?line Done = make_ref(), - ?line Parent = self(), - ?line Tester = spawn_link(Node, - fun () -> - %% Inet driver use port locking... - {ok, S} = gen_udp:open(0), - {ok, Fd} = inet:getfd(S), - %% Steal fd (lock checker used to - %% trigger here). - {ok, _S2} = gen_udp:open(0,[{fd,Fd}]), - Parent ! Done - end), - ?line receive Done -> ok end, - ?line unlink(Tester), - ?line stop_node(Node), - ?line ok. + {ok, Node} = start_node(Config), + Done = make_ref(), + Parent = self(), + Tester = spawn_link(Node, + fun () -> + %% Inet driver use port locking... + {ok, S} = gen_udp:open(0), + {ok, Fd} = inet:getfd(S), + %% Steal fd (lock checker used to + %% trigger here). + {ok, _S2} = gen_udp:open(0,[{fd,Fd}]), + Parent ! Done + end), + receive Done -> ok end, + unlink(Tester), + stop_node(Node), + ok. -define(EXPECTED_SYSTEM_INFO_NAMES1, - ["drv_drv_vsn", - "emu_drv_vsn", - "erts_vsn", - "otp_vsn", - "thread", - "smp"]). + ["drv_drv_vsn", + "emu_drv_vsn", + "erts_vsn", + "otp_vsn", + "thread", + "smp"]). -define(EXPECTED_SYSTEM_INFO_NAMES2, - (?EXPECTED_SYSTEM_INFO_NAMES1 ++ - ["async_thrs", - "sched_thrs"])). + (?EXPECTED_SYSTEM_INFO_NAMES1 ++ + ["async_thrs", + "sched_thrs"])). -define(EXPECTED_SYSTEM_INFO_NAMES3, - (?EXPECTED_SYSTEM_INFO_NAMES2 ++ - ["emu_nif_vsn"])). + (?EXPECTED_SYSTEM_INFO_NAMES2 ++ + ["emu_nif_vsn"])). -define(EXPECTED_SYSTEM_INFO_NAMES4, - (?EXPECTED_SYSTEM_INFO_NAMES3 ++ - ["dirty_sched"])). + (?EXPECTED_SYSTEM_INFO_NAMES3 ++ + ["dirty_sched"])). -define(EXPECTED_SYSTEM_INFO_NAMES, ?EXPECTED_SYSTEM_INFO_NAMES4). -'driver_system_info_base_ver'(doc) -> - []; -'driver_system_info_base_ver'(suite) -> - []; 'driver_system_info_base_ver'(Config) when is_list(Config) -> - ?line driver_system_info_test(Config, sys_info_base_drv). + driver_system_info_test(Config, sys_info_base_drv). -'driver_system_info_prev_ver'(doc) -> - []; -'driver_system_info_prev_ver'(suite) -> - []; 'driver_system_info_prev_ver'(Config) when is_list(Config) -> - ?line driver_system_info_test(Config, sys_info_prev_drv). + driver_system_info_test(Config, sys_info_prev_drv). -driver_system_info_current_ver(doc) -> - []; -driver_system_info_current_ver(suite) -> - []; driver_system_info_current_ver(Config) when is_list(Config) -> - ?line driver_system_info_test(Config, sys_info_curr_drv). + driver_system_info_test(Config, sys_info_curr_drv). driver_system_info_test(Config, Name) -> - ?line Port = start_driver(Config, Name, false), - ?line case erlang:port_control(Port, 0, []) of - [$o,$k,$:,_ | Result] -> - ?line check_driver_system_info_result(Result); - [$e,$r,$r,$o,$r,$:,_ | Error] -> - ?line ?t:fail(Error); - Unexpected -> - ?line ?t:fail({unexpected_result, Unexpected}) - end, - ?line stop_driver(Port, Name), - ?line ok. + Port = start_driver(Config, Name, false), + case erlang:port_control(Port, 0, []) of + [$o,$k,$:,_ | Result] -> + check_driver_system_info_result(Result); + [$e,$r,$r,$o,$r,$:,_ | Error] -> + ct:fail(Error); + Unexpected -> + ct:fail({unexpected_result, Unexpected}) + end, + stop_driver(Port, Name), + ok. check_driver_system_info_result(Result) -> - ?line ?t:format("All names: ~p~n", [?EXPECTED_SYSTEM_INFO_NAMES]), - ?line ?t:format("Result: ~p~n", [Result]), - ?line {[], Ns, DDVSN} = chk_sis(lists:map(fun (Str) -> - string:tokens(Str, "=") - end, - string:tokens(Result, " ")), - ?EXPECTED_SYSTEM_INFO_NAMES), - ?line case {DDVSN, - drv_vsn_str2tup(erlang:system_info(driver_version))} of - {DDVSN, DDVSN} -> - ?line [] = Ns; - %% {{1, 0}, _} -> - %% ?line ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES - %% -- ?EXPECTED_SYSTEM_INFO_NAMES1), - %% ?line ExpNs = lists:sort(Ns); - %% {{1, 1}, _} -> - %% ?line ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES - %% -- ?EXPECTED_SYSTEM_INFO_NAMES2), - %% ?line ExpNs = lists:sort(Ns); - {{3, 0}, _} -> - ?line ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES - -- ?EXPECTED_SYSTEM_INFO_NAMES3), - ?line ExpNs = lists:sort(Ns) - end. + io:format("All names: ~p~n", [?EXPECTED_SYSTEM_INFO_NAMES]), + io:format("Result: ~p~n", [Result]), + {[], Ns, DDVSN} = chk_sis(lists:map(fun (Str) -> + string:tokens(Str, "=") + end, + string:tokens(Result, " ")), + ?EXPECTED_SYSTEM_INFO_NAMES), + case {DDVSN, + drv_vsn_str2tup(erlang:system_info(driver_version))} of + {DDVSN, DDVSN} -> + [] = Ns; + %% {{1, 0}, _} -> + %% ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES + %% -- ?EXPECTED_SYSTEM_INFO_NAMES1), + %% ExpNs = lists:sort(Ns); + %% {{1, 1}, _} -> + %% ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES + %% -- ?EXPECTED_SYSTEM_INFO_NAMES2), + %% ExpNs = lists:sort(Ns); + {{3, 0}, _} -> + ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES + -- ?EXPECTED_SYSTEM_INFO_NAMES3), + ExpNs = lists:sort(Ns) + end. chk_sis(SIs, Ns) -> chk_sis(SIs, Ns, unknown). chk_sis(SIs, [], DDVSN) -> - ?line {SIs, [], DDVSN}; + {SIs, [], DDVSN}; chk_sis([], Ns, DDVSN) -> - ?line {[], Ns, DDVSN}; + {[], Ns, DDVSN}; chk_sis([[N, _] = SI| SIs], Ns, DDVSN) -> - ?line true = lists:member(N, Ns), - ?line case check_si_res(SI) of - {driver_version, NewDDVSN} -> - ?line chk_sis(SIs, lists:delete(N, Ns), NewDDVSN); - _ -> - ?line chk_sis(SIs, lists:delete(N, Ns), DDVSN) - end. + true = lists:member(N, Ns), + case check_si_res(SI) of + {driver_version, NewDDVSN} -> + chk_sis(SIs, lists:delete(N, Ns), NewDDVSN); + _ -> + chk_sis(SIs, lists:delete(N, Ns), DDVSN) + end. %% Data in first version of driver_system_info() (driver version 1.0) check_si_res(["drv_drv_vsn", Value]) -> - ?line DDVSN = drv_vsn_str2tup(Value), - ?line {Major, DMinor} = DDVSN, - ?line {Major, EMinor} = drv_vsn_str2tup(erlang:system_info(driver_version)), - ?line true = DMinor =< EMinor, - ?line {driver_version, DDVSN}; + DDVSN = drv_vsn_str2tup(Value), + {Major, DMinor} = DDVSN, + {Major, EMinor} = drv_vsn_str2tup(erlang:system_info(driver_version)), + true = DMinor =< EMinor, + {driver_version, DDVSN}; check_si_res(["emu_drv_vsn", Value]) -> - ?line Value = erlang:system_info(driver_version); + Value = erlang:system_info(driver_version); check_si_res(["erts_vsn", Value]) -> - ?line Value = erlang:system_info(version); + Value = erlang:system_info(version); check_si_res(["otp_vsn", Value]) -> - ?line Value = erlang:system_info(otp_release); + Value = erlang:system_info(otp_release); check_si_res(["thread", "true"]) -> - ?line true = erlang:system_info(threads); + true = erlang:system_info(threads); check_si_res(["thread", "false"]) -> - ?line false = erlang:system_info(threads); + false = erlang:system_info(threads); check_si_res(["smp", "true"]) -> - ?line true = erlang:system_info(smp_support); + true = erlang:system_info(smp_support); check_si_res(["smp", "false"]) -> - ?line false = erlang:system_info(smp_support); + false = erlang:system_info(smp_support); %% Data added in second version of driver_system_info() (driver version 1.1) check_si_res(["async_thrs", Value]) -> - ?line Value = integer_to_list(erlang:system_info(thread_pool_size)); + Value = integer_to_list(erlang:system_info(thread_pool_size)); check_si_res(["sched_thrs", Value]) -> - ?line Value = integer_to_list(erlang:system_info(schedulers)); + Value = integer_to_list(erlang:system_info(schedulers)); %% Data added in 3rd version of driver_system_info() (driver version 1.5) check_si_res(["emu_nif_vsn", Value]) -> - ?line Value = erlang:system_info(nif_version); + Value = erlang:system_info(nif_version); %% Data added in 4th version of driver_system_info() (driver version 3.1) check_si_res(["dirty_sched", _Value]) -> true; check_si_res(Unexpected) -> - ?line ?t:fail({unexpected_result, Unexpected}). + ct:fail({unexpected_result, Unexpected}). -define(MON_OP_I_AM_IPID,1). -define(MON_OP_MONITOR_ME,2). @@ -1221,171 +1174,168 @@ check_si_res(Unexpected) -> -define(MON_OP_MONITOR_ME_LATER,4). -define(MON_OP_DO_DELAYED_MONITOR,5). -driver_monitor(suite) -> - []; -driver_monitor(doc) -> - ["Test monitoring of processes from drivers"]; +%% Test monitoring of processes from drivers driver_monitor(Config) when is_list(Config) -> - ?line Name = monitor_drv, - ?line Port = start_driver(Config, Name, false), - ?line "ok" = port_control(Port,?MON_OP_I_AM_IPID,[]), - ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), - ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), - ?line {monitors, []} = erlang:port_info(Port,monitors), - - ?line "ok:"++Id1 = port_control(Port,?MON_OP_MONITOR_ME_LATER,[]), - ?line {monitored_by, []} = process_info(self(),monitored_by), - ?line "ok" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id1), - ?line {monitored_by, [Port]} = process_info(self(),monitored_by), - ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), - ?line {monitored_by, []} = process_info(self(),monitored_by), - - ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), - ?line Me = self(), - ?line {Pid1,Ref1} = - spawn_monitor(fun() -> - Me ! port_control(Port,?MON_OP_MONITOR_ME,[]), - Me ! process_info(self(),monitored_by), - Me ! erlang:port_info(Port,monitors) - end), - ?line ok = receive - "ok" -> - ok - after 1000 -> - timeout - end, - ?line ok = receive - {monitored_by, L} -> - L2 = lists:sort(L), - L3 = lists:sort([Me,Port]), - case L2 of - L3 -> - ok; - _ -> - mismatch - end - after 1000 -> - timeout - end, - ?line ok = receive - {monitors, LL} -> - LL2 = lists:sort(LL), - LL3 = lists:sort([{process,Me},{process,Pid1}]), - case LL2 of - LL3 -> - ok; - _ -> - mismatch - end - after 1000 -> - timeout - end, - ?line ok = receive - {'DOWN', Ref1, process, Pid1, _} -> - ok - after 1000 -> - timeout - end, - ?line ok = receive - {monitor_fired,Port,Pid1} -> - ok - after 1000 -> - timeout - end, - ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), - ?line {monitors,[]} = erlang:port_info(Port,monitors), - ?line {monitored_by, []} = process_info(self(),monitored_by), - - ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), - ?line {Pid2,Ref2} = - spawn_monitor(fun() -> - receive go -> ok end, - Me ! port_control(Port,?MON_OP_MONITOR_ME_LATER,[]), - Me ! process_info(self(),monitored_by), - Me ! erlang:port_info(Port,monitors) - end), - ?line Pid2 ! go, - ?line {ok,Id2} = receive - "ok:"++II -> - {ok,II} - after 1000 -> - timeout - end, - ?line ok = receive - {monitored_by, [Me]} -> - ok - after 1000 -> - timeout - end, - ?line ok = receive - {monitors, [{process,Me}]} -> - ok - after 1000 -> - timeout - end, - ?line ok = receive - {'DOWN', Ref2, process, Pid2, _} -> - ok - after 1000 -> - timeout - end, - ?line "noproc" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id2), - ?line {monitors,[{process,Me}]} = erlang:port_info(Port,monitors), - ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), - ?line "not_monitored" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), - ?line {monitors,[]} = erlang:port_info(Port,monitors), - ?line {monitored_by, []} = process_info(self(),monitored_by), - - - ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), - ?line {Pid3,Ref3} = - spawn_monitor(fun() -> - receive go -> ok end, - Me ! port_control(Port,?MON_OP_MONITOR_ME_LATER,[]), - Me ! process_info(self(),monitored_by), - Me ! erlang:port_info(Port,monitors) , - receive die -> ok end - end), - ?line Pid3 ! go, - ?line {ok,Id3} = receive - "ok:"++III -> - {ok,III} - after 1000 -> - timeout - end, - ?line ok = receive - {monitored_by, [Me]} -> - ok - after 1000 -> - timeout - end, - ?line ok = receive - {monitors, [{process,Me}]} -> - ok - after 1000 -> - timeout - end, - ?line "ok" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id3), - ?line LLL1 = lists:sort([{process,Me},{process,Pid3}]), - ?line {monitors,LLL2} = erlang:port_info(Port,monitors), - ?line LLL1 = lists:sort(LLL2), - ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), - ?line {monitors,[{process,Pid3}]} = erlang:port_info(Port,monitors), - ?line Pid3 ! die, - ?line ok = receive - {'DOWN', Ref3, process, Pid3, _} -> - ok - after 1000 -> - timeout - end, - ?line "not_found" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id2), - ?line {monitors,[]} = erlang:port_info(Port,monitors), - ?line "not_monitored" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), - ?line {monitors,[]} = erlang:port_info(Port,monitors), - ?line {monitored_by, []} = process_info(self(),monitored_by), - - ?line stop_driver(Port, Name), - ?line ok. + Name = monitor_drv, + Port = start_driver(Config, Name, false), + "ok" = port_control(Port,?MON_OP_I_AM_IPID,[]), + "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), + "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + {monitors, []} = erlang:port_info(Port,monitors), + + "ok:"++Id1 = port_control(Port,?MON_OP_MONITOR_ME_LATER,[]), + {monitored_by, []} = process_info(self(),monitored_by), + "ok" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id1), + {monitored_by, [Port]} = process_info(self(),monitored_by), + "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + {monitored_by, []} = process_info(self(),monitored_by), + + "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), + Me = self(), + {Pid1,Ref1} = + spawn_monitor(fun() -> + Me ! port_control(Port,?MON_OP_MONITOR_ME,[]), + Me ! process_info(self(),monitored_by), + Me ! erlang:port_info(Port,monitors) + end), + ok = receive + "ok" -> + ok + after 1000 -> + timeout + end, + ok = receive + {monitored_by, L} -> + L2 = lists:sort(L), + L3 = lists:sort([Me,Port]), + case L2 of + L3 -> + ok; + _ -> + mismatch + end + after 1000 -> + timeout + end, + ok = receive + {monitors, LL} -> + LL2 = lists:sort(LL), + LL3 = lists:sort([{process,Me},{process,Pid1}]), + case LL2 of + LL3 -> + ok; + _ -> + mismatch + end + after 1000 -> + timeout + end, + ok = receive + {'DOWN', Ref1, process, Pid1, _} -> + ok + after 1000 -> + timeout + end, + ok = receive + {monitor_fired,Port,Pid1} -> + ok + after 1000 -> + timeout + end, + "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + {monitors,[]} = erlang:port_info(Port,monitors), + {monitored_by, []} = process_info(self(),monitored_by), + + "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), + {Pid2,Ref2} = + spawn_monitor(fun() -> + receive go -> ok end, + Me ! port_control(Port,?MON_OP_MONITOR_ME_LATER,[]), + Me ! process_info(self(),monitored_by), + Me ! erlang:port_info(Port,monitors) + end), + Pid2 ! go, + {ok,Id2} = receive + "ok:"++II -> + {ok,II} + after 1000 -> + timeout + end, + ok = receive + {monitored_by, [Me]} -> + ok + after 1000 -> + timeout + end, + ok = receive + {monitors, [{process,Me}]} -> + ok + after 1000 -> + timeout + end, + ok = receive + {'DOWN', Ref2, process, Pid2, _} -> + ok + after 1000 -> + timeout + end, + "noproc" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id2), + {monitors,[{process,Me}]} = erlang:port_info(Port,monitors), + "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + "not_monitored" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + {monitors,[]} = erlang:port_info(Port,monitors), + {monitored_by, []} = process_info(self(),monitored_by), + + + "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), + {Pid3,Ref3} = + spawn_monitor(fun() -> + receive go -> ok end, + Me ! port_control(Port,?MON_OP_MONITOR_ME_LATER,[]), + Me ! process_info(self(),monitored_by), + Me ! erlang:port_info(Port,monitors) , + receive die -> ok end + end), + Pid3 ! go, + {ok,Id3} = receive + "ok:"++III -> + {ok,III} + after 1000 -> + timeout + end, + ok = receive + {monitored_by, [Me]} -> + ok + after 1000 -> + timeout + end, + ok = receive + {monitors, [{process,Me}]} -> + ok + after 1000 -> + timeout + end, + "ok" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id3), + LLL1 = lists:sort([{process,Me},{process,Pid3}]), + {monitors,LLL2} = erlang:port_info(Port,monitors), + LLL1 = lists:sort(LLL2), + "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + {monitors,[{process,Pid3}]} = erlang:port_info(Port,monitors), + Pid3 ! die, + ok = receive + {'DOWN', Ref3, process, Pid3, _} -> + ok + after 1000 -> + timeout + end, + "not_found" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id2), + {monitors,[]} = erlang:port_info(Port,monitors), + "not_monitored" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + {monitors,[]} = erlang:port_info(Port,monitors), + {monitored_by, []} = process_info(self(),monitored_by), + + stop_driver(Port, Name), + ok. -define(IOQ_EXIT_READY_INPUT, 1). @@ -1399,726 +1349,663 @@ driver_monitor(Config) when is_list(Config) -> -define(IOQ_EXIT_EVENT_ASYNC, 9). ioq_exit_test(Config, TestNo) -> - ?line Drv = ioq_exit_drv, - ?line try - begin - ?line case load_driver(?config(data_dir, Config), - Drv) of - ok -> ?line ok; - {error, permanent} -> ?line ok; - LoadError -> ?line ?t:fail({load_error, LoadError}) - end, - case open_port({spawn, Drv}, []) of - Port when is_port(Port) -> - try port_control(Port, TestNo, "") of - "ok" -> - ?line ok; - "nyiftos" -> - ?line throw({skipped, - "Not yet implemented for " - "this OS"}); - [$s,$k,$i,$p,$:,$ | Comment] -> - ?line throw({skipped, Comment}); - [$e,$r,$r,$o,$r,$:,$ | Error] -> - ?line ?t:fail(Error) - after - Port ! {self(), close}, - receive {Port, closed} -> ok end, - false = lists:member(Port, erlang:ports()), - ok - end; - Error -> - ?line ?t:fail({open_port_failed, Error}) - end - end - catch - throw:Term -> ?line Term - after - erl_ddll:unload_driver(Drv) - end. - -ioq_exit_ready_input(doc) -> []; -ioq_exit_ready_input(suite) -> []; + Drv = ioq_exit_drv, + try + begin + case load_driver(proplists:get_value(data_dir, Config), + Drv) of + ok -> ok; + {error, permanent} -> ok; + LoadError -> ct:fail({load_error, LoadError}) + end, + case open_port({spawn, Drv}, []) of + Port when is_port(Port) -> + try port_control(Port, TestNo, "") of + "ok" -> + ok; + "nyiftos" -> + throw({skipped, + "Not yet implemented for " + "this OS"}); + [$s,$k,$i,$p,$:,$ | Comment] -> + throw({skipped, Comment}); + [$e,$r,$r,$o,$r,$:,$ | Error] -> + ct:fail(Error) + after + Port ! {self(), close}, + receive {Port, closed} -> ok end, + false = lists:member(Port, erlang:ports()), + ok + end; + Error -> + ct:fail({open_port_failed, Error}) + end + end + catch + throw:Term -> Term + after + erl_ddll:unload_driver(Drv) + end. + ioq_exit_ready_input(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_READY_INPUT). -ioq_exit_ready_output(doc) -> []; -ioq_exit_ready_output(suite) -> []; ioq_exit_ready_output(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_READY_OUTPUT). -ioq_exit_timeout(doc) -> []; -ioq_exit_timeout(suite) -> []; ioq_exit_timeout(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_TIMEOUT). -ioq_exit_ready_async(doc) -> []; -ioq_exit_ready_async(suite) -> []; ioq_exit_ready_async(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_READY_ASYNC). -ioq_exit_event(doc) -> []; -ioq_exit_event(suite) -> []; ioq_exit_event(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_EVENT). -ioq_exit_ready_input_async(doc) -> []; -ioq_exit_ready_input_async(suite) -> []; ioq_exit_ready_input_async(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_READY_INPUT_ASYNC). -ioq_exit_ready_output_async(doc) -> []; -ioq_exit_ready_output_async(suite) -> []; ioq_exit_ready_output_async(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_READY_OUTPUT_ASYNC). -ioq_exit_timeout_async(doc) -> []; -ioq_exit_timeout_async(suite) -> []; ioq_exit_timeout_async(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_TIMEOUT_ASYNC). -ioq_exit_event_async(doc) -> []; -ioq_exit_event_async(suite) -> []; ioq_exit_event_async(Config) when is_list(Config) -> ioq_exit_test(Config, ?IOQ_EXIT_EVENT_ASYNC). vsn_mismatch_test(Config, LoadResult) -> - ?line Path = ?config(data_dir, Config), - ?line DrvName = ?config(testcase, Config), - ?line LoadResult = load_driver(Path, DrvName), - ?line case LoadResult of - ok -> - ?line Port = open_port({spawn, DrvName}, []), - ?line true = is_port(Port), - ?line true = port_close(Port), - ?line ok = erl_ddll:unload_driver(DrvName); - _ -> - ?line ok - end. - -zero_extended_marker_garb_drv(doc) -> []; -zero_extended_marker_garb_drv(suite) -> []; + Path = proplists:get_value(data_dir, Config), + DrvName = proplists:get_value(testcase, Config), + LoadResult = load_driver(Path, DrvName), + case LoadResult of + ok -> + Port = open_port({spawn, DrvName}, []), + true = is_port(Port), + true = port_close(Port), + ok = erl_ddll:unload_driver(DrvName); + _ -> + ok + end. + zero_extended_marker_garb_drv(Config) when is_list(Config) -> vsn_mismatch_test(Config, {error, driver_incorrect_version}). -invalid_extended_marker_drv(doc) -> []; -invalid_extended_marker_drv(suite) -> []; invalid_extended_marker_drv(Config) when is_list(Config) -> vsn_mismatch_test(Config, {error, driver_incorrect_version}). -larger_major_vsn_drv(doc) -> []; -larger_major_vsn_drv(suite) -> []; larger_major_vsn_drv(Config) when is_list(Config) -> vsn_mismatch_test(Config, {error, driver_incorrect_version}). -larger_minor_vsn_drv(doc) -> []; -larger_minor_vsn_drv(suite) -> []; larger_minor_vsn_drv(Config) when is_list(Config) -> vsn_mismatch_test(Config, {error, driver_incorrect_version}). -smaller_major_vsn_drv(doc) -> []; -smaller_major_vsn_drv(suite) -> []; smaller_major_vsn_drv(Config) when is_list(Config) -> vsn_mismatch_test(Config, {error, driver_incorrect_version}). -smaller_minor_vsn_drv(doc) -> []; -smaller_minor_vsn_drv(suite) -> []; smaller_minor_vsn_drv(Config) when is_list(Config) -> DrvVsnStr = erlang:system_info(driver_version), case drv_vsn_str2tup(DrvVsnStr) of - {_, 0} -> - {skipped, - "Cannot perform test when minor driver version is 0. " - "Current driver version is " ++ DrvVsnStr ++ "."}; - _ -> - vsn_mismatch_test(Config, ok) + {_, 0} -> + {skipped, + "Cannot perform test when minor driver version is 0. " + "Current driver version is " ++ DrvVsnStr ++ "."}; + _ -> + vsn_mismatch_test(Config, ok) end. -define(PEEK_NONXQ_TEST, 0). -define(PEEK_NONXQ_WAIT, 1). -peek_non_existing_queue(doc) -> []; -peek_non_existing_queue(suite) -> []; peek_non_existing_queue(Config) when is_list(Config) -> - ?line OTE = process_flag(trap_exit, true), - ?line Drv = peek_non_existing_queue_drv, - ?line try - begin - ?line case load_driver(?config(data_dir, Config), - Drv) of - ok -> ?line ok; - {error, permanent} -> ?line ok; - LoadError -> ?line ?t:fail({load_error, LoadError}) - end, - case open_port({spawn, Drv}, []) of - Port1 when is_port(Port1) -> - try port_control(Port1, ?PEEK_NONXQ_TEST, "") of - "ok" -> - ?line ok; - [$s,$k,$i,$p,$p,$e,$d,$:,$ | SkipReason] -> - ?line throw({skipped, SkipReason}); - [$e,$r,$r,$o,$r,$:,$ | Error1] -> - ?line ?t:fail(Error1) - after - exit(Port1, kill), - receive {'EXIT', Port1, _} -> ok end - end; - Error1 -> - ?line ?t:fail({open_port1_failed, Error1}) - end, - case open_port({spawn, Drv}, []) of - Port2 when is_port(Port2) -> - try port_control(Port2, ?PEEK_NONXQ_WAIT, "") of - "ok" -> - ?line ok; - [$e,$r,$r,$o,$r,$:,$ | Error2] -> - ?line ?t:fail(Error2) - after - receive {Port2, test_successful} -> ok end, - Port2 ! {self(), close}, - receive {Port2, closed} -> ok end - end; - Error2 -> - ?line ?t:fail({open_port2_failed, Error2}) - end - end - catch - throw:Term -> ?line Term - after - process_flag(trap_exit, OTE), - erl_ddll:unload_driver(Drv) - end. - -otp_6879(doc) -> - []; -otp_6879(suite) -> - []; + OTE = process_flag(trap_exit, true), + Drv = peek_non_existing_queue_drv, + try + begin + case load_driver(proplists:get_value(data_dir, Config), + Drv) of + ok -> ok; + {error, permanent} -> ok; + LoadError -> ct:fail({load_error, LoadError}) + end, + case open_port({spawn, Drv}, []) of + Port1 when is_port(Port1) -> + try port_control(Port1, ?PEEK_NONXQ_TEST, "") of + "ok" -> + ok; + [$s,$k,$i,$p,$p,$e,$d,$:,$ | SkipReason] -> + throw({skipped, SkipReason}); + [$e,$r,$r,$o,$r,$:,$ | Error1] -> + ct:fail(Error1) + after + exit(Port1, kill), + receive {'EXIT', Port1, _} -> ok end + end; + Error1 -> + ct:fail({open_port1_failed, Error1}) + end, + case open_port({spawn, Drv}, []) of + Port2 when is_port(Port2) -> + try port_control(Port2, ?PEEK_NONXQ_WAIT, "") of + "ok" -> + ok; + [$e,$r,$r,$o,$r,$:,$ | Error2] -> + ct:fail(Error2) + after + receive {Port2, test_successful} -> ok end, + Port2 ! {self(), close}, + receive {Port2, closed} -> ok end + end; + Error2 -> + ct:fail({open_port2_failed, Error2}) + end + end + catch + throw:Term -> Term + after + process_flag(trap_exit, OTE), + erl_ddll:unload_driver(Drv) + end. + otp_6879(Config) when is_list(Config) -> - ?line Drv = 'otp_6879_drv', - ?line Parent = self(), - ?line ok = load_driver(?config(data_dir, Config), Drv), - ?line Procs = lists:map( - fun (No) -> - spawn_link( - fun () -> - case open_port({spawn, Drv}, []) of - Port when is_port(Port) -> - Res = otp_6879_call(Port, No, 10000), - erlang:port_close(Port), - Parent ! {self(), Res}; - _ -> - Parent ! {self(), - open_port_failed} - end - end) - end, - lists:seq(1,10)), - ?line lists:foreach(fun (P) -> - ?line receive - {P, ok} -> - ?line ok; - {P, Error} -> - ?line ?t:fail({P, Error}) - end - end, - Procs), + Drv = 'otp_6879_drv', + Parent = self(), + ok = load_driver(proplists:get_value(data_dir, Config), Drv), + Procs = lists:map( + fun (No) -> + spawn_link( + fun () -> + case open_port({spawn, Drv}, []) of + Port when is_port(Port) -> + Res = otp_6879_call(Port, No, 10000), + erlang:port_close(Port), + Parent ! {self(), Res}; + _ -> + Parent ! {self(), + open_port_failed} + end + end) + end, + lists:seq(1,10)), + lists:foreach(fun (P) -> + receive + {P, ok} -> + ok; + {P, Error} -> + ct:fail({P, Error}) + end + end, + Procs), %% Also try it when input exceeds default buffer (256 bytes) - ?line Data = lists:seq(1, 1000), - ?line case open_port({spawn, Drv}, []) of - Port when is_port(Port) -> - ?line ok = otp_6879_call(Port, Data, 10), - ?line erlang:port_close(Port); - _ -> - ?line ?t:fail(open_port_failed) - end, - ?line erl_ddll:unload_driver(Drv), - ?line ok. + Data = lists:seq(1, 1000), + case open_port({spawn, Drv}, []) of + Port when is_port(Port) -> + ok = otp_6879_call(Port, Data, 10), + erlang:port_close(Port); + _ -> + ct:fail(open_port_failed) + end, + erl_ddll:unload_driver(Drv), + ok. otp_6879_call(_Port, _Data, 0) -> ok; otp_6879_call(Port, Data, N) -> case catch erlang:port_call(Port, 0, Data) of - Data -> otp_6879_call(Port, Data, N-1); - BadData -> {mismatch, Data, BadData} + Data -> otp_6879_call(Port, Data, N-1); + BadData -> {mismatch, Data, BadData} end. -caller(doc) -> - []; -caller(suite) -> - []; caller(Config) when is_list(Config) -> - ?line run_caller_test(Config, false), - ?line run_caller_test(Config, true). - + run_caller_test(Config, false), + run_caller_test(Config, true). + run_caller_test(Config, Outputv) -> - ?line Drv = 'caller_drv', - ?line Cmd = case Outputv of - true -> - ?line os:putenv("CALLER_DRV_USE_OUTPUTV", - "true"), - outputv; - false -> - ?line os:putenv("CALLER_DRV_USE_OUTPUTV", - "false"), - output - end, - ?line ok = load_driver(?config(data_dir, Config), Drv), - ?line Port = open_port({spawn, Drv}, []), - ?line true = is_port(Port), - ?line chk_caller(Port, start, self()), - ?line chk_caller(Port, - Cmd, - spawn_link( - fun () -> - port_command(Port, "") - end)), - ?line Port ! {self(), {command, ""}}, - ?line chk_caller(Port, Cmd, self()), - ?line chk_caller(Port, - control, - spawn_link( - fun () -> - port_control(Port, 0, "") - end)), - ?line chk_caller(Port, - call, - spawn_link( - fun () -> - erlang:port_call(Port, 0, "") - end)), - ?line true = port_close(Port), - ?line erl_ddll:unload_driver(Drv), - ?line ok. + Drv = 'caller_drv', + Cmd = case Outputv of + true -> + os:putenv("CALLER_DRV_USE_OUTPUTV", + "true"), + outputv; + false -> + os:putenv("CALLER_DRV_USE_OUTPUTV", + "false"), + output + end, + ok = load_driver(proplists:get_value(data_dir, Config), Drv), + Port = open_port({spawn, Drv}, []), + true = is_port(Port), + chk_caller(Port, start, self()), + chk_caller(Port, + Cmd, + spawn_link( + fun () -> + port_command(Port, "") + end)), + Port ! {self(), {command, ""}}, + chk_caller(Port, Cmd, self()), + chk_caller(Port, + control, + spawn_link( + fun () -> + port_control(Port, 0, "") + end)), + chk_caller(Port, + call, + spawn_link( + fun () -> + erlang:port_call(Port, 0, "") + end)), + true = port_close(Port), + erl_ddll:unload_driver(Drv), + ok. chk_caller(Port, Callback, ExpectedCaller) -> receive - {caller, Port, Callback, Caller} -> - ExpectedCaller = Caller + {caller, Port, Callback, Caller} -> + ExpectedCaller = Caller end. -many_events(suite) -> - []; -many_events(doc) -> - ["Check that many simultaneously signalled events work (win32)"]; +%% Check that many simultaneously signalled events work (win32) many_events(Config) when is_list(Config) -> - ?line Name = 'many_events_drv', - ?line Port = start_driver(Config, Name, false), + Name = 'many_events_drv', + Port = start_driver(Config, Name, false), Number = "1000", Port ! {self(), {command, Number}}, receive - {Port, {data,Number}} -> - ?line receive %% Just to make sure the emulator does not crash - %% after this case is run (if faulty) - after 2000 -> - ok - end + {Port, {data,Number}} -> + receive %% Just to make sure the emulator does not crash + %% after this case is run (if faulty) + after 2000 -> + ok + end after 1000 -> - ?line exit(the_driver_does_not_respond) + exit(the_driver_does_not_respond) end, - ?line stop_driver(Port, Name), - ?line ok. - - -missing_callbacks(doc) -> - []; -missing_callbacks(suite) -> - []; + stop_driver(Port, Name), + ok. + + missing_callbacks(Config) when is_list(Config) -> - ?line Name = 'missing_callback_drv', - ?line Port = start_driver(Config, Name, false), + Name = 'missing_callback_drv', + Port = start_driver(Config, Name, false), - ?line Port ! {self(), {command, "tjenix"}}, - ?line true = erlang:port_command(Port, "halloj"), - ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(Port, 4711, "mors")), - ?line {'EXIT', {badarg, _}} = (catch erlang:port_call(Port, 17, "hej")), + Port ! {self(), {command, "tjenix"}}, + true = erlang:port_command(Port, "halloj"), + {'EXIT', {badarg, _}} = (catch erlang:port_control(Port, 4711, "mors")), + {'EXIT', {badarg, _}} = (catch erlang:port_call(Port, 17, "hej")), - ?line %% Give the (non-existing) ready_output(), ready_input(), event(), - ?line %% and timeout() some time to be called. - ?line receive after 1000 -> ok end, + %% Give the (non-existing) ready_output(), ready_input(), event(), + %% and timeout() some time to be called. + receive after 1000 -> ok end, - ?line stop_driver(Port, Name), - ?line ok. + stop_driver(Port, Name), + ok. -smp_select(doc) -> - ["Test concurrent calls to driver_select."]; -smp_select(suite) -> - []; +%% Test concurrent calls to driver_select. smp_select(Config) when is_list(Config) -> case os:type() of - {win32,_} -> {skipped, "Test not implemented for this OS"}; - _ -> smp_select0(Config) + {win32,_} -> {skipped, "Test not implemented for this OS"}; + _ -> smp_select0(Config) end. - + smp_select0(Config) -> - ?line DrvName = 'chkio_drv', - Path = ?config(data_dir, Config), + DrvName = 'chkio_drv', + Path = proplists:get_value(data_dir, Config), erl_ddll:start(), - ?line ok = load_driver(Path, DrvName), + ok = load_driver(Path, DrvName), Master = self(), ProcFun = fun()-> io:format("Worker ~p starting\n",[self()]), - ?line Port = open_port({spawn, DrvName}, []), - smp_select_loop(Port, 100000), - sleep(1000), % wait for driver to handle pending events - ?line true = erlang:port_close(Port), - Master ! {ok,self()}, - io:format("Worker ~p finished\n",[self()]) - end, - ?line Pids = lists:map(fun(_) -> spawn_link(ProcFun) end, - lists:seq(1,4)), + Port = open_port({spawn, DrvName}, []), + smp_select_loop(Port, 100000), + sleep(1000), % wait for driver to handle pending events + true = erlang:port_close(Port), + Master ! {ok,self()}, + io:format("Worker ~p finished\n",[self()]) + end, + Pids = lists:map(fun(_) -> spawn_link(ProcFun) end, + lists:seq(1,4)), TimeoutMsg = make_ref(), {ok,TRef} = timer:send_after(5*1000, TimeoutMsg), % Limit test duration on slow machines smp_select_wait(Pids, TimeoutMsg), timer:cancel(TRef), - ?line ok = erl_ddll:unload_driver(DrvName), - ?line ok = erl_ddll:stop(), + ok = erl_ddll:unload_driver(DrvName), + ok = erl_ddll:stop(), ok. smp_select_loop(_, 0) -> ok; smp_select_loop(Port, N) -> - ?line "ok" = erlang:port_control(Port, ?CHKIO_SMP_SELECT, []), + "ok" = erlang:port_control(Port, ?CHKIO_SMP_SELECT, []), receive - stop -> - io:format("Worker ~p stopped with ~p laps left\n",[self(), N]), - ok + stop -> + io:format("Worker ~p stopped with ~p laps left\n",[self(), N]), + ok after 0 -> - smp_select_loop(Port, N-1) + smp_select_loop(Port, N-1) end. smp_select_wait([], _) -> ok; smp_select_wait(Pids, TimeoutMsg) -> receive - {ok,Pid} when is_pid(Pid) -> - smp_select_wait(lists:delete(Pid,Pids), TimeoutMsg); - TimeoutMsg -> - lists:foreach(fun(Pid)-> Pid ! stop end, - Pids), - smp_select_wait(Pids, TimeoutMsg) + {ok,Pid} when is_pid(Pid) -> + smp_select_wait(lists:delete(Pid,Pids), TimeoutMsg); + TimeoutMsg -> + lists:foreach(fun(Pid)-> Pid ! stop end, + Pids), + smp_select_wait(Pids, TimeoutMsg) end. -driver_select_use(doc) -> - ["Test driver_select() with new ERL_DRV_USE flag."]; -driver_select_use(suite) -> - []; +%% Test driver_select() with new ERL_DRV_USE flag. driver_select_use(Config) when is_list(Config) -> case os:type() of - {win32,_} -> {skipped, "Test not implemented for this OS"}; - _ -> driver_select_use0(Config) + {win32,_} -> {skipped, "Test not implemented for this OS"}; + _ -> driver_select_use0(Config) end. - + driver_select_use0(Config) -> - ?line DrvName = 'chkio_drv', - Path = ?config(data_dir, Config), + DrvName = 'chkio_drv', + Path = proplists:get_value(data_dir, Config), erl_ddll:start(), - ?line ok = load_driver(Path, DrvName), - ?line Port = open_port({spawn, DrvName}, []), - ?line "ok" = erlang:port_control(Port, ?CHKIO_DRV_USE, []), - ?line {Port,{data,"TheEnd"}} = receive Msg -> Msg - after 10000 -> timeout end, - ?line true = erlang:port_close(Port), - ?line ok = erl_ddll:unload_driver(DrvName), - ?line ok = erl_ddll:stop(), + ok = load_driver(Path, DrvName), + Port = open_port({spawn, DrvName}, []), + "ok" = erlang:port_control(Port, ?CHKIO_DRV_USE, []), + {Port,{data,"TheEnd"}} = receive Msg -> Msg + after 10000 -> timeout end, + true = erlang:port_close(Port), + ok = erl_ddll:unload_driver(DrvName), + ok = erl_ddll:stop(), ok. thread_mseg_alloc_cache_clean(Config) when is_list(Config) -> case {erlang:system_info(threads), - erlang:system_info({allocator,mseg_alloc}), - driver_alloc_sbct()} of - {_, false, _} -> - ?line {skipped, "No mseg_alloc"}; - {false, _, _} -> - ?line {skipped, "No threads"}; - {_, _, false} -> - ?line {skipped, "driver_alloc() not using the alloc_util framework"}; - {_, _, SBCT} when is_integer(SBCT), SBCT > 10*1024*1024 -> - ?line {skipped, "driver_alloc() using too large single block threshold"}; - {_, _, 0} -> - ?line {skipped, "driver_alloc() using too low single block threshold"}; - {true, _MsegAllocInfo, SBCT} -> - ?line DrvName = 'thr_alloc_drv', - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:start(), - ?line ok = load_driver(Path, DrvName), - ?line Port = open_port({spawn, DrvName}, []), - ?line CCI = 1000, - ?line ?t:format("CCI = ~p~n", [CCI]), - ?line CCC = mseg_alloc_ccc(), - ?line ?t:format("CCC = ~p~n", [CCC]), - ?line thread_mseg_alloc_cache_clean_test(Port, - 10, - CCI, - SBCT+100), - ?line true = erlang:port_close(Port), - ?line ok = erl_ddll:unload_driver(DrvName), - ?line ok = erl_ddll:stop(), - ?line ok + erlang:system_info({allocator,mseg_alloc}), + driver_alloc_sbct()} of + {_, false, _} -> + {skipped, "No mseg_alloc"}; + {false, _, _} -> + {skipped, "No threads"}; + {_, _, false} -> + {skipped, "driver_alloc() not using the alloc_util framework"}; + {_, _, SBCT} when is_integer(SBCT), SBCT > 10*1024*1024 -> + {skipped, "driver_alloc() using too large single block threshold"}; + {_, _, 0} -> + {skipped, "driver_alloc() using too low single block threshold"}; + {true, _MsegAllocInfo, SBCT} -> + DrvName = 'thr_alloc_drv', + Path = proplists:get_value(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, DrvName), + Port = open_port({spawn, DrvName}, []), + CCI = 1000, + io:format("CCI = ~p~n", [CCI]), + CCC = mseg_alloc_ccc(), + io:format("CCC = ~p~n", [CCC]), + thread_mseg_alloc_cache_clean_test(Port, + 10, + CCI, + SBCT+100), + true = erlang:port_close(Port), + ok = erl_ddll:unload_driver(DrvName), + ok = erl_ddll:stop(), + ok end. mseg_alloc_cci(MsegAllocInfo) -> - ?line {value,{options, OL}} - = lists:keysearch(options, 1, MsegAllocInfo), - ?line {value,{cci,CCI}} = lists:keysearch(cci,1,OL), - ?line CCI. + {value,{options, OL}} + = lists:keysearch(options, 1, MsegAllocInfo), + {value,{cci,CCI}} = lists:keysearch(cci,1,OL), + CCI. mseg_alloc_ccc() -> mseg_alloc_ccc(mseg_inst_info(0)). mseg_alloc_ccc(MsegAllocInfo) -> - ?line {value,{memkind, MKL}} = lists:keysearch(memkind,1,MsegAllocInfo), - ?line {value,{calls, CL}} = lists:keysearch(calls, 1, MKL), - ?line {value,{mseg_check_cache, GigaCCC, CCC}} - = lists:keysearch(mseg_check_cache, 1, CL), - ?line GigaCCC*1000000000 + CCC. + {value,{memkind, MKL}} = lists:keysearch(memkind,1,MsegAllocInfo), + {value,{calls, CL}} = lists:keysearch(calls, 1, MKL), + {value,{mseg_check_cache, GigaCCC, CCC}} + = lists:keysearch(mseg_check_cache, 1, CL), + GigaCCC*1000000000 + CCC. mseg_alloc_cached_segments() -> mseg_alloc_cached_segments(mseg_inst_info(0)). mseg_alloc_cached_segments(MsegAllocInfo) -> - MemName = case is_halfword_vm() of - true -> "high memory"; - false -> "all memory" - end, - ?line [{memkind,DrvMem}] - = lists:filter(fun(E) -> case E of - {memkind, [{name, MemName} | _]} -> true; - _ -> false - end end, MsegAllocInfo), - ?line {value,{status, SL}} - = lists:keysearch(status, 1, DrvMem), - ?line {value,{cached_segments, CS}} - = lists:keysearch(cached_segments, 1, SL), - ?line CS. + MemName = "all memory", + [{memkind,DrvMem}] + = lists:filter(fun(E) -> case E of + {memkind, [{name, MemName} | _]} -> true; + _ -> false + end end, MsegAllocInfo), + {value,{status, SL}} + = lists:keysearch(status, 1, DrvMem), + {value,{cached_segments, CS}} + = lists:keysearch(cached_segments, 1, SL), + CS. mseg_inst_info(I) -> {value, {instance, I, Value}} - = lists:keysearch(I, - 2, - erlang:system_info({allocator,mseg_alloc})), + = lists:keysearch(I, + 2, + erlang:system_info({allocator,mseg_alloc})), Value. -is_halfword_vm() -> - case {erlang:system_info({wordsize, internal}), - erlang:system_info({wordsize, external})} of - {4, 8} -> true; - {WS, WS} -> false - end. - driver_alloc_sbct() -> {_, _, _, As} = erlang:system_info(allocator), case lists:keysearch(driver_alloc, 1, As) of - {value,{driver_alloc,DAOPTs}} -> - case lists:keysearch(sbct, 1, DAOPTs) of - {value,{sbct,SBCT}} -> - SBCT; - _ -> - false - end; - _ -> - false + {value,{driver_alloc,DAOPTs}} -> + case lists:keysearch(sbct, 1, DAOPTs) of + {value,{sbct,SBCT}} -> + SBCT; + _ -> + false + end; + _ -> + false end. thread_mseg_alloc_cache_clean_test(_Port, 0, _CCI, _Size) -> - ?line ok; + ok; thread_mseg_alloc_cache_clean_test(Port, N, CCI, Size) -> - ?line wait_until(fun () -> 0 == mseg_alloc_cached_segments() end), - ?line receive after CCI+500 -> ok end, - ?line OCCC = mseg_alloc_ccc(), - ?line "ok" = erlang:port_control(Port, 0, integer_to_list(Size)), - ?line receive after CCI+500 -> ok end, - ?line CCC = mseg_alloc_ccc(), - ?line ?t:format("CCC = ~p~n", [CCC]), - ?line true = CCC > OCCC, - ?line thread_mseg_alloc_cache_clean_test(Port, N-1, CCI, Size). + wait_until(fun () -> 0 == mseg_alloc_cached_segments() end), + receive after CCI+500 -> ok end, + OCCC = mseg_alloc_ccc(), + "ok" = erlang:port_control(Port, 0, integer_to_list(Size)), + receive after CCI+500 -> ok end, + CCC = mseg_alloc_ccc(), + io:format("CCC = ~p~n", [CCC]), + true = CCC > OCCC, + thread_mseg_alloc_cache_clean_test(Port, N-1, CCI, Size). otp_9302(Config) when is_list(Config) -> - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:start(), - ?line ok = load_driver(Path, otp_9302_drv), - ?line Port = open_port({spawn, otp_9302_drv}, []), - ?line true = is_port(Port), - ?line port_command(Port, ""), - ?line {msg, block} = get_port_msg(Port, infinity), - ?line {msg, job} = get_port_msg(Port, infinity), - ?line C = case erlang:system_info(thread_pool_size) of - 0 -> - ?line {msg, cancel} = get_port_msg(Port, infinity), - ?line {msg, job} = get_port_msg(Port, infinity), - ?line false; - _ -> - case get_port_msg(Port, infinity) of - {msg, cancel} -> %% Cancel always fail in Rel >= 15 - ?line {msg, job} = get_port_msg(Port, infinity), - ?line false; - {msg, job} -> - ?line ok, - ?line true - end - end, - ?line {msg, end_of_jobs} = get_port_msg(Port, infinity), - ?line no_msg = get_port_msg(Port, 2000), - ?line port_close(Port), - ?line case C of - true -> - ?line {comment, "Async job cancelled"}; - false -> - ?line {comment, "Async job not cancelled"} - end. + Path = proplists:get_value(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, otp_9302_drv), + Port = open_port({spawn, otp_9302_drv}, []), + true = is_port(Port), + port_command(Port, ""), + {msg, block} = get_port_msg(Port, infinity), + {msg, job} = get_port_msg(Port, infinity), + C = case erlang:system_info(thread_pool_size) of + 0 -> + {msg, cancel} = get_port_msg(Port, infinity), + {msg, job} = get_port_msg(Port, infinity), + false; + _ -> + case get_port_msg(Port, infinity) of + {msg, cancel} -> %% Cancel always fail in Rel >= 15 + {msg, job} = get_port_msg(Port, infinity), + false; + {msg, job} -> + ok, + true + end + end, + {msg, end_of_jobs} = get_port_msg(Port, infinity), + no_msg = get_port_msg(Port, 2000), + port_close(Port), + case C of + true -> + {comment, "Async job cancelled"}; + false -> + {comment, "Async job not cancelled"} + end. thr_free_drv(Config) when is_list(Config) -> case erlang:system_info(threads) of - false -> - {skipped, "No thread support"}; - true -> - thr_free_drv_do(Config) + false -> + {skipped, "No thread support"}; + true -> + thr_free_drv_do(Config) end. thr_free_drv_do(Config) -> - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:start(), - ?line ok = load_driver(Path, thr_free_drv), - ?line MemBefore = driver_alloc_size(), -% io:format("SID=~p", [erlang:system_info(scheduler_id)]), - ?line Port = open_port({spawn, thr_free_drv}, []), - ?line MemPeek = driver_alloc_size(), - ?line true = is_port(Port), - ?line ok = thr_free_drv_control(Port, 0), - ?line port_close(Port), - ?line MemAfter = driver_alloc_size(), - ?line io:format("MemPeek=~p~n", [MemPeek]), - ?line io:format("MemBefore=~p, MemAfter=~p~n", [MemBefore, MemAfter]), - ?line MemBefore = MemAfter, - ?line case MemPeek of - undefined -> ok; - _ -> - ?line true = MemPeek > MemBefore - end, - ?line ok. + Path = proplists:get_value(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, thr_free_drv), + MemBefore = driver_alloc_size(), + % io:format("SID=~p", [erlang:system_info(scheduler_id)]), + Port = open_port({spawn, thr_free_drv}, []), + MemPeek = driver_alloc_size(), + true = is_port(Port), + ok = thr_free_drv_control(Port, 0), + port_close(Port), + MemAfter = driver_alloc_size(), + io:format("MemPeek=~p~n", [MemPeek]), + io:format("MemBefore=~p, MemAfter=~p~n", [MemBefore, MemAfter]), + MemBefore = MemAfter, + case MemPeek of + undefined -> ok; + _ -> + true = MemPeek > MemBefore + end, + ok. thr_free_drv_control(Port, N) -> case erlang:port_control(Port, 0, "") of - "done" -> - ok; - "more" -> - erlang:yield(), -% io:format("N=~p, SID=~p", [N, erlang:system_info(scheduler_id)]), - thr_free_drv_control(Port, N+1) + "done" -> + ok; + "more" -> + erlang:yield(), + % io:format("N=~p, SID=~p", [N, erlang:system_info(scheduler_id)]), + thr_free_drv_control(Port, N+1) end. - + async_blast(Config) when is_list(Config) -> - ?line Path = ?config(data_dir, Config), - ?line erl_ddll:start(), - ?line ok = load_driver(Path, async_blast_drv), - ?line SchedOnln = erlang:system_info(schedulers_online), - ?line MemBefore = driver_alloc_size(), - ?line Start = os:timestamp(), - ?line Blast = fun () -> - Port = open_port({spawn, async_blast_drv}, []), - true = is_port(Port), - port_command(Port, ""), - receive - {Port, done} -> - ok - end, - port_close(Port) - end, - ?line Ps = lists:map(fun (N) -> - spawn_opt(Blast, - [{scheduler, - (N rem SchedOnln)+ 1}, - monitor]) - end, - lists:seq(1, 100)), - ?line MemMid = driver_alloc_size(), - ?line lists:foreach(fun ({Pid, Mon}) -> - receive - {'DOWN',Mon,process,Pid,_} -> ok - end - end, Ps), - ?line End = os:timestamp(), - ?line MemAfter = driver_alloc_size(), - ?line io:format("MemBefore=~p, MemMid=~p, MemAfter=~p~n", - [MemBefore, MemMid, MemAfter]), - ?line AsyncBlastTime = timer:now_diff(End,Start)/1000000, - ?line io:format("AsyncBlastTime=~p~n", [AsyncBlastTime]), - ?line MemBefore = MemAfter, - ?line erlang:display({async_blast_time, AsyncBlastTime}), - ?line ok. + Path = proplists:get_value(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, async_blast_drv), + SchedOnln = erlang:system_info(schedulers_online), + MemBefore = driver_alloc_size(), + Start = os:timestamp(), + Blast = fun () -> + Port = open_port({spawn, async_blast_drv}, []), + true = is_port(Port), + port_command(Port, ""), + receive + {Port, done} -> + ok + end, + port_close(Port) + end, + Ps = lists:map(fun (N) -> + spawn_opt(Blast, + [{scheduler, + (N rem SchedOnln)+ 1}, + monitor]) + end, + lists:seq(1, 100)), + MemMid = driver_alloc_size(), + lists:foreach(fun ({Pid, Mon}) -> + receive + {'DOWN',Mon,process,Pid,_} -> ok + end + end, Ps), + End = os:timestamp(), + MemAfter = driver_alloc_size(), + io:format("MemBefore=~p, MemMid=~p, MemAfter=~p~n", + [MemBefore, MemMid, MemAfter]), + AsyncBlastTime = timer:now_diff(End,Start)/1000000, + io:format("AsyncBlastTime=~p~n", [AsyncBlastTime]), + MemBefore = MemAfter, + erlang:display({async_blast_time, AsyncBlastTime}), + ok. thr_msg_blast_receiver(_Port, N, N) -> ok; thr_msg_blast_receiver(Port, N, Max) -> receive - {Port, hi} -> - thr_msg_blast_receiver(Port, N+1, Max) + {Port, hi} -> + thr_msg_blast_receiver(Port, N+1, Max) end. thr_msg_blast_receiver_proc(Port, Max, Parent, Done) -> case port_control(Port, 0, "") of - "receiver" -> - spawn(fun () -> - thr_msg_blast_receiver_proc(Port, Max+1, Parent, Done) - end), - thr_msg_blast_receiver(Port, 0, Max); - "done" -> - Parent ! Done + "receiver" -> + spawn(fun () -> + thr_msg_blast_receiver_proc(Port, Max+1, Parent, Done) + end), + thr_msg_blast_receiver(Port, 0, Max); + "done" -> + Parent ! Done end. thr_msg_blast(Config) when is_list(Config) -> case erlang:system_info(smp_support) of - false -> - {skipped, "Non-SMP emulator; nothing to test..."}; - true -> - Path = ?config(data_dir, Config), - erl_ddll:start(), - ok = load_driver(Path, thr_msg_blast_drv), - MemBefore = driver_alloc_size(), - Start = os:timestamp(), - Port = open_port({spawn, thr_msg_blast_drv}, []), - true = is_port(Port), - Done = make_ref(), - Me = self(), - spawn(fun () -> - thr_msg_blast_receiver_proc(Port, 1, Me, Done) - end), - receive - Done -> ok - end, - ok = thr_msg_blast_receiver(Port, 0, 32*10000), - port_close(Port), - End = os:timestamp(), - receive - Garbage -> - ?t:fail({received_garbage, Port, Garbage}) - after 2000 -> - ok - end, - MemAfter = driver_alloc_size(), - io:format("MemBefore=~p, MemAfter=~p~n", - [MemBefore, MemAfter]), - ThrMsgBlastTime = timer:now_diff(End,Start)/1000000, - io:format("ThrMsgBlastTime=~p~n", [ThrMsgBlastTime]), - MemBefore = MemAfter, - Res = {thr_msg_blast_time, ThrMsgBlastTime}, - erlang:display(Res), - Res + false -> + {skipped, "Non-SMP emulator; nothing to test..."}; + true -> + Path = proplists:get_value(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, thr_msg_blast_drv), + MemBefore = driver_alloc_size(), + Start = os:timestamp(), + Port = open_port({spawn, thr_msg_blast_drv}, []), + true = is_port(Port), + Done = make_ref(), + Me = self(), + spawn(fun () -> + thr_msg_blast_receiver_proc(Port, 1, Me, Done) + end), + receive + Done -> ok + end, + ok = thr_msg_blast_receiver(Port, 0, 32*10000), + port_close(Port), + End = os:timestamp(), + receive + Garbage -> + ct:fail({received_garbage, Port, Garbage}) + after 2000 -> + ok + end, + MemAfter = driver_alloc_size(), + io:format("MemBefore=~p, MemAfter=~p~n", + [MemBefore, MemAfter]), + ThrMsgBlastTime = timer:now_diff(End,Start)/1000000, + io:format("ThrMsgBlastTime=~p~n", [ThrMsgBlastTime]), + MemBefore = MemAfter, + Res = {thr_msg_blast_time, ThrMsgBlastTime}, + erlang:display(Res), + Res end. -define(IN_RANGE(LoW_, VaLuE_, HiGh_), - case in_range(LoW_, VaLuE_, HiGh_) of - true -> ok; - false -> - case erlang:system_info(lock_checking) of - true -> - ?t:format("~p:~p: Ignore bad sched count due to " - "lock checking~n", - [?MODULE,?LINE]); - false -> - ?t:fail({unexpected_sched_counts, VaLuE_}) - end - end). + case in_range(LoW_, VaLuE_, HiGh_) of + true -> ok; + false -> + case erlang:system_info(lock_checking) of + true -> + io:format("~p:~p: Ignore bad sched count due to " + "lock checking~n", + [?MODULE,?LINE]); + false -> + ct:fail({unexpected_sched_counts, VaLuE_}) + end + end). consume_timeslice(Config) when is_list(Config) -> @@ -2150,7 +2037,7 @@ consume_timeslice(Config) when is_list(Config) -> %% the port instead. %% - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), erl_ddll:start(), ok = load_driver(Path, consume_timeslice_drv), Port = open_port({spawn, consume_timeslice_drv}, [{parallelism, false}]), @@ -2160,18 +2047,18 @@ consume_timeslice(Config) when is_list(Config) -> "enabled" = port_control(Port, $E, ""), Proc1 = spawn_link(fun () -> - receive Go -> ok end, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}} - end), + receive Go -> ok end, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}} + end), receive after 100 -> ok end, count_pp_sched_start(), Proc1 ! Go, @@ -2182,18 +2069,18 @@ consume_timeslice(Config) when is_list(Config) -> "disabled" = port_control(Port, $D, ""), Proc2 = spawn_link(fun () -> - receive Go -> ok end, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}}, - Port ! {Parent, {command, ""}} - end), + receive Go -> ok end, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}} + end), receive after 100 -> ok end, count_pp_sched_start(), Proc2 ! Go, @@ -2204,18 +2091,18 @@ consume_timeslice(Config) when is_list(Config) -> "enabled" = port_control(Port, $E, ""), Proc3 = spawn_link(fun () -> - receive Go -> ok end, - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, "") - end), + receive Go -> ok end, + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, "") + end), count_pp_sched_start(), Proc3 ! Go, wait_command_msgs(Port, 10), @@ -2225,18 +2112,18 @@ consume_timeslice(Config) when is_list(Config) -> "disabled" = port_control(Port, $D, ""), Proc4 = spawn_link(fun () -> - receive Go -> ok end, - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, ""), - port_command(Port, "") - end), + receive Go -> ok end, + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, "") + end), count_pp_sched_start(), Proc4 ! Go, wait_command_msgs(Port, 10), @@ -2248,43 +2135,43 @@ consume_timeslice(Config) when is_list(Config) -> %% If only one scheduler use port with parallelism set to true, %% in order to trigger scheduling of command signals Port2 = case SOnl of - 1 -> - Port ! {self(), close}, - receive {Port, closed} -> ok end, - open_port({spawn, consume_timeslice_drv}, - [{parallelism, true}]); - _ -> - process_flag(scheduler, 1), - 1 = erlang:system_info(scheduler_id), - Port - end, + 1 -> + Port ! {self(), close}, + receive {Port, closed} -> ok end, + open_port({spawn, consume_timeslice_drv}, + [{parallelism, true}]); + _ -> + process_flag(scheduler, 1), + 1 = erlang:system_info(scheduler_id), + Port + end, count_pp_sched_start(), "enabled" = port_control(Port2, $E, ""), W5 = case SOnl of - 1 -> - false; - _ -> - W1= spawn_opt(fun () -> - 2 = erlang:system_info(scheduler_id), - "sleeped" = port_control(Port2, $S, "") - end, [link,{scheduler,2}]), - receive after 100 -> ok end, - W1 - end, + 1 -> + false; + _ -> + W1= spawn_opt(fun () -> + 2 = erlang:system_info(scheduler_id), + "sleeped" = port_control(Port2, $S, "") + end, [link,{scheduler,2}]), + receive after 100 -> ok end, + W1 + end, Proc5 = spawn_opt(fun () -> - receive Go -> ok end, - 1 = erlang:system_info(scheduler_id), - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}} - end, [link,{scheduler,1}]), + receive Go -> ok end, + 1 = erlang:system_info(scheduler_id), + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}} + end, [link,{scheduler,1}]), receive after 100 -> ok end, Proc5 ! Go, wait_procs_exit([W5, Proc5]), @@ -2292,34 +2179,34 @@ consume_timeslice(Config) when is_list(Config) -> [{Port2, Sprt5}, {Proc5, Sproc5}] = count_pp_sched_stop([Port2, Proc5]), ?IN_RANGE(2, Sproc5, 3), ?IN_RANGE(6, Sprt5, 20), - + count_pp_sched_start(), "disabled" = port_control(Port2, $D, ""), W6 = case SOnl of - 1 -> - false; - _ -> - W2= spawn_opt(fun () -> - 2 = erlang:system_info(scheduler_id), - "sleeped" = port_control(Port2, $S, "") - end, [link,{scheduler,2}]), - receive after 100 -> ok end, - W2 - end, + 1 -> + false; + _ -> + W2= spawn_opt(fun () -> + 2 = erlang:system_info(scheduler_id), + "sleeped" = port_control(Port2, $S, "") + end, [link,{scheduler,2}]), + receive after 100 -> ok end, + W2 + end, Proc6 = spawn_opt(fun () -> - receive Go -> ok end, - 1 = erlang:system_info(scheduler_id), - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}}, - Port2 ! {Parent, {command, ""}} - end, [link,{scheduler,1}]), + receive Go -> ok end, + 1 = erlang:system_info(scheduler_id), + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}} + end, [link,{scheduler,1}]), receive after 100 -> ok end, Proc6 ! Go, wait_procs_exit([W6, Proc6]), @@ -2339,19 +2226,19 @@ wait_command_msgs(_, 0) -> ok; wait_command_msgs(Port, N) -> receive - {Port, command} -> - wait_command_msgs(Port, N-1) + {Port, command} -> + wait_command_msgs(Port, N-1) end. in_range(Low, Val, High) when is_integer(Low), - is_integer(Val), - is_integer(High), - Low =< Val, - Val =< High -> + is_integer(Val), + is_integer(High), + Low =< Val, + Val =< High -> true; in_range(Low, Val, High) when is_integer(Low), - is_integer(Val), - is_integer(High) -> + is_integer(Val), + is_integer(High) -> false. count_pp_sched_start() -> @@ -2364,7 +2251,7 @@ count_pp_sched_stop(Ps) -> PNs = lists:map(fun (P) -> {P, 0} end, Ps), receive {trace_delivered, all, Td} -> ok end, Res = count_proc_sched(Ps, PNs), - ?t:format("Scheduling counts: ~p~n", [Res]), + io:format("Scheduling counts: ~p~n", [Res]), erlang:display({scheduling_counts, Res}), Res. @@ -2377,22 +2264,22 @@ do_inc_pn(P, [PN|PNs]) -> inc_pn(P, PNs) -> try - do_inc_pn(P, PNs) + do_inc_pn(P, PNs) catch - throw:undefined -> PNs + throw:undefined -> PNs end. count_proc_sched(Ps, PNs) -> receive - TT when element(1, TT) == trace, element(3, TT) == in -> -% erlang:display(TT), - count_proc_sched(Ps, inc_pn(element(2, TT), PNs)); - TT when element(1, TT) == trace, element(3, TT) == out -> - count_proc_sched(Ps, PNs) + TT when element(1, TT) == trace, element(3, TT) == in -> + % erlang:display(TT), + count_proc_sched(Ps, inc_pn(element(2, TT), PNs)); + TT when element(1, TT) == trace, element(3, TT) == out -> + count_proc_sched(Ps, PNs) after 0 -> - PNs + PNs end. - + a_test(Config) when is_list(Config) -> check_io_debug(). @@ -2405,13 +2292,35 @@ z_test(Config) when is_list(Config) -> check_io_debug() -> get_stable_check_io_info(), - {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} - = erts_debug:get_internal_state(check_io_debug), + {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} = CheckIoDebug + = erts_debug:get_internal_state(check_io_debug), + HasGetHost = has_gethost(), + ct:log("check_io_debug: ~p~n" + "HasGetHost: ~p",[CheckIoDebug, HasGetHost]), 0 = NoErrorFds, - NoUsedFds = NoDrvSelStructs, + if + NoUsedFds == NoDrvSelStructs -> + ok; + HasGetHost andalso (NoUsedFds == (NoDrvSelStructs - 1)) -> + %% If the inet_gethost port is alive, we may have + %% one extra used fd that is not selected on + ok + end, 0 = NoDrvEvStructs, ok. +has_gethost() -> + has_gethost(erlang:ports()). +has_gethost([P|T]) -> + case erlang:port_info(P, name) of + {name,"inet_gethost"++_} -> + true; + _ -> + has_gethost(T) + end; +has_gethost([]) -> + false. + %flush_msgs() -> % receive % M -> @@ -2426,26 +2335,26 @@ wait_procs_exit([]) -> wait_procs_exit([P|Ps]) when is_pid(P) -> Mon = erlang:monitor(process, P), receive - {'DOWN', Mon, process, P, _} -> - wait_procs_exit(Ps) + {'DOWN', Mon, process, P, _} -> + wait_procs_exit(Ps) end; wait_procs_exit([_|Ps]) -> wait_procs_exit(Ps). get_port_msg(Port, Timeout) -> receive - {Port, What} -> - {msg, What} + {Port, What} -> + {msg, What} after Timeout -> - no_msg + no_msg end. wait_until(Fun) -> case Fun() of - true -> ok; - false -> - receive after 100 -> ok end, - wait_until(Fun) + true -> ok; + false -> + receive after 100 -> ok end, + wait_until(Fun) end. drv_vsn_str2tup(Str) -> @@ -2476,11 +2385,11 @@ transform_bins(_Transform, Other) -> Other. make_sub_binaries(Term) -> MakeSub = fun(Bin0) -> - Bin1 = <<243:8,0:3,Bin0/binary,31:5,19:8>>, - Sz = size(Bin0), - <<243:8,0:3,Bin:Sz/binary,31:5,19:8>> = id(Bin1), - Bin - end, + Bin1 = <<243:8,0:3,Bin0/binary,31:5,19:8>>, + Sz = size(Bin0), + <<243:8,0:3,Bin:Sz/binary,31:5,19:8>> = id(Bin1), + Bin + end, transform_bins(MakeSub, Term). id(I) -> I. @@ -2512,14 +2421,7 @@ random_char() -> uniform(256) - 1. uniform(N) -> - case get(random_seed) of - undefined -> - {X, Y, Z} = time(), - random:seed(X, Y, Z); - _ -> - ok - end, - random:uniform(N). + rand:uniform(N). erl_millisecs() -> erl_millisecs(erlang:monotonic_time()). @@ -2529,7 +2431,7 @@ erl_millisecs(MonotonicTime) -> %% Start/stop drivers. start_driver(Config, Name, Binary) -> - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), erl_ddll:start(), %% Load the driver @@ -2537,31 +2439,31 @@ start_driver(Config, Name, Binary) -> %% open port. case Binary of - true -> - open_port({spawn, Name}, [binary]); - false -> - open_port({spawn, Name}, []) + true -> + open_port({spawn, Name}, [binary]); + false -> + open_port({spawn, Name}, []) end. stop_driver(Port, Name) -> - ?line true = erlang:port_close(Port), + true = erlang:port_close(Port), receive - {Port,Message} -> - ?t:fail({strange_message_from_port,Message}) + {Port,Message} -> + ct:fail({strange_message_from_port,Message}) after 0 -> - ok + ok end, %% Unload the driver. ok = erl_ddll:unload_driver(Name), - ?line ok = erl_ddll:stop(). + ok = erl_ddll:stop(). load_driver(Dir, Driver) -> case erl_ddll:load_driver(Dir, Driver) of - ok -> ok; - {error, Error} = Res -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - Res + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res end. sleep() -> @@ -2576,50 +2478,50 @@ sleep(Ms) when is_integer(Ms), Ms >= 0 -> start_node(Config) when is_list(Config) -> 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}]). + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + test_server:start_node(Name, slave, [{args, "-pa "++Pa}]). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). wait_deallocations() -> try - erts_debug:set_internal_state(wait, deallocations) + erts_debug:set_internal_state(wait, deallocations) catch error:undef -> - erts_debug:set_internal_state(available_internal_state, true), - wait_deallocations() + erts_debug:set_internal_state(available_internal_state, true), + wait_deallocations() end. driver_alloc_size() -> case erlang:system_info(smp_support) of - true -> - ok; - false -> - %% driver_alloc also used by elements in lock-free queues, - %% give these some time to be deallocated... - receive after 100 -> ok end + true -> + ok; + false -> + %% driver_alloc also used by elements in lock-free queues, + %% give these some time to be deallocated... + receive after 100 -> ok end end, wait_deallocations(), case erlang:system_info({allocator_sizes, driver_alloc}) of - false -> - undefined; - MemInfo -> - CS = lists:foldl( - fun ({instance, _, L}, Acc) -> - {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L), - {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L), - [MBCS,SBCS | Acc] - end, - [], - MemInfo), - lists:foldl( - fun(L, Sz0) -> - {value,{_,Sz,_,_}} = lists:keysearch(blocks_size, 1, L), - Sz0+Sz - end, 0, CS) + false -> + undefined; + MemInfo -> + CS = lists:foldl( + fun ({instance, _, L}, Acc) -> + {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L), + {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L), + [MBCS,SBCS | Acc] + end, + [], + MemInfo), + lists:foldl( + fun(L, Sz0) -> + {value,{_,Sz,_,_}} = lists:keysearch(blocks_size, 1, L), + Sz0+Sz + end, 0, CS) end. diff --git a/erts/emulator/test/driver_SUITE_data/async_blast_drv.c b/erts/emulator/test/driver_SUITE_data/async_blast_drv.c index a1008afcae..1432bc42c1 100644 --- a/erts/emulator/test/driver_SUITE_data/async_blast_drv.c +++ b/erts/emulator/test/driver_SUITE_data/async_blast_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011-2013. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c b/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c index 192ac02d3e..142ae46247 100644 --- a/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c +++ b/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012-2013. All Rights Reserved. + * Copyright Ericsson AB 2012-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c b/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c index e2221b9e17..d87c2bec93 100644 --- a/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c +++ b/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2007-2013. All Rights Reserved. + * Copyright Ericsson AB 2007-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c b/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c index fdf8e4c0ad..37cb93fb3a 100644 --- a/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c +++ b/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011-2014. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/driver_SUITE_data/thr_free_drv.c b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c index 54205f190e..48fe5fa435 100644 --- a/erts/emulator/test/driver_SUITE_data/thr_free_drv.c +++ b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c b/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c index f7a7cc2b8e..56183c9484 100644 --- a/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c +++ b/erts/emulator/test/driver_SUITE_data/thr_msg_blast_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012. All Rights Reserved. + * Copyright Ericsson AB 2012-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/efile_SUITE.erl b/erts/emulator/test/efile_SUITE.erl index 4d8d89db9b..6bb8487c4e 100644 --- a/erts/emulator/test/efile_SUITE.erl +++ b/erts/emulator/test/efile_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -18,34 +18,18 @@ %% %CopyrightEnd% -module(efile_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-export([all/0, suite/0]). -export([iter_max_files/1, async_dist/1]). -export([do_iter_max_files/2, do_async_dist/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [iter_max_files, async_dist]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - do_async_dist(Dir) -> X = 100, AT = erlang:system_info(thread_pool_size), @@ -70,59 +54,58 @@ file_keys(Dir,Num,FdList,FnList) -> Name = "dummy"++integer_to_list(Num), FN = filename:join([Dir,Name]), case file:open(FN,[write,raw]) of - {ok,FD} -> - {file_descriptor,prim_file,{Port,_}} = FD, - <<X:32/integer-big>> = - iolist_to_binary(erlang:port_control(Port,$K,[])), - [X | file_keys(Dir,Num-1,[FD|FdList],[FN|FnList])]; - {error,_} -> - % Try freeing up FD's if there are any - case FdList of - [] -> - exit({cannot_open_file,FN}); - _ -> - [ file:close(FD) || FD <- FdList ], - [ file:delete(F) || F <- FnList ], - file_keys(Dir,Num,[],[]) - end + {ok,FD} -> + {file_descriptor,prim_file,{Port,_}} = FD, + <<X:32/integer-big>> = + iolist_to_binary(erlang:port_control(Port,$K,[])), + [X | file_keys(Dir,Num-1,[FD|FdList],[FN|FnList])]; + {error,_} -> + % Try freeing up FD's if there are any + case FdList of + [] -> + exit({cannot_open_file,FN}); + _ -> + [ file:close(FD) || FD <- FdList ], + [ file:delete(F) || F <- FnList ], + file_keys(Dir,Num,[],[]) + end end. -async_dist(doc) -> - "Check that the distribution of files over async threads is fair"; +%% Check that the distribution of files over async threads is fair async_dist(Config) when is_list(Config) -> - DataDir = ?config(data_dir,Config), + DataDir = proplists:get_value(data_dir,Config), TestFile = filename:join(DataDir, "existing_file"), Dir = filename:dirname(code:which(?MODULE)), AsyncSizes = [7,10,100,255,256,64,63,65], Max = 0.5, lists:foreach(fun(Size) -> - {ok,Node} = - test_server:start_node - (test_iter_max_files,slave, - [{args, - "+A "++integer_to_list(Size)++ - " -pa " ++ Dir}]), - {Distr,SD} = rpc:call(Node,?MODULE,do_async_dist, - [DataDir]), - test_server:stop_node(Node), - if - SD > Max -> - io:format("Bad async queue distribution for " - "~p async threads:~n" - " Standard deviation is ~p~n" - " Key distribution:~n ~lp~n", - [Size,SD,Distr]), - exit({bad_async_dist,Size,SD,Distr}); - true -> - io:format("OK async queue distribution for " - "~p async threads:~n" - " Standard deviation is ~p~n" - " Key distribution:~n ~lp~n", - [Size,SD,Distr]), - ok - end - end, AsyncSizes), + {ok,Node} = + test_server:start_node + (test_iter_max_files,slave, + [{args, + "+A "++integer_to_list(Size)++ + " -pa " ++ Dir}]), + {Distr,SD} = rpc:call(Node,?MODULE,do_async_dist, + [DataDir]), + test_server:stop_node(Node), + if + SD > Max -> + io:format("Bad async queue distribution for " + "~p async threads:~n" + " Standard deviation is ~p~n" + " Key distribution:~n ~lp~n", + [Size,SD,Distr]), + exit({bad_async_dist,Size,SD,Distr}); + true -> + io:format("OK async queue distribution for " + "~p async threads:~n" + " Standard deviation is ~p~n" + " Key distribution:~n ~lp~n", + [Size,SD,Distr]), + ok + end + end, AsyncSizes), ok. %% @@ -130,54 +113,53 @@ async_dist(Config) when is_list(Config) -> %% that we get the same number of files every time. %% -iter_max_files(suite) -> []; iter_max_files(Config) when is_list(Config) -> - DataDir = ?config(data_dir,Config), + DataDir = proplists:get_value(data_dir,Config), TestFile = filename:join(DataDir, "existing_file"), N = 10, %% Run on a different node in order to set the max ports Dir = filename:dirname(code:which(?MODULE)), {ok,Node} = test_server:start_node(test_iter_max_files,slave, - [{args,"+Q 1524 -pa " ++ Dir}]), + [{args,"+Q 1524 -pa " ++ Dir}]), L = rpc:call(Node,?MODULE,do_iter_max_files,[N, TestFile]), test_server:stop_node(Node), io:format("Number of files opened in each test:~n~w\n", [L]), all_equal(L), Head = hd(L), if Head >= 2 -> ok; - true -> ?line test_server:fail(too_few_files) + true -> ct:fail(too_few_files) end, {comment, "Max files: " ++ integer_to_list(hd(L))}. do_iter_max_files(N, Name) when N > 0 -> - ?line [max_files(Name)| do_iter_max_files(N-1, Name)]; + [max_files(Name)| do_iter_max_files(N-1, Name)]; do_iter_max_files(_, _) -> []. all_equal([E, E| T]) -> - ?line all_equal([E| T]); + all_equal([E| T]); all_equal([_]) -> ok; all_equal([]) -> ok. - + max_files(Name) -> - ?line Fds = open_files(Name), - ?line N = length(Fds), - ?line close_files(Fds), + Fds = open_files(Name), + N = length(Fds), + close_files(Fds), N. close_files([Fd| Fds]) -> - ?line file:close(Fd), - ?line close_files(Fds); + file:close(Fd), + close_files(Fds); close_files([]) -> ok. open_files(Name) -> - ?line case file:open(Name, [read,raw]) of - {ok, Fd} -> - [Fd| open_files(Name)]; - {error, _Reason} -> -% io:format("Error reason: ~p", [_Reason]), - [] - end. + case file:open(Name, [read,raw]) of + {ok, Fd} -> + [Fd| open_files(Name)]; + {error, _Reason} -> + % io:format("Error reason: ~p", [_Reason]), + [] + end. diff --git a/erts/emulator/test/emulator.spec.ose b/erts/emulator/test/emulator.spec.ose deleted file mode 100644 index 9f494609d9..0000000000 --- a/erts/emulator/test/emulator.spec.ose +++ /dev/null @@ -1,2 +0,0 @@ -{topcase, {dir, "../emulator_test"}}. -{skip, {obsolete_SUITE, "Not on ose"}}. diff --git a/erts/emulator/test/erl_drv_thread_SUITE.erl b/erts/emulator/test/erl_drv_thread_SUITE.erl index 2cd569ce4f..f99c151936 100644 --- a/erts/emulator/test/erl_drv_thread_SUITE.erl +++ b/erts/emulator/test/erl_drv_thread_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,12 +20,11 @@ -module(erl_drv_thread_SUITE). -author('[email protected]'). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-export([all/0, suite/0]). -export([basic/1, rwlock/1, tsd/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(DEFAULT_TIMETRAP_SECS, 240). @@ -34,38 +33,17 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [basic, rwlock, tsd]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% %% Testcases %% %% %% -basic(suite) -> []; -basic(doc) -> []; -basic(Cfg) -> ?line drv_case(Cfg, basic). +basic(Cfg) -> drv_case(Cfg, basic). -rwlock(suite) -> []; -rwlock(doc) -> []; -rwlock(Cfg) -> ?line drv_case(Cfg, rwlock). +rwlock(Cfg) -> drv_case(Cfg, rwlock). -tsd(suite) -> []; -tsd(doc) -> []; -tsd(Cfg) -> ?line drv_case(Cfg, tsd). +tsd(Cfg) -> drv_case(Cfg, tsd). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% @@ -81,58 +59,54 @@ drv_case(Config, CaseName, Command) when is_list(Command) -> drv_case(Config, CaseName, Command, ?DEFAULT_TIMETRAP_SECS). drv_case(Config, CaseName, TimeTrap, Command) when is_list(Command), - is_integer(TimeTrap) -> + is_integer(TimeTrap) -> drv_case(Config, CaseName, Command, TimeTrap); drv_case(Config, CaseName, Command, TimeTrap) when is_list(Config), - is_atom(CaseName), - is_list(Command), - is_integer(TimeTrap) -> - case ?t:os_type() of - {Family, _} when Family == unix; Family == win32 -> - ?line run_drv_case(Config, CaseName, Command, TimeTrap); - SkipOs -> - ?line {skipped, - lists:flatten(["Not run on " - | io_lib:format("~p",[SkipOs])])} + is_atom(CaseName), + is_list(Command), + is_integer(TimeTrap) -> + case os:type() of + {Family, _} when Family == unix; Family == win32 -> + run_drv_case(Config, CaseName, Command, TimeTrap); + SkipOs -> + {skipped, lists:flatten(["Not run on " | io_lib:format("~p",[SkipOs])])} end. run_drv_case(Config, CaseName, Command, TimeTrap) -> - ?line Dog = test_server:timetrap(test_server:seconds(TimeTrap)), - ?line DataDir = ?config(data_dir,Config), + ct:timetrap({seconds, TimeTrap}), + DataDir = proplists:get_value(data_dir,Config), case erl_ddll:load_driver(DataDir, CaseName) of - ok -> ok; - {error, Error} -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - ?line ?t:fail() + ok -> ok; + {error, Error} -> + ct:fail(erl_ddll:format_error(Error)) + end, + Port = open_port({spawn, atom_to_list(CaseName)}, []), + true = is_port(Port), + Port ! {self(), {command, Command}}, + Result = receive_drv_result(Port, CaseName), + Port ! {self(), close}, + receive + {Port, closed} -> + ok end, - ?line Port = open_port({spawn, atom_to_list(CaseName)}, []), - ?line true = is_port(Port), - ?line Port ! {self(), {command, Command}}, - ?line Result = receive_drv_result(Port, CaseName), - ?line Port ! {self(), close}, - ?line receive - {Port, closed} -> - ok - end, - ?line ok = erl_ddll:unload_driver(CaseName), - ?line test_server:timetrap_cancel(Dog), - ?line Result. + ok = erl_ddll:unload_driver(CaseName), + Result. receive_drv_result(Port, CaseName) -> - ?line receive - {print, Port, CaseName, Str} -> - ?line ?t:format("~s", [Str]), - ?line receive_drv_result(Port, CaseName); - {'EXIT', Port, Error} -> - ?line ?t:fail(Error); - {'EXIT', error, Error} -> - ?line ?t:fail(Error); - {failed, Port, CaseName, Comment} -> - ?line ?t:fail(Comment); - {skipped, Port, CaseName, Comment} -> - ?line {skipped, Comment}; - {succeeded, Port, CaseName, ""} -> - ?line succeeded; - {succeeded, Port, CaseName, Comment} -> - ?line {comment, Comment} - end. + receive + {print, Port, CaseName, Str} -> + io:format("~s", [Str]), + receive_drv_result(Port, CaseName); + {'EXIT', Port, Error} -> + ct:fail(Error); + {'EXIT', error, Error} -> + ct:fail(Error); + {failed, Port, CaseName, Comment} -> + ct:fail(Comment); + {skipped, Port, CaseName, Comment} -> + {skipped, Comment}; + {succeeded, Port, CaseName, ""} -> + succeeded; + {succeeded, Port, CaseName, Comment} -> + {comment, Comment} + end. diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl index a7a45046ca..93d2065ba3 100644 --- a/erts/emulator/test/erl_link_SUITE.erl +++ b/erts/emulator/test/erl_link_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -29,24 +29,23 @@ -author('[email protected]'). %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]). % Test cases -export([links/1, - dist_links/1, - monitor_nodes/1, - process_monitors/1, - dist_process_monitors/1, - busy_dist_port_monitor/1, - busy_dist_port_link/1, - otp_5772_link/1, - otp_5772_dist_link/1, - otp_5772_monitor/1, - otp_5772_dist_monitor/1, - otp_7946/1]). + dist_links/1, + monitor_nodes/1, + process_monitors/1, + dist_process_monitors/1, + busy_dist_port_monitor/1, + busy_dist_port_link/1, + otp_5772_link/1, + otp_5772_dist_link/1, + otp_5772_monitor/1, + otp_5772_dist_monitor/1, + otp_7946/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -65,21 +64,20 @@ -record(erl_link, {type = ?LINK_UNDEF, - pid = [], - targets = []}). + pid = [], + targets = []}). % This is to be kept in sync with erl_bif_info.c (make_monitor_list) --record(erl_monitor, { - type, % MON_ORIGIN or MON_TARGET (1 or 3) - ref, - pid, % Process or nodename - name = [] % registered name or [] - }). +-record(erl_monitor, {type, % MON_ORIGIN or MON_TARGET (1 or 3) + ref, + pid, % Process or nodename + name = []}). % registered name or [] - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [links, dist_links, monitor_nodes, process_monitors, @@ -87,8 +85,15 @@ all() -> busy_dist_port_link, otp_5772_link, otp_5772_dist_link, otp_5772_monitor, otp_5772_dist_monitor, otp_7946]. -groups() -> - []. +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + case catch erts_debug:get_internal_state(available_internal_state) of + true -> ok; + _ -> erts_debug:set_internal_state(available_internal_state, true) + end, + Config. + +end_per_testcase(_Func, _Config) -> + ok. init_per_suite(Config) -> Config. @@ -96,419 +101,397 @@ init_per_suite(Config) -> end_per_suite(_Config) -> catch erts_debug:set_internal_state(available_internal_state, false). -init_per_group(_GroupName, Config) -> - Config. -end_per_group(_GroupName, Config) -> - Config. - - -links(doc) -> ["Tests node local links"]; -links(suite) -> []; +%% Tests node local links links(Config) when is_list(Config) -> - ?line common_link_test(node(), node()), - ?line true = link(self()), - ?line [] = find_erl_link(self(), ?LINK_PID, self()), - ?line true = unlink(self()), - ?line ok. - -dist_links(doc) -> ["Tests distributed links"]; -dist_links(suite) -> []; + common_link_test(node(), node()), + true = link(self()), + [] = find_erl_link(self(), ?LINK_PID, self()), + true = unlink(self()), + ok. + +%% Tests distributed links dist_links(Config) when is_list(Config) -> - ?line [NodeName] = get_names(1, dist_link), - ?line {ok, Node} = start_node(NodeName), - ?line common_link_test(node(), Node), - ?line TP4 = spawn(?MODULE, test_proc, []), - ?line TP5 = spawn(?MODULE, test_proc, []), - ?line TP6 = spawn(Node, ?MODULE, test_proc, []), - ?line true = tp_call(TP6, fun() -> link(TP4) end), - ?line check_link(TP4, TP6), - ?line true = tp_call(TP5, - fun() -> - process_flag(trap_exit,true), - link(TP6) - end), - ?line check_link(TP5, TP6), - ?line rpc:cast(Node, erlang, halt, []), - ?line wait_until(fun () -> ?line is_proc_dead(TP4) end), - ?line check_unlink(TP4, TP6), - ?line true = tp_call(TP5, - fun() -> - receive - {'EXIT', TP6, noconnection} -> - true - end - end), - ?line check_unlink(TP5, TP6), - ?line tp_cast(TP5, fun() -> exit(normal) end), - ?line ok. + [NodeName] = get_names(1, dist_link), + {ok, Node} = start_node(NodeName), + common_link_test(node(), Node), + TP4 = spawn(?MODULE, test_proc, []), + TP5 = spawn(?MODULE, test_proc, []), + TP6 = spawn(Node, ?MODULE, test_proc, []), + true = tp_call(TP6, fun() -> link(TP4) end), + check_link(TP4, TP6), + true = tp_call(TP5, + fun() -> + process_flag(trap_exit,true), + link(TP6) + end), + check_link(TP5, TP6), + rpc:cast(Node, erlang, halt, []), + wait_until(fun () -> is_proc_dead(TP4) end), + check_unlink(TP4, TP6), + true = tp_call(TP5, + fun() -> + receive + {'EXIT', TP6, noconnection} -> + true + end + end), + check_unlink(TP5, TP6), + tp_cast(TP5, fun() -> exit(normal) end), + ok. common_link_test(NodeA, NodeB) -> - ?line TP1 = spawn(NodeA, ?MODULE, test_proc, []), - ?line check_unlink(TP1, self()), - ?line TP2 = tp_call(TP1, - fun () -> - spawn_link(NodeB, ?MODULE, test_proc, []) - end), - ?line check_link(TP1, TP2), - ?line true = tp_call(TP2, fun() -> unlink(TP1) end), - ?line check_unlink(TP1, TP2), - ?line true = tp_call(TP2, fun() -> link(TP1) end), - ?line check_link(TP1, TP2), - ?line false = tp_call(TP2, fun() -> process_flag(trap_exit, true) end), - ?line tp_cast(TP1, fun () -> exit(died) end), - ?line true = tp_call(TP2, fun() -> - receive - {'EXIT', TP1, died} -> - true - end - end), - ?line check_unlink(TP1, TP2), - ?line TP3 = tp_call(TP2, - fun () -> - spawn_link(NodeA, ?MODULE, test_proc, []) - end), - ?line check_link(TP3, TP2), - ?line tp_cast(TP2, fun() -> exit(died) end), - ?line wait_until(fun () -> ?line is_proc_dead(TP3) end), - ?line check_unlink(TP3, TP2), - ?line ok. - -monitor_nodes(doc) -> ["Tests monitor of nodes"]; -monitor_nodes(suite) -> []; + TP1 = spawn(NodeA, ?MODULE, test_proc, []), + check_unlink(TP1, self()), + TP2 = tp_call(TP1, + fun () -> + spawn_link(NodeB, ?MODULE, test_proc, []) + end), + check_link(TP1, TP2), + true = tp_call(TP2, fun() -> unlink(TP1) end), + check_unlink(TP1, TP2), + true = tp_call(TP2, fun() -> link(TP1) end), + check_link(TP1, TP2), + false = tp_call(TP2, fun() -> process_flag(trap_exit, true) end), + tp_cast(TP1, fun () -> exit(died) end), + true = tp_call(TP2, fun() -> + receive + {'EXIT', TP1, died} -> + true + end + end), + check_unlink(TP1, TP2), + TP3 = tp_call(TP2, + fun () -> + spawn_link(NodeA, ?MODULE, test_proc, []) + end), + check_link(TP3, TP2), + tp_cast(TP2, fun() -> exit(died) end), + wait_until(fun () -> is_proc_dead(TP3) end), + check_unlink(TP3, TP2), + ok. + +%% Tests monitor of nodes monitor_nodes(Config) when is_list(Config) -> - ?line [An, Bn, Cn, Dn] = get_names(4, dist_link), - ?line {ok, A} = start_node(An), - ?line {ok, B} = start_node(Bn), - ?line C = list_to_atom(lists:concat([Cn, "@", hostname()])), - ?line D = list_to_atom(lists:concat([Dn, "@", hostname()])), - ?line 0 = no_of_monitor_node(self(), A), - ?line 0 = no_of_monitor_node(self(), B), - ?line monitor_node(A, true), - ?line monitor_node(B, true), - ?line monitor_node(D, true), - ?line monitor_node(D, true), + [An, Bn, Cn, Dn] = get_names(4, dist_link), + {ok, A} = start_node(An), + {ok, B} = start_node(Bn), + C = list_to_atom(lists:concat([Cn, "@", hostname()])), + D = list_to_atom(lists:concat([Dn, "@", hostname()])), + 0 = no_of_monitor_node(self(), A), + 0 = no_of_monitor_node(self(), B), + monitor_node(A, true), + monitor_node(B, true), + monitor_node(D, true), + monitor_node(D, true), %% Has been known to crash the emulator. - ?line {memory,_} = process_info(self(), memory), - - ?line monitor_node(A, false), - ?line monitor_node(B, true), - ?line monitor_node(C, true), - ?line monitor_node(C, false), - ?line monitor_node(C, true), - ?line monitor_node(B, true), - ?line monitor_node(A, false), - ?line monitor_node(B, true), - ?line monitor_node(B, false), - ?line monitor_node(A, true), - ?line check_monitor_node(self(), A, 1), - ?line check_monitor_node(self(), B, 3), - ?line check_monitor_node(self(), C, 0), - ?line check_monitor_node(self(), D, 0), - ?line receive {nodedown, C} -> ok end, - ?line receive {nodedown, C} -> ok end, - ?line receive {nodedown, C} -> ok end, - ?line receive {nodedown, D} -> ok end, - ?line receive {nodedown, D} -> ok end, - ?line stop_node(A), - ?line receive {nodedown, A} -> ok end, - ?line check_monitor_node(self(), A, 0), - ?line check_monitor_node(self(), B, 3), - ?line stop_node(B), - ?line receive {nodedown, B} -> ok end, - ?line receive {nodedown, B} -> ok end, - ?line receive {nodedown, B} -> ok end, - ?line check_monitor_node(self(), B, 0), - ?line receive - {nodedown, X} -> - ?line ?t:fail({unexpected_nodedown, X}) - after 0 -> - ?line ok - end, - ?line ok. - - -process_monitors(doc) -> ["Tests node local process monitors"]; -process_monitors(suite) -> []; + {memory,_} = process_info(self(), memory), + + monitor_node(A, false), + monitor_node(B, true), + monitor_node(C, true), + monitor_node(C, false), + monitor_node(C, true), + monitor_node(B, true), + monitor_node(A, false), + monitor_node(B, true), + monitor_node(B, false), + monitor_node(A, true), + check_monitor_node(self(), A, 1), + check_monitor_node(self(), B, 3), + check_monitor_node(self(), C, 0), + check_monitor_node(self(), D, 0), + receive {nodedown, C} -> ok end, + receive {nodedown, C} -> ok end, + receive {nodedown, C} -> ok end, + receive {nodedown, D} -> ok end, + receive {nodedown, D} -> ok end, + stop_node(A), + receive {nodedown, A} -> ok end, + check_monitor_node(self(), A, 0), + check_monitor_node(self(), B, 3), + stop_node(B), + receive {nodedown, B} -> ok end, + receive {nodedown, B} -> ok end, + receive {nodedown, B} -> ok end, + check_monitor_node(self(), B, 0), + receive + {nodedown, X} -> + ct:fail({unexpected_nodedown, X}) + after 0 -> + ok + end, + ok. + + +%% Tests node local process monitors process_monitors(Config) when is_list(Config) -> - ?line common_process_monitors(node(), node()), - ?line Mon1 = erlang:monitor(process,self()), - ?line [] = find_erl_monitor(self(), Mon1), - ?line [Name] = get_names(1, process_monitors), - ?line true = register(Name, self()), - ?line Mon2 = erlang:monitor(process, Name), - ?line [] = find_erl_monitor(self(), Mon2), - ?line receive - {'DOWN', Mon1, _, _, _} = Msg -> - ?line ?t:fail({unexpected_down_msg, Msg}); - {'DOWN', Mon2, _, _, _} = Msg -> - ?line ?t:fail({unexpected_down_msg, Msg}) - after 500 -> - ?line true = erlang:demonitor(Mon1), - ?line true = erlang:demonitor(Mon2), - ?line ok - end. - -dist_process_monitors(doc) -> ["Tests distributed process monitors"]; -dist_process_monitors(suite) -> []; + common_process_monitors(node(), node()), + Mon1 = erlang:monitor(process,self()), + [] = find_erl_monitor(self(), Mon1), + [Name] = get_names(1, process_monitors), + true = register(Name, self()), + Mon2 = erlang:monitor(process, Name), + [] = find_erl_monitor(self(), Mon2), + receive + {'DOWN', Mon1, _, _, _} = Msg -> + ct:fail({unexpected_down_msg, Msg}); + {'DOWN', Mon2, _, _, _} = Msg -> + ct:fail({unexpected_down_msg, Msg}) + after 500 -> + true = erlang:demonitor(Mon1), + true = erlang:demonitor(Mon2), + ok + end. + +%% Tests distributed process monitors dist_process_monitors(Config) when is_list(Config) -> - ?line [Name] = get_names(1,dist_process_monitors), - ?line {ok, Node} = start_node(Name), - ?line common_process_monitors(node(), Node), - ?line TP1 = spawn(Node, ?MODULE, test_proc, []), - ?line R1 = erlang:monitor(process, TP1), - ?line TP1O = get_down_object(TP1, self()), - ?line check_process_monitor(self(), TP1, R1), - ?line tp_cast(TP1, fun () -> halt() end), - ?line receive - {'DOWN',R1,process,TP1O,noconnection} -> - ?line ok - end, - ?line check_process_demonitor(self(), TP1, R1), - ?line R2 = erlang:monitor(process, TP1), - ?line receive - {'DOWN',R2,process,TP1O,noconnection} -> - ?line ok - end, - ?line check_process_demonitor(self(), TP1, R2), - ?line ok. + [Name] = get_names(1,dist_process_monitors), + {ok, Node} = start_node(Name), + common_process_monitors(node(), Node), + TP1 = spawn(Node, ?MODULE, test_proc, []), + R1 = erlang:monitor(process, TP1), + TP1O = get_down_object(TP1, self()), + check_process_monitor(self(), TP1, R1), + tp_cast(TP1, fun () -> halt() end), + receive + {'DOWN',R1,process,TP1O,noconnection} -> + ok + end, + check_process_demonitor(self(), TP1, R1), + R2 = erlang:monitor(process, TP1), + receive + {'DOWN',R2,process,TP1O,noconnection} -> + ok + end, + check_process_demonitor(self(), TP1, R2), + ok. common_process_monitors(NodeA, NodeB) -> - ?line TP1 = spawn(NodeA, ?MODULE, test_proc, []), - ?line TP2 = spawn(NodeB, ?MODULE, test_proc, []), - ?line run_common_process_monitors(TP1, TP2), - ?line TP3 = spawn(NodeA, ?MODULE, test_proc, []), - ?line TP4 = spawn(NodeB, ?MODULE, test_proc, []), - ?line [TP4N] = get_names(1, common_process_monitors), - ?line true = tp_call(TP4, fun () -> register(TP4N,self()) end), - ?line run_common_process_monitors(TP3, - case node() == node(TP4) of - true -> TP4N; - false -> {TP4N, node(TP4)} - end), - ?line ok. + TP1 = spawn(NodeA, ?MODULE, test_proc, []), + TP2 = spawn(NodeB, ?MODULE, test_proc, []), + run_common_process_monitors(TP1, TP2), + TP3 = spawn(NodeA, ?MODULE, test_proc, []), + TP4 = spawn(NodeB, ?MODULE, test_proc, []), + [TP4N] = get_names(1, common_process_monitors), + true = tp_call(TP4, fun () -> register(TP4N,self()) end), + run_common_process_monitors(TP3, + case node() == node(TP4) of + true -> TP4N; + false -> {TP4N, node(TP4)} + end), + ok. run_common_process_monitors(TP1, TP2) -> - ?line R1 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), - ?line check_process_monitor(TP1, TP2, R1), - - ?line tp_call(TP2, fun () -> catch erlang:demonitor(R1) end), - ?line check_process_monitor(TP1, TP2, R1), - - ?line true = tp_call(TP1, fun () -> erlang:demonitor(R1) end), - ?line check_process_demonitor(TP1, TP2, R1), - - ?line R2 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), - ?line TP2O = get_down_object(TP2, TP1), - ?line check_process_monitor(TP1, TP2, R2), - ?line tp_cast(TP2, fun () -> exit(bye) end), - ?line wait_until(fun () -> ?line is_proc_dead(TP2) end), - ?line ok = tp_call(TP1, fun () -> - ?line receive - {'DOWN',R2,process,TP2O,bye} -> - ?line ok - end - end), - ?line check_process_demonitor(TP1, TP2, R2), - - ?line R3 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), - ?line ok = tp_call(TP1, fun () -> - ?line receive - {'DOWN',R3,process,TP2O,noproc} -> - ?line ok - end - end), - ?line check_process_demonitor(TP1, TP2, R3), - - ?line tp_cast(TP1, fun () -> exit(normal) end), - ?line wait_until(fun () -> ?line is_proc_dead(TP1) end), - ?line ok. - - -busy_dist_port_monitor(doc) -> ["Tests distributed monitor/2, demonitor/1, " - "and 'DOWN' message over busy distribution " - "port"]; -busy_dist_port_monitor(suite) -> []; + R1 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), + check_process_monitor(TP1, TP2, R1), + + tp_call(TP2, fun () -> catch erlang:demonitor(R1) end), + check_process_monitor(TP1, TP2, R1), + + true = tp_call(TP1, fun () -> erlang:demonitor(R1) end), + check_process_demonitor(TP1, TP2, R1), + + R2 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), + TP2O = get_down_object(TP2, TP1), + check_process_monitor(TP1, TP2, R2), + tp_cast(TP2, fun () -> exit(bye) end), + wait_until(fun () -> is_proc_dead(TP2) end), + ok = tp_call(TP1, fun () -> + receive + {'DOWN',R2,process,TP2O,bye} -> + ok + end + end), + check_process_demonitor(TP1, TP2, R2), + + R3 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), + ok = tp_call(TP1, fun () -> + receive + {'DOWN',R3,process,TP2O,noproc} -> + ok + end + end), + check_process_demonitor(TP1, TP2, R3), + + tp_cast(TP1, fun () -> exit(normal) end), + wait_until(fun () -> is_proc_dead(TP1) end), + ok. + + +%% Tests distributed monitor/2, demonitor/1, and 'DOWN' message +%% over busy distribution port busy_dist_port_monitor(Config) when is_list(Config) -> - ?line Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of - "true" -> start_busy_dist_port_tracer(); - _ -> false - end, + Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of + "true" -> start_busy_dist_port_tracer(); + _ -> false + end, - ?line [An] = get_names(1, busy_dist_port_monitor), - ?line {ok, A} = start_node(An), - ?line TP1 = spawn(A, ?MODULE, test_proc, []), + [An] = get_names(1, busy_dist_port_monitor), + {ok, A} = start_node(An), + TP1 = spawn(A, ?MODULE, test_proc, []), %% Check monitor over busy port - ?line M1 = suspend_on_busy_test(A, - "erlang:monitor(process, TP1)", - fun () -> erlang:monitor(process, TP1) end), - ?line check_process_monitor(self(), TP1, M1), + M1 = suspend_on_busy_test(A, + "erlang:monitor(process, TP1)", + fun () -> erlang:monitor(process, TP1) end), + check_process_monitor(self(), TP1, M1), %% Check demonitor over busy port - ?line suspend_on_busy_test(A, - "erlang:demonitor(M1)", - fun () -> erlang:demonitor(M1) end), - ?line check_process_demonitor(self(), TP1, M1), + suspend_on_busy_test(A, + "erlang:demonitor(M1)", + fun () -> erlang:demonitor(M1) end), + check_process_demonitor(self(), TP1, M1), %% Check down message over busy port - ?line TP2 = spawn(?MODULE, test_proc, []), - ?line M2 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), - ?line check_process_monitor(TP1, TP2, M2), - ?line Ref = make_ref(), - ?line Busy = make_busy(A, 1000), - ?line receive after 100 -> ok end, - ?line tp_cast(TP2, fun () -> exit(Ref) end), - ?line receive after 100 -> ok end, - ?line unmake_busy(Busy), - ?line Ref = tp_call(TP1, fun () -> - receive - {'DOWN', M2, process, TP2, Ref} -> - Ref - end - end), - ?line tp_cast(TP1, fun () -> exit(normal) end), - ?line stop_node(A), - ?line stop_busy_dist_port_tracer(Tracer), - ?line ok. - -busy_dist_port_link(doc) -> ["Tests distributed link/1, unlink/1, and 'EXIT'", - " message over busy distribution port"]; -busy_dist_port_link(suite) -> []; + TP2 = spawn(?MODULE, test_proc, []), + M2 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), + check_process_monitor(TP1, TP2, M2), + Ref = make_ref(), + Busy = make_busy(A, 1000), + receive after 100 -> ok end, + tp_cast(TP2, fun () -> exit(Ref) end), + receive after 100 -> ok end, + unmake_busy(Busy), + Ref = tp_call(TP1, fun () -> + receive + {'DOWN', M2, process, TP2, Ref} -> + Ref + end + end), + tp_cast(TP1, fun () -> exit(normal) end), + stop_node(A), + stop_busy_dist_port_tracer(Tracer), + ok. + +%% Tests distributed link/1, unlink/1, and 'EXIT' +%% message over busy distribution port busy_dist_port_link(Config) when is_list(Config) -> - ?line Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of - "true" -> start_busy_dist_port_tracer(); - _ -> false - end, - - ?line [An] = get_names(1, busy_dist_port_link), - ?line {ok, A} = start_node(An), - ?line TP1 = spawn(A, ?MODULE, test_proc, []), + Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of + "true" -> start_busy_dist_port_tracer(); + _ -> false + end, + + [An] = get_names(1, busy_dist_port_link), + {ok, A} = start_node(An), + TP1 = spawn(A, ?MODULE, test_proc, []), %% Check link over busy port - ?line suspend_on_busy_test(A, - "link(TP1)", - fun () -> link(TP1) end), - ?line check_link(self(), TP1), + suspend_on_busy_test(A, + "link(TP1)", + fun () -> link(TP1) end), + check_link(self(), TP1), %% Check unlink over busy port - ?line suspend_on_busy_test(A, - "unlink(TP1)", - fun () -> unlink(TP1) end), - ?line check_unlink(self(), TP1), + suspend_on_busy_test(A, + "unlink(TP1)", + fun () -> unlink(TP1) end), + check_unlink(self(), TP1), %% Check trap exit message over busy port - ?line TP2 = spawn(?MODULE, test_proc, []), - ?line ok = tp_call(TP1, fun () -> - process_flag(trap_exit, true), - link(TP2), - ok - end), - ?line check_link(TP1, TP2), - ?line Ref = make_ref(), - ?line Busy = make_busy(A, 1000), - ?line receive after 100 -> ok end, - ?line tp_cast(TP2, fun () -> exit(Ref) end), - ?line receive after 100 -> ok end, - ?line unmake_busy(Busy), - ?line Ref = tp_call(TP1, fun () -> - receive - {'EXIT', TP2, Ref} -> - Ref - end - end), - ?line tp_cast(TP1, fun () -> exit(normal) end), - ?line stop_node(A), - ?line stop_busy_dist_port_tracer(Tracer), - ?line ok. - - -otp_5772_link(doc) -> []; -otp_5772_link(suite) -> []; + TP2 = spawn(?MODULE, test_proc, []), + ok = tp_call(TP1, fun () -> + process_flag(trap_exit, true), + link(TP2), + ok + end), + check_link(TP1, TP2), + Ref = make_ref(), + Busy = make_busy(A, 1000), + receive after 100 -> ok end, + tp_cast(TP2, fun () -> exit(Ref) end), + receive after 100 -> ok end, + unmake_busy(Busy), + Ref = tp_call(TP1, fun () -> + receive + {'EXIT', TP2, Ref} -> + Ref + end + end), + tp_cast(TP1, fun () -> exit(normal) end), + stop_node(A), + stop_busy_dist_port_tracer(Tracer), + ok. + + otp_5772_link(Config) when is_list(Config) -> - ?line otp_5772_link_test(node()). + otp_5772_link_test(node()). -otp_5772_dist_link(doc) -> []; -otp_5772_dist_link(suite) -> []; otp_5772_dist_link(Config) when is_list(Config) -> - ?line [An] = get_names(1, otp_5772_dist_link), - ?line {ok, A} = start_node(An), - ?line otp_5772_link_test(A), - ?line stop_node(A). + [An] = get_names(1, otp_5772_dist_link), + {ok, A} = start_node(An), + otp_5772_link_test(A), + stop_node(A). otp_5772_link_test(Node) -> - ?line Prio = process_flag(priority, high), - ?line TE = process_flag(trap_exit, true), - ?line TP1 = spawn_opt(Node, ?MODULE, test_proc, [], - [link, {priority, low}]), + Prio = process_flag(priority, high), + TE = process_flag(trap_exit, true), + TP1 = spawn_opt(Node, ?MODULE, test_proc, [], + [link, {priority, low}]), exit(TP1, bang), unlink(TP1), - ?line receive - {'EXIT', TP1, _} -> - ?line ok - after 0 -> - ?line ok - end, - ?line receive - {'EXIT', TP1, _} = Exit -> - ?line ?t:fail({got_late_exit_message, Exit}) - after 1000 -> - ?line ok - end, - ?line process_flag(trap_exit, TE), - ?line process_flag(priority, Prio), - ?line ok. - -otp_5772_monitor(doc) -> []; -otp_5772_monitor(suite) -> []; + receive + {'EXIT', TP1, _} -> + ok + after 0 -> + ok + end, + receive + {'EXIT', TP1, _} = Exit -> + ct:fail({got_late_exit_message, Exit}) + after 1000 -> + ok + end, + process_flag(trap_exit, TE), + process_flag(priority, Prio), + ok. + otp_5772_monitor(Config) when is_list(Config) -> - ?line otp_5772_monitor_test(node()). + otp_5772_monitor_test(node()). -otp_5772_dist_monitor(doc) -> []; -otp_5772_dist_monitor(suite) -> []; otp_5772_dist_monitor(Config) when is_list(Config) -> - ?line [An] = get_names(1, otp_5772_dist_monitor), - ?line {ok, A} = start_node(An), - ?line otp_5772_monitor_test(A), - ?line stop_node(A), - ?line ok. + [An] = get_names(1, otp_5772_dist_monitor), + {ok, A} = start_node(An), + otp_5772_monitor_test(A), + stop_node(A), + ok. otp_5772_monitor_test(Node) -> - ?line Prio = process_flag(priority, high), - ?line TP1 = spawn_opt(Node, ?MODULE, test_proc, [], [{priority, low}]), - ?line M1 = erlang:monitor(process, TP1), - ?line exit(TP1, bang), - ?line erlang:demonitor(M1), - ?line receive - {'DOWN', M1, _, _, _} -> - ?line ok - after 0 -> - ?line ok - end, - ?line receive - {'DOWN', M1, _, _, _} = Down -> - ?line ?t:fail({got_late_down_message, Down}) - after 1000 -> - ?line ok - end, - ?line process_flag(priority, Prio), - ?line ok. + Prio = process_flag(priority, high), + TP1 = spawn_opt(Node, ?MODULE, test_proc, [], [{priority, low}]), + M1 = erlang:monitor(process, TP1), + exit(TP1, bang), + erlang:demonitor(M1), + receive + {'DOWN', M1, _, _, _} -> + ok + after 0 -> + ok + end, + receive + {'DOWN', M1, _, _, _} = Down -> + ct:fail({got_late_down_message, Down}) + after 1000 -> + ok + end, + process_flag(priority, Prio), + ok. otp_7946(Config) when is_list(Config) -> - ?line [NodeName] = get_names(1, otp_7946), - ?line {ok, Node} = start_node(NodeName), - ?line Proc = rpc:call(Node, erlang, whereis, [net_kernel]), - ?line Mon = erlang:monitor(process, Proc), - ?line rpc:cast(Node, erlang, halt, []), - ?line receive {'DOWN', Mon, process, Proc , _} -> ok end, - ?line {Linker, LMon} = spawn_monitor(fun () -> - link(Proc), - receive - after infinity -> ok - end - end), - ?line receive - {'DOWN', LMon, process, Linker, Reason} -> - ?line ?t:format("Reason=~p~n", [Reason]), - ?line Reason = noconnection - end. + [NodeName] = get_names(1, otp_7946), + {ok, Node} = start_node(NodeName), + Proc = rpc:call(Node, erlang, whereis, [net_kernel]), + Mon = erlang:monitor(process, Proc), + rpc:cast(Node, erlang, halt, []), + receive {'DOWN', Mon, process, Proc , _} -> ok end, + {Linker, LMon} = spawn_monitor(fun () -> + link(Proc), + receive + after infinity -> ok + end + end), + receive + {'DOWN', LMon, process, Linker, Reason} -> + io:format("Reason=~p~n", [Reason]), + Reason = noconnection + end. %% %% -- Internal utils -------------------------------------------------------- @@ -519,27 +502,27 @@ otp_7946(Config) when is_list(Config) -> busy_data() -> case get(?BUSY_DATA_KEY) of - undefined -> - set_busy_data([]); - Data -> - true = is_binary(Data), - true = size(Data) == ?BUSY_DATA_SIZE, - Data + undefined -> + set_busy_data([]); + Data -> + true = is_binary(Data), + true = size(Data) == ?BUSY_DATA_SIZE, + Data end. set_busy_data(SetData) -> case get(?BUSY_DATA_KEY) of - undefined -> - Data = case SetData of - D when is_binary(D), size(D) == ?BUSY_DATA_SIZE -> - SetData; - _ -> - list_to_binary(lists:duplicate(?BUSY_DATA_SIZE, 253)) - end, - put(?BUSY_DATA_KEY, Data), - Data; - OldData -> - OldData + undefined -> + Data = case SetData of + D when is_binary(D), size(D) == ?BUSY_DATA_SIZE -> + SetData; + _ -> + list_to_binary(lists:duplicate(?BUSY_DATA_SIZE, 253)) + end, + put(?BUSY_DATA_KEY, Data), + Data; + OldData -> + OldData end. freeze_node(Node, MS) -> @@ -547,13 +530,13 @@ freeze_node(Node, MS) -> DoingIt = make_ref(), Freezer = self(), spawn_link(Node, - fun () -> - erts_debug:set_internal_state(available_internal_state, - true), - dport_send(Freezer, DoingIt), - receive after Own -> ok end, - erts_debug:set_internal_state(block, MS+Own) - end), + fun () -> + erts_debug:set_internal_state(available_internal_state, + true), + dport_send(Freezer, DoingIt), + receive after Own -> ok end, + erts_debug:set_internal_state(block, MS+Own) + end), receive DoingIt -> ok end, receive after Own -> ok end. @@ -563,27 +546,27 @@ make_busy(Node, Time) when is_integer(Time) -> Data = busy_data(), %% first make port busy Pid = spawn_link(fun () -> - forever(fun () -> - dport_reg_send(Node, - '__noone__', - Data) - end) - end), + forever(fun () -> + dport_reg_send(Node, + '__noone__', + Data) + end) + end), receive after Own -> ok end, wait_until(fun () -> - case process_info(Pid, status) of - {status, suspended} -> true; - _ -> false - end - end), + case process_info(Pid, status) of + {status, suspended} -> true; + _ -> false + end + end), %% then dist entry make_busy(Node, [nosuspend], Data), Pid. make_busy(Node, Opts, Data) -> case erlang:send({'__noone__', Node}, Data, Opts) of - nosuspend -> nosuspend; - _ -> make_busy(Node, Opts, Data) + nosuspend -> nosuspend; + _ -> make_busy(Node, Opts, Data) end. unmake_busy(Pid) -> @@ -596,33 +579,33 @@ suspend_on_busy_test(Node, Doing, Fun) -> Done = make_ref(), Data = busy_data(), spawn_link(fun () -> - set_busy_data(Data), - Busy = make_busy(Node, 1000), - Tester ! DoIt, - receive after 100 -> ok end, - Info = process_info(Tester, [status, current_function]), - unmake_busy(Busy), - ?t:format("~p doing ~s: ~p~n", [Tester, Doing, Info]), - Tester ! {Done, Info} - end), + set_busy_data(Data), + Busy = make_busy(Node, 1000), + Tester ! DoIt, + receive after 100 -> ok end, + Info = process_info(Tester, [status, current_function]), + unmake_busy(Busy), + io:format("~p doing ~s: ~p~n", [Tester, Doing, Info]), + Tester ! {Done, Info} + end), receive DoIt -> ok end, Res = Fun(), receive - {Done, MyInfo} -> - %% Don't match arity; it is different in - %% debug and optimized emulator - [{status, suspended}, - {current_function, {erlang, bif_return_trap, _}}] = MyInfo, - ok + {Done, MyInfo} -> + %% Don't match arity; it is different in + %% debug and optimized emulator + [{status, suspended}, + {current_function, {erlang, bif_return_trap, _}}] = MyInfo, + ok end, Res. % get_node(Name) when is_atom(Name) -> -% ?line node(); +% node(); % get_node({Name, Node}) when is_atom(Name) -> -% ?line Node; +% Node; % get_node(NC) when is_pid(NC); is_port(NC); is_reference(NC) -> -% ?line node(NC). +% node(NC). get_down_object(Item, _) when is_pid(Item) -> Item; @@ -637,90 +620,78 @@ get_down_object(Item, Watcher) when is_atom(Item), is_atom(Watcher) -> is_proc_dead(P) -> case is_proc_alive(P) of - true -> false; - false -> true + true -> false; + false -> true end. is_proc_alive(Pid) when is_pid(Pid), node(Pid) == node() -> - ?line is_process_alive(Pid); + is_process_alive(Pid); is_proc_alive(Name) when is_atom(Name) -> - ?line case catch whereis(Name) of - Pid when is_pid(Pid) -> - ?line is_proc_alive(Pid); - _ -> - ?line false - end; + case catch whereis(Name) of + Pid when is_pid(Pid) -> + is_proc_alive(Pid); + _ -> + false + end; is_proc_alive({Name, Node}) when is_atom(Name), Node == node() -> - ?line is_proc_alive(Name); + is_proc_alive(Name); is_proc_alive(Proc) -> - ?line is_remote_proc_alive(Proc). + is_remote_proc_alive(Proc). is_remote_proc_alive({Name, Node}) when is_atom(Name), is_atom(Node) -> - ?line is_remote_proc_alive(Name, Node); + is_remote_proc_alive(Name, Node); is_remote_proc_alive(Pid) when is_pid(Pid) -> - ?line is_remote_proc_alive(Pid, node(Pid)); + is_remote_proc_alive(Pid, node(Pid)); is_remote_proc_alive(_) -> - ?line false. + false. is_remote_proc_alive(PN, Node) -> - ?line S = self(), - ?line R = make_ref(), - ?line monitor_node(Node, true), - ?line _P = spawn(Node, fun () -> S ! {R, is_proc_alive(PN)} end), - ?line receive - {R, Bool} -> - ?line monitor_node(Node, false), - ?line Bool; - {nodedown, Node} -> - ?line false - end. + S = self(), + R = make_ref(), + monitor_node(Node, true), + _P = spawn(Node, fun () -> S ! {R, is_proc_alive(PN)} end), + receive + {R, Bool} -> + monitor_node(Node, false), + Bool; + {nodedown, Node} -> + false + end. wait_until(Fun) -> - ?line case Fun() of - true -> - ?line ok; - _ -> - ?line receive - after 100 -> - ?line wait_until(Fun) - end - end. + case Fun() of + true -> + ok; + _ -> + receive + after 100 -> + wait_until(Fun) + end + end. forever(Fun) -> Fun(), forever(Fun). -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - ?line Dog = ?t:timetrap(?t:minutes(1)), - case catch erts_debug:get_internal_state(available_internal_state) of - true -> ok; - _ -> erts_debug:set_internal_state(available_internal_state, true) - end, - ?line [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - ?line Dog = ?config(watchdog, Config), - ?line ?t:timetrap_cancel(Dog). - tp_call(Tp, Fun) -> - ?line R = make_ref(), - ?line Tp ! {call, self(), R, Fun}, - ?line receive - {R, Res} -> - ?line Res - end. + R = make_ref(), + Tp ! {call, self(), R, Fun}, + receive + {R, Res} -> + Res + end. tp_cast(Tp, Fun) -> - ?line Tp ! {cast, Fun}. + Tp ! {cast, Fun}. test_proc() -> - ?line receive - {call, From, Ref, Fun} -> - ?line From ! {Ref, Fun()}; - {cast, Fun} -> - ?line Fun() - end, - ?line test_proc(). + receive + {call, From, Ref, Fun} -> + From ! {Ref, Fun()}; + {cast, Fun} -> + Fun() + end, + test_proc(). expand_link_list([#erl_link{type = ?LINK_NODE, targets = N} = Rec | T]) -> lists:duplicate(N,Rec#erl_link{targets = []}) ++ expand_link_list(T); @@ -728,7 +699,7 @@ expand_link_list([#erl_link{targets = [#erl_link{pid = Pid}]} = Rec | T]) -> [Rec#erl_link{targets = [Pid]} | expand_link_list(T)]; expand_link_list([#erl_link{targets = [#erl_link{pid = Pid}|TT]} = Rec | T]) -> [ Rec#erl_link{targets = [Pid]} | expand_link_list( - [Rec#erl_link{targets = TT} | T])]; + [Rec#erl_link{targets = TT} | T])]; expand_link_list([#erl_link{targets = []} = Rec | T]) -> [Rec | expand_link_list(T)]; expand_link_list([]) -> @@ -736,19 +707,19 @@ expand_link_list([]) -> get_local_link_list(Obj) -> case catch erts_debug:get_internal_state({link_list, Obj}) of - LL when is_list(LL) -> - expand_link_list(LL); - _ -> - [] + LL when is_list(LL) -> + expand_link_list(LL); + _ -> + [] end. get_remote_link_list(Node, Obj) -> case catch rpc:call(Node, erts_debug, get_internal_state, - [{link_list, Obj}]) of - LL when is_list(LL) -> - expand_link_list(LL); - _ -> - [] + [{link_list, Obj}]) of + LL when is_list(LL) -> + expand_link_list(LL); + _ -> + [] end. @@ -758,30 +729,30 @@ get_link_list({Node, DistEntry}) when is_atom(Node), is_atom(DistEntry) -> get_remote_link_list(Node, DistEntry); get_link_list(P) when is_pid(P); is_port(P) -> case node(P) of - Node when Node == node() -> - get_local_link_list(P); - Node -> - get_remote_link_list(Node, P) - end; + Node when Node == node() -> + get_local_link_list(P); + Node -> + get_remote_link_list(Node, P) + end; get_link_list(undefined) -> []. get_local_monitor_list(Obj) -> case catch erts_debug:get_internal_state({monitor_list, Obj}) of - LL when is_list(LL) -> - LL; - _ -> - [] - end. + LL when is_list(LL) -> + LL; + _ -> + [] + end. get_remote_monitor_list(Node, Obj) -> case catch rpc:call(Node, erts_debug, get_internal_state, - [{monitor_list, Obj}]) of - LL when is_list(LL) -> - LL; - _ -> - [] - end. + [{monitor_list, Obj}]) of + LL when is_list(LL) -> + LL; + _ -> + [] + end. get_monitor_list({Node, DistEntry}) when Node == node(), is_atom(DistEntry) -> @@ -790,242 +761,242 @@ get_monitor_list({Node, DistEntry}) when is_atom(Node), is_atom(DistEntry) -> get_remote_monitor_list(Node, DistEntry); get_monitor_list(P) when is_pid(P) -> case node(P) of - Node when Node == node() -> - get_local_monitor_list(P); - Node -> - get_remote_monitor_list(Node, P) - end; + Node when Node == node() -> + get_local_monitor_list(P); + Node -> + get_remote_monitor_list(Node, P) + end; get_monitor_list(undefined) -> []. find_erl_monitor(Pid, Ref) when is_reference(Ref) -> lists:foldl(fun (#erl_monitor{ref = R} = EL, Acc) when R == Ref -> - [EL|Acc]; - (_, Acc) -> - Acc - end, - [], - get_monitor_list(Pid)). + [EL|Acc]; + (_, Acc) -> + Acc + end, + [], + get_monitor_list(Pid)). % find_erl_link(Obj, Ref) when is_reference(Ref) -> -% ?line lists:foldl(fun (#erl_link{ref = R} = EL, Acc) when R == Ref -> -% ?line [EL|Acc]; +% lists:foldl(fun (#erl_link{ref = R} = EL, Acc) when R == Ref -> +% [EL|Acc]; % (_, Acc) -> -% ?line Acc +% Acc % end, % [], % get_link_list(Obj)). find_erl_link(Obj, Type, [Item, Data]) when is_pid(Item); - is_port(Item); - is_atom(Item) -> + is_port(Item); + is_atom(Item) -> lists:foldl(fun (#erl_link{type = T, pid = I, targets = D} = EL, - Acc) when T == Type, I == Item -> - case Data of - D -> - [EL|Acc]; - [] -> - [EL|Acc]; - _ -> - Acc - end; - (_, Acc) -> - Acc - end, - [], - get_link_list(Obj)); + Acc) when T == Type, I == Item -> + case Data of + D -> + [EL|Acc]; + [] -> + [EL|Acc]; + _ -> + Acc + end; + (_, Acc) -> + Acc + end, + [], + get_link_list(Obj)); find_erl_link(Obj, Type, Item) when is_pid(Item); is_port(Item); is_atom(Item) -> find_erl_link(Obj, Type, [Item, []]). - + check_link(A, B) -> - ?line [#erl_link{type = ?LINK_PID, - pid = B, - targets = []}] = find_erl_link(A, ?LINK_PID, B), - ?line [#erl_link{type = ?LINK_PID, - pid = A, - targets = []}] = find_erl_link(B, ?LINK_PID, A), - ?line case node(A) == node(B) of - false -> - ?line [#erl_link{type = ?LINK_PID, - pid = A, - targets = [B]}] = find_erl_link({node(A), - node(B)}, - ?LINK_PID, - [A, [B]]), - ?line [#erl_link{type = ?LINK_PID, - pid = B, - targets = [A]}] = find_erl_link({node(B), - node(A)}, - ?LINK_PID, - [B, [A]]); - true -> - ?line [] = find_erl_link({node(A), node(B)}, - ?LINK_PID, - [A, [B]]), - ?line [] = find_erl_link({node(B), node(A)}, - ?LINK_PID, - [B, [A]]) - end, - ?line ok. + [#erl_link{type = ?LINK_PID, + pid = B, + targets = []}] = find_erl_link(A, ?LINK_PID, B), + [#erl_link{type = ?LINK_PID, + pid = A, + targets = []}] = find_erl_link(B, ?LINK_PID, A), + case node(A) == node(B) of + false -> + [#erl_link{type = ?LINK_PID, + pid = A, + targets = [B]}] = find_erl_link({node(A), + node(B)}, + ?LINK_PID, + [A, [B]]), + [#erl_link{type = ?LINK_PID, + pid = B, + targets = [A]}] = find_erl_link({node(B), + node(A)}, + ?LINK_PID, + [B, [A]]); + true -> + [] = find_erl_link({node(A), node(B)}, + ?LINK_PID, + [A, [B]]), + [] = find_erl_link({node(B), node(A)}, + ?LINK_PID, + [B, [A]]) + end, + ok. check_unlink(A, B) -> - ?line [] = find_erl_link(A, ?LINK_PID, B), - ?line [] = find_erl_link(B, ?LINK_PID, A), - ?line [] = find_erl_link({node(A), node(B)}, ?LINK_PID, [A, [B]]), - ?line [] = find_erl_link({node(B), node(A)}, ?LINK_PID, [B, [A]]), - ?line ok. + [] = find_erl_link(A, ?LINK_PID, B), + [] = find_erl_link(B, ?LINK_PID, A), + [] = find_erl_link({node(A), node(B)}, ?LINK_PID, [A, [B]]), + [] = find_erl_link({node(B), node(A)}, ?LINK_PID, [B, [A]]), + ok. check_process_monitor(From, {Name, Node}, Ref) when is_pid(From), - is_atom(Name), - Node == node(From), - is_reference(Ref) -> - ?line check_process_monitor(From, Name, Ref); + is_atom(Name), + Node == node(From), + is_reference(Ref) -> + check_process_monitor(From, Name, Ref); check_process_monitor(From, {Name, Node}, Ref) when is_pid(From), - is_atom(Name), - is_atom(Node), - is_reference(Ref) -> - ?line MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), - ?line [#erl_monitor{type = ?MON_ORIGIN, - ref = Ref, - pid = Node, - name = Name}] = find_erl_monitor(From, Ref), - ?line [#erl_monitor{type = ?MON_TARGET, - ref = Ref, - pid = From, - name = Name}] = find_erl_monitor({node(From), Node}, Ref), - ?line [#erl_monitor{type = ?MON_ORIGIN, - ref = Ref, - pid = MonitoredPid, - name = Name}] = find_erl_monitor({Node, node(From)}, Ref), - ?line [#erl_monitor{type = ?MON_TARGET, - ref = Ref, - pid = From, - name = Name}] = find_erl_monitor(MonitoredPid, Ref), - ?line ok; + is_atom(Name), + is_atom(Node), + is_reference(Ref) -> + MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), + [#erl_monitor{type = ?MON_ORIGIN, + ref = Ref, + pid = Node, + name = Name}] = find_erl_monitor(From, Ref), + [#erl_monitor{type = ?MON_TARGET, + ref = Ref, + pid = From, + name = Name}] = find_erl_monitor({node(From), Node}, Ref), + [#erl_monitor{type = ?MON_ORIGIN, + ref = Ref, + pid = MonitoredPid, + name = Name}] = find_erl_monitor({Node, node(From)}, Ref), + [#erl_monitor{type = ?MON_TARGET, + ref = Ref, + pid = From, + name = Name}] = find_erl_monitor(MonitoredPid, Ref), + ok; check_process_monitor(From, Name, Ref) when is_pid(From), - is_atom(Name), - undefined /= Name, - is_reference(Ref) -> - ?line MonitoredPid = rpc:call(node(From), erlang, whereis, [Name]), - - ?line [#erl_monitor{type = ?MON_ORIGIN, - ref = Ref, - pid = MonitoredPid, - name = Name}] = find_erl_monitor(From, Ref), - - - ?line [#erl_monitor{type = ?MON_TARGET, - ref = Ref, - pid = From, - name = Name}] = find_erl_monitor(MonitoredPid,Ref), + is_atom(Name), + undefined /= Name, + is_reference(Ref) -> + MonitoredPid = rpc:call(node(From), erlang, whereis, [Name]), + + [#erl_monitor{type = ?MON_ORIGIN, + ref = Ref, + pid = MonitoredPid, + name = Name}] = find_erl_monitor(From, Ref), + + + [#erl_monitor{type = ?MON_TARGET, + ref = Ref, + pid = From, + name = Name}] = find_erl_monitor(MonitoredPid,Ref), ok; check_process_monitor(From, To, Ref) when is_pid(From), - is_pid(To), - is_reference(Ref) -> - ?line OriMon = [#erl_monitor{type = ?MON_ORIGIN, - ref = Ref, - pid = To}], - - ?line OriMon = find_erl_monitor(From, Ref), - - ?line TargMon = [#erl_monitor{type = ?MON_TARGET, - ref = Ref, - pid = From}], - ?line TargMon = find_erl_monitor(To, Ref), - - - ?line case node(From) == node(To) of - false -> - ?line TargMon = find_erl_monitor({node(From), node(To)}, Ref), - ?line OriMon = find_erl_monitor({node(To), node(From)}, Ref); - true -> - ?line [] = find_erl_monitor({node(From), node(From)}, Ref) - end, - ?line ok. + is_pid(To), + is_reference(Ref) -> + OriMon = [#erl_monitor{type = ?MON_ORIGIN, + ref = Ref, + pid = To}], + + OriMon = find_erl_monitor(From, Ref), + + TargMon = [#erl_monitor{type = ?MON_TARGET, + ref = Ref, + pid = From}], + TargMon = find_erl_monitor(To, Ref), + + + case node(From) == node(To) of + false -> + TargMon = find_erl_monitor({node(From), node(To)}, Ref), + OriMon = find_erl_monitor({node(To), node(From)}, Ref); + true -> + [] = find_erl_monitor({node(From), node(From)}, Ref) + end, + ok. check_process_demonitor(From, {undefined, Node}, Ref) when is_pid(From), - is_reference(Ref) -> - ?line [] = find_erl_monitor(From, Ref), - ?line case node(From) == Node of - false -> - ?line [] = find_erl_monitor({node(From), Node}, Ref), - ?line [] = find_erl_monitor({Node, node(From)}, Ref); - true -> - ?line [] = find_erl_monitor({Node, Node}, Ref) - end, - ?line ok; + is_reference(Ref) -> + [] = find_erl_monitor(From, Ref), + case node(From) == Node of + false -> + [] = find_erl_monitor({node(From), Node}, Ref), + [] = find_erl_monitor({Node, node(From)}, Ref); + true -> + [] = find_erl_monitor({Node, Node}, Ref) + end, + ok; check_process_demonitor(From, {Name, Node}, Ref) when is_pid(From), - is_atom(Name), - Node == node(From), - is_reference(Ref) -> - ?line MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), - ?line case rpc:call(Node, erlang, whereis, [Name]) of - undefined -> - ?line check_process_demonitor(From, {undefined, Node}, Ref); - MonitoredPid -> - ?line check_process_demonitor(From, MonitoredPid, Ref) - end; + is_atom(Name), + Node == node(From), + is_reference(Ref) -> + MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), + case rpc:call(Node, erlang, whereis, [Name]) of + undefined -> + check_process_demonitor(From, {undefined, Node}, Ref); + MonitoredPid -> + check_process_demonitor(From, MonitoredPid, Ref) + end; check_process_demonitor(From, {Name, Node}, Ref) when is_pid(From), - is_atom(Name), - is_atom(Node), - is_reference(Ref) -> - ?line MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), - ?line [] = find_erl_monitor(From, Ref), - ?line [] = find_erl_monitor({node(From), Node}, Ref), - ?line [] = find_erl_monitor({Node, node(From)}, Ref), - ?line [] = find_erl_monitor(MonitoredPid, Ref), - ?line ok; + is_atom(Name), + is_atom(Node), + is_reference(Ref) -> + MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), + [] = find_erl_monitor(From, Ref), + [] = find_erl_monitor({node(From), Node}, Ref), + [] = find_erl_monitor({Node, node(From)}, Ref), + [] = find_erl_monitor(MonitoredPid, Ref), + ok; check_process_demonitor(From, undefined, Ref) when is_pid(From), - is_reference(Ref) -> - ?line [] = find_erl_monitor(From, Ref), - ?line case node(From) == node() of - false -> - ?line [] = find_erl_monitor({node(From), node()}, Ref), - ?line [] = find_erl_monitor({node(), node(From)}, Ref); - true -> - ?line [] = find_erl_monitor({node(), node()}, Ref) - end, - ?line ok; + is_reference(Ref) -> + [] = find_erl_monitor(From, Ref), + case node(From) == node() of + false -> + [] = find_erl_monitor({node(From), node()}, Ref), + [] = find_erl_monitor({node(), node(From)}, Ref); + true -> + [] = find_erl_monitor({node(), node()}, Ref) + end, + ok; check_process_demonitor(From, Name, Ref) when is_pid(From), - is_atom(Name), - undefined /= Name, - is_reference(Ref) -> - ?line check_process_demonitor(From, {Name, node()}, Ref); + is_atom(Name), + undefined /= Name, + is_reference(Ref) -> + check_process_demonitor(From, {Name, node()}, Ref); check_process_demonitor(From, To, Ref) when is_pid(From), - is_pid(To), - is_reference(Ref) -> - ?line [] = find_erl_monitor(From, Ref), - ?line [] = find_erl_monitor(To, Ref), - ?line case node(From) == node(To) of - false -> - ?line [] = find_erl_monitor({node(From), node(To)}, Ref), - ?line [] = find_erl_monitor({node(To), node(From)}, Ref); - true -> - ?line [] = find_erl_monitor({node(From), node(From)}, Ref) - end, - ?line ok. + is_pid(To), + is_reference(Ref) -> + [] = find_erl_monitor(From, Ref), + [] = find_erl_monitor(To, Ref), + case node(From) == node(To) of + false -> + [] = find_erl_monitor({node(From), node(To)}, Ref), + [] = find_erl_monitor({node(To), node(From)}, Ref); + true -> + [] = find_erl_monitor({node(From), node(From)}, Ref) + end, + ok. no_of_monitor_node(From, Node) when is_pid(From), is_atom(Node) -> - ?line length(find_erl_link(From, ?LINK_NODE, Node)). + length(find_erl_link(From, ?LINK_NODE, Node)). check_monitor_node(From, Node, No) when is_pid(From), - is_atom(Node), - is_integer(No), - No >= 0 -> - ?line LL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = Node}), - ?line DLL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = From}), - ?line LL = find_erl_link(From, ?LINK_NODE, Node), - ?line DLL = find_erl_link({node(From), Node}, ?LINK_NODE, From), - ?line ok. + is_atom(Node), + is_integer(No), + No >= 0 -> + LL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = Node}), + DLL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = From}), + LL = find_erl_link(From, ?LINK_NODE, Node), + DLL = find_erl_link({node(From), Node}, ?LINK_NODE, From), + ok. hostname() -> - ?line from($@, atom_to_list(node())). + from($@, atom_to_list(node())). from(H, [H | T]) -> T; from(H, [_ | T]) -> from(H, T); @@ -1037,27 +1008,27 @@ get_names(0, _, Acc) -> Acc; get_names(N, T, Acc) -> get_names(N-1, T, [list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(T) - ++ "-" - ++ integer_to_list(erlang:system_time(seconds)) - ++ "-" - ++ integer_to_list(erlang:unique_integer([positive]))) | Acc]). + ++ "-" + ++ atom_to_list(T) + ++ "-" + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))) | Acc]). start_node(Name) -> - ?line start_node(Name, ""). + start_node(Name, ""). start_node(Name, Args) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line Res = ?t:start_node(Name, slave, [{args, Args ++ " -pa " ++ Pa}]), - ?line {ok, Node} = Res, - ?line rpc:call(Node, erts_debug, set_internal_state, - [available_internal_state, true]), - ?line Res. - + Pa = filename:dirname(code:which(?MODULE)), + Res = test_server:start_node(Name, slave, [{args, Args ++ " -pa " ++ Pa}]), + {ok, Node} = Res, + rpc:call(Node, erts_debug, set_internal_state, + [available_internal_state, true]), + Res. + stop_node(Node) -> - ?line ?t:stop_node(Node). + test_server:stop_node(Node). -define(COOKIE, ''). -define(DOP_LINK, 1). @@ -1080,37 +1051,37 @@ stop_node(Node) -> dport_send(To, Msg) -> Node = node(To), DPrt = case dport(Node) of - undefined -> - pong = net_adm:ping(Node), - dport(Node); - Prt -> - Prt - end, + undefined -> + pong = net_adm:ping(Node), + dport(Node); + Prt -> + Prt + end, port_command(DPrt, [dmsg_hdr(), - dmsg_ext({?DOP_SEND, - ?COOKIE, - To}), - dmsg_ext(Msg)]). + dmsg_ext({?DOP_SEND, + ?COOKIE, + To}), + dmsg_ext(Msg)]). dport_reg_send(Node, Name, Msg) -> DPrt = case dport(Node) of - undefined -> - pong = net_adm:ping(Node), - dport(Node); - Prt -> - Prt - end, + undefined -> + pong = net_adm:ping(Node), + dport(Node); + Prt -> + Prt + end, port_command(DPrt, [dmsg_hdr(), - dmsg_ext({?DOP_REG_SEND, - self(), - ?COOKIE, - Name}), - dmsg_ext(Msg)]). + dmsg_ext({?DOP_REG_SEND, + self(), + ?COOKIE, + Name}), + dmsg_ext(Msg)]). dport(Node) when is_atom(Node) -> case catch erts_debug:get_internal_state(available_internal_state) of - true -> true; - _ -> erts_debug:set_internal_state(available_internal_state, true) + true -> true; + _ -> erts_debug:set_internal_state(available_internal_state, true) end, erts_debug:get_internal_state({dist_port, Node}). @@ -1136,11 +1107,7 @@ stop_busy_dist_port_tracer(_) -> busy_dist_port_tracer() -> receive - {monitor, _SuspendedProcess, busy_dist_port, _Port} = M -> - erlang:display(M), - busy_dist_port_tracer() + {monitor, _SuspendedProcess, busy_dist_port, _Port} = M -> + erlang:display(M), + busy_dist_port_tracer() end. - - - - diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl index 35677f9953..23871585f7 100644 --- a/erts/emulator/test/erts_debug_SUITE.erl +++ b/erts/emulator/test/erts_debug_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,42 +19,18 @@ %% -module(erts_debug_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --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, - test_size/1,flat_size_big/1,df/1, +-export([all/0, suite/0, + test_size/1,flat_size_big/1,df/1,term_type/1, instructions/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> - [test_size, flat_size_big, df, instructions]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(2)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). + [test_size, flat_size_big, df, instructions, term_type]. test_size(Config) when is_list(Config) -> ConsCell1 = id([a|b]), @@ -138,9 +114,50 @@ flat_size_big_1(Term, Size0, Limit) when Size0 < Limit -> end; flat_size_big_1(_, _, _) -> ok. + +term_type(Config) when is_list(Config) -> + Ts = [{fixnum, 1}, + {fixnum, -1}, + {bignum, 1 bsl 300}, + {bignum, -(1 bsl 300)}, + {hfloat, 0.0}, + {hfloat, 0.0/-1}, + {hfloat, 1.0/(1 bsl 302)}, + {hfloat, 1.0*(1 bsl 302)}, + {hfloat, -1.0/(1 bsl 302)}, + {hfloat, -1.0*(1 bsl 302)}, + {hfloat, 3.1416}, + {hfloat, 1.0e18}, + {hfloat, -3.1416}, + {hfloat, -1.0e18}, + + {heap_binary, <<1,2,3>>}, + {refc_binary, <<0:(8*80)>>}, + {sub_binary, <<5:7>>}, + + {flatmap, #{ a => 1}}, + {hashmap, maps:from_list([{I,I}||I <- lists:seq(1,76)])}, + + {list, [1,2,3]}, + {nil, []}, + {tuple, {1,2,3}}, + {tuple, {}}, + + {export, fun lists:sort/1}, + {'fun', fun() -> ok end}, + {pid, self()}, + {atom, atom}], + lists:foreach(fun({E,Val}) -> + R = erts_internal:term_type(Val), + io:format("expecting term type ~w, got ~w (~p)~n", [E,R,Val]), + E = R + end, Ts), + ok. + + df(Config) when is_list(Config) -> P0 = pps(), - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ok = file:set_cwd(PrivDir), AllLoaded = [M || {M,_} <- code:all_loaded()], diff --git a/erts/emulator/test/estone_SUITE.erl b/erts/emulator/test/estone_SUITE.erl index d49ab3de4d..1180a45585 100644 --- a/erts/emulator/test/estone_SUITE.erl +++ b/erts/emulator/test/estone_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,9 +19,8 @@ -module(estone_SUITE). %% Test functions --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2,estone/1,estone_bench/1]). --export([init_per_testcase/2, end_per_testcase/2]). +-export([all/0, suite/0, groups/0, + estone/1, estone_bench/1]). %% Internal exports for EStone tests -export([lists/1, @@ -46,12 +45,9 @@ run_micro/3,p1/1,ppp/3,macro/2,micros/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("common_test/include/ct_event.hrl"). -%% Test suite defines --define(default_timeout, ?t:minutes(10)). - %% EStone defines -define(TOTAL, (3000 * 1000 * 100)). %% 300 secs -define(BIGPROCS, 2). @@ -66,17 +62,9 @@ str}). %% Header string - - -init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(?default_timeout), - [{watchdog, Dog}|Config]. -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. all() -> [estone]. @@ -84,34 +72,18 @@ all() -> groups() -> [{estone_bench, [{repeat,50}],[estone_bench]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -estone(suite) -> - []; -estone(doc) -> - ["EStone Test"]; +%% EStone Test estone(Config) when is_list(Config) -> - ?line DataDir = ?config(data_dir,Config), - ?line Mhz=get_cpu_speed(os:type(),DataDir), - ?line L = ?MODULE:macro(?MODULE:micros(),DataDir), - ?line {Total, Stones} = sum_micros(L, 0, 0), - ?line pp(Mhz,Total,Stones,L), - ?line {comment,Mhz ++ " MHz, " ++ - integer_to_list(Stones) ++ " ESTONES"}. + DataDir = proplists:get_value(data_dir,Config), + Mhz=get_cpu_speed(os:type(),DataDir), + L = ?MODULE:macro(?MODULE:micros(),DataDir), + {Total, Stones} = sum_micros(L, 0, 0), + pp(Mhz,Total,Stones,L), + {comment,Mhz ++ " MHz, " ++ integer_to_list(Stones) ++ " ESTONES"}. estone_bench(Config) -> - DataDir = ?config(data_dir,Config), + DataDir = proplists:get_value(data_dir,Config), L = ?MODULE:macro(?MODULE:micros(),DataDir), [ct_event:notify( #event{name = benchmark_data, @@ -1136,4 +1108,3 @@ wait_for_pids([P|Tail]) -> send_procs([P|Tail], Msg) -> P ! Msg, send_procs(Tail, Msg); send_procs([], _) -> ok. - diff --git a/erts/emulator/test/evil_SUITE.erl b/erts/emulator/test/evil_SUITE.erl index 484d2a8bf5..9416ac7a02 100644 --- a/erts/emulator/test/evil_SUITE.erl +++ b/erts/emulator/test/evil_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,23 +19,22 @@ -module(evil_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, - heap_frag/1, - encode_decode_ext/1, - decode_integer_ext/1, - decode_small_big_ext/1, - decode_large_big_ext/1, - decode_small_big_ext_neg/1, - decode_large_big_ext_neg/1, - decode_too_small/1, - decode_pos_neg_zero/1 - ]). +-export([all/0, suite/0, + heap_frag/1, + encode_decode_ext/1, + decode_integer_ext/1, + decode_small_big_ext/1, + decode_large_big_ext/1, + decode_small_big_ext_neg/1, + decode_large_big_ext_neg/1, + decode_too_small/1, + decode_pos_neg_zero/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 30}}]. all() -> [heap_frag, encode_decode_ext, decode_integer_ext, @@ -43,41 +42,16 @@ all() -> decode_small_big_ext_neg, decode_large_big_ext_neg, decode_too_small, decode_pos_neg_zero]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(_Case, Config) -> - ?line Dog = test_server:timetrap(?t:minutes(0.5)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. - heap_frag(Config) when is_list(Config) -> N = 512, Self = self(), - ?line Pid = spawn_link(fun() -> appender(Self, N) end), + Pid = spawn_link(fun() -> appender(Self, N) end), receive - {Pid,Res} -> - ?line Res = my_appender(N); - Garbage -> - io:format("Garbage: ~p\n", [Garbage]), - ?line ?t:fail(got_garbage) + {Pid,Res} -> + Res = my_appender(N); + Garbage -> + io:format("Garbage: ~p\n", [Garbage]), + ct:fail(got_garbage) end. @@ -87,29 +61,28 @@ heap_frag(Config) when is_list(Config) -> %% These test cases are not "evil" but the next test case is.... encode_decode_ext(Config) when is_list(Config) -> - ?line enc_dec( 2, 0), % SMALL_INTEGER_EXT smallest - ?line enc_dec( 2, 255), % SMALL_INTEGER_EXT largest - ?line enc_dec( 5, 256), % INTEGER_EXT smallest pos (*) - ?line enc_dec( 5, -1), % INTEGER_EXT largest neg - - ?line enc_dec( 5, 16#07ffffff), % INTEGER_EXT largest (28 bits) - ?line enc_dec( 5,-16#08000000), % INTEGER_EXT smallest - ?line enc_dec( 7, 16#08000000), % SMALL_BIG_EXT smallest pos(*) - ?line enc_dec( 7,-16#08000001), % SMALL_BIG_EXT largest neg (*) - - ?line enc_dec( 7, 16#7fffffff), % SMALL_BIG_EXT largest i32 - ?line enc_dec( 7,-16#80000000), % SMALL_BIG_EXT smallest i32 - - ?line enc_dec( 7, 16#80000000), % SMALL_BIG_EXT u32 - ?line enc_dec( 7, 16#ffffffff), % SMALL_BIG_EXT largest u32 - - ?line enc_dec( 9, 16#7fffffffffff), % largest i48 - ?line enc_dec( 9,-16#800000000000), % smallest i48 - ?line enc_dec( 9, 16#ffffffffffff), % largest u48 - ?line enc_dec(11, 16#7fffffffffffffff), % largest i64 - ?line enc_dec(11,-16#8000000000000000), % smallest i64 - ?line enc_dec(11, 16#ffffffffffffffff), % largest u64 - + enc_dec( 2, 0), % SMALL_INTEGER_EXT smallest + enc_dec( 2, 255), % SMALL_INTEGER_EXT largest + enc_dec( 5, 256), % INTEGER_EXT smallest pos (*) + enc_dec( 5, -1), % INTEGER_EXT largest neg + + enc_dec( 5, 16#07ffffff), % INTEGER_EXT largest (28 bits) + enc_dec( 5,-16#08000000), % INTEGER_EXT smallest + enc_dec( 7, 16#08000000), % SMALL_BIG_EXT smallest pos(*) + enc_dec( 7,-16#08000001), % SMALL_BIG_EXT largest neg (*) + + enc_dec( 7, 16#7fffffff), % SMALL_BIG_EXT largest i32 + enc_dec( 7,-16#80000000), % SMALL_BIG_EXT smallest i32 + + enc_dec( 7, 16#80000000), % SMALL_BIG_EXT u32 + enc_dec( 7, 16#ffffffff), % SMALL_BIG_EXT largest u32 + + enc_dec( 9, 16#7fffffffffff), % largest i48 + enc_dec( 9,-16#800000000000), % smallest i48 + enc_dec( 9, 16#ffffffffffff), % largest u48 + enc_dec(11, 16#7fffffffffffffff), % largest i64 + enc_dec(11,-16#8000000000000000), % smallest i64 + enc_dec(11, 16#ffffffffffffffff), % largest u64 ok. @@ -125,213 +98,213 @@ encode_decode_ext(Config) when is_list(Config) -> %% erl_interface, i.e. not how it is encoded in the test case below. decode_integer_ext(Config) when is_list(Config) -> - ?line decode( 0, <<131,98, 0:32>>), % SMALL_INTEGER_EXT - ?line decode( 42, <<131,98, 42:32>>), % SMALL_INTEGER_EXT - ?line decode(255, <<131,98,255:32>>), % SMALL_INTEGER_EXT - ?line decode( 16#08000000, <<131,98, 16#08000000:32>>), % SMALL_BIG_EXT - ?line decode(-16#08000001, <<131,98,-16#08000001:32>>), % SMALL_BIG_EXT - ?line decode( 16#7fffffff, <<131,98, 16#7fffffff:32>>), % SMALL_BIG_EXT - ?line decode(-16#80000000, <<131,98,-16#80000000:32>>), % SMALL_BIG_EXT + decode( 0, <<131,98, 0:32>>), % SMALL_INTEGER_EXT + decode( 42, <<131,98, 42:32>>), % SMALL_INTEGER_EXT + decode(255, <<131,98,255:32>>), % SMALL_INTEGER_EXT + decode( 16#08000000, <<131,98, 16#08000000:32>>), % SMALL_BIG_EXT + decode(-16#08000001, <<131,98,-16#08000001:32>>), % SMALL_BIG_EXT + decode( 16#7fffffff, <<131,98, 16#7fffffff:32>>), % SMALL_BIG_EXT + decode(-16#80000000, <<131,98,-16#80000000:32>>), % SMALL_BIG_EXT ok. decode_small_big_ext(Config) when is_list(Config) -> - ?line decode(256,<<131,110,2,0,0,1>>), % INTEGER_EXT - ?line decode(16#07ffffff,<<131,110,4,0,255,255,255,7>>), % INTEGER_EXT - ?line decode(16#7fffffff,<<131,110,4,0,255,255,255,127>>), % SMALL_BIG_EXT - - ?line decode(42,<<131,110,1,0,42>>), % SMALL_INTEGER_EXT - ?line decode(42,<<131,110,2,0,42,0>>), % Redundant zeros from now on - ?line decode(42,<<131,110,3,0,42,0,0>>), - ?line decode(42,<<131,110,4,0,42,0,0,0>>), - ?line decode(42,<<131,110,5,0,42,0,0,0,0>>), - ?line decode(42,<<131,110,6,0,42,0,0,0,0,0>>), - ?line decode(42,<<131,110,7,0,42,0,0,0,0,0,0>>), - ?line decode(42,<<131,110,8,0,42,0,0,0,0,0,0,0>>), + decode(256,<<131,110,2,0,0,1>>), % INTEGER_EXT + decode(16#07ffffff,<<131,110,4,0,255,255,255,7>>), % INTEGER_EXT + decode(16#7fffffff,<<131,110,4,0,255,255,255,127>>), % SMALL_BIG_EXT + + decode(42,<<131,110,1,0,42>>), % SMALL_INTEGER_EXT + decode(42,<<131,110,2,0,42,0>>), % Redundant zeros from now on + decode(42,<<131,110,3,0,42,0,0>>), + decode(42,<<131,110,4,0,42,0,0,0>>), + decode(42,<<131,110,5,0,42,0,0,0,0>>), + decode(42,<<131,110,6,0,42,0,0,0,0,0>>), + decode(42,<<131,110,7,0,42,0,0,0,0,0,0>>), + decode(42,<<131,110,8,0,42,0,0,0,0,0,0,0>>), ok. decode_large_big_ext(Config) when is_list(Config) -> - ?line decode(256,<<131,111,2:32,0,0,1>>), % INTEGER_EXT - ?line decode(16#07ffffff,<<131,111,4:32,0,255,255,255,7>>), % INTEG_EXT - ?line decode(16#7fffffff,<<131,111,4:32,0,255,255,255,127>>), % SMA_BIG - ?line decode(16#ffffffff,<<131,111,4:32,0,255,255,255,255>>), % SMA_BIG + decode(256,<<131,111,2:32,0,0,1>>), % INTEGER_EXT + decode(16#07ffffff,<<131,111,4:32,0,255,255,255,7>>), % INTEG_EXT + decode(16#7fffffff,<<131,111,4:32,0,255,255,255,127>>), % SMA_BIG + decode(16#ffffffff,<<131,111,4:32,0,255,255,255,255>>), % SMA_BIG N = largest_small_big(), - ?line decode(N,<<131,111,255:32,0,N:2040/little>>), % SMALL_BIG_EXT - - ?line decode(42,<<131,111,1:32,0,42>>), - ?line decode(42,<<131,111,2:32,0,42,0>>), % Redundant zeros from now on - ?line decode(42,<<131,111,3:32,0,42,0,0>>), - ?line decode(42,<<131,111,4:32,0,42,0,0,0>>), - ?line decode(42,<<131,111,5:32,0,42,0,0,0,0>>), - ?line decode(42,<<131,111,6:32,0,42,0,0,0,0,0>>), - ?line decode(42,<<131,111,7:32,0,42,0,0,0,0,0,0>>), - ?line decode(42,<<131,111,8:32,0,42,0,0,0,0,0,0,0>>), + decode(N,<<131,111,255:32,0,N:2040/little>>), % SMALL_BIG_EXT + + decode(42,<<131,111,1:32,0,42>>), + decode(42,<<131,111,2:32,0,42,0>>), % Redundant zeros from now on + decode(42,<<131,111,3:32,0,42,0,0>>), + decode(42,<<131,111,4:32,0,42,0,0,0>>), + decode(42,<<131,111,5:32,0,42,0,0,0,0>>), + decode(42,<<131,111,6:32,0,42,0,0,0,0,0>>), + decode(42,<<131,111,7:32,0,42,0,0,0,0,0,0>>), + decode(42,<<131,111,8:32,0,42,0,0,0,0,0,0,0>>), ok. decode_small_big_ext_neg(Config) when is_list(Config) -> - ?line decode(-1,<<131,110,1,1,1>>), % INTEGER_EXT - ?line decode(-16#08000000,<<131,110,4,1,0,0,0,8>>), % INTEGER_EXT - ?line decode(-16#80000000,<<131,110,4,1,0,0,0,128>>), % SMALL_BIG_EXT - ?line decode(-16#ffffffff,<<131,110,4,1,255,255,255,255>>), % SMALL_BIG_EXT + decode(-1,<<131,110,1,1,1>>), % INTEGER_EXT + decode(-16#08000000,<<131,110,4,1,0,0,0,8>>), % INTEGER_EXT + decode(-16#80000000,<<131,110,4,1,0,0,0,128>>), % SMALL_BIG_EXT + decode(-16#ffffffff,<<131,110,4,1,255,255,255,255>>), % SMALL_BIG_EXT N = largest_small_big(), - ?line decode(-N,<<131,111,255:32,1,N:2040/little>>), % SMALL_BIG_EXT - - ?line decode(-42,<<131,110,1,1,42>>), - ?line decode(-42,<<131,110,2,1,42,0>>), % Redundant zeros from now on - ?line decode(-42,<<131,110,3,1,42,0,0>>), - ?line decode(-42,<<131,110,4,1,42,0,0,0>>), - ?line decode(-42,<<131,110,5,1,42,0,0,0,0>>), - ?line decode(-42,<<131,110,6,1,42,0,0,0,0,0>>), - ?line decode(-42,<<131,110,7,1,42,0,0,0,0,0,0>>), - ?line decode(-42,<<131,110,8,1,42,0,0,0,0,0,0,0>>), + decode(-N,<<131,111,255:32,1,N:2040/little>>), % SMALL_BIG_EXT + + decode(-42,<<131,110,1,1,42>>), + decode(-42,<<131,110,2,1,42,0>>), % Redundant zeros from now on + decode(-42,<<131,110,3,1,42,0,0>>), + decode(-42,<<131,110,4,1,42,0,0,0>>), + decode(-42,<<131,110,5,1,42,0,0,0,0>>), + decode(-42,<<131,110,6,1,42,0,0,0,0,0>>), + decode(-42,<<131,110,7,1,42,0,0,0,0,0,0>>), + decode(-42,<<131,110,8,1,42,0,0,0,0,0,0,0>>), ok. decode_large_big_ext_neg(Config) when is_list(Config) -> - ?line decode(-1,<<131,111,1:32,1,1>>), % INTEGER_EXT - ?line decode(-16#08000000,<<131,111,4:32,1,0,0,0,8>>), % INTEGER_EXT - ?line decode(-16#80000000,<<131,111,4:32,1,0,0,0,128>>), % SMALL_BIG_EXT - - ?line decode(-42,<<131,111,1:32,1,42>>), - ?line decode(-42,<<131,111,2:32,1,42,0>>), % Redundant zeros from now on - ?line decode(-42,<<131,111,3:32,1,42,0,0>>), - ?line decode(-42,<<131,111,4:32,1,42,0,0,0>>), - ?line decode(-42,<<131,111,5:32,1,42,0,0,0,0>>), - ?line decode(-42,<<131,111,6:32,1,42,0,0,0,0,0>>), - ?line decode(-42,<<131,111,7:32,1,42,0,0,0,0,0,0>>), - ?line decode(-42,<<131,111,8:32,1,42,0,0,0,0,0,0,0>>), + decode(-1,<<131,111,1:32,1,1>>), % INTEGER_EXT + decode(-16#08000000,<<131,111,4:32,1,0,0,0,8>>), % INTEGER_EXT + decode(-16#80000000,<<131,111,4:32,1,0,0,0,128>>), % SMALL_BIG_EXT + + decode(-42,<<131,111,1:32,1,42>>), + decode(-42,<<131,111,2:32,1,42,0>>), % Redundant zeros from now on + decode(-42,<<131,111,3:32,1,42,0,0>>), + decode(-42,<<131,111,4:32,1,42,0,0,0>>), + decode(-42,<<131,111,5:32,1,42,0,0,0,0>>), + decode(-42,<<131,111,6:32,1,42,0,0,0,0,0>>), + decode(-42,<<131,111,7:32,1,42,0,0,0,0,0,0>>), + decode(-42,<<131,111,8:32,1,42,0,0,0,0,0,0,0>>), ok. decode_pos_neg_zero(Config) when is_list(Config) -> - ?line decode( 0, <<131,110,0,0>>), % SMALL_BIG_EXT (positive zero) - ?line decode( 0, <<131,110,1,0,0>>), % SMALL_BIG_EXT (positive zero) - ?line decode( 0, <<131,110,0,1>>), % SMALL_BIG_EXT (negative zero) - ?line decode( 0, <<131,110,1,1,0>>), % SMALL_BIG_EXT (negative zero) + decode( 0, <<131,110,0,0>>), % SMALL_BIG_EXT (positive zero) + decode( 0, <<131,110,1,0,0>>), % SMALL_BIG_EXT (positive zero) + decode( 0, <<131,110,0,1>>), % SMALL_BIG_EXT (negative zero) + decode( 0, <<131,110,1,1,0>>), % SMALL_BIG_EXT (negative zero) - ?line decode( 0, <<131,111,0:32,0>>), % SMALL_BIG_EXT (positive zero) - ?line decode( 0, <<131,111,1:32,0,0>>), % SMALL_BIG_EXT (positive zero) - ?line decode( 0, <<131,111,0:32,1>>), % SMALL_BIG_EXT (negative zero) - ?line decode( 0, <<131,111,1:32,1,0>>), % SMALL_BIG_EXT (negative zero) + decode( 0, <<131,111,0:32,0>>), % SMALL_BIG_EXT (positive zero) + decode( 0, <<131,111,1:32,0,0>>), % SMALL_BIG_EXT (positive zero) + decode( 0, <<131,111,0:32,1>>), % SMALL_BIG_EXT (negative zero) + decode( 0, <<131,111,1:32,1,0>>), % SMALL_BIG_EXT (negative zero) N = largest_small_big(), - ?line decode( N,<<131,110,255,0,N:2040/little>>), % largest SMALL_BIG_EXT - ?line decode(-N,<<131,110,255,1,N:2040/little>>), % largest SMALL_BIG_EXT + decode( N,<<131,110,255,0,N:2040/little>>), % largest SMALL_BIG_EXT + decode(-N,<<131,110,255,1,N:2040/little>>), % largest SMALL_BIG_EXT ok. %% Test to decode uncompleted encodings for all in "erl_ext_dist.txt" decode_too_small(Config) when is_list(Config) -> - ?line decode_badarg(<<131, 97>>), - ?line decode_badarg(<<131, 98>>), - ?line decode_badarg(<<131, 98, 0>>), - ?line decode_badarg(<<131, 98, 0, 0>>), - ?line decode_badarg(<<131, 98, 0, 0, 0>>), - ?line decode_badarg(<<131, 99>>), - ?line decode_badarg(<<131, 99, 0>>), - ?line decode_badarg(<<131, 99, 0:240>>), - - ?line decode_badarg(<<131,100>>), - ?line decode_badarg(<<131,100, 1:16/big>>), - ?line decode_badarg(<<131,100, 2:16/big>>), - ?line decode_badarg(<<131,100, 2:16/big, "A">>), + decode_badarg(<<131, 97>>), + decode_badarg(<<131, 98>>), + decode_badarg(<<131, 98, 0>>), + decode_badarg(<<131, 98, 0, 0>>), + decode_badarg(<<131, 98, 0, 0, 0>>), + decode_badarg(<<131, 99>>), + decode_badarg(<<131, 99, 0>>), + decode_badarg(<<131, 99, 0:240>>), + + decode_badarg(<<131,100>>), + decode_badarg(<<131,100, 1:16/big>>), + decode_badarg(<<131,100, 2:16/big>>), + decode_badarg(<<131,100, 2:16/big, "A">>), % FIXME node name "A" seem ok, should it be? -% ?line decode_badarg(<<131,101,100,1:16/big,"A",42:32/big,0>>), - - ?line decode_badarg(<<131,101>>), - ?line decode_badarg(<<131,101,106>>), - ?line decode_badarg(<<131,101,255>>), - ?line decode_badarg(<<131,101,106,42:8/big>>), - ?line decode_badarg(<<131,101,106,42:16/big>>), - ?line decode_badarg(<<131,101,255,42:24/big>>), - ?line decode_badarg(<<131,101,255,42:32/big,0>>), - ?line decode_badarg(<<131,101,100,1:16/big,"A">>), - ?line decode_badarg(<<131,101,100,1:16/big,"A",42:32/big>>), - - ?line decode_badarg(<<131,102>>), - ?line decode_badarg(<<131,102,106,42:32/big,0>>), - ?line decode_badarg(<<131,102,255,42:32/big,0>>), - ?line decode_badarg(<<131,102,100,1:16/big,"A">>), - ?line decode_badarg(<<131,102,100,1:16/big,"A",42:32/big>>), - - ?line decode_badarg(<<131,103>>), - ?line decode_badarg(<<131,103,106,42:32/big,0>>), - ?line decode_badarg(<<131,103,255,42:32/big,0>>), - ?line decode_badarg(<<131,103,100,1:16/big,"A">>), - ?line decode_badarg(<<131,103,100,1:16/big,"A",42:32/big>>), - ?line decode_badarg(<<131,103,100,1:16/big,"A",4:32/big,2:32/big>>), - - ?line decode_badarg(<<131,104>>), - ?line decode_badarg(<<131,104, 1>>), - ?line decode_badarg(<<131,104, 2, 106>>), - ?line decode_badarg(<<131,105, 1:32/big>>), - ?line decode_badarg(<<131,105, 2:32/big, 106>>), - - ?line decode_badarg(<<131,107>>), - ?line decode_badarg(<<131,107, 1:16/big>>), - ?line decode_badarg(<<131,107, 2:16/big>>), - ?line decode_badarg(<<131,107, 2:16/big, "A">>), - - ?line decode_badarg(<<131,108>>), - ?line decode_badarg(<<131,108, 1:32/big>>), - ?line decode_badarg(<<131,108, 2:32/big>>), - ?line decode_badarg(<<131,108, 2:32/big, 106>>), % FIXME don't use NIL - - ?line decode_badarg(<<131,109>>), - ?line decode_badarg(<<131,109, 1:32/big>>), - ?line decode_badarg(<<131,109, 2:32/big>>), - ?line decode_badarg(<<131,109, 2:32/big, 42>>), + % decode_badarg(<<131,101,100,1:16/big,"A",42:32/big,0>>), + + decode_badarg(<<131,101>>), + decode_badarg(<<131,101,106>>), + decode_badarg(<<131,101,255>>), + decode_badarg(<<131,101,106,42:8/big>>), + decode_badarg(<<131,101,106,42:16/big>>), + decode_badarg(<<131,101,255,42:24/big>>), + decode_badarg(<<131,101,255,42:32/big,0>>), + decode_badarg(<<131,101,100,1:16/big,"A">>), + decode_badarg(<<131,101,100,1:16/big,"A",42:32/big>>), + + decode_badarg(<<131,102>>), + decode_badarg(<<131,102,106,42:32/big,0>>), + decode_badarg(<<131,102,255,42:32/big,0>>), + decode_badarg(<<131,102,100,1:16/big,"A">>), + decode_badarg(<<131,102,100,1:16/big,"A",42:32/big>>), + + decode_badarg(<<131,103>>), + decode_badarg(<<131,103,106,42:32/big,0>>), + decode_badarg(<<131,103,255,42:32/big,0>>), + decode_badarg(<<131,103,100,1:16/big,"A">>), + decode_badarg(<<131,103,100,1:16/big,"A",42:32/big>>), + decode_badarg(<<131,103,100,1:16/big,"A",4:32/big,2:32/big>>), + + decode_badarg(<<131,104>>), + decode_badarg(<<131,104, 1>>), + decode_badarg(<<131,104, 2, 106>>), + decode_badarg(<<131,105, 1:32/big>>), + decode_badarg(<<131,105, 2:32/big, 106>>), + + decode_badarg(<<131,107>>), + decode_badarg(<<131,107, 1:16/big>>), + decode_badarg(<<131,107, 2:16/big>>), + decode_badarg(<<131,107, 2:16/big, "A">>), + + decode_badarg(<<131,108>>), + decode_badarg(<<131,108, 1:32/big>>), + decode_badarg(<<131,108, 2:32/big>>), + decode_badarg(<<131,108, 2:32/big, 106>>), % FIXME don't use NIL + + decode_badarg(<<131,109>>), + decode_badarg(<<131,109, 1:32/big>>), + decode_badarg(<<131,109, 2:32/big>>), + decode_badarg(<<131,109, 2:32/big, 42>>), N = largest_small_big(), - ?line decode_badarg(<<131,110>>), - ?line decode_badarg(<<131,110,1>>), - ?line decode_badarg(<<131,110,1,0>>), - ?line decode_badarg(<<131,110,1,1>>), - ?line decode_badarg(<<131,110,2,0,42>>), - ?line decode_badarg(<<131,110,2,1,42>>), - ?line decode_badarg(<<131,110,255,0,N:2032/little>>), - ?line decode_badarg(<<131,110,255,1,N:2032/little>>), - - ?line decode_badarg(<<131,111>>), - ?line decode_badarg(<<131,111, 1:32/big>>), - ?line decode_badarg(<<131,111, 1:32/big,0>>), - ?line decode_badarg(<<131,111, 1:32/big,1>>), - ?line decode_badarg(<<131,111, 2:32/big,0,42>>), - ?line decode_badarg(<<131,111, 2:32/big,1,42>>), - ?line decode_badarg(<<131,111,256:32/big,0,N:2032/little>>), - ?line decode_badarg(<<131,111,256:32/big,1,N:2032/little>>), - ?line decode_badarg(<<131,111,256:32/big,0,N:2040/little>>), - ?line decode_badarg(<<131,111,256:32/big,1,N:2040/little>>), - ?line decode_badarg(<<131,111,257:32/big,0,N:2048/little>>), - ?line decode_badarg(<<131,111,257:32/big,1,N:2048/little>>), + decode_badarg(<<131,110>>), + decode_badarg(<<131,110,1>>), + decode_badarg(<<131,110,1,0>>), + decode_badarg(<<131,110,1,1>>), + decode_badarg(<<131,110,2,0,42>>), + decode_badarg(<<131,110,2,1,42>>), + decode_badarg(<<131,110,255,0,N:2032/little>>), + decode_badarg(<<131,110,255,1,N:2032/little>>), + + decode_badarg(<<131,111>>), + decode_badarg(<<131,111, 1:32/big>>), + decode_badarg(<<131,111, 1:32/big,0>>), + decode_badarg(<<131,111, 1:32/big,1>>), + decode_badarg(<<131,111, 2:32/big,0,42>>), + decode_badarg(<<131,111, 2:32/big,1,42>>), + decode_badarg(<<131,111,256:32/big,0,N:2032/little>>), + decode_badarg(<<131,111,256:32/big,1,N:2032/little>>), + decode_badarg(<<131,111,256:32/big,0,N:2040/little>>), + decode_badarg(<<131,111,256:32/big,1,N:2040/little>>), + decode_badarg(<<131,111,257:32/big,0,N:2048/little>>), + decode_badarg(<<131,111,257:32/big,1,N:2048/little>>), % Emulator dies if trying to create large bignum.... -% ?line decode_badarg(<<131,111,16#ffffffff:32/big,0>>), -% ?line decode_badarg(<<131,111,16#ffffffff:32/big,1>>), - - ?line decode_badarg(<<131, 78>>), - ?line decode_badarg(<<131, 78, 42>>), - ?line decode_badarg(<<131, 78, 42, 1>>), - ?line decode_badarg(<<131, 78, 42, 1:16/big>>), - ?line decode_badarg(<<131, 78, 42, 2:16/big>>), - ?line decode_badarg(<<131, 78, 42, 2:16/big, "A">>), - - ?line decode_badarg(<<131, 67>>), - - ?line decode_badarg(<<131,114>>), - ?line decode_badarg(<<131,114,0>>), - ?line decode_badarg(<<131,114,1:16/big>>), - ?line decode_badarg(<<131,114,1:16/big,100>>), - ?line decode_badarg(<<131,114,1:16/big,100,1:16/big>>), - ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A">>), - ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0>>), - ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:8>>), - ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:16>>), - ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:24>>), - - ?line decode_badarg(<<131,117>>), % FIXME needs more tests + % decode_badarg(<<131,111,16#ffffffff:32/big,0>>), + % decode_badarg(<<131,111,16#ffffffff:32/big,1>>), + + decode_badarg(<<131, 78>>), + decode_badarg(<<131, 78, 42>>), + decode_badarg(<<131, 78, 42, 1>>), + decode_badarg(<<131, 78, 42, 1:16/big>>), + decode_badarg(<<131, 78, 42, 2:16/big>>), + decode_badarg(<<131, 78, 42, 2:16/big, "A">>), + + decode_badarg(<<131, 67>>), + + decode_badarg(<<131,114>>), + decode_badarg(<<131,114,0>>), + decode_badarg(<<131,114,1:16/big>>), + decode_badarg(<<131,114,1:16/big,100>>), + decode_badarg(<<131,114,1:16/big,100,1:16/big>>), + decode_badarg(<<131,114,1:16/big,100,1:16/big,"A">>), + decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0>>), + decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:8>>), + decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:16>>), + decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:24>>), + + decode_badarg(<<131,117>>), % FIXME needs more tests ok. @@ -380,12 +353,11 @@ my_appender_1(N, T0) -> U = rnd_term(), T = [U|T0], my_appender_1(N-1, T). - + seed() -> - random:seed(3172, 9815, 20129). + rand:seed(exsplus, {3172,9815,20129}). rnd_term() -> - U0 = random:uniform(), + U0 = rand:uniform(), B = <<U0/float>>, {U0,U0 * 2.5 + 3.14,[U0*2.3,B]}. - diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl index 11caea3698..76e3556bc4 100644 --- a/erts/emulator/test/exception_SUITE.erl +++ b/erts/emulator/test/exception_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,67 +20,52 @@ -module(exception_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - badmatch/1, pending_errors/1, nil_arith/1, +-export([all/0, suite/0, + badmatch/1, pending_errors/1, nil_arith/1, stacktrace/1, nested_stacktrace/1, raise/1, gunilla/1, per/1, - exception_with_heap_frag/1, line_numbers/1]). + exception_with_heap_frag/1, line_numbers/1]). -export([bad_guy/2]). -export([crash/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(lists, [foreach/2]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 10}}]. all() -> [badmatch, pending_errors, nil_arith, stacktrace, nested_stacktrace, raise, gunilla, per, exception_with_heap_frag, line_numbers]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -define(try_match(E), - catch ?MODULE:bar(), - {'EXIT', {{badmatch, nomatch}, _}} = (catch E = id(nomatch))). + catch ?MODULE:bar(), + {'EXIT', {{badmatch, nomatch}, _}} = (catch E = id(nomatch))). %% Test that deliberately bad matches are reported correctly. badmatch(Config) when is_list(Config) -> - ?line ?try_match(a), - ?line ?try_match(42), - ?line ?try_match({a, b, c}), - ?line ?try_match([]), - ?line ?try_match(1.0), + ?try_match(a), + ?try_match(42), + ?try_match({a, b, c}), + ?try_match([]), + ?try_match(1.0), ok. %% Test various exceptions, in the presence of a previous error suppressed %% in a guard. pending_errors(Config) when is_list(Config) -> - ?line pending(e_badmatch, {badmatch, b}), - ?line pending(x, function_clause), - ?line pending(e_case, {case_clause, xxx}), - ?line pending(e_if, if_clause), - ?line pending(e_badarith, badarith), - ?line pending(e_undef, undef), - ?line pending(e_timeoutval, timeout_value), - ?line pending(e_badarg, badarg), - ?line pending(e_badarg_spawn, badarg), + pending(e_badmatch, {badmatch, b}), + pending(x, function_clause), + pending(e_case, {case_clause, xxx}), + pending(e_if, if_clause), + pending(e_badarith, badarith), + pending(e_undef, undef), + pending(e_timeoutval, timeout_value), + pending(e_badarg, badarg), + pending(e_badarg_spawn, badarg), ok. bad_guy(pe_badarith, Other) when Other+1 == 0 -> % badarith (suppressed) @@ -89,11 +74,11 @@ bad_guy(pe_badarg, Other) when length(Other) > 0 -> % badarg (suppressed) ok; bad_guy(_, e_case) -> case id(xxx) of - ok -> ok + ok -> ok end; % case_clause bad_guy(_, e_if) -> if - a == b -> ok + a == b -> ok end; % if_clause bad_guy(_, e_badarith) -> 1+b; % badarith @@ -101,9 +86,9 @@ bad_guy(_, e_undef) -> non_existing_module:foo(); % undef bad_guy(_, e_timeoutval) -> receive - after arne -> % timeout_value - ok - end; + after arne -> % timeout_value + ok + end; bad_guy(_, e_badarg) -> node(xxx); % badarg bad_guy(_, e_badarg_spawn) -> @@ -122,30 +107,30 @@ pending(First, Second, Expected) -> pending_catched(First, Second, Expected) -> ok = io:format("Catching bad_guy(~p, ~p)", [First, Second]), case catch bad_guy(First, Second) of - {'EXIT', Reason} -> - pending(Reason, bad_guy, [First, Second], Expected); - Other -> - test_server:fail({not_exit, Other}) + {'EXIT', Reason} -> + pending(Reason, bad_guy, [First, Second], Expected); + Other -> + ct:fail({not_exit, Other}) end. pending_exit_message(Args, Expected) -> ok = io:format("Trapping EXITs from spawn_link(~p, ~p, ~p)", - [?MODULE, bad_guy, Args]), + [?MODULE, bad_guy, Args]), process_flag(trap_exit, true), Pid = spawn_link(?MODULE, bad_guy, Args), receive - {'EXIT', Pid, Reason} -> - pending(Reason, bad_guy, Args, Expected); - Other -> - test_server:fail({unexpected_message, Other}) + {'EXIT', Pid, Reason} -> + pending(Reason, bad_guy, Args, Expected); + Other -> + ct:fail({unexpected_message, Other}) after 10000 -> - test_server:fail(timeout) + ct:fail(timeout) end, process_flag(trap_exit, false). pending({badarg,[{erlang,Bif,BifArgs,Loc1}, - {?MODULE,Func,Arity,Loc2}|_]}, - Func, Args, _Code) + {?MODULE,Func,Arity,Loc2}|_]}, + Func, Args, _Code) when is_atom(Bif), is_list(BifArgs), length(Args) =:= Arity, is_list(Loc1), is_list(Loc2) -> ok; @@ -159,67 +144,67 @@ pending({Code,[{?MODULE,Func,Arity,Loc}|_]}, Func, Args, Code) when length(Args) =:= Arity, is_list(Loc) -> ok; pending(Reason, _Function, _Args, _Code) -> - test_server:fail({bad_exit_reason,Reason}). + ct:fail({bad_exit_reason,Reason}). %% Test that doing arithmetics on [] gives a badarith EXIT and not a crash. nil_arith(Config) when is_list(Config) -> - ?line ba_plus_minus_times([], []), - - ?line ba_plus_minus_times([], 0), - ?line ba_plus_minus_times([], 42), - ?line ba_plus_minus_times([], 38724978123478923784), - ?line ba_plus_minus_times([], 38.72), - - ?line ba_plus_minus_times(0, []), - ?line ba_plus_minus_times(334, []), - ?line ba_plus_minus_times(387249797813478923784, []), - ?line ba_plus_minus_times(344.22, []), - - ?line ba_div_rem([], []), - - ?line ba_div_rem([], 0), - ?line ba_div_rem([], 1), - ?line ba_div_rem([], 42), - ?line ba_div_rem([], 38724978123478923784), - ?line ba_div_rem(344.22, []), - - ?line ba_div_rem(0, []), - ?line ba_div_rem(1, []), - ?line ba_div_rem(334, []), - ?line ba_div_rem(387249797813478923784, []), - ?line ba_div_rem(344.22, []), - - ?line ba_div_rem(344.22, 0.0), - ?line ba_div_rem(1, 0.0), - ?line ba_div_rem(392873498733971, 0.0), - - ?line ba_bop([], []), - ?line ba_bop(0, []), - ?line ba_bop(42, []), - ?line ba_bop(-42342742987343, []), - ?line ba_bop(238.342, []), - ?line ba_bop([], 0), - ?line ba_bop([], -243), - ?line ba_bop([], 243), - ?line ba_bop([], 2438724982478933), - ?line ba_bop([], 3987.37), - - ?line ba_bnot([]), - ?line ba_bnot(23.33), - - ?line ba_shift([], []), - ?line ba_shift([], 0), - ?line ba_shift([], 4), - ?line ba_shift([], -4), - ?line ba_shift([], 2343333333333), - ?line ba_shift([], -333333333), - ?line ba_shift([], 234.00), - ?line ba_shift(23, []), - ?line ba_shift(0, []), - ?line ba_shift(-3433443433433323, []), - ?line ba_shift(433443433433323, []), - ?line ba_shift(343.93, []), + ba_plus_minus_times([], []), + + ba_plus_minus_times([], 0), + ba_plus_minus_times([], 42), + ba_plus_minus_times([], 38724978123478923784), + ba_plus_minus_times([], 38.72), + + ba_plus_minus_times(0, []), + ba_plus_minus_times(334, []), + ba_plus_minus_times(387249797813478923784, []), + ba_plus_minus_times(344.22, []), + + ba_div_rem([], []), + + ba_div_rem([], 0), + ba_div_rem([], 1), + ba_div_rem([], 42), + ba_div_rem([], 38724978123478923784), + ba_div_rem(344.22, []), + + ba_div_rem(0, []), + ba_div_rem(1, []), + ba_div_rem(334, []), + ba_div_rem(387249797813478923784, []), + ba_div_rem(344.22, []), + + ba_div_rem(344.22, 0.0), + ba_div_rem(1, 0.0), + ba_div_rem(392873498733971, 0.0), + + ba_bop([], []), + ba_bop(0, []), + ba_bop(42, []), + ba_bop(-42342742987343, []), + ba_bop(238.342, []), + ba_bop([], 0), + ba_bop([], -243), + ba_bop([], 243), + ba_bop([], 2438724982478933), + ba_bop([], 3987.37), + + ba_bnot([]), + ba_bnot(23.33), + + ba_shift([], []), + ba_shift([], 0), + ba_shift([], 4), + ba_shift([], -4), + ba_shift([], 2343333333333), + ba_shift([], -333333333), + ba_shift([], 234.00), + ba_shift(23, []), + ba_shift(0, []), + ba_shift(-3433443433433323, []), + ba_shift(433443433433323, []), + ba_shift(343.93, []), ok. ba_plus_minus_times(A, B) -> @@ -251,7 +236,7 @@ ba_shift(A, B) -> {'EXIT', {badarith, _}} = (catch A bsl B), io:format("~p bsr ~p", [A, B]), {'EXIT', {badarith, _}} = (catch A bsr B). - + ba_bnot(A) -> io:format("bnot ~p", [A]), {'EXIT', {badarith, _}} = (catch bnot A). @@ -260,38 +245,38 @@ ba_bnot(A) -> stacktrace(Conf) when is_list(Conf) -> Tag = make_ref(), - ?line {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end), - ?line {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end, + {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end), + {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end, V = [make_ref()|self()], - ?line {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]=St1}} = - stacktrace_1({'abs',V}, error, {value,V}), - ?line St1 = erase(stacktrace1), - ?line St1 = erase(stacktrace2), - ?line St1 = erlang:get_stacktrace(), - ?line {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]=St2} = - stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}), - ?line [{?MODULE,my_div,2,_}|_] = erase(stacktrace1), - ?line St2 = erase(stacktrace2), - ?line St2 = erlang:get_stacktrace(), - ?line {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} = - stacktrace_1({value,V}, error, {value,V}), - ?line St3 = erase(stacktrace1), - ?line St3 = erase(stacktrace2), - ?line St3 = erlang:get_stacktrace(), - ?line {caught2,{throw,V},[{?MODULE,foo,1,_}|_]=St4} = - stacktrace_1({value,V}, error, {throw,V}), - ?line [{?MODULE,stacktrace_1,3,_}|_] = erase(stacktrace1), - ?line St4 = erase(stacktrace2), - ?line St4 = erlang:get_stacktrace(), + {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]=St1}} = + stacktrace_1({'abs',V}, error, {value,V}), + St1 = erase(stacktrace1), + St1 = erase(stacktrace2), + St1 = erlang:get_stacktrace(), + {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]=St2} = + stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}), + [{?MODULE,my_div,2,_}|_] = erase(stacktrace1), + St2 = erase(stacktrace2), + St2 = erlang:get_stacktrace(), + {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} = + stacktrace_1({value,V}, error, {value,V}), + St3 = erase(stacktrace1), + St3 = erase(stacktrace2), + St3 = erlang:get_stacktrace(), + {caught2,{throw,V},[{?MODULE,foo,1,_}|_]=St4} = + stacktrace_1({value,V}, error, {throw,V}), + [{?MODULE,stacktrace_1,3,_}|_] = erase(stacktrace1), + St4 = erase(stacktrace2), + St4 = erlang:get_stacktrace(), try - ?line stacktrace_2() + stacktrace_2() catch - error:{badmatch,_} -> - [{?MODULE,stacktrace_2,0,_}, - {?MODULE,stacktrace,1,_}|_] = - erlang:get_stacktrace(), - ok + error:{badmatch,_} -> + [{?MODULE,stacktrace_2,0,_}, + {?MODULE,stacktrace,1,_}|_] = + erlang:get_stacktrace(), + ok end. stacktrace_1(X, C1, Y) -> @@ -303,7 +288,7 @@ stacktrace_1(X, C1, Y) -> C1:D1 -> {caught1,D1,erlang:get_stacktrace()} after put(stacktrace1, erlang:get_stacktrace()), - foo(Y) + foo(Y) end of V2 -> {value2,V2} catch @@ -319,21 +304,21 @@ stacktrace_2() -> nested_stacktrace(Conf) when is_list(Conf) -> V = [{make_ref()}|[self()]], - ?line value1 = - nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, - {void,void,void}), - ?line {caught1, - [{?MODULE,my_add,2,_}|_], - value2, - [{?MODULE,my_add,2,_}|_]} = - nested_stacktrace_1({{'add',{V,x1}},error,badarith}, - {{value,{V,x2}},void,{V,x2}}), - ?line {caught1, - [{?MODULE,my_add,2,_}|_], - {caught2,[{erlang,abs,[V],_}|_]}, - [{erlang,abs,[V],_}|_]} = - nested_stacktrace_1({{'add',{V,x1}},error,badarith}, - {{'abs',V},error,badarg}), + value1 = + nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, + {void,void,void}), + {caught1, + [{?MODULE,my_add,2,_}|_], + value2, + [{?MODULE,my_add,2,_}|_]} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{value,{V,x2}},void,{V,x2}}), + {caught1, + [{?MODULE,my_add,2,_}|_], + {caught2,[{erlang,abs,[V],_}|_]}, + [{erlang,abs,[V],_}|_]} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{'abs',V},error,badarg}), ok. nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> @@ -341,64 +326,64 @@ nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> V1 -> value1 catch C1:V1 -> - S1 = erlang:get_stacktrace(), + S1 = erlang:get_stacktrace(), T2 = - try foo(X2) of - V2 -> value2 - catch - C2:V2 -> {caught2,erlang:get_stacktrace()} - end, + try foo(X2) of + V2 -> value2 + catch + C2:V2 -> {caught2,erlang:get_stacktrace()} + end, {caught1,S1,T2,erlang:get_stacktrace()} end. raise(Conf) when is_list(Conf) -> - ?line erase(raise), - ?line A = - try - ?line try foo({'div',{1,0}}) - catch - error:badarith -> - put(raise, A0 = erlang:get_stacktrace()), - ?line erlang:raise(error, badarith, A0) - end - catch - error:badarith -> - ?line A1 = erlang:get_stacktrace(), - ?line A1 = get(raise) - end, - ?line A = erlang:get_stacktrace(), - ?line A = get(raise), - ?line [{?MODULE,my_div,2,_}|_] = A, + erase(raise), + A = + try + try foo({'div',{1,0}}) + catch + error:badarith -> + put(raise, A0 = erlang:get_stacktrace()), + erlang:raise(error, badarith, A0) + end + catch + error:badarith -> + A1 = erlang:get_stacktrace(), + A1 = get(raise) + end, + A = erlang:get_stacktrace(), + A = get(raise), + [{?MODULE,my_div,2,_}|_] = A, %% N = 8, % Must be even - ?line N = erlang:system_flag(backtrace_depth, N), - ?line B = odd_even(N, []), - ?line try even(N) - catch error:function_clause -> ok - end, - ?line B = erlang:get_stacktrace(), + N = erlang:system_flag(backtrace_depth, N), + B = odd_even(N, []), + try even(N) + catch error:function_clause -> ok + end, + B = erlang:get_stacktrace(), %% - ?line C0 = odd_even(N+1, []), - ?line C = lists:sublist(C0, N), - ?line try odd(N+1) - catch error:function_clause -> ok - end, - ?line C = erlang:get_stacktrace(), - ?line try erlang:raise(error, function_clause, C0) - catch error:function_clause -> ok - end, - ?line C = erlang:get_stacktrace(), + C0 = odd_even(N+1, []), + C = lists:sublist(C0, N), + try odd(N+1) + catch error:function_clause -> ok + end, + C = erlang:get_stacktrace(), + try erlang:raise(error, function_clause, C0) + catch error:function_clause -> ok + end, + C = erlang:get_stacktrace(), ok. odd_even(N, R) when is_integer(N), N > 1 -> odd_even(N-1, - [if (N rem 2) == 0 -> - {?MODULE,even,1,[{file,"odd_even.erl"},{line,3}]}; - true -> - {?MODULE,odd,1,[{file,"odd_even.erl"},{line,6}]} - end|R]); + [if (N rem 2) == 0 -> + {?MODULE,even,1,[{file,"odd_even.erl"},{line,3}]}; + true -> + {?MODULE,odd,1,[{file,"odd_even.erl"},{line,6}]} + end|R]); odd_even(1, R) -> [{?MODULE,odd,[1],[{file,"odd_even.erl"},{line,5}]}|R]. @@ -428,18 +413,18 @@ my_add(A, B) -> my_abs(X) -> abs(X). gunilla(Config) when is_list(Config) -> - ?line {throw,kalle} = gunilla_1(), - ?line [] = erlang:get_stacktrace(), + {throw,kalle} = gunilla_1(), + [] = erlang:get_stacktrace(), ok. gunilla_1() -> try try arne() - after - pelle - end + after + pelle + end catch - C:R -> - {C,R} + C:R -> + {C,R} end. arne() -> @@ -448,18 +433,18 @@ arne() -> per(Config) when is_list(Config) -> try - t1(0,pad,0), - t2(0,pad,0) + t1(0,pad,0), + t2(0,pad,0) catch - error:badarith -> - ok + error:badarith -> + ok end. t1(_,X,_) -> - (1 bsl X) + 1. + (1 bsl X) + 1. t2(_,X,_) -> - (X bsl 1) + 1. + (X bsl 1) + 1. %% %% Make sure that even if a BIF builds an heap fragment, then causes an exception, @@ -471,155 +456,155 @@ exception_with_heap_frag(Config) when is_list(Config) -> %% Floats are only validated when the heap fragment has been allocated. BadFloat = <<131,99,53,46,48,$X,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,101,45,48,49,0,0,0,0,0>>, - ?line do_exception_with_heap_frag(BadFloat, Sizes), + do_exception_with_heap_frag(BadFloat, Sizes), %% {Binary,BadFloat}: When the error in float is discovered, a refc-binary %% has been allocated and the list of refc-binaries goes through the %% heap fragment. BinAndFloat = - <<131,104,2,109,0,0,1,0,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, - 21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45, - 46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70, - 71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95, - 96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115, - 116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134, - 135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153, - 154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172, - 173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191, - 192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210, - 211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229, - 230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248, - 249,250,251,252,253,254,255,99,51,46,49,52,$B,$l,$u,$r,$f,48,48,48,48,48,48, - 48,48,49,50,52,51,52,101,43,48,48,0,0,0,0,0>>, - ?line do_exception_with_heap_frag(BinAndFloat, Sizes), + <<131,104,2,109,0,0,1,0,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, + 21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45, + 46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70, + 71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95, + 96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115, + 116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134, + 135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153, + 154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172, + 173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191, + 192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210, + 211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229, + 230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248, + 249,250,251,252,253,254,255,99,51,46,49,52,$B,$l,$u,$r,$f,48,48,48,48,48,48, + 48,48,49,50,52,51,52,101,43,48,48,0,0,0,0,0>>, + do_exception_with_heap_frag(BinAndFloat, Sizes), %% {Fun,BadFloat} FunAndFloat = - <<131,104,2,112,0,0,0,66,0,238,239,135,138,137,216,89,57,22,111,52,126,16,84, - 71,8,0,0,0,0,0,0,0,0,100,0,1,116,97,0,98,5,175,169,123,103,100,0,13,110,111, - 110,111,100,101,64,110,111,104,111,115,116,0,0,0,41,0,0,0,0,0,99,50,46,55,48, - $Y,57,57,57,57,57,57,57,57,57,57,57,57,57,54,52,52,55,101,43,48,48,0,0,0,0,0>>, - ?line do_exception_with_heap_frag(FunAndFloat, Sizes), + <<131,104,2,112,0,0,0,66,0,238,239,135,138,137,216,89,57,22,111,52,126,16,84, + 71,8,0,0,0,0,0,0,0,0,100,0,1,116,97,0,98,5,175,169,123,103,100,0,13,110,111, + 110,111,100,101,64,110,111,104,111,115,116,0,0,0,41,0,0,0,0,0,99,50,46,55,48, + $Y,57,57,57,57,57,57,57,57,57,57,57,57,57,54,52,52,55,101,43,48,48,0,0,0,0,0>>, + do_exception_with_heap_frag(FunAndFloat, Sizes), %% [ExternalPid|BadFloat] ExtPidAndFloat = - <<131,108,0,0,0,1,103,100,0,13,107,97,108,108,101,64,115,116,114,105,100,101, - 114,0,0,0,36,0,0,0,0,2,99,48,46,$@,48,48,48,48,48,48,48,48,48,48,48,48,48,48, - 48,48,48,48,48,101,43,48,48,0,0,0,0,0>>, - ?line do_exception_with_heap_frag(ExtPidAndFloat, Sizes), - + <<131,108,0,0,0,1,103,100,0,13,107,97,108,108,101,64,115,116,114,105,100,101, + 114,0,0,0,36,0,0,0,0,2,99,48,46,$@,48,48,48,48,48,48,48,48,48,48,48,48,48,48, + 48,48,48,48,48,101,43,48,48,0,0,0,0,0>>, + do_exception_with_heap_frag(ExtPidAndFloat, Sizes), + ok. do_exception_with_heap_frag(Bin, [Sz|Sizes]) -> Filler = erlang:make_tuple(Sz, a), spawn(fun() -> - try - binary_to_term(Bin) - catch - _:_ -> - %% term_to_binary/1 is an easy way to traverse the - %% entire stacktrace term to make sure that every part - %% of it is OK. - term_to_binary(erlang:get_stacktrace()) - end, - id(Filler) - end), + try + binary_to_term(Bin) + catch + _:_ -> + %% term_to_binary/1 is an easy way to traverse the + %% entire stacktrace term to make sure that every part + %% of it is OK. + term_to_binary(erlang:get_stacktrace()) + end, + id(Filler) + end), do_exception_with_heap_frag(Bin, Sizes); do_exception_with_heap_frag(_, []) -> ok. line_numbers(Config) when is_list(Config) -> {'EXIT',{{case_clause,bad_tag}, - [{?MODULE,line1,2, - [{file,"fake_file.erl"},{line,3}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch line1(bad_tag, 0)), + [{?MODULE,line1,2, + [{file,"fake_file.erl"},{line,3}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(bad_tag, 0)), {'EXIT',{badarith, - [{?MODULE,line1,2, - [{file,"fake_file.erl"},{line,5}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch line1(a, not_an_integer)), + [{?MODULE,line1,2, + [{file,"fake_file.erl"},{line,5}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, not_an_integer)), {'EXIT',{{badmatch,{ok,1}}, - [{?MODULE,line1,2, - [{file,"fake_file.erl"},{line,7}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch line1(a, 0)), + [{?MODULE,line1,2, + [{file,"fake_file.erl"},{line,7}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, 0)), {'EXIT',{crash, - [{?MODULE,crash,1, - [{file,"fake_file.erl"},{line,14}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch line1(a, 41)), + [{?MODULE,crash,1, + [{file,"fake_file.erl"},{line,14}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, 41)), ModFile = ?MODULE_STRING++".erl", [{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]}, {?MODULE,call1,0,[{file,"call.erl"},{line,14}]}, {?MODULE,close_calls,1,[{file,"call.erl"},{line,5}]}, {?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] = - close_calls(call1), + close_calls(call1), [{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]}, {?MODULE,call2,0,[{file,"call.erl"},{line,18}]}, {?MODULE,close_calls,1,[{file,"call.erl"},{line,6}]}, {?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] = - close_calls(call2), + close_calls(call2), [{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]}, {?MODULE,call3,0,[{file,"call.erl"},{line,22}]}, {?MODULE,close_calls,1,[{file,"call.erl"},{line,7}]}, {?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] = - close_calls(call3), + close_calls(call3), no_crash = close_calls(other), <<0,0>> = build_binary1(16), {'EXIT',{badarg, - [{?MODULE,build_binary1,1, - [{file,"bit_syntax.erl"},{line,72503}]}, - {?MODULE,line_numbers,1, - [{file,ModFile},{line,_}]}|_]}} = - (catch build_binary1(bad_size)), + [{?MODULE,build_binary1,1, + [{file,"bit_syntax.erl"},{line,72503}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary1(bad_size)), <<7,1,2,3>> = build_binary2(8, <<1,2,3>>), {'EXIT',{badarg, - [{?MODULE,build_binary2,2, - [{file,"bit_syntax.erl"},{line,72507}]}, - {?MODULE,line_numbers,1, - [{file,ModFile},{line,_}]}|_]}} = - (catch build_binary2(bad_size, <<>>)), + [{?MODULE,build_binary2,2, + [{file,"bit_syntax.erl"},{line,72507}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary2(bad_size, <<>>)), {'EXIT',{badarg, - [{erlang,bit_size,[bad_binary],[]}, - {?MODULE,build_binary2,2, - [{file,"bit_syntax.erl"},{line,72507}]}, - {?MODULE,line_numbers,1, - [{file,ModFile},{line,_}]}|_]}} = - (catch build_binary2(8, bad_binary)), + [{erlang,bit_size,[bad_binary],[]}, + {?MODULE,build_binary2,2, + [{file,"bit_syntax.erl"},{line,72507}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary2(8, bad_binary)), <<"abc",357:16>> = build_binary3(<<"abc">>), {'EXIT',{badarg,[{?MODULE,build_binary3,1, - [{file,"bit_syntax.erl"},{line,72511}]}, - {?MODULE,line_numbers,1, - [{file,ModFile},{line,_}]}|_]}} = - (catch build_binary3(no_binary)), + [{file,"bit_syntax.erl"},{line,72511}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary3(no_binary)), {'EXIT',{function_clause, - [{?MODULE,do_call_abs,[y,y], - [{file,"gc_bif.erl"},{line,18}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch do_call_abs(y, y)), + [{?MODULE,do_call_abs,[y,y], + [{file,"gc_bif.erl"},{line,18}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch do_call_abs(y, y)), {'EXIT',{badarg, - [{erlang,abs,[[]],[]}, - {?MODULE,do_call_abs,2, - [{file,"gc_bif.erl"},{line,19}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch do_call_abs(x, [])), + [{erlang,abs,[[]],[]}, + {?MODULE,do_call_abs,2, + [{file,"gc_bif.erl"},{line,19}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch do_call_abs(x, [])), {'EXIT',{{badmatch,"42"}, - [{MODULE,applied_bif_1,1,[{file,"applied_bif.erl"},{line,5}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch applied_bif_1(42)), + [{MODULE,applied_bif_1,1,[{file,"applied_bif.erl"},{line,5}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch applied_bif_1(42)), {'EXIT',{{badmatch,{current_location, - {?MODULE,applied_bif_2,0, - [{file,"applied_bif.erl"},{line,9}]}}}, - [{MODULE,applied_bif_2,0,[{file,"applied_bif.erl"},{line,10}]}, - {?MODULE,line_numbers,1,_}|_]}} = - (catch applied_bif_2()), + {?MODULE,applied_bif_2,0, + [{file,"applied_bif.erl"},{line,9}]}}}, + [{MODULE,applied_bif_2,0,[{file,"applied_bif.erl"},{line,10}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch applied_bif_2()), ok. @@ -646,13 +631,13 @@ odd(N) when is_integer(N), N > 1, (N rem 2) == 1 -> -file("fake_file.erl", 1). %Line 1 line1(Tag, X) -> %Line 2 case Tag of %Line 3 - a -> - Y = X + 1, %Line 5 - Res = id({ok,Y}), %Line 6 - ?MODULE:crash({ok,42} = Res); %Line 7 - b -> - x = id(x), %Line 9 - ok %Line 10 + a -> + Y = X + 1, %Line 5 + Res = id({ok,Y}), %Line 6 + ?MODULE:crash({ok,42} = Res); %Line 7 + b -> + x = id(x), %Line 9 + ok %Line 10 end. %Line 11 crash(_) -> %Line 13 @@ -662,12 +647,12 @@ crash(_) -> %Line 13 close_calls(Where) -> %Line 2 put(where_to_crash, Where), %Line 3 try - call1(), %Line 5 - call2(), %Line 6 - call3(), %Line 7 - no_crash %Line 8 + call1(), %Line 5 + call2(), %Line 6 + call3(), %Line 7 + no_crash %Line 8 catch error:crash -> - erlang:get_stacktrace() %Line 10 + erlang:get_stacktrace() %Line 10 end. %Line 11 call1() -> %Line 13 @@ -684,10 +669,10 @@ call3() -> %Line 21 maybe_crash(Name) -> %Line 25 case get(where_to_crash) of %Line 26 - Name -> - erlang:error(crash); %Line 28 - _ -> - ok %Line 30 + Name -> + erlang:error(crash); %Line 28 + _ -> + ok %Line 30 end. -file("bit_syntax.erl", 72500). %Line 72500 diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index c1a76b8af4..e85addae3a 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,63 +20,40 @@ -module(float_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --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, - fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1, - bad_float_unpack/1, write/1, cmp_zero/1, cmp_integer/1, cmp_bignum/1]). +-export([all/0, suite/0, groups/0, + fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1, + t_mul_add_ops/1, + bad_float_unpack/1, write/1, cmp_zero/1, cmp_integer/1, cmp_bignum/1]). -export([otp_7178/1]). -export([hidden_inf/1]). +-export([arith/1]). - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(3)), - [{watchdog, Dog},{testcase,Func}|Config]. - -end_per_testcase(_Func, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> [fpe, fp_drv, fp_drv_thread, otp_7178, denormalized, match, bad_float_unpack, write, {group, comparison} ,hidden_inf - ]. + ,arith, t_mul_add_ops]. groups() -> [{comparison, [parallel], [cmp_zero, cmp_integer, cmp_bignum]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - %% %% OTP-7178, list_to_float on very small numbers should give 0.0 %% instead of exception, i.e. ignore underflow. %% -otp_7178(suite) -> - []; -otp_7178(doc) -> - ["test that list_to_float on very small numbers give 0.0"]; +%% test that list_to_float on very small numbers give 0.0 otp_7178(Config) when is_list(Config) -> - ?line X = list_to_float("1.0e-325"), - ?line true = (X < 0.00000001) and (X > -0.00000001), - ?line Y = list_to_float("1.0e-325325325"), - ?line true = (Y < 0.00000001) and (Y > -0.00000001), - ?line {'EXIT', {badarg,_}} = (catch list_to_float("1.0e83291083210")), + X = list_to_float("1.0e-325"), + true = (X < 0.00000001) and (X > -0.00000001), + Y = list_to_float("1.0e-325325325"), + true = (Y < 0.00000001) and (Y > -0.00000001), + {'EXIT', {badarg,_}} = (catch list_to_float("1.0e83291083210")), ok. %% Forces floating point exceptions and tests that subsequent, legal, @@ -84,15 +61,15 @@ otp_7178(Config) when is_list(Config) -> %% Strollo. fpe(Config) when is_list(Config) -> - ?line 0.0 = math:log(1.0), - ?line {'EXIT', {badarith, _}} = (catch math:log(-1.0)), - ?line 0.0 = math:log(1.0), - ?line {'EXIT', {badarith, _}} = (catch math:log(0.0)), - ?line 0.0 = math:log(1.0), - ?line {'EXIT',{badarith,_}} = (catch 3.23e133 * id(3.57e257)), - ?line 0.0 = math:log(1.0), - ?line {'EXIT',{badarith,_}} = (catch 5.0/id(0.0)), - ?line 0.0 = math:log(1.0), + 0.0 = math:log(1.0), + {'EXIT', {badarith, _}} = (catch math:log(-1.0)), + 0.0 = math:log(1.0), + {'EXIT', {badarith, _}} = (catch math:log(0.0)), + 0.0 = math:log(1.0), + {'EXIT',{badarith,_}} = (catch 3.23e133 * id(3.57e257)), + 0.0 = math:log(1.0), + {'EXIT',{badarith,_}} = (catch 5.0/id(0.0)), + 0.0 = math:log(1.0), ok. @@ -100,70 +77,70 @@ fpe(Config) when is_list(Config) -> -define(ERTS_FP_THREAD_TEST, 1). fp_drv(Config) when is_list(Config) -> - fp_drv_test(?ERTS_FP_CONTROL_TEST, ?config(data_dir, Config)). + fp_drv_test(?ERTS_FP_CONTROL_TEST, proplists:get_value(data_dir, Config)). fp_drv_thread(Config) when is_list(Config) -> %% Run in a separate node since it used to crash the emulator... - ?line Parent = self(), - ?line DrvDir = ?config(data_dir, Config), - ?line {ok,Node} = start_node(Config), - ?line Tester = spawn_link(Node, - fun () -> - Parent ! - {self(), - fp_drv_test(?ERTS_FP_THREAD_TEST, - DrvDir)} - end), - ?line Result = receive {Tester, Res} -> Res end, - ?line stop_node(Node), - ?line Result. + Parent = self(), + DrvDir = proplists:get_value(data_dir, Config), + {ok,Node} = start_node(Config), + Tester = spawn_link(Node, + fun () -> + Parent ! + {self(), + fp_drv_test(?ERTS_FP_THREAD_TEST, + DrvDir)} + end), + Result = receive {Tester, Res} -> Res end, + stop_node(Node), + Result. fp_drv_test(Test, DrvDir) -> - ?line Drv = fp_drv, - ?line try - begin - ?line case erl_ddll:load_driver(DrvDir, Drv) of - ok -> - ok; - {error, permanent} -> - ok; - {error, LoadError} -> - exit({load_error, - erl_ddll:format_error(LoadError)}); - LoadError -> - exit({load_error, LoadError}) - end, - case open_port({spawn, Drv}, []) of - Port when is_port(Port) -> - try port_control(Port, Test, "") of - "ok" -> - 0.0 = math:log(1.0), - ok; - [$s,$k,$i,$p,$:,$ | Reason] -> - {skipped, Reason}; - Error -> - exit(Error) - after - Port ! {self(), close}, - receive {Port, closed} -> ok end, - false = lists:member(Port, erlang:ports()), - ok - end; - Error -> - exit({open_port_failed, Error}) - end - end - catch - throw:Term -> ?line Term - after - erl_ddll:unload_driver(Drv) - end. + Drv = fp_drv, + try + begin + case erl_ddll:load_driver(DrvDir, Drv) of + ok -> + ok; + {error, permanent} -> + ok; + {error, LoadError} -> + exit({load_error, + erl_ddll:format_error(LoadError)}); + LoadError -> + exit({load_error, LoadError}) + end, + case open_port({spawn, Drv}, []) of + Port when is_port(Port) -> + try port_control(Port, Test, "") of + "ok" -> + 0.0 = math:log(1.0), + ok; + [$s,$k,$i,$p,$:,$ | Reason] -> + {skipped, Reason}; + Error -> + exit(Error) + after + Port ! {self(), close}, + receive {Port, closed} -> ok end, + false = lists:member(Port, erlang:ports()), + ok + end; + Error -> + exit({open_port_failed, Error}) + end + end + catch + throw:Term -> Term + after + erl_ddll:unload_driver(Drv) + end. denormalized(Config) when is_list(Config) -> - ?line Denormalized = 1.0e-307 / 1000, - ?line roundtrip(Denormalized), - ?line NegDenormalized = -1.0e-307 / 1000, - ?line roundtrip(NegDenormalized), + Denormalized = 1.0e-307 / 1000, + roundtrip(Denormalized), + NegDenormalized = -1.0e-307 / 1000, + roundtrip(NegDenormalized), ok. roundtrip(N) -> @@ -171,12 +148,12 @@ roundtrip(N) -> N = binary_to_term(term_to_binary(N, [{minor_version,1}])). match(Config) when is_list(Config) -> - ?line one = match_1(1.0), - ?line two = match_1(2.0), - ?line a_lot = match_1(1000.0), - ?line {'EXIT',_} = (catch match_1(0.5)), + one = match_1(1.0), + two = match_1(2.0), + a_lot = match_1(1000.0), + {'EXIT',_} = (catch match_1(0.5)), ok. - + match_1(1.0) -> one; match_1(2.0) -> two; match_1(1000.0) -> a_lot. @@ -184,8 +161,8 @@ match_1(1000.0) -> a_lot. %% Thanks to Per Gustafsson. bad_float_unpack(Config) when is_list(Config) -> - ?line Bin = <<-1:64>>, - ?line -1 = bad_float_unpack_match(Bin), + Bin = <<-1:64>>, + -1 = bad_float_unpack_match(Bin), ok. bad_float_unpack_match(<<F:64/float>>) -> F; @@ -237,75 +214,75 @@ span_cmp(Axis, Incr, Length) -> %% Diff: How much the float and int should differ when comparing span_cmp(Axis, Incr, Length, Diff) -> [begin - cmp(round(Axis*-1.0)+Diff+I*Incr,Axis*-1.0+I*Incr), - cmp(Axis*-1.0+I*Incr,round(Axis*-1.0)-Diff+I*Incr) + cmp(round(Axis*-1.0)+Diff+I*Incr,Axis*-1.0+I*Incr), + cmp(Axis*-1.0+I*Incr,round(Axis*-1.0)-Diff+I*Incr) end || I <- lists:seq((Length div 2)*-1,(Length div 2))], [begin - cmp(round(Axis)+Diff+I*Incr,Axis+I*Incr), - cmp(Axis+I*Incr,round(Axis)-Diff+I*Incr) + cmp(round(Axis)+Diff+I*Incr,Axis+I*Incr), + cmp(Axis+I*Incr,round(Axis)-Diff+I*Incr) end || I <- lists:seq((Length div 2)*-1,(Length div 2))]. cmp(Big,Small) when is_float(Big) -> BigGtSmall = lists:flatten( - io_lib:format("~f > ~p",[Big,Small])), + io_lib:format("~f > ~p",[Big,Small])), BigLtSmall = lists:flatten( - io_lib:format("~f < ~p",[Big,Small])), + io_lib:format("~f < ~p",[Big,Small])), BigEqSmall = lists:flatten( - io_lib:format("~f == ~p",[Big,Small])), + io_lib:format("~f == ~p",[Big,Small])), SmallGtBig = lists:flatten( - io_lib:format("~p > ~f",[Small,Big])), + io_lib:format("~p > ~f",[Small,Big])), SmallLtBig = lists:flatten( - io_lib:format("~p < ~f",[Small,Big])), + io_lib:format("~p < ~f",[Small,Big])), SmallEqBig = lists:flatten( - io_lib:format("~p == ~f",[Small,Big])), + io_lib:format("~p == ~f",[Small,Big])), cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, - SmallEqBig,BigEqSmall); + SmallEqBig,BigEqSmall); cmp(Big,Small) when is_float(Small) -> BigGtSmall = lists:flatten( - io_lib:format("~p > ~f",[Big,Small])), + io_lib:format("~p > ~f",[Big,Small])), BigLtSmall = lists:flatten( - io_lib:format("~p < ~f",[Big,Small])), + io_lib:format("~p < ~f",[Big,Small])), BigEqSmall = lists:flatten( - io_lib:format("~p == ~f",[Big,Small])), + io_lib:format("~p == ~f",[Big,Small])), SmallGtBig = lists:flatten( - io_lib:format("~f > ~p",[Small,Big])), + io_lib:format("~f > ~p",[Small,Big])), SmallLtBig = lists:flatten( - io_lib:format("~f < ~p",[Small,Big])), + io_lib:format("~f < ~p",[Small,Big])), SmallEqBig = lists:flatten( - io_lib:format("~f == ~p",[Small,Big])), + io_lib:format("~f == ~p",[Small,Big])), cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, - SmallEqBig,BigEqSmall). + SmallEqBig,BigEqSmall). cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, SmallEqBig,BigEqSmall) -> {_,_,_,true} = {Big,Small,BigGtSmall, - Big > Small}, + Big > Small}, {_,_,_,false} = {Big,Small,BigLtSmall, - Big < Small}, + Big < Small}, {_,_,_,false} = {Big,Small,SmallGtBig, - Small > Big}, + Small > Big}, {_,_,_,true} = {Big,Small,SmallLtBig, - Small < Big}, + Small < Big}, {_,_,_,false} = {Big,Small,SmallEqBig, - Small == Big}, + Small == Big}, {_,_,_,false} = {Big,Small,BigEqSmall, - Big == Small}. + Big == Small}. id(I) -> I. - + start_node(Config) when is_list(Config) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line 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}]). + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + test_server:start_node(Name, slave, [{args, "-pa "++Pa}]). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). %% Test that operations that might hide infinite intermediate results @@ -315,8 +292,8 @@ hidden_inf(Config) when is_list(Config) -> ZeroN = id(ZeroP) * (-1), [hidden_inf_1(A, B, Z, 9.23e307) || A <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN], - B <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN], - Z <- [ZeroP, ZeroN]], + B <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN], + Z <- [ZeroP, ZeroN]], ok. hidden_inf_1(A, B, Zero, Huge) -> @@ -328,3 +305,122 @@ hidden_inf_1(A, B, Zero, Huge) -> {'EXIT',{badarith,_}} = (catch (B * (Huge + Huge))), {'EXIT',{badarith,_}} = (catch (B / (-Huge - Huge))), {'EXIT',{badarith,_}} = (catch (B * (-Huge - Huge))). + +%% Improve code coverage in our different arithmetic functions +%% and make sure they yield consistent results. +arith(_Config) -> + _TAG_IMMED1_SIZE = 4, + + <<FLOAT_MAX/float>> = <<0:1, 16#7fe:11, -1:52>>, + <<FLOAT_MIN/float>> = <<0:1, 0:11, 1:52>>, + <<FloatNegZero/float>> = <<1:1, 0:11, 0:52>>, + + WORD_BITS = erlang:system_info(wordsize) * 8, + SMALL_BITS = (WORD_BITS - _TAG_IMMED1_SIZE), + SMALL_MAX = (1 bsl (SMALL_BITS-1)) - 1, + SMALL_MIN = -(1 bsl (SMALL_BITS-1)), + BIG1_MAX = (1 bsl WORD_BITS) - 1, + BIG2_MAX = (1 bsl (WORD_BITS*2)) - 1, + + fixnum = erts_internal:term_type(SMALL_MAX), + fixnum = erts_internal:term_type(SMALL_MIN), + bignum = erts_internal:term_type(SMALL_MAX + 1), + bignum = erts_internal:term_type(SMALL_MIN - 1), + + L = [0, 0.0, FloatNegZero, 1, 1.0, 17, 17.0, 0.17, + FLOAT_MIN, FLOAT_MAX, + SMALL_MAX, SMALL_MAX+1, + SMALL_MIN, SMALL_MIN-1, + BIG1_MAX, BIG1_MAX+1, + BIG2_MAX, BIG2_MAX+1, + trunc(FLOAT_MAX), trunc(FLOAT_MAX)+1, trunc(FLOAT_MAX)*2, + immed_badarg, + "list badarg", + {"boxed badarg"}], + + foreach_pair(fun(A,B) -> do_bin_ops(A,B) end, L). + +foreach_pair(F, L) -> + lists:foreach( + fun(A) -> lists:foreach(fun(B) -> F(A,B) end, L) end, + L). + +do_bin_ops(A, B) -> + Fun = fun(Op) -> + Op(A,B), + is_number(A) andalso Op(-A,B), + is_number(B) andalso Op(A,-B), + is_number(A) andalso is_number(B) andalso Op(-A,-B) + end, + lists:foreach(Fun, + [fun op_add/2, fun op_sub/2, fun op_mul/2, fun op_div/2]). + +op_add(A, B) -> + Info = [A,B], + R = unify(catch A + B, Info), + R = unify(my_apply(erlang,'+',[A,B]), Info), + case R of + _ when A + B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +op_sub(A, B) -> + Info = [A,B], + R = unify(catch A - B, Info), + R = unify(my_apply(erlang,'-',[A,B]), Info), + case R of + _ when A - B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +op_mul(A, B) -> + Info = [A,B], + R = unify(catch A * B, Info), + R = unify(my_apply(erlang,'*',[A,B]), Info), + case R of + _ when A * B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +op_div(A, B) -> + Info = [A,B], + R = unify(catch A / B, Info), + R = unify(my_apply(erlang,'/',[A,B]), Info), + case R of + _ when A / B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +my_apply(M, F, A) -> + catch apply(id(M), id(F), A). + +% Unify exceptions be removing stack traces. +% and add argument info to make it easer to debug failed matches. +unify({'EXIT',{Reason,_Stack}}, Info) -> + {{'EXIT', Reason}, Info}; +unify(Other, Info) -> + {Other, Info}. + + +-define(epsilon, 1.0e-20). +check_epsilon(R,Val) -> + if erlang:abs(R-Val) < ?epsilon -> ok; + true -> ct:fail({R,Val}) + end. + +t_mul_add_ops(Config) when is_list(Config) -> + check_epsilon(op_mul_add(1, 2.0, 1.0, 0.0), 1.0), + check_epsilon(op_mul_add(2, 2.0, 1.0, 0.0), 3.0), + check_epsilon(op_mul_add(3, 2.0, 1.0, 0.0), 7.0), + check_epsilon(op_mul_add(4, 2.0, 1.0, 0.0), 15.0), + check_epsilon(op_mul_add(5, 2.0, 1.0, 0.0), 31.0), + check_epsilon(op_mul_add(6, 2.0, 1.0, 0.0), 63.0), + check_epsilon(op_mul_add(6, 2.0, 1.3, 0.0), 81.9), + check_epsilon(op_mul_add(6, 2.03, 1.3, 0.0), 87.06260151458997), + ok. + + +op_mul_add(0, _, _, R) -> R; +op_mul_add(N, A, B, R) when is_float(A), is_float(B), is_float(R) -> + op_mul_add(N - 1, A, B, R * A + B). + diff --git a/erts/emulator/test/float_SUITE_data/fp_drv.c b/erts/emulator/test/float_SUITE_data/fp_drv.c index 5919dd8e2f..a91d622040 100644 --- a/erts/emulator/test/float_SUITE_data/fp_drv.c +++ b/erts/emulator/test/float_SUITE_data/fp_drv.c @@ -18,6 +18,7 @@ */ #if defined(DEBUG) || 0 +# include <stdio.h> # define PRINTF(X) printf X #else # define PRINTF(X) diff --git a/erts/emulator/test/float_SUITE_data/has_fpe_bug.erl b/erts/emulator/test/float_SUITE_data/has_fpe_bug.erl index 79ab74dfff..26837de274 100644 --- a/erts/emulator/test/float_SUITE_data/has_fpe_bug.erl +++ b/erts/emulator/test/float_SUITE_data/has_fpe_bug.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl index b18f9f5c6b..26fa955e3c 100644 --- a/erts/emulator/test/fun_SUITE.erl +++ b/erts/emulator/test/fun_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,11 +21,7 @@ -module(fun_SUITE). -compile({nowarn_deprecated_function, {erlang,hash,2}}). --define(default_timeout, ?t:minutes(1)). - --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([all/0, suite/0, bad_apply/1,bad_fun_call/1,badarity/1,ext_badarity/1, equality/1,ordering/1, fun_to_port/1,t_hash/1,t_phash/1,t_phash2/1,md5/1, @@ -35,9 +31,12 @@ -export([nothing/0]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. -suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [bad_apply, bad_fun_call, badarity, ext_badarity, @@ -46,45 +45,18 @@ all() -> const_propagation, t_arity, t_is_function2, t_fun_info, t_fun_info_mfa]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(_Case, Config) -> - ?line Dog = test_server:timetrap(?default_timeout), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. - -bad_apply(doc) -> - "Test that the correct EXIT code is returned for all types of bad funs."; -bad_apply(suite) -> []; +%% Test that the correct EXIT code is returned for all types of bad funs. bad_apply(Config) when is_list(Config) -> - ?line bad_apply_fc(42, [0]), - ?line bad_apply_fc(xx, [1]), - ?line bad_apply_fc({}, [2]), - ?line bad_apply_fc({1}, [3]), - ?line bad_apply_fc({1,2,3}, [4]), - ?line bad_apply_fc({1,2,3}, [5]), - ?line bad_apply_fc({1,2,3,4}, [6]), - ?line bad_apply_fc({1,2,3,4,5,6}, [7]), - ?line bad_apply_fc({1,2,3,4,5}, [8]), - ?line bad_apply_badarg({1,2}, [9]), + bad_apply_fc(42, [0]), + bad_apply_fc(xx, [1]), + bad_apply_fc({}, [2]), + bad_apply_fc({1}, [3]), + bad_apply_fc({1,2,3}, [4]), + bad_apply_fc({1,2,3}, [5]), + bad_apply_fc({1,2,3,4}, [6]), + bad_apply_fc({1,2,3,4,5,6}, [7]), + bad_apply_fc({1,2,3,4,5}, [8]), + bad_apply_badarg({1,2}, [9]), ok. bad_apply_fc(Fun, Args) -> @@ -96,7 +68,7 @@ bad_apply_fc(Fun, Args) -> ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]); Other -> ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]), - ?t:fail({bad_result,Other}) + ct:fail({bad_result,Other}) end. bad_apply_badarg(Fun, Args) -> @@ -108,23 +80,21 @@ bad_apply_badarg(Fun, Args) -> ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]); Other -> ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]), - ?t:fail({bad_result, Other}) + ct:fail({bad_result, Other}) end. -bad_fun_call(doc) -> - "Try directly calling bad funs."; -bad_fun_call(suite) -> []; +%% Try directly calling bad funs. bad_fun_call(Config) when is_list(Config) -> - ?line bad_call_fc(42), - ?line bad_call_fc(xx), - ?line bad_call_fc({}), - ?line bad_call_fc({1}), - ?line bad_call_fc({1,2,3}), - ?line bad_call_fc({1,2,3}), - ?line bad_call_fc({1,2,3,4}), - ?line bad_call_fc({1,2,3,4,5,6}), - ?line bad_call_fc({1,2,3,4,5}), - ?line bad_call_fc({1,2}), + bad_call_fc(42), + bad_call_fc(xx), + bad_call_fc({}), + bad_call_fc({1}), + bad_call_fc({1,2,3}), + bad_call_fc({1,2,3}), + bad_call_fc({1,2,3,4}), + bad_call_fc({1,2,3,4,5,6}), + bad_call_fc({1,2,3,4,5}), + bad_call_fc({1,2}), ok. bad_call_fc(Fun) -> @@ -135,74 +105,74 @@ bad_call_fc(Fun) -> ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); Other -> ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), - ?t:fail({bad_result,Other}) + ct:fail({bad_result,Other}) end. %% Call and apply valid funs with wrong number of arguments. badarity(Config) when is_list(Config) -> - ?line Fun = fun() -> ok end, - ?line Stupid = {stupid,arguments}, - ?line Args = [some,{stupid,arguments},here], + Fun = fun() -> ok end, + Stupid = {stupid,arguments}, + Args = [some,{stupid,arguments},here], %% Simple call. - ?line Res = (catch Fun(some, Stupid, here)), + Res = (catch Fun(some, Stupid, here)), erlang:garbage_collect(), erlang:yield(), case Res of {'EXIT',{{badarity,{Fun,Args}},_}} -> - ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); + ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); _ -> - ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), - ?line ?t:fail({bad_result,Res}) + ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), + ct:fail({bad_result,Res}) end, %% Apply. - ?line Res2 = (catch apply(Fun, Args)), + Res2 = (catch apply(Fun, Args)), erlang:garbage_collect(), erlang:yield(), case Res2 of {'EXIT',{{badarity,{Fun,Args}},_}} -> - ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]); + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]); _ -> - ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]), - ?line ?t:fail({bad_result,Res2}) + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]), + ct:fail({bad_result,Res2}) end, ok. %% Call and apply valid external funs with wrong number of arguments. ext_badarity(Config) when is_list(Config) -> - ?line Fun = fun ?MODULE:nothing/0, - ?line Stupid = {stupid,arguments}, - ?line Args = [some,{stupid,arguments},here], + Fun = fun ?MODULE:nothing/0, + Stupid = {stupid,arguments}, + Args = [some,{stupid,arguments},here], %% Simple call. - ?line Res = (catch Fun(some, Stupid, here)), + Res = (catch Fun(some, Stupid, here)), erlang:garbage_collect(), erlang:yield(), case Res of {'EXIT',{{badarity,{Fun,Args}},_}} -> - ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); + ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); _ -> - ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), - ?line ?t:fail({bad_result,Res}) + ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), + ct:fail({bad_result,Res}) end, %% Apply. - ?line Res2 = (catch apply(Fun, Args)), + Res2 = (catch apply(Fun, Args)), erlang:garbage_collect(), erlang:yield(), case Res2 of {'EXIT',{{badarity,{Fun,Args}},_}} -> - ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]); + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]); _ -> - ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]), - ?line ?t:fail({bad_result,Res2}) + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]), + ct:fail({bad_result,Res2}) end, ok. @@ -214,29 +184,29 @@ nothing() -> equality(Config) when is_list(Config) -> F0 = fun() -> 1 end, F0_copy = copy_term(F0), - ?line true = eq(F0, F0), - ?line true = eq(F0, F0_copy), + true = eq(F0, F0), + true = eq(F0, F0_copy), %% Compare different arities. F1 = fun(X) -> X + 1 end, - ?line true = eq(F1, F1), - ?line false = eq(F0, F1), - ?line false = eq(F0_copy, F1), + true = eq(F1, F1), + false = eq(F0, F1), + false = eq(F0_copy, F1), %% Compare different environments. G1 = make_fun(1), G2 = make_fun(2), - ?line true = eq(G1, G1), - ?line true = eq(G2, G2), - ?line false = eq(G1, G2), - ?line false = eq(G2, G1), + true = eq(G1, G1), + true = eq(G2, G2), + false = eq(G1, G2), + false = eq(G2, G1), G1_copy = copy_term(G1), - ?line true = eq(G1, G1_copy), + true = eq(G1, G1_copy), %% Compare fun with binaries. B = list_to_binary([7,8,9]), - ?line false = eq(B, G1), - ?line false = eq(G1, B), + false = eq(B, G1), + false = eq(G1, B), %% Compare external funs. FF0 = fun aa:blurf/0, @@ -246,23 +216,23 @@ equality(Config) when is_list(Config) -> FF3 = fun erlang:exit/2, FF4 = fun z:ff/0, - ?line true = eq(FF0, FF0), - ?line true = eq(FF0, FF0_copy), - ?line true = eq(FF1, FF1), - ?line true = eq(FF2, FF2), - ?line true = eq(FF3, FF3), - ?line true = eq(FF4, FF4), - ?line false = eq(FF0, FF1), - ?line false = eq(FF0, FF2), - ?line false = eq(FF0, FF3), - ?line false = eq(FF0, FF4), - ?line false = eq(FF1, FF0), - ?line false = eq(FF1, FF2), - ?line false = eq(FF1, FF3), - ?line false = eq(FF1, FF4), - ?line false = eq(FF2, FF3), - ?line false = eq(FF2, FF4), - ?line false = eq(FF3, FF4), + true = eq(FF0, FF0), + true = eq(FF0, FF0_copy), + true = eq(FF1, FF1), + true = eq(FF2, FF2), + true = eq(FF3, FF3), + true = eq(FF4, FF4), + false = eq(FF0, FF1), + false = eq(FF0, FF2), + false = eq(FF0, FF3), + false = eq(FF0, FF4), + false = eq(FF1, FF0), + false = eq(FF1, FF2), + false = eq(FF1, FF3), + false = eq(FF1, FF4), + false = eq(FF2, FF3), + false = eq(FF2, FF4), + false = eq(FF3, FF4), %% EEP37 H1 = fun Fact(N) when N > 0 -> N * Fact(N - 1); Fact(0) -> 1 end, @@ -285,7 +255,7 @@ copy_term(Term) -> make_fun(X) -> fun() -> X end. -ordering(doc) -> "Tests ordering of funs."; +%% Tests ordering of funs. ordering(Config) when is_list(Config) -> F1 = make_fun(1, 2), F1_copy = copy_term(F1), @@ -298,140 +268,139 @@ ordering(Config) when is_list(Config) -> FF3 = fun erlang:exit/2, FF4 = fun z:ff/0, - ?line true = FF0 < FF1, - ?line true = FF1 < FF2, - ?line true = FF2 < FF3, - ?line true = FF3 < FF4, + true = FF0 < FF1, + true = FF1 < FF2, + true = FF2 < FF3, + true = FF3 < FF4, - ?line true = FF0 > F1, - ?line true = FF0 > F2, - ?line true = FF0 > F3, - ?line true = FF4 > F1, - ?line true = FF4 > F2, - ?line true = FF4 > F3, + true = FF0 > F1, + true = FF0 > F2, + true = FF0 > F3, + true = FF4 > F1, + true = FF4 > F2, + true = FF4 > F3, - ?line true = F1 == F1, - ?line true = F1 == F1_copy, - ?line true = F1 /= F2, + true = F1 == F1, + true = F1 == F1_copy, + true = F1 /= F2, - ?line true = F1 < F2, - ?line true = F2 > F1, - ?line true = F2 < F3, - ?line true = F3 > F2, + true = F1 < F2, + true = F2 > F1, + true = F2 < F3, + true = F3 > F2, - ?line false = F1 > F2, - ?line false = F2 > F3, + false = F1 > F2, + false = F2 > F3, %% Compare with binaries. B = list_to_binary([7,8,9,10]), - ?line false = B == F1, - ?line false = F1 == B, + false = B == F1, + false = F1 == B, - ?line true = F1 < B, - ?line true = B > F2, + true = F1 < B, + true = B > F2, - ?line false = F1 > B, - ?line false = B < F2, + false = F1 > B, + false = B < F2, - ?line false = F1 >= B, - ?line false = B =< F2, + false = F1 >= B, + false = B =< F2, %% Compare module funs with binaries. - ?line false = B == FF1, - ?line false = FF1 == B, + false = B == FF1, + false = FF1 == B, - ?line true = FF1 < B, - ?line true = B > FF2, + true = FF1 < B, + true = B > FF2, - ?line false = FF1 > B, - ?line false = B < FF2, + false = FF1 > B, + false = B < FF2, - ?line false = FF1 >= B, - ?line false = B =< FF2, + false = FF1 >= B, + false = B =< FF2, %% Create a port and ref. - ?line Path = ?config(priv_dir, Config), - ?line AFile = filename:join(Path, "vanilla_file"), - ?line P = open_port(AFile, [out]), - ?line R = make_ref(), + Path = proplists:get_value(priv_dir, Config), + AFile = filename:join(Path, "vanilla_file"), + P = open_port(AFile, [out]), + R = make_ref(), %% Compare funs with ports and refs. - ?line true = R < F3, - ?line true = F3 > R, - ?line true = F3 < P, - ?line true = P > F3, + true = R < F3, + true = F3 > R, + true = F3 < P, + true = P > F3, - ?line true = R =< F3, - ?line true = F3 >= R, - ?line true = F3 =< P, - ?line true = P >= F3, + true = R =< F3, + true = F3 >= R, + true = F3 =< P, + true = P >= F3, - ?line false = R > F3, - ?line false = F3 < R, - ?line false = F3 > P, - ?line false = P < F3, + false = R > F3, + false = F3 < R, + false = F3 > P, + false = P < F3, %% Compare funs with conses and nils. - ?line true = F1 < [a], - ?line true = F1 < [], - ?line true = [a,b] > F1, - ?line true = [] > F1, + true = F1 < [a], + true = F1 < [], + true = [a,b] > F1, + true = [] > F1, - ?line false = [1] < F1, - ?line false = [] < F1, - ?line false = F1 > [2], - ?line false = F1 > [], + false = [1] < F1, + false = [] < F1, + false = F1 > [2], + false = F1 > [], - ?line false = [1] =< F1, - ?line false = [] =< F1, - ?line false = F1 >= [2], - ?line false = F1 >= [], + false = [1] =< F1, + false = [] =< F1, + false = F1 >= [2], + false = F1 >= [], %% Compare module funs with conses and nils. - ?line true = FF1 < [a], - ?line true = FF1 < [], - ?line true = [a,b] > FF1, - ?line true = [] > FF1, + true = FF1 < [a], + true = FF1 < [], + true = [a,b] > FF1, + true = [] > FF1, - ?line false = [1] < FF1, - ?line false = [] < FF1, - ?line false = FF1 > [2], - ?line false = FF1 > [], + false = [1] < FF1, + false = [] < FF1, + false = FF1 > [2], + false = FF1 > [], - ?line false = [1] =< FF1, - ?line false = [] =< FF1, - ?line false = FF1 >= [2], - ?line false = FF1 >= [], + false = [1] =< FF1, + false = [] =< FF1, + false = FF1 >= [2], + false = FF1 >= [], ok. make_fun(X, Y) -> fun(A) -> A*X+Y end. -fun_to_port(doc) -> "Try sending funs to ports (should fail)."; -fun_to_port(suite) -> []; +%% Try sending funs to ports (should fail). fun_to_port(Config) when is_list(Config) -> - ?line fun_to_port(Config, xxx), - ?line fun_to_port(Config, fun() -> 42 end), - ?line fun_to_port(Config, [fun() -> 43 end]), - ?line fun_to_port(Config, [1,fun() -> 44 end]), - ?line fun_to_port(Config, [0,1|fun() -> 45 end]), + fun_to_port(Config, xxx), + fun_to_port(Config, fun() -> 42 end), + fun_to_port(Config, [fun() -> 43 end]), + fun_to_port(Config, [1,fun() -> 44 end]), + fun_to_port(Config, [0,1|fun() -> 45 end]), B64K = build_io_list(65536), - ?line fun_to_port(Config, [B64K,fun() -> 45 end]), - ?line fun_to_port(Config, [B64K|fun() -> 45 end]), + fun_to_port(Config, [B64K,fun() -> 45 end]), + fun_to_port(Config, [B64K|fun() -> 45 end]), ok. fun_to_port(Config, IoList) -> - Path = ?config(priv_dir, Config), + Path = proplists:get_value(priv_dir, Config), AFile = filename:join(Path, "vanilla_file"), Port = open_port(AFile, [out]), case catch port_command(Port, IoList) of {'EXIT',{badarg,_}} -> ok; - Other -> ?t:fail({unexpected_retval,Other}) + Other -> ct:fail({unexpected_retval,Other}) end. build_io_list(0) -> []; @@ -443,86 +412,83 @@ build_io_list(N) -> 1 -> [7,L|L] end. -t_hash(doc) -> "Test the hash/2 BIF on funs."; -t_hash(suite) -> []; +%% Test the hash/2 BIF on funs. t_hash(Config) when is_list(Config) -> F1 = fun(_X) -> 1 end, F2 = fun(_X) -> 2 end, - ?line true = hash(F1) /= hash(F2), + true = hash(F1) /= hash(F2), G1 = make_fun(1, 2, 3), G2 = make_fun(1, 2, 3), G3 = make_fun(1, 2, 4), - ?line true = hash(G1) == hash(G2), - ?line true = hash(G2) /= hash(G3), + true = hash(G1) == hash(G2), + true = hash(G2) /= hash(G3), FF0 = fun erlang:abs/1, FF1 = fun erlang:exit/1, FF2 = fun erlang:exit/2, FF3 = fun blurf:exit/2, - ?line true = hash(FF0) =/= hash(FF1), - ?line true = hash(FF0) =/= hash(FF2), - ?line true = hash(FF0) =/= hash(FF3), - ?line true = hash(FF1) =/= hash(FF2), - ?line true = hash(FF1) =/= hash(FF3), - ?line true = hash(FF2) =/= hash(FF3), + true = hash(FF0) =/= hash(FF1), + true = hash(FF0) =/= hash(FF2), + true = hash(FF0) =/= hash(FF3), + true = hash(FF1) =/= hash(FF2), + true = hash(FF1) =/= hash(FF3), + true = hash(FF2) =/= hash(FF3), ok. hash(Term) -> erlang:hash(Term, 16#7ffffff). -t_phash(doc) -> "Test the phash/2 BIF on funs."; -t_phash(suite) -> []; +%% Test the phash/2 BIF on funs. t_phash(Config) when is_list(Config) -> F1 = fun(_X) -> 1 end, F2 = fun(_X) -> 2 end, - ?line true = phash(F1) /= phash(F2), + true = phash(F1) /= phash(F2), G1 = make_fun(1, 2, 3), G2 = make_fun(1, 2, 3), G3 = make_fun(1, 2, 4), - ?line true = phash(G1) == phash(G2), - ?line true = phash(G2) /= phash(G3), + true = phash(G1) == phash(G2), + true = phash(G2) /= phash(G3), FF0 = fun erlang:abs/1, FF1 = fun erlang:exit/1, FF2 = fun erlang:exit/2, FF3 = fun blurf:exit/2, - ?line true = phash(FF0) =/= phash(FF1), - ?line true = phash(FF0) =/= phash(FF2), - ?line true = phash(FF0) =/= phash(FF3), - ?line true = phash(FF1) =/= phash(FF2), - ?line true = phash(FF1) =/= phash(FF3), - ?line true = phash(FF2) =/= phash(FF3), + true = phash(FF0) =/= phash(FF1), + true = phash(FF0) =/= phash(FF2), + true = phash(FF0) =/= phash(FF3), + true = phash(FF1) =/= phash(FF2), + true = phash(FF1) =/= phash(FF3), + true = phash(FF2) =/= phash(FF3), ok. phash(Term) -> erlang:phash(Term, 16#7ffffff). -t_phash2(doc) -> "Test the phash2/2 BIF on funs."; -t_phash2(suite) -> []; +%% Test the phash2/2 BIF on funs. t_phash2(Config) when is_list(Config) -> F1 = fun(_X) -> 1 end, F2 = fun(_X) -> 2 end, - ?line true = phash2(F1) /= phash2(F2), + true = phash2(F1) /= phash2(F2), G1 = make_fun(1, 2, 3), G2 = make_fun(1, 2, 3), G3 = make_fun(1, 2, 4), - ?line true = phash2(G1) == phash2(G2), - ?line true = phash2(G2) /= phash2(G3), + true = phash2(G1) == phash2(G2), + true = phash2(G2) /= phash2(G3), FF0 = fun erlang:abs/1, FF1 = fun erlang:exit/1, FF2 = fun erlang:exit/2, FF3 = fun blurf:exit/2, - ?line true = phash2(FF0) =/= phash2(FF1), - ?line true = phash2(FF0) =/= phash2(FF2), - ?line true = phash2(FF0) =/= phash2(FF3), - ?line true = phash2(FF1) =/= phash2(FF2), - ?line true = phash2(FF1) =/= phash2(FF3), - ?line true = phash2(FF2) =/= phash2(FF3), + true = phash2(FF0) =/= phash2(FF1), + true = phash2(FF0) =/= phash2(FF2), + true = phash2(FF0) =/= phash2(FF3), + true = phash2(FF1) =/= phash2(FF2), + true = phash2(FF1) =/= phash2(FF3), + true = phash2(FF2) =/= phash2(FF3), ok. @@ -532,52 +498,51 @@ phash2(Term) -> make_fun(X, Y, Z) -> fun() -> {X,Y,Z} end. -md5(doc) -> "Test that MD5 bifs reject funs properly."; -md5(suite) -> []; +%% Test that MD5 bifs reject funs properly. md5(Config) when is_list(Config) -> _ = size(erlang:md5_init()), %% Try funs in the i/o list. - ?line bad_md5(fun(_X) -> 42 end), - ?line bad_md5([fun(_X) -> 43 end]), - ?line bad_md5([1,fun(_X) -> 44 end]), - ?line bad_md5([1|fun(_X) -> 45 end]), - ?line B64K = build_io_list(65536), - ?line bad_md5([B64K,fun(_X) -> 46 end]), - ?line bad_md5([B64K|fun(_X) -> 46 end]), + bad_md5(fun(_X) -> 42 end), + bad_md5([fun(_X) -> 43 end]), + bad_md5([1,fun(_X) -> 44 end]), + bad_md5([1|fun(_X) -> 45 end]), + B64K = build_io_list(65536), + bad_md5([B64K,fun(_X) -> 46 end]), + bad_md5([B64K|fun(_X) -> 46 end]), ok. bad_md5(Bad) -> {'EXIT',{badarg,_}} = (catch erlang:md5(Bad)). refc(Config) when is_list(Config) -> - ?line F1 = fun_factory(2), - ?line {refc,2} = erlang:fun_info(F1, refc), - ?line F2 = fun_factory(42), - ?line {refc,3} = erlang:fun_info(F1, refc), + F1 = fun_factory(2), + {refc,2} = erlang:fun_info(F1, refc), + F2 = fun_factory(42), + {refc,3} = erlang:fun_info(F1, refc), - ?line process_flag(trap_exit, true), - ?line Pid = spawn_link(fun() -> {refc,4} = erlang:fun_info(F1, refc) end), + process_flag(trap_exit, true), + Pid = spawn_link(fun() -> {refc,4} = erlang:fun_info(F1, refc) end), receive {'EXIT',Pid,normal} -> ok; - Other -> ?line ?t:fail({unexpected,Other}) + Other -> ct:fail({unexpected,Other}) end, - ?line process_flag(trap_exit, false), - ?line {refc,3} = erlang:fun_info(F1, refc), + process_flag(trap_exit, false), + {refc,3} = erlang:fun_info(F1, refc), %% Garbage collect. Only the F2 fun will be left. - ?line 7 = F1(5), - ?line true = erlang:garbage_collect(), - ?line 40 = F2(-2), - ?line {refc,2} = erlang:fun_info(F2, refc), + 7 = F1(5), + true = erlang:garbage_collect(), + 40 = F2(-2), + {refc,2} = erlang:fun_info(F2, refc), ok. fun_factory(Const) -> fun(X) -> X + Const end. refc_ets(Config) when is_list(Config) -> - ?line F = fun(X) -> X + 33 end, - ?line {refc,2} = erlang:fun_info(F, refc), + F = fun(X) -> X + 33 end, + {refc,2} = erlang:fun_info(F, refc), refc_ets_set(F, [set]), refc_ets_set(F, [ordered_set]), @@ -586,115 +551,112 @@ refc_ets(Config) when is_list(Config) -> ok. refc_ets_set(F1, Options) -> - ?line io:format("~p", [Options]), - ?line Tab = ets:new(kalle, Options), - ?line true = ets:insert(Tab, {a_key,F1}), - ?line 3 = fun_refc(F1), - ?line [{a_key,F3}] = ets:lookup(Tab, a_key), - ?line 4 = fun_refc(F1), - ?line true = ets:insert(Tab, {a_key,not_a_fun}), - ?line 3 = fun_refc(F1), - ?line true = ets:insert(Tab, {another_key,F1}), - ?line 4 = fun_refc(F1), - ?line true = ets:delete(Tab), - ?line 3 = fun_refc(F1), - ?line 10 = F3(-23), - ?line true = erlang:garbage_collect(), - ?line 2 = fun_refc(F1), + io:format("~p", [Options]), + Tab = ets:new(kalle, Options), + true = ets:insert(Tab, {a_key,F1}), + 3 = fun_refc(F1), + [{a_key,F3}] = ets:lookup(Tab, a_key), + 4 = fun_refc(F1), + true = ets:insert(Tab, {a_key,not_a_fun}), + 3 = fun_refc(F1), + true = ets:insert(Tab, {another_key,F1}), + 4 = fun_refc(F1), + true = ets:delete(Tab), + 3 = fun_refc(F1), + 10 = F3(-23), + true = erlang:garbage_collect(), + 2 = fun_refc(F1), ok. refc_ets_bag(F1, Options) -> - ?line io:format("~p", [Options]), - ?line Tab = ets:new(kalle, Options), - ?line true = ets:insert(Tab, {a_key,F1}), - ?line 3 = fun_refc(F1), - ?line [{a_key,F3}] = ets:lookup(Tab, a_key), - ?line 4 = fun_refc(F1), - ?line true = ets:insert(Tab, {a_key,not_a_fun}), - ?line 4 = fun_refc(F1), - ?line true = ets:insert(Tab, {another_key,F1}), - ?line 5 = fun_refc(F1), - ?line true = ets:delete(Tab), - ?line 3 = fun_refc(F1), - ?line 10 = F3(-23), - ?line true = erlang:garbage_collect(), - ?line 2 = fun_refc(F1), + io:format("~p", [Options]), + Tab = ets:new(kalle, Options), + true = ets:insert(Tab, {a_key,F1}), + 3 = fun_refc(F1), + [{a_key,F3}] = ets:lookup(Tab, a_key), + 4 = fun_refc(F1), + true = ets:insert(Tab, {a_key,not_a_fun}), + 4 = fun_refc(F1), + true = ets:insert(Tab, {another_key,F1}), + 5 = fun_refc(F1), + true = ets:delete(Tab), + 3 = fun_refc(F1), + 10 = F3(-23), + true = erlang:garbage_collect(), + 2 = fun_refc(F1), ok. refc_dist(Config) when is_list(Config) -> - ?line {ok,Node} = start_node(fun_SUITE_refc_dist), - ?line process_flag(trap_exit, true), - ?line Pid = spawn_link(Node, - fun() -> receive - Fun when is_function(Fun) -> - 2 = fun_refc(Fun), - exit({normal,Fun}) end - end), - ?line F = fun() -> 42 end, - ?line 2 = fun_refc(F), - ?line Pid ! F, + {ok,Node} = start_node(fun_SUITE_refc_dist), + process_flag(trap_exit, true), + Pid = spawn_link(Node, fun() -> receive + Fun when is_function(Fun) -> + 2 = fun_refc(Fun), + exit({normal,Fun}) end + end), + F = fun() -> 42 end, + 2 = fun_refc(F), + Pid ! F, F2 = receive {'EXIT',Pid,{normal,Fun}} -> Fun; - Other -> ?line ?t:fail({unexpected,Other}) + Other -> ct:fail({unexpected,Other}) end, %% dist.c:net_mess2 have a reference to Fun for a while since %% Fun is passed in an exit signal. Wait until it is gone. - ?line wait_until(fun () -> 4 =/= fun_refc(F2) end), - ?line 3 = fun_refc(F2), - ?line true = erlang:garbage_collect(), - ?line 2 = fun_refc(F), + wait_until(fun () -> 4 =/= fun_refc(F2) end), + 3 = fun_refc(F2), + true = erlang:garbage_collect(), + 2 = fun_refc(F), refc_dist_send(Node, F). refc_dist_send(Node, F) -> - ?line Pid = spawn_link(Node, - fun() -> receive - {To,Fun} when is_function(Fun) -> - wait_until(fun () -> - 2 =:= fun_refc(Fun) - end), - To ! Fun - end - end), - ?line 2 = fun_refc(F), + Pid = spawn_link(Node, fun() -> receive + {To,Fun} when is_function(Fun) -> + wait_until(fun () -> + 2 =:= fun_refc(Fun) + end), + To ! Fun + end + end), + 2 = fun_refc(F), Pid ! {self(),F}, F2 = receive Fun when is_function(Fun) -> Fun; - Other -> ?line ?t:fail({unexpected,Other}) + Other -> ct:fail({unexpected,Other}) end, receive {'EXIT',Pid,normal} -> ok end, %% No reference from dist.c:net_mess2 since Fun is passed %% in an ordinary message. - ?line 3 = fun_refc(F), - ?line 3 = fun_refc(F2), + 3 = fun_refc(F), + 3 = fun_refc(F2), refc_dist_reg_send(Node, F). refc_dist_reg_send(Node, F) -> - ?line true = erlang:garbage_collect(), - ?line 2 = fun_refc(F), - ?line Ref = make_ref(), - ?line Me = self(), - ?line Pid = spawn_link(Node, - fun() -> - true = register(my_fun_tester, self()), - Me ! Ref, - receive - {Me,Fun} when is_function(Fun) -> - 2 = fun_refc(Fun), - Me ! Fun - end - end), + true = erlang:garbage_collect(), + 2 = fun_refc(F), + Ref = make_ref(), + Me = self(), + Pid = spawn_link(Node, fun() -> + true = register(my_fun_tester, self()), + Me ! Ref, + receive + {Me,Fun} when is_function(Fun) -> + 2 = fun_refc(Fun), + Me ! Fun + end + end), erlang:yield(), - ?line 2 = fun_refc(F), + 2 = fun_refc(F), receive Ref -> ok end, {my_fun_tester,Node} ! {self(),F}, F2 = receive Fun when is_function(Fun) -> Fun; - Other -> ?line ?t:fail({unexpected,Other}) + Other -> ct:fail({unexpected,Other}) end, receive {'EXIT',Pid,normal} -> ok end, - ?line 3 = fun_refc(F), - ?line 3 = fun_refc(F2), + 3 = fun_refc(F), + 3 = fun_refc(F2), ok. fun_refc(F) -> @@ -702,67 +664,67 @@ fun_refc(F) -> Count. const_propagation(Config) when is_list(Config) -> - ?line Fun1 = fun start_node/1, - ?line 2 = fun_refc(Fun1), - ?line Fun2 = Fun1, - ?line my_cmp({Fun1,Fun2}), - - ?line Fun3 = fun() -> ok end, - ?line 2 = fun_refc(Fun3), - ?line Fun4 = Fun3, - ?line my_cmp({Fun3,Fun4}), + Fun1 = fun start_node/1, + 2 = fun_refc(Fun1), + Fun2 = Fun1, + my_cmp({Fun1,Fun2}), + + Fun3 = fun() -> ok end, + 2 = fun_refc(Fun3), + Fun4 = Fun3, + my_cmp({Fun3,Fun4}), ok. my_cmp({Fun,Fun}) -> ok; my_cmp({Fun1,Fun2}) -> io:format("Fun1: ~p", [erlang:fun_info(Fun1)]), io:format("Fun2: ~p", [erlang:fun_info(Fun2)]), - ?t:fail(). + ct:fail(no_match). t_arity(Config) when is_list(Config) -> - ?line 0 = fun_arity(fun() -> ok end), - ?line 0 = fun_arity(fun() -> Config end), - ?line 1 = fun_arity(fun(X) -> X+1 end), - ?line 1 = fun_arity(fun(X) -> Config =:= X end), + 0 = fun_arity(fun() -> ok end), + 0 = fun_arity(fun() -> Config end), + 1 = fun_arity(fun(X) -> X+1 end), + 1 = fun_arity(fun(X) -> Config =:= X end), A = id(42), %% Test that the arity is transferred properly. - ?line process_flag(trap_exit, true), - ?line {ok,Node} = start_node(fun_test_arity), - ?line hello_world = spawn_call(Node, fun() -> hello_world end), - ?line 0 = spawn_call(Node, fun(X) -> X end), - ?line 42 = spawn_call(Node, fun(_X) -> A end), - ?line 43 = spawn_call(Node, fun(X, Y) -> A+X+Y end), - ?line 1 = spawn_call(Node, fun(X, Y) -> X+Y end), - ?line 45 = spawn_call(Node, fun(X, Y, Z) -> A+X+Y+Z end), + process_flag(trap_exit, true), + {ok,Node} = start_node(fun_test_arity), + hello_world = spawn_call(Node, fun() -> hello_world end), + 0 = spawn_call(Node, fun(X) -> X end), + 42 = spawn_call(Node, fun(_X) -> A end), + 43 = spawn_call(Node, fun(X, Y) -> A+X+Y end), + 1 = spawn_call(Node, fun(X, Y) -> X+Y end), + 45 = spawn_call(Node, fun(X, Y, Z) -> A+X+Y+Z end), ok. t_is_function2(Config) when is_list(Config) -> false = is_function(id({a,b}), 0), false = is_function(id({a,b}), 234343434333433433), - ?line true = is_function(fun() -> ok end, 0), - ?line true = is_function(fun(_) -> ok end, 1), - ?line false = is_function(fun(_) -> ok end, 0), + true = is_function(fun() -> ok end, 0), + true = is_function(fun(_) -> ok end, 1), + false = is_function(fun(_) -> ok end, 0), - ?line true = is_function(fun erlang:abs/1, 1), - ?line true = is_function(fun erlang:abs/99, 99), - ?line false = is_function(fun erlang:abs/1, 0), - ?line false = is_function(fun erlang:abs/99, 0), + true = is_function(fun erlang:abs/1, 1), + true = is_function(fun erlang:abs/99, 99), + false = is_function(fun erlang:abs/1, 0), + false = is_function(fun erlang:abs/99, 0), - ?line false = is_function(id(self()), 0), - ?line false = is_function(id({a,b,c}), 0), - ?line false = is_function(id({a}), 0), - ?line false = is_function(id([a,b,c]), 0), + false = is_function(id(self()), 0), + false = is_function(id({a,b,c}), 0), + false = is_function(id({a}), 0), + false = is_function(id([a,b,c]), 0), %% Bad arity argument. - ?line bad_arity(a), - ?line bad_arity(-1), - ?line bad_arity(-9738974938734938793873498378), - ?line bad_arity([]), - ?line bad_arity(fun() -> ok end), - ?line bad_arity({}), - ?line bad_arity({a,b}), - ?line bad_arity(self()), + bad_arity(a), + bad_arity(-1), + bad_arity(-9738974938734938793873498378), + bad_arity([]), + bad_arity(fun() -> ok end), + bad_arity({}), + bad_arity({a,b}), + bad_arity(self()), ok. bad_arity(A) -> @@ -771,59 +733,57 @@ bad_arity(A) -> ok. t_fun_info(Config) when is_list(Config) -> - ?line F = fun t_fun_info/1, - ?line try F(blurf) of + F = fun t_fun_info/1, + try F(blurf) of FAny -> - io:format("should fail; returned ~p\n", [FAny]), - ?line ?t:fail() + ct:fail("should fail; returned ~p\n", [FAny]) catch error:function_clause -> ok end, - ?line {module,?MODULE} = erlang:fun_info(F, module), - ?line case erlang:fun_info(F, name) of + {module,?MODULE} = erlang:fun_info(F, module), + case erlang:fun_info(F, name) of undefined -> - ?line ?t:fail(); + ct:fail(no_fun_info); _ -> ok end, - ?line {arity,1} = erlang:fun_info(F, arity), - ?line {env,[]} = erlang:fun_info(F, env), - ?line verify_not_undef(F, index), - ?line verify_not_undef(F, uniq), - ?line verify_not_undef(F, new_index), - ?line verify_not_undef(F, new_uniq), - ?line verify_not_undef(F, refc), - ?line {'EXIT',_} = (catch erlang:fun_info(F, blurf)), + {arity,1} = erlang:fun_info(F, arity), + {env,[]} = erlang:fun_info(F, env), + verify_not_undef(F, index), + verify_not_undef(F, uniq), + verify_not_undef(F, new_index), + verify_not_undef(F, new_uniq), + verify_not_undef(F, refc), + {'EXIT',_} = (catch erlang:fun_info(F, blurf)), %% Module fun. - ?line FF = fun ?MODULE:t_fun_info/1, - ?line try FF(blurf) of + FF = fun ?MODULE:t_fun_info/1, + try FF(blurf) of FFAny -> - io:format("should fail; returned ~p\n", [FFAny]), - ?line ?t:fail() + ct:fail("should fail; returned ~p\n", [FFAny]) catch error:function_clause -> ok end, - ?line {module,?MODULE} = erlang:fun_info(FF, module), - ?line {name,t_fun_info} = erlang:fun_info(FF, name), - ?line {arity,1} = erlang:fun_info(FF, arity), - ?line {env,[]} = erlang:fun_info(FF, env), - ?line verify_undef(FF, index), - ?line verify_undef(FF, uniq), - ?line verify_undef(FF, new_index), - ?line verify_undef(FF, new_uniq), - ?line verify_undef(FF, refc), - ?line {'EXIT',_} = (catch erlang:fun_info(FF, blurf)), + {module,?MODULE} = erlang:fun_info(FF, module), + {name,t_fun_info} = erlang:fun_info(FF, name), + {arity,1} = erlang:fun_info(FF, arity), + {env,[]} = erlang:fun_info(FF, env), + verify_undef(FF, index), + verify_undef(FF, uniq), + verify_undef(FF, new_index), + verify_undef(FF, new_uniq), + verify_undef(FF, refc), + {'EXIT',_} = (catch erlang:fun_info(FF, blurf)), %% Not fun. - ?line bad_info(abc), - ?line bad_info(42), - ?line bad_info({fun erlang:list_to_integer/1}), - ?line bad_info([42]), - ?line bad_info([]), - ?line bad_info(self()), - ?line bad_info(<<>>), - ?line bad_info(<<1,2>>), + bad_info(abc), + bad_info(42), + bad_info({fun erlang:list_to_integer/1}), + bad_info([42]), + bad_info([]), + bad_info(self()), + bad_info(<<>>), + bad_info(<<1,2>>), ok. t_fun_info_mfa(Config) when is_list(Config) -> @@ -847,8 +807,7 @@ t_fun_info_mfa(Config) when is_list(Config) -> bad_info(Term) -> try erlang:fun_info(Term, module) of Any -> - io:format("should fail; returned ~p\n", [Any]), - ?t:fail() + ict:fail("should fail; returned ~p\n", [Any]) catch error:badarg -> ok end. @@ -859,7 +818,7 @@ verify_undef(Fun, Tag) -> verify_not_undef(Fun, Tag) -> case erlang:fun_info(Fun, Tag) of {Tag,undefined} -> - ?t:fail(); + ct:fail("tag ~w not defined in fun_info", [Tag]); {Tag,_} -> ok end. @@ -884,15 +843,15 @@ spawn_call(Node, AFun) -> Pid ! {AFun,AFun,AFun}, Res = receive {result,R} -> R; - Other -> ?t:fail({bad_message,Other}) + Other -> ct:fail({bad_message,Other}) after 10000 -> - ?t:fail(timeout_waiting_for_result) + ct:fail(timeout_waiting_for_result) end, receive {'EXIT',Pid,normal} -> ok; - Other2 -> ?t:fail({bad_message_waiting_for_exit,Other2}) + Other2 -> ct:fail({bad_message_waiting_for_exit,Other2}) after 10000 -> - ?t:fail(timeout_waiting_for_exit) + ct:fail(timeout_waiting_for_exit) end, Res. @@ -911,6 +870,3 @@ wait_until(Fun) -> true -> ok; _ -> receive after 100 -> wait_until(Fun) end end. - -% stop_node(Node) -> -% test_server:stop_node(Node). diff --git a/erts/emulator/test/fun_r13_SUITE.erl b/erts/emulator/test/fun_r13_SUITE.erl index 7ab5e65cb3..a45ed08b9d 100644 --- a/erts/emulator/test/fun_r13_SUITE.erl +++ b/erts/emulator/test/fun_r13_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,77 +21,53 @@ -module(fun_r13_SUITE). -compile(r13). --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,dist_old_release/1]). +-export([all/0, suite/0, + dist_old_release/1]). --define(default_timeout, ?t:minutes(1)). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [dist_old_release]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(_Case, Config) -> - ?line Dog = test_server:timetrap(?default_timeout), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. - dist_old_release(Config) when is_list(Config) -> - case ?t:is_release_available("r12b") of - true -> do_dist_old(Config); - false -> {skip,"No R12B found"} + case test_server:is_release_available("r12b") of + true -> do_dist_old(Config); + false -> {skip,"No R12B found"} end. do_dist_old(Config) when is_list(Config) -> - ?line Pa = filename:dirname(code:which(?MODULE)), + Pa = filename:dirname(code:which(?MODULE)), Name = fun_dist_r12, - ?line {ok,Node} = ?t:start_node(Name, peer, - [{args,"-pa "++Pa}, - {erl,[{release,"r12b"}]}]), - - ?line Pid = spawn_link(Node, - fun() -> - receive - Fun when is_function(Fun) -> - R12BFun = fun(H) -> cons(H, [b,c]) end, - Fun(Fun, R12BFun) - end - end), + {ok,Node} = test_server:start_node(Name, peer, + [{args,"-pa "++Pa}, + {erl,[{release,"r12b"}]}]), + + Pid = spawn_link(Node, + fun() -> + receive + Fun when is_function(Fun) -> + R12BFun = fun(H) -> cons(H, [b,c]) end, + Fun(Fun, R12BFun) + end + end), Self = self(), Fun = fun(F, R12BFun) -> - {pid,Self} = erlang:fun_info(F, pid), - {module,?MODULE} = erlang:fun_info(F, module), - Self ! {ok,F,R12BFun} - end, - ?line Pid ! Fun, - ?line receive - {ok,Fun,R12BFun} -> - ?line [a,b,c] = R12BFun(a); - Other -> - ?line ?t:fail({bad_message,Other}) - end, + {pid,Self} = erlang:fun_info(F, pid), + {module,?MODULE} = erlang:fun_info(F, module), + Self ! {ok,F,R12BFun} + end, + Pid ! Fun, + receive + {ok,Fun,R12BFun} -> + [a,b,c] = R12BFun(a); + Other -> + ct:fail({bad_message,Other}) + end, + true = test_server:stop_node(Node), ok. cons(H, T) -> diff --git a/erts/emulator/test/gc_SUITE.erl b/erts/emulator/test/gc_SUITE.erl index 1e155e7b09..79c229a34d 100644 --- a/erts/emulator/test/gc_SUITE.erl +++ b/erts/emulator/test/gc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,45 +22,27 @@ -module(gc_SUITE). --include_lib("test_server/include/test_server.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). - --define(default_timeout, ?t:minutes(10)). +-include_lib("common_test/include/ct.hrl"). +-export([all/0, suite/0]). -export([grow_heap/1, grow_stack/1, grow_stack_heap/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}]. all() -> [grow_heap, grow_stack, grow_stack_heap]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -grow_heap(doc) -> ["Produce a growing list of elements, ", - "for X calls, then drop one item per call", - "until the list is empty."]; +%% Produce a growing list of elements, +%% for X calls, then drop one item per call +%% until the list is empty. grow_heap(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:minutes(40)), + ct:timetrap({minutes, 40}), ok = grow_heap1(256), ok = grow_heap1(512), ok = grow_heap1(1024), ok = grow_heap1(2048), - test_server:timetrap_cancel(Dog), ok. grow_heap1(Len) -> @@ -86,14 +68,13 @@ grow_heap1([_|List], MaxLen, CurLen, down) -> -grow_stack(doc) -> ["Increase and decrease stack size, and ", - "drop off some garbage from time to time."]; +%% Increase and decrease stack size, and +%% drop off some garbage from time to time. grow_stack(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:minutes(80)), + ct:timetrap({minutes, 80}), show_heap("before:"), grow_stack1(200, 0), show_heap("after:"), - test_server:timetrap_cancel(Dog), ok. grow_stack1(0, _) -> @@ -110,14 +91,12 @@ grow_stack1(Recs, CurRecs) -> %% Let's see how BEAM handles this one... -grow_stack_heap(doc) -> ["While growing the heap, bounces the size ", - "of the stack, and while reducing the heap", - "bounces the stack usage."]; +%% While growing the heap, bounces the size of the +%% stack, and while reducing the heap, bounces the stack usage. grow_stack_heap(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:minutes(40)), + ct:timetrap({minutes, 40}), grow_stack_heap1(16), grow_stack_heap1(32), - test_server:timetrap_cancel(Dog), ok. grow_stack_heap1(MaxLen) -> diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl index b3a85c6423..e155e5f49f 100644 --- a/erts/emulator/test/guard_SUITE.erl +++ b/erts/emulator/test/guard_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,12 +20,12 @@ -module(guard_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, bad_arith/1, bad_tuple/1, +-export([all/0, suite/0, + bad_arith/1, bad_tuple/1, test_heap_guards/1, guard_bifs/1, type_tests/1,guard_bif_binary_part/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init/3]). -import(lists, [member/2]). @@ -36,27 +36,12 @@ all() -> [bad_arith, bad_tuple, test_heap_guards, guard_bifs, type_tests, guard_bif_binary_part]. -groups() -> - []. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -bad_arith(doc) -> "Test that a bad arithmetic operation in a guard works correctly."; +%% Test that a bad arithmetic operation in a guard works correctly. bad_arith(Config) when is_list(Config) -> - ?line 5 = bad_arith1(2, 3), - ?line 10 = bad_arith1(1, infinity), - ?line 10 = bad_arith1(infinity, 1), + 5 = bad_arith1(2, 3), + 10 = bad_arith1(1, infinity), + 10 = bad_arith1(infinity, 1), ok. bad_arith1(T1, T2) when T1+T2 < 10 -> @@ -64,12 +49,12 @@ bad_arith1(T1, T2) when T1+T2 < 10 -> bad_arith1(_, _) -> 10. -bad_tuple(doc) -> "Test that bad arguments to element/2 are handled correctly."; +%% Test that bad arguments to element/2 are handled correctly. bad_tuple(Config) when is_list(Config) -> - ?line error = bad_tuple1(a), - ?line error = bad_tuple1({a, b}), - ?line x = bad_tuple1({x, b}), - ?line y = bad_tuple1({a, b, y}), + error = bad_tuple1(a), + error = bad_tuple1({a, b}), + x = bad_tuple1({x, b}), + y = bad_tuple1({a, b, y}), ok. bad_tuple1(T) when element(1, T) == x -> @@ -79,26 +64,25 @@ bad_tuple1(T) when element(3, T) == y -> bad_tuple1(_) -> error. -test_heap_guards(doc) -> ""; test_heap_guards(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(2)), + ct:timetrap({minutes, 2}), - ?line process_flag(trap_exit, true), - ?line Tuple = {a, tuple, is, built, here, xxx}, - ?line List = [a, list, is, built, here], + process_flag(trap_exit, true), + Tuple = {a, tuple, is, built, here, xxx}, + List = [a, list, is, built, here], - ?line 'try'(fun a_case/1, [Tuple], [Tuple]), - ?line 'try'(fun a_case/1, [List], [List, List]), - ?line 'try'(fun a_case/1, [a], [a]), + 'try'(fun a_case/1, [Tuple], [Tuple]), + 'try'(fun a_case/1, [List], [List, List]), + 'try'(fun a_case/1, [a], [a]), - ?line 'try'(fun an_if/1, [Tuple], [Tuple]), - ?line 'try'(fun an_if/1, [List], [List, List]), - ?line 'try'(fun an_if/1, [a], [a]), + 'try'(fun an_if/1, [Tuple], [Tuple]), + 'try'(fun an_if/1, [List], [List, List]), + 'try'(fun an_if/1, [a], [a]), - ?line 'try'(fun receive_test/1, [Tuple], [Tuple]), - ?line 'try'(fun receive_test/1, [List], [List, List]), - ?line 'try'(fun receive_test/1, [a], [a]), - ?line test_server:timetrap_cancel(Dog). + 'try'(fun receive_test/1, [Tuple], [Tuple]), + 'try'(fun receive_test/1, [List], [List, List]), + 'try'(fun receive_test/1, [a], [a]), + ok. a_case(V) -> case V of @@ -143,12 +127,11 @@ a_receive() -> Pid = spawn_link(?MODULE, init, [Fun,Args,list_to_tuple(Filler)]), receive {'EXIT', Pid, {result, Result}} -> - ?line 'try'(Iter-1, Fun, Args, Result, [0|Filler]); + 'try'(Iter-1, Fun, Args, Result, [0|Filler]); {result, Other} -> - ?line io:format("Expected ~p; got ~p~n", [Result, Other]), - ?line test_server:fail(); + ct:fail("Expected ~p; got ~p~n", [Result, Other]); Other -> - ?line test_server:fail({unexpected_message, Other}) + ct:fail({unexpected_message, Other}) end. init(Fun, Args, Filler) -> @@ -165,15 +148,14 @@ mask_error({'EXIT',{Err,_}}) -> mask_error(Else) -> Else. -guard_bif_binary_part(doc) -> - ["Test the binary_part/2,3 guard BIF's extensively"]; +%% Test the binary_part/2,3 guard BIF's extensively guard_bif_binary_part(Config) when is_list(Config) -> %% Overflow tests that need to be unoptimized - ?line badarg = + badarg = ?MASK_ERROR( binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, -16#7FFFFFFFFFFFFFFF-1})), - ?line badarg = + badarg = ?MASK_ERROR( binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, 16#7FFFFFFFFFFFFFFF})), @@ -198,66 +180,66 @@ guard_bif_binary_part(Config) when is_list(Config) -> do_binary_part_guard() -> - ?line 1 = bptest(<<1,2,3>>), - ?line 2 = bptest(<<2,1,3>>), - ?line error = bptest(<<1>>), - ?line error = bptest(<<>>), - ?line error = bptest(apa), - ?line 3 = bptest(<<2,3,3>>), + 1 = bptest(<<1,2,3>>), + 2 = bptest(<<2,1,3>>), + error = bptest(<<1>>), + error = bptest(<<>>), + error = bptest(apa), + 3 = bptest(<<2,3,3>>), % With one variable (pos) - ?line 1 = bptest(<<1,2,3>>,1), - ?line 2 = bptest(<<2,1,3>>,1), - ?line error = bptest(<<1>>,1), - ?line error = bptest(<<>>,1), - ?line error = bptest(apa,1), - ?line 3 = bptest(<<2,3,3>>,1), + 1 = bptest(<<1,2,3>>,1), + 2 = bptest(<<2,1,3>>,1), + error = bptest(<<1>>,1), + error = bptest(<<>>,1), + error = bptest(apa,1), + 3 = bptest(<<2,3,3>>,1), % With one variable (length) - ?line 1 = bptesty(<<1,2,3>>,1), - ?line 2 = bptesty(<<2,1,3>>,1), - ?line error = bptesty(<<1>>,1), - ?line error = bptesty(<<>>,1), - ?line error = bptesty(apa,1), - ?line 3 = bptesty(<<2,3,3>>,2), + 1 = bptesty(<<1,2,3>>,1), + 2 = bptesty(<<2,1,3>>,1), + error = bptesty(<<1>>,1), + error = bptesty(<<>>,1), + error = bptesty(apa,1), + 3 = bptesty(<<2,3,3>>,2), % With one variable (whole tuple) - ?line 1 = bptestx(<<1,2,3>>,{1,1}), - ?line 2 = bptestx(<<2,1,3>>,{1,1}), - ?line error = bptestx(<<1>>,{1,1}), - ?line error = bptestx(<<>>,{1,1}), - ?line error = bptestx(apa,{1,1}), - ?line 3 = bptestx(<<2,3,3>>,{1,2}), + 1 = bptestx(<<1,2,3>>,{1,1}), + 2 = bptestx(<<2,1,3>>,{1,1}), + error = bptestx(<<1>>,{1,1}), + error = bptestx(<<>>,{1,1}), + error = bptestx(apa,{1,1}), + 3 = bptestx(<<2,3,3>>,{1,2}), % With two variables - ?line 1 = bptest(<<1,2,3>>,1,1), - ?line 2 = bptest(<<2,1,3>>,1,1), - ?line error = bptest(<<1>>,1,1), - ?line error = bptest(<<>>,1,1), - ?line error = bptest(apa,1,1), - ?line 3 = bptest(<<2,3,3>>,1,2), + 1 = bptest(<<1,2,3>>,1,1), + 2 = bptest(<<2,1,3>>,1,1), + error = bptest(<<1>>,1,1), + error = bptest(<<>>,1,1), + error = bptest(apa,1,1), + 3 = bptest(<<2,3,3>>,1,2), % Direct (autoimported) call, these will be evaluated by the compiler... - ?line <<2>> = binary_part(<<1,2,3>>,1,1), - ?line <<1>> = binary_part(<<2,1,3>>,1,1), + <<2>> = binary_part(<<1,2,3>>,1,1), + <<1>> = binary_part(<<2,1,3>>,1,1), % Compiler warnings due to constant evaluation expected (3) - ?line badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)), - ?line badarg = ?MASK_ERROR(binary_part(<<>>,1,1)), - ?line badarg = ?MASK_ERROR(binary_part(apa,1,1)), - ?line <<3,3>> = binary_part(<<2,3,3>>,1,2), + badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)), + badarg = ?MASK_ERROR(binary_part(<<>>,1,1)), + badarg = ?MASK_ERROR(binary_part(apa,1,1)), + <<3,3>> = binary_part(<<2,3,3>>,1,2), % Direct call through apply - ?line <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]), - ?line <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]), + <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]), + <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]), % Compiler warnings due to constant evaluation expected (3) - ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])), - ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])), - ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])), - ?line <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]), + badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])), + badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])), + badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])), + <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]), % Constant propagation - ?line Bin = <<1,2,3>>, - ?line ok = if + Bin = <<1,2,3>>, + ok = if binary_part(Bin,1,1) =:= <<2>> -> ok; %% Compiler warning, clause cannot match (expected) true -> error end, - ?line ok = if + ok = if binary_part(Bin,{1,1}) =:= <<2>> -> ok; %% Compiler warning, clause cannot match (expected) @@ -323,91 +305,91 @@ bptest(_,_,_) -> error. -guard_bifs(doc) -> "Test all guard bifs with nasty (but legal arguments)."; +%% Test all guard bifs with nasty (but legal arguments). guard_bifs(Config) when is_list(Config) -> - ?line Big = -237849247829874297658726487367328971246284736473821617265433, - ?line Float = 387924.874, + Big = -237849247829874297658726487367328971246284736473821617265433, + Float = 387924.874, %% Succeding use of guard bifs. - ?line try_gbif('abs/1', Big, -Big), - ?line try_gbif('float/1', Big, float(Big)), - ?line try_gbif('float/1', Big, float(id(Big))), - ?line try_gbif('trunc/1', Float, 387924.0), - ?line try_gbif('round/1', Float, 387925.0), - ?line try_gbif('length/1', [], 0), + try_gbif('abs/1', Big, -Big), + try_gbif('float/1', Big, float(Big)), + try_gbif('float/1', Big, float(id(Big))), + try_gbif('trunc/1', Float, 387924.0), + try_gbif('round/1', Float, 387925.0), + try_gbif('length/1', [], 0), - ?line try_gbif('length/1', [a], 1), - ?line try_gbif('length/1', [a, b], 2), - ?line try_gbif('length/1', lists:seq(0, 31), 32), + try_gbif('length/1', [a], 1), + try_gbif('length/1', [a, b], 2), + try_gbif('length/1', lists:seq(0, 31), 32), - ?line try_gbif('hd/1', [a], a), - ?line try_gbif('hd/1', [a, b], a), + try_gbif('hd/1', [a], a), + try_gbif('hd/1', [a, b], a), - ?line try_gbif('tl/1', [a], []), - ?line try_gbif('tl/1', [a, b], [b]), - ?line try_gbif('tl/1', [a, b, c], [b, c]), + try_gbif('tl/1', [a], []), + try_gbif('tl/1', [a, b], [b]), + try_gbif('tl/1', [a, b, c], [b, c]), - ?line try_gbif('size/1', {}, 0), - ?line try_gbif('size/1', {a}, 1), - ?line try_gbif('size/1', {a, b}, 2), - ?line try_gbif('size/1', {a, b, c}, 3), - ?line try_gbif('size/1', list_to_binary([]), 0), - ?line try_gbif('size/1', list_to_binary([1]), 1), - ?line try_gbif('size/1', list_to_binary([1, 2]), 2), - ?line try_gbif('size/1', list_to_binary([1, 2, 3]), 3), + try_gbif('size/1', {}, 0), + try_gbif('size/1', {a}, 1), + try_gbif('size/1', {a, b}, 2), + try_gbif('size/1', {a, b, c}, 3), + try_gbif('size/1', list_to_binary([]), 0), + try_gbif('size/1', list_to_binary([1]), 1), + try_gbif('size/1', list_to_binary([1, 2]), 2), + try_gbif('size/1', list_to_binary([1, 2, 3]), 3), - ?line try_gbif('bit_size/1', <<0:7>>, 7), + try_gbif('bit_size/1', <<0:7>>, 7), - ?line try_gbif('element/2', {x}, {1, x}), - ?line try_gbif('element/2', {x, y}, {1, x}), - ?line try_gbif('element/2', {x, y}, {2, y}), + try_gbif('element/2', {x}, {1, x}), + try_gbif('element/2', {x, y}, {1, x}), + try_gbif('element/2', {x, y}, {2, y}), - ?line try_gbif('self/0', 0, self()), - ?line try_gbif('node/0', 0, node()), - ?line try_gbif('node/1', self(), node()), + try_gbif('self/0', 0, self()), + try_gbif('node/0', 0, node()), + try_gbif('node/1', self(), node()), %% Failing use of guard bifs. - ?line try_fail_gbif('abs/1', Big, 1), - ?line try_fail_gbif('abs/1', [], 1), + try_fail_gbif('abs/1', Big, 1), + try_fail_gbif('abs/1', [], 1), - ?line try_fail_gbif('float/1', Big, 42), - ?line try_fail_gbif('float/1', [], 42), + try_fail_gbif('float/1', Big, 42), + try_fail_gbif('float/1', [], 42), - ?line try_fail_gbif('trunc/1', Float, 0.0), - ?line try_fail_gbif('trunc/1', [], 0.0), + try_fail_gbif('trunc/1', Float, 0.0), + try_fail_gbif('trunc/1', [], 0.0), - ?line try_fail_gbif('round/1', Float, 1.0), - ?line try_fail_gbif('round/1', [], a), + try_fail_gbif('round/1', Float, 1.0), + try_fail_gbif('round/1', [], a), - ?line try_fail_gbif('length/1', [], 1), - ?line try_fail_gbif('length/1', [a], 0), - ?line try_fail_gbif('length/1', a, 0), - ?line try_fail_gbif('length/1', {a}, 0), + try_fail_gbif('length/1', [], 1), + try_fail_gbif('length/1', [a], 0), + try_fail_gbif('length/1', a, 0), + try_fail_gbif('length/1', {a}, 0), - ?line try_fail_gbif('hd/1', [], 0), - ?line try_fail_gbif('hd/1', [a], x), - ?line try_fail_gbif('hd/1', x, x), + try_fail_gbif('hd/1', [], 0), + try_fail_gbif('hd/1', [a], x), + try_fail_gbif('hd/1', x, x), - ?line try_fail_gbif('tl/1', [], 0), - ?line try_fail_gbif('tl/1', [a], x), - ?line try_fail_gbif('tl/1', x, x), + try_fail_gbif('tl/1', [], 0), + try_fail_gbif('tl/1', [a], x), + try_fail_gbif('tl/1', x, x), - ?line try_fail_gbif('size/1', {}, 1), - ?line try_fail_gbif('size/1', [], 0), - ?line try_fail_gbif('size/1', [a], 1), - ?line try_fail_gbif('size/1', fun() -> 1 end, 0), - ?line try_fail_gbif('size/1', fun() -> 1 end, 1), + try_fail_gbif('size/1', {}, 1), + try_fail_gbif('size/1', [], 0), + try_fail_gbif('size/1', [a], 1), + try_fail_gbif('size/1', fun() -> 1 end, 0), + try_fail_gbif('size/1', fun() -> 1 end, 1), - ?line try_fail_gbif('element/2', {}, {1, x}), - ?line try_fail_gbif('element/2', {x}, {1, y}), - ?line try_fail_gbif('element/2', [], {1, z}), + try_fail_gbif('element/2', {}, {1, x}), + try_fail_gbif('element/2', {x}, {1, y}), + try_fail_gbif('element/2', [], {1, z}), - ?line try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")), - ?line try_fail_gbif('node/0', 0, xxxx), - ?line try_fail_gbif('node/1', self(), xxx), - ?line try_fail_gbif('node/1', yyy, xxx), + try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")), + try_fail_gbif('node/0', 0, xxxx), + try_fail_gbif('node/1', self(), xxx), + try_fail_gbif('node/1', yyy, xxx), ok. try_gbif(Id, X, Y) -> @@ -415,9 +397,7 @@ try_gbif(Id, X, Y) -> {Id, X, Y} -> io:format("guard_bif(~p, ~p, ~p) -- ok", [Id, X, Y]); Other -> - ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", - [Id, X, Y, Other]), - ?line test_server:fail() + ct:fail("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", [Id, X, Y, Other]) end. try_fail_gbif(Id, X, Y) -> @@ -425,9 +405,7 @@ try_fail_gbif(Id, X, Y) -> {'EXIT',{function_clause,[{?MODULE,guard_bif,[Id,X,Y],_}|_]}} -> io:format("guard_bif(~p, ~p, ~p) -- ok", [Id,X,Y]); Other -> - ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", - [Id, X, Y, Other]), - ?line test_server:fail() + ct:fail("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", [Id, X, Y, Other]) end. guard_bif('abs/1', X, Y) when abs(X) == Y -> @@ -457,22 +435,20 @@ guard_bif('node/0', X, Y) when node() == Y -> guard_bif('node/1', X, Y) when node(X) == Y -> {'node/1', X, Y}. -type_tests(doc) -> "Test the type tests."; +%% Test the type tests. type_tests(Config) when is_list(Config) -> - ?line Types = all_types(), - ?line Tests = type_test_desc(), - ?line put(errors, 0), - ?line put(violations, 0), - ?line type_tests(Tests, Types), - ?line case {get(errors), get(violations)} of + Types = all_types(), + Tests = type_test_desc(), + put(errors, 0), + put(violations, 0), + type_tests(Tests, Types), + case {get(errors), get(violations)} of {0, 0} -> ok; {0, N} -> {comment, integer_to_list(N) ++ " standard violation(s)"}; {Errors, Violations} -> - io:format("~p sub test(s) failed, ~p violation(s)", - [Errors, Violations]), - ?line test_server:fail() + ct:fail("~p sub test(s) failed, ~p violation(s)", [Errors, Violations]) end. type_tests([{Test, AllowedTypes}| T], AllTypes) -> @@ -499,7 +475,7 @@ type_tests(Test, [Type|T], Allowed) -> when is_list(Loc) -> ok; {'EXIT',Other} -> - ?line test_server:fail({unexpected_error_reason,Other}); + ct:fail({unexpected_error_reason,Other}); tuple when is_function(Value) -> io:format("Standard violation: Test ~p(~p) should fail", [Test, Value]), diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl index 2ea49467b8..a39d101b0d 100644 --- a/erts/emulator/test/hash_SUITE.erl +++ b/erts/emulator/test/hash_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -50,7 +50,7 @@ -define(config(A,B),config(A,B)). -export([config/2]). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. -ifdef(debug). @@ -70,86 +70,43 @@ config(priv_dir,_) -> ".". -else. %% When run in test server. --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, 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)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. -suite() -> [{ct_hooks,[ts_install_cth]}]. + test_hash_zero/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 10}}]. all() -> [test_basic, test_cmp, test_range, test_spread, test_phash2, otp_5292, bit_level_binaries, otp_7127, - test_hash_zero - ]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - + test_hash_zero]. -test_basic(suite) -> - []; -test_basic(doc) -> - ["Tests basic functionality of erlang:phash and that the " - "hashes has not changed (neither hash nor phash)"]; +%% Tests basic functionality of erlang:phash and that the +%% hashes has not changed (neither hash nor phash) test_basic(Config) when is_list(Config) -> basic_test(). -test_cmp(suite) -> - []; -test_cmp(doc) -> - ["Compares integer hashes made by erlang:phash with those of a reference " - "implementation"]; +%% Compares integer hashes made by erlang:phash with those of a reference implementation test_cmp(Config) when is_list(Config) -> cmp_test(10000). -test_range(suite) -> - []; -test_range(doc) -> - ["Tests ranges on erlang:phash from 1 to 2^32"]; +%% Tests ranges on erlang:phash from 1 to 2^32 test_range(Config) when is_list(Config) -> range_test(). -test_spread(suite) -> - []; -test_spread(doc) -> - ["Tests that the hashes are spread ok"]; +%% Tests that the hashes are spread ok test_spread(Config) when is_list(Config) -> spread_test(10). -test_phash2(suite) -> - []; -test_phash2(doc) -> - ["Tests phash2"]; +%% Tests phash2 test_phash2(Config) when is_list(Config) -> phash2_test(). -otp_5292(suite) -> - []; -otp_5292(doc) -> - ["Tests hash, phash and phash2 regarding integers."]; +%% Tests hash, phash and phash2 regarding integers. otp_5292(Config) when is_list(Config) -> otp_5292_test(). @@ -157,10 +114,7 @@ otp_5292(Config) when is_list(Config) -> bit_level_binaries(Config) when is_list(Config) -> bit_level_binaries_do(). -otp_7127(suite) -> - []; -otp_7127(doc) -> - ["Tests phash2/1."]; +%% Tests phash2/1. otp_7127(Config) when is_list(Config) -> otp_7127_test(). @@ -223,11 +177,10 @@ basic_test() -> range_test() -> - random:seed(), F = fun(From,From,_FF) -> ok; (From,To,FF) -> - R = random:uniform(16#FFFFFFFFFFFFFFFF), + R = rand:uniform(16#FFFFFFFFFFFFFFFF), X = erlang:phash(R, From), Y = erlang:phash(R, 16#100000000) - 1, Z = (Y rem From) + 1, @@ -265,14 +218,13 @@ spread_test(N) -> cmp_test(N) -> - % No need to save seed, the error indicates what number caused it. - random:seed(), do_cmp_hashes(N,8). + do_cmp_hashes(0,_) -> ok; do_cmp_hashes(N,Steps) -> - R0 = random:uniform(1 bsl Steps - 1) + random:uniform(16#FFFFFFFF), - R = case random:uniform(2) of + R0 = rand:uniform(1 bsl Steps - 1) + rand:uniform(16#FFFFFFFF), + R = case rand:uniform(2) of 1 -> R0; _ -> diff --git a/erts/emulator/test/hibernate_SUITE.erl b/erts/emulator/test/hibernate_SUITE.erl index 4ac8c272db..6f8ce02266 100644 --- a/erts/emulator/test/hibernate_SUITE.erl +++ b/erts/emulator/test/hibernate_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,47 +20,25 @@ -module(hibernate_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --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([all/0, suite/0, basic/1,dynamic_call/1,min_heap_size/1,bad_args/1, - messages_in_queue/1,undefined_mfa/1,no_heap/1,wake_up_and_bif_trap/1]). + messages_in_queue/1,undefined_mfa/1,no_heap/1, + wake_up_and_bif_trap/1]). %% Used by test cases. --export([basic_hibernator/1,dynamic_call_hibernator/2,messages_in_queue_restart/2, no_heap_loop/0,characters_to_list_trap/1]). +-export([basic_hibernator/1,dynamic_call_hibernator/2,messages_in_queue_restart/2, + no_heap_loop/0,characters_to_list_trap/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> [basic, dynamic_call, min_heap_size, bad_args, messages_in_queue, undefined_mfa, no_heap, wake_up_and_bif_trap]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(3)), - [{watchdog,Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - %%% %%% Testing the basic functionality of erlang:hibernate/3. %%% @@ -69,9 +47,9 @@ basic(Config) when is_list(Config) -> Ref = make_ref(), Info = {self(),Ref}, ExpectedHeapSz = erts_debug:size([Info]), - ?line Child = spawn_link(fun() -> basic_hibernator(Info) end), - ?line hibernate_wake_up(100, ExpectedHeapSz, Child), - ?line Child ! please_quit_now, + Child = spawn_link(fun() -> basic_hibernator(Info) end), + hibernate_wake_up(100, ExpectedHeapSz, Child), + Child ! please_quit_now, ok. hibernate_wake_up(0, _, _) -> ok; @@ -85,35 +63,35 @@ hibernate_wake_up(N, ExpectedHeapSz, Child) -> end; 1 -> ok end, - ?line Child ! {hibernate,self()}, - ?line wait_until(fun () -> + Child ! {hibernate,self()}, + wait_until(fun () -> {current_function,{erlang,hibernate,3}} == process_info(Child, current_function) end), - ?line {message_queue_len,0} = process_info(Child, message_queue_len), - ?line {status,waiting} = process_info(Child, status), - ?line {heap_size,ExpectedHeapSz} = process_info(Child, heap_size), + {message_queue_len,0} = process_info(Child, message_queue_len), + {status,waiting} = process_info(Child, status), + {heap_size,ExpectedHeapSz} = process_info(Child, heap_size), io:format("Before hibernation: ~p After hibernation: ~p\n", [Before,ExpectedHeapSz]), - ?line Child ! {whats_up,self()}, - ?line receive - {all_fine,X,Child,_Ref} -> - if - N =:= 1 -> io:format("~p\n", [X]); - true -> ok - end, - {backtrace,Bin} = process_info(Child, backtrace), - if - size(Bin) > 1000 -> - io:format("~s\n", [binary_to_list(Bin)]), - ?line ?t:fail(stack_is_growing); - true -> - hibernate_wake_up(N-1, ExpectedHeapSz, Child) - end; - Other -> - ?line io:format("~p\n", [Other]), - ?line ?t:fail(unexpected_message) - end. + Child ! {whats_up,self()}, + receive + {all_fine,X,Child,_Ref} -> + if + N =:= 1 -> io:format("~p\n", [X]); + true -> ok + end, + {backtrace,Bin} = process_info(Child, backtrace), + if + size(Bin) > 1000 -> + io:format("~s\n", [binary_to_list(Bin)]), + ct:fail(stack_is_growing); + true -> + hibernate_wake_up(N-1, ExpectedHeapSz, Child) + end; + Other -> + io:format("~p\n", [Other]), + ct:fail(unexpected_message) + end. basic_hibernator(Info) -> {catchlevel,0} = process_info(self(), catchlevel), @@ -165,9 +143,9 @@ dynamic_call(Config) when is_list(Config) -> Ref = make_ref(), Info = {self(),Ref}, ExpectedHeapSz = erts_debug:size([Info]), - ?line Child = spawn_link(fun() -> ?MODULE:dynamic_call_hibernator(Info, hibernate) end), - ?line hibernate_wake_up(100, ExpectedHeapSz, Child), - ?line Child ! please_quit_now, + Child = spawn_link(fun() -> ?MODULE:dynamic_call_hibernator(Info, hibernate) end), + hibernate_wake_up(100, ExpectedHeapSz, Child), + Child ! please_quit_now, ok. dynamic_call_hibernator(Info, Function) -> @@ -195,34 +173,32 @@ min_heap_size(Config) when is_list(Config) -> end. min_heap_size_1(Config) when is_list(Config) -> - ?line erlang:trace(new, true, [call]), + erlang:trace(new, true, [call]), MFA = {?MODULE,min_hibernator,1}, - ?line 1 = erlang:trace_pattern(MFA, true, [local]), + 1 = erlang:trace_pattern(MFA, true, [local]), Ref = make_ref(), Info = {self(),Ref}, - ?line Child = spawn_opt(fun() -> min_hibernator(Info) end, + Child = spawn_opt(fun() -> min_hibernator(Info) end, [{min_heap_size,15000},link]), receive - {trace,Child,call,{?MODULE,min_hibernator,_}} -> - ?line 1 = erlang:trace_pattern(MFA, false, [local]), - ?line erlang:trace(new, false, [call]) + {trace,Child,call,{?MODULE,min_hibernator,_}} -> + 1 = erlang:trace_pattern(MFA, false, [local]), + erlang:trace(new, false, [call]) end, {heap_size,HeapSz} = process_info(Child, heap_size), io:format("Heap size: ~p\n", [HeapSz]), - ?line if - HeapSz < 20 -> ok - end, - ?line Child ! wake_up, + if + HeapSz < 20 -> ok + end, + Child ! wake_up, receive {heap_size,AfterSize} -> io:format("Heap size after wakeup: ~p\n", [AfterSize]), - ?line - if - AfterSize >= 15000 -> ok - end; + if + AfterSize >= 15000 -> ok + end; Other -> - io:format("Unexpected: ~p\n", [Other]), - ?line ?t:fail() + ct:fail("Unexpected: ~p\n", [Other]) end. min_hibernator({Parent,_Ref}) -> @@ -239,23 +215,23 @@ min_hibernator_recv(Parent) -> %%% bad_args(Config) when is_list(Config) -> - ?line bad_args(?MODULE, {name,glurf}, [0]), - ?line {'EXIT',{system_limit,_}} = + bad_args(?MODULE, {name,glurf}, [0]), + {'EXIT',{system_limit,_}} = (catch erlang:hibernate(x, y, lists:duplicate(5122, xxx))), - ?line bad_args(42, name, [0]), - ?line bad_args(xx, 42, [1]), - ?line bad_args(xx, 42, glurf), - ?line bad_args(xx, 42, {}), - ?line bad_args({}, name, [2]), - ?line bad_args({1}, name, [3]), - ?line bad_args({1,2,3}, name, [4]), - ?line bad_args({1,2,3}, name, [5]), - ?line bad_args({1,2,3,4}, name, [6]), - ?line bad_args({1,2,3,4,5,6}, name,[7]), - ?line bad_args({1,2,3,4,5}, name, [8]), - ?line bad_args({1,2}, name, [9]), - ?line bad_args([1,2], name, [9]), - ?line bad_args(55.0, name, [9]), + bad_args(42, name, [0]), + bad_args(xx, 42, [1]), + bad_args(xx, 42, glurf), + bad_args(xx, 42, {}), + bad_args({}, name, [2]), + bad_args({1}, name, [3]), + bad_args({1,2,3}, name, [4]), + bad_args({1,2,3}, name, [5]), + bad_args({1,2,3,4}, name, [6]), + bad_args({1,2,3,4,5,6}, name,[7]), + bad_args({1,2,3,4,5}, name, [8]), + bad_args({1,2}, name, [9]), + bad_args([1,2], name, [9]), + bad_args(55.0, name, [9]), ok. bad_args(Mod, Name, Args) -> @@ -266,7 +242,7 @@ bad_args(Mod, Name, Args) -> io:format("erlang:hibernate(~p, ~p, ~p) -> ~p\n", [Mod,Name,Args,Res]); Other -> io:format("erlang:hibernate(~p, ~p, ~p) -> ~p\n", [Mod,Name,Args,Res]), - ?t:fail({bad_result,Other}) + ct:fail({bad_result,Other}) end. @@ -283,8 +259,8 @@ messages_in_queue(Config) when is_list(Config) -> receive done -> ok; Other -> - ?line io:format("~p\n", [Other]), - ?line ?t:fail(unexpected_message) + io:format("~p\n", [Other]), + ct:fail(unexpected_message) end. messages_in_queue_1(Parent, ExpectedMsg) -> @@ -296,13 +272,13 @@ messages_in_queue_1(Parent, ExpectedMsg) -> [Parent,ExpectedMsg]). messages_in_queue_restart(Parent, ExpectedMessage) -> - ?line receive - ExpectedMessage -> - Parent ! done; - Other -> - io:format("~p\n", [Other]), - ?t:fail(unexpected_message) - end, + receive + ExpectedMessage -> + Parent ! done; + Other -> + io:format("~p\n", [Other]), + ct:fail(unexpected_message) + end, ok. @@ -312,36 +288,36 @@ messages_in_queue_restart(Parent, ExpectedMessage) -> %%% undefined_mfa(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line Pid = spawn_link(fun() -> + process_flag(trap_exit, true), + Pid = spawn_link(fun() -> %% Will be a call_only instruction. erlang:hibernate(?MODULE, blarf, []) end), - ?line Pid ! {a,message}, - ?line receive - {'EXIT',Pid,{undef,Undef}} -> - io:format("~p\n", [Undef]), - ok; - Other -> - ?line io:format("~p\n", [Other]), - ?line ?t:fail(unexpected_message) - end, + Pid ! {a,message}, + receive + {'EXIT',Pid,{undef,Undef}} -> + io:format("~p\n", [Undef]), + ok; + Other -> + io:format("~p\n", [Other]), + ct:fail(unexpected_message) + end, undefined_mfa_1(). undefined_mfa_1() -> - ?line Pid = spawn_link(fun() -> + Pid = spawn_link(fun() -> %% Force a call_last instruction by calling bar() %% (if that is not obvious). bar(), erlang:hibernate(?MODULE, blarf, []) end), - ?line Pid ! {another,message}, - ?line receive + Pid ! {another,message}, + receive {'EXIT',Pid,{undef,Undef}} -> io:format("~p\n", [Undef]), ok; Other -> - ?line io:format("~p\n", [Other]), - ?line ?t:fail(unexpected_message) + io:format("~p\n", [Other]), + ct:fail(unexpected_message) end, ok. @@ -352,23 +328,17 @@ bar() -> %% No heap %% -no_heap(doc) -> []; -no_heap(suite) -> []; no_heap(Config) when is_list(Config) -> - ?line H = spawn_link(fun () -> clean_dict(), no_heap_loop() end), - ?line lists:foreach(fun (_) -> - wait_until(fun () -> is_hibernated(H) end), - ?line [{heap_size,1}, - {total_heap_size,1}] - = process_info(H, - [heap_size, - total_heap_size]), - receive after 10 -> ok end, - H ! again - end, - lists:seq(1, 100)), - ?line unlink(H), - ?line exit(H, bye). + H = spawn_link(fun () -> clean_dict(), no_heap_loop() end), + lists:foreach(fun (_) -> + wait_until(fun () -> is_hibernated(H) end), + [{heap_size,1}, {total_heap_size,1}] + = process_info(H, [heap_size, total_heap_size]), + receive after 10 -> ok end, + H ! again + end, lists:seq(1, 100)), + unlink(H), + exit(H, bye). no_heap_loop() -> flush(), @@ -382,19 +352,17 @@ clean_dict() -> %% Wake up and then immediatly bif trap with a lengthy computation. %% -wake_up_and_bif_trap(doc) -> []; -wake_up_and_bif_trap(suite) -> []; wake_up_and_bif_trap(Config) when is_list(Config) -> - ?line Self = self(), - ?line Pid = spawn_link(fun() -> erlang:hibernate(?MODULE, characters_to_list_trap, [Self]) end), - ?line Pid ! wakeup, - ?line receive + Self = self(), + Pid = spawn_link(fun() -> erlang:hibernate(?MODULE, characters_to_list_trap, [Self]) end), + Pid ! wakeup, + receive {ok, Pid0} when Pid0 =:= Pid -> ok after 5000 -> - ?line ?t:fail(process_blocked) + ct:fail(process_blocked) end, - ?line unlink(Pid), - ?line exit(Pid, bye). + unlink(Pid), + exit(Pid, bye). %% Lengthy computation that traps (in characters_to_list_trap_3). characters_to_list_trap(Parent) -> diff --git a/erts/emulator/test/ignore_cores.erl b/erts/emulator/test/ignore_cores.erl index 13f34cd10f..25dce346b9 100644 --- a/erts/emulator/test/ignore_cores.erl +++ b/erts/emulator/test/ignore_cores.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,7 +28,7 @@ -module(ignore_cores). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]). @@ -53,7 +53,7 @@ init(Config) -> fini(Config) -> #ignore_cores{org_cwd = OrgCWD, org_path = OrgPath, - org_pwd_env = OrgPWD} = ?config(ignore_cores, Config), + org_pwd_env = OrgPWD} = proplists:get_value(ignore_cores, Config), ok = file:set_cwd(OrgCWD), true = code:set_path(OrgPath), case OrgPWD of @@ -70,10 +70,10 @@ setup(Suite, Testcase, Config, SetCwd) when is_atom(Suite), is_list(Config) -> #ignore_cores{org_cwd = OrgCWD, org_path = OrgPath, - org_pwd_env = OrgPWD} = ?config(ignore_cores, Config), + org_pwd_env = OrgPWD} = proplists:get_value(ignore_cores, Config), Path = lists:map(fun (".") -> OrgCWD; (Dir) -> Dir end, OrgPath), true = code:set_path(Path), - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), IgnDir = filename:join([PrivDir, atom_to_list(Suite) ++ "_" @@ -94,7 +94,7 @@ setup(Suite, Testcase, Config, SetCwd) when is_atom(Suite), end, ok = file:write_file(filename:join([IgnDir, "ignore_core_files"]), <<>>), %% cores are dumped in /cores on MacOS X - CoresDir = case {?t:os_type(), filelib:is_dir("/cores")} of + CoresDir = case {os:type(), filelib:is_dir("/cores")} of {{unix,darwin}, true} -> filelib:fold_files("/cores", "^core.*$", @@ -119,7 +119,7 @@ restore(Config) -> org_path = OrgPath, org_pwd_env = OrgPWD, ign_dir = IgnDir, - cores_dir = CoresDir} = ?config(ignore_cores, Config), + cores_dir = CoresDir} = proplists:get_value(ignore_cores, Config), try case CoresDir of false -> @@ -155,5 +155,5 @@ restore(Config) -> dir(Config) -> - #ignore_cores{ign_dir = Dir} = ?config(ignore_cores, Config), + #ignore_cores{ign_dir = Dir} = proplists:get_value(ignore_cores, Config), Dir. diff --git a/erts/emulator/test/list_bif_SUITE.erl b/erts/emulator/test/list_bif_SUITE.erl index 9e930822cf..514dd2f412 100644 --- a/erts/emulator/test/list_bif_SUITE.erl +++ b/erts/emulator/test/list_bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,149 +19,108 @@ %% -module(list_bif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --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([all/0, suite/0]). -export([hd_test/1,tl_test/1,t_length/1,t_list_to_pid/1, t_list_to_float/1,t_list_to_integer/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. + all() -> [hd_test, tl_test, t_length, t_list_to_pid, t_list_to_float, t_list_to_integer]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(_Case, Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(60)), - [{watchdog,Dog}|Config]. - -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. - -t_list_to_integer(suite) -> - []; -t_list_to_integer(doc) -> - ["tests list_to_integer and string:to_integer"]; +%% Tests list_to_integer and string:to_integer t_list_to_integer(Config) when is_list(Config) -> - ?line {'EXIT',{badarg,_}} = (catch list_to_integer("12373281903728109372810937209817320981321ABC")), - ?line 12373281903728109372810937209817320981321 = (catch list_to_integer("12373281903728109372810937209817320981321")), - ?line 12373 = (catch list_to_integer("12373")), - ?line -12373 = (catch list_to_integer("-12373")), - ?line 12373 = (catch list_to_integer("+12373")), - ?line {'EXIT',{badarg,_}} = ( catch list_to_integer(abc)), - ?line {'EXIT',{badarg,_}} = (catch list_to_integer("")), - ?line {12373281903728109372810937209817320981321,"ABC"} = string:to_integer("12373281903728109372810937209817320981321ABC"), - ?line {-12373281903728109372810937209817320981321,"ABC"} = string:to_integer("-12373281903728109372810937209817320981321ABC"), - ?line {12,[345]} = string:to_integer([$1,$2,345]), - ?line {12,[a]} = string:to_integer([$1,$2,a]), - ?line {error,no_integer} = string:to_integer([$A]), - ?line {error,not_a_list} = string:to_integer($A), + {'EXIT',{badarg,_}} = (catch list_to_integer("12373281903728109372810937209817320981321ABC")), + 12373281903728109372810937209817320981321 = (catch list_to_integer("12373281903728109372810937209817320981321")), + 12373 = (catch list_to_integer("12373")), + -12373 = (catch list_to_integer("-12373")), + 12373 = (catch list_to_integer("+12373")), + {'EXIT',{badarg,_}} = ( catch list_to_integer(abc)), + {'EXIT',{badarg,_}} = (catch list_to_integer("")), + {12373281903728109372810937209817320981321,"ABC"} = string:to_integer("12373281903728109372810937209817320981321ABC"), + {-12373281903728109372810937209817320981321,"ABC"} = string:to_integer("-12373281903728109372810937209817320981321ABC"), + {12,[345]} = string:to_integer([$1,$2,345]), + {12,[a]} = string:to_integer([$1,$2,a]), + {error,no_integer} = string:to_integer([$A]), + {error,not_a_list} = string:to_integer($A), ok. %% Test hd/1 with correct and incorrect arguments. hd_test(Config) when is_list(Config) -> - ?line $h = hd(id("hejsan")), - ?line case catch hd(id($h)) of - {'EXIT', {badarg, _}} -> ok; - Res -> - Str=io_lib:format("hd/1 with incorrect args "++ - "succeeded.~nResult: ~p", [Res]), - test_server:fail(Str) - end, + $h = hd(id("hejsan")), + case catch hd(id($h)) of + {'EXIT', {badarg, _}} -> ok; + Res -> + ct:fail("hd/1 with incorrect args succeeded.~nResult: ~p", [Res]) + end, ok. %% Test tl/1 with correct and incorrect arguments. tl_test(Config) when is_list(Config) -> - ?line "ejsan" = tl(id("hejsan")), - ?line case catch tl(id(104)) of - {'EXIT', {badarg, _}} -> - ok; - Res -> - Str=io_lib:format("tl/1 with incorrect args "++ - "succeeded.~nResult: ~p", [Res]), - test_server:fail(Str) - end, + "ejsan" = tl(id("hejsan")), + case catch tl(id(104)) of + {'EXIT', {badarg, _}} -> + ok; + Res -> + ct:fail("tl/1 with incorrect args succeeded.~nResult: ~p", [Res]) + end, ok. %% Test length/1 with correct and incorrect arguments. t_length(Config) when is_list(Config) -> - ?line 0 = length(""), - ?line 0 = length([]), - ?line 1 = length([1]), - ?line 2 = length([1,a]), - ?line 2 = length("ab"), - ?line 3 = length("abc"), - ?line 4 = length(id([x|"abc"])), - ?line 6 = length("hejsan"), - ?line {'EXIT',{badarg,_}} = (catch length(id([a,b|c]))), - ?line case catch length({tuple}) of - {'EXIT', {badarg, _}} -> - ok; - Res -> - Str = io_lib:format("length/1 with incorrect args "++ - "succeeded.~nResult: ~p", [Res]), - ?line test_server:fail(Str) - end, + 0 = length(""), + 0 = length([]), + 1 = length([1]), + 2 = length([1,a]), + 2 = length("ab"), + 3 = length("abc"), + 4 = length(id([x|"abc"])), + 6 = length("hejsan"), + {'EXIT',{badarg,_}} = (catch length(id([a,b|c]))), + case catch length({tuple}) of + {'EXIT', {badarg, _}} -> + ok; + Res -> + ct:fail("length/1 with incorrect args succeeded.~nResult: ~p", [Res]) + end, ok. %% Test list_to_pid/1 with correct and incorrect arguments. t_list_to_pid(Config) when is_list(Config) -> - ?line Me = self(), - ?line MyListedPid = pid_to_list(Me), - ?line Me = list_to_pid(MyListedPid), - ?line case catch list_to_pid(id("Incorrect list")) of - {'EXIT', {badarg, _}} -> - ok; - Res -> - Str=io_lib:format("list_to_pid/1 with incorrect "++ - "arg succeeded.~nResult: ~p", - [Res]), - test_server:fail(Str) - end, + Me = self(), + MyListedPid = pid_to_list(Me), + Me = list_to_pid(MyListedPid), + case catch list_to_pid(id("Incorrect list")) of + {'EXIT', {badarg, _}} -> + ok; + Res -> + ct:fail("list_to_pid/1 with incorrect arg succeeded.~nResult: ~p", [Res]) + end, ok. %% Test list_to_float/1 with correct and incorrect arguments. t_list_to_float(Config) when is_list(Config) -> - ?line 5.89000 = list_to_float(id("5.89")), - ?line 5.89898 = list_to_float(id("5.89898")), - ?line case catch list_to_float(id("58")) of - {'EXIT', {badarg, _}} -> ok; - Res -> - Str=io_lib:format("list_to_float with incorrect "++ - "arg succeeded.~nResult: ~p", - [Res]), - test_server:fail(Str) - end, + 5.89000 = list_to_float(id("5.89")), + 5.89898 = list_to_float(id("5.89898")), + case catch list_to_float(id("58")) of + {'EXIT', {badarg, _}} -> ok; + Res -> + ct:fail("list_to_float with incorrect arg succeeded.~nResult: ~p", [Res]) + end, ok. id(I) -> I. - - diff --git a/erts/emulator/test/long_timers_test.erl b/erts/emulator/test/long_timers_test.erl index 9415e1cced..7c055a31f9 100644 --- a/erts/emulator/test/long_timers_test.erl +++ b/erts/emulator/test/long_timers_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2010. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/lttng_SUITE.erl b/erts/emulator/test/lttng_SUITE.erl new file mode 100644 index 0000000000..efc79f42ed --- /dev/null +++ b/erts/emulator/test/lttng_SUITE.erl @@ -0,0 +1,499 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(lttng_SUITE). + +-export([all/0, suite/0]). +-export([init_per_suite/1, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2]). + +-export([t_lttng_list/1, + t_carrier_pool/1, + t_memory_carrier/1, + t_async_io_pool/1, + t_driver_control_ready_async/1, + t_driver_start_stop/1, + t_driver_ready_input_output/1, + t_driver_timeout/1, + t_driver_caller/1, + t_driver_flush/1, + t_scheduler_poll/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 10}}]. + +all() -> + [t_lttng_list, + t_carrier_pool, + t_async_io_pool, + t_driver_start_stop, + t_driver_ready_input_output, + t_driver_control_ready_async, + t_driver_timeout, + t_driver_caller, + t_driver_flush, + t_scheduler_poll, + t_memory_carrier]. + + +init_per_suite(Config) -> + case erlang:system_info(dynamic_trace) of + lttng -> + ensure_lttng_stopped("--all"), + Config; + _ -> + {skip, "No LTTng configured on system."} + end. + +end_per_suite(_Config) -> + ensure_lttng_stopped("--all"), + ok. + +init_per_testcase(Case, Config) -> + Name = atom_to_list(Case), + ok = ensure_lttng_started(Name, Config), + [{session, Name}|Config]. + +end_per_testcase(Case, _Config) -> + Name = atom_to_list(Case), + ok = ensure_lttng_stopped(Name), + ok. + +%% Not tested yet +%% com_ericsson_otp:driver_process_exit +%% com_ericsson_otp:driver_event + +%% tracepoints +%% +%% com_ericsson_otp:carrier_pool_get +%% com_ericsson_otp:carrier_pool_put +%% com_ericsson_otp:carrier_destroy +%% com_ericsson_otp:carrier_create +%% com_ericsson_otp:aio_pool_put +%% com_ericsson_otp:aio_pool_get +%% com_ericsson_otp:driver_control +%% com_ericsson_otp:driver_call +%% com_ericsson_otp:driver_finish +%% com_ericsson_otp:driver_ready_async +%% com_ericsson_otp:driver_process_exit +%% com_ericsson_otp:driver_stop +%% com_ericsson_otp:driver_flush +%% com_ericsson_otp:driver_stop_select +%% com_ericsson_otp:driver_timeout +%% com_ericsson_otp:driver_event +%% com_ericsson_otp:driver_ready_output +%% com_ericsson_otp:driver_ready_input +%% com_ericsson_otp:driver_output +%% com_ericsson_otp:driver_outputv +%% com_ericsson_otp:driver_init +%% com_ericsson_otp:driver_start +%% com_ericsson_otp:scheduler_poll + +%% +%% Testcases +%% + +t_lttng_list(_Config) -> + {ok, _} = cmd("lttng list -u"), + ok. + +%% com_ericsson_otp:carrier_pool_get +%% com_ericsson_otp:carrier_pool_put +t_carrier_pool(Config) -> + case have_carriers() of + false -> + {skip, "No Memory Carriers configured on system."}; + true -> + ok = lttng_start_event("com_ericsson_otp:carrier_pool*", Config), + + ok = ets_load(), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:carrier_pool_get", Res), + ok = check_tracepoint("com_ericsson_otp:carrier_pool_put", Res), + ok + end. + +%% com_ericsson_otp:carrier_destroy +%% com_ericsson_otp:carrier_create +t_memory_carrier(Config) -> + case have_carriers() of + false -> + {skip, "No Memory Carriers configured on system."}; + true -> + ok = lttng_start_event("com_ericsson_otp:carrier_*", Config), + + ok = ets_load(), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:carrier_destroy", Res), + ok = check_tracepoint("com_ericsson_otp:carrier_create", Res), + ok + end. + +%% com_ericsson_otp:aio_pool_put +%% com_ericsson_otp:aio_pool_get +t_async_io_pool(Config) -> + case have_async_threads() of + false -> + {skip, "No Async Threads configured on system."}; + true -> + ok = lttng_start_event("com_ericsson_otp:aio_pool_*", Config), + + Path1 = proplists:get_value(priv_dir, Config), + {ok, [[Path2]]} = init:get_argument(home), + {ok, _} = file:list_dir(Path1), + {ok, _} = file:list_dir(Path2), + {ok, _} = file:list_dir(Path1), + {ok, _} = file:list_dir(Path2), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:aio_pool_put", Res), + ok = check_tracepoint("com_ericsson_otp:aio_pool_get", Res), + ok + end. + + +%% com_ericsson_otp:driver_start +%% com_ericsson_otp:driver_stop +t_driver_start_stop(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_*", Config), + Path = proplists:get_value(priv_dir, Config), + Name = filename:join(Path, "sometext.txt"), + Bin = txt(), + ok = file:write_file(Name, Bin), + {ok, Bin} = file:read_file(Name), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_start", Res), + ok = check_tracepoint("com_ericsson_otp:driver_stop", Res), + ok = check_tracepoint("com_ericsson_otp:driver_control", Res), + ok = check_tracepoint("com_ericsson_otp:driver_outputv", Res), + ok = check_tracepoint("com_ericsson_otp:driver_ready_async", Res), + ok. + +%% com_ericsson_otp:driver_control +%% com_ericsson_otp:driver_outputv +%% com_ericsson_otp:driver_ready_async +t_driver_control_ready_async(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_control", Config), + ok = lttng_start_event("com_ericsson_otp:driver_outputv", Config), + ok = lttng_start_event("com_ericsson_otp:driver_ready_async", Config), + Path = proplists:get_value(priv_dir, Config), + Name = filename:join(Path, "sometext.txt"), + Bin = txt(), + ok = file:write_file(Name, Bin), + {ok, Bin} = file:read_file(Name), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_control", Res), + ok = check_tracepoint("com_ericsson_otp:driver_outputv", Res), + ok = check_tracepoint("com_ericsson_otp:driver_ready_async", Res), + ok. + +%% com_ericsson_otp:driver_ready_input +%% com_ericsson_otp:driver_ready_output +t_driver_ready_input_output(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_ready_*", Config), + Me = self(), + Pid = spawn_link(fun() -> tcp_server(Me, active) end), + receive {Pid, accept} -> ok end, + Bin = txt(), + Sz = byte_size(Bin), + + {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary, {packet, 2}]), + ok = gen_tcp:send(Sock, <<Sz:16, Bin/binary>>), + ok = gen_tcp:send(Sock, <<Sz:16, Bin/binary>>), + ok = gen_tcp:close(Sock), + receive {Pid, done} -> ok end, + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_ready_input", Res), + ok = check_tracepoint("com_ericsson_otp:driver_ready_output", Res), + ok. + + +%% com_ericsson_otp:driver_stop_select +%% com_ericsson_otp:driver_timeout +t_driver_timeout(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_*", Config), + Me = self(), + Pid = spawn_link(fun() -> tcp_server(Me, timeout) end), + receive {Pid, accept} -> ok end, + {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary]), + ok = gen_tcp:send(Sock, <<"hej">>), + receive {Pid, done} -> ok end, + ok = gen_tcp:close(Sock), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_timeout", Res), + ok = check_tracepoint("com_ericsson_otp:driver_stop_select", Res), + ok. + +%% com_ericsson_otp:driver_call +%% com_ericsson_otp:driver_output +%% com_ericsson_otp:driver_init +%% com_ericsson_otp:driver_finish +t_driver_caller(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_*", Config), + + Drv = 'caller_drv', + os:putenv("CALLER_DRV_USE_OUTPUTV", "false"), + + ok = load_driver(proplists:get_value(data_dir, Config), Drv), + Port = open_port({spawn, Drv}, []), + true = is_port(Port), + + chk_caller(Port, start, self()), + chk_caller(Port, output, spawn_link(fun() -> + port_command(Port, "") + end)), + Port ! {self(), {command, ""}}, + chk_caller(Port, output, self()), + chk_caller(Port, control, spawn_link(fun () -> + port_control(Port, 0, "") + end)), + chk_caller(Port, call, spawn_link(fun() -> + erlang:port_call(Port, 0, "") + end)), + + true = port_close(Port), + erl_ddll:unload_driver(Drv), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_call", Res), + ok = check_tracepoint("com_ericsson_otp:driver_output", Res), + ok = check_tracepoint("com_ericsson_otp:driver_init", Res), + ok = check_tracepoint("com_ericsson_otp:driver_finish", Res), + ok. + +%% com_ericsson_otp:scheduler_poll +t_scheduler_poll(Config) -> + ok = lttng_start_event("com_ericsson_otp:scheduler_poll", Config), + + ok = memory_load(), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:scheduler_poll", Res), + ok. + +%% com_ericsson_otp:driver_flush +t_driver_flush(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_flush", Config), + + Me = self(), + Pid = spawn_link(fun() -> tcp_server(Me, passive_no_read) end), + receive {Pid, accept} -> ok end, + Bin = iolist_to_binary([txt() || _ <- lists:seq(1,100)]), + Sz = byte_size(Bin), + + %% We want to create a scenario where sendings stalls and we + %% queue packets in the driver. + %% When we close the socket it has to flush the queue. + {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary, {packet, 2}, + {send_timeout, 10}, + {sndbuf, 10000000}]), + Pids = [spawn_link(fun() -> + gen_tcp:send(Sock, <<Sz:16, Bin/binary>>), + Me ! {self(), ok} + end) || _ <- lists:seq(1,100)], + [receive {P, ok} -> ok end || P <- Pids], + ok = gen_tcp:close(Sock), + Pid ! die, + receive {Pid, done} -> ok end, + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_flush", Res), + ok. + +%% +%% AUX +%% + +chk_caller(Port, Callback, ExpectedCaller) -> + receive + {caller, Port, Callback, Caller} -> + ExpectedCaller = Caller + end. + + +ets_load() -> + Tid = ets:new(ets_load, [public,set]), + N = erlang:system_info(schedulers_online), + Pids = [spawn_link(fun() -> ets_shuffle(Tid) end) || _ <- lists:seq(1,N)], + ok = ets_kill(Pids, 500), + ok. + + +ets_kill([], _) -> ok; +ets_kill([Pid|Pids], Time) -> + timer:sleep(Time), + Pid ! done, + ets_kill(Pids, Time). + +ets_shuffle(Tid) -> + Payload = lists:duplicate(100, $x), + ets_shuffle(Tid, 100, Payload). +ets_shuffle(Tid, I, Data) -> + ets_shuffle(Tid, I, I, Data, Data). + +ets_shuffle(Tid, 0, N, _, Data) -> + ets_shuffle(Tid, N, N, Data, Data); +ets_shuffle(Tid, I, N, Data, Data0) -> + receive + done -> ok + after 0 -> + Key = rand:uniform(1000), + Data1 = [I|Data], + ets:insert(Tid, {Key, Data1}), + ets_shuffle(Tid, I - 1, N, Data1, Data0) + end. + + + + +memory_load() -> + Me = self(), + Pids0 = [spawn_link(fun() -> memory_loop(Me, 20, <<42>>) end) || _ <- lists:seq(1,30)], + timer:sleep(50), + Pids1 = [spawn_link(fun() -> memory_loop(Me, 20, <<42>>) end) || _ <- lists:seq(1,30)], + [receive {Pid, done} -> ok end || Pid <- Pids0 ++ Pids1], + timer:sleep(500), + ok. + +memory_loop(Parent, N, Bin) -> + memory_loop(Parent, N, Bin, []). + +memory_loop(Parent, 0, _Bin, _) -> + Parent ! {self(), done}; +memory_loop(Parent, N, Bin0, Ls) -> + Bin = binary:copy(<<Bin0/binary, Bin0/binary>>), + memory_loop(Parent, N - 1, Bin, [a,b,c|Ls]). + +tcp_server(Pid, Type) -> + {ok, LSock} = gen_tcp:listen(5679, [binary, + {reuseaddr, true}, + {active, false}]), + Pid ! {self(), accept}, + {ok, Sock} = gen_tcp:accept(LSock), + case Type of + passive_no_read -> + receive die -> ok end; + active -> + inet:setopts(Sock, [{active, once}, {packet,2}]), + receive Msg1 -> io:format("msg1: ~p~n", [Msg1]) end, + inet:setopts(Sock, [{active, once}, {packet,2}]), + receive Msg2 -> io:format("msg2: ~p~n", [Msg2]) end, + ok = gen_tcp:close(Sock); + timeout -> + Res = gen_tcp:recv(Sock, 2000, 1000), + io:format("res ~p~n", [Res]) + end, + Pid ! {self(), done}, + ok. + +txt() -> + <<"%% tracepoints\n" + "%%\n" + "%% com_ericsson_otp:carrier_pool_get\n" + "%% com_ericsson_otp:carrier_pool_put\n" + "%% com_ericsson_otp:carrier_destroy\n" + "%% com_ericsson_otp:carrier_create\n" + "%% com_ericsson_otp:aio_pool_put\n" + "%% com_ericsson_otp:aio_pool_get\n" + "%% com_ericsson_otp:driver_control\n" + "%% com_ericsson_otp:driver_call\n" + "%% com_ericsson_otp:driver_finish\n" + "%% com_ericsson_otp:driver_ready_async\n" + "%% com_ericsson_otp:driver_process_exit\n" + "%% com_ericsson_otp:driver_stop\n" + "%% com_ericsson_otp:driver_flush\n" + "%% com_ericsson_otp:driver_stop_select\n" + "%% com_ericsson_otp:driver_timeout\n" + "%% com_ericsson_otp:driver_event\n" + "%% com_ericsson_otp:driver_ready_output\n" + "%% com_ericsson_otp:driver_ready_input\n" + "%% com_ericsson_otp:driver_output\n" + "%% com_ericsson_otp:driver_outputv\n" + "%% com_ericsson_otp:driver_init\n" + "%% com_ericsson_otp:driver_start\n" + "%% com_ericsson_otp:scheduler_poll">>. + +load_driver(Dir, Driver) -> + case erl_ddll:load_driver(Dir, Driver) of + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res + end. + +%% check + +have_carriers() -> + Cap = element(3,erlang:system_info(allocator)), + case Cap -- [sys_alloc,sys_aligned_alloc] of + [] -> false; + _ -> true + end. + +have_async_threads() -> + Tps = erlang:system_info(thread_pool_size), + if Tps =:= 0 -> false; + true -> true + end. + +%% lttng +lttng_stop_and_view(Config) -> + Path = proplists:get_value(priv_dir, Config), + Name = proplists:get_value(session, Config), + {ok,_} = cmd("lttng stop " ++ Name), + {ok,Res} = cmd("lttng view " ++ Name ++ " --trace-path=" ++ Path), + Res. + +check_tracepoint(TP, Data) -> + case re:run(Data, TP, [global]) of + {match, _} -> ok; + _ -> notfound + end. + +lttng_start_event(Event, Config) -> + Name = proplists:get_value(session, Config), + {ok, _} = cmd("lttng enable-event -u " ++ Event ++ " --session=" ++ Name), + {ok, _} = cmd("lttng start " ++ Name), + ok. + +ensure_lttng_started(Name, Config) -> + Out = case proplists:get_value(priv_dir, Config) of + undefined -> []; + Path -> "--output="++Path++" " + end, + {ok,_} = cmd("lttng create " ++ Out ++ Name), + ok. + +ensure_lttng_stopped(Name) -> + {ok,_} = cmd("lttng stop"), + {ok,_} = cmd("lttng destroy " ++ Name), + ok. + +cmd(Cmd) -> + io:format("<< ~ts~n", [Cmd]), + Res = os:cmd(Cmd), + io:format(">> ~ts~n", [Res]), + {ok,Res}. diff --git a/erts/emulator/test/lttng_SUITE_data/Makefile.src b/erts/emulator/test/lttng_SUITE_data/Makefile.src new file mode 100644 index 0000000000..fe7a1b6ef3 --- /dev/null +++ b/erts/emulator/test/lttng_SUITE_data/Makefile.src @@ -0,0 +1,7 @@ + +MISC_DRVS = caller_drv@dll@ + + +all: $(MISC_DRVS) + +@SHLIB_RULES@ diff --git a/erts/emulator/test/lttng_SUITE_data/caller_drv.c b/erts/emulator/test/lttng_SUITE_data/caller_drv.c new file mode 100644 index 0000000000..86fd0a2995 --- /dev/null +++ b/erts/emulator/test/lttng_SUITE_data/caller_drv.c @@ -0,0 +1,159 @@ +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include <stdlib.h> +#include <string.h> +#include "erl_driver.h" + +static int init(); +static void stop(ErlDrvData drv_data); +static void finish(); +static void flush(ErlDrvData drv_data); +static ErlDrvData start(ErlDrvPort port, char *command); +static void output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len); +static void outputv(ErlDrvData drv_data, ErlIOVec *ev); +static ErlDrvSSizeT control(ErlDrvData drv_data, + unsigned int command, char *buf, + ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen); +static ErlDrvSSizeT call(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, + unsigned int *flags); + +static ErlDrvEntry caller_drv_entry = { + init, + start, + stop, + output, + NULL /* ready_input */, + NULL /* ready_output */, + "caller_drv", + finish, + NULL /* handle */, + control, + NULL /* timeout */, + outputv, + NULL /* ready_async */, + flush, + call, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +DRIVER_INIT(caller_drv) +{ + char buf[10]; + size_t bufsz = sizeof(buf); + char *use_outputv; + use_outputv = (erl_drv_getenv("CALLER_DRV_USE_OUTPUTV", buf, &bufsz) == 0 + ? buf + : "false"); + if (strcmp(use_outputv, "true") != 0) + caller_drv_entry.outputv = NULL; + return &caller_drv_entry; +} + +void +send_caller(ErlDrvData drv_data, char *func) +{ + int res; + ErlDrvPort port = (ErlDrvPort) drv_data; + ErlDrvTermData msg[] = { + ERL_DRV_ATOM, driver_mk_atom("caller"), + ERL_DRV_PORT, driver_mk_port(port), + ERL_DRV_ATOM, driver_mk_atom(func), + ERL_DRV_PID, driver_caller(port), + ERL_DRV_TUPLE, (ErlDrvTermData) 4 + }; + res = erl_drv_output_term(driver_mk_port(port), msg, sizeof(msg)/sizeof(ErlDrvTermData)); + if (res <= 0) + driver_failure_atom(port, "erl_drv_output_term failed"); +} + +static int +init() { + return 0; +} + +static void +stop(ErlDrvData drv_data) +{ + +} + +static void +flush(ErlDrvData drv_data) +{ + +} + +static void +finish() +{ + +} + +static ErlDrvData +start(ErlDrvPort port, char *command) +{ + send_caller((ErlDrvData) port, "start"); + return (ErlDrvData) port; +} + +static void +output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) +{ + send_caller(drv_data, "output"); +} + +static void +outputv(ErlDrvData drv_data, ErlIOVec *ev) +{ + send_caller(drv_data, "outputv"); +} + +static ErlDrvSSizeT +control(ErlDrvData drv_data, + unsigned int command, char *buf, + ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen) +{ + send_caller(drv_data, "control"); + return 0; +} + +static ErlDrvSSizeT +call(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, + unsigned int *flags) +{ + /* echo call */ + if (len > rlen) + *rbuf = driver_alloc(len); + memcpy((void *) *rbuf, (void *) buf, len); + send_caller(drv_data, "call"); + return len; +} diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index a256cf4195..b3870f0313 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -17,73 +17,71 @@ %% %CopyrightEnd% %% -module(map_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2 - ]). - --export([ - 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_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_map_compare/1, - t_map_size/1, - t_is_map/1, - - %% Specific Map BIFs - t_bif_map_get/1, - t_bif_map_find/1, - t_bif_map_is_key/1, - t_bif_map_keys/1, - t_bif_map_merge/1, - t_bif_map_new/1, - t_bif_map_put/1, - t_bif_map_remove/1, - t_bif_map_update/1, - t_bif_map_values/1, - t_bif_map_to_list/1, - t_bif_map_from_list/1, - - %% erlang - t_erlang_hash/1, - t_map_encode_decode/1, - t_gc_rare_map_overflow/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, - t_maps_size/1, - 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, - - %% instruction-level tests - t_has_map_fields/1, - y_regs/1, - badmap_17/1 - ]). +-export([all/0, suite/0]). +-compile({nowarn_deprecated_function, {erlang,hash,2}}). + +-export([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_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_map_compare/1, + t_map_size/1, + t_is_map/1, + + %% Specific Map BIFs + t_bif_map_get/1, + t_bif_map_find/1, + t_bif_map_is_key/1, + t_bif_map_keys/1, + t_bif_map_merge/1, + t_bif_map_new/1, + t_bif_map_put/1, + t_bif_map_remove/1, + t_bif_map_take/1, t_bif_map_take_large/1, + t_bif_map_update/1, + t_bif_map_values/1, + t_bif_map_to_list/1, + t_bif_map_from_list/1, + + %% erlang + t_erlang_hash/1, + t_map_encode_decode/1, + t_gc_rare_map_overflow/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, + t_maps_size/1, + 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, + + %% instruction-level tests + t_has_map_fields/1, + y_regs/1, + badmap_17/1]). -include_lib("stdlib/include/ms_transform.hrl"). @@ -96,65 +94,57 @@ suite() -> []. -all() -> [ - 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_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 - t_bif_map_get,t_bif_map_find,t_bif_map_is_key, - t_bif_map_keys, t_bif_map_merge, t_bif_map_new, - t_bif_map_put, - t_bif_map_remove, t_bif_map_update, - t_bif_map_values, - t_bif_map_to_list, t_bif_map_from_list, - - %% erlang - t_erlang_hash, t_map_encode_decode, - t_gc_rare_map_overflow, - 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, - t_maps_size, t_maps_without, - - - %% Other functions - t_hashmap_balance, - t_erts_internal_order, - t_erts_internal_hash, - t_pdict, - t_ets, - t_tracing, - - %% instruction-level tests - t_has_map_fields, - y_regs, - badmap_17 - ]. - -groups() -> []. - -init_per_suite(Config) -> Config. -end_per_suite(_Config) -> ok. - -init_per_group(_GroupName, Config) -> Config. -end_per_group(_GroupName, Config) -> Config. +all() -> [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_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 + t_bif_map_get,t_bif_map_find,t_bif_map_is_key, + t_bif_map_keys, t_bif_map_merge, t_bif_map_new, + t_bif_map_put, + t_bif_map_remove, + t_bif_map_take, t_bif_map_take_large, + t_bif_map_update, + t_bif_map_values, + t_bif_map_to_list, t_bif_map_from_list, + + %% erlang + t_erlang_hash, t_map_encode_decode, + t_gc_rare_map_overflow, + 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, + t_maps_size, t_maps_without, + + + %% Other functions + t_hashmap_balance, + t_erts_internal_order, + t_erts_internal_hash, + t_pdict, + t_ets, + t_tracing, + + %% instruction-level tests + t_has_map_fields, + y_regs, + badmap_17]. %% tests @@ -1511,11 +1501,8 @@ t_map_equal(Config) when is_list(Config) -> 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), + rand:seed(exsplus), + io:format("seed = ~p\n", [rand:export_seed()]), repeat(100, fun(_) -> float_int_compare() end, []), repeat(100, fun(_) -> recursive_compare() end, []), ok. @@ -1533,7 +1520,7 @@ float_int_compare() -> numeric_keys(N) -> lists:foldl(fun(_,Acc) -> - Int = random:uniform(N*4) - N*2, + Int = rand:uniform(N*4) - N*2, Float = float(Int), [Int, Float, Float * 0.99, Float * 1.01 | Acc] end, @@ -1564,7 +1551,7 @@ do_compare([Gen1, Gen2]) -> %% 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), + {K1,V1} = lists:nth(rand:uniform(length(ML1)), ML1), case K1 of I when is_integer(I) -> case maps:find(float(I),M1) of @@ -1655,9 +1642,9 @@ cmp_others(T1, T2, _) -> map_gen(Pairs, Size) -> {_,L} = lists:foldl(fun(_, {Keys, Acc}) -> - KI = random:uniform(size(Keys)), + KI = rand:uniform(size(Keys)), K = element(KI,Keys), - KV = element(random:uniform(size(K)), K), + KV = element(rand:uniform(size(K)), K), {erlang:delete_element(KI,Keys), [KV | Acc]} end, {Pairs, []}, @@ -1697,20 +1684,19 @@ term_gen_recursive(Leafs, Flags, Depth) -> MaxDepth = 10, Rnd = case {Flags, Depth} of {_, MaxDepth} -> % Only leafs - random:uniform(size(Leafs)) + 3; + rand:uniform(size(Leafs)) + 3; {0, 0} -> % Only containers - random:uniform(3); + rand:uniform(3); {0,_} -> % Anything - random:uniform(size(Leafs)+3) + rand:uniform(size(Leafs)+3) end, case Rnd of 1 -> % Make map - Size = random:uniform(size(Leafs)), + Size = rand: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()}, @@ -1720,7 +1706,7 @@ term_gen_recursive(Leafs, Flags, Depth) -> {Cdr1,Cdr2} = term_gen_recursive(Leafs, Flags, Depth+1), {[Car1 | Cdr1], [Car2 | Cdr2]}; 3 -> % Make tuple - Size = random:uniform(size(Leafs)), + Size = rand:uniform(size(Leafs)), L = lists:map(fun(_) -> term_gen_recursive(Leafs, Flags, Depth+1) end, lists:seq(1,Size)), {L1, L2} = lists:unzip(L), @@ -1729,7 +1715,7 @@ term_gen_recursive(Leafs, Flags, Depth) -> N -> % Make leaf case element(N-3, Leafs) of I when is_integer(I) -> - case random:uniform(4) of + case rand:uniform(4) of 1 -> {I, float(I)}; 2 -> {float(I), I}; _ -> {I,I} @@ -1738,26 +1724,6 @@ term_gen_recursive(Leafs, Flags, Depth) -> 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) -> @@ -2007,7 +1973,7 @@ t_bif_map_remove(Config) when is_list(Config) -> 0 = erlang:map_size(maps:remove(some_key, #{})), M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, - 4 => number, 18446744073709551629 => wat}, + 4 => number, 18446744073709551629 => wat}, M1 = maps:remove("hi", M0), true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)), @@ -2036,10 +2002,71 @@ t_bif_map_remove(Config) when is_list(Config) -> %% error case do_badmap(fun(T) -> - {'EXIT',{{badmap,T},[{maps,remove,_,_}|_]}} = - (catch maps:remove(a, T)) + {'EXIT',{{badmap,T},[{maps,remove,_,_}|_]}} = (catch maps:remove(a, T)) end), - ok. + ok. + +t_bif_map_take(Config) when is_list(Config) -> + error = maps:take(some_key, #{}), + + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + 5 = maps:size(M0), + {"hello", M1} = maps:take("hi", M0), + true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)), + true = is_members([number,wat,3,<<"value">>],maps:values(M1)), + error = maps:take("hi", M1), + 4 = maps:size(M1), + + {3, M2} = maps:take(int, M1), + true = is_members([4,18446744073709551629,<<"key">>],maps:keys(M2)), + true = is_members([number,wat,<<"value">>],maps:values(M2)), + error = maps:take(int, M2), + 3 = maps:size(M2), + + {<<"value">>,M3} = maps:take(<<"key">>, M2), + true = is_members([4,18446744073709551629],maps:keys(M3)), + true = is_members([number,wat],maps:values(M3)), + error = maps:take(<<"key">>, M3), + 2 = maps:size(M3), + + {wat,M4} = maps:take(18446744073709551629, M3), + true = is_members([4],maps:keys(M4)), + true = is_members([number],maps:values(M4)), + error = maps:take(18446744073709551629, M4), + 1 = maps:size(M4), + + {number,M5} = maps:take(4, M4), + [] = maps:keys(M5), + [] = maps:values(M5), + error = maps:take(4, M5), + 0 = maps:size(M5), + + {wat,#{ "hi" := "hello", int := 3, 4 := number, <<"key">> := <<"value">>}} = maps:take(18446744073709551629,M0), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,take,_,_}|_]}} = (catch maps:take(a, T)) + end), + ok. + +t_bif_map_take_large(Config) when is_list(Config) -> + KVs = [{{erlang:md5(<<I:64>>),I}, I}|| I <- lists:seq(1,500)], + M0 = maps:from_list(KVs), + ok = bif_map_take_all(KVs, M0), + ok. + +bif_map_take_all([], M0) -> + 0 = maps:size(M0), + ok; +bif_map_take_all([{K,V}|KVs],M0) -> + {ok,V} = maps:find(K,M0), + {V,M1} = maps:take(K,M0), + error = maps:find(K,M1), + error = maps:take(K,M1), + bif_map_take_all(KVs,M1). + t_bif_map_update(Config) when is_list(Config) -> M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, @@ -2598,7 +2625,7 @@ hashmap_balance(KeyFun) -> F = fun(I, {M0,Max0}) -> Key = KeyFun(I), M1 = M0#{Key => Key}, - Max1 = case erts_internal:map_type(M1) of + Max1 = case erts_internal:term_type(M1) of hashmap -> Nodes = hashmap_nodes(M1), Avg = maps:size(M1) * 0.4, @@ -2996,7 +3023,7 @@ id(I) -> I. %% OTP-13146 %% Provoke major GC with a lot of "fat" maps on external format in msg queue %% causing heap fragments to be allocated. -t_gc_rare_map_overflow(Config) -> +t_gc_rare_map_overflow(Config) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), {ok, Node} = test_server:start_node(gc_rare_map_overflow, slave, [{args, "-pa \""++Pa++"\""}]), erts_debug:set_internal_state(available_internal_state, true), @@ -3006,7 +3033,7 @@ t_gc_rare_map_overflow(Config) -> Loop() end), FatMap = fatmap(34), - false = (flatmap =:= erts_internal:map_type(FatMap)), + false = (flatmap =:= erts_internal:term_type(FatMap)), t_gc_rare_map_overflow_do(Echo, FatMap, fun() -> erlang:garbage_collect() end), @@ -3016,7 +3043,7 @@ t_gc_rare_map_overflow(Config) -> unlink(Echo), %% Test fatmap in exit signal - Exiter = spawn_link(Node, fun Loop() -> receive {From,Msg} -> + Exiter = spawn_link(Node, fun Loop() -> receive {_From,Msg} -> "not_a_map" = Msg % badmatch! end, Loop() @@ -3034,7 +3061,7 @@ t_gc_rare_map_overflow(Config) -> t_gc_rare_map_overflow_do(Echo, FatMap, GcFun) -> Master = self(), - true = receive M -> false after 0 -> true end, % assert empty msg queue + true = receive _M -> false after 0 -> true end, % assert empty msg queue Echo ! {Master, token}, repeat(1000, fun(_) -> Echo ! {Master, FatMap} end, void), diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index 3f986ca2ed..6733237b20 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,11 +20,10 @@ -module(match_spec_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, not_run/1]). +-export([all/0, suite/0, not_run/1]). -export([test_1/1, test_2/1, test_3/1, bad_match_spec_bin/1, trace_control_word/1, silent/1, silent_no_ms/1, silent_test/1, - ms_trace2/1, ms_trace3/1, boxed_and_small/1, + ms_trace2/1, ms_trace3/1, ms_trace_dead/1, boxed_and_small/1, destructive_in_test_bif/1, guard_exceptions/1, empty_list/1, unary_plus/1, unary_minus/1, moving_labels/1]). @@ -39,27 +38,18 @@ % This test suite assumes that tracing in general works. What we test is % the match spec functionality. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([init_per_testcase/2, end_per_testcase/2]). - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:seconds(30)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 30}}]. all() -> case test_server:is_native(match_spec_SUITE) of false -> [test_1, test_2, test_3, bad_match_spec_bin, trace_control_word, silent, silent_no_ms, silent_test, ms_trace2, - ms_trace3, boxed_and_small, destructive_in_test_bif, + ms_trace3, ms_trace_dead, boxed_and_small, destructive_in_test_bif, guard_exceptions, unary_plus, unary_minus, fpe, moving_labels, faulty_seq_trace, @@ -69,106 +59,87 @@ all() -> true -> [not_run] end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - not_run(Config) when is_list(Config) -> {skipped, "Native Code"}. -test_1(doc) -> - [""]; -test_1(suite) -> []; test_1(Config) when is_list(Config) -> - ?line tr(fun() -> ?MODULE:f1(a) end, - {?MODULE, f1, 1}, - [], - [{call, {?MODULE, f1, [a]}}]), - - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$1','$1'],[{is_atom, '$1'}],[]}], - [{call, {?MODULE, f2, [a, a]}}]), - - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$1','$1'],[{is_atom, '$1'}],[{message, false}]}], - []), - - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}]}], - [{call, {?MODULE, f2, [a, a]}, 4711}]), + tr(fun() -> ?MODULE:f1(a) end, + {?MODULE, f1, 1}, + [], + [{call, {?MODULE, f1, [a]}}]), + + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[]}], + [{call, {?MODULE, f2, [a, a]}}]), + + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[{message, false}]}], + []), + + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}]}], + [{call, {?MODULE, f2, [a, a]}, 4711}]), Ref = make_ref(), - ?line tr(fun() -> ?MODULE:f2(Ref, Ref) end, - {?MODULE, f2, 2}, - [{[Ref,'$1'],[{is_reference, '$1'}],[{message, 4711}]}], - [{call, {?MODULE, f2, [Ref, Ref]}, 4711}]), - ?line tr(fun() -> ?MODULE:f2(Ref, Ref) end, - {?MODULE, f2, 2}, - [{['$1',Ref],[{is_reference, '$1'}],[{message, 4711}]}], - [{call, {?MODULE, f2, [Ref, Ref]}, 4711}]), - - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$0','$0'],[{is_atom, '$0'}],[{message, 4711}]}], - [{call, {?MODULE, f2, [a, a]}, 4711}]), - - ?line tr(fun() -> ?MODULE:f2(a, b) end, - {?MODULE, f2, 2}, - [{['_','_'],[],[]}], - [{call, {?MODULE, f2, [a, b]}}]), - - ?line tr(fun() -> ?MODULE:f2(a, b) end, - {?MODULE, f2, 2}, - [{['_','_'],[],[{message, '$_'}]}], - [{call, {?MODULE, f2, [a, b]}, [a, b]}]), - - ?line tr(fun() -> ?MODULE:f2(a, '$_') end, - {?MODULE, f2, 2}, - [{['$1','$_'],[{is_atom, '$1'}],[]}], - [{call, {?MODULE, f2, [a, '$_']}}]), - - ?line tr(fun() -> ?MODULE:f1({a}) end, - {?MODULE, f1, 1}, - [{['$1'],[{'==', '$1', {const, {a}}}],[]}], - [{call, {?MODULE, f1, [{a}]}}]), - - ?line tr(fun() -> ?MODULE:f1({a}) end, - {?MODULE, f1, 1}, - [{['$1'],[{'==', '$1', {{a}}}],[]}], - [{call, {?MODULE, f1, [{a}]}}]), - -%% Undocumented, currently. - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}, - {message, true}]}], - [{call, {?MODULE, f2, [a, a]}}]), - - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}, - {message, false}]}], - []), - - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$1','$1'],[{is_atom, '$1'}],[kakalorum]}], - [{call, {?MODULE, f2, [a, a]}}]), + tr(fun() -> ?MODULE:f2(Ref, Ref) end, + {?MODULE, f2, 2}, + [{[Ref,'$1'],[{is_reference, '$1'}],[{message, 4711}]}], + [{call, {?MODULE, f2, [Ref, Ref]}, 4711}]), + tr(fun() -> ?MODULE:f2(Ref, Ref) end, + {?MODULE, f2, 2}, + [{['$1',Ref],[{is_reference, '$1'}],[{message, 4711}]}], + [{call, {?MODULE, f2, [Ref, Ref]}, 4711}]), + + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$0','$0'],[{is_atom, '$0'}],[{message, 4711}]}], + [{call, {?MODULE, f2, [a, a]}, 4711}]), + + tr(fun() -> ?MODULE:f2(a, b) end, + {?MODULE, f2, 2}, + [{['_','_'],[],[]}], + [{call, {?MODULE, f2, [a, b]}}]), + + tr(fun() -> ?MODULE:f2(a, b) end, + {?MODULE, f2, 2}, + [{['_','_'],[],[{message, '$_'}]}], + [{call, {?MODULE, f2, [a, b]}, [a, b]}]), + + tr(fun() -> ?MODULE:f2(a, '$_') end, + {?MODULE, f2, 2}, + [{['$1','$_'],[{is_atom, '$1'}],[]}], + [{call, {?MODULE, f2, [a, '$_']}}]), + + tr(fun() -> ?MODULE:f1({a}) end, + {?MODULE, f1, 1}, + [{['$1'],[{'==', '$1', {const, {a}}}],[]}], + [{call, {?MODULE, f1, [{a}]}}]), + + tr(fun() -> ?MODULE:f1({a}) end, + {?MODULE, f1, 1}, + [{['$1'],[{'==', '$1', {{a}}}],[]}], + [{call, {?MODULE, f1, [{a}]}}]), + + %% Undocumented, currently. + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}, + {message, true}]}], + [{call, {?MODULE, f2, [a, a]}}]), + + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}, + {message, false}]}], + []), + + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[kakalorum]}], + [{call, {?MODULE, f2, [a, a]}}]), %% Verify that 'process_dump' can handle a matchstate on the stack. tr(fun() -> fbinmatch(<<0>>, 0) end, @@ -176,56 +147,49 @@ test_1(Config) when is_list(Config) -> [{['_'],[],[{message, {process_dump}}]}], [fun({trace, _, call, {?MODULE, f1, [0]}, _Bin}) -> true end]), -% Error cases - ?line errchk([{['$1','$1'],[{is_atom, '$1'}],[{banka, kanin}]}]), - + % Error cases + errchk([{['$1','$1'],[{is_atom, '$1'}],[{banka, kanin}]}]), ok. -test_2(doc) -> - [""]; -test_2(suite) -> []; test_2(Config) when is_list(Config) -> - ?line tr(fun() -> ?MODULE:f2(a, a) end, - {?MODULE, f2, 2}, - [{['$1','$1'],[{is_atom, '$1'}],[{return_trace}]}], - [{call, {?MODULE, f2, [a, a]}}, - {return_from, {?MODULE, f2, 2}, {a, a}}]), + tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[{return_trace}]}], + [{call, {?MODULE, f2, [a, a]}}, + {return_from, {?MODULE, f2, 2}, {a, a}}]), ok. -test_3(doc) -> - ["Test the enable_trace/2 and caller/0 PAM instructions"]; -test_3(suite) -> []; +%% Test the enable_trace/2 and caller/0 PAM instructions test_3(Config) when is_list(Config) -> - ?line Fun1 = fun() -> + Fun1 = fun() -> register(fnoppelklopfer,self()), ?MODULE:f2(a, b), ?MODULE:f2(a, b) end, - ?line P1 = spawn(?MODULE, runner, [self(), Fun1]), - ?line Pat = [{['$1','$1'],[],[{message, - [{enable_trace, P1, call},{caller}]}]}, - {['_','_'],[],[{message, - [{disable_trace, fnoppelklopfer, call}]}]}], - ?line Fun2 = fun() -> ?MODULE:f3(a, a) end, - ?line P2 = spawn(?MODULE, runner, [self(), Fun2]), - ?line erlang:trace(P2, true, [call]), - ?line erlang:trace_pattern({?MODULE, f2, 2}, Pat), - ?line collect(P2, [{trace, P2, call, {?MODULE, f2, [a, a]}, [true, + P1 = spawn(?MODULE, runner, [self(), Fun1]), + Pat = [{['$1','$1'],[],[{message, + [{enable_trace, P1, call},{caller}]}]}, + {['_','_'],[],[{message, + [{disable_trace, fnoppelklopfer, call}]}]}], + Fun2 = fun() -> ?MODULE:f3(a, a) end, + P2 = spawn(?MODULE, runner, [self(), Fun2]), + erlang:trace(P2, true, [call]), + erlang:trace_pattern({?MODULE, f2, 2}, Pat), + collect(P2, [{trace, P2, call, {?MODULE, f2, [a, a]}, [true, {?MODULE,f3,2}]}]), - ?line collect(P1, [{trace, P1, call, {?MODULE, f2, [a, b]}, [true]}]), - ?line ok. + collect(P1, [{trace, P1, call, {?MODULE, f2, [a, b]}, [true]}]), + ok. -otp_9422(doc) -> []; otp_9422(Config) when is_list(Config) -> Laps = 10000, - ?line Fun1 = fun() -> otp_9422_tracee() end, - ?line P1 = spawn_link(?MODULE, loop_runner, [self(), Fun1, Laps]), + Fun1 = fun() -> otp_9422_tracee() end, + P1 = spawn_link(?MODULE, loop_runner, [self(), Fun1, Laps]), io:format("spawned ~p as tracee\n", [P1]), - ?line erlang:trace(P1, true, [call, silent]), + erlang:trace(P1, true, [call, silent]), - ?line Fun2 = fun() -> otp_9422_trace_changer() end, - ?line P2 = spawn_link(?MODULE, loop_runner, [self(), Fun2, Laps]), + Fun2 = fun() -> otp_9422_trace_changer() end, + P2 = spawn_link(?MODULE, loop_runner, [self(), Fun2, Laps]), io:format("spawned ~p as trace_changer\n", [P2]), start_collect(P1), @@ -244,9 +208,9 @@ otp_9422_tracee() -> otp_9422_trace_changer() -> Pat1 = [{[a], [], [{enable_trace, arity}]}], - ?line erlang:trace_pattern({?MODULE, f1, 1}, Pat1), + erlang:trace_pattern({?MODULE, f1, 1}, Pat1), Pat2 = [{[b], [], [{disable_trace, arity}]}], - ?line erlang:trace_pattern({?MODULE, f1, 1}, Pat2). + erlang:trace_pattern({?MODULE, f1, 1}, Pat2). @@ -261,261 +225,227 @@ bad_match_spec_bin(Config) when is_list(Config) -> -trace_control_word(doc) -> - ["Test the erlang:system_info(trace_control_word) and ", - "erlang:system_flag(trace_control_word, Value) BIFs, ", - "as well as the get_tcw/0 and set_tcw/1 PAM instructions"]; -trace_control_word(suite) -> []; +%% Test the erlang:system_info(trace_control_word) and +%% erlang:system_flag(trace_control_word, Value) BIFs, +%% as well as the get_tcw/0 and set_tcw/1 PAM instructions trace_control_word(Config) when is_list(Config) -> - ?line 32 = Bits = tcw_bits(), - ?line High = 1 bsl (Bits - 1), - ?line erlang:system_flag(trace_control_word, 17), - ?line tr(fun() -> ?MODULE:f1(a) end, - {?MODULE, f1, 1}, - [{'_',[{'=:=', {get_tcw}, 17}],[]}], - [{call, {?MODULE, f1, [a]}}]), - ?line tr(fun() -> ?MODULE:f1(a) end, - {?MODULE, f1, 1}, - [{'_',[{'=:=', {get_tcw}, 18}],[]}], - []), - ?line erlang:system_flag(trace_control_word, High), - ?line tr(fun() -> ?MODULE:f1(a) end, - {?MODULE, f1, 1}, - [{'_',[{'=:=', {get_tcw}, High}],[]}], - [{call, {?MODULE, f1, [a]}}]), - ?line erlang:system_flag(trace_control_word, 0), - ?line tr(fun() -> - ?MODULE:f1(a), - ?MODULE:f1(start), - ?MODULE:f1(b), - ?MODULE:f1(c), - ?MODULE:f1(high), - ?MODULE:f1(d), - ?MODULE:f1(stop), - ?MODULE:f1(e) - end, - {?MODULE, f1, 1}, - [{[start], - [], - [{message, {set_tcw, 17}}]}, - {[stop], - [], - [{message, {set_tcw, 0}}]}, - {[high], - [], - [{message, {set_tcw, High}}]}, - {['_'], - [{'>', {get_tcw}, 0}], - [{set_tcw, {'+', 1, {get_tcw}}}, {message, {get_tcw}}] }], - [{call, {?MODULE, f1, [start]}, 0}, - {call, {?MODULE, f1, [b]}, 18}, - {call, {?MODULE, f1, [c]}, 19}, - {call, {?MODULE, f1, [high]}, 19}, - {call, {?MODULE, f1, [d]}, High + 1}, - {call, {?MODULE, f1, [stop]}, High + 1}]), - ?line 0 = erlang:system_info(trace_control_word), + 32 = Bits = tcw_bits(), + High = 1 bsl (Bits - 1), + erlang:system_flag(trace_control_word, 17), + tr(fun() -> ?MODULE:f1(a) end, + {?MODULE, f1, 1}, + [{'_',[{'=:=', {get_tcw}, 17}],[]}], + [{call, {?MODULE, f1, [a]}}]), + tr(fun() -> ?MODULE:f1(a) end, + {?MODULE, f1, 1}, + [{'_',[{'=:=', {get_tcw}, 18}],[]}], + []), + erlang:system_flag(trace_control_word, High), + tr(fun() -> ?MODULE:f1(a) end, + {?MODULE, f1, 1}, + [{'_',[{'=:=', {get_tcw}, High}],[]}], + [{call, {?MODULE, f1, [a]}}]), + erlang:system_flag(trace_control_word, 0), + tr(fun() -> + ?MODULE:f1(a), + ?MODULE:f1(start), + ?MODULE:f1(b), + ?MODULE:f1(c), + ?MODULE:f1(high), + ?MODULE:f1(d), + ?MODULE:f1(stop), + ?MODULE:f1(e) + end, + {?MODULE, f1, 1}, + [{[start], + [], + [{message, {set_tcw, 17}}]}, + {[stop], + [], + [{message, {set_tcw, 0}}]}, + {[high], + [], + [{message, {set_tcw, High}}]}, + {['_'], + [{'>', {get_tcw}, 0}], + [{set_tcw, {'+', 1, {get_tcw}}}, {message, {get_tcw}}] }], + [{call, {?MODULE, f1, [start]}, 0}, + {call, {?MODULE, f1, [b]}, 18}, + {call, {?MODULE, f1, [c]}, 19}, + {call, {?MODULE, f1, [high]}, 19}, + {call, {?MODULE, f1, [d]}, High + 1}, + {call, {?MODULE, f1, [stop]}, High + 1}]), + 0 = erlang:system_info(trace_control_word), ok. tcw_bits() -> - ?line tcw_bits(erlang:system_flag(trace_control_word, 0), 0, 0). + tcw_bits(erlang:system_flag(trace_control_word, 0), 0, 0). tcw_bits(Save, Prev, Bits) -> - ?line Curr = 1 bsl Bits, - ?line case catch erlang:system_flag(trace_control_word, Curr) of - {'EXIT' , {badarg, _}} -> - ?line Prev = erlang:system_flag(trace_control_word, Save), - Bits; - Prev -> - ?line Curr = erlang:system_info(trace_control_word), - tcw_bits(Save, Curr, Bits+1) - end. - - - -silent(doc) -> - ["Test the erlang:trace(_, _, [silent]) flag ", - "as well as the silent/0 PAM instruction"]; -silent(suite) -> []; + Curr = 1 bsl Bits, + case catch erlang:system_flag(trace_control_word, Curr) of + {'EXIT' , {badarg, _}} -> + Prev = erlang:system_flag(trace_control_word, Save), + Bits; + Prev -> + Curr = erlang:system_info(trace_control_word), + tcw_bits(Save, Curr, Bits+1) + end. + + +%% Test the erlang:trace(_, _, [silent]) flag +%% as well as the silent/0 PAM instruction silent(Config) when is_list(Config) -> %% Global call trace - ?line tr(fun() -> - ?MODULE:f1(a), % No trace - not active - ?MODULE:f1(miss), % No trace - no activation - ?MODULE:f1(b), % No trace - still not active - ?MODULE:f1(start), % Trace - activation - ?MODULE:f1(c), % Trace - active - f1(d), % No trace - local call - ?MODULE:f1(miss), % Trace - no inactivation - ?MODULE:f1(e), % Trace - still active - ?MODULE:f1(stop), % No trace - inactivation - ?MODULE:f1(f) % No trace - not active - end, - {?MODULE, f1, 1}, - [call, silent], - [{[start], - [], - [{silent, false}, {message, start}]}, - {[stop], - [], - [{silent, true}, {message, stop}]}, - {[miss], - [], - [{silent, neither_true_nor_false}, {message, miss}]}, - {['$1'], - [], - [{message, '$1'}] }], - [global], - [{call, {?MODULE, f1, [start]}, start}, - {call, {?MODULE, f1, [c]}, c}, - {call, {?MODULE, f1, [miss]}, miss}, - {call, {?MODULE, f1, [e]}, e} ]), + tr(fun() -> + ?MODULE:f1(a), % No trace - not active + ?MODULE:f1(miss), % No trace - no activation + ?MODULE:f1(b), % No trace - still not active + ?MODULE:f1(start), % Trace - activation + ?MODULE:f1(c), % Trace - active + f1(d), % No trace - local call + ?MODULE:f1(miss), % Trace - no inactivation + ?MODULE:f1(e), % Trace - still active + ?MODULE:f1(stop), % No trace - inactivation + ?MODULE:f1(f) % No trace - not active + end, + {?MODULE, f1, 1}, + [call, silent], + [{[start], + [], + [{silent, false}, {message, start}]}, + {[stop], + [], + [{silent, true}, {message, stop}]}, + {[miss], + [], + [{silent, neither_true_nor_false}, {message, miss}]}, + {['$1'], + [], + [{message, '$1'}] }], + [global], + [{call, {?MODULE, f1, [start]}, start}, + {call, {?MODULE, f1, [c]}, c}, + {call, {?MODULE, f1, [miss]}, miss}, + {call, {?MODULE, f1, [e]}, e} ]), %% Local call trace - ?line tr(fun() -> - ?MODULE:f1(a), % No trace - not active - f1(b), % No trace - not active - ?MODULE:f1(start), % Trace - activation - ?MODULE:f1(c), % Trace - active - f1(d), % Trace - active - f1(stop), % No trace - inactivation - ?MODULE:f1(e), % No trace - not active - f1(f) % No trace - not active - end, - {?MODULE, f1, 1}, - [call, silent], - [{[start], - [], - [{silent, false}, {message, start}]}, - {[stop], - [], - [{silent, true}, {message, stop}]}, - {['$1'], - [], - [{message, '$1'}] }], - [local], - [{call, {?MODULE, f1, [start]}, start}, - {call, {?MODULE, f1, [c]}, c}, - {call, {?MODULE, f1, [d]}, d} ]), + tr(fun() -> + ?MODULE:f1(a), % No trace - not active + f1(b), % No trace - not active + ?MODULE:f1(start), % Trace - activation + ?MODULE:f1(c), % Trace - active + f1(d), % Trace - active + f1(stop), % No trace - inactivation + ?MODULE:f1(e), % No trace - not active + f1(f) % No trace - not active + end, + {?MODULE, f1, 1}, + [call, silent], + [{[start], + [], + [{silent, false}, {message, start}]}, + {[stop], + [], + [{silent, true}, {message, stop}]}, + {['$1'], + [], + [{message, '$1'}] }], + [local], + [{call, {?MODULE, f1, [start]}, start}, + {call, {?MODULE, f1, [c]}, c}, + {call, {?MODULE, f1, [d]}, d} ]), ok. -silent_no_ms(doc) -> - ["Test the erlang:trace(_, _, [silent]) flag without match specs"]; -silent_no_ms(suite) -> []; +%% Test the erlang:trace(_, _, [silent]) flag without match specs silent_no_ms(Config) when is_list(Config) -> %% Global call trace %% %% Trace f2/2 and erlang:integer_to_list/1 without match spec %% and use match spec on f1/1 to control silent flag. - ?line tr( - fun () -> - ?MODULE:f1(a), - ?MODULE:f2(b, c), - _ = erlang:integer_to_list(id(1)), - ?MODULE:f3(d, e), - ?MODULE:f1(start), - ?MODULE:f2(f, g), - _ = erlang:integer_to_list(id(2)), - ?MODULE:f3(h, i), - ?MODULE:f1(stop), - ?MODULE:f2(j, k), - _ = erlang:integer_to_list(id(3)), - ?MODULE:f3(l, m) - end, - fun (Tracee) -> - ?line 1 = - erlang:trace(Tracee, true, - [call,silent,return_to]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f2,2}, - [], - [global]), - ?line 1 = - erlang:trace_pattern( - {erlang,integer_to_list,1}, - [], - [global]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f1,1}, - [{[start],[],[{silent,false}]}, - {[stop],[],[{silent,true}]}], - [global]), - %% - %% Expected: (no return_to for global call trace) - %% - ?line - [{trace,Tracee,call,{?MODULE,f1,[start]}}, - {trace,Tracee,call,{?MODULE,f2,[f,g]}}, - {trace,Tracee,call,{erlang,integer_to_list,[2]}}, - {trace,Tracee,call,{?MODULE,f2,[h,i]}}] - end), + tr( + fun () -> + ?MODULE:f1(a), + ?MODULE:f2(b, c), + _ = erlang:integer_to_list(id(1)), + ?MODULE:f3(d, e), + ?MODULE:f1(start), + ?MODULE:f2(f, g), + _ = erlang:integer_to_list(id(2)), + ?MODULE:f3(h, i), + ?MODULE:f1(stop), + ?MODULE:f2(j, k), + _ = erlang:integer_to_list(id(3)), + ?MODULE:f3(l, m) + end, + fun (Tracee) -> + 1 = erlang:trace(Tracee, true, [call,silent,return_to]), + 1 = erlang:trace_pattern( {?MODULE,f2,2}, [], [global]), + 1 = erlang:trace_pattern( {erlang,integer_to_list,1}, [], [global]), + 1 = erlang:trace_pattern( + {?MODULE,f1,1}, + [{[start],[],[{silent,false}]}, + {[stop],[],[{silent,true}]}], + [global]), + %% + %% Expected: (no return_to for global call trace) + %% + [{trace,Tracee,call,{?MODULE,f1,[start]}}, + {trace,Tracee,call,{?MODULE,f2,[f,g]}}, + {trace,Tracee,call,{erlang,integer_to_list,[2]}}, + {trace,Tracee,call,{?MODULE,f2,[h,i]}}] + end), %% Local call trace %% %% Trace f2/2 and erlang:integer_to_list/1 without match spec %% and use match spec on f1/1 to control silent flag. - ?line tr( - fun () -> - ?MODULE:f1(a), - ?MODULE:f2(b, c), - _ = erlang:integer_to_list(id(1)), - ?MODULE:f3(d, e), - ?MODULE:f1(start), - ?MODULE:f2(f, g), - _ = erlang:integer_to_list(id(2)), - ?MODULE:f3(h, i), - ?MODULE:f1(stop), - ?MODULE:f2(j, k), - _ = erlang:integer_to_list(id(3)), - ?MODULE:f3(l, m) - end, - fun (Tracee) -> - ?line 1 = - erlang:trace(Tracee, true, - [call,silent,return_to]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f2,2}, - [], - [local]), - ?line 1 = - erlang:trace_pattern( - {erlang,integer_to_list,1}, - [], - [local]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f1,1}, - [{[start],[],[{silent,false}]}, - {[stop],[],[{silent,true}]}], - [local]), - %% - %% Expected: - %% - ?line - [{trace,Tracee,call,{?MODULE,f1,[start]}}, - {trace,Tracee,return_to, - {?MODULE,'-silent_no_ms/1-fun-2-',0}}, - {trace,Tracee,call,{?MODULE,f2,[f,g]}}, - {trace,Tracee,return_to, - {?MODULE,'-silent_no_ms/1-fun-2-',0}}, - {trace,Tracee,call,{erlang,integer_to_list,[2]}}, - {trace,Tracee,return_to, - {?MODULE,'-silent_no_ms/1-fun-2-',0}}, - {trace,Tracee,call,{?MODULE,f2,[h,i]}}, - {trace,Tracee,return_to,{?MODULE,f3,2}}] - end). - -silent_test(doc) -> - ["Test that match_spec_test does not activate silent"]; + tr( + fun () -> + ?MODULE:f1(a), + ?MODULE:f2(b, c), + _ = erlang:integer_to_list(id(1)), + ?MODULE:f3(d, e), + ?MODULE:f1(start), + ?MODULE:f2(f, g), + _ = erlang:integer_to_list(id(2)), + ?MODULE:f3(h, i), + ?MODULE:f1(stop), + ?MODULE:f2(j, k), + _ = erlang:integer_to_list(id(3)), + ?MODULE:f3(l, m) + end, + fun (Tracee) -> + 1 = erlang:trace(Tracee, true, [call,silent,return_to]), + 1 = erlang:trace_pattern( {?MODULE,f2,2}, [], [local]), + 1 = erlang:trace_pattern( {erlang,integer_to_list,1}, [], [local]), + 1 = erlang:trace_pattern( + {?MODULE,f1,1}, + [{[start],[],[{silent,false}]}, + {[stop],[],[{silent,true}]}], + [local]), + %% + %% Expected: + %% + [{trace,Tracee,call,{?MODULE,f1,[start]}}, + {trace,Tracee,return_to, + {?MODULE,'-silent_no_ms/1-fun-2-',0}}, + {trace,Tracee,call,{?MODULE,f2,[f,g]}}, + {trace,Tracee,return_to, + {?MODULE,'-silent_no_ms/1-fun-2-',0}}, + {trace,Tracee,call,{erlang,integer_to_list,[2]}}, + {trace,Tracee,return_to, + {?MODULE,'-silent_no_ms/1-fun-2-',0}}, + {trace,Tracee,call,{?MODULE,f2,[h,i]}}, + {trace,Tracee,return_to,{?MODULE,f3,2}}] + end). + +%% Test that match_spec_test does not activate silent silent_test(_Config) -> {flags,[]} = erlang:trace_info(self(),flags), erlang:match_spec_test([],[{'_',[],[{silent,true}]}],trace), {flags,[]} = erlang:trace_info(self(),flags). -ms_trace2(doc) -> - ["Test the match spec functions {trace/2}"]; -ms_trace2(suite) -> []; +%% Test the match spec functions {trace/2} ms_trace2(Config) when is_list(Config) -> Tracer = self(), %% Meta trace init @@ -523,75 +453,60 @@ ms_trace2(Config) when is_list(Config) -> %% Trace global f1/1, local f2/2, global erlang:integer_to_list/1 %% without match spec. Use match spec functions %% {trace/2} to control trace through fn/2,3. - ?line tr( - fun () -> - ?MODULE:f1(a), - ?MODULE:f2(b, c), - _ = erlang:integer_to_list(id(1)), - ?MODULE:f3(d, e), - fn([all], [call,return_to,{tracer,Tracer}]), - ?MODULE:f1(f), - f2(g, h), - f1(i), - _ = erlang:integer_to_list(id(2)), - ?MODULE:f3(j, k), - fn([call,return_to], []), - ?MODULE:f1(l), - ?MODULE:f2(m, n), - _ = erlang:integer_to_list(id(3)), - ?MODULE:f3(o, p) - end, - fun (Tracee) -> - ?line 1 = - erlang:trace(Tracee, false, [all]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f1,1}, - [], - [global]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f2,2}, - [], - [local]), - ?line 1 = - erlang:trace_pattern( - {erlang,integer_to_list,1}, - [], - [global]), - ?line 3 = - erlang:trace_pattern( - {?MODULE,fn,'_'}, - [{['$1','$2'],[], - [{trace,'$1','$2'},{message,ms_trace2}]}], - [meta]), - %% - %% Expected: (no return_to for global call trace) - %% - ?line Origin = {match_spec_SUITE,'-ms_trace2/1-fun-0-',1}, - ?line - [{trace_ts,Tracee,call, - {?MODULE,fn, - [[all],[call,return_to,{tracer,Tracer}]]}, - ms_trace2}, - {trace,Tracee,call,{?MODULE,f1,[f]}}, - {trace,Tracee,call,{?MODULE,f2,[g,h]}}, - {trace,Tracee,return_to,Origin}, - {trace,Tracee,call,{erlang,integer_to_list,[2]}}, - {trace,Tracee,call,{?MODULE,f2,[j,k]}}, - {trace,Tracee,return_to,{?MODULE,f3,2}}, - {trace_ts,Tracee,call, - {?MODULE,fn, - [[call,return_to],[]]}, - ms_trace2}] - end), + tr( + fun () -> + ?MODULE:f1(a), + ?MODULE:f2(b, c), + _ = erlang:integer_to_list(id(1)), + ?MODULE:f3(d, e), + fn([all], [call,return_to,{tracer,Tracer}]), + ?MODULE:f1(f), + f2(g, h), + f1(i), + _ = erlang:integer_to_list(id(2)), + ?MODULE:f3(j, k), + fn([call,return_to], []), + ?MODULE:f1(l), + ?MODULE:f2(m, n), + _ = erlang:integer_to_list(id(3)), + ?MODULE:f3(o, p) + end, + fun (Tracee) -> + 1 = erlang:trace(Tracee, false, [all]), + 1 = erlang:trace_pattern( {?MODULE,f1,1}, [], [global]), + 1 = erlang:trace_pattern( {?MODULE,f2,2}, [], [local]), + 1 = erlang:trace_pattern( {erlang,integer_to_list,1}, [], [global]), + 3 = erlang:trace_pattern( + {?MODULE,fn,'_'}, + [{['$1','$2'],[], + [{trace,'$1','$2'},{message,ms_trace2}]}], + [meta]), + %% + %% Expected: (no return_to for global call trace) + %% + Origin = {match_spec_SUITE,'-ms_trace2/1-fun-0-',1}, + [{trace_ts,Tracee,call, + {?MODULE,fn, + [[all],[call,return_to,{tracer,Tracer}]]}, + ms_trace2}, + {trace,Tracee,call,{?MODULE,f1,[f]}}, + {trace,Tracee,call,{?MODULE,f2,[g,h]}}, + {trace,Tracee,return_to,Origin}, + {trace,Tracee,call,{erlang,integer_to_list,[2]}}, + {trace,Tracee,call,{?MODULE,f2,[j,k]}}, + {trace,Tracee,return_to,{?MODULE,f3,2}}, + {trace_ts,Tracee,call, + {?MODULE,fn, + [[call,return_to],[]]}, + ms_trace2}] + end), + %% Silence valgrind + erlang:trace_pattern({?MODULE,fn,'_'},[],[]), ok. -ms_trace3(doc) -> - ["Test the match spec functions {trace/3}"]; -ms_trace3(suite) -> []; +%% Test the match spec functions {trace/3} ms_trace3(Config) when is_list(Config) -> TraceeName = 'match_spec_SUITE:ms_trace3', Tracer = self(), @@ -602,134 +517,140 @@ ms_trace3(Config) when is_list(Config) -> %% {trace/2} to control trace through fn/2,3. Tag = make_ref(), Controller = - spawn_link( - fun () -> - receive - {Tracee,Tag,start} -> - fn(TraceeName, [all], - [call,return_to,send,'receive', - {tracer,Tracer}]), - Tracee ! {self(),Tag,started}, - receive {Tracee,Tag,stop_1} -> ok end, - fn(Tracee, [call,return_to], []), - Tracee ! {self(),Tag,stopped_1}, - receive {Tracee,Tag,stop_2} -> ok end, - fn(Tracee, [all], []), - Tracee ! {self(),Tag,stopped_2} - end - end), - ?line tr( - fun () -> %% Action - register(TraceeName, self()), - ?MODULE:f1(a), - ?MODULE:f2(b, c), - _ = erlang:integer_to_list(id(1)), - ?MODULE:f3(d, e), - Controller ! {self(),Tag,start}, - receive {Controller,Tag,started} -> ok end, - ?MODULE:f1(f), - f2(g, h), - f1(i), - _ = erlang:integer_to_list(id(2)), - ?MODULE:f3(j, k), - Controller ! {self(),Tag,stop_1}, - receive {Controller,Tag,stopped_1} -> ok end, - ?MODULE:f1(l), - ?MODULE:f2(m, n), - _ = erlang:integer_to_list(id(3)), - ?MODULE:f3(o, p), - Controller ! {self(),Tag,stop_2}, - receive {Controller,Tag,stopped_2} -> ok end, - ?MODULE:f1(q), - ?MODULE:f2(r, s), - _ = erlang:integer_to_list(id(4)), - ?MODULE:f3(t, u) - end, - - fun (Tracee) -> %% Startup - ?line 1 = - erlang:trace(Tracee, false, [all]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f1,1}, - [], - [global]), - ?line 1 = - erlang:trace_pattern( - {?MODULE,f2,2}, - [], - [local]), - ?line 1 = - erlang:trace_pattern( - {erlang,integer_to_list,1}, - [], - [global]), - ?line 3 = - erlang:trace_pattern( - {?MODULE,fn,'_'}, - [{['$1','$2','$3'],[], - [{trace,'$1','$2','$3'},{message,Tag}]}], - [meta]), - %% - %% Expected: (no return_to for global call trace) - %% - ?line Origin = {match_spec_SUITE,'-ms_trace3/1-fun-1-',2}, - ?line - [{trace_ts,Controller,call, - {?MODULE,fn,[TraceeName,[all], - [call,return_to,send,'receive', - {tracer,Tracer}]]}, - Tag}, - {trace,Tracee,'receive',{Controller,Tag,started}}, - {trace,Tracee,call,{?MODULE,f1,[f]}}, - {trace,Tracee,call,{?MODULE,f2,[g,h]}}, - {trace,Tracee,return_to,Origin}, - {trace,Tracee,call,{erlang,integer_to_list,[2]}}, - {trace,Tracee,call,{?MODULE,f2,[j,k]}}, - {trace,Tracee,return_to,{?MODULE,f3,2}}, - {trace,Tracee,send,{Tracee,Tag,stop_1},Controller}, - {trace_ts,Controller,call, - {?MODULE,fn,[Tracee,[call,return_to],[]]}, - Tag}, - {trace_ts,Controller,call, - {?MODULE,fn,[Tracee,[all],[]]}, - Tag}] - end), + spawn_link( + fun () -> + receive + {Tracee,Tag,start} -> + fn(TraceeName, [all], + [call,return_to,send,'receive', + {tracer,Tracer}]), + Tracee ! {self(),Tag,started}, + receive {Tracee,Tag,stop_1} -> ok end, + fn(Tracee, [call,return_to], []), + Tracee ! {self(),Tag,stopped_1}, + receive {Tracee,Tag,stop_2} -> ok end, + fn(Tracee, [all], []), + Tracee ! {self(),Tag,stopped_2} + end + end), + tr( + fun () -> %% Action + register(TraceeName, self()), + ?MODULE:f1(a), + ?MODULE:f2(b, c), + _ = erlang:integer_to_list(id(1)), + ?MODULE:f3(d, e), + Controller ! {self(),Tag,start}, + receive {Controller,Tag,started} -> ok end, + ?MODULE:f1(f), + f2(g, h), + f1(i), + _ = erlang:integer_to_list(id(2)), + ?MODULE:f3(j, k), + Controller ! {self(),Tag,stop_1}, + receive {Controller,Tag,stopped_1} -> ok end, + ?MODULE:f1(l), + ?MODULE:f2(m, n), + _ = erlang:integer_to_list(id(3)), + ?MODULE:f3(o, p), + Controller ! {self(),Tag,stop_2}, + receive {Controller,Tag,stopped_2} -> ok end, + ?MODULE:f1(q), + ?MODULE:f2(r, s), + _ = erlang:integer_to_list(id(4)), + ?MODULE:f3(t, u) + end, + + fun (Tracee) -> %% Startup + 1 = erlang:trace(Tracee, false, [all]), + 1 = erlang:trace_pattern( {?MODULE,f1,1}, [], [global]), + 1 = erlang:trace_pattern( {?MODULE,f2,2}, [], [local]), + 1 = erlang:trace_pattern( {erlang,integer_to_list,1}, [], [global]), + 3 = erlang:trace_pattern( + {?MODULE,fn,'_'}, + [{['$1','$2','$3'],[], + [{trace,'$1','$2','$3'},{message,Tag}]}], + [meta]), + %% + %% Expected: (no return_to for global call trace) + %% + Origin = {match_spec_SUITE,'-ms_trace3/1-fun-1-',2}, + [{trace_ts,Controller,call, + {?MODULE,fn,[TraceeName,[all], + [call,return_to,send,'receive', + {tracer,Tracer}]]}, + Tag}, + {trace,Tracee,'receive',{Controller,Tag,started}}, + {trace,Tracee,call,{?MODULE,f1,[f]}}, + {trace,Tracee,call,{?MODULE,f2,[g,h]}}, + {trace,Tracee,return_to,Origin}, + {trace,Tracee,call,{erlang,integer_to_list,[2]}}, + {trace,Tracee,call,{?MODULE,f2,[j,k]}}, + {trace,Tracee,return_to,{?MODULE,f3,2}}, + {trace,Tracee,send,{Tracee,Tag,stop_1},Controller}, + {trace_ts,Controller,call, + {?MODULE,fn,[Tracee,[call,return_to],[]]}, + Tag}, + {trace_ts,Controller,call, + {?MODULE,fn,[Tracee,[all],[]]}, + Tag}] + end), ok. - - -destructive_in_test_bif(doc) -> - ["Test that destructive operations in test bif does not really happen"]; -destructive_in_test_bif(suite) -> []; +%% Test that a dead tracer is removed using ms +ms_trace_dead(_Config) -> + Self = self(), + TFun = fun F() -> receive M -> Self ! M, F() end end, + {Tracer, MRef} = spawn_monitor(TFun), + MetaTracer = spawn_link(TFun), + erlang:trace_pattern({?MODULE, f1, '_'}, + [{'_',[],[{message, false}, + {trace,[], + [call,{const,{tracer,Tracer}}]}]}], + [{meta, MetaTracer}]), + erlang:trace_pattern({?MODULE, f2, '_'}, []), + ?MODULE:f2(1,2), + ?MODULE:f1(1), + {tracer,Tracer} = erlang:trace_info(self(), tracer), + {flags,[call]} = erlang:trace_info(self(), flags), + ?MODULE:f2(2,3), + receive {trace, Self, call, {?MODULE, f2, _}} -> ok end, + exit(Tracer, stop), + receive {'DOWN',MRef,_,_,_} -> ok end, + ?MODULE:f1(2), + {tracer,[]} = erlang:trace_info(self(), tracer), + ?MODULE:f2(3,4), + TRef = erlang:trace_delivered(all), + receive {trace_delivered, _, TRef} -> ok end, + receive M -> ct:fail({unexpected, M}) after 10 -> ok end. + +%% Test that destructive operations in test bif does not really happen destructive_in_test_bif(Config) when is_list(Config) -> - ?line {ok,OldToken,_,_} = erlang:match_spec_test + {ok,OldToken,_,_} = erlang:match_spec_test ([], [{'_',[],[{message,{get_seq_token}}]}],trace), - ?line {ok,_,_,_} = erlang:match_spec_test + {ok,_,_,_} = erlang:match_spec_test ([], [{'_',[],[{message,{set_seq_token, label, 1}}]}], trace), - ?line {ok,OldToken,_,_} = erlang:match_spec_test + {ok,OldToken,_,_} = erlang:match_spec_test ([], [{'_',[],[{message,{get_seq_token}}]}],trace), - ?line {ok, OldTCW,_,_} = erlang:match_spec_test + {ok, OldTCW,_,_} = erlang:match_spec_test ([],[{'_',[],[{message,{get_tcw}}]}],trace), - ?line {ok,OldTCW,_,_} = erlang:match_spec_test + {ok,OldTCW,_,_} = erlang:match_spec_test ([], [{'_',[],[{message,{set_tcw, OldTCW+1}}]}], trace), - ?line {ok, OldTCW,_,_} = erlang:match_spec_test + {ok, OldTCW,_,_} = erlang:match_spec_test ([],[{'_',[],[{message,{get_tcw}}]}],trace), ok. -boxed_and_small(doc) -> - ["Test that the comparision between boxed and small does not crash emulator"]; -boxed_and_small(suite) -> []; +%% Test that the comparision between boxed and small does not crash emulator boxed_and_small(Config) when is_list(Config) -> - ?line {ok, Node} = start_node(match_spec_suite_other), - ?line ok = rpc:call(Node,?MODULE,do_boxed_and_small,[]), - ?line stop_node(Node), + {ok, Node} = start_node(match_spec_suite_other), + ok = rpc:call(Node,?MODULE,do_boxed_and_small,[]), + stop_node(Node), ok. do_boxed_and_small() -> @@ -739,13 +660,11 @@ do_boxed_and_small() -> {ok, false, _, _} = erlang:match_spec_test({0,3},[{{make_ref(),'_'},[],['$_']}],table), ok. -faulty_seq_trace(doc) -> - ["Test that faulty seq_trace_call does not crash emulator"]; -faulty_seq_trace(suite) -> []; +%% Test that faulty seq_trace_call does not crash emulator faulty_seq_trace(Config) when is_list(Config) -> - ?line {ok, Node} = start_node(match_spec_suite_other), - ?line ok = rpc:call(Node,?MODULE,do_faulty_seq_trace,[]), - ?line stop_node(Node), + {ok, Node} = start_node(match_spec_suite_other), + ok = rpc:call(Node,?MODULE,do_faulty_seq_trace,[]), + stop_node(Node), ok. do_faulty_seq_trace() -> @@ -757,63 +676,58 @@ errchk(Pat) -> {'EXIT', {badarg, _}} -> ok; Other -> - test_server:fail({noerror, Other}) + ct:fail({noerror, Other}) end. -unary_minus(suite) -> - []; -unary_minus(doc) -> - ["Checks that unary minus works"]; +%% Checks that unary minus works unary_minus(Config) when is_list(Config) -> - ?line {ok,true,[],[]} = erlang:match_spec_test + {ok,true,[],[]} = erlang:match_spec_test (5, [{'$1', [{'<',{'-','$1'},-4}], [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (5, [{'$1', [{'<',{'-','$1'},-6}], [true]}], table), - ?line {ok,true,[],[]} = erlang:match_spec_test + {ok,true,[],[]} = erlang:match_spec_test (5, [{'$1', [{'=:=',{'-','$1',2},3}], [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (hej, [{'$1', [{'=/=',{'-','$1'},0}], [true]}], table), ok. -unary_plus(suite) -> - []; -unary_plus(doc) -> - ["Checks that unary plus works"]; + +%% Checks that unary plus works unary_plus(Config) when is_list(Config) -> - ?line {ok,true,[],[]} = erlang:match_spec_test + {ok,true,[],[]} = erlang:match_spec_test (5, [{'$1', [{'<',{'+','$1'},6}], [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (5, [{'$1', [{'<',{'+','$1'},4}], [true]}], table), - ?line {ok,true,[],[]} = erlang:match_spec_test + {ok,true,[],[]} = erlang:match_spec_test (5, [{'$1', [{'=:=',{'+','$1',2},7}], [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (hej, [{'$1', [{'=/=',{'+','$1'},0}], @@ -824,53 +738,50 @@ unary_plus(Config) when is_list(Config) -> -guard_exceptions(suite) -> - []; -guard_exceptions(doc) -> - ["Checks that exceptions in guards are handled correctly"]; +%% Checks that exceptions in guards are handled correctly guard_exceptions(Config) when is_list(Config) -> - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (5, [{'$1', [{'or',{is_integer,'$1'},{'or','$1','$1'}}], [true]}], table), - ?line {ok,true,[],[]} = erlang:match_spec_test + {ok,true,[],[]} = erlang:match_spec_test (5, [{'$1', [{'orelse',{is_integer,'$1'}, {'or','$1','$1'}}], [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (5, [{'$1', [{'orelse',{'or','$1',true}, {is_integer,'$1'}}], [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (5, [{'$1', [{'or',{is_integer,'$1'}, {'orelse','$1',true}}], [true]}], table), - ?line {ok,true,[],[]} = erlang:match_spec_test + {ok,true,[],[]} = erlang:match_spec_test (5, [{'$1', [{'or',{is_integer,'$1'}, {'orelse',true,'$1'}}], [true]}], table), - ?line {ok,true,[],[]} = erlang:match_spec_test + {ok,true,[],[]} = erlang:match_spec_test (5, [{'$1', [{'or',{is_integer,'$1'}, {'andalso',false,'$1'}}], [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (5, [{'$1', [{'or',{is_integer,'$1'}, @@ -878,7 +789,7 @@ guard_exceptions(Config) when is_list(Config) -> [true]}], table), - ?line {ok,false,[],[]} = erlang:match_spec_test + {ok,false,[],[]} = erlang:match_spec_test (5, [{'$1', [{'or',{is_integer,'$1'}, @@ -888,19 +799,16 @@ guard_exceptions(Config) when is_list(Config) -> ok. -fpe(suite) -> - []; -fpe(doc) -> - ["Checks floating point exceptions in match-specs"]; +%% Checks floating point exceptions in match-specs fpe(Config) when is_list(Config) -> MS = [{{'$1'},[],[{'/','$1',0}]}], case catch (['EXIT','EXIT'] = ets:match_spec_run([{1},{2}],ets:match_spec_compile(MS))) of - {'EXIT',_} -> test_server:fail({error, - "Floating point exceptions faulty"}); + {'EXIT',_} -> ct:fail({error, "Floating point exceptions faulty"}); _ -> ok end. +%% Test maps in match-specs maps(Config) when is_list(Config) -> {ok,#{},[],[]} = erlang:match_spec_test(#{}, [{'_',[],['$_']}], table), {ok,#{},[],[]} = erlang:match_spec_test(#{}, [{#{},[],['$_']}], table), @@ -980,11 +888,11 @@ moving_labels(Config) when is_list(Config) -> %% point at their correct target. %% Ms = [{{'$1','$2'},[],[{{ok,{'andalso','$1','$2'},[1,2,3]}}]}], - ?line {ok,{ok,false,[1,2,3]},[],[]} = + {ok,{ok,false,[1,2,3]},[],[]} = erlang:match_spec_test({true,false}, Ms, table), Ms2 = [{{'$1','$2'},[],[{{ok,{'orelse','$1','$2'},[1,2,3]}}]}], - ?line {ok,{ok,true,[1,2,3]},[],[]} = + {ok,{ok,true,[1,2,3]},[],[]} = erlang:match_spec_test({true,false}, Ms2, table), ok. @@ -995,13 +903,13 @@ tr(Fun, MFA, Pat, Expected) -> tr(Fun, MFA, TraceFlags, Pat, PatFlags, Expected0) -> tr(Fun, fun(P) -> - erlang:trace(P, true, TraceFlags), - erlang:trace_pattern(MFA, Pat, PatFlags), - lists:map( - fun(X) when is_function(X,1) -> X; - (X) -> list_to_tuple([trace, P | tuple_to_list(X)]) - end, - Expected0) + erlang:trace(P, true, TraceFlags), + erlang:trace_pattern(MFA, Pat, PatFlags), + lists:map( + fun(X) when is_function(X,1) -> X; + (X) -> list_to_tuple([trace, P | tuple_to_list(X)]) + end, + Expected0) end). tr(RunFun, ControlFun) -> @@ -1016,15 +924,19 @@ collect(P, TMs) -> collect([]) -> receive M -> - ?t:format("Got unexpected: ~p~n", [M]), + io:format("Got unexpected: ~p~n", [M]), flush({got_unexpected,M}) after 17 -> ok end; collect([TM | TMs]) -> - ?t:format( "Expecting: ~p~n", [TM]), + io:format( "Expecting: ~p~n", [TM]), receive - M0 -> + %% We only look at trace messages with the same tracee + %% as the message we are looking for. This because + %% the order of trace messages is only guaranteed from + %% within a single process. + M0 when element(2, M0) =:= element(2, TM); is_function(TM, 1) -> M = case element(1, M0) of trace_ts -> list_to_tuple(lists:reverse( @@ -1035,32 +947,34 @@ collect([TM | TMs]) -> true -> case (catch TM(M)) of true -> - ?t:format("Got: ~p~n", [M]), + io:format("Got: ~p~n", [M]), collect(TMs); _ -> - ?t:format("Got unexpected: ~p~n", [M]), + io:format("Got unexpected: ~p~n", [M]), flush({got_unexpected,M}) end; false -> case M of TM -> - ?t:format("Got: ~p~n", [M]), + io:format("Got: ~p~n", [M]), collect(TMs); _ -> - ?t:format("Got unexpected: ~p~n", [M]), + io:format("Got unexpected: ~p~n", [M]), flush({got_unexpected,M}) end end + after 15000 -> + flush(timeout) end. flush(Reason) -> receive - M -> - ?t:format("In queue: ~p~n", [M]), - flush(Reason) + M -> + io:format("In queue: ~p~n", [M]), + flush(Reason) after 17 -> - ?t:fail(Reason) + ct:fail(Reason) end. start_collect(P) -> @@ -1071,33 +985,33 @@ stop_collect(P) -> stop_collect(P, Order) -> P ! {Order, self()}, receive - {gone, P} -> - ok + {gone, P} -> + ok end. runner(Collector, Fun) -> receive - {go, Collector} -> - go + {go, Collector} -> + go end, Fun(), receive - {done, Collector} -> - Collector ! {gone, self()} + {done, Collector} -> + Collector ! {gone, self()} end. loop_runner(Collector, Fun, Laps) -> receive - {go, Collector} -> - go + {go, Collector} -> + go end, loop_runner_cont(Collector, Fun, 0, Laps). loop_runner_cont(Collector, _Fun, Laps, Laps) -> receive - {done, Collector} -> ok; - {abort, Collector} -> ok + {done, Collector} -> ok; + {abort, Collector} -> ok end, io:format("loop_runner ~p exit after ~p laps\n", [self(), Laps]), Collector ! {gone, self()}; @@ -1105,11 +1019,11 @@ loop_runner_cont(Collector, _Fun, Laps, Laps) -> loop_runner_cont(Collector, Fun, N, Laps) -> Fun(), receive - {abort, Collector} -> - io:format("loop_runner ~p aborted after ~p of ~p laps\n", [self(), N+1, Laps]), - Collector ! {gone, self()} + {abort, Collector} -> + io:format("loop_runner ~p aborted after ~p of ~p laps\n", [self(), N+1, Laps]), + Collector ! {gone, self()} after 0 -> - loop_runner_cont(Collector, Fun, N+1, Laps) + loop_runner_cont(Collector, Fun, N+1, Laps) end. @@ -1141,7 +1055,7 @@ start_node(Name) -> Pa = filename:dirname(code:which(?MODULE)), Cookie = atom_to_list(erlang:get_cookie()), test_server:start_node(Name, slave, - [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]). + [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]). stop_node(Node) -> test_server:stop_node(Node). diff --git a/erts/emulator/test/message_queue_data_SUITE.erl b/erts/emulator/test/message_queue_data_SUITE.erl new file mode 100644 index 0000000000..226462676c --- /dev/null +++ b/erts/emulator/test/message_queue_data_SUITE.erl @@ -0,0 +1,235 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(message_queue_data_SUITE). + +-export([all/0, suite/0]). +-export([basic/1, process_info_messages/1, total_heap_size/1]). + +-export([basic_test/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. + +all() -> + [basic, process_info_messages, total_heap_size]. + +%% +%% +%% Test cases +%% +%% + +basic(Config) when is_list(Config) -> + + basic_test(erlang:system_info(message_queue_data)), + + {ok, Node1} = start_node(Config, "+hmqd off_heap"), + ok = rpc:call(Node1, ?MODULE, basic_test, [off_heap]), + stop_node(Node1), + + {ok, Node2} = start_node(Config, "+hmqd on_heap"), + ok = rpc:call(Node2, ?MODULE, basic_test, [on_heap]), + stop_node(Node2), + + {ok, Node3} = start_node(Config, "+hmqd mixed"), + ok = rpc:call(Node3, ?MODULE, basic_test, [mixed]), + stop_node(Node3), + + ok. + +is_valid_mqd_value(off_heap) -> + true; +is_valid_mqd_value(on_heap) -> + true; +is_valid_mqd_value(mixed) -> + true; +is_valid_mqd_value(_) -> + false. + + +basic_test(Default) -> + + Default = erlang:system_info(message_queue_data), + true = is_valid_mqd_value(Default), + + {message_queue_data, Default} = process_info(self(), message_queue_data), + Default = process_flag(message_queue_data, off_heap), + {message_queue_data, off_heap} = process_info(self(), message_queue_data), + off_heap = process_flag(message_queue_data, on_heap), + {message_queue_data, on_heap} = process_info(self(), message_queue_data), + on_heap = process_flag(message_queue_data, mixed), + {message_queue_data, mixed} = process_info(self(), message_queue_data), + mixed = process_flag(message_queue_data, Default), + {'EXIT', _} = (catch process_flag(message_queue_data, blupp)), + + P1 = spawn_opt(fun () -> receive after infinity -> ok end end, + [link]), + {message_queue_data, Default} = process_info(P1, message_queue_data), + unlink(P1), + exit(P1, bye), + + P2 = spawn_opt(fun () -> receive after infinity -> ok end end, + [link, {message_queue_data, off_heap}]), + {message_queue_data, off_heap} = process_info(P2, message_queue_data), + unlink(P2), + exit(P2, bye), + + P3 = spawn_opt(fun () -> receive after infinity -> ok end end, + [link, {message_queue_data, on_heap}]), + {message_queue_data, on_heap} = process_info(P3, message_queue_data), + unlink(P3), + exit(P3, bye), + + P4 = spawn_opt(fun () -> receive after infinity -> ok end end, + [link, {message_queue_data, mixed}]), + {message_queue_data, mixed} = process_info(P4, message_queue_data), + unlink(P4), + exit(P4, bye), + + {'EXIT', _} = (catch spawn_opt(fun () -> receive after infinity -> ok end end, + [link, {message_queue_data, blapp}])), + + ok. + +process_info_messages(Config) when is_list(Config) -> + Tester = self(), + P1 = spawn_opt(fun () -> + receive after 500 -> ok end, + mixed = process_flag(message_queue_data, off_heap), + Tester ! first, + receive after 500 -> ok end, + off_heap = process_flag(message_queue_data, on_heap), + Tester ! second, + receive after 500 -> ok end, + on_heap = process_flag(message_queue_data, mixed), + Tester ! third, + receive after 500 -> ok end, + mixed = process_flag(message_queue_data, off_heap), + Tester ! fourth, + + receive after infinity -> ok end + end, + [link, {message_queue_data, mixed}]), + + P1 ! "A", + receive first -> ok end, + P1 ! "B", + receive second -> ok end, + P1 ! "C", + receive third -> ok end, + P1 ! "D", + receive fourth -> ok end, + P1 ! "E", + + {messages, ["A", "B", "C", "D", "E"]} = process_info(P1, messages), + + P2 = spawn_opt(fun () -> + receive after 500 -> ok end, + mixed = process_flag(message_queue_data, off_heap), + Tester ! first, + receive after 500 -> ok end, + off_heap = process_flag(message_queue_data, on_heap), + Tester ! second, + receive after 500 -> ok end, + on_heap = process_flag(message_queue_data, mixed), + Tester ! third, + receive after 500 -> ok end, + mixed = process_flag(message_queue_data, off_heap), + Tester ! fourth, + receive after 500 -> ok end, + + Tester ! process_info(self(), messages), + + receive M1 -> M1 = "A" end, + receive M2 -> M2 = "B" end, + receive M3 -> M3 = "C" end, + receive M4 -> M4 = "D" end, + receive M5 -> M5 = "E" end, + + Tester ! self() + end, + [link, {message_queue_data, mixed}]), + + P2 ! "A", + receive first -> ok end, + P2 ! "B", + receive second -> ok end, + P2 ! "C", + receive third -> ok end, + P2 ! "D", + receive fourth -> ok end, + P2 ! "E", + + receive + Msg -> + {messages, ["A", "B", "C", "D", "E"]} = Msg + end, + + receive P2 -> ok end, + + ok. + +total_heap_size(_Config) -> + + Fun = fun F() -> receive Pid when is_pid(Pid) -> Pid ! ok,F() end end, + + %% Test that on_heap messages grow the heap even if they are not received + OnPid = spawn_opt(Fun, [{message_queue_data, on_heap}]), + {total_heap_size, OnSize} = erlang:process_info(OnPid, total_heap_size), + [OnPid ! lists:duplicate(N,N) || N <- lists:seq(1,100)], + OnPid ! self(), receive ok -> ok end, + {total_heap_size, OnSizeAfter} = erlang:process_info(OnPid, total_heap_size), + ct:log("OnSize = ~p, OnSizeAfter = ~p",[OnSize, OnSizeAfter]), + true = OnSize < OnSizeAfter, + + %% Test that off_heap messages do not grow the heap if they are not received + OffPid = spawn_opt(Fun, [{message_queue_data, off_heap}]), + {total_heap_size, OffSize} = erlang:process_info(OffPid, total_heap_size), + [OffPid ! lists:duplicate(N,N) || N <- lists:seq(1,100)], + OffPid ! self(), receive ok -> ok end, + {total_heap_size, OffSizeAfter} = erlang:process_info(OffPid, total_heap_size), + ct:log("OffSize = ~p, OffSizeAfter = ~p",[OffSize, OffSizeAfter]), + true = OffSize == OffSizeAfter. + +%% +%% +%% helpers +%% +%% + +start_node(Config) -> + start_node(Config, []). +start_node(Config, Opts) when is_list(Config), is_list(Opts) -> + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + test_server:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). + +stop_node(Node) -> + test_server:stop_node(Node). diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl index 7c2101ca05..ba9b564fdc 100644 --- a/erts/emulator/test/module_info_SUITE.erl +++ b/erts/emulator/test/module_info_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,11 +20,9 @@ -module(module_info_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --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([all/0, suite/0, exports/1,functions/1,deleted/1,native/1,info/1]). %%-compile(native). @@ -32,46 +30,23 @@ %% Helper. -export([native_proj/1,native_filter/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> modules(). -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - modules() -> [exports, functions, deleted, native, info]. -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(3)), - [{watchdog,Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - %% Should return all functions exported from this module. (local) all_exported() -> All = add_arity(modules()), - lists:sort([{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}, - {module_info,0},{module_info,1},{native_proj,1}, - {native_filter,1}|All]). + lists:sort([{all,0},{suite,0}, + {module_info,0},{module_info,1}, + {native_proj,1}, + {native_filter,1}|All]). %% Should return all functions in this module. (local) all_functions() -> @@ -95,7 +70,7 @@ functions(Config) when is_list(Config) -> %% Test that deleted modules cause badarg deleted(Config) when is_list(Config) -> - Data = ?config(data_dir, Config), + Data = proplists:get_value(data_dir, Config), File = filename:join(Data, "module_info_test"), {ok,module_info_test,Code} = compile:file(File, [binary]), {module,module_info_test} = erlang:load_module(module_info_test, Code), diff --git a/erts/emulator/test/monitor_SUITE.erl b/erts/emulator/test/monitor_SUITE.erl index 4db17969c0..8955e62df5 100644 --- a/erts/emulator/test/monitor_SUITE.erl +++ b/erts/emulator/test/monitor_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,21 +20,20 @@ -module(monitor_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - 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, - monitor_time_offset/1]). - --export([init_per_testcase/2, end_per_testcase/2]). +-export([all/0, suite/0, groups/0, + 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, + monitor_time_offset/1]). -export([y2/1, g/1, g0/0, g1/0, large_exit_sub/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 15}}]. all() -> [case_1, case_1a, case_2, case_2a, mon_e_1, demon_e_1, @@ -47,132 +46,103 @@ groups() -> [{remove_monitor, [], [local_remove_monitor, remote_remove_monitor]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(15)), - [{watchdog, Dog},{testcase, Func}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -case_1(doc) -> - "A monitors B, B kills A and then exits (yielded core dump)"; -case_1(suite) -> []; +%% A monitors B, B kills A and then exits (yielded core dump) case_1(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line spawn_link(?MODULE, g0, []), - ?line receive _ -> ok end, + process_flag(trap_exit, true), + spawn_link(?MODULE, g0, []), + receive _ -> ok end, ok. -case_1a(doc) -> - "A monitors B, B kills A and then exits (yielded core dump)"; +%% A monitors B, B kills A and then exits (yielded core dump) case_1a(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line spawn_link(?MODULE, g1, []), - ?line receive _ -> ok end, + process_flag(trap_exit, true), + spawn_link(?MODULE, g1, []), + receive _ -> ok end, ok. g0() -> - ?line B = spawn(?MODULE, g, [self()]), - ?line erlang:monitor(process, B), - ?line B ! ok, - ?line receive ok -> ok end, + B = spawn(?MODULE, g, [self()]), + erlang:monitor(process, B), + B ! ok, + receive ok -> ok end, ok. g1() -> - ?line {B,_} = spawn_monitor(?MODULE, g, [self()]), - ?line B ! ok, - ?line receive ok -> ok end, + {B,_} = spawn_monitor(?MODULE, g, [self()]), + B ! ok, + receive ok -> ok end, ok. g(Parent) -> - ?line receive ok -> ok end, - ?line exit(Parent, foo), - ?line ok. + receive ok -> ok end, + exit(Parent, foo), + ok. -case_2(doc) -> - "A monitors B, B demonitors A (yielded core dump)"; +%% A monitors B, B demonitors A (yielded core dump) case_2(Config) when is_list(Config) -> - ?line B = spawn(?MODULE, y2, [self()]), - ?line R = erlang:monitor(process, B), - ?line B ! R, - ?line receive - {'EXIT', _} -> ok; - Other -> - test_server:fail({rec, Other}) - end, - ?line expect_down(R, B, normal), + B = spawn(?MODULE, y2, [self()]), + R = erlang:monitor(process, B), + B ! R, + receive + {'EXIT', _} -> ok; + Other -> + ct:fail({rec, Other}) + end, + expect_down(R, B, normal), ok. -case_2a(doc) -> - "A monitors B, B demonitors A (yielded core dump)"; +%% A monitors B, B demonitors A (yielded core dump) case_2a(Config) when is_list(Config) -> - ?line {B,R} = spawn_monitor(?MODULE, y2, [self()]), - ?line B ! R, - ?line receive - {'EXIT', _} -> ok; - Other -> - test_server:fail({rec, Other}) - end, - ?line expect_down(R, B, normal), + {B,R} = spawn_monitor(?MODULE, y2, [self()]), + B ! R, + receive + {'EXIT', _} -> ok; + Other -> + ct:fail({rec, Other}) + end, + expect_down(R, B, normal), ok. y2(Parent) -> - ?line R = receive T -> T end, - ?line Parent ! (catch erlang:demonitor(R)), + R = receive T -> T end, + Parent ! (catch erlang:demonitor(R)), ok. expect_down(Ref, P) -> receive - {'DOWN', Ref, process, P, Reason} -> - Reason; - Other -> - test_server:fail({rec, Other}) + {'DOWN', Ref, process, P, Reason} -> + Reason; + Other -> + ct:fail({rec, Other}) end. expect_down(Ref, P, Reason) -> receive - {'DOWN', Ref, process, P, Reason} -> - ok; - Other -> - test_server:fail({rec, Other}) + {'DOWN', Ref, process, P, Reason} -> + ok; + Other -> + ct:fail({rec, Other}) end. expect_no_msg() -> receive - Msg -> - test_server:fail({msg, Msg}) + Msg -> + ct:fail({msg, Msg}) after 0 -> - ok + ok end. %%% Error cases for monitor/2 -mon_e_1(doc) -> - "Error cases for monitor/2"; -mon_e_1(suite) -> []; mon_e_1(Config) when is_list(Config) -> - ?line {ok, N} = test_server:start_node(hej, slave, []), - ?line mon_error(plutt, self()), - ?line mon_error(process, [bingo]), - ?line mon_error(process, {rex, N, junk}), - ?line mon_error(process, 1), + {ok, N} = test_server:start_node(hej, slave, []), + mon_error(plutt, self()), + mon_error(process, [bingo]), + mon_error(process, {rex, N, junk}), + mon_error(process, 1), - ?line true = test_server:stop_node(N), + true = test_server:stop_node(N), ok. %%% We would also like to have a test case that tries to monitor something @@ -185,155 +155,142 @@ mon_e_1(Config) when is_list(Config) -> mon_error(Type, Item) -> case catch erlang:monitor(Type, Item) of - {'EXIT', _} -> - ok; - Other -> - test_server:fail({err, Other}) + {'EXIT', _} -> + ok; + Other -> + ct:fail({err, Other}) end. %%% Error cases for demonitor/1 -demon_e_1(doc) -> - "Error cases for demonitor/1"; -demon_e_1(suite) -> []; demon_e_1(Config) when is_list(Config) -> - ?line {ok, N} = test_server:start_node(hej, slave, []), - ?line demon_error(plutt, badarg), - ?line demon_error(1, badarg), + {ok, N} = test_server:start_node(hej, slave, []), + demon_error(plutt, badarg), + demon_error(1, badarg), %% Demonitor with ref created at other node - ?line R1 = rpc:call(N, erlang, make_ref, []), - ?line demon_error(R1, badarg), + R1 = rpc:call(N, erlang, make_ref, []), + demon_error(R1, badarg), %% Demonitor with ref created at wrong monitor link end - ?line P0 = self(), - ?line P2 = spawn( - fun() -> - P0 ! {self(), ref, erlang:monitor(process,P0)}, - receive {P0, stop} -> ok end - end ), - ?line receive - {P2, ref, R2} -> - ?line demon_error(R2, badarg), - ?line P2 ! {self(), stop}; - Other2 -> - test_server:fail({rec, Other2}) - end, - - ?line true = test_server:stop_node(N), + P0 = self(), + P2 = spawn( + fun() -> + P0 ! {self(), ref, erlang:monitor(process,P0)}, + receive {P0, stop} -> ok end + end ), + receive + {P2, ref, R2} -> + demon_error(R2, badarg), + P2 ! {self(), stop}; + Other2 -> + ct:fail({rec, Other2}) + end, + + true = test_server:stop_node(N), ok. demon_error(Ref, Reason) -> case catch erlang:demonitor(Ref) of - {'EXIT', {Reason, _}} -> - ok; - Other -> - test_server:fail({err, Other}) + {'EXIT', {Reason, _}} -> + ok; + Other -> + ct:fail({err, Other}) end. %%% No-op cases for demonitor/1 -demon_1(doc) -> - "demonitor/1"; -demon_1(suite) -> []; demon_1(Config) when is_list(Config) -> - ?line true = erlang:demonitor(make_ref()), + true = erlang:demonitor(make_ref()), ok. %%% Cases for demonitor/1 -demon_2(doc) -> - "Cases for demonitor/1"; -demon_2(suite) -> []; demon_2(Config) when is_list(Config) -> - ?line R1 = erlang:monitor(process, self()), - ?line true = erlang:demonitor(R1), + R1 = erlang:monitor(process, self()), + true = erlang:demonitor(R1), %% Extra demonitor - ?line true = erlang:demonitor(R1), - ?line expect_no_msg(), + true = erlang:demonitor(R1), + expect_no_msg(), %% Normal 'DOWN' - ?line P2 = spawn(timer, sleep, [1]), - ?line R2 = erlang:monitor(process, P2), - ?line case expect_down(R2, P2) of - normal -> ?line ok; - noproc -> ?line ok; - BadReason -> ?line ?t:fail({bad_reason, BadReason}) - end, - -%% OTP-5772 -% %% 'DOWN' before demonitor -% ?line P3 = spawn(timer, sleep, [100000]), -% ?line R3 = erlang:monitor(process, P3), -% ?line exit(P3, frop), -% ?line erlang:demonitor(R3), -% ?line expect_down(R3, P3, frop), + P2 = spawn(timer, sleep, [1]), + R2 = erlang:monitor(process, P2), + case expect_down(R2, P2) of + normal -> ok; + noproc -> ok; + BadReason -> ct:fail({bad_reason, BadReason}) + end, + + %% OTP-5772 + % %% 'DOWN' before demonitor + % P3 = spawn(timer, sleep, [100000]), + % R3 = erlang:monitor(process, P3), + % exit(P3, frop), + % erlang:demonitor(R3), + % expect_down(R3, P3, frop), %% Demonitor before 'DOWN' - ?line P4 = spawn(timer, sleep, [100000]), - ?line R4 = erlang:monitor(process, P4), - ?line erlang:demonitor(R4), - ?line exit(P4, frop), - ?line expect_no_msg(), + P4 = spawn(timer, sleep, [100000]), + R4 = erlang:monitor(process, P4), + erlang:demonitor(R4), + exit(P4, frop), + expect_no_msg(), ok. -demon_3(doc) -> - "Distributed case for demonitor/1 (OTP-3499)"; -demon_3(suite) -> []; +%% Distributed case for demonitor/1 (OTP-3499) demon_3(Config) when is_list(Config) -> - ?line {ok, N} = test_server:start_node(hej, slave, []), + {ok, N} = test_server:start_node(hej, slave, []), %% 'DOWN' before demonitor - ?line P2 = spawn(N, timer, sleep, [100000]), - ?line R2 = erlang:monitor(process, P2), - ?line true = test_server:stop_node(N), - ?line true = erlang:demonitor(R2), - ?line expect_down(R2, P2, noconnection), + P2 = spawn(N, timer, sleep, [100000]), + R2 = erlang:monitor(process, P2), + true = test_server:stop_node(N), + true = erlang:demonitor(R2), + expect_down(R2, P2, noconnection), - ?line {ok, N2} = test_server:start_node(hej, slave, []), + {ok, N2} = test_server:start_node(hej, slave, []), %% Demonitor before 'DOWN' - ?line P3 = spawn(N2, timer, sleep, [100000]), - ?line R3 = erlang:monitor(process, P3), - ?line true = erlang:demonitor(R3), - ?line true = test_server:stop_node(N2), - ?line expect_no_msg(), + P3 = spawn(N2, timer, sleep, [100000]), + R3 = erlang:monitor(process, P3), + true = erlang:demonitor(R3), + true = test_server:stop_node(N2), + expect_no_msg(), ok. -demonitor_flush(suite) -> []; -demonitor_flush(doc) -> []; demonitor_flush(Config) when is_list(Config) -> - ?line {'EXIT', {badarg, _}} = (catch erlang:demonitor(make_ref(), flush)), - ?line {'EXIT', {badarg, _}} = (catch erlang:demonitor(make_ref(), [flus])), - ?line {'EXIT', {badarg, _}} = (catch erlang:demonitor(x, [flush])), - ?line {ok, N} = test_server:start_node(demonitor_flush, slave, []), - ?line ok = demonitor_flush_test(N), - ?line true = test_server:stop_node(N), - ?line ok = demonitor_flush_test(node()). - + {'EXIT', {badarg, _}} = (catch erlang:demonitor(make_ref(), flush)), + {'EXIT', {badarg, _}} = (catch erlang:demonitor(make_ref(), [flus])), + {'EXIT', {badarg, _}} = (catch erlang:demonitor(x, [flush])), + {ok, N} = test_server:start_node(demonitor_flush, slave, []), + ok = demonitor_flush_test(N), + true = test_server:stop_node(N), + ok = demonitor_flush_test(node()). + demonitor_flush_test(Node) -> - ?line P = spawn(Node, timer, sleep, [100000]), - ?line M1 = erlang:monitor(process, P), - ?line M2 = erlang:monitor(process, P), - ?line M3 = erlang:monitor(process, P), - ?line M4 = erlang:monitor(process, P), - ?line true = erlang:demonitor(M1, [flush, flush]), - ?line exit(P, bang), - ?line receive {'DOWN', M2, process, P, bang} -> ok end, - ?line receive after 100 -> ok end, - ?line true = erlang:demonitor(M3, [flush]), - ?line true = erlang:demonitor(M4, []), - ?line receive {'DOWN', M4, process, P, bang} -> ok end, - ?line receive - {'DOWN', M, _, _, _} =DM when M == M1, - M == M3 -> - ?line ?t:fail({unexpected_down_message, DM}) - after 100 -> - ?line ok - end. + P = spawn(Node, timer, sleep, [100000]), + M1 = erlang:monitor(process, P), + M2 = erlang:monitor(process, P), + M3 = erlang:monitor(process, P), + M4 = erlang:monitor(process, P), + true = erlang:demonitor(M1, [flush, flush]), + exit(P, bang), + receive {'DOWN', M2, process, P, bang} -> ok end, + receive after 100 -> ok end, + true = erlang:demonitor(M3, [flush]), + true = erlang:demonitor(M4, []), + receive {'DOWN', M4, process, P, bang} -> ok end, + receive + {'DOWN', M, _, _, _} =DM when M == M1, + M == M3 -> + ct:fail({unexpected_down_message, DM}) + after 100 -> + ok + end. -define(RM_MON_GROUPS, 100). -define(RM_MON_GPROCS, 100). @@ -341,33 +298,33 @@ demonitor_flush_test(Node) -> local_remove_monitor(Config) when is_list(Config) -> Gs = generate(fun () -> start_remove_monitor_group(node()) end, - ?RM_MON_GROUPS), + ?RM_MON_GROUPS), {True, False} = lists:foldl(fun (G, {T, F}) -> - receive - {rm_mon_res, G, {GT, GF}} -> - {T+GT, F+GF} - end - end, - {0, 0}, - Gs), + receive + {rm_mon_res, G, {GT, GF}} -> + {T+GT, F+GF} + end + end, + {0, 0}, + Gs), erlang:display({local_remove_monitor, True, False}), {comment, "True = "++integer_to_list(True)++"; False = "++integer_to_list(False)}. - + remote_remove_monitor(Config) when is_list(Config) -> - ?line {ok, N} = test_server:start_node(demonitor_flush, slave, []), + {ok, N} = test_server:start_node(demonitor_flush, slave, []), Gs = generate(fun () -> start_remove_monitor_group(node()) end, - ?RM_MON_GROUPS), + ?RM_MON_GROUPS), {True, False} = lists:foldl(fun (G, {T, F}) -> - receive - {rm_mon_res, G, {GT, GF}} -> - {T+GT, F+GF} - end - end, - {0, 0}, - Gs), + receive + {rm_mon_res, G, {GT, GF}} -> + {T+GT, F+GF} + end + end, + {0, 0}, + Gs), erlang:display({remote_remove_monitor, True, False}), - ?line true = test_server:stop_node(N), + true = test_server:stop_node(N), {comment, "True = "++integer_to_list(True)++"; False = "++integer_to_list(False)}. @@ -375,161 +332,153 @@ start_remove_monitor_group(Node) -> Master = self(), spawn_link( fun () -> - Ms = generate(fun () -> - P = spawn(Node, fun () -> ok end), - erlang:monitor(process, P) - end, ?RM_MON_GPROCS), - Res = lists:foldl(fun (M, {T, F}) -> - case erlang:demonitor(M, [info]) of - true -> - receive - {'DOWN', M, _, _, _} -> - exit(down_msg_found) - after 0 -> - ok - end, - {T+1, F}; - false -> - receive - {'DOWN', M, _, _, _} -> - ok - after 0 -> - exit(no_down_msg_found) - end, - {T, F+1} - end - end, - {0,0}, - Ms), - Master ! {rm_mon_res, self(), Res} + Ms = generate(fun () -> + P = spawn(Node, fun () -> ok end), + erlang:monitor(process, P) + end, ?RM_MON_GPROCS), + Res = lists:foldl(fun (M, {T, F}) -> + case erlang:demonitor(M, [info]) of + true -> + receive + {'DOWN', M, _, _, _} -> + exit(down_msg_found) + after 0 -> + ok + end, + {T+1, F}; + false -> + receive + {'DOWN', M, _, _, _} -> + ok + after 0 -> + exit(no_down_msg_found) + end, + {T, F+1} + end + end, + {0,0}, + Ms), + Master ! {rm_mon_res, self(), Res} end). - - + + %%% Cases for monitor/2 -mon_1(doc) -> - "Cases for monitor/2"; -mon_1(suite) -> []; mon_1(Config) when is_list(Config) -> %% Normal case - ?line P2 = spawn(timer, sleep, [1]), - ?line R2 = erlang:monitor(process, P2), - ?line case expect_down(R2, P2) of - normal -> ?line ok; - noproc -> ?line ok; - BadReason -> ?line ?t:fail({bad_reason, BadReason}) - end, - ?line {P2A,R2A} = spawn_monitor(timer, sleep, [1]), - ?line expect_down(R2A, P2A, normal), + P2 = spawn(timer, sleep, [1]), + R2 = erlang:monitor(process, P2), + case expect_down(R2, P2) of + normal -> ok; + noproc -> ok; + BadReason -> ct:fail({bad_reason, BadReason}) + end, + {P2A,R2A} = spawn_monitor(timer, sleep, [1]), + expect_down(R2A, P2A, normal), %% 'DOWN' with other reason - ?line P3 = spawn(timer, sleep, [100000]), - ?line R3 = erlang:monitor(process, P3), - ?line exit(P3, frop), - ?line expect_down(R3, P3, frop), - ?line {P3A,R3A} = spawn_monitor(timer, sleep, [100000]), - ?line exit(P3A, frop), - ?line expect_down(R3A, P3A, frop), + P3 = spawn(timer, sleep, [100000]), + R3 = erlang:monitor(process, P3), + exit(P3, frop), + expect_down(R3, P3, frop), + {P3A,R3A} = spawn_monitor(timer, sleep, [100000]), + exit(P3A, frop), + expect_down(R3A, P3A, frop), %% Monitor fails because process is dead - ?line R4 = erlang:monitor(process, P3), - ?line expect_down(R4, P3, noproc), + R4 = erlang:monitor(process, P3), + expect_down(R4, P3, noproc), %% Normal case (named process) - ?line P5 = start_jeeves(jeeves), - ?line R5 = erlang:monitor(process, jeeves), - ?line tell_jeeves(P5, stop), - ?line expect_down(R5, {jeeves, node()}, normal), + P5 = start_jeeves(jeeves), + R5 = erlang:monitor(process, jeeves), + tell_jeeves(P5, stop), + expect_down(R5, {jeeves, node()}, normal), %% 'DOWN' with other reason and node explicit activation - ?line P6 = start_jeeves(jeeves), - ?line R6 = erlang:monitor(process, {jeeves, node()}), - ?line tell_jeeves(P6, {exit, frop}), - ?line expect_down(R6, {jeeves, node()}, frop), + P6 = start_jeeves(jeeves), + R6 = erlang:monitor(process, {jeeves, node()}), + tell_jeeves(P6, {exit, frop}), + expect_down(R6, {jeeves, node()}, frop), %% Monitor (named process) fails because process is dead - ?line R7 = erlang:monitor(process, {jeeves, node()}), - ?line expect_down(R7, {jeeves, node()}, noproc), + R7 = erlang:monitor(process, {jeeves, node()}), + expect_down(R7, {jeeves, node()}, noproc), ok. -mon_2(doc) -> - "Distributed cases for monitor/2"; -mon_2(suite) -> []; +%% Distributed cases for monitor/2 mon_2(Config) when is_list(Config) -> - ?line {ok, N1} = test_server:start_node(hej1, slave, []), + {ok, N1} = test_server:start_node(hej1, slave, []), %% Normal case - ?line P2 = spawn(N1, timer, sleep, [4000]), - ?line R2 = erlang:monitor(process, P2), - ?line expect_down(R2, P2, normal), + P2 = spawn(N1, timer, sleep, [4000]), + R2 = erlang:monitor(process, P2), + expect_down(R2, P2, normal), %% 'DOWN' with other reason - ?line P3 = spawn(N1, timer, sleep, [100000]), - ?line R3 = erlang:monitor(process, P3), - ?line exit(P3, frop), - ?line expect_down(R3, P3, frop), + P3 = spawn(N1, timer, sleep, [100000]), + R3 = erlang:monitor(process, P3), + exit(P3, frop), + expect_down(R3, P3, frop), %% Monitor fails because process is dead - ?line R4 = erlang:monitor(process, P3), - ?line expect_down(R4, P3, noproc), + R4 = erlang:monitor(process, P3), + expect_down(R4, P3, noproc), %% Other node goes down - ?line P5 = spawn(N1, timer, sleep, [100000]), - ?line R5 = erlang:monitor(process, P5), + P5 = spawn(N1, timer, sleep, [100000]), + R5 = erlang:monitor(process, P5), - ?line true = test_server:stop_node(N1), + true = test_server:stop_node(N1), - ?line expect_down(R5, P5, noconnection), + expect_down(R5, P5, noconnection), %% Monitor fails because other node is dead - ?line P6 = spawn(N1, timer, sleep, [100000]), - ?line R6 = erlang:monitor(process, P6), - ?line R6_Reason = expect_down(R6, P6), - ?line true = (R6_Reason == noconnection) orelse (R6_Reason == noproc), + P6 = spawn(N1, timer, sleep, [100000]), + R6 = erlang:monitor(process, P6), + R6_Reason = expect_down(R6, P6), + true = (R6_Reason == noconnection) orelse (R6_Reason == noproc), %% Start a new node that can load code in this module - ?line PA = filename:dirname(code:which(?MODULE)), - ?line {ok, N2} = test_server:start_node - (hej2, slave, [{args, "-pa " ++ PA}]), + PA = filename:dirname(code:which(?MODULE)), + {ok, N2} = test_server:start_node + (hej2, slave, [{args, "-pa " ++ PA}]), %% Normal case (named process) - ?line P7 = start_jeeves({jeeves, N2}), - ?line R7 = erlang:monitor(process, {jeeves, N2}), - ?line tell_jeeves(P7, stop), - ?line expect_down(R7, {jeeves, N2}, normal), + P7 = start_jeeves({jeeves, N2}), + R7 = erlang:monitor(process, {jeeves, N2}), + tell_jeeves(P7, stop), + expect_down(R7, {jeeves, N2}, normal), %% 'DOWN' with other reason (named process) - ?line P8 = start_jeeves({jeeves, N2}), - ?line R8 = erlang:monitor(process, {jeeves, N2}), - ?line tell_jeeves(P8, {exit, frop}), - ?line expect_down(R8, {jeeves, N2}, frop), + P8 = start_jeeves({jeeves, N2}), + R8 = erlang:monitor(process, {jeeves, N2}), + tell_jeeves(P8, {exit, frop}), + expect_down(R8, {jeeves, N2}, frop), %% Monitor (named process) fails because process is dead - ?line R9 = erlang:monitor(process, {jeeves, N2}), - ?line expect_down(R9, {jeeves, N2}, noproc), + R9 = erlang:monitor(process, {jeeves, N2}), + expect_down(R9, {jeeves, N2}, noproc), %% Other node goes down (named process) - ?line _P10 = start_jeeves({jeeves, N2}), - ?line R10 = erlang:monitor(process, {jeeves, N2}), + _P10 = start_jeeves({jeeves, N2}), + R10 = erlang:monitor(process, {jeeves, N2}), - ?line true = test_server:stop_node(N2), + true = test_server:stop_node(N2), - ?line expect_down(R10, {jeeves, N2}, noconnection), + expect_down(R10, {jeeves, N2}, noconnection), %% Monitor (named process) fails because other node is dead - ?line R11 = erlang:monitor(process, {jeeves, N2}), - ?line expect_down(R11, {jeeves, N2}, noconnection), + R11 = erlang:monitor(process, {jeeves, N2}), + expect_down(R11, {jeeves, N2}, noconnection), ok. %%% Large exit reason. Crashed first attempt to release R5B. -large_exit(doc) -> - "Large exit reason"; -large_exit(suite) -> []; large_exit(Config) when is_list(Config) -> - ?line f(100), + f(100), ok. f(0) -> @@ -539,23 +488,23 @@ f(N) -> f(N-1). f() -> - ?line S0 = {big, tuple, with, [list, 4563784278]}, - ?line S = {S0, term_to_binary(S0)}, - ?line P = spawn(?MODULE, large_exit_sub, [S]), - ?line R = erlang:monitor(process, P), - ?line P ! hej, + S0 = {big, tuple, with, [list, 4563784278]}, + S = {S0, term_to_binary(S0)}, + P = spawn(?MODULE, large_exit_sub, [S]), + R = erlang:monitor(process, P), + P ! hej, receive - {'DOWN', R, process, P, X} -> - ?line io:format(" -> ~p~n", [X]), - if - X == S -> - ok; - true -> - test_server:fail({X, S}) - end; - Other -> - ?line io:format(" -> ~p~n", [Other]), - exit({answer, Other}) + {'DOWN', R, process, P, X} -> + io:format(" -> ~p~n", [X]), + if + X == S -> + ok; + true -> + ct:fail({X, S}) + end; + Other -> + io:format(" -> ~p~n", [Other]), + exit({answer, Other}) end. large_exit_sub(S) -> @@ -566,105 +515,99 @@ large_exit_sub(S) -> %%% by using erlang:process_info(self(), monitors) %%% and erlang:process_info(self(), monitored_by) -list_cleanup(doc) -> - "Testing of monitor link list cleanup by using " ++ - "erlang:process_info/2"; -list_cleanup(suite) -> []; list_cleanup(Config) when is_list(Config) -> - ?line P0 = self(), - ?line M = node(), - ?line PA = filename:dirname(code:which(?MODULE)), - ?line true = register(master_bertie, self()), + P0 = self(), + M = node(), + PA = filename:dirname(code:which(?MODULE)), + true = register(master_bertie, self()), %% Normal local case, monitor and demonitor - ?line P1 = start_jeeves(jeeves), - ?line {[], []} = monitors(), - ?line expect_jeeves(P1, monitors, {monitors, {[], []}}), - ?line R1a = erlang:monitor(process, P1), - ?line {[{process, P1}], []} = monitors(), - ?line expect_jeeves(P1, monitors, {monitors, {[], [P0]}}), - ?line true = erlang:demonitor(R1a), - ?line expect_no_msg(), - ?line {[], []} = monitors(), - ?line expect_jeeves(P1, monitors, {monitors, {[], []}}), + P1 = start_jeeves(jeeves), + {[], []} = monitors(), + expect_jeeves(P1, monitors, {monitors, {[], []}}), + R1a = erlang:monitor(process, P1), + {[{process, P1}], []} = monitors(), + expect_jeeves(P1, monitors, {monitors, {[], [P0]}}), + true = erlang:demonitor(R1a), + expect_no_msg(), + {[], []} = monitors(), + expect_jeeves(P1, monitors, {monitors, {[], []}}), %% Remonitor named and try again, now exiting the monitored process - ?line R1b = erlang:monitor(process, jeeves), - ?line {[{process, {jeeves, M}}], []} = monitors(), - ?line expect_jeeves(P1, monitors, {monitors, {[], [P0]}}), - ?line tell_jeeves(P1, stop), - ?line expect_down(R1b, {jeeves, node()}, normal), - ?line {[], []} = monitors(), + R1b = erlang:monitor(process, jeeves), + {[{process, {jeeves, M}}], []} = monitors(), + expect_jeeves(P1, monitors, {monitors, {[], [P0]}}), + tell_jeeves(P1, stop), + expect_down(R1b, {jeeves, node()}, normal), + {[], []} = monitors(), %% Slightly weird local case - the monitoring process crashes - ?line P2 = start_jeeves(jeeves), - ?line {[], []} = monitors(), - ?line expect_jeeves(P2, monitors, {monitors, {[], []}}), - ?line {monitor_process, _R2} = - ask_jeeves(P2, {monitor_process, master_bertie}), - ?line {[], [P2]} = monitors(), - ?line expect_jeeves(P2, monitors, - {monitors, {[{process, {master_bertie, node()}}], []}}), - ?line tell_jeeves(P2, {exit, frop}), + P2 = start_jeeves(jeeves), + {[], []} = monitors(), + expect_jeeves(P2, monitors, {monitors, {[], []}}), + {monitor_process, _R2} = + ask_jeeves(P2, {monitor_process, master_bertie}), + {[], [P2]} = monitors(), + expect_jeeves(P2, monitors, + {monitors, {[{process, {master_bertie, node()}}], []}}), + tell_jeeves(P2, {exit, frop}), timer:sleep(2000), - ?line {[], []} = monitors(), + {[], []} = monitors(), %% Start a new node that can load code in this module - ?line {ok, J} = test_server:start_node - (jeeves, slave, [{args, "-pa " ++ PA}]), + {ok, J} = test_server:start_node + (jeeves, slave, [{args, "-pa " ++ PA}]), %% Normal remote case, monitor and demonitor - ?line P3 = start_jeeves({jeeves, J}), - ?line {[], []} = monitors(), - ?line expect_jeeves(P3, monitors, {monitors, {[], []}}), - ?line R3a = erlang:monitor(process, P3), - ?line {[{process, P3}], []} = monitors(), - ?line expect_jeeves(P3, monitors, {monitors, {[], [P0]}}), - ?line true = erlang:demonitor(R3a), - ?line expect_no_msg(), - ?line {[], []} = monitors(), - ?line expect_jeeves(P3, monitors, {monitors, {[], []}}), + P3 = start_jeeves({jeeves, J}), + {[], []} = monitors(), + expect_jeeves(P3, monitors, {monitors, {[], []}}), + R3a = erlang:monitor(process, P3), + {[{process, P3}], []} = monitors(), + expect_jeeves(P3, monitors, {monitors, {[], [P0]}}), + true = erlang:demonitor(R3a), + expect_no_msg(), + {[], []} = monitors(), + expect_jeeves(P3, monitors, {monitors, {[], []}}), %% Remonitor named and try again, now exiting the monitored process - ?line R3b = erlang:monitor(process, {jeeves, J}), - ?line {[{process, {jeeves, J}}], []} = monitors(), - ?line expect_jeeves(P3, monitors, {monitors, {[], [P0]}}), - ?line tell_jeeves(P3, stop), - ?line expect_down(R3b, {jeeves, J}, normal), - ?line {[], []} = monitors(), + R3b = erlang:monitor(process, {jeeves, J}), + {[{process, {jeeves, J}}], []} = monitors(), + expect_jeeves(P3, monitors, {monitors, {[], [P0]}}), + tell_jeeves(P3, stop), + expect_down(R3b, {jeeves, J}, normal), + {[], []} = monitors(), %% Slightly weird remote case - the monitoring process crashes - ?line P4 = start_jeeves({jeeves, J}), - ?line {[], []} = monitors(), - ?line expect_jeeves(P4, monitors, {monitors, {[], []}}), - ?line {monitor_process, _R4} = - ask_jeeves(P4, {monitor_process, {master_bertie, M}}), - ?line {[], [P4]} = monitors(), - ?line expect_jeeves(P4, monitors, - {monitors, {[{process, {master_bertie, M}}], []}} ), - ?line tell_jeeves(P4, {exit, frop}), + P4 = start_jeeves({jeeves, J}), + {[], []} = monitors(), + expect_jeeves(P4, monitors, {monitors, {[], []}}), + {monitor_process, _R4} = + ask_jeeves(P4, {monitor_process, {master_bertie, M}}), + {[], [P4]} = monitors(), + expect_jeeves(P4, monitors, + {monitors, {[{process, {master_bertie, M}}], []}} ), + tell_jeeves(P4, {exit, frop}), timer:sleep(2000), - ?line {[], []} = monitors(), - + {[], []} = monitors(), + %% Now, the monitoring remote node crashes - ?line P5 = start_jeeves({jeeves, J}), - ?line {[], []} = monitors(), - ?line expect_jeeves(P5, monitors, {monitors, {[], []}}), - ?line {monitor_process, _R5} = - ask_jeeves(P5, {monitor_process, P0}), - ?line {[], [P5]} = monitors(), - ?line expect_jeeves(P5, monitors, - {monitors, {[{process, P0}], []}} ), - ?line test_server:stop_node(J), + P5 = start_jeeves({jeeves, J}), + {[], []} = monitors(), + expect_jeeves(P5, monitors, {monitors, {[], []}}), + {monitor_process, _R5} = + ask_jeeves(P5, {monitor_process, P0}), + {[], [P5]} = monitors(), + expect_jeeves(P5, monitors, + {monitors, {[{process, P0}], []}} ), + test_server:stop_node(J), timer:sleep(4000), - ?line {[], []} = monitors(), - - ?line true = unregister(master_bertie), + {[], []} = monitors(), + + true = unregister(master_bertie), ok. - + %%% Mixed internal and external monitors -mixer(doc) -> - "Test mixing of internal and external monitors."; mixer(Config) when is_list(Config) -> PA = filename:dirname(code:which(?MODULE)), NN = [j0,j1,j2], @@ -748,115 +691,112 @@ mixer(Config) when is_list(Config) -> [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) -> []; +%% Test that DOWN message for a named monitor isn't +%% delivered until name has been unregistered named_down(Config) when is_list(Config) -> - ?line Name = list_to_atom(atom_to_list(?MODULE) - ++ "-named_down-" - ++ integer_to_list(erlang:system_time(seconds)) - ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), - ?line Prio = process_flag(priority,high), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-named_down-" + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), + Prio = process_flag(priority,high), %% Spawn a bunch of high prio cpu bound processes to prevent %% normal prio processes from terminating during the next %% 500 ms... - ?line Self = self(), - ?line spawn_opt(fun () -> - WFun = fun - (F, hej) -> F(F, hopp); - (F, hopp) -> F(F, hej) - end, - NoSchedulers = erlang:system_info(schedulers_online), - lists:foreach(fun (_) -> - spawn_opt(fun () -> - WFun(WFun, - hej) - end, - [{priority,high}, - link]) - end, - lists:seq(1, NoSchedulers)), - receive after 500 -> ok end, - unlink(Self), - exit(bang) - end, - [{priority,high}, link]), - ?line NamedProc = spawn_link(fun () -> - receive after infinity -> ok end - end), - ?line true = register(Name, NamedProc), - ?line unlink(NamedProc), - ?line exit(NamedProc, bang), - ?line Mon = erlang:monitor(process, Name), - ?line receive {'DOWN',Mon, _, _, _} -> ok end, - ?line true = register(Name, self()), - ?line true = unregister(Name), - ?line process_flag(priority,Prio), + Self = self(), + spawn_opt(fun () -> + WFun = fun + (F, hej) -> F(F, hopp); +(F, hopp) -> F(F, hej) + end, + NoSchedulers = erlang:system_info(schedulers_online), + lists:foreach(fun (_) -> + spawn_opt(fun () -> + WFun(WFun, + hej) + end, + [{priority,high}, + link]) + end, + lists:seq(1, NoSchedulers)), + receive after 500 -> ok end, + unlink(Self), + exit(bang) + end, + [{priority,high}, link]), + NamedProc = spawn_link(fun () -> + receive after infinity -> ok end + end), + true = register(Name, NamedProc), + unlink(NamedProc), + exit(NamedProc, bang), + Mon = erlang:monitor(process, Name), + receive {'DOWN',Mon, _, _, _} -> ok end, + true = register(Name, self()), + true = unregister(Name), + process_flag(priority,Prio), ok. -otp_5827(doc) -> []; -otp_5827(suite) -> []; otp_5827(Config) when is_list(Config) -> %% Make a pid with the same nodename but with another creation - ?line [CreEnd | RPTail] - = lists:reverse(binary_to_list(term_to_binary(self()))), - ?line NewCreEnd = case CreEnd of - 0 -> 1; - 1 -> 2; - _ -> CreEnd - 1 - end, - ?line OtherCreationPid - = binary_to_term(list_to_binary(lists:reverse([NewCreEnd | RPTail]))), + [CreEnd | RPTail] + = lists:reverse(binary_to_list(term_to_binary(self()))), + NewCreEnd = case CreEnd of + 0 -> 1; + 1 -> 2; + _ -> CreEnd - 1 + end, + OtherCreationPid + = binary_to_term(list_to_binary(lists:reverse([NewCreEnd | RPTail]))), %% If the bug is present erlang:monitor(process, OtherCreationPid) %% will hang... - ?line Parent = self(), - ?line Ok = make_ref(), - ?line spawn(fun () -> - Mon = erlang:monitor(process, OtherCreationPid), - % Should get the DOWN message right away - receive - {'DOWN', Mon, process, OtherCreationPid, noproc} -> - Parent ! Ok - end - end), - ?line receive - Ok -> - ?line ok - after 1000 -> - ?line ?t:fail("erlang:monitor/2 hangs") - end. + Parent = self(), + Ok = make_ref(), + spawn(fun () -> + Mon = erlang:monitor(process, OtherCreationPid), + % Should get the DOWN message right away + receive + {'DOWN', Mon, process, OtherCreationPid, noproc} -> + Parent ! Ok + end + end), + receive + Ok -> + ok + after 1000 -> + ct: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)), + 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), + 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), + receive + {no_change_message_received, P} -> + ok; + {'DOWN', M, process, P, Reason} -> + ct: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), + receive + {change_messages_received, P} -> + erlang:demonitor(M, [flush]); + {'DOWN', M, process, P, Reason} -> + ct:fail(Reason) + end + end, PMs), stop_node(Node), ok. @@ -867,42 +807,42 @@ check_monitor_time_offset(Leader) -> 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) + {'CHANGE', _, time_offset, clock_service, _} -> + exit(unexpected_change_message_received) after 0 -> - Leader ! {no_change_message_received, self()} + Leader ! {no_change_message_received, self()} end, receive after 100 -> ok end, erlang:demonitor(Mon4, [flush]), receive - {'CHANGE', Mon3, time_offset, clock_service, _} -> - ok + {'CHANGE', Mon3, time_offset, clock_service, _} -> + ok end, receive - {'CHANGE', Mon6, time_offset, clock_service, _} -> - ok + {'CHANGE', Mon6, time_offset, clock_service, _} -> + ok end, erlang:demonitor(Mon5, [flush]), receive - {'CHANGE', Mon7, time_offset, clock_service, _} -> - ok + {'CHANGE', Mon7, time_offset, clock_service, _} -> + ok end, receive - {'CHANGE', Mon1, time_offset, clock_service, _} -> - ok + {'CHANGE', Mon1, time_offset, clock_service, _} -> + ok end, receive - {'CHANGE', _, time_offset, clock_service, _} -> - exit(unexpected_change_message_received) + {'CHANGE', _, time_offset, clock_service, _} -> + exit(unexpected_change_message_received) after 1000 -> - ok + ok end, Leader ! {change_messages_received, self()}. @@ -916,17 +856,17 @@ wait_for_m(Monitors, MonitoredBy, N) -> {monitors,M0} = process_info(self(),monitors), {monitored_by,MB0} = process_info(self(),monitored_by), case lists:sort(M0) of - Monitors -> - case lists:sort(MB0) of - MonitoredBy -> - ok; - _ -> - receive after 100 -> ok end, - wait_for_m(Monitors,MonitoredBy,N-1) - end; - _ -> - receive after 100 -> ok end, - wait_for_m(Monitors,MonitoredBy,N-1) + Monitors -> + case lists:sort(MB0) of + MonitoredBy -> + ok; + _ -> + receive after 100 -> ok end, + wait_for_m(Monitors,MonitoredBy,N-1) + end; + _ -> + receive after 100 -> ok end, + wait_for_m(Monitors,MonitoredBy,N-1) end. % All permutations of a list... @@ -950,32 +890,32 @@ jeeves(Parent, Name, Ref) when is_pid(Parent), (is_atom(Name) or (Name =:= [])), is_reference(Ref) -> %%io:format("monitor_SUITE:jeeves(~p, ~p)~n", [Parent, Name]), case Name of - Atom when is_atom(Atom) -> - register(Name, self()); - [] -> - ok + Atom when is_atom(Atom) -> + register(Name, self()); + [] -> + ok end, Parent ! {self(), Ref}, jeeves_loop(Parent). jeeves_loop(Parent) -> receive - {Parent, monitors} -> - Parent ! {self(), {monitors, monitors()}}, - jeeves_loop(Parent); - {Parent, {monitor_process, P}} -> - Parent ! {self(), {monitor_process, - catch erlang:monitor(process, P) }}, - jeeves_loop(Parent); - {Parent, {demonitor, Ref}} -> - Parent ! {self(), {demonitor, catch erlang:demonitor(Ref)}}, - jeeves_loop(Parent); - {Parent, stop} -> - ok; - {Parent, {exit, Reason}} -> - exit(Reason); - Other -> - io:format("~p:jeeves_loop received ~p~n", [?MODULE, Other]) + {Parent, monitors} -> + Parent ! {self(), {monitors, monitors()}}, + jeeves_loop(Parent); + {Parent, {monitor_process, P}} -> + Parent ! {self(), {monitor_process, + catch erlang:monitor(process, P) }}, + jeeves_loop(Parent); + {Parent, {demonitor, Ref}} -> + Parent ! {self(), {demonitor, catch erlang:demonitor(Ref)}}, + jeeves_loop(Parent); + {Parent, stop} -> + ok; + {Parent, {exit, Reason}} -> + exit(Reason); + Other -> + io:format("~p:jeeves_loop received ~p~n", [?MODULE, Other]) end. @@ -985,10 +925,10 @@ start_jeeves({Name, Node}) Ref = make_ref(), Pid = spawn(Node, fun() -> jeeves(Parent, Name, Ref) end), receive - {Pid, Ref} -> - ok; - Other -> - test_server:fail({rec, Other}) + {Pid, Ref} -> + ok; + Other -> + ct:fail({rec, Other}) end, Pid; start_jeeves(Name) when is_atom(Name) -> @@ -1002,20 +942,20 @@ tell_jeeves(Pid, What) when is_pid(Pid) -> ask_jeeves(Pid, Request) when is_pid(Pid) -> Pid ! {self(), Request}, receive - {Pid, Response} -> - Response; - Other -> - test_server:fail({rec, Other}) + {Pid, Response} -> + Response; + Other -> + ct:fail({rec, Other}) end. expect_jeeves(Pid, Request, Response) when is_pid(Pid) -> Pid ! {self(), Request}, receive - {Pid, Response} -> - ok; - Other -> - test_server:fail({rec, Other}) + {Pid, Response} -> + ok; + Other -> + ct:fail({rec, Other}) end. @@ -1036,20 +976,20 @@ start_node(Config) -> start_node(Config, ""). start_node(Config, Args) -> - TestCase = ?config(testcase, Config), + TestCase = proplists:get_value(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)), + ++ "-" + ++ atom_to_list(TestCase) + ++ "-" + ++ integer_to_list(ESTime) + ++ "-" + ++ integer_to_list(Unique)), test_server:start_node(Name, - slave, - [{args, "-pa " ++ PA ++ " " ++ Args}]). + 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 87dace4721..1493e52655 100644 --- a/erts/emulator/test/mtx_SUITE.erl +++ b/erts/emulator/test/mtx_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -29,9 +29,8 @@ -include_lib("common_test/include/ct.hrl"). --export([all/0,suite/0,groups/0, - init_per_group/2,end_per_group/2, init_per_suite/1, - end_per_suite/1, init_per_testcase/2, end_per_testcase/2]). +-export([all/0,suite/0, init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2]). -export([long_rwlock/1, hammer_ets_rwlock/1, @@ -56,8 +55,30 @@ hammer_sched_freqread_tryrwlock/1, hammer_sched_freqread_tryrwlock_check/1]). +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 15}}]. + +all() -> + [long_rwlock, hammer_rwlock_check, hammer_rwlock, + hammer_tryrwlock_check, hammer_tryrwlock, + hammer_ets_rwlock, hammer_sched_long_rwlock_check, + hammer_sched_long_rwlock, + hammer_sched_long_freqread_rwlock_check, + hammer_sched_long_freqread_rwlock, + hammer_sched_long_tryrwlock_check, + hammer_sched_long_tryrwlock, + hammer_sched_long_freqread_tryrwlock_check, + hammer_sched_long_freqread_tryrwlock, + hammer_sched_rwlock_check, hammer_sched_rwlock, + hammer_sched_freqread_rwlock_check, + hammer_sched_freqread_rwlock, + hammer_sched_tryrwlock_check, hammer_sched_tryrwlock, + hammer_sched_freqread_tryrwlock_check, + hammer_sched_freqread_tryrwlock]. + init_per_suite(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), Lib = filename:join([DataDir, atom_to_list(?MODULE)]), case {erlang:load_nif(Lib, none),erlang:system_info(threads)} of {{error,_},false} -> @@ -71,15 +92,13 @@ end_per_suite(Config) when is_list(Config) -> Config. init_per_testcase(_Case, Config) -> - Dog = ?t:timetrap(?t:minutes(15)), %% Wait for deallocations to complete since we measure %% runtime in test cases. wait_deallocations(), - [{watchdog, Dog}|Config]. + Config. end_per_testcase(_Func, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog). + ok. wait_deallocations() -> try @@ -90,45 +109,15 @@ wait_deallocations() -> wait_deallocations() end. -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [long_rwlock, hammer_rwlock_check, hammer_rwlock, - hammer_tryrwlock_check, hammer_tryrwlock, - hammer_ets_rwlock, hammer_sched_long_rwlock_check, - hammer_sched_long_rwlock, - hammer_sched_long_freqread_rwlock_check, - hammer_sched_long_freqread_rwlock, - hammer_sched_long_tryrwlock_check, - hammer_sched_long_tryrwlock, - hammer_sched_long_freqread_tryrwlock_check, - hammer_sched_long_freqread_tryrwlock, - hammer_sched_rwlock_check, hammer_sched_rwlock, - hammer_sched_freqread_rwlock_check, - hammer_sched_freqread_rwlock, - hammer_sched_tryrwlock_check, hammer_sched_tryrwlock, - hammer_sched_freqread_tryrwlock_check, - hammer_sched_freqread_tryrwlock]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - long_rwlock(Config) when is_list(Config) -> statistics(runtime), LLRes = long_rw_test(), {_, RunTime} = statistics(runtime), %% A very short run time is expected, since %% threads in the test mostly wait - ?t:format("RunTime=~p~n", [RunTime]), - ?line true = RunTime < 400, - ?line RunTimeStr = "Run-time during test was "++integer_to_list(RunTime)++" ms.", + io:format("RunTime=~p~n", [RunTime]), + true = RunTime < 400, + RunTimeStr = "Run-time during test was "++integer_to_list(RunTime)++" ms.", case LLRes of ok -> {comment, RunTimeStr}; @@ -198,100 +187,100 @@ hammer_sched_long_freqread_tryrwlock_check(Config) when is_list(Config) -> hammer_sched_rwlock_test(FreqRead, LockCheck, Blocking, WaitLocked, WaitUnlocked) -> case create_rwlock(FreqRead, LockCheck) of - enotsup -> - {skipped, "Not supported."}; - RWLock -> - Onln = erlang:system_info(schedulers_online), - NWPs = case Onln div 3 of - 1 -> case Onln < 4 of - true -> 1; - false -> 2 - end; - X -> X - end, - NRPs = Onln - NWPs, - NoLockOps = ((((50000000 div Onln) - div case {Blocking, WaitLocked} of - {false, 0} -> 1; - _ -> 10 - end) - div (case WaitLocked == 0 of - true -> 1; - false -> WaitLocked*250 - end)) - div handicap()), - ?t:format("NoLockOps=~p~n", [NoLockOps]), - Sleep = case Blocking of - true -> NoLockOps; - false -> NoLockOps div 10 - end, - WPs = lists:map( - fun (Sched) -> - spawn_opt( - fun () -> - io:format("Writer on scheduler ~p.~n", - [Sched]), - Sched = erlang:system_info(scheduler_id), - receive go -> gone end, - hammer_sched_rwlock_proc(RWLock, - Blocking, - true, - WaitLocked, - WaitUnlocked, - NoLockOps, - Sleep), - Sched = erlang:system_info(scheduler_id) - end, - [link, {scheduler, Sched}]) - end, - lists:seq(1, NWPs)), - RPs = lists:map( - fun (Sched) -> - spawn_opt( - fun () -> - io:format("Reader on scheduler ~p.~n", - [Sched]), - Sched = erlang:system_info(scheduler_id), - receive go -> gone end, - hammer_sched_rwlock_proc(RWLock, - Blocking, - false, - WaitLocked, - WaitUnlocked, - NoLockOps, - Sleep), - Sched = erlang:system_info(scheduler_id) - end, - [link, {scheduler, Sched}]) - end, - lists:seq(NWPs + 1, NWPs + NRPs)), - Procs = WPs ++ RPs, - case {Blocking, WaitLocked} of - {_, 0} -> ok; - {false, _} -> ok; - _ -> statistics(runtime) - end, - lists:foreach(fun (P) -> P ! go end, Procs), - lists:foreach(fun (P) -> - M = erlang:monitor(process, P), - receive - {'DOWN', M, process, P, _} -> - ok - end - end, - Procs), - case {Blocking, WaitLocked} of - {_, 0} -> ok; - {false, _} -> ok; - _ -> - {_, RunTime} = statistics(runtime), - ?t:format("RunTime=~p~n", [RunTime]), - ?line true = RunTime < 700, - {comment, - "Run-time during test was " - ++ integer_to_list(RunTime) - ++ " ms."} - end + enotsup -> + {skipped, "Not supported."}; + RWLock -> + Onln = erlang:system_info(schedulers_online), + NWPs = case Onln div 3 of + 1 -> case Onln < 4 of + true -> 1; + false -> 2 + end; + X -> X + end, + NRPs = Onln - NWPs, + NoLockOps = ((((50000000 div Onln) + div case {Blocking, WaitLocked} of + {false, 0} -> 1; + _ -> 10 + end) + div (case WaitLocked == 0 of + true -> 1; + false -> WaitLocked*250 + end)) + div handicap()), + io:format("NoLockOps=~p~n", [NoLockOps]), + Sleep = case Blocking of + true -> NoLockOps; + false -> NoLockOps div 10 + end, + WPs = lists:map( + fun (Sched) -> + spawn_opt( + fun () -> + io:format("Writer on scheduler ~p.~n", + [Sched]), + Sched = erlang:system_info(scheduler_id), + receive go -> gone end, + hammer_sched_rwlock_proc(RWLock, + Blocking, + true, + WaitLocked, + WaitUnlocked, + NoLockOps, + Sleep), + Sched = erlang:system_info(scheduler_id) + end, + [link, {scheduler, Sched}]) + end, + lists:seq(1, NWPs)), + RPs = lists:map( + fun (Sched) -> + spawn_opt( + fun () -> + io:format("Reader on scheduler ~p.~n", + [Sched]), + Sched = erlang:system_info(scheduler_id), + receive go -> gone end, + hammer_sched_rwlock_proc(RWLock, + Blocking, + false, + WaitLocked, + WaitUnlocked, + NoLockOps, + Sleep), + Sched = erlang:system_info(scheduler_id) + end, + [link, {scheduler, Sched}]) + end, + lists:seq(NWPs + 1, NWPs + NRPs)), + Procs = WPs ++ RPs, + case {Blocking, WaitLocked} of + {_, 0} -> ok; + {false, _} -> ok; + _ -> statistics(runtime) + end, + lists:foreach(fun (P) -> P ! go end, Procs), + lists:foreach(fun (P) -> + M = erlang:monitor(process, P), + receive + {'DOWN', M, process, P, _} -> + ok + end + end, + Procs), + case {Blocking, WaitLocked} of + {_, 0} -> ok; + {false, _} -> ok; + _ -> + {_, RunTime} = statistics(runtime), + io:format("RunTime=~p~n", [RunTime]), + true = RunTime < 700, + {comment, + "Run-time during test was " + ++ integer_to_list(RunTime) + ++ " ms."} + end end. hammer_sched_rwlock_proc(_RWLock, @@ -343,9 +332,9 @@ hammer_ets_rwlock(Config) when is_list(Config) -> 3 -> {2000, 50}; _ -> {200, 50} end, - ?t:format("Procs=~p~nOps=~p~n", [Procs, Ops]), + io:format("Procs=~p~nOps=~p~n", [Procs, Ops]), lists:foreach(fun (XOpts) -> - ?t:format("Running with extra opts: ~p", [XOpts]), + io:format("Running with extra opts: ~p", [XOpts]), hammer_ets_rwlock_test(XOpts, true, 2, Ops, Procs, false) end, @@ -408,65 +397,65 @@ hammer_ets_rwlock_init(_T, _N) -> hammer_ets_rwlock_test(XOpts, UW, C, N, NP, SC) -> receive after 100 -> ok end, {TP, TM} = spawn_monitor( - fun () -> - _L = repeat_list( - fun () -> - Caller = self(), - T = fun () -> - Parent = self(), - hammer_ets_rwlock_put_data(), - T=ets:new(x, [public | XOpts]), - hammer_ets_rwlock_init(T, 0), - Ps0 = repeat_list( - fun () -> - spawn_link( - fun () -> - hammer_ets_rwlock_put_data(), - receive go -> ok end, - hammer_ets_rwlock_ops(T, UW, N, C, C, N), - Parent ! {done, self()}, - receive after infinity -> ok end - end) - end, - NP - case SC of - false -> 0; - _ -> 1 - end), - Ps = case SC of - false -> Ps0; - _ -> [spawn_link(fun () -> - hammer_ets_rwlock_put_data(), - receive go -> ok end, - hammer_ets_rwlock_ops(T, UW, N, SC, SC, N), - Parent ! {done, self()}, - receive after infinity -> ok end - end) | Ps0] - end, - Start = erlang:monotonic_time(), - lists:foreach(fun (P) -> P ! go end, Ps), - lists:foreach(fun (P) -> receive {done, P} -> ok end end, Ps), - Stop = erlang:monotonic_time(), - lists:foreach(fun (P) -> - unlink(P), - exit(P, bang), - M = erlang:monitor(process, P), - receive - {'DOWN', M, process, P, _} -> ok - end - end, Ps), - Res = (Stop-Start)/erlang:convert_time_unit(1,seconds,native), - Caller ! {?MODULE, self(), Res} - end, - TP = spawn_link(T), - receive - {?MODULE, TP, Res} -> - Res - end - end, - ?HAMMER_ETS_RWLOCK_REPEAT_TIMES) - end), + fun () -> + _L = repeat_list( + fun () -> + Caller = self(), + T = fun () -> + Parent = self(), + hammer_ets_rwlock_put_data(), + T=ets:new(x, [public | XOpts]), + hammer_ets_rwlock_init(T, 0), + Ps0 = repeat_list( + fun () -> + spawn_link( + fun () -> + hammer_ets_rwlock_put_data(), + receive go -> ok end, + hammer_ets_rwlock_ops(T, UW, N, C, C, N), + Parent ! {done, self()}, + receive after infinity -> ok end + end) + end, + NP - case SC of + false -> 0; + _ -> 1 + end), + Ps = case SC of + false -> Ps0; + _ -> [spawn_link(fun () -> + hammer_ets_rwlock_put_data(), + receive go -> ok end, + hammer_ets_rwlock_ops(T, UW, N, SC, SC, N), + Parent ! {done, self()}, + receive after infinity -> ok end + end) | Ps0] + end, + Start = erlang:monotonic_time(), + lists:foreach(fun (P) -> P ! go end, Ps), + lists:foreach(fun (P) -> receive {done, P} -> ok end end, Ps), + Stop = erlang:monotonic_time(), + lists:foreach(fun (P) -> + unlink(P), + exit(P, bang), + M = erlang:monitor(process, P), + receive + {'DOWN', M, process, P, _} -> ok + end + end, Ps), + Res = (Stop-Start)/erlang:convert_time_unit(1,seconds,native), + Caller ! {?MODULE, self(), Res} + end, + TP = spawn_link(T), + receive + {?MODULE, TP, Res} -> + Res + end + end, + ?HAMMER_ETS_RWLOCK_REPEAT_TIMES) + end), receive - {'DOWN', TM, process, TP, _} -> ok + {'DOWN', TM, process, TP, _} -> ok end. repeat_list(Fun, N) -> @@ -480,18 +469,17 @@ repeat_list(Fun, N, Acc) -> handicap() -> X0 = case catch (erlang:system_info(logical_processors_available) >= - erlang:system_info(schedulers_online)) of - true -> 1; - _ -> 2 - end, + erlang:system_info(schedulers_online)) of + true -> 1; + _ -> 2 + end, case erlang:system_info(build_type) of - opt -> - X0; - ReallySlow when ReallySlow == debug; - ReallySlow == valgrind; - ReallySlow == purify -> - X0*3; - _Slow -> - X0*2 + opt -> + X0; + ReallySlow when ReallySlow == debug; + ReallySlow == valgrind; + ReallySlow == purify -> + X0*3; + _Slow -> + X0*2 end. - diff --git a/erts/emulator/test/mtx_SUITE_data/Makefile.src b/erts/emulator/test/mtx_SUITE_data/Makefile.src index dc880118f1..1816dc6798 100644 --- a/erts/emulator/test/mtx_SUITE_data/Makefile.src +++ b/erts/emulator/test/mtx_SUITE_data/Makefile.src @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2010-2013. All Rights Reserved. +# Copyright Ericsson AB 2010-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c b/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c index 1911291448..e011aadce9 100644 --- a/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c +++ b/erts/emulator/test/mtx_SUITE_data/mtx_SUITE.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2011. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/multi_load_SUITE.erl b/erts/emulator/test/multi_load_SUITE.erl new file mode 100644 index 0000000000..edf3205812 --- /dev/null +++ b/erts/emulator/test/multi_load_SUITE.erl @@ -0,0 +1,181 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(multi_load_SUITE). +-export([all/0, suite/0, many/1, on_load/1, errors/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [many,on_load,errors]. + +many(_Config) -> + Ms = make_modules(100, fun many_module/1), + + io:put_chars("Light load\n" + "=========="), + many_measure(Ms), + + _ = [spawn_link(fun many_worker/0) || _ <- lists:seq(1, 8)], + erlang:yield(), + io:put_chars("Heavy load\n" + "=========="), + many_measure(Ms), + ok. + +many_module(M) -> + ["-module("++M++").", + "-compile(export_all).", + "f1() -> ok.", + "f2() -> ok.", + "f3() -> ok.", + "f4() -> ok."]. + +many_measure(Ms) -> + many_purge(Ms), + MsPrep1 = prepare_modules(Ms), + Us1 = ms(fun() -> many_load_seq(MsPrep1) end), + many_try_call(Ms), + many_purge(Ms), + MsPrep2 = prepare_modules(Ms), + Us2 = ms(fun() -> many_load_par(MsPrep2) end), + many_try_call(Ms), + io:format("# modules: ~9w\n" + "Sequential: ~9w µs\n" + "Parallel: ~9w µs\n" + "Ratio: ~9w\n", + [length(Ms),Us1,Us2,divide(Us1,Us2)]), + ok. + +divide(A,B) when B > 0 -> A div B; +divide(_,_) -> inf. + +many_load_seq(Ms) -> + [erlang:finish_loading([M]) || M <- Ms], + ok. + +many_load_par(Ms) -> + erlang:finish_loading(Ms). + +many_purge(Ms) -> + _ = [catch erlang:purge_module(M) || {M,_} <- Ms], + ok. + +many_try_call(Ms) -> + _ = [begin + ok = M:f1(), + ok = M:f2(), + ok = M:f3(), + ok = M:f4() + end || {M,_} <- Ms], + ok. + +many_worker() -> + many_worker(lists:seq(1, 100)). + +many_worker(L) -> + N0 = length(L), + N1 = N0 * N0 * N0, + N2 = N1 div (N0 * N0), + N3 = N2 + 10, + _ = N3 - 10, + many_worker(L). + + +on_load(_Config) -> + On = make_modules(2, fun on_load_module/1), + OnPrep = prepare_modules(On), + {'EXIT',{system_limit,_}} = (catch erlang:finish_loading(OnPrep)), + + Normal = make_modules(1, fun on_load_normal/1), + Mixed = Normal ++ tl(On), + MixedPrep = prepare_modules(Mixed), + {'EXIT',{system_limit,_}} = (catch erlang:finish_loading(MixedPrep)), + + [false,true] = [erlang:has_prepared_code_on_load(Code) || + Code <- MixedPrep], + {'EXIT',{badarg,_}} = (catch erlang:has_prepared_code_on_load(<<1,2,3>>)), + Magic = ets:match_spec_compile([{'_',[true],['$_']}]), + {'EXIT',{badarg,_}} = (catch erlang:has_prepared_code_on_load(Magic)), + + SingleOnPrep = tl(OnPrep), + {on_load,[OnLoadMod]} = erlang:finish_loading(SingleOnPrep), + ok = erlang:call_on_load_function(OnLoadMod), + ok. + +on_load_module(M) -> + ["-module("++M++").", + "-on_load(f/0).", + "f() -> ok."]. + +on_load_normal(M) -> + ["-module("++M++")."]. + + +errors(_Config) -> + finish_loading_badarg(x), + finish_loading_badarg([x|y]), + finish_loading_badarg([x]), + finish_loading_badarg([<<>>]), + + Mods = make_modules(2, fun errors_module/1), + Ms = lists:sort([M || {M,_} <- Mods]), + Prep = prepare_modules(Mods), + {duplicated,Dups} = erlang:finish_loading(Prep ++ Prep), + Ms = lists:sort(Dups), + ok. + +finish_loading_badarg(Arg) -> + {'EXIT',{badarg,[{erlang,finish_loading,[Arg],_}|_]}} = + (catch erlang:finish_loading(Arg)). + +errors_module(M) -> + ["-module("++M++").", + "-export([f/0]).", + "f() -> ok."]. + +%%% +%%% Common utilities +%%% + +ms(Fun) -> + {Ms,ok} = timer:tc(Fun), + Ms. + +make_modules(0, _) -> + []; +make_modules(N, Fun) -> + U = erlang:unique_integer([positive]), + M0 = "m__" ++ integer_to_list(N) ++ "_" ++ integer_to_list(U), + Contents = Fun(M0), + Forms = [make_form(S) || S <- Contents], + {ok,M,Code} = compile:forms(Forms), + [{M,Code}|make_modules(N-1, Fun)]. + +make_form(S) -> + {ok,Toks,_} = erl_scan:string(S), + {ok,Form} = erl_parse:parse_form(Toks), + Form. + +prepare_modules(Ms) -> + [erlang:prepare_loading(M, Code) || {M,Code} <- Ms]. diff --git a/erts/emulator/test/nested_SUITE.erl b/erts/emulator/test/nested_SUITE.erl index 7cfa837ee5..7af2873ce2 100644 --- a/erts/emulator/test/nested_SUITE.erl +++ b/erts/emulator/test/nested_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,90 +20,74 @@ -module(nested_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - case_in_case/1, case_in_after/1, catch_in_catch/1, bif_in_bif/1]). +-export([all/0, suite/0, + case_in_case/1, case_in_after/1, catch_in_catch/1, bif_in_bif/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 10}}]. all() -> [case_in_case, case_in_after, catch_in_catch, bif_in_bif]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - case_in_case(suite) -> []; case_in_case(Config) when is_list(Config) -> - ?line done = search_any([a], [{a, 1}]), - ?line done = search_any([x], [{a, 1}]), + done = search_any([a], [{a, 1}]), + done = search_any([x], [{a, 1}]), ok. search_any([Key|Rest], List) -> - ?line case case lists:keysearch(Key, 1, List) of - {value, _} -> - true; - _ -> - false - end of - true -> - ok; - false -> - error; - Other -> - test_server:fail({other_result, Other}) - end, - ?line search_any(Rest, List); + case case lists:keysearch(Key, 1, List) of + {value, _} -> + true; + _ -> + false + end of + true -> + ok; + false -> + error; + Other -> + ct:fail({other_result, Other}) + end, + search_any(Rest, List); search_any([], _) -> done. case_in_after(suite) -> []; case_in_after(Config) when is_list(Config) -> receive - after case {x, y, z} of - {x, y, z} -> 0 - end -> - ok - end, + after case {x, y, z} of + {x, y, z} -> 0 + end -> + ok + end, ok. -catch_in_catch(doc) -> "Test a catch within a catch in the same function."; -catch_in_catch(suite) -> []; +%% Test a catch within a catch in the same function. catch_in_catch(Config) when is_list(Config) -> - ?line {outer, inner_exit} = catcher(), + {outer, inner_exit} = catcher(), ok. catcher() -> case (catch - case (catch ?MODULE:non_existing()) of % bogus function - {'EXIT', _} -> - inner_exit; - Res1 -> - {inner, Res1} - end) of - {'EXIT', _} -> - outer_exit; - Res2 -> - {outer, Res2} + case (catch ?MODULE:non_existing()) of % bogus function + {'EXIT', _} -> + inner_exit; + Res1 -> + {inner, Res1} + end) of + {'EXIT', _} -> + outer_exit; + Res2 -> + {outer, Res2} end. -bif_in_bif(doc) -> "Test a BIF call within a BIF call."; -bif_in_bif(suite) -> []; +%% Test a BIF call within a BIF call. bif_in_bif(Config) when is_list(Config) -> Self = self(), put(pid, Self), diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 2400505159..a7767132ee 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,14 +22,13 @@ %%-define(line_trace,true). -define(CHECK(Exp,Got), check(Exp,Got,?LINE)). -%%-define(CHECK(Exp,Got), ?line Exp = Got). +%%-define(CHECK(Exp,Got), Exp = Got). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --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, basic/1, reload/1, upgrade/1, heap_frag/1, +-export([all/0, suite/0, + init_per_testcase/2, end_per_testcase/2, + basic/1, reload/1, upgrade/1, heap_frag/1, types/1, many_args/1, binaries/1, get_string/1, get_atom/1, maps/1, api_macros/1, @@ -43,7 +42,11 @@ dirty_nif_exception/1, call_dirty_nif_exception/1, nif_schedule/1, nif_exception/1, call_nif_exception/1, nif_nan_and_inf/1, nif_atom_too_long/1, - nif_monotonic_time/1, nif_time_offset/1, nif_convert_time_unit/1 + nif_monotonic_time/1, nif_time_offset/1, nif_convert_time_unit/1, + nif_now_time/1, nif_cpu_time/1, nif_unique_integer/1, + nif_is_process_alive/1, nif_is_port_alive/1, + nif_term_to_binary/1, nif_binary_to_term/1, + nif_port_command/1 ]). -export([many_args_100/100]). @@ -74,182 +77,163 @@ all() -> otp_9668, consume_timeslice, nif_schedule, dirty_nif, dirty_nif_send, dirty_nif_exception, nif_exception, nif_nan_and_inf, nif_atom_too_long, - nif_monotonic_time, nif_time_offset, nif_convert_time_unit + nif_monotonic_time, nif_time_offset, nif_convert_time_unit, + nif_now_time, nif_cpu_time, nif_unique_integer, + nif_is_process_alive, nif_is_port_alive, + nif_term_to_binary, nif_binary_to_term, + nif_port_command ]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - init_per_testcase(_Case, Config) -> -% ?line Dog = ?t:timetrap(?t:seconds(60*60*24)), Config. end_per_testcase(_Func, _Config) -> - %%Dog = ?config(watchdog, Config), - %%?t:timetrap_cancel(Dog), P1 = code:purge(nif_mod), Del = code:delete(nif_mod), P2 = code:purge(nif_mod), io:format("fin purged=~p, deleted=~p and then purged=~p\n",[P1,Del,P2]). -basic(doc) -> ["Basic smoke test of load_nif and a simple NIF call"]; -basic(suite) -> []; +%% Basic smoke test of load_nif and a simple NIF call basic(Config) when is_list(Config) -> ensure_lib_loaded(Config), - ?line true = (lib_version() =/= undefined), - ?line [{load,1,1,101},{lib_version,1,2,102}] = call_history(), - ?line [] = call_history(), - ?line true = lists:member(?MODULE, erlang:system_info(taints)), + true = (lib_version() =/= undefined), + [{load,1,1,101},{lib_version,1,2,102}] = call_history(), + [] = call_history(), + true = lists:member(?MODULE, erlang:system_info(taints)), ok. -reload(doc) -> ["Test reload callback in nif lib"]; -reload(suite) -> []; +%% Test reload callback in nif lib reload(Config) when is_list(Config) -> TmpMem = tmpmem(), ensure_lib_loaded(Config), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "nif_mod"), - ?line {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), - ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "nif_mod"), + {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), + {module,nif_mod} = erlang:load_module(nif_mod,Bin), - ?line ok = nif_mod:load_nif_lib(Config, 1), + ok = nif_mod:load_nif_lib(Config, 1), - ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), - ?line [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), + hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), - ?line ok = nif_mod:load_nif_lib(Config, 2), - ?line 2 = nif_mod:lib_version(), - ?line [{reload,2,1,201},{lib_version,2,2,202}] = nif_mod_call_history(), + ok = nif_mod:load_nif_lib(Config, 2), + 2 = nif_mod:lib_version(), + [{reload,2,1,201},{lib_version,2,2,202}] = nif_mod_call_history(), - ?line ok = nif_mod:load_nif_lib(Config, 1), - ?line 1 = nif_mod:lib_version(), - ?line [{reload,1,1,101},{lib_version,1,2,102}] = nif_mod_call_history(), + ok = nif_mod:load_nif_lib(Config, 1), + 1 = nif_mod:lib_version(), + [{reload,1,1,101},{lib_version,1,2,102}] = nif_mod_call_history(), - ?line true = erlang:delete_module(nif_mod), - ?line [] = nif_mod_call_history(), + true = erlang:delete_module(nif_mod), + [] = nif_mod_call_history(), - %%?line false= check_process_code(Pid, nif_mod), - ?line true = erlang:purge_module(nif_mod), - ?line [{unload,1,3,103}] = nif_mod_call_history(), + %%false= check_process_code(Pid, nif_mod), + true = erlang:purge_module(nif_mod), + [{unload,1,3,103}] = nif_mod_call_history(), - ?line true = lists:member(?MODULE, erlang:system_info(taints)), - ?line true = lists:member(nif_mod, erlang:system_info(taints)), - ?line verify_tmpmem(TmpMem), + true = lists:member(?MODULE, erlang:system_info(taints)), + true = lists:member(nif_mod, erlang:system_info(taints)), + verify_tmpmem(TmpMem), ok. -upgrade(doc) -> ["Test upgrade callback in nif lib"]; -upgrade(suite) -> []; +%% Test upgrade callback in nif lib upgrade(Config) when is_list(Config) -> TmpMem = tmpmem(), ensure_lib_loaded(Config), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "nif_mod"), - ?line {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), - ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "nif_mod"), + {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), + {module,nif_mod} = erlang:load_module(nif_mod,Bin), - ?line ok = nif_mod:load_nif_lib(Config, 1), - ?line {Pid,MRef} = nif_mod:start(), - ?line 1 = call(Pid,lib_version), + ok = nif_mod:load_nif_lib(Config, 1), + {Pid,MRef} = nif_mod:start(), + 1 = call(Pid,lib_version), - ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), - ?line [{load,1,1,101},{lib_version,1,2,102},{get_priv_data_ptr,1,3,103}] = nif_mod_call_history(), + hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + [{load,1,1,101},{lib_version,1,2,102},{get_priv_data_ptr,1,3,103}] = nif_mod_call_history(), %% Module upgrade with same lib-version - ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), - ?line undefined = nif_mod:lib_version(), - ?line 1 = call(Pid,lib_version), - ?line [{lib_version,1,4,104}] = nif_mod_call_history(), + {module,nif_mod} = erlang:load_module(nif_mod,Bin), + undefined = nif_mod:lib_version(), + 1 = call(Pid,lib_version), + [{lib_version,1,4,104}] = nif_mod_call_history(), - ?line ok = nif_mod:load_nif_lib(Config, 1), - ?line 1 = nif_mod:lib_version(), - ?line [{upgrade,1,5,105},{lib_version,1,6,106}] = nif_mod_call_history(), + ok = nif_mod:load_nif_lib(Config, 1), + 1 = nif_mod:lib_version(), + [{upgrade,1,5,105},{lib_version,1,6,106}] = nif_mod_call_history(), - ?line upgraded = call(Pid,upgrade), - ?line false = check_process_code(Pid, nif_mod), - ?line true = erlang:purge_module(nif_mod), - ?line [{unload,1,7,107}] = nif_mod_call_history(), + upgraded = call(Pid,upgrade), + false = check_process_code(Pid, nif_mod), + true = erlang:purge_module(nif_mod), + [{unload,1,7,107}] = nif_mod_call_history(), - ?line 1 = nif_mod:lib_version(), - ?line [{lib_version,1,8,108}] = nif_mod_call_history(), + 1 = nif_mod:lib_version(), + [{lib_version,1,8,108}] = nif_mod_call_history(), - ?line true = erlang:delete_module(nif_mod), - ?line [] = nif_mod_call_history(), + true = erlang:delete_module(nif_mod), + [] = nif_mod_call_history(), - ?line Pid ! die, - ?line {'DOWN', MRef, process, Pid, normal} = receive_any(), - ?line false = check_process_code(Pid, nif_mod), - ?line true = erlang:purge_module(nif_mod), - ?line [{unload,1,9,109}] = nif_mod_call_history(), + Pid ! die, + {'DOWN', MRef, process, Pid, normal} = receive_any(), + false = check_process_code(Pid, nif_mod), + true = erlang:purge_module(nif_mod), + [{unload,1,9,109}] = nif_mod_call_history(), %% Module upgrade with different lib version - ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), - ?line undefined = nif_mod:lib_version(), - ?line {Pid2,MRef2} = nif_mod:start(), - ?line undefined = call(Pid2,lib_version), - - ?line ok = nif_mod:load_nif_lib(Config, 1), - ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), - ?line 1 = call(Pid2,lib_version), - ?line [{load,1,1,101},{get_priv_data_ptr,1,2,102},{lib_version,1,3,103}] = nif_mod_call_history(), - - ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), - ?line undefined = nif_mod:lib_version(), - ?line [] = nif_mod_call_history(), - ?line 1 = call(Pid2,lib_version), - ?line [{lib_version,1,4,104}] = nif_mod_call_history(), - - ?line ok = nif_mod:load_nif_lib(Config, 2), - ?line 2 = nif_mod:lib_version(), - ?line [{upgrade,2,1,201},{lib_version,2,2,202}] = nif_mod_call_history(), - - ?line 1 = call(Pid2,lib_version), - ?line [{lib_version,1,5,105}] = nif_mod_call_history(), - - ?line upgraded = call(Pid2,upgrade), - ?line false = check_process_code(Pid2, nif_mod), - ?line true = erlang:purge_module(nif_mod), - ?line [{unload,1,6,106}] = nif_mod_call_history(), - - ?line 2 = nif_mod:lib_version(), - ?line [{lib_version,2,3,203}] = nif_mod_call_history(), - - ?line true = erlang:delete_module(nif_mod), - ?line [] = nif_mod_call_history(), - - ?line Pid2 ! die, - ?line {'DOWN', MRef2, process, Pid2, normal} = receive_any(), - ?line false= check_process_code(Pid2, nif_mod), - ?line true = erlang:purge_module(nif_mod), - ?line [{unload,2,4,204}] = nif_mod_call_history(), - - ?line true = lists:member(?MODULE, erlang:system_info(taints)), - ?line true = lists:member(nif_mod, erlang:system_info(taints)), - ?line verify_tmpmem(TmpMem), + {module,nif_mod} = erlang:load_module(nif_mod,Bin), + undefined = nif_mod:lib_version(), + {Pid2,MRef2} = nif_mod:start(), + undefined = call(Pid2,lib_version), + + ok = nif_mod:load_nif_lib(Config, 1), + hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + 1 = call(Pid2,lib_version), + [{load,1,1,101},{get_priv_data_ptr,1,2,102},{lib_version,1,3,103}] = nif_mod_call_history(), + + {module,nif_mod} = erlang:load_module(nif_mod,Bin), + undefined = nif_mod:lib_version(), + [] = nif_mod_call_history(), + 1 = call(Pid2,lib_version), + [{lib_version,1,4,104}] = nif_mod_call_history(), + + ok = nif_mod:load_nif_lib(Config, 2), + 2 = nif_mod:lib_version(), + [{upgrade,2,1,201},{lib_version,2,2,202}] = nif_mod_call_history(), + + 1 = call(Pid2,lib_version), + [{lib_version,1,5,105}] = nif_mod_call_history(), + + upgraded = call(Pid2,upgrade), + false = check_process_code(Pid2, nif_mod), + true = erlang:purge_module(nif_mod), + [{unload,1,6,106}] = nif_mod_call_history(), + + 2 = nif_mod:lib_version(), + [{lib_version,2,3,203}] = nif_mod_call_history(), + + true = erlang:delete_module(nif_mod), + [] = nif_mod_call_history(), + + Pid2 ! die, + {'DOWN', MRef2, process, Pid2, normal} = receive_any(), + false= check_process_code(Pid2, nif_mod), + true = erlang:purge_module(nif_mod), + [{unload,2,4,204}] = nif_mod_call_history(), + + true = lists:member(?MODULE, erlang:system_info(taints)), + true = lists:member(nif_mod, erlang:system_info(taints)), + verify_tmpmem(TmpMem), ok. -heap_frag(doc) -> ["Test NIF building heap fragments"]; -heap_frag(suite) -> []; +%% Test NIF building heap fragments heap_frag(Config) when is_list(Config) -> TmpMem = tmpmem(), ensure_lib_loaded(Config), heap_frag_do(1,1000000), - ?line verify_tmpmem(TmpMem), + verify_tmpmem(TmpMem), ok. heap_frag_do(N, Max) when N > Max -> @@ -260,12 +244,11 @@ heap_frag_do(N, Max) -> L = list_seq(N), heap_frag_do(((N*5) div 4) + 1, Max). -types(doc) -> ["Type tests"]; -types(suite) -> []; +%% Type tests types(Config) when is_list(Config) -> TmpMem = tmpmem(), ensure_lib_loaded(Config), - ?line ok = type_test(), + ok = type_test(), lists:foreach(fun(Tpl) -> Lst = erlang:tuple_to_list(Tpl), Lst = tuple_2_list(Tpl) @@ -290,18 +273,18 @@ types(Config) when is_list(Config) -> R1 = echo_int(I), %%io:format("echo_int(~p) -> ~p\n", [I, R1]), R2 = my_echo_int(I, Limits), - ?line R1 = R2, - ?line true = (R1 =:= R2), - ?line true = (R1 == R2) + R1 = R2, + true = (R1 =:= R2), + true = (R1 == R2) end, int_list()), - ?line verify_tmpmem(TmpMem), - ?line true = (compare(-1294536544000, -1178704800000) < 0), - ?line true = (compare(-1178704800000, -1294536544000) > 0), - ?line true = (compare(-295147905179352825856, -36893488147419103232) < 0), - ?line true = (compare(-36893488147419103232, -295147905179352825856) > 0), - ?line true = (compare(-29514790517935282585612345678, -36893488147419103232) < 0), - ?line true = (compare(-36893488147419103232, -29514790517935282585612345678) > 0), + verify_tmpmem(TmpMem), + true = (compare(-1294536544000, -1178704800000) < 0), + true = (compare(-1178704800000, -1294536544000) > 0), + true = (compare(-295147905179352825856, -36893488147419103232) < 0), + true = (compare(-36893488147419103232, -295147905179352825856) > 0), + true = (compare(-29514790517935282585612345678, -36893488147419103232) < 0), + true = (compare(-36893488147419103232, -29514790517935282585612345678) > 0), ok. int_list() -> @@ -329,15 +312,15 @@ eq_cmp(A,B) -> eq_cmp_do({A,B},{A,B}). eq_cmp_do(A,B) -> - %%?t:format("compare ~p and ~p\n",[A,B]), + %%io:format("compare ~p and ~p\n",[A,B]), Eq = (A =:= B), - ?line Eq = is_identical(A,B), - ?line Cmp = if + Eq = is_identical(A,B), + Cmp = if A < B -> -1; A == B -> 0; A > B -> 1 end, - ?line Cmp = case compare(A,B) of + Cmp = case compare(A,B) of C when is_integer(C), C < 0 -> -1; 0 -> 0; C when is_integer(C) -> 1 @@ -345,47 +328,45 @@ eq_cmp_do(A,B) -> ok. -many_args(doc) -> ["Test NIF with many arguments"]; -many_args(suite) -> []; +%% Test NIF with many arguments many_args(Config) when is_list(Config) -> TmpMem = tmpmem(), - ?line ensure_lib_loaded(Config ,1), - ?line ok = apply(?MODULE,many_args_100,lists:seq(1,100)), - ?line ok = many_args_100(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100), - ?line verify_tmpmem(TmpMem), + ensure_lib_loaded(Config ,1), + ok = apply(?MODULE,many_args_100,lists:seq(1,100)), + ok = many_args_100(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100), + verify_tmpmem(TmpMem), ok. -binaries(doc) -> ["Test NIF binary handling."]; -binaries(suite) -> []; +%% Test NIF binary handling. binaries(Config) when is_list(Config) -> TmpMem = tmpmem(), - ?line ensure_lib_loaded(Config, 1), - ?line RefcBin = list_to_binary(lists:seq(1,255)), - ?line RefcBin = clone_bin(RefcBin), - ?line HeapBin = list_to_binary(lists:seq(1,20)), - ?line HeapBin = clone_bin(HeapBin), - ?line <<_:8,Sub1:6/binary,_/binary>> = RefcBin, - ?line <<_:8,Sub2:6/binary,_/binary>> = HeapBin, - ?line Sub1 = Sub2, - ?line Sub1 = clone_bin(Sub1), - ?line Sub2 = clone_bin(Sub2), - ?line <<_:9,Sub3:6/binary,_/bitstring>> = RefcBin, - ?line <<_:9,Sub4:6/binary,_/bitstring>> = HeapBin, - ?line Sub3 = Sub4, - ?line Sub3 = clone_bin(Sub3), - ?line Sub4 = clone_bin(Sub4), + ensure_lib_loaded(Config, 1), + RefcBin = list_to_binary(lists:seq(1,255)), + RefcBin = clone_bin(RefcBin), + HeapBin = list_to_binary(lists:seq(1,20)), + HeapBin = clone_bin(HeapBin), + <<_:8,Sub1:6/binary,_/binary>> = RefcBin, + <<_:8,Sub2:6/binary,_/binary>> = HeapBin, + Sub1 = Sub2, + Sub1 = clone_bin(Sub1), + Sub2 = clone_bin(Sub2), + <<_:9,Sub3:6/binary,_/bitstring>> = RefcBin, + <<_:9,Sub4:6/binary,_/bitstring>> = HeapBin, + Sub3 = Sub4, + Sub3 = clone_bin(Sub3), + Sub4 = clone_bin(Sub4), %% When NIFs get bitstring support - %%?line <<_:8,Sub5:27/bitstring,_/bitstring>> = RefcBin, - %%?line <<_:8,Sub6:27/bitstring,_/bitstring>> = HeapBin, - %%?line Sub5 = Sub6, - %%?line Sub5 = clone_bin(Sub5), - %%?line Sub6 = clone_bin(Sub6), - %%?line <<_:9,Sub7:27/bitstring,_/bitstring>> = RefcBin, - %%?line <<_:9,Sub8:27/bitstring,_/bitstring>> = HeapBin, - %%?line Sub7 = Sub8, - %%?line Sub7 = clone_bin(Sub7), - %%?line Sub8 = clone_bin(Sub8), - %%?line <<>> = clone_bin(<<>>), + %%<<_:8,Sub5:27/bitstring,_/bitstring>> = RefcBin, + %%<<_:8,Sub6:27/bitstring,_/bitstring>> = HeapBin, + %%Sub5 = Sub6, + %%Sub5 = clone_bin(Sub5), + %%Sub6 = clone_bin(Sub6), + %%<<_:9,Sub7:27/bitstring,_/bitstring>> = RefcBin, + %%<<_:9,Sub8:27/bitstring,_/bitstring>> = HeapBin, + %%Sub7 = Sub8, + %%Sub7 = clone_bin(Sub7), + %%Sub8 = clone_bin(Sub8), + %%<<>> = clone_bin(<<>>), <<_:8,SubBinA:200/binary,_/binary>> = RefcBin, <<_:9,SubBinB:200/binary,_/bitstring>> = RefcBin, @@ -398,56 +379,53 @@ binaries(Config) when is_list(Config) -> test_make_sub_bin(SubBinC), test_make_sub_bin(SubBinD), - ?line verify_tmpmem(TmpMem), + verify_tmpmem(TmpMem), ok. test_make_sub_bin(Bin) -> Size = byte_size(Bin), Rest10 = Size - 10, Rest1 = Size - 1, - ?line Bin = make_sub_bin(Bin, 0, Size), + Bin = make_sub_bin(Bin, 0, Size), <<_:10/binary,Sub0:Rest10/binary>> = Bin, - ?line Sub0 = make_sub_bin(Bin, 10, Rest10), + Sub0 = make_sub_bin(Bin, 10, Rest10), <<Sub1:10/binary,_/binary>> = Bin, - ?line Sub1 = make_sub_bin(Bin, 0, 10), + Sub1 = make_sub_bin(Bin, 0, 10), <<_:7/binary,Sub2:10/binary,_/binary>> = Bin, - ?line Sub2 = make_sub_bin(Bin, 7, 10), - ?line <<>> = make_sub_bin(Bin, 0, 0), - ?line <<>> = make_sub_bin(Bin, 10, 0), - ?line <<>> = make_sub_bin(Bin, Rest1, 0), - ?line <<>> = make_sub_bin(Bin, Size, 0), + Sub2 = make_sub_bin(Bin, 7, 10), + <<>> = make_sub_bin(Bin, 0, 0), + <<>> = make_sub_bin(Bin, 10, 0), + <<>> = make_sub_bin(Bin, Rest1, 0), + <<>> = make_sub_bin(Bin, Size, 0), ok. -get_string(doc) -> ["Test enif_get_string"]; -get_string(suite) -> []; +%% Test enif_get_string get_string(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), - ?line {7, <<"hejsan",0,_:3/binary>>} = string_to_bin("hejsan",10), - ?line {7, <<"hejsan",0,_>>} = string_to_bin("hejsan",8), - ?line {7, <<"hejsan",0>>} = string_to_bin("hejsan",7), - ?line {-6, <<"hejsa",0>>} = string_to_bin("hejsan",6), - ?line {-5, <<"hejs",0>>} = string_to_bin("hejsan",5), - ?line {-1, <<0>>} = string_to_bin("hejsan",1), - ?line {0, <<>>} = string_to_bin("hejsan",0), - ?line {1, <<0>>} = string_to_bin("",1), - ?line {0, <<>>} = string_to_bin("",0), + ensure_lib_loaded(Config, 1), + {7, <<"hejsan",0,_:3/binary>>} = string_to_bin("hejsan",10), + {7, <<"hejsan",0,_>>} = string_to_bin("hejsan",8), + {7, <<"hejsan",0>>} = string_to_bin("hejsan",7), + {-6, <<"hejsa",0>>} = string_to_bin("hejsan",6), + {-5, <<"hejs",0>>} = string_to_bin("hejsan",5), + {-1, <<0>>} = string_to_bin("hejsan",1), + {0, <<>>} = string_to_bin("hejsan",0), + {1, <<0>>} = string_to_bin("",1), + {0, <<>>} = string_to_bin("",0), ok. -get_atom(doc) -> ["Test enif_get_atom"]; -get_atom(suite) -> []; +%% Test enif_get_atom get_atom(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), - ?line {7, <<"hejsan",0,_:3/binary>>} = atom_to_bin(hejsan,10), - ?line {7, <<"hejsan",0,_>>} = atom_to_bin(hejsan,8), - ?line {7, <<"hejsan",0>>} = atom_to_bin(hejsan,7), - ?line {0, <<_:6/binary>>} = atom_to_bin(hejsan,6), - ?line {0, <<>>} = atom_to_bin(hejsan,0), - ?line {1, <<0>>} = atom_to_bin('',1), - ?line {0, <<>>} = atom_to_bin('',0), + ensure_lib_loaded(Config, 1), + {7, <<"hejsan",0,_:3/binary>>} = atom_to_bin(hejsan,10), + {7, <<"hejsan",0,_>>} = atom_to_bin(hejsan,8), + {7, <<"hejsan",0>>} = atom_to_bin(hejsan,7), + {0, <<_:6/binary>>} = atom_to_bin(hejsan,6), + {0, <<>>} = atom_to_bin(hejsan,0), + {1, <<0>>} = atom_to_bin('',1), + {0, <<>>} = atom_to_bin('',0), ok. -maps(doc) -> ["Test NIF maps handling."]; -maps(suite) -> []; +%% Test NIF maps handling. maps(Config) when is_list(Config) -> TmpMem = tmpmem(), Pairs = [{adam, "bert"}] ++ @@ -494,31 +472,28 @@ maps(Config) when is_list(Config) -> ok. -api_macros(doc) -> ["Test macros enif_make_list<N> and enif_make_tuple<N>"]; -api_macros(suite) -> []; +%% Test macros enif_make_list<N> and enif_make_tuple<N> api_macros(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), + ensure_lib_loaded(Config, 1), Expected = {[lists:seq(1,N) || N <- lists:seq(1,9)], [list_to_tuple(lists:seq(1,N)) || N <- lists:seq(1,9)] }, - ?line Expected = macros(list_to_tuple(lists:seq(1,9))), + Expected = macros(list_to_tuple(lists:seq(1,9))), ok. -from_array(doc) -> ["enif_make_[tuple|list]_from_array"]; -from_array(suite) -> []; +%% enif_make_[tuple|list]_from_array from_array(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), + ensure_lib_loaded(Config, 1), lists:foreach(fun(Tpl) -> Lst = tuple_to_list(Tpl), - ?line {Lst,Tpl} = tuple_2_list_and_tuple(Tpl) + {Lst,Tpl} = tuple_2_list_and_tuple(Tpl) end, [{}, {1,2,3}, {[4,5],[],{},{6,7}}, {{}}, {[]}]), ok. -iolist_as_binary(doc) -> ["enif_inspect_iolist_as_binary"]; -iolist_as_binary(suite) -> []; +%% enif_inspect_iolist_as_binary iolist_as_binary(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), + ensure_lib_loaded(Config, 1), TmpMem = tmpmem(), List = [<<"hejsan">>, <<>>, [], [17], [<<>>], [127,128,255,0], @@ -527,18 +502,17 @@ iolist_as_binary(Config) when is_list(Config) -> lists:foreach(fun(IoL) -> B1 = erlang:iolist_to_binary(IoL), - ?line B2 = iolist_2_bin(IoL), - ?line B1 = B2 + B2 = iolist_2_bin(IoL), + B1 = B2 end, List), - ?line verify_tmpmem(TmpMem), + verify_tmpmem(TmpMem), ok. -resource(doc) -> ["Test memory managed objects, aka 'resources'"]; -resource(suite) -> []; +%% Test memory managed objects, aka 'resources' resource(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), - ?line Type = get_resource_type(0), + ensure_lib_loaded(Config, 1), + Type = get_resource_type(0), resource_hugo(Type), resource_otto(Type), resource_new(Type), @@ -548,75 +522,75 @@ resource(Config) when is_list(Config) -> resource_hugo(Type) -> DtorCall = resource_hugo_do(Type), erlang:garbage_collect(), - ?line DtorCall = last_resource_dtor_call(), + DtorCall = last_resource_dtor_call(), ok. resource_hugo_do(Type) -> HugoBin = <<"Hugo Hacker">>, - ?line HugoPtr = alloc_resource(Type, HugoBin), - ?line Hugo = make_resource(HugoPtr), - ?line <<>> = Hugo, + HugoPtr = alloc_resource(Type, HugoBin), + Hugo = make_resource(HugoPtr), + <<>> = Hugo, release_resource(HugoPtr), erlang:garbage_collect(), - ?line {HugoPtr,HugoBin} = get_resource(Type,Hugo), + {HugoPtr,HugoBin} = get_resource(Type,Hugo), Pid = spawn_link(fun() -> - receive {Pid, Type, Resource, Ptr, Bin} -> - Pid ! {self(), got_it}, - receive {Pid, check_it} -> - ?line {Ptr,Bin} = get_resource(Type,Resource), - Pid ! {self(), ok} - end - end - end), + receive {Pid, Type, Resource, Ptr, Bin} -> + Pid ! {self(), got_it}, + receive {Pid, check_it} -> + {Ptr,Bin} = get_resource(Type,Resource), + Pid ! {self(), ok} + end + end + end), Pid ! {self(), Type, Hugo, HugoPtr, HugoBin}, - ?line {Pid, got_it} = receive_any(), + {Pid, got_it} = receive_any(), erlang:garbage_collect(), % just to make our ProcBin move in memory Pid ! {self(), check_it}, - ?line {Pid, ok} = receive_any(), - ?line [] = last_resource_dtor_call(), - ?line {HugoPtr,HugoBin} = get_resource(Type,Hugo), + {Pid, ok} = receive_any(), + [] = last_resource_dtor_call(), + {HugoPtr,HugoBin} = get_resource(Type,Hugo), {HugoPtr, HugoBin, 1}. resource_otto(Type) -> {OttoPtr, OttoBin} = resource_otto_do(Type), erlang:garbage_collect(), - ?line [] = last_resource_dtor_call(), + [] = last_resource_dtor_call(), release_resource(OttoPtr), - ?line {OttoPtr,OttoBin,1} = last_resource_dtor_call(), + {OttoPtr,OttoBin,1} = last_resource_dtor_call(), ok. resource_otto_do(Type) -> OttoBin = <<"Otto Ordonnans">>, - ?line OttoPtr = alloc_resource(Type, OttoBin), - ?line Otto = make_resource(OttoPtr), - ?line <<>> = Otto, + OttoPtr = alloc_resource(Type, OttoBin), + Otto = make_resource(OttoPtr), + <<>> = Otto, %% forget resource term but keep referenced by NIF {OttoPtr, OttoBin}. resource_new(Type) -> - ?line {PtrB,BinB} = resource_new_do1(Type), + {PtrB,BinB} = resource_new_do1(Type), erlang:garbage_collect(), - ?line {PtrB,BinB,1} = last_resource_dtor_call(), + {PtrB,BinB,1} = last_resource_dtor_call(), ok. resource_new_do1(Type) -> - ?line {{PtrA,BinA}, {ResB,PtrB,BinB}} = resource_new_do2(Type), + {{PtrA,BinA}, {ResB,PtrB,BinB}} = resource_new_do2(Type), erlang:garbage_collect(), - ?line {PtrA,BinA,1} = last_resource_dtor_call(), - ?line {PtrB,BinB} = get_resource(Type, ResB), + {PtrA,BinA,1} = last_resource_dtor_call(), + {PtrB,BinB} = get_resource(Type, ResB), %% forget ResB and make it garbage {PtrB,BinB}. resource_new_do2(Type) -> BinA = <<"NewA">>, BinB = <<"NewB">>, - ?line ResA = make_new_resource(Type, BinA), - ?line ResB = make_new_resource(Type, BinB), - ?line <<>> = ResA, - ?line <<>> = ResB, - ?line {PtrA,BinA} = get_resource(Type, ResA), - ?line {PtrB,BinB} = get_resource(Type, ResB), - ?line true = (PtrA =/= PtrB), + ResA = make_new_resource(Type, BinA), + ResB = make_new_resource(Type, BinB), + <<>> = ResA, + <<>> = ResB, + {PtrA,BinA} = get_resource(Type, ResA), + {PtrB,BinB} = get_resource(Type, ResB), + true = (PtrA =/= PtrB), %% forget ResA and make it garbage {{PtrA,BinA}, {ResB,PtrB,BinB}}. @@ -625,22 +599,21 @@ resource_neg(TypeA) -> catch exit(42), % dummy exception to purge saved stacktraces from earlier exception erlang:garbage_collect(), - ?line {_,_,2} = last_resource_dtor_call(), + {_,_,2} = last_resource_dtor_call(), ok. resource_neg_do(TypeA) -> TypeB = get_resource_type(1), ResA = make_new_resource(TypeA, <<"Arnold">>), ResB= make_new_resource(TypeB, <<"Bobo">>), - ?line {'EXIT',{badarg,_}} = (catch get_resource(TypeA, ResB)), - ?line {'EXIT',{badarg,_}} = (catch get_resource(TypeB, ResA)), + {'EXIT',{badarg,_}} = (catch get_resource(TypeA, ResB)), + {'EXIT',{badarg,_}} = (catch get_resource(TypeB, ResA)), ok. -resource_binary(doc) -> ["Test enif_make_resource_binary"]; -resource_binary(suite) -> []; +%% Test enif_make_resource_binary resource_binary(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), - ?line {Ptr,Bin} = resource_binary_do(), + ensure_lib_loaded(Config, 1), + {Ptr,Bin} = resource_binary_do(), erlang:garbage_collect(), Last = last_resource_dtor_call(), ?CHECK({Ptr,Bin,1}, Last), @@ -648,58 +621,57 @@ resource_binary(Config) when is_list(Config) -> resource_binary_do() -> Bin = <<"Hej Hopp i lingonskogen">>, - ?line {Ptr,ResBin1} = make_new_resource_binary(Bin), - ?line ResBin1 = Bin, - ?line ResInfo = {Ptr,_} = get_resource(binary_resource_type,ResBin1), + {Ptr,ResBin1} = make_new_resource_binary(Bin), + ResBin1 = Bin, + ResInfo = {Ptr,_} = get_resource(binary_resource_type,ResBin1), Papa = self(), Forwarder = spawn_link(fun() -> forwarder(Papa) end), io:format("sending to forwarder pid=~p\n",[Forwarder]), Forwarder ! ResBin1, ResBin2 = receive_any(), - ?line ResBin2 = ResBin1, - ?line ResInfo = get_resource(binary_resource_type,ResBin2), + ResBin2 = ResBin1, + ResInfo = get_resource(binary_resource_type,ResBin2), Forwarder ! terminate, - ?line {Forwarder, 1} = receive_any(), + {Forwarder, 1} = receive_any(), erlang:garbage_collect(), - ?line ResInfo = get_resource(binary_resource_type,ResBin1), - ?line ResInfo = get_resource(binary_resource_type,ResBin2), + ResInfo = get_resource(binary_resource_type,ResBin1), + ResInfo = get_resource(binary_resource_type,ResBin2), ResInfo. -define(RT_CREATE,1). -define(RT_TAKEOVER,2). -resource_takeover(doc) -> ["Test resource takeover by module reload and upgrade"]; -resource_takeover(suite) -> []; +%% Test resource takeover by module reload and upgrade resource_takeover(Config) when is_list(Config) -> TmpMem = tmpmem(), ensure_lib_loaded(Config), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "nif_mod"), - ?line {ok,nif_mod,ModBin} = compile:file(File, [binary,return_errors]), - ?line {module,nif_mod} = erlang:load_module(nif_mod,ModBin), - - ?line ok = nif_mod:load_nif_lib(Config, 1, - [{resource_type, 0, ?RT_CREATE, "resource_type_A",resource_dtor_A, - ?RT_CREATE}, - {resource_type, 1, ?RT_CREATE, "resource_type_null_A",null, - ?RT_CREATE}, - {resource_type, 2, ?RT_CREATE bor ?RT_TAKEOVER, "resource_type_A_null",resource_dtor_A, - ?RT_CREATE}, - {resource_type, 3, ?RT_CREATE, "resource_type_B_goneX",resource_dtor_B, - ?RT_CREATE}, - {resource_type, 4, ?RT_CREATE, "resource_type_null_goneX",null, - ?RT_CREATE}, - {resource_type, null, ?RT_TAKEOVER, "Pink unicorn", resource_dtor_A, - ?RT_TAKEOVER} - ]), - - ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), - ?line [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "nif_mod"), + {ok,nif_mod,ModBin} = compile:file(File, [binary,return_errors]), + {module,nif_mod} = erlang:load_module(nif_mod,ModBin), - ?line {Holder, _MRef} = spawn_opt(fun resource_holder/0, [link, monitor]), + ok = nif_mod:load_nif_lib(Config, 1, + [{resource_type, 0, ?RT_CREATE, "resource_type_A",resource_dtor_A, + ?RT_CREATE}, + {resource_type, 1, ?RT_CREATE, "resource_type_null_A",null, + ?RT_CREATE}, + {resource_type, 2, ?RT_CREATE bor ?RT_TAKEOVER, "resource_type_A_null",resource_dtor_A, + ?RT_CREATE}, + {resource_type, 3, ?RT_CREATE, "resource_type_B_goneX",resource_dtor_B, + ?RT_CREATE}, + {resource_type, 4, ?RT_CREATE, "resource_type_null_goneX",null, + ?RT_CREATE}, + {resource_type, null, ?RT_TAKEOVER, "Pink unicorn", resource_dtor_A, + ?RT_TAKEOVER} + ]), + + hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), + + {Holder, _MRef} = spawn_opt(fun resource_holder/0, [link, monitor]), {A1,BinA1} = make_resource(0,Holder,"A1"), {A2,BinA2} = make_resource(0,Holder,"A2"), @@ -719,91 +691,91 @@ resource_takeover(Config) when is_list(Config) -> {NGX1,_BinNGX1} = make_resource(4,Holder,"NGX1"), {NGX2,_BinNGX2} = make_resource(4,Holder,"NGX2"), - ?line [] = nif_mod_call_history(), + [] = nif_mod_call_history(), - ?line ok = forget_resource(A1), - ?line [{{resource_dtor_A_v1,BinA1},1,3,103}] = nif_mod_call_history(), + ok = forget_resource(A1), + [{{resource_dtor_A_v1,BinA1},1,3,103}] = nif_mod_call_history(), - ?line ok = forget_resource(NA1), - ?line [] = nif_mod_call_history(), % no dtor + ok = forget_resource(NA1), + [] = nif_mod_call_history(), % no dtor - ?line ok = forget_resource(AN1), + ok = forget_resource(AN1), ?CHECK([{{resource_dtor_A_v1,BinAN1},1,4,104}] , nif_mod_call_history()), - ?line ok = forget_resource(BGX1), + ok = forget_resource(BGX1), ?CHECK([{{resource_dtor_B_v1,BinBGX1},1,5,105}], nif_mod_call_history()), - ?line ok = forget_resource(NGX1), + ok = forget_resource(NGX1), ?CHECK([], nif_mod_call_history()), % no dtor - ?line ok = nif_mod:load_nif_lib(Config, 2, - [{resource_type, 0, ?RT_TAKEOVER, "resource_type_A",resource_dtor_A, - ?RT_TAKEOVER}, - {resource_type, 1, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",resource_dtor_A, - ?RT_TAKEOVER}, - {resource_type, 2, ?RT_TAKEOVER, "resource_type_A_null",null, - ?RT_TAKEOVER}, - {resource_type, null, ?RT_TAKEOVER, "Pink unicorn", resource_dtor_A, - ?RT_TAKEOVER}, - {resource_type, null, ?RT_CREATE, "resource_type_B_goneX",resource_dtor_B, - ?RT_CREATE}, - {resource_type, null, ?RT_CREATE, "resource_type_null_goneX",null, - ?RT_CREATE}, - {resource_type, 3, ?RT_CREATE, "resource_type_B_goneY",resource_dtor_B, - ?RT_CREATE}, - {resource_type, 4, ?RT_CREATE, "resource_type_null_goneY",null, - ?RT_CREATE} - ]), + ok = nif_mod:load_nif_lib(Config, 2, + [{resource_type, 0, ?RT_TAKEOVER, "resource_type_A",resource_dtor_A, + ?RT_TAKEOVER}, + {resource_type, 1, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",resource_dtor_A, + ?RT_TAKEOVER}, + {resource_type, 2, ?RT_TAKEOVER, "resource_type_A_null",null, + ?RT_TAKEOVER}, + {resource_type, null, ?RT_TAKEOVER, "Pink unicorn", resource_dtor_A, + ?RT_TAKEOVER}, + {resource_type, null, ?RT_CREATE, "resource_type_B_goneX",resource_dtor_B, + ?RT_CREATE}, + {resource_type, null, ?RT_CREATE, "resource_type_null_goneX",null, + ?RT_CREATE}, + {resource_type, 3, ?RT_CREATE, "resource_type_B_goneY",resource_dtor_B, + ?RT_CREATE}, + {resource_type, 4, ?RT_CREATE, "resource_type_null_goneY",null, + ?RT_CREATE} + ]), ?CHECK([{reload,2,1,201}], nif_mod_call_history()), - ?line BinA2 = read_resource(0,A2), - ?line ok = forget_resource(A2), + BinA2 = read_resource(0,A2), + ok = forget_resource(A2), ?CHECK([{{resource_dtor_A_v2,BinA2},2,2,202}], nif_mod_call_history()), - ?line ok = forget_resource(NA2), + ok = forget_resource(NA2), ?CHECK([{{resource_dtor_A_v2,BinNA2},2,3,203}], nif_mod_call_history()), - ?line ok = forget_resource(AN2), + ok = forget_resource(AN2), ?CHECK([], nif_mod_call_history()), % no dtor - ?line ok = forget_resource(BGX2), % calling dtor in orphan library v1 still loaded + ok = forget_resource(BGX2), % calling dtor in orphan library v1 still loaded ?CHECK([{{resource_dtor_B_v1,BinBGX2},1,6,106}], nif_mod_call_history()), % How to test that lib v1 is closed here? - ?line ok = forget_resource(NGX2), + ok = forget_resource(NGX2), ?CHECK([], nif_mod_call_history()), % no dtor {BGY1,BinBGY1} = make_resource(3,Holder,"BGY1"), {NGY1,_BinNGY1} = make_resource(4,Holder,"NGY1"), %% Module upgrade with same lib-version - ?line {module,nif_mod} = erlang:load_module(nif_mod,ModBin), - ?line undefined = nif_mod:lib_version(), - ?line ok = nif_mod:load_nif_lib(Config, 2, - [{resource_type, 2, ?RT_TAKEOVER, "resource_type_A",resource_dtor_B, - ?RT_TAKEOVER}, - {resource_type, 0, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",null, - ?RT_TAKEOVER}, - {resource_type, 1, ?RT_TAKEOVER, "resource_type_A_null",resource_dtor_A, - ?RT_TAKEOVER}, - {resource_type, null, ?RT_TAKEOVER, "Pink elephant", resource_dtor_A, - ?RT_TAKEOVER}, - {resource_type, 3, ?RT_CREATE, "resource_type_B_goneZ",resource_dtor_B, - ?RT_CREATE}, - {resource_type, 4, ?RT_CREATE, "resource_type_null_goneZ",null, - ?RT_CREATE} - ]), - - ?line 2 = nif_mod:lib_version(), + {module,nif_mod} = erlang:load_module(nif_mod,ModBin), + undefined = nif_mod:lib_version(), + ok = nif_mod:load_nif_lib(Config, 2, + [{resource_type, 2, ?RT_TAKEOVER, "resource_type_A",resource_dtor_B, + ?RT_TAKEOVER}, + {resource_type, 0, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",null, + ?RT_TAKEOVER}, + {resource_type, 1, ?RT_TAKEOVER, "resource_type_A_null",resource_dtor_A, + ?RT_TAKEOVER}, + {resource_type, null, ?RT_TAKEOVER, "Pink elephant", resource_dtor_A, + ?RT_TAKEOVER}, + {resource_type, 3, ?RT_CREATE, "resource_type_B_goneZ",resource_dtor_B, + ?RT_CREATE}, + {resource_type, 4, ?RT_CREATE, "resource_type_null_goneZ",null, + ?RT_CREATE} + ]), + + 2 = nif_mod:lib_version(), ?CHECK([{upgrade,2,4,204},{lib_version,2,5,205}], nif_mod_call_history()), - ?line ok = forget_resource(A3), + ok = forget_resource(A3), ?CHECK([{{resource_dtor_B_v2,BinA3},2,6,206}], nif_mod_call_history()), - ?line ok = forget_resource(NA3), + ok = forget_resource(NA3), ?CHECK([], nif_mod_call_history()), - ?line ok = forget_resource(AN3), + ok = forget_resource(AN3), ?CHECK([{{resource_dtor_A_v2,BinAN3},2,7,207}], nif_mod_call_history()), {A4,BinA4} = make_resource(2,Holder, "A4"), @@ -813,19 +785,19 @@ resource_takeover(Config) when is_list(Config) -> {BGZ1,BinBGZ1} = make_resource(3,Holder,"BGZ1"), {NGZ1,_BinNGZ1} = make_resource(4,Holder,"NGZ1"), - ?line false = code:purge(nif_mod), - ?line [] = nif_mod_call_history(), + false = code:purge(nif_mod), + [] = nif_mod_call_history(), - ?line ok = forget_resource(NGY1), - ?line [] = nif_mod_call_history(), + ok = forget_resource(NGY1), + [] = nif_mod_call_history(), - ?line ok = forget_resource(BGY1), % calling dtor in orphan library v2 still loaded - ?line [{{resource_dtor_B_v2,BinBGY1},2,8,208},{unload,2,9,209}] = nif_mod_call_history(), + ok = forget_resource(BGY1), % calling dtor in orphan library v2 still loaded + [{{resource_dtor_B_v2,BinBGY1},2,8,208},{unload,2,9,209}] = nif_mod_call_history(), %% Module upgrade with other lib-version - ?line {module,nif_mod} = erlang:load_module(nif_mod,ModBin), - ?line undefined = nif_mod:lib_version(), - ?line ok = nif_mod:load_nif_lib(Config, 1, + {module,nif_mod} = erlang:load_module(nif_mod,ModBin), + undefined = nif_mod:lib_version(), + ok = nif_mod:load_nif_lib(Config, 1, [{resource_type, 2, ?RT_TAKEOVER, "resource_type_A",resource_dtor_A, ?RT_TAKEOVER}, {resource_type, 0, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",resource_dtor_A, @@ -836,28 +808,28 @@ resource_takeover(Config) when is_list(Config) -> ?RT_TAKEOVER} ]), - ?line 1 = nif_mod:lib_version(), - ?line [{upgrade,1,1,101},{lib_version,1,2,102}] = nif_mod_call_history(), + 1 = nif_mod:lib_version(), + [{upgrade,1,1,101},{lib_version,1,2,102}] = nif_mod_call_history(), - %%?line false= check_process_code(Pid, nif_mod), - ?line false = code:purge(nif_mod), + %%false= check_process_code(Pid, nif_mod), + false = code:purge(nif_mod), %% no unload here as we still have instances with destructors - ?line [] = nif_mod_call_history(), + [] = nif_mod_call_history(), - ?line ok = forget_resource(BGZ1), % calling dtor in orphan library v2 still loaded - ?line [{{resource_dtor_B_v2,BinBGZ1},2,10,210},{unload,2,11,211}] = nif_mod_call_history(), + ok = forget_resource(BGZ1), % calling dtor in orphan library v2 still loaded + [{{resource_dtor_B_v2,BinBGZ1},2,10,210},{unload,2,11,211}] = nif_mod_call_history(), - ?line ok = forget_resource(NGZ1), - ?line [] = nif_mod_call_history(), + ok = forget_resource(NGZ1), + [] = nif_mod_call_history(), - ?line ok = forget_resource(A4), - ?line [{{resource_dtor_A_v1,BinA4},1,3,103}] = nif_mod_call_history(), + ok = forget_resource(A4), + [{{resource_dtor_A_v1,BinA4},1,3,103}] = nif_mod_call_history(), - ?line ok = forget_resource(NA4), - ?line [{{resource_dtor_A_v1,BinNA4},1,4,104}] = nif_mod_call_history(), + ok = forget_resource(NA4), + [{{resource_dtor_A_v1,BinNA4},1,4,104}] = nif_mod_call_history(), - ?line ok = forget_resource(AN4), - ?line [] = nif_mod_call_history(), + ok = forget_resource(AN4), + [] = nif_mod_call_history(), %% @@ -979,8 +951,8 @@ resource_takeover(Config) when is_list(Config) -> {return, 0} % SUCCESS ]), - ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), - ?line [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), + hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), {NA7,BinNA7} = make_resource(0, Holder, "NA7"), {AN7,BinAN7} = make_resource(1, Holder, "AN7"), @@ -991,15 +963,15 @@ resource_takeover(Config) when is_list(Config) -> ok = forget_resource(AN7), [] = nif_mod_call_history(), - ?line true = lists:member(?MODULE, erlang:system_info(taints)), - ?line true = lists:member(nif_mod, erlang:system_info(taints)), - ?line verify_tmpmem(TmpMem), + true = lists:member(?MODULE, erlang:system_info(taints)), + true = lists:member(nif_mod, erlang:system_info(taints)), + verify_tmpmem(TmpMem), ok. make_resource(Type,Holder,Str) when is_list(Str) -> Bin = list_to_binary(Str), A1 = make_resource_do(Type,Holder,Bin), - ?line Bin = read_resource(Type,A1), + Bin = read_resource(Type,A1), {A1,Bin}. make_resource_do(Type, Holder, Bin) -> @@ -1026,7 +998,7 @@ resource_holder(List) -> %%io:format("resource_holder got ~p with list = ~p\n", [Msg,List]), case Msg of {Pid, make, Type, Bin} -> - ?line Resource = nif_mod:make_new_resource(Type, Bin), + Resource = nif_mod:make_new_resource(Type, Bin), Id = {make_ref(),Bin}, Pid ! {self(), make_ok, Id}, resource_holder([{Id,Resource} | List]); @@ -1048,7 +1020,7 @@ resource_holder(Pid,Reply,List) -> resource_holder(List). -threading(doc) -> ["Test the threading API functions (reuse tests from driver API)"]; +%% Test the threading API functions (reuse tests from driver API) threading(Config) when is_list(Config) -> case erlang:system_info(threads) of true -> threading_do(Config); @@ -1056,53 +1028,53 @@ threading(Config) when is_list(Config) -> end. threading_do(Config) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "tester"), - ?line {ok,tester,ModBin} = compile:file(File, [binary,return_errors]), - ?line {module,tester} = erlang:load_module(tester,ModBin), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "tester"), + {ok,tester,ModBin} = compile:file(File, [binary,return_errors]), + {module,tester} = erlang:load_module(tester,ModBin), - ?line ok = tester:load_nif_lib(Config, "basic"), - ?line ok = tester:run(), + ok = tester:load_nif_lib(Config, "basic"), + ok = tester:run(), - ?line ok = tester:load_nif_lib(Config, "rwlock"), - ?line ok = tester:run(), + ok = tester:load_nif_lib(Config, "rwlock"), + ok = tester:run(), - ?line ok = tester:load_nif_lib(Config, "tsd"), - ?line ok = tester:run(). + ok = tester:load_nif_lib(Config, "tsd"), + ok = tester:run(). -send(doc) -> ["Test NIF message sending"]; +%% Test NIF message sending send(Config) when is_list(Config) -> ensure_lib_loaded(Config), N = 1500, List = lists:seq(1,N), - ?line {ok,1} = send_list_seq(N, self), - ?line {ok,1} = send_list_seq(N, self()), - ?line List = receive_any(), - ?line List = receive_any(), + {ok,1} = send_list_seq(N, self), + {ok,1} = send_list_seq(N, self()), + List = receive_any(), + List = receive_any(), Papa = self(), - spawn_link(fun() -> ?line {ok,1} = send_list_seq(N, Papa) end), - ?line List = receive_any(), + spawn_link(fun() -> {ok,1} = send_list_seq(N, Papa) end), + List = receive_any(), - ?line {ok, 1, BlobS} = send_new_blob(self(), other_term()), - ?line BlobR = receive_any(), + {ok, 1, BlobS} = send_new_blob(self(), other_term()), + BlobR = receive_any(), io:format("Sent ~p\nGot ~p\n", [BlobS, BlobR]), - ?line BlobR = BlobS, + BlobR = BlobS, %% send to dead pid {DeadPid, DeadMon} = spawn_monitor(fun() -> void end), - ?line {'DOWN', DeadMon, process, DeadPid, normal} = receive_any(), + {'DOWN', DeadMon, process, DeadPid, normal} = receive_any(), {ok,0} = send_list_seq(7, DeadPid), ok. -send2(doc) -> ["More NIF message sending"]; +%% More NIF message sending send2(Config) when is_list(Config) -> ensure_lib_loaded(Config), send2_do1(fun send_blob_dbg/2), ok. -send_threaded(doc) -> ["Send msg from user thread"]; +%% Send msg from user thread send_threaded(Config) when is_list(Config) -> case erlang:system_info(smp_support) of true -> @@ -1123,44 +1095,44 @@ send2_do1(SendBlobF) -> io:format("sending to forwarder pid=~p\n",[Forwarder]), send2_do2(SendBlobF, Forwarder), Forwarder ! terminate, - ?line {Forwarder, 4} = receive_any(), + {Forwarder, 4} = receive_any(), ok. send2_do2(SendBlobF, To) -> MsgEnv = alloc_msgenv(), repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []), - ?line {ok,1,Blob0} = SendBlobF(MsgEnv, To), - ?line Blob1 = receive_any(), - ?line Blob1 = Blob0, + {ok,1,Blob0} = SendBlobF(MsgEnv, To), + Blob1 = receive_any(), + Blob1 = Blob0, clear_msgenv(MsgEnv), repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []), - ?line {ok,1,Blob2} = SendBlobF(MsgEnv, To), - ?line Blob3 = receive_any(), - ?line Blob3 = Blob2, + {ok,1,Blob2} = SendBlobF(MsgEnv, To), + Blob3 = receive_any(), + Blob3 = Blob2, clear_msgenv(MsgEnv), repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []), clear_msgenv(MsgEnv), repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []), - ?line {ok,1,Blob4} = SendBlobF(MsgEnv, To), - ?line Blob5 = receive_any(), - ?line Blob5 = Blob4, + {ok,1,Blob4} = SendBlobF(MsgEnv, To), + Blob5 = receive_any(), + Blob5 = Blob4, clear_msgenv(MsgEnv), clear_msgenv(MsgEnv), repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []), - ?line {ok,1,Blob6} = SendBlobF(MsgEnv, To), - ?line Blob7 = receive_any(), - ?line Blob7 = Blob6, + {ok,1,Blob6} = SendBlobF(MsgEnv, To), + Blob7 = receive_any(), + Blob7 = Blob6, ok. send_blob_thread_and_join(MsgEnv, To) -> - ?line {ok,Blob} = send_blob_thread_dbg(MsgEnv, To, no_join), - ?line {ok,SendRes} = join_send_thread(MsgEnv), + {ok,Blob} = send_blob_thread_dbg(MsgEnv, To, no_join), + {ok,SendRes} = join_send_thread(MsgEnv), {ok,SendRes,Blob}. send_blob_dbg(MsgEnv, To) -> @@ -1188,21 +1160,18 @@ forwarder(To, N) -> other_term() -> {fun(X,Y) -> X*Y end, make_ref()}. -send3(doc) -> ["Message sending stress test"]; +%% Message sending stress test 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 = {erlang:monotonic_time(), - erlang:time_offset(), - erlang:unique_integer()}, - io:format("seed: ~p\n",[Seed]), - random:seed(Seed), + rand:seed(exsplus), + io:format("seed: ~p\n",[rand:export_seed()]), ets:new(nif_SUITE,[named_table,public]), - ?line true = ets:insert(nif_SUITE,{send3,0,0,0,0}), + true = ets:insert(nif_SUITE,{send3,0,0,0,0}), timer:send_after(10000, timeout), % Run for 10 seconds SpawnCnt = send3_controller(0, [], [], 20), - ?line [{_,Rcv,SndOk,SndFail,Balance}] = ets:lookup(nif_SUITE,send3), + [{_,Rcv,SndOk,SndFail,Balance}] = ets:lookup(nif_SUITE,send3), io:format("spawns=~p received=~p, sent=~p send-failure=~p balance=~p\n", [SpawnCnt,Rcv,SndOk,SndFail,Balance]), ets:delete(nif_SUITE). @@ -1230,13 +1199,13 @@ send3_controller(SpawnCnt0, Mons0, Pids0, Tick) -> after Tick -> Max = 20, N = length(Pids0), - PidN = random:uniform(Max), + PidN = rand:uniform(Max), %%io:format("N=~p PidN=~p Pids0=~p\n", [N,PidN,Pids0]), case PidN > N of true -> {NewPid,Mon} = spawn_opt(fun send3_proc/0, [link,monitor]), lists:foreach(fun(P) -> P ! {is_born,NewPid} end, Pids0), - ?line Balance = ets:lookup_element(nif_SUITE,send3,5), + Balance = ets:lookup_element(nif_SUITE,send3,5), Inject = (Balance =< 0), case Inject of true -> ok; @@ -1262,7 +1231,7 @@ send3_proc(Pids0, Counters={Rcv,SndOk,SndFail}, State0) -> receive {pids, Pids1, Inject} -> %%io:format("~p: got ~p Inject=~p\n", [self(), Pids1, Inject]), - ?line Pids0 = [self()], + Pids0 = [self()], Pids2 = [self() | Pids1], case Inject of true -> send3_proc_send(Pids2, Counters, State0); @@ -1294,7 +1263,7 @@ send3_proc(Pids0, Counters={Rcv,SndOk,SndFail}, State0) -> end. send3_proc_send(Pids, {Rcv,SndOk,SndFail}, State0) -> - To = lists:nth(random:uniform(length(Pids)),Pids), + To = lists:nth(rand:uniform(length(Pids)),Pids), Blob = send3_make_blob(), State1 = send3_new_state(State0,Blob), case send3_send(To, Blob) of @@ -1306,28 +1275,32 @@ send3_proc_send(Pids, {Rcv,SndOk,SndFail}, State0) -> send3_make_blob() -> - case random:uniform(20)-1 of + case rand:uniform(20)-1 of 0 -> {term,[]}; N -> MsgEnv = alloc_msgenv(), repeat(N bsr 1, - fun(_) -> grow_blob(MsgEnv,other_term(),random:uniform(1 bsl 20)) + fun(_) -> grow_blob(MsgEnv,other_term(),rand:uniform(1 bsl 20)) end, void), - case (N band 1) of + case (N band 3) of 0 -> {term,copy_blob(MsgEnv)}; - 1 -> {msgenv,MsgEnv} + 1 -> {copy,copy_blob(MsgEnv)}; + _ -> {msgenv,MsgEnv} end end. send3_send(Pid, Msg) -> %% 90% enif_send and 10% normal bang - case random:uniform(10) of + case rand:uniform(10) of 1 -> send3_send_bang(Pid,Msg); _ -> send3_send_nif(Pid,Msg) end. send3_send_nif(Pid, {term,Blob}) -> %%io:format("~p send term nif\n",[self()]), send_term(Pid, {blob, Blob}) =:= 1; +send3_send_nif(Pid, {copy,Blob}) -> + %%io:format("~p send term nif\n",[self()]), + send_copy_term(Pid, {blob, Blob}) =:= 1; send3_send_nif(Pid, {msgenv,MsgEnv}) -> %%io:format("~p send blob nif\n",[self()]), send3_blob(MsgEnv, Pid, blob) =:= 1. @@ -1336,109 +1309,115 @@ send3_send_bang(Pid, {term,Blob}) -> %%io:format("~p send term bang\n",[self()]), Pid ! {blob, Blob}, true; +send3_send_bang(Pid, {copy,Blob}) -> + %%io:format("~p send term bang\n",[self()]), + Pid ! {blob, Blob}, + true; send3_send_bang(Pid, {msgenv,MsgEnv}) -> %%io:format("~p send blob bang\n",[self()]), Pid ! {blob, copy_blob(MsgEnv)}, true. send3_new_state(State, Blob) -> - case random:uniform(5+2) of + case rand:uniform(5+2) of N when N =< 5-> setelement(N, State, Blob); _ -> State % Don't store blob end. -neg(doc) -> ["Negative testing of load_nif"]; +%% Negative testing of load_nif neg(Config) when is_list(Config) -> TmpMem = tmpmem(), - ?line {'EXIT',{badarg,_}} = (catch erlang:load_nif(badarg, 0)), - ?line {error,{load_failed,_}} = erlang:load_nif("pink_unicorn", 0), + {'EXIT',{badarg,_}} = (catch erlang:load_nif(badarg, 0)), + {error,{load_failed,_}} = erlang:load_nif("pink_unicorn", 0), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "nif_mod"), - ?line {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), - ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "nif_mod"), + {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), + {module,nif_mod} = erlang:load_module(nif_mod,Bin), - ?line {error,{bad_lib,_}} = nif_mod:load_nif_lib(Config, no_init), - ?line verify_tmpmem(TmpMem), - ?line ok. + {error,{bad_lib,_}} = nif_mod:load_nif_lib(Config, no_init), + verify_tmpmem(TmpMem), + ok. -is_checks(doc) -> ["Test all enif_is functions"]; +%% Test all enif_is functions is_checks(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), - ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + ensure_lib_loaded(Config, 1), + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 12), - ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -12), - ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551617), - ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551617), - ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 99.146), - ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -99.146), - ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551616.2e2), - ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551616.2e2), try - ?line check_is_exception(), - ?line throw(expected_badarg) + check_is_exception(), + throw(expected_badarg) catch error:badarg -> - ?line ok + ok end. -get_length(doc) -> ["Test all enif_get_length functions"]; +%% Test all enif_get_length functions get_length(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), - ?line ok = length_test(hejsan, "hejsan", [], [], not_a_list). + ensure_lib_loaded(Config, 1), + ok = length_test(hejsan, "hejsan", [], [], not_a_list, [1,2|3]). ensure_lib_loaded(Config) -> ensure_lib_loaded(Config, 1). ensure_lib_loaded(Config, Ver) -> - ?line case lib_version() of - undefined -> - ?line Path = ?config(data_dir, Config), - ?line Lib = "nif_SUITE." ++ integer_to_list(Ver), - ?line ok = erlang:load_nif(filename:join(Path,Lib), []); - Ver when is_integer(Ver) -> - ok - end. + Path = ?config(data_dir, Config), + case lib_version() of + undefined -> + Lib = "nif_SUITE." ++ integer_to_list(Ver), + ok = erlang:load_nif(filename:join(Path,Lib), []); + Ver when is_integer(Ver) -> + ok + end, + erl_ddll:try_load(Path, echo_drv, []), + ok. make_atom(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), + ensure_lib_loaded(Config, 1), An0Atom = an0atom, An0Atom0 = 'an\000atom\000', - ?line Atoms = make_atoms(), - ?line 7 = size(Atoms), - ?line Atoms = {An0Atom,An0Atom,An0Atom,An0Atom0,An0Atom,An0Atom,An0Atom0}. + Atoms = make_atoms(), + 7 = size(Atoms), + Atoms = {An0Atom,An0Atom,An0Atom,An0Atom0,An0Atom,An0Atom,An0Atom0}. make_string(Config) when is_list(Config) -> - ?line ensure_lib_loaded(Config, 1), - ?line Strings = make_strings(), - ?line 5 = size(Strings), + ensure_lib_loaded(Config, 1), + Strings = make_strings(), + 5 = size(Strings), A0String = "a0string", A0String0 = [$a,0,$s,$t,$r,$i,$n,$g,0], AStringWithAccents = [$E,$r,$l,$a,$n,$g,$ ,16#e4,$r,$ ,$e,$t,$t,$ ,$g,$e,$n,$e,$r,$e,$l,$l,$t,$ ,$p,$r,$o,$g,$r,$a,$m,$s,$p,$r,16#e5,$k], - ?line Strings = {A0String,A0String,A0String,A0String0, AStringWithAccents}. + Strings = {A0String,A0String,A0String,A0String0, AStringWithAccents}. reverse_list_test(Config) -> - ?line ensure_lib_loaded(Config, 1), + ensure_lib_loaded(Config, 1), List = lists:seq(1,100), RevList = lists:reverse(List), - ?line RevList = reverse_list(List), - ?line badarg = reverse_list(foo). + RevList = reverse_list(List), + badarg = reverse_list(foo). -otp_9668(doc) -> ["Memory leak of tmp-buffer when inspecting iolist or unaligned binary in unbound environment"]; +%% Memory leak of tmp-buffer when inspecting iolist or unaligned binary in unbound environment otp_9668(Config) -> ensure_lib_loaded(Config, 1), TmpMem = tmpmem(), @@ -1448,13 +1427,12 @@ otp_9668(Config) -> <<_:5/bitstring,UnalignedBin:10/binary,_/bitstring>> = <<"Abuse me as unaligned">>, otp_9668_nif(UnalignedBin), - ?line verify_tmpmem(TmpMem), + verify_tmpmem(TmpMem), ok. -otp_9828(doc) -> ["Copy of writable binary"]; +%% Copy of writable binary otp_9828(Config) -> ensure_lib_loaded(Config, 1), - otp_9828_loop(<<"I'm alive!">>, 1000). otp_9828_loop(Bin, 0) -> @@ -1473,68 +1451,68 @@ consume_timeslice(Config) when is_list(Config) -> Done = make_ref(), DummyMFA = {?MODULE,dummy_call,1}, P = spawn(fun () -> - receive Go -> ok end, - {reductions, R1} = process_info(self(), reductions), - 1 = consume_timeslice_nif(100, false), - dummy_call(111), - 0 = consume_timeslice_nif(90, false), - dummy_call(222), - 1 = consume_timeslice_nif(10, false), - dummy_call(333), - 0 = consume_timeslice_nif(25, false), - 0 = consume_timeslice_nif(25, false), - 0 = consume_timeslice_nif(25, false), - 1 = consume_timeslice_nif(25, false), - 0 = consume_timeslice_nif(25, false), - - ok = case consume_timeslice_nif(1, true) of - Cnt when Cnt > 70, Cnt < 80 -> ok; - Other -> Other - end, - dummy_call(444), - - {reductions, R2} = process_info(self(), reductions), - Me ! {RedDiff, R2 - R1}, - exit(Done) - end), + receive Go -> ok end, + {reductions, R1} = process_info(self(), reductions), + 1 = consume_timeslice_nif(100, false), + dummy_call(111), + 0 = consume_timeslice_nif(90, false), + dummy_call(222), + 1 = consume_timeslice_nif(10, false), + dummy_call(333), + 0 = consume_timeslice_nif(25, false), + 0 = consume_timeslice_nif(25, false), + 0 = consume_timeslice_nif(25, false), + 1 = consume_timeslice_nif(25, false), + 0 = consume_timeslice_nif(25, false), + + ok = case consume_timeslice_nif(1, true) of + Cnt when Cnt > 70, Cnt < 80 -> ok; + Other -> Other + end, + dummy_call(444), + + {reductions, R2} = process_info(self(), reductions), + Me ! {RedDiff, R2 - R1}, + exit(Done) + end), erlang:yield(), erlang:trace_pattern(DummyMFA, [], [local]), - ?line 1 = erlang:trace(P, true, [call, running, procs, {tracer, self()}]), + 1 = erlang:trace(P, true, [call, running, procs, {tracer, self()}]), P ! Go, %% receive Go -> ok end, - ?line {trace, P, in, _} = next_tmsg(P), + {trace, P, in, _} = next_tmsg(P), %% consume_timeslice_nif(100), %% dummy_call(111) - ?line {trace, P, out, _} = next_tmsg(P), - ?line {trace, P, in, _} = next_tmsg(P), - ?line {trace, P, call, {?MODULE,dummy_call,[111]}} = next_tmsg(P), + {trace, P, out, _} = next_tmsg(P), + {trace, P, in, _} = next_tmsg(P), + {trace, P, call, {?MODULE,dummy_call,[111]}} = next_tmsg(P), %% consume_timeslice_nif(90), %% dummy_call(222) - ?line {trace, P, call, {?MODULE,dummy_call,[222]}} = next_tmsg(P), + {trace, P, call, {?MODULE,dummy_call,[222]}} = next_tmsg(P), %% consume_timeslice_nif(10), %% dummy_call(333) - ?line {trace, P, out, _} = next_tmsg(P), - ?line {trace, P, in, _} = next_tmsg(P), - ?line {trace, P, call, {?MODULE,dummy_call,[333]}} = next_tmsg(P), + {trace, P, out, _} = next_tmsg(P), + {trace, P, in, _} = next_tmsg(P), + {trace, P, call, {?MODULE,dummy_call,[333]}} = next_tmsg(P), %% 25,25,25,25, 25 - ?line {trace, P, out, {?MODULE,consume_timeslice_nif,2}} = next_tmsg(P), - ?line {trace, P, in, {?MODULE,consume_timeslice_nif,2}} = next_tmsg(P), + {trace, P, out, {?MODULE,consume_timeslice_nif,2}} = next_tmsg(P), + {trace, P, in, {?MODULE,consume_timeslice_nif,2}} = next_tmsg(P), %% consume_timeslice(1,true) %% dummy_call(444) - ?line {trace, P, out, DummyMFA} = next_tmsg(P), - ?line {trace, P, in, DummyMFA} = next_tmsg(P), - ?line {trace, P, call, {?MODULE,dummy_call,[444]}} = next_tmsg(P), + {trace, P, out, DummyMFA} = next_tmsg(P), + {trace, P, in, DummyMFA} = next_tmsg(P), + {trace, P, call, {?MODULE,dummy_call,[444]}} = next_tmsg(P), %% exit(Done) - ?line {trace, P, exit, Done} = next_tmsg(P), + {trace, P, exit, Done} = next_tmsg(P), ExpReds = (100 + 90 + 10 + 25*5 + 75) * CONTEXT_REDS div 100, receive @@ -1542,7 +1520,7 @@ consume_timeslice(Config) when is_list(Config) -> io:format("Reductions = ~p~n", [Reductions]), ok; {RedDiff, Reductions} -> - ?t:fail({unexpected_reduction_count, Reductions}) + ct:fail({unexpected_reduction_count, Reductions}) end, none = next_msg(P), @@ -1599,38 +1577,38 @@ dirty_nif_send(Config) when is_list(Config) -> dirty_nif_exception(Config) when is_list(Config) -> try erlang:system_info(dirty_cpu_schedulers) of - N when is_integer(N) -> - ensure_lib_loaded(Config), - try - %% 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,[1],_}|_] = - erlang:get_stacktrace(), - ok - 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) + N when is_integer(N) -> + ensure_lib_loaded(Config), + try + %% this checks that the expected exception occurs when the + %% dirty NIF returns the result of enif_make_badarg + %% directly + call_dirty_nif_exception(1), + ct:fail(expected_badarg) + catch + error:badarg -> + [{?MODULE,call_dirty_nif_exception,[1],_}|_] = + erlang:get_stacktrace(), + ok + 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), + ct: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"} + error:badarg -> + {skipped,"No dirty scheduler support"} end. nif_exception(Config) when is_list(Config) -> @@ -1640,7 +1618,7 @@ nif_exception(Config) when is_list(Config) -> %% 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) + ct:fail(expected_badarg) catch error:badarg -> ok @@ -1653,21 +1631,21 @@ nif_nan_and_inf(Config) when is_list(Config) -> ensure_lib_loaded(Config), try call_nif_nan_or_inf(nan), - ?t:fail(expected_badarg) + ct:fail(expected_badarg) catch error:badarg -> ok end, try call_nif_nan_or_inf(inf), - ?t:fail(expected_badarg) + ct:fail(expected_badarg) catch error:badarg -> ok end, try call_nif_nan_or_inf(tuple), - ?t:fail(expected_badarg) + ct:fail(expected_badarg) catch error:badarg -> ok @@ -1677,14 +1655,14 @@ nif_atom_too_long(Config) when is_list(Config) -> ensure_lib_loaded(Config), try call_nif_atom_too_long(all), - ?t:fail(expected_badarg) + ct:fail(expected_badarg) catch error:badarg -> ok end, try call_nif_atom_too_long(len), - ?t:fail(expected_badarg) + ct:fail(expected_badarg) catch error:badarg -> ok @@ -1692,19 +1670,19 @@ nif_atom_too_long(Config) when is_list(Config) -> next_msg(_Pid) -> receive - M -> M + M -> M after 100 -> - none + none end. next_tmsg(Pid) -> receive TMsg when is_tuple(TMsg), - element(1, TMsg) == trace, - element(2, TMsg) == Pid -> - TMsg - after 100 -> - none - end. + element(1, TMsg) == trace, + element(2, TMsg) == Pid -> + TMsg + after 100 -> + none + end. dummy_call(_) -> ok. @@ -1744,9 +1722,7 @@ verify_tmpmem(MemInfo) -> ok end; Other -> - io:format("Expected: ~p", [MemInfo]), - io:format("Actual: ~p", [Other]), - ?t:fail() + ct:fail("Expected: ~p\nActual: ~p", [MemInfo, Other]) end. call(Pid,Cmd) -> @@ -1774,17 +1750,17 @@ check(Exp,Got,Line) -> nif_raise_exceptions(NifFunc) -> ExcTerms = [{error, test}, "a string", <<"a binary">>, - 42, [1,2,3,4,5], [{p,1},{p,2},{p,3}]], + 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). + try + erlang:apply(?MODULE,NifFunc,[Term]), + ct:fail({expected,Term}) + catch + error:Term -> + [{?MODULE,NifFunc,[Term],_}|_] = erlang:get_stacktrace(), + ok + end + end, ok, ExcTerms). -define(ERL_NIF_TIME_ERROR, -9223372036854775808). -define(TIME_UNITS, [seconds, milli_seconds, micro_seconds, nano_seconds]). @@ -1810,7 +1786,7 @@ chk_mtime([TU|TUs]) -> true = B =< C catch _ : _ -> - ?t:fail({monotonic_time_missmatch, TU, A, B, C}) + ct:fail({monotonic_time_missmatch, TU, A, B, C}) end, chk_mtime(TUs). @@ -1830,25 +1806,25 @@ chk_toffs([TU|TUs]) -> TO = erlang:time_offset(TU), NifTO = time_offset(TU), case TO =:= NifTO of - true -> - ok; - false -> - case erlang:system_info(time_warp_mode) of - no_time_warp -> - ?t:fail({time_offset_mismatch, TU, TO, NifTO}); - _ -> - %% Most frequent time offset change - %% is currently only every 15:th - %% second so this should currently - %% work... - NTO = erlang:time_offset(TU), - case NifTO =:= NTO of - true -> - ok; - false -> - ?t:fail({time_offset_mismatch, TU, TO, NifTO, NTO}) - end - end + true -> + ok; + false -> + case erlang:system_info(time_warp_mode) of + no_time_warp -> + ct:fail({time_offset_mismatch, TU, TO, NifTO}); + _ -> + %% Most frequent time offset change + %% is currently only every 15:th + %% second so this should currently + %% work... + NTO = erlang:time_offset(TU), + case NifTO =:= NTO of + true -> + ok; + false -> + ct:fail({time_offset_mismatch, TU, TO, NifTO, NTO}) + end + end end, chk_toffs(TUs). @@ -1857,47 +1833,47 @@ nif_convert_time_unit(Config) -> ?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, seconds), ?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, invalid_time_unit), lists:foreach(fun (Offset) -> - lists:foreach(fun (Diff) -> - chk_ctu(Diff+(Offset*1000*1000*1000)) - end, - [999999999999, - 99999999999, - 9999999999, - 999999999, - 99999999, - 9999999, - 999999, - 99999, - 999, - 99, - 9, - 1, - 11, - 101, - 1001, - 10001, - 100001, - 1000001, - 10000001, - 100000001, - 1000000001, - 100000000001, - 1000000000001, - 5, - 50, - 500, - 5000, - 50000, - 500000, - 5000000, - 50000000, - 500000000, - 5000000000, - 50000000000, - 500000000000]) - end, - [-4711, -1000, -475, -5, -4, -3, -2, -1, 0, - 1, 2, 3, 4, 5, 475, 1000, 4711]), + lists:foreach(fun (Diff) -> + chk_ctu(Diff+(Offset*1000*1000*1000)) + end, + [999999999999, + 99999999999, + 9999999999, + 999999999, + 99999999, + 9999999, + 999999, + 99999, + 999, + 99, + 9, + 1, + 11, + 101, + 1001, + 10001, + 100001, + 1000001, + 10000001, + 100000001, + 1000000001, + 100000000001, + 1000000000001, + 5, + 50, + 500, + 5000, + 50000, + 500000, + 5000000, + 50000000, + 500000000, + 5000000000, + 50000000000, + 500000000000]) + end, + [-4711, -1000, -475, -5, -4, -3, -2, -1, 0, + 1, 2, 3, 4, 5, 475, 1000, 4711]), ctu_loop(1000000). ctu_loop(0) -> @@ -1923,11 +1899,134 @@ chk_ctu(Time, FromTU, [ToTU|ToTUs]) -> TN = convert_time_unit(T, FromTU, ToTU), case TE =:= TN of false -> - ?t:fail({conversion_mismatch, FromTU, T, ToTU, TE, TN}); + ct:fail({conversion_mismatch, FromTU, T, ToTU, TE, TN}); true -> chk_ctu(Time, FromTU, ToTUs) end. +nif_now_time(Config) -> + ensure_lib_loaded(Config), + + N1 = now(), + NifN1 = now_time(), + NifN2 = now_time(), + N2 = now(), + true = N1 < NifN1, + true = NifN1 < NifN2, + true = NifN2 < N2. + +nif_cpu_time(Config) -> + ensure_lib_loaded(Config), + + try cpu_time() of + {_, _, _} -> + ok + catch error:badarg -> + {comment, "cpu_time not supported"} + end. + +nif_unique_integer(Config) -> + ensure_lib_loaded(Config), + + UM1 = erlang:unique_integer([monotonic]), + UM2 = unique_integer_nif([monotonic]), + UM3 = erlang:unique_integer([monotonic]), + + true = UM1 < UM2, + true = UM2 < UM3, + + UMP1 = erlang:unique_integer([monotonic, positive]), + UMP2 = unique_integer_nif([monotonic, positive]), + UMP3 = erlang:unique_integer([monotonic, positive]), + + true = 0 =< UMP1, + true = UMP1 < UMP2, + true = UMP2 < UMP3, + + UP1 = erlang:unique_integer([positive]), + UP2 = unique_integer_nif([positive]), + UP3 = erlang:unique_integer([positive]), + + true = 0 =< UP1, + true = 0 =< UP2, + true = 0 =< UP3, + + true = is_integer(unique_integer_nif([])), + true = is_integer(unique_integer_nif([])), + true = is_integer(unique_integer_nif([])). + +nif_is_process_alive(Config) -> + ensure_lib_loaded(Config), + + {Pid,_} = spawn_monitor(fun() -> receive ok -> nok end end), + true = is_process_alive_nif(Pid), + exit(Pid, die), + receive _ -> ok end, %% Clear monitor + false = is_process_alive_nif(Pid). + +nif_is_port_alive(Config) -> + ensure_lib_loaded(Config), + + Port = open_port({spawn,echo_drv},[eof]), + true = is_port_alive_nif(Port), + port_close(Port), + false = is_port_alive_nif(Port). + +nif_term_to_binary(Config) -> + ensure_lib_loaded(Config), + T = {#{ok => nok}, <<0:8096>>, lists:seq(1,100)}, + Bin = term_to_binary(T), + ct:log("~p",[Bin]), + Bin = term_to_binary_nif(T, undefined), + true = term_to_binary_nif(T, self()), + receive Bin -> ok end. + +-define(ERL_NIF_BIN2TERM_SAFE, 16#20000000). + +nif_binary_to_term(Config) -> + ensure_lib_loaded(Config), + T = {#{ok => nok}, <<0:8096>>, lists:seq(1,100)}, + Bin = term_to_binary(T), + Len = byte_size(Bin), + {Len,T} = binary_to_term_nif(Bin, undefined, 0), + Len = binary_to_term_nif(Bin, self(), 0), + T = receive M -> M after 1000 -> timeout end, + + {Len, T} = binary_to_term_nif(Bin, undefined, ?ERL_NIF_BIN2TERM_SAFE), + false = binary_to_term_nif(<<131,100,0,14,"undefined_atom">>, + undefined, ?ERL_NIF_BIN2TERM_SAFE), + false = binary_to_term_nif(Bin, undefined, 1), + ok. + +nif_port_command(Config) -> + ensure_lib_loaded(Config), + + Port = open_port({spawn,echo_drv},[eof]), + true = port_command_nif(Port, "hello\n"), + receive {Port,{data,"hello\n"}} -> ok + after 1000 -> ct:fail(timeout) end, + + RefcBin = lists:flatten([lists:duplicate(100, "hello"),"\n"]), + true = port_command_nif(Port, iolist_to_binary(RefcBin)), + receive {Port,{data,RefcBin}} -> ok + after 1000 -> ct:fail(timeout) end, + + %% Test that invalid arguments correctly returns + %% badarg and that the port survives. + {'EXIT', {badarg, _}} = (catch port_command_nif(Port, [ok])), + + IoList = [lists:duplicate(100,<<"hello">>),"\n"], + true = port_command_nif(Port, [IoList]), + FlatIoList = binary_to_list(iolist_to_binary(IoList)), + receive {Port,{data,FlatIoList}} -> ok + after 1000 -> ct:fail(timeout) end, + + port_close(Port), + + {'EXIT', {badarg, _}} = (catch port_command_nif(Port, "hello\n")), + + ok. + %% The NIFs: lib_version() -> undefined. call_history() -> ?nif_stub. @@ -1955,7 +2054,7 @@ last_resource_dtor_call() -> ?nif_stub. make_new_resource(_,_) -> ?nif_stub. check_is(_,_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. check_is_exception() -> ?nif_stub. -length_test(_,_,_,_,_) -> ?nif_stub. +length_test(_,_,_,_,_,_) -> ?nif_stub. make_atoms() -> ?nif_stub. make_strings() -> ?nif_stub. make_new_resource_binary(_) -> ?nif_stub. @@ -1971,6 +2070,7 @@ send_blob_thread(_,_,_) -> ?nif_stub. join_send_thread(_) -> ?nif_stub. copy_blob(_) -> ?nif_stub. send_term(_,_) -> ?nif_stub. +send_copy_term(_,_) -> ?nif_stub. reverse_list(_) -> ?nif_stub. echo_int(_) -> ?nif_stub. type_sizes() -> ?nif_stub. @@ -1985,6 +2085,12 @@ 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. +unique_integer_nif(_) -> ?nif_stub. +is_process_alive_nif(_) -> ?nif_stub. +is_port_alive_nif(_) -> ?nif_stub. +term_to_binary_nif(_, _) -> ?nif_stub. +binary_to_term_nif(_, _, _) -> ?nif_stub. +port_command_nif(_, _) -> ?nif_stub. %% maps is_map_nif(_) -> ?nif_stub. @@ -2001,7 +2107,8 @@ sorted_list_from_maps_nif(_) -> ?nif_stub. monotonic_time(_) -> ?nif_stub. time_offset(_) -> ?nif_stub. convert_time_unit(_,_,_) -> ?nif_stub. - +now_time() -> ?nif_stub. +cpu_time() -> ?nif_stub. nif_stub_error(Line) -> exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/nif_SUITE_data/Makefile.src b/erts/emulator/test/nif_SUITE_data/Makefile.src index ab4ff77add..fbb8978771 100644 --- a/erts/emulator/test/nif_SUITE_data/Makefile.src +++ b/erts/emulator/test/nif_SUITE_data/Makefile.src @@ -4,8 +4,7 @@ NIF_LIBS = nif_SUITE.1@dll@ \ nif_mod.2@dll@ \ nif_mod.3@dll@ -all: $(NIF_LIBS) basic@dll@ rwlock@dll@ tsd@dll@ - +all: $(NIF_LIBS) basic@dll@ rwlock@dll@ tsd@dll@ echo_drv@dll@ @SHLIB_RULES@ diff --git a/erts/emulator/test/nif_SUITE_data/echo_drv.c b/erts/emulator/test/nif_SUITE_data/echo_drv.c new file mode 100644 index 0000000000..2b3510c641 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/echo_drv.c @@ -0,0 +1,62 @@ +#include <stdio.h> +#include "erl_driver.h" + +static ErlDrvPort erlang_port; +static ErlDrvData echo_start(ErlDrvPort, char *); +static void from_erlang(ErlDrvData, char*, ErlDrvSizeT); +static ErlDrvSSizeT echo_call(ErlDrvData drv_data, unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, unsigned *ret_flags); +static ErlDrvEntry echo_driver_entry = { + NULL, /* Init */ + echo_start, + NULL, /* Stop */ + from_erlang, + NULL, /* Ready input */ + NULL, /* Ready output */ + "echo_drv", + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + echo_call, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, + NULL, + NULL, + NULL +}; + +DRIVER_INIT(echo_drv) +{ + return &echo_driver_entry; +} + +static ErlDrvData +echo_start(ErlDrvPort port, char *buf) +{ + return (ErlDrvData) port; +} + +static void +from_erlang(ErlDrvData data, char *buf, ErlDrvSizeT count) +{ + driver_output((ErlDrvPort) data, buf, count); +} + +static ErlDrvSSizeT +echo_call(ErlDrvData drv_data, unsigned int command, + char *buf, ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen, + unsigned *ret_flags) +{ + *rbuf = buf; + *ret_flags |= DRIVER_CALL_KEEP_BUFFER; + return len; +} + diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 8ebce4fef4..11e5dab58e 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2014. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -30,6 +30,7 @@ static int static_cntA; /* zero by default */ static int static_cntB = NIF_SUITE_LIB_VER * 100; static ERL_NIF_TERM atom_false; +static ERL_NIF_TERM atom_true; static ERL_NIF_TERM atom_self; static ERL_NIF_TERM atom_ok; static ERL_NIF_TERM atom_join; @@ -138,6 +139,7 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) msgenv_dtor, ERL_NIF_RT_CREATE, NULL); atom_false = enif_make_atom(env,"false"); + atom_true = enif_make_atom(env,"true"); atom_self = enif_make_atom(env,"self"); atom_ok = enif_make_atom(env,"ok"); atom_join = enif_make_atom(env,"join"); @@ -914,6 +916,7 @@ static ERL_NIF_TERM check_is_exception(ErlNifEnv* env, int argc, const ERL_NIF_T * argv[2] empty list * argv[3] not an atom * argv[4] not a list + * argv[5] improper list */ static ERL_NIF_TERM length_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { @@ -934,6 +937,9 @@ static ERL_NIF_TERM length_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg if (enif_get_list_length(env, argv[4], &len)) return enif_make_badarg(env); + if (enif_get_list_length(env, argv[5], &len)) + return enif_make_badarg(env); + return enif_make_atom(env, "ok"); } @@ -1460,6 +1466,18 @@ static ERL_NIF_TERM send_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ return enif_make_int(env, ret); } +static ERL_NIF_TERM send_copy_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifEnv* menv; + ErlNifPid pid; + int ret; + if (!enif_get_local_pid(env, argv[0], &pid)) { + return enif_make_badarg(env); + } + ret = enif_send(env, &pid, NULL, argv[1]); + return enif_make_int(env, ret); +} + static ERL_NIF_TERM reverse_list(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ERL_NIF_TERM rev_list; @@ -1974,6 +1992,123 @@ static ERL_NIF_TERM convert_time_unit(ErlNifEnv* env, int argc, const ERL_NIF_TE return enif_make_int64(env, enif_convert_time_unit(val, from, to)); } +static ERL_NIF_TERM now_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return enif_now_time(env); +} + +static ERL_NIF_TERM cpu_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return enif_cpu_time(env); +} + +static ERL_NIF_TERM unique_integer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM atom_pos = enif_make_atom(env,"positive"), + atom_mon = enif_make_atom(env,"monotonic"); + ERL_NIF_TERM opts = argv[0], opt; + ErlNifUniqueInteger properties = 0; + + while (!enif_is_empty_list(env, opts)) { + if (!enif_get_list_cell(env, opts, &opt, &opts)) + return enif_make_badarg(env); + + if (enif_compare(opt, atom_pos) == 0) + properties |= ERL_NIF_UNIQUE_POSITIVE; + if (enif_compare(opt, atom_mon) == 0) + properties |= ERL_NIF_UNIQUE_MONOTONIC; + } + + return enif_make_unique_integer(env, properties); +} + +static ERL_NIF_TERM is_process_alive(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPid pid; + if (!enif_get_local_pid(env, argv[0], &pid)) + return enif_make_badarg(env); + if (enif_is_process_alive(env, &pid)) + return atom_true; + return atom_false; +} + +static ERL_NIF_TERM is_port_alive(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPort port; + if (!enif_get_local_port(env, argv[0], &port)) + return enif_make_badarg(env); + if (enif_is_port_alive(env, &port)) + return atom_true; + return atom_false; +} + +static ERL_NIF_TERM term_to_binary(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifBinary bin; + ErlNifPid pid; + ErlNifEnv *msg_env = env; + ERL_NIF_TERM term; + + if (enif_get_local_pid(env, argv[1], &pid)) + msg_env = enif_alloc_env(); + + if (!enif_term_to_binary(msg_env, argv[0], &bin)) + return enif_make_badarg(env); + + term = enif_make_binary(msg_env, &bin); + + if (msg_env != env) { + enif_send(env, &pid, msg_env, term); + enif_free_env(msg_env); + return atom_true; + } else { + return term; + } +} + +static ERL_NIF_TERM binary_to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifBinary bin; + ERL_NIF_TERM term, ret_term; + ErlNifPid pid; + ErlNifEnv *msg_env = env; + unsigned int opts; + ErlNifUInt64 ret; + + if (enif_get_local_pid(env, argv[1], &pid)) + msg_env = enif_alloc_env(); + + if (!enif_inspect_binary(env, argv[0], &bin) + || !enif_get_uint(env, argv[2], &opts)) + return enif_make_badarg(env); + + ret = enif_binary_to_term(msg_env, bin.data, bin.size, &term, + (ErlNifBinaryToTerm)opts); + if (!ret) + return atom_false; + + ret_term = enif_make_uint64(env, ret); + if (msg_env != env) { + enif_send(env, &pid, msg_env, term); + enif_free_env(msg_env); + return ret_term; + } else { + return enif_make_tuple2(env, ret_term, term); + } +} + +static ERL_NIF_TERM port_command(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPort port; + + if (!enif_get_local_port(env, argv[0], &port)) + return enif_make_badarg(env); + + if (!enif_port_command(env, &port, NULL, argv[1])) + return enif_make_badarg(env); + return atom_true; +} + static ErlNifFunc nif_funcs[] = { {"lib_version", 0, lib_version}, @@ -2002,7 +2137,7 @@ static ErlNifFunc nif_funcs[] = {"make_new_resource", 2, make_new_resource}, {"check_is", 11, check_is}, {"check_is_exception", 0, check_is_exception}, - {"length_test", 5, length_test}, + {"length_test", 6, length_test}, {"make_atoms", 0, make_atoms}, {"make_strings", 0, make_strings}, {"make_new_resource", 2, make_new_resource}, @@ -2019,6 +2154,7 @@ static ErlNifFunc nif_funcs[] = {"join_send_thread", 1, join_send_thread}, {"copy_blob", 1, copy_blob}, {"send_term", 2, send_term}, + {"send_copy_term", 2, send_copy_term}, {"reverse_list",1, reverse_list}, {"echo_int", 1, echo_int}, {"type_sizes", 0, type_sizes}, @@ -2046,8 +2182,15 @@ static ErlNifFunc nif_funcs[] = {"sorted_list_from_maps_nif", 1, sorted_list_from_maps_nif}, {"monotonic_time", 1, monotonic_time}, {"time_offset", 1, time_offset}, - {"convert_time_unit", 3, convert_time_unit} + {"convert_time_unit", 3, convert_time_unit}, + {"now_time", 0, now_time}, + {"cpu_time", 0, cpu_time}, + {"unique_integer_nif", 1, unique_integer}, + {"is_process_alive_nif", 1, is_process_alive}, + {"is_port_alive_nif", 1, is_port_alive}, + {"term_to_binary_nif", 2, term_to_binary}, + {"binary_to_term_nif", 3, binary_to_term}, + {"port_command_nif", 2, port_command} }; ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload) - diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.c b/erts/emulator/test/nif_SUITE_data/nif_mod.c index f7e729e2b6..fd8a0d0595 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_mod.c +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2014. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.erl b/erts/emulator/test/nif_SUITE_data/nif_mod.erl index e65d4577c7..eec1bb8858 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_mod.erl +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,7 +20,7 @@ -module(nif_mod). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([load_nif_lib/2, load_nif_lib/3, start/0, lib_version/0, call_history/0, get_priv_data_ptr/0, make_new_resource/2, get_resource/2]). @@ -33,7 +33,7 @@ load_nif_lib(Config, Ver) -> load_nif_lib(Config, Ver, []). load_nif_lib(Config, Ver, LoadInfo) -> - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), erlang:load_nif(filename:join(Path,libname(Ver)), LoadInfo). libname(no_init) -> libname(3); diff --git a/erts/emulator/test/nif_SUITE_data/tester.erl b/erts/emulator/test/nif_SUITE_data/tester.erl index b393e29b82..f955f99c9a 100644 --- a/erts/emulator/test/nif_SUITE_data/tester.erl +++ b/erts/emulator/test/nif_SUITE_data/tester.erl @@ -1,12 +1,11 @@ -module(tester). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([load_nif_lib/2, run/0]). - load_nif_lib(Config, LibName) -> - ?line Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), erlang:load_nif(filename:join(Path,LibName), []). run() -> diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index fecaad5232..536c91d4ae 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2012. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,37 +28,34 @@ -module(node_container_SUITE). -author('[email protected]'). -%-define(line_trace, 1). +-include_lib("common_test/include/ct.hrl"). --include_lib("test_server/include/test_server.hrl"). - -%-compile(export_all). --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, - node_container_refc_check/1]). +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2, + node_container_refc_check/1]). -export([term_to_binary_to_term_eq/1, - round_trip_eq/1, - cmp/1, - ref_eq/1, - node_table_gc/1, - dist_link_refc/1, - dist_monitor_refc/1, - node_controller_refc/1, - ets_refc/1, - match_spec_refc/1, - timer_refc/1, - otp_4715/1, - pid_wrap/1, - port_wrap/1, - bad_nc/1, - unique_pid/1, - iter_max_procs/1]). - --define(DEFAULT_TIMEOUT, ?t:minutes(10)). - -suite() -> [{ct_hooks,[ts_install_cth]}]. + round_trip_eq/1, + cmp/1, + ref_eq/1, + node_table_gc/1, + dist_link_refc/1, + dist_monitor_refc/1, + node_controller_refc/1, + ets_refc/1, + match_spec_refc/1, + timer_refc/1, + otp_4715/1, + pid_wrap/1, + port_wrap/1, + bad_nc/1, + unique_pid/1, + iter_max_procs/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 12}}]. + all() -> [term_to_binary_to_term_eq, round_trip_eq, cmp, ref_eq, @@ -67,9 +64,6 @@ all() -> timer_refc, otp_4715, pid_wrap, port_wrap, bad_nc, unique_pid, iter_max_procs]. -groups() -> - []. - init_per_suite(Config) -> Config. @@ -78,36 +72,26 @@ end_per_suite(_Config) -> erts_debug:set_internal_state(node_tab_delayed_delete, -1), %% restore original value available_internal_state(false). -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - available_internal_state(Bool) when Bool == true; Bool == false -> case {Bool, - (catch erts_debug:get_internal_state(available_internal_state))} of - {true, true} -> - true; - {false, true} -> - erts_debug:set_internal_state(available_internal_state, false), - true; - {true, _} -> - erts_debug:set_internal_state(available_internal_state, true), - false; - {false, _} -> - false + (catch erts_debug:get_internal_state(available_internal_state))} of + {true, true} -> + true; + {false, true} -> + erts_debug:set_internal_state(available_internal_state, false), + true; + {true, _} -> + erts_debug:set_internal_state(available_internal_state, true), + false; + {false, _} -> + false end. init_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), available_internal_state(true), - [{watchdog, Dog}|Config]. + Config. end_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), ok. %%% @@ -119,111 +103,108 @@ end_per_testcase(_Case, Config) when is_list(Config) -> %% %% Test case: term_to_binary_to_term_eq %% -term_to_binary_to_term_eq(doc) -> - ["Tests that node container terms that are converted to external format " - "and back stay equal to themselves."]; -term_to_binary_to_term_eq(suite) -> []; +%% Tests that node container terms that are converted to external format +%% and back stay equal to themselves. term_to_binary_to_term_eq(Config) when is_list(Config) -> - ?line ThisNode = {node(), erlang:system_info(creation)}, + ThisNode = {node(), erlang:system_info(creation)}, % Get local node containers - ?line LPid = self(), - ?line LXPid = mk_pid(ThisNode, 32767, 8191), - ?line LPort = hd(erlang:ports()), - ?line LXPort = mk_port(ThisNode, 268435455), - ?line LLRef = make_ref(), - ?line LHLRef = mk_ref(ThisNode, [47, 11]), - ?line LSRef = mk_ref(ThisNode, [4711]), + LPid = self(), + LXPid = mk_pid(ThisNode, 32767, 8191), + LPort = hd(erlang:ports()), + LXPort = mk_port(ThisNode, 268435455), + LLRef = make_ref(), + LHLRef = mk_ref(ThisNode, [47, 11]), + LSRef = mk_ref(ThisNode, [4711]), % Test local nc:s - ?line LPid = binary_to_term(term_to_binary(LPid)), - ?line LXPid = binary_to_term(term_to_binary(LXPid)), - ?line LPort = binary_to_term(term_to_binary(LPort)), - ?line LXPort = binary_to_term(term_to_binary(LXPort)), - ?line LLRef = binary_to_term(term_to_binary(LLRef)), - ?line LHLRef = binary_to_term(term_to_binary(LHLRef)), - ?line LSRef = binary_to_term(term_to_binary(LSRef)), + LPid = binary_to_term(term_to_binary(LPid)), + LXPid = binary_to_term(term_to_binary(LXPid)), + LPort = binary_to_term(term_to_binary(LPort)), + LXPort = binary_to_term(term_to_binary(LXPort)), + LLRef = binary_to_term(term_to_binary(LLRef)), + LHLRef = binary_to_term(term_to_binary(LHLRef)), + LSRef = binary_to_term(term_to_binary(LSRef)), % Get remote node containers - ?line RNode = {get_nodename(), 3}, - ?line RPid = mk_pid(RNode, 4711, 1), - ?line RXPid = mk_pid(RNode, 32767, 8191), - ?line RPort = mk_port(RNode, 4711), - ?line RXPort = mk_port(RNode, 268435455), - ?line RLRef = mk_ref(RNode, [4711, 4711, 4711]), - ?line RHLRef = mk_ref(RNode, [4711, 4711]), - ?line RSRef = mk_ref(RNode, [4711]), + ttbtteq_do_remote({get_nodename(), 3}), + ttbtteq_do_remote({get_nodename(), 4}), + ttbtteq_do_remote({get_nodename(), 16#adec0ded}), + nc_refc_check(node()), + ok. + +ttbtteq_do_remote(RNode) -> + RPid = mk_pid(RNode, 4711, 1), + RXPid = mk_pid(RNode, 32767, 8191), + RPort = mk_port(RNode, 4711), + RXPort = mk_port(RNode, 268435455), + RLRef = mk_ref(RNode, [4711, 4711, 4711]), + RHLRef = mk_ref(RNode, [4711, 4711]), + RSRef = mk_ref(RNode, [4711]), % Test remote nc:s - ?line RPid = binary_to_term(term_to_binary(RPid)), - ?line RXPid = binary_to_term(term_to_binary(RXPid)), - ?line RPort = binary_to_term(term_to_binary(RPort)), - ?line RXPort = binary_to_term(term_to_binary(RXPort)), - ?line RLRef = binary_to_term(term_to_binary(RLRef)), - ?line RHLRef = binary_to_term(term_to_binary(RHLRef)), - ?line RSRef = binary_to_term(term_to_binary(RSRef)), - ?line nc_refc_check(node()), - ?line ok. + RPid = binary_to_term(term_to_binary(RPid)), + RXPid = binary_to_term(term_to_binary(RXPid)), + RPort = binary_to_term(term_to_binary(RPort)), + RXPort = binary_to_term(term_to_binary(RXPort)), + RLRef = binary_to_term(term_to_binary(RLRef)), + RHLRef = binary_to_term(term_to_binary(RHLRef)), + RSRef = binary_to_term(term_to_binary(RSRef)), + ok. %% %% Test case: round_trip_eq %% -round_trip_eq(doc) -> - ["Tests that node containers that are sent beteen nodes stay equal to " - "themselves."]; -round_trip_eq(suite) -> []; +%% Tests that node containers that are sent beteen nodes stay equal to themselves. round_trip_eq(Config) when is_list(Config) -> - ?line ThisNode = {node(), erlang:system_info(creation)}, - ?line NodeFirstName = get_nodefirstname(), - ?line ?line {ok, Node} = start_node(NodeFirstName), - ?line Self = self(), - ?line RPid = spawn_link(Node, - fun () -> - receive - {Self, Data} -> - Self ! {self(), Data} - end - end), - ?line SentPid = self(), - ?line SentXPid = mk_pid(ThisNode, 17471, 8190), - ?line SentPort = hd(erlang:ports()), - ?line SentXPort = mk_port(ThisNode, 268435451), - ?line SentLRef = make_ref(), - ?line SentHLRef = mk_ref(ThisNode, [4711, 17]), - ?line SentSRef = mk_ref(ThisNode, [4711]), - ?line RPid ! {Self, {SentPid, - SentXPid, - SentPort, - SentXPort, - SentLRef, - SentHLRef, - SentSRef}}, + ThisNode = {node(), erlang:system_info(creation)}, + NodeFirstName = get_nodefirstname(), + {ok, Node} = start_node(NodeFirstName), + Self = self(), + RPid = spawn_link(Node, + fun () -> + receive + {Self, Data} -> + Self ! {self(), Data} + end + end), + SentPid = self(), + SentXPid = mk_pid(ThisNode, 17471, 8190), + SentPort = hd(erlang:ports()), + SentXPort = mk_port(ThisNode, 268435451), + SentLRef = make_ref(), + SentHLRef = mk_ref(ThisNode, [4711, 17]), + SentSRef = mk_ref(ThisNode, [4711]), + RPid ! {Self, {SentPid, + SentXPid, + SentPort, + SentXPort, + SentLRef, + SentHLRef, + SentSRef}}, receive - {RPid, {RecPid, - RecXPid, - RecPort, - RecXPort, - RecLRef, - RecHLRef, - RecSRef}} -> - ?line stop_node(Node), - ?line SentPid = RecPid, - ?line SentXPid = RecXPid, - ?line SentPort = RecPort, - ?line SentXPort = RecXPort, - ?line SentLRef = RecLRef, - ?line SentHLRef = RecHLRef, - ?line SentSRef = RecSRef, - ?line nc_refc_check(node()), - ?line ok + {RPid, {RecPid, + RecXPid, + RecPort, + RecXPort, + RecLRef, + RecHLRef, + RecSRef}} -> + stop_node(Node), + SentPid = RecPid, + SentXPid = RecXPid, + SentPort = RecPort, + SentXPort = RecXPort, + SentLRef = RecLRef, + SentHLRef = RecHLRef, + SentSRef = RecSRef, + nc_refc_check(node()), + ok end. - + %% %% Test case: cmp %% -cmp(doc) -> - ["Tests that Erlang term comparison works as it should on node " - "containers."]; -cmp(suite) -> []; +%% Tests that Erlang term comparison works as it should on node containers. cmp(Config) when is_list(Config) -> %% Inter type comparison --------------------------------------------------- @@ -234,103 +215,103 @@ cmp(Config) when is_list(Config) -> IRef = make_ref(), ERef = mk_ref({get_nodename(), 2}, [1,2,3]), - + IPid = self(), EPid = mk_pid(RNode, 1, 2), IPort = hd(erlang:ports()), EPort = mk_port(RNode, 1), - + %% Test pids ---------------------------------------------------- - ?line true = 1 < IPid, - ?line true = 1.3 < IPid, - ?line true = (1 bsl 64) < IPid, - ?line true = an_atom < IPid, - ?line true = IRef < IPid, - ?line true = ERef < IPid, - ?line true = fun () -> a_fun end < IPid, - ?line true = IPort < IPid, - ?line true = EPort < IPid, - ?line true = IPid < {a, tuple}, - ?line true = IPid < [], - ?line true = IPid < [a|cons], - ?line true = IPid < <<"a binary">>, - - ?line true = 1 < EPid, - ?line true = 1.3 < EPid, - ?line true = (1 bsl 64) < EPid, - ?line true = an_atom < EPid, - ?line true = IRef < EPid, - ?line true = ERef < EPid, - ?line true = fun () -> a_fun end < EPid, - ?line true = IPort < EPid, - ?line true = EPort < EPid, - ?line true = EPid < {a, tuple}, - ?line true = EPid < [], - ?line true = EPid < [a|cons], - ?line true = EPid < <<"a binary">>, + true = 1 < IPid, + true = 1.3 < IPid, + true = (1 bsl 64) < IPid, + true = an_atom < IPid, + true = IRef < IPid, + true = ERef < IPid, + true = fun () -> a_fun end < IPid, + true = IPort < IPid, + true = EPort < IPid, + true = IPid < {a, tuple}, + true = IPid < [], + true = IPid < [a|cons], + true = IPid < <<"a binary">>, + + true = 1 < EPid, + true = 1.3 < EPid, + true = (1 bsl 64) < EPid, + true = an_atom < EPid, + true = IRef < EPid, + true = ERef < EPid, + true = fun () -> a_fun end < EPid, + true = IPort < EPid, + true = EPort < EPid, + true = EPid < {a, tuple}, + true = EPid < [], + true = EPid < [a|cons], + true = EPid < <<"a binary">>, %% Test ports -------------------------------------------------- - ?line true = 1 < IPort, - ?line true = 1.3 < IPort, - ?line true = (1 bsl 64) < IPort, - ?line true = an_atom < IPort, - ?line true = IRef < IPort, - ?line true = ERef < IPort, - ?line true = fun () -> a_fun end < IPort, - ?line true = IPort < IPid, - ?line true = IPort < EPid, - ?line true = IPort < {a, tuple}, - ?line true = IPort < [], - ?line true = IPort < [a|cons], - ?line true = IPort < <<"a binary">>, - - ?line true = 1 < EPort, - ?line true = 1.3 < EPort, - ?line true = (1 bsl 64) < EPort, - ?line true = an_atom < EPort, - ?line true = IRef < EPort, - ?line true = ERef < EPort, - ?line true = fun () -> a_fun end < EPort, - ?line true = EPort < IPid, - ?line true = EPort < EPid, - ?line true = EPort < {a, tuple}, - ?line true = EPort < [], - ?line true = EPort < [a|cons], - ?line true = EPort < <<"a binary">>, + true = 1 < IPort, + true = 1.3 < IPort, + true = (1 bsl 64) < IPort, + true = an_atom < IPort, + true = IRef < IPort, + true = ERef < IPort, + true = fun () -> a_fun end < IPort, + true = IPort < IPid, + true = IPort < EPid, + true = IPort < {a, tuple}, + true = IPort < [], + true = IPort < [a|cons], + true = IPort < <<"a binary">>, + + true = 1 < EPort, + true = 1.3 < EPort, + true = (1 bsl 64) < EPort, + true = an_atom < EPort, + true = IRef < EPort, + true = ERef < EPort, + true = fun () -> a_fun end < EPort, + true = EPort < IPid, + true = EPort < EPid, + true = EPort < {a, tuple}, + true = EPort < [], + true = EPort < [a|cons], + true = EPort < <<"a binary">>, %% Test refs ---------------------------------------------------- - ?line true = 1 < IRef, - ?line true = 1.3 < IRef, - ?line true = (1 bsl 64) < IRef, - ?line true = an_atom < IRef, - ?line true = IRef < fun () -> a_fun end, - ?line true = IRef < IPort, - ?line true = IRef < EPort, - ?line true = IRef < IPid, - ?line true = IRef < EPid, - ?line true = IRef < {a, tuple}, - ?line true = IRef < [], - ?line true = IRef < [a|cons], - ?line true = IRef < <<"a binary">>, - - ?line true = 1 < ERef, - ?line true = 1.3 < ERef, - ?line true = (1 bsl 64) < ERef, - ?line true = an_atom < ERef, - ?line true = ERef < fun () -> a_fun end, - ?line true = ERef < IPort, - ?line true = ERef < EPort, - ?line true = ERef < IPid, - ?line true = ERef < EPid, - ?line true = ERef < {a, tuple}, - ?line true = ERef < [], - ?line true = ERef < [a|cons], - ?line true = ERef < <<"a binary">>, + true = 1 < IRef, + true = 1.3 < IRef, + true = (1 bsl 64) < IRef, + true = an_atom < IRef, + true = IRef < fun () -> a_fun end, + true = IRef < IPort, + true = IRef < EPort, + true = IRef < IPid, + true = IRef < EPid, + true = IRef < {a, tuple}, + true = IRef < [], + true = IRef < [a|cons], + true = IRef < <<"a binary">>, + + true = 1 < ERef, + true = 1.3 < ERef, + true = (1 bsl 64) < ERef, + true = an_atom < ERef, + true = ERef < fun () -> a_fun end, + true = ERef < IPort, + true = ERef < EPort, + true = ERef < IPid, + true = ERef < EPid, + true = ERef < {a, tuple}, + true = ERef < [], + true = ERef < [a|cons], + true = ERef < <<"a binary">>, %% Intra type comparison --------------------------------------------------- - + %% Test pids ---------------------------------------------------- %% @@ -338,13 +319,13 @@ cmp(Config) when is_list(Config) -> %% serial, number, nodename, creation %% - ?line Pid = mk_pid({b@b, 2}, 4711, 1), + Pid = mk_pid({b@b, 2}, 4711, 1), - ?line true = mk_pid({a@b, 1}, 4710, 2) > Pid, - ?line true = mk_pid({a@b, 1}, 4712, 1) > Pid, - ?line true = mk_pid({c@b, 1}, 4711, 1) > Pid, - ?line true = mk_pid({b@b, 3}, 4711, 1) > Pid, - ?line true = mk_pid({b@b, 2}, 4711, 1) =:= Pid, + true = mk_pid({a@b, 1}, 4710, 2) > Pid, + true = mk_pid({a@b, 1}, 4712, 1) > Pid, + true = mk_pid({c@b, 1}, 4711, 1) > Pid, + true = mk_pid({b@b, 3}, 4711, 1) > Pid, + true = mk_pid({b@b, 2}, 4711, 1) =:= Pid, %% Test ports --------------------------------------------------- %% @@ -356,12 +337,12 @@ cmp(Config) when is_list(Config) -> %% Significance used to be: dist_slot, number, %% creation. - ?line Port = mk_port({b@b, 2}, 4711), + Port = mk_port({b@b, 2}, 4711), - ?line true = mk_port({c@b, 1}, 4710) > Port, - ?line true = mk_port({b@b, 3}, 4710) > Port, - ?line true = mk_port({b@b, 2}, 4712) > Port, - ?line true = mk_port({b@b, 2}, 4711) =:= Port, + true = mk_port({c@b, 1}, 4710) > Port, + true = mk_port({b@b, 3}, 4710) > Port, + true = mk_port({b@b, 2}, 4712) > Port, + true = mk_port({b@b, 2}, 4711) =:= Port, %% Test refs ---------------------------------------------------- %% Significance (most -> least): @@ -373,99 +354,96 @@ cmp(Config) when is_list(Config) -> %% creation. %% - ?line Ref = mk_ref({b@b, 2}, [4711, 4711, 4711]), + Ref = mk_ref({b@b, 2}, [4711, 4711, 4711]), - ?line true = mk_ref({c@b, 1}, [4710, 4710, 4710]) > Ref, - ?line true = mk_ref({b@b, 3}, [4710, 4710, 4710]) > Ref, - ?line true = mk_ref({b@b, 2}, [4710, 4710, 4712]) > Ref, - ?line true = mk_ref({b@b, 2}, [4710, 4712, 4711]) > Ref, - ?line true = mk_ref({b@b, 2}, [4712, 4711, 4711]) > Ref, - ?line true = mk_ref({b@b, 2}, [4711, 4711, 4711]) =:= Ref, + true = mk_ref({c@b, 1}, [4710, 4710, 4710]) > Ref, + true = mk_ref({b@b, 3}, [4710, 4710, 4710]) > Ref, + true = mk_ref({b@b, 2}, [4710, 4710, 4712]) > Ref, + true = mk_ref({b@b, 2}, [4710, 4712, 4711]) > Ref, + true = mk_ref({b@b, 2}, [4712, 4711, 4711]) > Ref, + true = mk_ref({b@b, 2}, [4711, 4711, 4711]) =:= Ref, ok. %% %% Test case: ref_eq %% -ref_eq(doc) -> ["Test that one word refs \"works\"."]; -ref_eq(suite) -> []; +%% Test that one word refs works ref_eq(Config) when is_list(Config) -> - ?line ThisNode = {node(), erlang:system_info(creation)}, - ?line AnotherNode = {get_nodename(),2}, - ?line LLongRef = mk_ref(ThisNode, [4711, 0, 0]), - ?line LHalfLongRef = mk_ref(ThisNode, [4711, 0]), - ?line LShortRef = mk_ref(ThisNode, [4711]), - ?line true = LLongRef =:= LShortRef, - ?line true = LLongRef =:= LHalfLongRef, - ?line true = LLongRef =:= LLongRef, - ?line true = LHalfLongRef =:= LShortRef, - ?line true = LHalfLongRef =:= LHalfLongRef, - ?line true = LShortRef =:= LShortRef, - ?line false = LShortRef == mk_ref(ThisNode, [4711, 0, 1]), % Not any more - ?line RLongRef = mk_ref(AnotherNode, [4711, 0, 0]), - ?line RHalfLongRef = mk_ref(AnotherNode, [4711, 0]), - ?line RShortRef = mk_ref(AnotherNode, [4711]), - ?line true = RLongRef =:= RShortRef, - ?line true = RLongRef =:= RHalfLongRef, - ?line true = RLongRef =:= RLongRef, - ?line true = RHalfLongRef =:= RShortRef, - ?line true = RHalfLongRef =:= RHalfLongRef, - ?line true = RShortRef =:= RShortRef, - ?line false = RShortRef == mk_ref(AnotherNode, [4711, 0, 1]), % Not any more - ?line nc_refc_check(node()), - ?line ok. - + ThisNode = {node(), erlang:system_info(creation)}, + AnotherNode = {get_nodename(),2}, + LLongRef = mk_ref(ThisNode, [4711, 0, 0]), + LHalfLongRef = mk_ref(ThisNode, [4711, 0]), + LShortRef = mk_ref(ThisNode, [4711]), + true = LLongRef =:= LShortRef, + true = LLongRef =:= LHalfLongRef, + true = LLongRef =:= LLongRef, + true = LHalfLongRef =:= LShortRef, + true = LHalfLongRef =:= LHalfLongRef, + true = LShortRef =:= LShortRef, + false = LShortRef == mk_ref(ThisNode, [4711, 0, 1]), % Not any more + RLongRef = mk_ref(AnotherNode, [4711, 0, 0]), + RHalfLongRef = mk_ref(AnotherNode, [4711, 0]), + RShortRef = mk_ref(AnotherNode, [4711]), + true = RLongRef =:= RShortRef, + true = RLongRef =:= RHalfLongRef, + true = RLongRef =:= RLongRef, + true = RHalfLongRef =:= RShortRef, + true = RHalfLongRef =:= RHalfLongRef, + true = RShortRef =:= RShortRef, + false = RShortRef == mk_ref(AnotherNode, [4711, 0, 1]), % Not any more + nc_refc_check(node()), + ok. + %% %% Test case: node_table_gc %% -node_table_gc(doc) -> - ["Tests that node tables are garbage collected."]; -node_table_gc(suite) -> []; +%% Tests that node tables are garbage collected. node_table_gc(Config) when is_list(Config) -> erts_debug:set_internal_state(available_internal_state, true), erts_debug:set_internal_state(node_tab_delayed_delete, 0), - ?line PreKnown = nodes(known), - ?line ?t:format("PreKnown = ~p~n", [PreKnown]), - ?line make_node_garbage(0, 200000, 1000, []), - ?line PostKnown = nodes(known), - ?line PostAreas = erlang:system_info(allocated_areas), - ?line ?t:format("PostKnown = ~p~n", [PostKnown]), - ?line ?t:format("PostAreas = ~p~n", [PostAreas]), - ?line true = length(PostKnown) =< length(PreKnown), - ?line nc_refc_check(node()), + PreKnown = nodes(known), + io:format("PreKnown = ~p~n", [PreKnown]), + make_node_garbage(0, 200000, 1000, []), + PostKnown = nodes(known), + PostAreas = erlang:system_info(allocated_areas), + io:format("PostKnown = ~p~n", [PostKnown]), + io:format("PostAreas = ~p~n", [PostAreas]), + true = length(PostKnown) =< length(PreKnown), + nc_refc_check(node()), erts_debug:set_internal_state(node_tab_delayed_delete, -1), %% restore original value - ?line ok. + ok. make_node_garbage(N, L, I, Ps) when N < L -> - ?line Self = self(), - ?line P = spawn_link(fun () -> - % Generate two node entries and one dist - % entry per node name - ?line PL1 = make_faked_pid_list(N, - I div 2, - 1), - ?line put(a, PL1), - ?line PL2 = make_faked_pid_list(N, - I div 2, - 2), - ?line put(b, PL2), - ?line Self ! {self(), length(nodes(known))} - end), - ?line receive - {P, KnownLength} -> - ?line true = KnownLength >= I div 2 - end, - ?line make_node_garbage(N+(I div 2)*2, L, I, [P|Ps]); + Self = self(), + P = spawn_link(fun () -> + % Generate two node entries and one dist + % entry per node name + PL1 = make_faked_pid_list(N, + I div 2, + 1), + put(a, PL1), + PL2 = make_faked_pid_list(N, + I div 2, + 2), + put(b, PL2), + Self ! {self(), length(nodes(known))} + end), + receive + {P, KnownLength} -> + true = KnownLength >= I div 2 + end, + make_node_garbage(N+(I div 2)*2, L, I, [P|Ps]); make_node_garbage(_, _, _, Ps) -> %% Cleanup garbage... ProcIsCleanedUp - = fun (Proc) -> - undefined == erts_debug:get_internal_state({process_status, - Proc}) - end, + = fun (Proc) -> + undefined == erts_debug:get_internal_state({process_status, + Proc}) + end, lists:foreach(fun (P) -> wait_until(fun () -> ProcIsCleanedUp(P) end) end, - Ps), - ?line ok. + Ps), + ok. make_faked_pid_list(Start, No, Creation) -> @@ -475,292 +453,274 @@ make_faked_pid_list(_Start, 0, _Creation, Acc) -> Acc; make_faked_pid_list(Start, No, Creation, Acc) -> make_faked_pid_list(Start+1, - No-1, - Creation, - [mk_pid({"faked_node-" - ++ integer_to_list(Start rem 50000) - ++ "@" - ++ atom_to_list(?MODULE), - Creation}, - 4711, - 3) | Acc]). + No-1, + Creation, + [mk_pid({"faked_node-" + ++ integer_to_list(Start rem 50000) + ++ "@" + ++ atom_to_list(?MODULE), + Creation}, + 4711, + 3) | Acc]). %% %% Test case: dist_link_refc %% -dist_link_refc(doc) -> - ["Tests that external reference counts are incremented and decremented " - "as they should for distributed links"]; -dist_link_refc(suite) -> []; +%% Tests that external reference counts are incremented and decremented +%% as they should for distributed links dist_link_refc(Config) when is_list(Config) -> - ?line NodeFirstName = get_nodefirstname(), - ?line ?line {ok, Node} = start_node(NodeFirstName), - ?line RP = spawn_execer(Node), - ?line LP = spawn_link_execer(node()), - ?line true = sync_exec(RP, fun () -> link(LP) end), - ?line wait_until(fun () -> - ?line {links, Links} = process_info(LP, links), - ?line lists:member(RP, Links) - end), - ?line NodeCre = sync_exec(RP, fun() -> erlang:system_info(creation) end), - ?line 1 = reference_type_count( - link, - refering_entity_id({process, LP}, - get_node_references({Node, NodeCre}))), - ?line exec(RP, fun() -> exit(normal) end), - ?line wait_until(fun () -> - ?line {links, Links} = process_info(LP, links), - ?line not lists:member(RP, Links) - end), - ?line 0 = reference_type_count( - link, - refering_entity_id({process, LP}, - get_node_references({Node, NodeCre}))), - ?line exit(LP, normal), - ?line stop_node(Node), - ?line nc_refc_check(node()), - ?line ok. + NodeFirstName = get_nodefirstname(), + {ok, Node} = start_node(NodeFirstName), + RP = spawn_execer(Node), + LP = spawn_link_execer(node()), + true = sync_exec(RP, fun () -> link(LP) end), + wait_until(fun () -> + {links, Links} = process_info(LP, links), + lists:member(RP, Links) + end), + NodeCre = sync_exec(RP, fun() -> erlang:system_info(creation) end), + 1 = reference_type_count( + link, + refering_entity_id({process, LP}, + get_node_references({Node, NodeCre}))), + exec(RP, fun() -> exit(normal) end), + wait_until(fun () -> + {links, Links} = process_info(LP, links), + not lists:member(RP, Links) + end), + 0 = reference_type_count( + link, + refering_entity_id({process, LP}, + get_node_references({Node, NodeCre}))), + exit(LP, normal), + stop_node(Node), + nc_refc_check(node()), + ok. %% %% Test case: dist_monitor_refc %% -dist_monitor_refc(doc) -> - ["Tests that external reference counts are incremented and decremented " - "as they should for distributed monitors"]; -dist_monitor_refc(suite) -> []; +%% Tests that external reference counts are incremented and decremented +%% as they should for distributed monitors dist_monitor_refc(Config) when is_list(Config) -> - ?line NodeFirstName = get_nodefirstname(), - ?line {ok, Node} = start_node(NodeFirstName), - ?line RP = spawn_execer(Node), - ?line LP = spawn_link_execer(node()), - ?line RMon = sync_exec(RP, fun () -> erlang:monitor(process, LP) end), - ?line true = is_reference(RMon), - ?line LMon = sync_exec(LP, fun () -> erlang:monitor(process, RP) end), - ?line true = is_reference(LMon), - ?line NodeCre = sync_exec(RP, fun() -> erlang:system_info(creation) end), - ?line wait_until(fun () -> - ?line {monitored_by, MonBy} - = process_info(LP, monitored_by), - ?line {monitors, Mon} - = process_info(LP, monitors), - ?line (lists:member(RP, MonBy) - and lists:member({process,RP}, Mon)) - end), - ?line 3 = reference_type_count( - monitor, - refering_entity_id({process, LP}, - get_node_references({Node, NodeCre}))), - ?line exec(RP, fun () -> exit(normal) end), - ?line wait_until(fun () -> - ?line {monitored_by, MonBy} - = process_info(LP, monitored_by), - ?line {monitors, Mon} - = process_info(LP, monitors), - ?line ((not lists:member(RP, MonBy)) - and (not lists:member({process,RP}, Mon))) - end), - ?line ok = sync_exec(LP, - fun () -> - receive - {'DOWN', LMon, process, _, _} -> - ok - end - end), - ?line 0 = reference_type_count( - link, - refering_entity_id({process, LP}, - get_node_references({Node, NodeCre}))), - ?line exit(LP, normal), - ?line stop_node(Node), - ?line nc_refc_check(node()), - ?line ok. + NodeFirstName = get_nodefirstname(), + {ok, Node} = start_node(NodeFirstName), + RP = spawn_execer(Node), + LP = spawn_link_execer(node()), + RMon = sync_exec(RP, fun () -> erlang:monitor(process, LP) end), + true = is_reference(RMon), + LMon = sync_exec(LP, fun () -> erlang:monitor(process, RP) end), + true = is_reference(LMon), + NodeCre = sync_exec(RP, fun() -> erlang:system_info(creation) end), + wait_until(fun () -> + {monitored_by, MonBy} + = process_info(LP, monitored_by), + {monitors, Mon} + = process_info(LP, monitors), + (lists:member(RP, MonBy) + and lists:member({process,RP}, Mon)) + end), + 3 = reference_type_count( + monitor, + refering_entity_id({process, LP}, + get_node_references({Node, NodeCre}))), + exec(RP, fun () -> exit(normal) end), + wait_until(fun () -> + {monitored_by, MonBy} + = process_info(LP, monitored_by), + {monitors, Mon} + = process_info(LP, monitors), + ((not lists:member(RP, MonBy)) + and (not lists:member({process,RP}, Mon))) + end), + ok = sync_exec(LP, + fun () -> + receive + {'DOWN', LMon, process, _, _} -> + ok + end + end), + 0 = reference_type_count( + link, + refering_entity_id({process, LP}, + get_node_references({Node, NodeCre}))), + exit(LP, normal), + stop_node(Node), + nc_refc_check(node()), + ok. %% %% Test case: node_controller_refc %% -node_controller_refc(doc) -> - ["Tests that external reference counts are incremented and decremented " - "as they should for entities controlling a connections."]; -node_controller_refc(suite) -> []; +%% Tests that external reference counts are incremented and decremented +%% as they should for entities controlling a connections. node_controller_refc(Config) when is_list(Config) -> erts_debug:set_internal_state(available_internal_state, true), erts_debug:set_internal_state(node_tab_delayed_delete, 0), - ?line NodeFirstName = get_nodefirstname(), - ?line ?line {ok, Node} = start_node(NodeFirstName), - ?line true = lists:member(Node, nodes()), - ?line 1 = reference_type_count(control, get_dist_references(Node)), - ?line P = spawn_link_execer(node()), - ?line Node - = sync_exec(P, - fun () -> - put(remote_net_kernel, - rpc:call(Node,erlang,whereis,[net_kernel])), - node(get(remote_net_kernel)) - end), - ?line Creation = rpc:call(Node, erlang, system_info, [creation]), - ?line monitor_node(Node,true), - ?line stop_node(Node), - ?line receive {nodedown, Node} -> ok end, - ?line DistRefs = get_dist_references(Node), - ?line true = reference_type_count(node, DistRefs) > 0, - ?line 0 = reference_type_count(control, DistRefs), + NodeFirstName = get_nodefirstname(), + {ok, Node} = start_node(NodeFirstName), + true = lists:member(Node, nodes()), + 1 = reference_type_count(control, get_dist_references(Node)), + P = spawn_link_execer(node()), + Node + = sync_exec(P, + fun () -> + put(remote_net_kernel, + rpc:call(Node,erlang,whereis,[net_kernel])), + node(get(remote_net_kernel)) + end), + Creation = rpc:call(Node, erlang, system_info, [creation]), + monitor_node(Node,true), + stop_node(Node), + receive {nodedown, Node} -> ok end, + DistRefs = get_dist_references(Node), + true = reference_type_count(node, DistRefs) > 0, + 0 = reference_type_count(control, DistRefs), % Get rid of all references to Node - ?line exec(P, fun () -> exit(normal) end), - ?line wait_until(fun () -> not is_process_alive(P) end), + exec(P, fun () -> exit(normal) end), + wait_until(fun () -> not is_process_alive(P) end), lists:foreach(fun (Proc) -> garbage_collect(Proc) end, processes()), - ?line false = get_node_references({Node,Creation}), - ?line false = get_dist_references(Node), - ?line false = lists:member(Node, nodes(known)), - ?line nc_refc_check(node()), + false = get_node_references({Node,Creation}), + false = get_dist_references(Node), + false = lists:member(Node, nodes(known)), + nc_refc_check(node()), erts_debug:set_internal_state(node_tab_delayed_delete, -1), %% restore original value - ?line ok. + ok. %% %% Test case: ets_refc %% -ets_refc(doc) -> - ["Tests that external reference counts are incremented and decremented " - "as they should for data stored in ets tables."]; -ets_refc(suite) -> []; +%% Tests that external reference counts are incremented and decremented +%% as they should for data stored in ets tables. ets_refc(Config) when is_list(Config) -> - ?line RNode = {get_nodename(), 1}, - ?line RPid = mk_pid(RNode, 4711, 2), - ?line RPort = mk_port(RNode, 4711), - ?line RRef = mk_ref(RNode, [4711, 47, 11]), - ?line Tab = ets:new(ets_refc, []), - ?line 0 = reference_type_count(ets, get_node_references(RNode)), - ?line true = ets:insert(Tab, [{a, self()}, - {b, RPid}, - {c, hd(erlang:ports())}, - {d, RPort}, - {e, make_ref()}]), - ?line 2 = reference_type_count(ets, get_node_references(RNode)), - ?line true = ets:insert(Tab, {f, RRef}), - ?line 3 = reference_type_count(ets, get_node_references(RNode)), - ?line true = ets:delete(Tab, d), - ?line 2 = reference_type_count(ets, get_node_references(RNode)), - ?line true = ets:delete_all_objects(Tab), - ?line 0 = reference_type_count(ets, get_node_references(RNode)), - ?line true = ets:insert(Tab, [{b, RPid}, {e, make_ref()}]), - ?line 1 = reference_type_count(ets, get_node_references(RNode)), - ?line true = ets:delete(Tab), - ?line 0 = reference_type_count(ets, get_node_references(RNode)), - ?line nc_refc_check(node()), - ?line ok. + RNode = {get_nodename(), 1}, + RPid = mk_pid(RNode, 4711, 2), + RPort = mk_port(RNode, 4711), + RRef = mk_ref(RNode, [4711, 47, 11]), + Tab = ets:new(ets_refc, []), + 0 = reference_type_count(ets, get_node_references(RNode)), + true = ets:insert(Tab, [{a, self()}, + {b, RPid}, + {c, hd(erlang:ports())}, + {d, RPort}, + {e, make_ref()}]), + 2 = reference_type_count(ets, get_node_references(RNode)), + true = ets:insert(Tab, {f, RRef}), + 3 = reference_type_count(ets, get_node_references(RNode)), + true = ets:delete(Tab, d), + 2 = reference_type_count(ets, get_node_references(RNode)), + true = ets:delete_all_objects(Tab), + 0 = reference_type_count(ets, get_node_references(RNode)), + true = ets:insert(Tab, [{b, RPid}, {e, make_ref()}]), + 1 = reference_type_count(ets, get_node_references(RNode)), + true = ets:delete(Tab), + 0 = reference_type_count(ets, get_node_references(RNode)), + nc_refc_check(node()), + ok. %% %% Test case: match_spec_refc %% -match_spec_refc(doc) -> - ["Tests that external reference counts are incremented and decremented " - "as they should for data stored in match specifications."]; -match_spec_refc(suite) -> []; +%% Tests that external reference counts are incremented and decremented +%% as they should for data stored in match specifications. match_spec_refc(Config) when is_list(Config) -> - ?line RNode = {get_nodename(), 1}, - ?line RPid = mk_pid(RNode, 4711, 2), - ?line RPort = mk_port(RNode, 4711), - ?line RRef = mk_ref(RNode, [4711, 47, 11]), - ?line ok = do_match_spec_test(RNode, RPid, RPort, RRef), - ?line garbage_collect(), - ?line NodeRefs = get_node_references(RNode), - ?line 0 = reference_type_count(binary, NodeRefs), - ?line 0 = reference_type_count(ets, NodeRefs), - ?line nc_refc_check(node()), - ?line ok. + RNode = {get_nodename(), 1}, + RPid = mk_pid(RNode, 4711, 2), + RPort = mk_port(RNode, 4711), + RRef = mk_ref(RNode, [4711, 47, 11]), + ok = do_match_spec_test(RNode, RPid, RPort, RRef), + garbage_collect(), + NodeRefs = get_node_references(RNode), + 0 = reference_type_count(binary, NodeRefs), + 0 = reference_type_count(ets, NodeRefs), + nc_refc_check(node()), + ok. do_match_spec_test(RNode, RPid, RPort, RRef) -> - ?line Tab = ets:new(match_spec_refc, []), - ?line true = ets:insert(Tab, [{a, RPid, RPort, RRef}, - {b, self(), RPort, RRef}, - {c, RPid, RPort, make_ref()}, - {d, RPid, RPort, RRef}]), - ?line {M1, C1} = ets:select(Tab, [{{'$1',RPid,RPort,RRef},[],['$1']}], 1), - ?line NodeRefs = get_node_references(RNode), - ?line 3 = reference_type_count(binary, NodeRefs), - ?line 10 = reference_type_count(ets, NodeRefs), - ?line {M2, C2} = ets:select(C1), - ?line '$end_of_table' = ets:select(C2), - ?line ets:delete(Tab), - ?line [a,d] = lists:sort(M1++M2), - ?line ok. - + Tab = ets:new(match_spec_refc, []), + true = ets:insert(Tab, [{a, RPid, RPort, RRef}, + {b, self(), RPort, RRef}, + {c, RPid, RPort, make_ref()}, + {d, RPid, RPort, RRef}]), + {M1, C1} = ets:select(Tab, [{{'$1',RPid,RPort,RRef},[],['$1']}], 1), + NodeRefs = get_node_references(RNode), + 3 = reference_type_count(binary, NodeRefs), + 10 = reference_type_count(ets, NodeRefs), + {M2, C2} = ets:select(C1), + '$end_of_table' = ets:select(C2), + ets:delete(Tab), + [a,d] = lists:sort(M1++M2), + ok. + %% %% Test case: ets_refc %% -timer_refc(doc) -> - ["Tests that external reference counts are incremented and decremented " - "as they should for data stored in bif timers."]; -timer_refc(suite) -> []; +%% Tests that external reference counts are incremented and decremented +%% as they should for data stored in bif timers. timer_refc(Config) when is_list(Config) -> - ?line RNode = {get_nodename(), 1}, - ?line RPid = mk_pid(RNode, 4711, 2), - ?line RPort = mk_port(RNode, 4711), - ?line RRef = mk_ref(RNode, [4711, 47, 11]), - ?line 0 = reference_type_count(timer, get_node_references(RNode)), - ?line Pid = spawn(fun () -> receive after infinity -> ok end end), - ?line erlang:start_timer(10000, Pid, {RPid, RPort, RRef}), - ?line 3 = reference_type_count(timer, get_node_references(RNode)), - ?line exit(Pid, kill), - ?line Mon = erlang:monitor(process, Pid), - ?line receive {'DOWN', Mon, process, Pid, _} -> ok end, - ?line 0 = reference_type_count(timer, get_node_references(RNode)), - ?line erlang:send_after(500, Pid, {timer, RPid, RPort, RRef}), - ?line 0 = reference_type_count(timer, get_node_references(RNode)), - ?line erlang:send_after(500, self(), {timer, RPid, RPort, RRef}), - ?line erlang:send_after(400, bananfluga, {timer, RPid, RPort, RRef}), - ?line 6 = reference_type_count(timer, get_node_references(RNode)), - ?line receive {timer, RPid, RPort, RRef} -> ok end, - ?line 0 = reference_type_count(timer, get_node_references(RNode)), - ?line nc_refc_check(node()), - ?line ok. - -otp_4715(doc) -> []; -otp_4715(suite) -> []; + RNode = {get_nodename(), 1}, + RPid = mk_pid(RNode, 4711, 2), + RPort = mk_port(RNode, 4711), + RRef = mk_ref(RNode, [4711, 47, 11]), + 0 = reference_type_count(timer, get_node_references(RNode)), + Pid = spawn(fun () -> receive after infinity -> ok end end), + erlang:start_timer(10000, Pid, {RPid, RPort, RRef}), + 3 = reference_type_count(timer, get_node_references(RNode)), + exit(Pid, kill), + Mon = erlang:monitor(process, Pid), + receive {'DOWN', Mon, process, Pid, _} -> ok end, + 0 = reference_type_count(timer, get_node_references(RNode)), + erlang:send_after(500, Pid, {timer, RPid, RPort, RRef}), + 0 = reference_type_count(timer, get_node_references(RNode)), + erlang:send_after(500, self(), {timer, RPid, RPort, RRef}), + erlang:send_after(400, bananfluga, {timer, RPid, RPort, RRef}), + 6 = reference_type_count(timer, get_node_references(RNode)), + receive {timer, RPid, RPort, RRef} -> ok end, + 0 = reference_type_count(timer, get_node_references(RNode)), + nc_refc_check(node()), + ok. + otp_4715(Config) when is_list(Config) -> - case ?t:is_release_available("r9b") of - true -> otp_4715_1(Config); - false -> {skip,"No R9B found"} + case test_server:is_release_available("r9b") of + true -> otp_4715_1(Config); + false -> {skip,"No R9B found"} end. otp_4715_1(Config) -> case erlang:system_info(compat_rel) of - 9 -> - ?line run_otp_4715(Config); - _ -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line ?t:run_on_shielded_node(fun () -> - run_otp_4715(Config) - end, - "+R9 -pa " ++ Pa) + 9 -> + run_otp_4715(Config); + _ -> + Pa = filename:dirname(code:which(?MODULE)), + test_server:run_on_shielded_node(fun () -> + run_otp_4715(Config) + end, + "+R9 -pa " ++ Pa) end. run_otp_4715(Config) when is_list(Config) -> - ?line erts_debug:set_internal_state(available_internal_state, true), - ?line PidList = [mk_pid({a@b, 1}, 4710, 2), - mk_pid({a@b, 1}, 4712, 1), - mk_pid({c@b, 1}, 4711, 1), - mk_pid({b@b, 3}, 4711, 1), - mk_pid({b@b, 2}, 4711, 1)], - - ?line R9Sorted = old_mod:sort_on_old_node(PidList), - ?line R9Sorted = lists:sort(PidList). - -pid_wrap(doc) -> []; -pid_wrap(suite) -> []; -pid_wrap(Config) when is_list(Config) -> ?line pp_wrap(pid). - -port_wrap(doc) -> []; -port_wrap(suite) -> []; + erts_debug:set_internal_state(available_internal_state, true), + PidList = [mk_pid({a@b, 1}, 4710, 2), + mk_pid({a@b, 1}, 4712, 1), + mk_pid({c@b, 1}, 4711, 1), + mk_pid({b@b, 3}, 4711, 1), + mk_pid({b@b, 2}, 4711, 1)], + + R9Sorted = old_mod:sort_on_old_node(PidList), + R9Sorted = lists:sort(PidList). + +pid_wrap(Config) when is_list(Config) -> pp_wrap(pid). + port_wrap(Config) when is_list(Config) -> - ?line case ?t:os_type() of - {unix, _} -> - ?line pp_wrap(port); - _ -> - ?line {skip, "Only run on unix"} - end. + case os:type() of + {unix, _} -> + pp_wrap(port); + _ -> + {skip, "Only run on unix"} + end. get_next_id(pid) -> erts_debug:get_internal_state(next_pid); @@ -773,167 +733,160 @@ set_next_id(port, N) -> erts_debug:set_internal_state(next_port, N). pp_wrap(What) -> - ?line N = set_high_pp_next(What), - ?line Cre = N + 100, - ?line ?t:format("no creations = ~p~n", [Cre]), - ?line PreCre = get_next_id(What), - ?line ?t:format("pre creations = ~p~n", [PreCre]), - ?line true = is_integer(PreCre), - ?line do_pp_creations(What, Cre), - ?line PostCre = get_next_id(What), - ?line ?t:format("post creations = ~p~n", [PostCre]), - ?line true = is_integer(PostCre), - ?line true = PreCre > PostCre, - ?line Now = set_next_id(What, ?MAX_PIDS_PORTS div 2), - ?line ?t:format("reset to = ~p~n", [Now]), - ?line true = is_integer(Now), - ?line ok. + N = set_high_pp_next(What), + Cre = N + 100, + io:format("no creations = ~p~n", [Cre]), + PreCre = get_next_id(What), + io:format("pre creations = ~p~n", [PreCre]), + true = is_integer(PreCre), + do_pp_creations(What, Cre), + PostCre = get_next_id(What), + io:format("post creations = ~p~n", [PostCre]), + true = is_integer(PostCre), + true = PreCre > PostCre, + Now = set_next_id(What, ?MAX_PIDS_PORTS div 2), + io:format("reset to = ~p~n", [Now]), + true = is_integer(Now), + ok. set_high_pp_next(What) -> - ?line set_high_pp_next(What, ?MAX_PIDS_PORTS-1). - + set_high_pp_next(What, ?MAX_PIDS_PORTS-1). + set_high_pp_next(What, N) -> - ?line M = set_next_id(What, N), - ?line true = is_integer(M), - ?line case {M >= N, M =< ?MAX_PIDS_PORTS} of - {true, true} -> - ?line ?MAX_PIDS_PORTS - M + 1; - _ -> - ?line set_high_pp_next(What, N - 100) - end. + M = set_next_id(What, N), + true = is_integer(M), + case {M >= N, M =< ?MAX_PIDS_PORTS} of + {true, true} -> + ?MAX_PIDS_PORTS - M + 1; + _ -> + set_high_pp_next(What, N - 100) + end. do_pp_creations(_What, N) when is_integer(N), N =< 0 -> - ?line done; + done; do_pp_creations(pid, N) when is_integer(N) -> %% Create new pid and make sure it works... - ?line Me = self(), - ?line Ref = make_ref(), - ?line Pid = spawn_link(fun () -> - receive - Ref -> - Me ! Ref - end - end), - ?line Pid ! Ref, - ?line receive - Ref -> - ?line do_pp_creations(pid, N - 1) - end; + Me = self(), + Ref = make_ref(), + Pid = spawn_link(fun () -> + receive + Ref -> + Me ! Ref + end + end), + Pid ! Ref, + receive + Ref -> + do_pp_creations(pid, N - 1) + end; do_pp_creations(port, N) when is_integer(N) -> %% Create new port and make sure it works... - ?line "hej" = os:cmd("echo hej") -- "\n", - ?line do_pp_creations(port, N - 1). + "hej" = os:cmd("echo hej") -- "\n", + do_pp_creations(port, N - 1). -bad_nc(doc) -> []; -bad_nc(suite) -> []; bad_nc(Config) when is_list(Config) -> % Make sure emulator don't crash on bad node containers... - ?line MaxPidNum = (1 bsl 15) - 1, - ?line MaxPidSer = ?MAX_PIDS_PORTS bsr 15, - ?line ThisNode = {node(), erlang:system_info(creation)}, - ?line {'EXIT', {badarg, mk_pid, _}} - = (catch mk_pid(ThisNode, MaxPidNum + 1, 17)), - ?line {'EXIT', {badarg, mk_pid, _}} - = (catch mk_pid(ThisNode, 4711, MaxPidSer + 1)), - ?line {'EXIT', {badarg, mk_port, _}} - = (catch mk_port(ThisNode, ?MAX_PIDS_PORTS + 1)), - ?line {'EXIT', {badarg, mk_ref, _}} - = (catch mk_ref(ThisNode,[(1 bsl 18), 4711, 4711])), - ?line {'EXIT', {badarg, mk_ref, _}} - = (catch mk_ref(ThisNode, [4711, 4711, 4711, 4711, 4711, 4711, 4711])), - ?line RemNode = {x@y, 2}, - ?line {'EXIT', {badarg, mk_pid, _}} - = (catch mk_pid(RemNode, MaxPidNum + 1, MaxPidSer)), - ?line {'EXIT', {badarg, mk_pid, _}} - = (catch mk_pid(RemNode, MaxPidNum, MaxPidSer + 1)), - ?line {'EXIT', {badarg, mk_port, _}} - = (catch mk_port(RemNode, ?MAX_PIDS_PORTS + 1)), - ?line {'EXIT', {badarg, mk_ref, _}} - = (catch mk_ref(RemNode, [(1 bsl 18), 4711, 4711])), - ?line {'EXIT', {badarg, mk_ref, _}} - = (catch mk_ref(RemNode, [4711, 4711, 4711, 4711, 4711, 4711, 4711])), - ?line BadNode = {x@y, 4}, - ?line {'EXIT', {badarg, mk_pid, _}} - = (catch mk_pid(BadNode, 4711, 17)), - ?line {'EXIT', {badarg, mk_port, _}} - = (catch mk_port(BadNode, 4711)), - ?line {'EXIT', {badarg, mk_ref, _}} - = (catch mk_ref(BadNode, [4711, 4711, 17])), - ?line ok. + MaxPidNum = (1 bsl 15) - 1, + MaxPidSer = ?MAX_PIDS_PORTS bsr 15, + ThisNode = {node(), erlang:system_info(creation)}, + {'EXIT', {badarg, mk_pid, _}} + = (catch mk_pid(ThisNode, MaxPidNum + 1, 17)), + {'EXIT', {badarg, mk_pid, _}} + = (catch mk_pid(ThisNode, 4711, MaxPidSer + 1)), + {'EXIT', {badarg, mk_port, _}} + = (catch mk_port(ThisNode, ?MAX_PIDS_PORTS + 1)), + {'EXIT', {badarg, mk_ref, _}} + = (catch mk_ref(ThisNode,[(1 bsl 18), 4711, 4711])), + {'EXIT', {badarg, mk_ref, _}} + = (catch mk_ref(ThisNode, [4711, 4711, 4711, 4711, 4711, 4711, 4711])), + RemNode = {x@y, 2}, + {'EXIT', {badarg, mk_pid, _}} + = (catch mk_pid(RemNode, MaxPidNum + 1, MaxPidSer)), + {'EXIT', {badarg, mk_pid, _}} + = (catch mk_pid(RemNode, MaxPidNum, MaxPidSer + 1)), + {'EXIT', {badarg, mk_port, _}} + = (catch mk_port(RemNode, ?MAX_PIDS_PORTS + 1)), + {'EXIT', {badarg, mk_ref, _}} + = (catch mk_ref(RemNode, [(1 bsl 18), 4711, 4711])), + {'EXIT', {badarg, mk_ref, _}} + = (catch mk_ref(RemNode, [4711, 4711, 4711, 4711, 4711, 4711, 4711])), + BadNode = {x@y, bad_creation}, + {'EXIT', {badarg, mk_pid, _}} + = (catch mk_pid(BadNode, 4711, 17)), + {'EXIT', {badarg, mk_port, _}} + = (catch mk_port(BadNode, 4711)), + {'EXIT', {badarg, mk_ref, _}} + = (catch mk_ref(BadNode, [4711, 4711, 17])), + ok. -define(NO_PIDS, 1000000). -unique_pid(doc) -> []; -unique_pid(suite) -> []; unique_pid(Config) when is_list(Config) -> case catch erlang:system_info(modified_timing_level) of - Level when is_integer(Level) -> - {skip, - "Modified timing (level " ++ integer_to_list(Level) - ++ ") is enabled. spawn() is too slow for this " - " test when modified timing is enabled."}; - _ -> - ?line ?NO_PIDS = length(lists:usort(mkpidlist(?NO_PIDS, []))), - ?line ok + Level when is_integer(Level) -> + {skip, + "Modified timing (level " ++ integer_to_list(Level) + ++ ") is enabled. spawn() is too slow for this " + " test when modified timing is enabled."}; + _ -> + ?NO_PIDS = length(lists:usort(mkpidlist(?NO_PIDS, []))), + ok end. - + mkpidlist(0, Ps) -> Ps; mkpidlist(N, Ps) -> mkpidlist(N-1, [spawn(fun () -> ok end)|Ps]). -iter_max_procs(doc) -> []; -iter_max_procs(suite) -> []; iter_max_procs(Config) when is_list(Config) -> - ?line NoMoreTests = make_ref(), - ?line erlang:send_after(10000, self(), NoMoreTests), - ?line Res = chk_max_proc_line(), - ?line Res = chk_max_proc_line(), - ?line done = chk_max_proc_line_until(NoMoreTests, Res), - ?line {comment, - io_lib:format("max processes = ~p; " - "process line length = ~p", - [element(2, Res), element(1, Res)])}. - - + NoMoreTests = make_ref(), + erlang:send_after(10000, self(), NoMoreTests), + Res = chk_max_proc_line(), + Res = chk_max_proc_line(), + done = chk_max_proc_line_until(NoMoreTests, Res), + Cmt = io_lib:format("max processes = ~p; " + "process line length = ~p", + [element(2, Res), element(1, Res)]), + {comment, lists:flatten(Cmt)}. + max_proc_line(Root, Parent, N) -> Me = self(), case catch spawn_link(fun () -> max_proc_line(Root, Me, N+1) end) of - {'EXIT', {system_limit, _}} when Root /= self() -> - Root ! {proc_line_length, N, self()}, - receive remove_proc_line -> Parent ! {exiting, Me} end; - P when is_pid(P), Root =/= self() -> - receive {exiting, P} -> Parent ! {exiting, Me} end; - P when is_pid(P) -> - P; - Unexpected -> - exit({unexpected_spawn_result, Unexpected}) + {'EXIT', {system_limit, _}} when Root /= self() -> + Root ! {proc_line_length, N, self()}, + receive remove_proc_line -> Parent ! {exiting, Me} end; + P when is_pid(P), Root =/= self() -> + receive {exiting, P} -> Parent ! {exiting, Me} end; + P when is_pid(P) -> + P; + Unexpected -> + exit({unexpected_spawn_result, Unexpected}) end. chk_max_proc_line() -> - ?line Child = max_proc_line(self(), self(), 0), - ?line receive - {proc_line_length, PLL, End} -> - ?line PC = erlang:system_info(process_count), - ?line LP = length(processes()), - ?line ?t:format("proc line length = ~p; " - "process count = ~p; " - "length processes = ~p~n", - [PLL, PC, LP]), - ?line End ! remove_proc_line, - ?line PC = LP, - ?line receive {exiting, Child} -> ok end, - ?line {PLL, PC} - end. + Child = max_proc_line(self(), self(), 0), + receive + {proc_line_length, PLL, End} -> + PC = erlang:system_info(process_count), + LP = length(processes()), + io:format("proc line length = ~p; " + "process count = ~p; " + "length processes = ~p~n", + [PLL, PC, LP]), + End ! remove_proc_line, + PC = LP, + receive {exiting, Child} -> ok end, + {PLL, PC} + end. chk_max_proc_line_until(NoMoreTests, Res) -> receive - NoMoreTests -> - ?line done + NoMoreTests -> + done after 0 -> - ?line Res = chk_max_proc_line(), - ?line chk_max_proc_line_until(NoMoreTests, Res) + Res = chk_max_proc_line(), + chk_max_proc_line_until(NoMoreTests, Res) end. %% @@ -950,126 +903,126 @@ node_container_refc_check(Node) when is_atom(Node) -> nc_refc_check(Node) when is_atom(Node) -> Ref = make_ref(), Self = self(), - ?t:format("Starting reference count check of node ~w~n", [Node]), + io:format("Starting reference count check of node ~w~n", [Node]), spawn_link(Node, - fun () -> - {{node_references, NodeRefs}, - {dist_references, DistRefs}} = ?ND_REFS, - check_nd_refc({node(), erlang:system_info(creation)}, - NodeRefs, - DistRefs, - fun (ErrMsg) -> - Self ! {Ref, ErrMsg, failed}, - exit(normal) - end), - Self ! {Ref, succeded} - end), + fun () -> + {{node_references, NodeRefs}, + {dist_references, DistRefs}} = ?ND_REFS, + check_nd_refc({node(), erlang:system_info(creation)}, + NodeRefs, + DistRefs, + fun (ErrMsg) -> + Self ! {Ref, ErrMsg, failed}, + exit(normal) + end), + Self ! {Ref, succeded} + end), receive - {Ref, ErrorMsg, failed} -> - ?t:format("~s~n", [ErrorMsg]), - ?t:fail(reference_count_check_failed); - {Ref, succeded} -> - ?t:format("Reference count check of node ~w succeded!~n", [Node]), - ok + {Ref, ErrorMsg, failed} -> + io:format("~s~n", [ErrorMsg]), + ct:fail(reference_count_check_failed); + {Ref, succeded} -> + io:format("Reference count check of node ~w succeded!~n", [Node]), + ok end. check_nd_refc({ThisNodeName, ThisCreation}, NodeRefs, DistRefs, Fail) -> case catch begin - check_refc(ThisNodeName,ThisCreation,"node table",NodeRefs), - check_refc(ThisNodeName,ThisCreation,"dist table",DistRefs), - ok - end of - ok -> - ok; - {'EXIT', Reason} -> - {Y,Mo,D} = date(), - {H,Mi,S} = time(), - ErrMsg = io_lib:format("~n" - "*** Reference count check of node ~w " - "failed (~p) at ~w~w~w ~w:~w:~w~n" - "*** Node table references:~n ~p~n" - "*** Dist table references:~n ~p~n", - [node(), Reason, Y, Mo, D, H, Mi, S, - NodeRefs, DistRefs]), - Fail(lists:flatten(ErrMsg)) + check_refc(ThisNodeName,ThisCreation,"node table",NodeRefs), + check_refc(ThisNodeName,ThisCreation,"dist table",DistRefs), + ok + end of + ok -> + ok; + {'EXIT', Reason} -> + {Y,Mo,D} = date(), + {H,Mi,S} = time(), + ErrMsg = io_lib:format("~n" + "*** Reference count check of node ~w " + "failed (~p) at ~w~w~w ~w:~w:~w~n" + "*** Node table references:~n ~p~n" + "*** Dist table references:~n ~p~n", + [node(), Reason, Y, Mo, D, H, Mi, S, + NodeRefs, DistRefs]), + Fail(lists:flatten(ErrMsg)) end. check_refc(ThisNodeName,ThisCreation,Table,EntryList) when is_list(EntryList) -> lists:foreach( fun ({Entry, Refc, ReferrerList}) -> - {DelayedDeleteTimer, - FoundRefs} = - lists:foldl( - fun ({Referrer, ReferencesList}, {DDT, A1}) -> - {case Referrer of - {system,delayed_delete_timer} -> - true; - _ -> - DDT - end, - A1 + lists:foldl(fun ({_T,Rs},A2) -> - A2+Rs - end, - 0, - ReferencesList)} - end, - {false, 0}, - ReferrerList), - - %% Reference count equals found references? - case {Refc, FoundRefs, DelayedDeleteTimer} of - {X, X, _} -> - ok; - {0, 1, true} -> - ok; - _ -> - exit({invalid_reference_count, Table, Entry}) - end, - - %% All entries in table referred to? - case {Entry, Refc} of - {ThisNodeName, 0} -> ok; - {{ThisNodeName, ThisCreation}, 0} -> ok; - {_, 0} when DelayedDeleteTimer == false -> - exit({not_referred_entry_in_table, Table, Entry}); - {_, _} -> ok - end + {DelayedDeleteTimer, + FoundRefs} = + lists:foldl( + fun ({Referrer, ReferencesList}, {DDT, A1}) -> + {case Referrer of + {system,delayed_delete_timer} -> + true; + _ -> + DDT + end, + A1 + lists:foldl(fun ({_T,Rs},A2) -> + A2+Rs + end, + 0, + ReferencesList)} + end, + {false, 0}, + ReferrerList), + + %% Reference count equals found references? + case {Refc, FoundRefs, DelayedDeleteTimer} of + {X, X, _} -> + ok; + {0, 1, true} -> + ok; + _ -> + exit({invalid_reference_count, Table, Entry}) + end, + + %% All entries in table referred to? + case {Entry, Refc} of + {ThisNodeName, 0} -> ok; + {{ThisNodeName, ThisCreation}, 0} -> ok; + {_, 0} when DelayedDeleteTimer == false -> + exit({not_referred_entry_in_table, Table, Entry}); + {_, _} -> ok + end end, EntryList), ok. get_node_references({NodeName, Creation} = Node) when is_atom(NodeName), - is_integer(Creation) -> + is_integer(Creation) -> {{node_references, NodeRefs}, - {dist_references, DistRefs}} = ?ND_REFS, + {dist_references, DistRefs}} = ?ND_REFS, check_nd_refc({node(), erlang:system_info(creation)}, - NodeRefs, - DistRefs, - fun (ErrMsg) -> - ?t:format("~s", [ErrMsg]), - ?t:fail(reference_count_check_failed) - end), + NodeRefs, + DistRefs, + fun (ErrMsg) -> + io:format("~s", [ErrMsg]), + ct:fail(reference_count_check_failed) + end), find_references(Node, NodeRefs). get_dist_references(NodeName) when is_atom(NodeName) -> - ?line {{node_references, NodeRefs}, - {dist_references, DistRefs}} = ?ND_REFS, - ?line check_nd_refc({node(), erlang:system_info(creation)}, - NodeRefs, - DistRefs, - fun (ErrMsg) -> - ?line ?t:format("~s", [ErrMsg]), - ?line ?t:fail(reference_count_check_failed) - end), - ?line find_references(NodeName, DistRefs). + {{node_references, NodeRefs}, + {dist_references, DistRefs}} = ?ND_REFS, + check_nd_refc({node(), erlang:system_info(creation)}, + NodeRefs, + DistRefs, + fun (ErrMsg) -> + io:format("~s", [ErrMsg]), + ct:fail(reference_count_check_failed) + end), + find_references(NodeName, DistRefs). find_references(N, NRefList) -> case lists:keysearch(N, 1, NRefList) of - {value, {N, _, ReferrersList}} -> ReferrersList; - _ -> false - end. + {value, {N, _, ReferrersList}} -> ReferrersList; + _ -> false + end. %% Currently unused % refering_entity_type(RefererType, ReferingEntities) -> @@ -1081,7 +1034,7 @@ find_references(N, NRefList) -> % ReferingEntities). refering_entity_id(ReferingEntityId, [{ReferingEntityId,_} = ReferingEntity - | _ReferingEntities]) -> + | _ReferingEntities]) -> ReferingEntity; refering_entity_id(ReferingEntityId, [_ | ReferingEntities]) -> refering_entity_id(ReferingEntityId, ReferingEntities); @@ -1094,34 +1047,34 @@ reference_type_count(Type, {_, _ReferenceCountList} = ReferingEntity) -> reference_type_count(Type, [ReferingEntity]); reference_type_count(Type, ReferingEntities) when is_list(ReferingEntities) -> lists:foldl(fun ({_, ReferenceCountList}, Acc1) -> - lists:foldl(fun ({T, N}, Acc2) when T == Type -> - N + Acc2; - (_, Acc2) -> - Acc2 - end, - Acc1, - ReferenceCountList) - end, - 0, - ReferingEntities). + lists:foldl(fun ({T, N}, Acc2) when T == Type -> + N + Acc2; + (_, Acc2) -> + Acc2 + end, + Acc1, + ReferenceCountList) + end, + 0, + ReferingEntities). start_node(Name, Args) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line Res = test_server:start_node(Name, - slave, - [{args, "-pa "++Pa++" "++Args}]), - ?line {ok, Node} = Res, - ?line rpc:call(Node, erts_debug, set_internal_state, - [available_internal_state, true]), - ?line Res. - + Pa = filename:dirname(code:which(?MODULE)), + Res = test_server:start_node(Name, + slave, + [{args, "-pa "++Pa++" "++Args}]), + {ok, Node} = Res, + rpc:call(Node, erts_debug, set_internal_state, + [available_internal_state, true]), + Res. + start_node(Name) -> - ?line start_node(Name, ""). + start_node(Name, ""). stop_node(Node) -> - ?line nc_refc_check(Node), - ?line true = test_server:stop_node(Node). + nc_refc_check(Node), + true = test_server:stop_node(Node). hostname() -> from($@, atom_to_list(node())). @@ -1132,25 +1085,25 @@ from(_H, []) -> []. wait_until(Pred) -> case Pred() of - true -> ok; - false -> receive after 100 -> wait_until(Pred) end + true -> ok; + 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])). + ++ "-" + ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive])). get_nodefirstname() -> list_to_atom(get_nodefirstname_string()). get_nodename() -> list_to_atom(get_nodefirstname_string() - ++ "@" - ++ hostname()). - + ++ "@" + ++ hostname()). + -define(VERSION_MAGIC, 131). @@ -1160,6 +1113,9 @@ get_nodename() -> -define(PORT_EXT, 102). -define(PID_EXT, 103). -define(NEW_REFERENCE_EXT, 114). +-define(NEW_PID_EXT, $X). +-define(NEW_PORT_EXT, $Y). +-define(NEWER_REFERENCE_EXT, $Z). uint32_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 32 -> [(Uint bsr 24) band 16#ff, @@ -1182,18 +1138,25 @@ uint8(Uint) -> exit({badarg, uint8, [Uint]}). +pid_tag(bad_creation) -> ?PID_EXT; +pid_tag(Creation) when Creation =< 3 -> ?PID_EXT; +pid_tag(_Creation) -> ?NEW_PID_EXT. + +enc_creation(bad_creation) -> uint8(4); +enc_creation(Creation) when Creation =< 3 -> uint8(Creation); +enc_creation(Creation) -> uint32_be(Creation). mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) -> mk_pid({atom_to_list(NodeName), Creation}, Number, Serial); mk_pid({NodeName, Creation}, Number, Serial) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PID_EXT, - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint32_be(Number), - uint32_be(Serial), - uint8(Creation)])) of + pid_tag(Creation), + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint32_be(Serial), + enc_creation(Creation)])) of Pid when is_pid(Pid) -> Pid; {'EXIT', {badarg, _}} -> @@ -1202,16 +1165,20 @@ mk_pid({NodeName, Creation}, Number, Serial) -> exit({unexpected_binary_to_term_result, Other}) end. +port_tag(bad_creation) -> ?PORT_EXT; +port_tag(Creation) when Creation =< 3 -> ?PORT_EXT; +port_tag(_Creation) -> ?NEW_PORT_EXT. + mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> mk_port({atom_to_list(NodeName), Creation}, Number); mk_port({NodeName, Creation}, Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PORT_EXT, + port_tag(Creation), ?ATOM_EXT, uint16_be(length(NodeName)), NodeName, uint32_be(Number), - uint8(Creation)])) of + enc_creation(Creation)])) of Port when is_port(Port) -> Port; {'EXIT', {badarg, _}} -> @@ -1220,37 +1187,39 @@ mk_port({NodeName, Creation}, Number) -> exit({unexpected_binary_to_term_result, Other}) end. +ref_tag(bad_creation) -> ?NEW_REFERENCE_EXT; +ref_tag(Creation) when Creation =< 3 -> ?NEW_REFERENCE_EXT; +ref_tag(_Creation) -> ?NEWER_REFERENCE_EXT. + mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName), - is_integer(Creation), is_list(Numbers) -> mk_ref({atom_to_list(NodeName), Creation}, Numbers); mk_ref({NodeName, Creation}, [Number]) when is_list(NodeName), - is_integer(Creation), + Creation =< 3, is_integer(Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?REFERENCE_EXT, - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint32_be(Number), - uint8(Creation)])) of - Ref when is_reference(Ref) -> - Ref; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_ref, [{NodeName, Creation}, [Number]]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?REFERENCE_EXT, + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint8(Creation)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeName, Creation}, [Number]]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end; mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName), - is_integer(Creation), is_list(Numbers) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?NEW_REFERENCE_EXT, + ref_tag(Creation), uint16_be(length(Numbers)), ?ATOM_EXT, uint16_be(length(NodeName)), NodeName, - uint8(Creation), + enc_creation(Creation), lists:map(fun (N) -> uint32_be(N) end, @@ -1265,10 +1234,10 @@ mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName), exec_loop() -> receive - {exec_fun, Fun} when is_function(Fun) -> - Fun(); - {sync_exec_fun, From, Fun} when is_pid(From), is_function(Fun) -> - From ! {sync_exec_fun_res, self(), Fun()} + {exec_fun, Fun} when is_function(Fun) -> + Fun(); + {sync_exec_fun, From, Fun} when is_pid(From), is_function(Fun) -> + From ! {sync_exec_fun_res, self(), Fun()} end, exec_loop(). @@ -1284,6 +1253,6 @@ exec(Pid, Fun) when is_pid(Pid), is_function(Fun) -> sync_exec(Pid, Fun) when is_pid(Pid), is_function(Fun) -> Pid ! {sync_exec_fun, self(), Fun}, receive - {sync_exec_fun_res, Pid, Res} -> - Res + {sync_exec_fun_res, Pid, Res} -> + Res end. diff --git a/erts/emulator/test/nofrag_SUITE.erl b/erts/emulator/test/nofrag_SUITE.erl index 3660a58c56..8b1519ae36 100644 --- a/erts/emulator/test/nofrag_SUITE.erl +++ b/erts/emulator/test/nofrag_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,57 +20,33 @@ -module(nofrag_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --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, - error_handler/1,error_handler_apply/1, - error_handler_fixed_apply/1,error_handler_fun/1, - debug_breakpoint/1]). +-export([all/0, suite/0, + error_handler/1,error_handler_apply/1, + error_handler_fixed_apply/1,error_handler_fun/1, + debug_breakpoint/1]). %% Exported functions for an error_handler module. -export([undefined_function/3,undefined_lambda/3,breakpoint/3]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> [error_handler, error_handler_apply, error_handler_fixed_apply, error_handler_fun, debug_breakpoint]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(3)), - [{watchdog,Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - error_handler(Config) when is_list(Config) -> - ?line process_flag(error_handler, ?MODULE), + process_flag(error_handler, ?MODULE), %% The term_to_binary/1 - binary_to_term/1 roundtrip is a good way %% to traverse the entire term. - ?line Term = collect(1024), - ?line Term = binary_to_term(term_to_binary(Term)), - ?line 1024 = length(Term), - ?line [[a,b,c,d,[e,f,g]]] = lists:usort(Term), + Term = collect(1024), + Term = binary_to_term(term_to_binary(Term)), + 1024 = length(Term), + [[a,b,c,d,[e,f,g]]] = lists:usort(Term), ok. collect(0) -> @@ -105,25 +81,25 @@ collect_apply(N, Mod) -> [C|Res]. error_handler_apply(Config) when is_list(Config) -> - ?line process_flag(error_handler, ?MODULE), + process_flag(error_handler, ?MODULE), %% The term_to_binary/1 - binary_to_term/1 roundtrip is a good way %% to traverse the entire term. - ?line Term = collect_apply(1024, fooblurfbar), - ?line Term = binary_to_term(term_to_binary(Term)), - ?line 1024 = length(Term), - ?line [[{a,42},b,c,d,[e,f,g]]] = lists:usort(Term), + Term = collect_apply(1024, fooblurfbar), + Term = binary_to_term(term_to_binary(Term)), + 1024 = length(Term), + [[{a,42},b,c,d,[e,f,g]]] = lists:usort(Term), ok. error_handler_fixed_apply(Config) when is_list(Config) -> - ?line process_flag(error_handler, ?MODULE), + process_flag(error_handler, ?MODULE), %% The term_to_binary/1 - binary_to_term/1 roundtrip is a good way %% to traverse the entire term. - ?line Term = collect_fixed_apply(1024, fooblurfbar), - ?line Term = binary_to_term(term_to_binary(Term)), - ?line 1024 = length(Term), - ?line [[{a,2},b,c,d,[e,f,g]]] = lists:usort(Term), + Term = collect_fixed_apply(1024, fooblurfbar), + Term = binary_to_term(term_to_binary(Term)), + 1024 = length(Term), + [[{a,2},b,c,d,[e,f,g]]] = lists:usort(Term), ok. collect_fixed_apply(0, _) -> @@ -145,19 +121,19 @@ undefined_function(_Mod, _Name, Args) -> Args. error_handler_fun(Config) when is_list(Config) -> - ?line process_flag(error_handler, ?MODULE), + process_flag(error_handler, ?MODULE), %% fun(A, B, C) -> {A,B,C,X} end in module foobarblurf. B = <<131,112,0,0,0,84,3,109,96,69,208,5,175,207,75,36,93,112,218,232,222,22,251,0, - 0,0,0,0,0,0,1,100,0,11,102,111,111,98,97,114,98,108,117,114,102,97,0,98,5, - 244,197,144,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116, - 0,0,0,46,0,0,0,0,0,104,3,97,1,97,2,97,3>>, - ?line Fun = binary_to_term(B), - ?line Term = collect_fun(1024, Fun), - ?line Term = binary_to_term(term_to_binary(Term)), - ?line 1024 = length(Term), - ?line [[{foo,bar},{99,1.0},[e,f,g]]] = lists:usort(Term), - ?line {env,[{1,2,3}]} = erlang:fun_info(Fun, env), + 0,0,0,0,0,0,1,100,0,11,102,111,111,98,97,114,98,108,117,114,102,97,0,98,5, + 244,197,144,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116, + 0,0,0,46,0,0,0,0,0,104,3,97,1,97,2,97,3>>, + Fun = binary_to_term(B), + Term = collect_fun(1024, Fun), + Term = binary_to_term(term_to_binary(Term)), + 1024 = length(Term), + [[{foo,bar},{99,1.0},[e,f,g]]] = lists:usort(Term), + {env,[{1,2,3}]} = erlang:fun_info(Fun, env), ok. collect_fun(0, _) -> @@ -179,13 +155,13 @@ undefined_lambda(foobarblurf, Fun, Args) when is_function(Fun) -> Args. debug_breakpoint(Config) when is_list(Config) -> - ?line process_flag(error_handler, ?MODULE), - ?line erts_debug:breakpoint({?MODULE,foobar,5}, true), - ?line Term = break_collect(1024), - ?line Term = binary_to_term(term_to_binary(Term)), - ?line 1024 = length(Term), - ?line [[a,b,c,{d,e},[f,g,h]]] = lists:usort(Term), - ?line erts_debug:breakpoint({?MODULE,foobar,5}, false), + process_flag(error_handler, ?MODULE), + erts_debug:breakpoint({?MODULE,foobar,5}, true), + Term = break_collect(1024), + Term = binary_to_term(term_to_binary(Term)), + 1024 = length(Term), + [[a,b,c,{d,e},[f,g,h]]] = lists:usort(Term), + erts_debug:breakpoint({?MODULE,foobar,5}, false), ok. break_collect(0) -> @@ -202,5 +178,3 @@ foobar(_, _, _, _, _) -> exit(dont_execute_me). id(I) -> I. - - diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index 90b6a36262..d1c9648017 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,13 +14,13 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% %% -module(num_bif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Tests the BIFs: %% abs/1 @@ -36,22 +36,22 @@ %% integer_to_binary/2 %% binary_to_integer/1 --export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, init_per_group/2, end_per_group/2, t_abs/1, t_float/1, t_float_to_string/1, t_integer_to_string/1, - t_string_to_integer/1, + t_string_to_integer/1, t_list_to_integer_edge_cases/1, t_string_to_float_safe/1, t_string_to_float_risky/1, t_round/1, t_trunc/1 ]). suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [t_abs, t_float, t_float_to_string, t_integer_to_string, {group, t_string_to_float}, t_string_to_integer, t_round, - t_trunc]. + t_trunc, t_list_to_integer_edge_cases]. -groups() -> +groups() -> [{t_string_to_float, [], [t_string_to_float_safe, t_string_to_float_risky]}]. @@ -73,7 +73,7 @@ t_abs(Config) when is_list(Config) -> 5.5 = abs(id(5.5)), 0.0 = abs(id(0.0)), 100.0 = abs(id(-100.0)), - + %% Integers. 5 = abs(id(5)), 0 = abs(id(0)), @@ -93,7 +93,7 @@ t_abs(Config) when is_list(Config) -> BigNum = abs(BigNum), BigNum = abs(-BigNum), ok. - + t_float(Config) when is_list(Config) -> 0.0 = float(id(0)), 2.5 = float(id(2.5)), @@ -109,7 +109,7 @@ t_float(Config) when is_list(Config) -> %% Extremly big bignums. Big = id(list_to_integer(id(lists:duplicate(2000, $1)))), {'EXIT', {badarg, _}} = (catch float(Big)), - + ok. @@ -183,7 +183,7 @@ t_float_to_string(Config) when is_list(Config) -> test_fts("1.2300000000e+20",1.23e20, [{scientific, 10}, compact]), test_fts("1.23000000000000000000e+20",1.23e20, []), ok. - + test_fts(Expect, Float) -> Expect = float_to_list(Float), BinExpect = list_to_binary(Expect), @@ -255,7 +255,7 @@ t_round(Config) when is_list(Config) -> 256 = round(id(255.6)), -1033 = round(id(-1033.3)), -1034 = round(id(-1033.6)), - + % OTP-3722: X = id((1 bsl 27) - 1), MX = -X, @@ -345,9 +345,9 @@ t_integer_to_string(Config) when is_list(Config) -> %% Invalid types lists:foreach(fun(Value) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:integer_to_binary(Value)), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:integer_to_list(Value)) end,[atom,1.2,0.0,[$1,[$2]]]), @@ -416,27 +416,27 @@ t_string_to_integer(Config) when is_list(Config) -> %% Invalid types lists:foreach(fun(Value) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch binary_to_integer(Value)), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value)) end,[atom,1.2,0.0,[$1,[$2]]]), - + % Default base error cases lists:foreach(fun(Value) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:binary_to_integer( list_to_binary(Value))), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value)) end,["1.0"," 1"," -1","","+"]), - + % Custom base error cases lists:foreach(fun({Value,Base}) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch binary_to_integer( list_to_binary(Value),Base)), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value,Base)) end,[{" 1",1},{" 1",37},{"2",2},{"C",11}, {"1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111z",16}, @@ -449,10 +449,61 @@ t_string_to_integer(Config) when is_list(Config) -> ok. +%% Tests edge cases for list_to_integer; compares with known good values + +t_list_to_integer_edge_cases(Config) when is_list(Config) -> + %% Take integer literals and compare to their representation in ExtTerm + T = [ + {16, "0", <<131,97,0>>}, + {16, "-0", <<131,97,0>>}, + + {16, "f", <<131,97,15>>}, + {16, "-f", <<131,98,255,255,255,241>>}, + + {16, "0000000000000000000000000000000000000000000000000f", + <<131,97,15>>}, + {16, "-0000000000000000000000000000000000000000000000000f", + <<131,98,255,255,255,241>>}, + + {16, "ffffffff", <<131,110,4,0,255,255,255,255>>}, + {16, "-ffffffff", <<131,110,4,1,255,255,255,255>>}, + + {16, "7fffffff", <<131,110,4,0,255,255,255,127>>}, + {16, "-7fffffff", <<131,98,128,0,0,1>>}, + + {16, "ffffffffffffffff", + <<131,110,8,0,255,255,255,255,255,255,255,255>>}, + {16, "-ffffffffffffffff", + <<131,110,8,1,255,255,255,255,255,255,255,255>>}, + + {16, "7fffffffffffffff", + <<131,110,8,0,255,255,255,255,255,255,255,127>>}, + {16, "-7fffffffffffffff", + <<131,110,8,1,255,255,255,255,255,255,255,127>>}, + + %% Alleged 32-bit corner case (should not happen on 64-bit). At 32-4 + %% bits we may corrupt sign bit and fall out of SMALL_INT range. + {2, "1000000000000000000000000000", <<131,98,8,0,0,0>>}, + {2, "-1000000000000000000000000000", <<131,98,248,0,0,0>>}, + + %% 64-bit corner case (should not happen on 32-bit) at 64-4 bits we + %% corrupt sign bit and fall out of SMALL_INT range (bam! all dead) + {2, "100000000000000000000000000000000000000000000000000000000000", + <<131,110,8,0,0,0,0,0,0,0,0,8>>}, + {2, "-100000000000000000000000000000000000000000000000000000000000", + <<131,110,8,1,0,0,0,0,0,0,0,8>>} + ], + [begin + io:format("~s base ~p vs ~p~n", [Str, Base, Bin]), + FromStr = list_to_integer(Str, Base), + FromStr = binary_to_term(Bin) + end || {Base, Str, Bin} <- T], + ok. + test_sti(Num) -> [begin io:format("Testing ~p:~p",[Num,Base]), - test_sti(Num,Base) + test_sti(Num,Base) end|| Base <- lists:seq(2,36)]. test_sti(Num,Base) -> diff --git a/erts/emulator/test/old_mod.erl b/erts/emulator/test/old_mod.erl index 1586a024d8..866aba79bb 100644 --- a/erts/emulator/test/old_mod.erl +++ b/erts/emulator/test/old_mod.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2010. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,26 +23,26 @@ -export([sort_on_old_node/1, sorter/3]). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). sorter(Receiver, Ref, List) -> Receiver ! {Ref, lists:sort(List)}. sort_on_old_node(List) when is_list(List) -> OldVersion = "r10", - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {X, Y, Z} = now(), - ?line NodeName = list_to_atom(OldVersion - ++ "_" - ++ integer_to_list(X) - ++ integer_to_list(Y) - ++ integer_to_list(Z)), - ?line {ok, Node} = ?t:start_node(NodeName, - peer, - [{args, " -pa " ++ Pa}, - {erl, [{release, OldVersion++"b_patched"}]}]), - ?line Ref = make_ref(), - ?line spawn_link(Node, ?MODULE, sorter, [self(), Ref, List]), - ?line SortedPids = receive {Ref, SP} -> SP end, - ?line true = ?t:stop_node(Node), - ?line SortedPids. + Pa = filename:dirname(code:which(?MODULE)), + {X, Y, Z} = now(), + NodeName = list_to_atom(OldVersion + ++ "_" + ++ integer_to_list(X) + ++ integer_to_list(Y) + ++ integer_to_list(Z)), + {ok, Node} = test_server:start_node(NodeName, + peer, + [{args, " -pa " ++ Pa}, + {erl, [{release, OldVersion++"b_patched"}]}]), + Ref = make_ref(), + spawn_link(Node, ?MODULE, sorter, [self(), Ref, List]), + SortedPids = receive {Ref, SP} -> SP end, + true = test_server:stop_node(Node), + SortedPids. diff --git a/erts/emulator/test/old_scheduler_SUITE.erl b/erts/emulator/test/old_scheduler_SUITE.erl index 97c99fe07b..f91d84beea 100644 --- a/erts/emulator/test/old_scheduler_SUITE.erl +++ b/erts/emulator/test/old_scheduler_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,43 +20,27 @@ -module(old_scheduler_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --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([all/0, suite/0, + init_per_testcase/2, end_per_testcase/2]). -export([equal/1, many_low/1, few_low/1, max/1, high/1]). --define(default_timeout, ?t:minutes(11)). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 11}}]. all() -> case catch erlang:system_info(modified_timing_level) of - Level when is_integer(Level) -> - {skipped, - "Modified timing (level " ++ - integer_to_list(Level) ++ - ") is enabled. Testcases gets messed " - "up by modfied timing."}; - _ -> [equal, many_low, few_low, max, high] + Level when is_integer(Level) -> + {skipped, + "Modified timing (level " ++ + integer_to_list(Level) ++ + ") is enabled. Testcases gets messed " + "up by modfied timing."}; + _ -> [equal, many_low, few_low, max, high] end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - %%----------------------------------------------------------------------------------- %% TEST SUITE DESCRIPTION @@ -78,35 +62,30 @@ end_per_group(_GroupName, Config) -> %%----------------------------------------------------------------------------------- init_per_testcase(_Case, Config) -> - ?line Dog = test_server:timetrap(?default_timeout), %% main test process needs max prio - ?line Prio = process_flag(priority, max), - ?line MS = erlang:system_flag(multi_scheduling, block), - [{prio,Prio},{watchdog,Dog},{multi_scheduling, MS}|Config]. + Prio = process_flag(priority, max), + MS = erlang:system_flag(multi_scheduling, block), + [{prio,Prio},{multi_scheduling, MS}|Config]. end_per_testcase(_Case, Config) -> erlang:system_flag(multi_scheduling, unblock), - Dog=?config(watchdog, Config), - Prio=?config(prio, Config), + Prio=proplists:get_value(prio, Config), process_flag(priority, Prio), - test_server:timetrap_cancel(Dog), ok. ok(Config) when is_list(Config) -> - case ?config(multi_scheduling, Config) of - blocked -> - {comment, - "Multi-scheduling blocked during test. This testcase was not " - "written to work with multiple schedulers."}; - _ -> ok + case proplists:get_value(multi_scheduling, Config) of + blocked -> + {comment, + "Multi-scheduling blocked during test. This testcase was not " + "written to work with multiple schedulers."}; + _ -> ok end. %% Run equal number of low and normal prio processes. -equal(suite) -> []; -equal(doc) -> []; equal(Config) when is_list(Config) -> - ?line Self = self(), + Self = self(), %% specify number of test processes to run Normal = {normal,500}, @@ -116,102 +95,96 @@ equal(Config) when is_list(Config) -> Time = 30, %% start controllers - ?line Receiver = - spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end), - ?line Starter = - spawn(fun() -> starter(Normal, Low, Receiver) end), + Receiver = + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end), + Starter = + spawn(fun() -> starter(Normal, Low, Receiver) end), %% receive test data from Receiver - ?line {NRs,NAvg,LRs,LAvg,Ratio} = - receive - {Receiver,Res} -> Res - end, + {NRs,NAvg,LRs,LAvg,Ratio} = + receive + {Receiver,Res} -> Res + end, %% stop controllers and test processes - ?line exit(Starter, kill), - ?line exit(Receiver, kill), + exit(Starter, kill), + exit(Receiver, kill), io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n", - [NRs,NAvg,LRs,LAvg,Ratio]), + [NRs,NAvg,LRs,LAvg,Ratio]), %% runtime ratio between normal and low should be ~8 if Ratio < 7.5 ; Ratio > 8.5 -> - ?t:fail({bad_ratio,Ratio}); + ct:fail({bad_ratio,Ratio}); true -> - ok(Config) + ok(Config) end. %% Run many low and few normal prio processes. -many_low(suite) -> []; -many_low(doc) -> []; many_low(Config) when is_list(Config) -> - ?line Self = self(), + Self = self(), Normal = {normal,1}, Low = {low,1000}, %% specify time of test (in seconds) Time = 30, - ?line Receiver = - 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} = - receive - {Receiver,Res} -> Res - end, - ?line exit(Starter, kill), - ?line exit(Receiver, kill), + Receiver = + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end), + Starter = + spawn(fun() -> starter(Normal, Low, Receiver) end), + {NRs,NAvg,LRs,LAvg,Ratio} = + receive + {Receiver,Res} -> Res + end, + exit(Starter, kill), + exit(Receiver, kill), io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n", - [NRs,NAvg,LRs,LAvg,Ratio]), + [NRs,NAvg,LRs,LAvg,Ratio]), if Ratio < 7.5 ; Ratio > 8.5 -> - ?t:fail({bad_ratio,Ratio}); + ct:fail({bad_ratio,Ratio}); true -> - ok(Config) + ok(Config) end. %% Run few low and many normal prio processes. -few_low(suite) -> []; -few_low(doc) -> []; few_low(Config) when is_list(Config) -> - ?line Self = self(), + Self = self(), Normal = {normal,1000}, Low = {low,1}, %% specify time of test (in seconds) Time = 30, - ?line Receiver = - 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} = - receive - {Receiver,Res} -> Res - end, - ?line exit(Starter, kill), - ?line exit(Receiver, kill), + Receiver = + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end), + Starter = + spawn(fun() -> starter(Normal, Low, Receiver) end), + {NRs,NAvg,LRs,LAvg,Ratio} = + receive + {Receiver,Res} -> Res + end, + exit(Starter, kill), + exit(Receiver, kill), io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n", - [NRs,NAvg,LRs,LAvg,Ratio]), + [NRs,NAvg,LRs,LAvg,Ratio]), if Ratio < 7.0 ; Ratio > 8.5 -> - ?t:fail({bad_ratio,Ratio}); + ct:fail({bad_ratio,Ratio}); true -> - ok(Config) + ok(Config) end. %% Run max prio processes and verify they get at least as much %% runtime as high, normal and low. -max(suite) -> []; -max(doc) -> []; max(Config) when is_list(Config) -> max = process_flag(priority, max), % should already be max (init_per_tc) - ?line Self = self(), + Self = self(), Max = {max,2}, High = {high,2}, Normal = {normal,100}, @@ -220,69 +193,67 @@ max(Config) when is_list(Config) -> %% specify time of test (in seconds) Time = 30, - ?line Receiver1 = - 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} = - receive - {Receiver1,Res1} -> Res1 - end, - ?line exit(Starter1, kill), - ?line exit(Receiver1, kill), + Receiver1 = + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Max, High) end), + Starter1 = + spawn(fun() -> starter(Max, High, Receiver1) end), + {M1Rs,M1Avg,HRs,HAvg,Ratio1} = + receive + {Receiver1,Res1} -> Res1 + end, + exit(Starter1, kill), + exit(Receiver1, kill), io:format("Reports: ~w max (~w/proc), ~w high (~w/proc). Ratio: ~w~n", - [M1Rs,M1Avg,HRs,HAvg,Ratio1]), + [M1Rs,M1Avg,HRs,HAvg,Ratio1]), if Ratio1 < 1.0 -> - ?t:fail({bad_ratio,Ratio1}); + ct:fail({bad_ratio,Ratio1}); true -> - ok(Config) + ok(Config) end, - ?line Receiver2 = - 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} = - receive - {Receiver2,Res2} -> Res2 - end, - ?line exit(Starter2, kill), - ?line exit(Receiver2, kill), + Receiver2 = + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Max, Normal) end), + Starter2 = + spawn(fun() -> starter(Max, Normal, Receiver2) end), + {M2Rs,M2Avg,NRs,NAvg,Ratio2} = + receive + {Receiver2,Res2} -> Res2 + end, + exit(Starter2, kill), + exit(Receiver2, kill), io:format("Reports: ~w max (~w/proc), ~w normal (~w/proc). Ratio: ~w~n", - [M2Rs,M2Avg,NRs,NAvg,Ratio2]), + [M2Rs,M2Avg,NRs,NAvg,Ratio2]), if Ratio2 < 1.0 -> - ?t:fail({bad_ratio,Ratio2}); + ct:fail({bad_ratio,Ratio2}); true -> - ok + ok end, - ?line Receiver3 = - 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} = - receive - {Receiver3,Res3} -> Res3 - end, - ?line exit(Starter3, kill), - ?line exit(Receiver3, kill), + Receiver3 = + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Max, Low) end), + Starter3 = + spawn(fun() -> starter(Max, Low, Receiver3) end), + {M3Rs,M3Avg,LRs,LAvg,Ratio3} = + receive + {Receiver3,Res3} -> Res3 + end, + exit(Starter3, kill), + exit(Receiver3, kill), io:format("Reports: ~w max (~w/proc), ~w low (~w/proc). Ratio: ~w~n", - [M3Rs,M3Avg,LRs,LAvg,Ratio3]), + [M3Rs,M3Avg,LRs,LAvg,Ratio3]), if Ratio3 < 1.0 -> - ?t:fail({bad_ratio,Ratio3}); + ct:fail({bad_ratio,Ratio3}); true -> - ok(Config) + ok(Config) end. %% Run high prio processes and verify they get at least as much %% runtime as normal and low. -high(suite) -> []; -high(doc) -> []; high(Config) when is_list(Config) -> max = process_flag(priority, max), % should already be max (init_per_tc) - ?line Self = self(), + Self = self(), High = {high,2}, Normal = {normal,100}, Low = {low,100}, @@ -290,40 +261,40 @@ high(Config) when is_list(Config) -> %% specify time of test (in seconds) Time = 30, - ?line Receiver1 = - 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} = - receive - {Receiver1,Res1} -> Res1 - end, - ?line exit(Starter1, kill), - ?line exit(Receiver1, kill), + Receiver1 = + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, High, Normal) end), + Starter1 = + spawn(fun() -> starter(High, Normal, Receiver1) end), + {H1Rs,H1Avg,NRs,NAvg,Ratio1} = + receive + {Receiver1,Res1} -> Res1 + end, + exit(Starter1, kill), + exit(Receiver1, kill), io:format("Reports: ~w high (~w/proc), ~w normal (~w/proc). Ratio: ~w~n", - [H1Rs,H1Avg,NRs,NAvg,Ratio1]), + [H1Rs,H1Avg,NRs,NAvg,Ratio1]), if Ratio1 < 1.0 -> - ?t:fail({bad_ratio,Ratio1}); + ct:fail({bad_ratio,Ratio1}); true -> - ok + ok end, - ?line Receiver2 = - 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} = - receive - {Receiver2,Res2} -> Res2 - end, - ?line exit(Starter2, kill), - ?line exit(Receiver2, kill), + Receiver2 = + spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, High, Low) end), + Starter2 = + spawn(fun() -> starter(High, Low, Receiver2) end), + {H2Rs,H2Avg,LRs,LAvg,Ratio2} = + receive + {Receiver2,Res2} -> Res2 + end, + exit(Starter2, kill), + exit(Receiver2, kill), io:format("Reports: ~w high (~w/proc), ~w low (~w/proc). Ratio: ~w~n", - [H2Rs,H2Avg,LRs,LAvg,Ratio2]), + [H2Rs,H2Avg,LRs,LAvg,Ratio2]), if Ratio2 < 1.0 -> - ?t:fail({bad_ratio,Ratio2}); + ct:fail({bad_ratio,Ratio2}); true -> - ok(Config) + ok(Config) end. @@ -338,38 +309,38 @@ 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 = erlang:convert_time_unit(erlang:monotonic_time() - T0, native, milli_seconds), -% erlang:display({round(T/1000),P1Rs,P2Rs}), + % 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 - erlang:convert_time_unit(erlang:monotonic_time() - T0, - native, milli_seconds), % test time remaining + native, milli_seconds), % test time remaining Remain1 = if Remain < 0 -> - 0; - true -> - Remain - end, + 0; + true -> + Remain + end, {P1Rs1,P2Rs1} = - receive - {_Pid,P1} -> % report from a P1 process - {P1Rs+1,P2Rs}; - {_Pid,P2} -> % report from a P2 process - {P1Rs,P2Rs+1} - after Remain1 -> - {P1Rs,P2Rs} - end, + receive + {_Pid,P1} -> % report from a P1 process + {P1Rs+1,P2Rs}; + {_Pid,P2} -> % report from a P2 process + {P1Rs,P2Rs+1} + after Remain1 -> + {P1Rs,P2Rs} + end, if Remain > 0 -> % keep going - receiver(T0, Time, Main, P1,P1N,P1Rs1, P2,P2N,P2Rs1, C-1); + receiver(T0, Time, Main, P1,P1N,P1Rs1, P2,P2N,P2Rs1, C-1); true -> % finish - %% calculate results and send to main test process - P1Avg = P1Rs1/P1N, - P2Avg = P2Rs1/P2N, - Ratio = if P2Avg < 1.0 -> P1Avg; - true -> P1Avg/P2Avg - end, - Main ! {self(),{P1Rs1,round(P1Avg),P2Rs1,round(P2Avg),Ratio}}, - flush_loop() + %% calculate results and send to main test process + P1Avg = P1Rs1/P1N, + P2Avg = P2Rs1/P2N, + Ratio = if P2Avg < 1.0 -> P1Avg; + true -> P1Avg/P2Avg + end, + Main ! {self(),{P1Rs1,round(P1Avg),P2Rs1,round(P2Avg),Ratio}}, + flush_loop() end. starter({P1,P1N}, {P2,P2N}, Receiver) -> @@ -395,8 +366,8 @@ p_loop(100, Prio, Receiver) -> receive after 0 -> ok end, %% if Receiver gone, we're done case is_process_alive(Receiver) of - false -> exit(bye); - true -> ok + false -> exit(bye); + true -> ok end, %% send report Receiver ! {self(),Prio}, @@ -404,10 +375,10 @@ p_loop(100, Prio, Receiver) -> p_loop(N, Prio, Receiver) -> p_loop(N+1, Prio, Receiver). - + flush_loop() -> receive _ -> - ok + ok end, flush_loop(). diff --git a/erts/emulator/test/op_SUITE.erl b/erts/emulator/test/op_SUITE.erl index 6eda78a57b..08655d32a5 100644 --- a/erts/emulator/test/op_SUITE.erl +++ b/erts/emulator/test/op_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,68 +20,51 @@ -module(op_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --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, - bsl_bsr/1,logical/1,t_not/1,relop_simple/1,relop/1,complex_relop/1]). +-export([all/0, suite/0, + bsl_bsr/1,logical/1,t_not/1,relop_simple/1,relop/1,complex_relop/1]). -export([]). -import(lists, [foldl/3,flatmap/2]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 5}}]. all() -> [bsl_bsr, logical, t_not, relop_simple, relop, complex_relop]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(3)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - %% Test the bsl and bsr operators. bsl_bsr(Config) when is_list(Config) -> Vs = [unvalue(V) || V <- [-16#8000009-2,-1,0,1,2,73,16#8000000,bad,[]]], - Cases = [{Op,X,Y} || Op <- ['bsr','bsl'], X <- Vs, Y <- Vs], - ?line run_test_module(Cases, false), - {comment,integer_to_list(length(Cases)) ++ " cases"}. + %% Try to use less memory by splitting the cases + + Cases1 = [{Op,X,Y} || Op <- ['bsl'], X <- Vs, Y <- Vs], + N1 = length(Cases1), + run_test_module(Cases1, false), -logical(doc) -> "Test the logical operators and internal BIFs."; + Cases2 = [{Op,X,Y} || Op <- ['bsr'], X <- Vs, Y <- Vs], + N2 = length(Cases2), + run_test_module(Cases2, false), + {comment,integer_to_list(N1 + N2) ++ " cases"}. + +%% Test the logical operators and internal BIFs. logical(Config) when is_list(Config) -> Vs0 = [true,false,bad], Vs = [unvalue(V) || V <- Vs0], Cases = [{Op,X,Y} || Op <- ['and','or','xor'], X <- Vs, Y <- Vs], - ?line run_test_module(Cases, false), + run_test_module(Cases, false), {comment,integer_to_list(length(Cases)) ++ " cases"}. -t_not(doc) -> "Test the not operator and internal BIFs."; +%% Test the not operator and internal BIFs. t_not(Config) when is_list(Config) -> - ?line Cases = [{'not',unvalue(V)} || V <- [true,false,42,bad]], - ?line run_test_module(Cases, false), + Cases = [{'not',unvalue(V)} || V <- [true,false,42,bad]], + run_test_module(Cases, false), {comment,integer_to_list(length(Cases)) ++ " cases"}. -relop_simple(doc) -> "Test that simlpe relations between relation operators hold."; +%% Test that simlpe relations between relation operators hold. relop_simple(Config) when is_list(Config) -> Big1 = 19738924729729787487784874, Big2 = 38374938373887374983978484, @@ -90,51 +73,52 @@ relop_simple(Config) when is_list(Config) -> T1 = erlang:make_tuple(3,87), T2 = erlang:make_tuple(3,87), Terms = [-F2,Big2,-F1,-Big1,-33,-33.0,0,0.0,42,42.0,Big1,F1,Big2,F2,a,b, - {T1,a},{T2,b},[T1,Big1],[T2,Big2]], - - ?line Combos = [{V1,V2} || V1 <- Terms, V2 <- Terms], - + {T1,a},{T2,b},[T1,Big1],[T2,Big2]], + + Combos = [{V1,V2} || V1 <- Terms, V2 <- Terms], + lists:foreach(fun({A,B}) -> relop_simple_do(A,B) end, - Combos), - - repeat(fun() -> Size = random:uniform(100), - Rnd1 = make_rand_term(Size), - {Rnd2,0} = clone_and_mutate(Rnd1, random:uniform(Size)), - relop_simple_do(Rnd1,Rnd2) - end, - 1000), + Combos), + + repeat(fun() -> + Size = rand:uniform(100), + Rnd1 = make_rand_term(Size), + {Rnd2,0} = clone_and_mutate(Rnd1, rand:uniform(Size)), + relop_simple_do(Rnd1,Rnd2) + end, + 1000), ok. relop_simple_do(V1,V2) -> %%io:format("compare ~p\n and ~p\n",[V1,V2]), L = V1 < V2, - ?line L = not (V1 >= V2), - ?line L = V2 > V1, - ?line L = not (V2 =< V1), + L = not (V1 >= V2), + L = V2 > V1, + L = not (V2 =< V1), G = V1 > V2, - ?line G = not (V1 =< V2), - ?line G = V2 < V1, - ?line G = not (V2 >= V1), - + G = not (V1 =< V2), + G = V2 < V1, + G = not (V2 >= V1), + ID = V1 =:= V2, - ?line ID = V2 =:= V1, - ?line ID = not (V1 =/= V2), - ?line ID = not (V2 =/= V1), - + ID = V2 =:= V1, + ID = not (V1 =/= V2), + ID = not (V2 =/= V1), + EQ = V1 == V2, - ?line EQ = V2 == V1, - ?line EQ = not (V1 /= V2), - ?line EQ = not (V2 /= V1), - - ?line case {L, EQ, ID, G, cmp_emu(V1,V2)} of - { true, false, false, false, -1} -> ok; - {false, true, false, false, 0} -> ok; - {false, true, true, false, 0} -> ok; - {false, false, false, true, +1} -> ok - end. - + EQ = V2 == V1, + EQ = not (V1 /= V2), + EQ = not (V2 /= V1), + + case {L, EQ, ID, G, cmp_emu(V1,V2)} of + { true, false, false, false, -1} -> ok; + {false, true, false, false, 0} -> ok; + {false, true, true, false, 0} -> ok; + {false, false, false, true, +1} -> ok + end. + %% Emulate internal "cmp" cmp_emu(A,B) when is_tuple(A), is_tuple(B) -> SA = size(A), @@ -145,8 +129,8 @@ cmp_emu(A,B) when is_tuple(A), is_tuple(B) -> end; cmp_emu([A|TA],[B|TB]) -> case cmp_emu(A,B) of - 0 -> cmp_emu(TA,TB); - CMP -> CMP + 0 -> cmp_emu(TA,TB); + CMP -> CMP end; cmp_emu(A,B) -> %% We cheat and use real "cmp" for the primitive types. @@ -154,48 +138,48 @@ cmp_emu(A,B) -> A > B -> +1; true -> 0 end. - + make_rand_term(1) -> make_rand_term_single(); make_rand_term(Arity) -> - case random:uniform(3) of - 1 -> - make_rand_list(Arity); - 2 -> - list_to_tuple(make_rand_list(Arity)); - 3 -> - {Car,Rest} = make_rand_term_rand_size(Arity), - [Car|make_rand_term(Rest)] + case rand:uniform(3) of + 1 -> + make_rand_list(Arity); + 2 -> + list_to_tuple(make_rand_list(Arity)); + 3 -> + {Car,Rest} = make_rand_term_rand_size(Arity), + [Car|make_rand_term(Rest)] end. make_rand_term_single() -> - Range = 1 bsl random:uniform(200), - case random:uniform(12) of - 1 -> random; - 2 -> uniform; - 3 -> random:uniform(Range) - (Range div 2); - 4 -> Range * (random:uniform() - 0.5); - 5 -> 0; - 6 -> 0.0; - 7 -> make_ref(); - 8 -> self(); - 9 -> term_to_binary(random:uniform(Range)); - 10 -> fun(X) -> X*Range end; - 11 -> fun(X) -> X/Range end; - 12 -> [] + Range = 1 bsl rand:uniform(200), + case rand:uniform(12) of + 1 -> random; + 2 -> uniform; + 3 -> rand:uniform(Range) - (Range div 2); + 4 -> Range * (rand:uniform() - 0.5); + 5 -> 0; + 6 -> 0.0; + 7 -> make_ref(); + 8 -> self(); + 9 -> term_to_binary(rand:uniform(Range)); + 10 -> fun(X) -> X*Range end; + 11 -> fun(X) -> X/Range end; + 12 -> [] end. make_rand_term_rand_size(1) -> {make_rand_term(1), 0}; make_rand_term_rand_size(MaxArity) -> - Arity = random:uniform(MaxArity-1), + Arity = rand:uniform(MaxArity-1), {make_rand_term(Arity), MaxArity-Arity}. make_rand_list(0) -> []; make_rand_list(Arity) -> {Term, Rest} = make_rand_term_rand_size(Arity), [Term | make_rand_list(Rest)]. - + clone_and_mutate(Term, 0) -> {clone(Term), 0}; @@ -218,82 +202,81 @@ clone(Term) -> my_list_to_tuple(List) -> try list_to_tuple(List) catch - error:badarg -> - %%io:format("my_list_to_tuple got badarg exception.\n"), - list_to_tuple(purify_list(List)) + error:badarg -> + %%io:format("my_list_to_tuple got badarg exception.\n"), + list_to_tuple(purify_list(List)) end. - + purify_list(List) -> lists:reverse(purify_list(List, [])). purify_list([], Acc) -> Acc; purify_list([H|T], Acc) -> purify_list(T, [H|Acc]); purify_list(Other, Acc) -> [Other|Acc]. - -relop(doc) -> "Test the relational operators and internal BIFs on literals."; + +%% Test the relational operators and internal BIFs on literals. relop(Config) when is_list(Config) -> Big1 = -38374938373887374983978484, Big2 = 19738924729729787487784874, F1 = float(Big1), F2 = float(Big2), Vs0 = [a,b,-33,-33.0,0,0.0,42,42.0,Big1,Big2,F1,F2], - ?line Vs = [unvalue(V) || V <- Vs0], + Vs = [unvalue(V) || V <- Vs0], Ops = ['==', '/=', '=:=', '=/=', '<', '=<', '>', '>='], - ?line binop(Ops, Vs). + binop(Ops, Vs). -complex_relop(doc) -> - "Test the relational operators and internal BIFs on lists and tuples."; +%% Test the relational operators and internal BIFs on lists and tuples. complex_relop(Config) when is_list(Config) -> Big = 99678557475484872464269855544643333, Float = float(Big), Vs0 = [an_atom,42.0,42,Big,Float], Vs = flatmap(fun(X) -> [unvalue({X}),unvalue([X])] end, Vs0), Ops = ['==', '/=', '=:=', '=/=', '<', '=<', '>', '>='], - ?line binop(Ops, Vs). + binop(Ops, Vs). binop(Ops, Vs) -> - Run = fun(Op, N) -> ?line Cases = [{Op,V1,V2} || V1 <- Vs, V2 <- Vs], - ?line run_test_module(Cases, true), - N + length(Cases) end, - ?line NumCases = foldl(Run, 0, Ops), + Run = fun(Op, N) -> Cases = [{Op,V1,V2} || V1 <- Vs, V2 <- Vs], + run_test_module(Cases, true), + N + length(Cases) end, + NumCases = foldl(Run, 0, Ops), {comment,integer_to_list(NumCases) ++ " cases"}. - + run_test_module(Cases, GuardsOk) -> - ?line Es = [expr(C) || C <- Cases], - ?line Ok = unvalue(ok), - ?line Gts = case GuardsOk of - true -> - Ges = [guard_expr(C) || C <- Cases], - ?line lists:foldr(fun guard_test/2, [Ok], Ges); - false -> - [Ok] - end, - ?line Fun1 = make_function(guard_tests, Gts), - ?line Bts = lists:foldr(fun body_test/2, [Ok], Es), - ?line Fun2 = make_function(body_tests, Bts), - ?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'}]}]}, + Es = [expr(C) || C <- Cases], + Ok = unvalue(ok), + Gts = case GuardsOk of + true -> + Ges = [guard_expr(C) || C <- Cases], + lists:foldr(fun guard_test/2, [Ok], Ges); + false -> + [Ok] + end, + Fun1 = make_function(guard_tests, Gts), + Bts = lists:foldr(fun body_test/2, [Ok], Es), + Fun2 = make_function(body_tests, Bts), + Bbts = lists:foldr(fun internal_bif/2, [Ok], Es), + Fun3 = make_function(bif_tests, Bbts), + Id = {function,1,id,1,[{clause,1,[{var,1,'I'}],[],[{var,1,'I'}]}]}, 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), + lists:foreach(fun(F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Module), %% Compile, load, and run the generated module. - Native = case ?t:is_native(?MODULE) of - true -> [native]; - false -> [] - end, - ?line {ok,Mod,Code1} = compile:forms(Module, [time|Native]), - ?line code:delete(Mod), - ?line code:purge(Mod), - ?line {module,Mod} = code:load_binary(Mod, Mod, Code1), - ?line run_function(Mod, guard_tests), - ?line run_function(Mod, body_tests), - ?line run_function(Mod, bif_tests), - - ?line true = code:delete(Mod), - ?line code:purge(Mod), + Native = case test_server:is_native(?MODULE) of + true -> [native]; + false -> [] + end, + {ok,Mod,Code1} = compile:forms(Module, [time|Native]), + code:delete(Mod), + code:purge(Mod), + {module,Mod} = code:load_binary(Mod, Mod, Code1), + run_function(Mod, guard_tests), + run_function(Mod, body_tests), + run_function(Mod, bif_tests), + + true = code:delete(Mod), + code:purge(Mod), ok. @@ -317,19 +300,19 @@ guard_expr({Op,X,Y}) -> run_function(Mod, Name) -> case catch Mod:Name() of - {'EXIT',Reason} -> - io:format("~p", [get(last)]), - ?t:fail({'EXIT',Reason}); - _Other -> - ok + {'EXIT',Reason} -> + io:format("~p", [get(last)]), + ct:fail({'EXIT',Reason}); + _Other -> + ok end. - + guard_test({E,Expr,Res}, Tail) -> True = unvalue(true), [save_term(Expr), {match,1,unvalue(Res), {'if',1,[{clause,1,[],[[E]],[True]}, - {clause,1,[],[[True]],[unvalue(false)]}]}}|Tail]. + {clause,1,[],[[True]],[unvalue(false)]}]}}|Tail]. body_test({E,Expr,{'EXIT',_}}, Tail) -> [save_term(Expr), @@ -355,8 +338,8 @@ internal_bif(Op, Args, Expr, Res, Tail) -> save_term(Term) -> {call,1, - {atom,1,put}, - [{atom,1,last},unvalue(Term)]}. + {atom,1,put}, + [{atom,1,last},unvalue(Term)]}. make_module(Name, Funcs) -> [{attribute,1,module,Name}, @@ -366,18 +349,18 @@ make_module(Name, Funcs) -> make_function(Name, Body) -> {function,1,Name,0,[{clause,1,[],[],Body}]}. - + 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. + case catch erl_eval:exprs(E, []) of + {'EXIT',Reason} -> {'EXIT',Reason}; + {value,Val,_Bs} -> Val + end. unvalue(V) -> Abstr = erl_parse:abstract(V), erl_parse:anno_to_term(Abstr). - + value({nil,_}) -> []; value({integer,_,X}) -> X; value({string,_,X}) -> X; diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index 3d0509a28c..79abcbde5f 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -74,25 +74,27 @@ %% --export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2, - init_per_suite/1, end_per_suite/1, - stream_small/1, stream_big/1, - basic_ping/1, slow_writes/1, bad_packet/1, bad_port_messages/1, - mul_basic/1, mul_slow_writes/1, - dying_port/1, port_program_with_path/1, - open_input_file_port/1, open_output_file_port/1, - iter_max_ports/1, eof/1, input_only/1, output_only/1, - name1/1, - t_binary/1, parallell/1, t_exit/1, - env/1, bad_env/1, cd/1, exit_status/1, - tps_16_bytes/1, tps_1K/1, line/1, stderr_to_stdout/1, - otp_3906/1, otp_4389/1, win_massive/1, win_massive_client/1, - mix_up_ports/1, otp_5112/1, otp_5119/1, otp_6224/1, - exit_status_multi_scheduling_block/1, ports/1, - spawn_driver/1, spawn_executable/1, close_deaf_port/1, - port_setget_data/1, - unregister_name/1, parallelism_option/1]). +-export([all/0, suite/0, groups/0, + init_per_testcase/2, end_per_testcase/2, + init_per_suite/1, end_per_suite/1, + stream_small/1, stream_big/1, + basic_ping/1, slow_writes/1, bad_packet/1, bad_port_messages/1, + mul_basic/1, mul_slow_writes/1, + dying_port/1, port_program_with_path/1, + open_input_file_port/1, open_output_file_port/1, + count_fds/1, + iter_max_ports/1, eof/1, input_only/1, output_only/1, + name1/1, + t_binary/1, parallell/1, t_exit/1, + env/1, huge_env/1, bad_env/1, cd/1, exit_status/1, + bad_args/1, + tps_16_bytes/1, tps_1K/1, line/1, stderr_to_stdout/1, + otp_3906/1, otp_4389/1, win_massive/1, win_massive_client/1, + mix_up_ports/1, otp_5112/1, otp_5119/1, otp_6224/1, + exit_status_multi_scheduling_block/1, ports/1, + spawn_driver/1, spawn_executable/1, close_deaf_port/1, + port_setget_data/1, + unregister_name/1, parallelism_option/1]). -export([do_iter_max_ports/2]). @@ -101,18 +103,21 @@ -export([otp_3906_forker/5, otp_3906_start_forker_starter/4]). -export([env_slave_main/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 10}}]. all() -> [otp_6224, {group, stream}, basic_ping, slow_writes, bad_packet, bad_port_messages, {group, options}, {group, multiple_packets}, parallell, dying_port, port_program_with_path, open_input_file_port, - open_output_file_port, name1, env, bad_env, cd, - exit_status, iter_max_ports, t_exit, {group, tps}, line, + open_output_file_port, name1, env, huge_env, bad_env, cd, + bad_args, + exit_status, iter_max_ports, count_fds, t_exit, {group, tps}, line, stderr_to_stdout, otp_3906, otp_4389, win_massive, mix_up_ports, otp_5112, otp_5119, exit_status_multi_scheduling_block, ports, spawn_driver, @@ -126,15 +131,6 @@ groups() -> {multiple_packets, [], [mul_basic, mul_slow_writes]}, {tps, [], [tps_16_bytes, tps_1K]}]. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - --define(DEFAULT_TIMEOUT, ?t:minutes(5)). - init_per_testcase(Case, Config) -> [{testcase, Case} |Config]. @@ -154,69 +150,63 @@ end_per_suite(Config) when is_list(Config) -> %% on a Windows machine given the correct environment. win_massive(Config) when is_list(Config) -> case os:type() of - {win32,_} -> - do_win_massive(); - _ -> - {skip,"Only on Windows."} + {win32,_} -> + do_win_massive(); + _ -> + {skip,"Only on Windows."} end. do_win_massive() -> - Dog = test_server:timetrap(test_server:seconds(360)), + ct:timetrap({minutes, 6}), SuiteDir = filename:dirname(code:which(?MODULE)), Ports = " +Q 8192", {ok, Node} = - test_server:start_node(win_massive, - slave, - [{args, " -pa " ++ SuiteDir ++ Ports}]), + test_server:start_node(win_massive, + slave, + [{args, " -pa " ++ SuiteDir ++ Ports}]), ok = rpc:call(Node,?MODULE,win_massive_client,[3000]), test_server:stop_node(Node), - test_server:timetrap_cancel(Dog), ok. - + win_massive_client(N) -> {ok,P}=gen_tcp:listen(?WIN_MASSIVE_PORT,[{reuseaddr,true}]), L = win_massive_loop(P,N), Len = length(L), lists:foreach(fun(E) -> - gen_tcp:close(E) - end, - L), + gen_tcp:close(E) + end, + L), case Len div 2 of - N -> - ok; - _Else -> - {too_few, Len} + N -> + ok; + _Else -> + {too_few, Len} end. win_massive_loop(_,0) -> []; win_massive_loop(P,N) -> case (catch gen_tcp:connect("localhost",?WIN_MASSIVE_PORT,[])) of - {ok,A} -> - case (catch gen_tcp:accept(P)) of - {ok,B} -> - %erlang:display(N), - [A,B|win_massive_loop(P,N-1)]; - _Else -> - [A] - end; - _Else0 -> - [] + {ok,A} -> + case (catch gen_tcp:accept(P)) of + {ok,B} -> + %erlang:display(N), + [A,B|win_massive_loop(P,N-1)]; + _Else -> + [A] + end; + _Else0 -> + [] end. - - - %% Test that we can send a stream of bytes and get it back. %% We will send only a small amount of data, to avoid deadlock. stream_small(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), stream_ping(Config, 512, "", []), stream_ping(Config, 1777, "", []), stream_ping(Config, 1777, "-s512", []), - test_server:timetrap_cancel(Dog), ok. %% Send big amounts of data (much bigger than the buffer size in port test). @@ -224,22 +214,20 @@ stream_small(Config) when is_list(Config) -> %% non-blocking reads and writes. stream_big(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(180)), + ct:timetrap({seconds, 180}), stream_ping(Config, 43755, "", []), stream_ping(Config, 100000, "", []), stream_ping(Config, 77777, " -s40000", []), - test_server:timetrap_cancel(Dog), ok. %% Sends packet with header size of 1, 2, and 4, with packets of various %% sizes. basic_ping(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(120)), + ct:timetrap({minutes, 2}), ping(Config, sizes(1), 1, "", []), ping(Config, sizes(2), 2, "", []), ping(Config, sizes(4), 4, "", []), - test_server:timetrap_cancel(Dog), ok. %% Let the port program insert delays between characters sent back to @@ -247,17 +235,13 @@ basic_ping(Config) when is_list(Config) -> %% small chunks rather than all at once. slow_writes(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(20)), ping(Config, [8], 4, "-s1", []), ping(Config, [10], 2, "-s2", []), - test_server:timetrap_cancel(Dog), ok. -bad_packet(doc) -> - ["Test that we get {'EXIT', Port, einval} if we try to send a bigger " - "packet than the packet header allows."]; +%% Test that we get {'EXIT', Port, einval} if we try to send a bigger +%% packet than the packet header allows. bad_packet(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), PortTest = port_test(Config), process_flag(trap_exit, true), @@ -265,16 +249,14 @@ bad_packet(Config) when is_list(Config) -> bad_packet(PortTest, 1, 257), bad_packet(PortTest, 2, 65536), bad_packet(PortTest, 2, 65537), - - test_server:timetrap_cancel(Dog), ok. bad_packet(PortTest, HeaderSize, PacketSize) -> P = open_port({spawn, PortTest}, [{packet, HeaderSize}]), P ! {self(), {command, make_zero_packet(PacketSize)}}, receive - {'EXIT', P, einval} -> ok; - Other -> test_server:fail({unexpected_message, Other}) + {'EXIT', P, einval} -> ok; + Other -> ct:fail({unexpected_message, Other}) end. make_zero_packet(0) -> []; @@ -287,7 +269,6 @@ make_zero_packet(N) -> %% Test sending bad messages to a port. bad_port_messages(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), PortTest = port_test(Config), process_flag(trap_exit, true), @@ -295,16 +276,14 @@ bad_port_messages(Config) when is_list(Config) -> bad_message(PortTest, {a}), bad_message(PortTest, {self(),{command,bad_command}}), bad_message(PortTest, {self(),{connect,no_pid}}), - - test_server:timetrap_cancel(Dog), ok. bad_message(PortTest, Message) -> P = open_port({spawn,PortTest}, []), P ! Message, receive - {'EXIT',P,badsig} -> ok; - Other -> test_server:fail({unexpected_message, Other}) + {'EXIT',P,badsig} -> ok; + Other -> ct:fail({unexpected_message, Other}) end. %% Tests various options (stream and {packet, Number} are implicitly @@ -314,7 +293,7 @@ bad_message(PortTest, Message) -> %% Tests the 'binary' option for a port. t_binary(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(300)), + ct:timetrap({seconds, 300}), %% Packet mode. ping(Config, sizes(1), 1, "", [binary]), @@ -325,12 +304,10 @@ t_binary(Config) when is_list(Config) -> stream_ping(Config, 435, "", [binary]), stream_ping(Config, 43755, "", [binary]), stream_ping(Config, 100000, "", [binary]), - - test_server:timetrap_cancel(Dog), ok. name1(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(100)), + ct:timetrap({seconds, 100}), PortTest = port_test(Config), Command = lists:concat([PortTest, " "]), P = open_port({spawn, Command}, []), @@ -347,13 +324,12 @@ name1(Config) when is_list(Config) -> {P, closed} -> ok end, undefined = whereis(myport), - test_server:timetrap_cancel(Dog), ok. %% Test that the 'eof' option works. eof(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(100)), + ct:timetrap({seconds, 100}), PortTest = port_test(Config), Command = lists:concat([PortTest, " -h0 -q"]), P = open_port({spawn, Command}, [eof]), @@ -365,47 +341,49 @@ eof(Config) when is_list(Config) -> receive {P, closed} -> ok end, - test_server:timetrap_cancel(Dog), ok. %% Tests that the 'in' option for a port works. input_only(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(300)), + ct:timetrap({seconds, 300}), expect_input(Config, [0, 1, 10, 13, 127, 128, 255], 1, "", [in]), expect_input(Config, [0, 1, 255, 2048], 2, "", [in]), expect_input(Config, [0, 1, 255, 2048], 4, "", [in]), expect_input(Config, [0, 1, 10, 13, 127, 128, 255], 1, "", [in, binary]), - test_server:timetrap_cancel(Dog), ok. %% Tests that the 'out' option for a port works. output_only(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(100)), - Dir = ?config(priv_dir, Config), + ct:timetrap({seconds, 100}), + Dir = proplists:get_value(priv_dir, Config), + + %% First we test that the port program gets the data Filename = filename:join(Dir, "output_only_stream"), - output_and_verify(Config, Filename, "-h0", - random_packet(35777, "echo")), - test_server:timetrap_cancel(Dog), + Data = random_packet(35777, "echo"), + output_and_verify(Config, ["-h0 -o", Filename], Data), + Wait_time = 500, + test_server:sleep(Wait_time), + {ok, Written} = file:read_file(Filename), + Data = binary_to_list(Written), + + %% Then we test that any writes to stdout from + %% the port program is not sent to erlang + output_and_verify(Config, ["-h0"], Data), ok. -output_and_verify(Config, Filename, Options, Data) -> +output_and_verify(Config, Options, Data) -> PortTest = port_test(Config), - Command = lists:concat([PortTest, " ", - Options, " -o", Filename]), + Command = lists:concat([PortTest, " " | Options]), Port = open_port({spawn, Command}, [out]), Port ! {self(), {command, Data}}, Port ! {self(), close}, receive - {Port, closed} -> ok - end, - Wait_time = 500, - test_server:sleep(Wait_time), - {ok, Written} = file:read_file(Filename), - Data = binary_to_list(Written), - ok. + {Port, closed} -> ok; + Msg -> ct:fail({received_unexpected_message, Msg}) + end. %% Test that receiving several packages written in the same %% write operation works. @@ -414,11 +392,10 @@ output_and_verify(Config, Filename, Options, Data) -> %% Basic test of receiving multiple packages, written in %% one operation by the other end. mul_basic(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(600)), + ct:timetrap({minutes, 10}), expect_input(Config, [0, 1, 255, 10, 13], 1, "", []), expect_input(Config, [0, 10, 13, 1600, 32767, 65535], 2, "", []), expect_input(Config, [10, 70000], 4, "", []), - test_server:timetrap_cancel(Dog), ok. %% Test reading a buffer consisting of several packets, some @@ -427,9 +404,8 @@ mul_basic(Config) when is_list(Config) -> %% delays in between.) mul_slow_writes(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(250)), + ct:timetrap({minutes, 4}), expect_input(Config, [0, 20, 255, 10, 1], 1, "-s64", []), - test_server:timetrap_cancel(Dog), ok. %% Runs several port tests in parallell. Each individual test @@ -437,27 +413,26 @@ mul_slow_writes(Config) when is_list(Config) -> %% should also finish in about 5 seconds. parallell(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(300)), + ct:timetrap({minutes, 5}), Testers = [ - fun() -> stream_ping(Config, 1007, "-s100", []) end, - fun() -> stream_ping(Config, 10007, "-s1000", []) end, - fun() -> stream_ping(Config, 10007, "-s1000", []) end, + fun() -> stream_ping(Config, 1007, "-s100", []) end, + fun() -> stream_ping(Config, 10007, "-s1000", []) end, + fun() -> stream_ping(Config, 10007, "-s1000", []) end, - fun() -> expect_input(Config, [21, 22, 23, 24, 25], 1, - "-s10", [in]) end, + fun() -> expect_input(Config, [21, 22, 23, 24, 25], 1, + "-s10", [in]) end, - fun() -> ping(Config, [10], 1, "-d", []) end, - fun() -> ping(Config, [20000], 2, "-d", []) end, - fun() -> ping(Config, [101], 1, "-s10", []) end, - fun() -> ping(Config, [1001], 2, "-s100", []) end, - fun() -> ping(Config, [10001], 4, "-s1000", []) end, + fun() -> ping(Config, [10], 1, "-d", []) end, + fun() -> ping(Config, [20000], 2, "-d", []) end, + fun() -> ping(Config, [101], 1, "-s10", []) end, + fun() -> ping(Config, [1001], 2, "-s100", []) end, + fun() -> ping(Config, [10001], 4, "-s1000", []) end, - fun() -> ping(Config, [501, 501], 2, "-s100", []) end, - fun() -> ping(Config, [11, 12, 13, 14, 11], 1, "-s5", []) end], + fun() -> ping(Config, [501, 501], 2, "-s100", []) end, + fun() -> ping(Config, [11, 12, 13, 14, 11], 1, "-s5", []) end], process_flag(trap_exit, true), Pids = lists:map(fun fun_spawn/1, Testers), wait_for(Pids), - test_server:timetrap_cancel(Dog), ok. wait_for([]) -> @@ -465,18 +440,17 @@ wait_for([]) -> wait_for(Pids) -> io:format("Waiting for ~p", [Pids]), receive - {'EXIT', Pid, normal} -> - wait_for(lists:delete(Pid, Pids)); - Other -> - test_server:fail({bad_exit, Other}) + {'EXIT', Pid, normal} -> + wait_for(lists:delete(Pid, Pids)); + Other -> + ct:fail({bad_exit, Other}) end. %% Tests starting port programs that terminate by themselves. %% This used to cause problems on Windows. -dying_port(suite) -> []; dying_port(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(150)), + ct:timetrap({minutes, 2}), process_flag(trap_exit, true), P1 = make_dying_port(Config), @@ -497,14 +471,12 @@ dying_port(Config) when is_list(Config) -> wait_for_port_exit(P3), wait_for_port_exit(P4), wait_for_port_exit(P5), - - test_server:timetrap_cancel(Dog), ok. wait_for_port_exit(Port) -> receive - {'EXIT', Port, _} -> - ok + {'EXIT', Port, _} -> + ok end. make_dying_port(Config) when is_list(Config) -> @@ -523,22 +495,21 @@ make_dying_port(Config) when is_list(Config) -> %% %% This testcase works on Unix, but is not very useful. -port_program_with_path(suite) -> []; port_program_with_path(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(100)), - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), - + ct:timetrap({minutes, 2}), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + %% Create a copy of the port test program in a directory not %% included in PATH (i.e. in priv_dir), with the name 'my_port_test.exe'. %% Also, place a file named 'my_port_test' in the same directory. %% This used to confuse the CreateProcess() call in spawn driver. %% (On Unix, there will be a single file created, which will be %% a copy of the port program.) - + PortTest = os:find_executable("port_test", DataDir), io:format("os:find_executable(~p, ~p) returned ~p", - ["port_test", DataDir, PortTest]), + ["port_test", DataDir, PortTest]), {ok, PortTestPgm} = file:read_file(PortTest), NewName = filename:join(PrivDir, filename:basename(PortTest)), RedHerring = filename:rootname(NewName), @@ -546,12 +517,12 @@ port_program_with_path(Config) when is_list(Config) -> ok = file:write_file(NewName, PortTestPgm), ok = file:write_file_info(NewName, #file_info{mode=8#111}), PgmWithPathAndNoExt = filename:rootname(NewName), - + %% Open the port using the path to the copied port test program, %% but without the .exe extension, and verified that it was started. %% %% If the bug is present the open_port call will fail with badarg. - + Command = lists:concat([PgmWithPathAndNoExt, " -h2"]), P = open_port({spawn, Command}, [{packet, 2}]), Message = "echo back to me", @@ -560,17 +531,14 @@ port_program_with_path(Config) when is_list(Config) -> {P, {data, Message}} -> ok end, - test_server:timetrap_cancel(Dog), ok. %% Tests that files can be read using open_port(Filename, [in]). %% This used to fail on Windows. -open_input_file_port(suite) -> []; open_input_file_port(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), - PrivDir = ?config(priv_dir, Config), - + PrivDir = proplists:get_value(priv_dir, Config), + %% Create a file with the file driver and read it back using %% open_port/2. @@ -578,20 +546,18 @@ open_input_file_port(Config) when is_list(Config) -> FileData1 = "An input file", ok = file:write_file(MyFile1, FileData1), case open_port(MyFile1, [in]) of - InputPort when is_port(InputPort) -> - receive - {InputPort, {data, FileData1}} -> - ok - end + InputPort when is_port(InputPort) -> + receive + {InputPort, {data, FileData1}} -> + ok + end end, - test_server:timetrap_cancel(Dog), ok. %% Tests that files can be written using open_port(Filename, [out]). -open_output_file_port(suite) -> []; open_output_file_port(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(100)), - PrivDir = ?config(priv_dir, Config), + ct:timetrap({minutes, 2}), + PrivDir = proplists:get_value(priv_dir, Config), %% Create a file with open_port/2 and read it back with %% the file driver. @@ -606,16 +572,44 @@ open_output_file_port(Config) when is_list(Config) -> OutputPort ! {self(), close}, {ok, Bin} = file:read_file(MyFile2), FileData2 = binary_to_list(Bin), - - test_server:timetrap_cancel(Dog), ok. +%% Tests that all appropriate fd's have been closed in the port program +count_fds(Config) when is_list(Config) -> + case os:type() of + {unix, _} -> + PrivDir = proplists:get_value(priv_dir, Config), + Filename = filename:join(PrivDir, "my_fd_counter"), + + RunTest = fun(PortOpts) -> + PortTest = port_test(Config), + Command = lists:concat([PortTest, " -n -f -o", Filename]), + Port = open_port({spawn, Command}, PortOpts), + Port ! {self(), close}, + receive + {Port, closed} -> ok + end, + test_server:sleep(500), + {ok, Written} = file:read_file(Filename), + Written + end, + <<4:32/native>> = RunTest([out, nouse_stdio]), + <<4:32/native>> = RunTest([in, nouse_stdio]), + <<5:32/native>> = RunTest([in, out, nouse_stdio]), + <<3:32/native>> = RunTest([out, use_stdio]), + <<3:32/native>> = RunTest([in, use_stdio]), + <<3:32/native>> = RunTest([in, out, use_stdio]), + <<3:32/native>> = RunTest([in, out, use_stdio, stderr_to_stdout]), + <<3:32/native>> = RunTest([out, use_stdio, stderr_to_stdout]); + _ -> + {skip, "Skipped on windows"} + end. + %% %% Open as many ports as possible. Do this several times and check %% that we get the same number of ports every time. %% -iter_max_ports(suite) -> []; iter_max_ports(Config) when is_list(Config) -> %% The child_setup program might dump core if we get out of memory. %% This is hard to do anything about and is harmless. We run this test @@ -624,31 +618,30 @@ iter_max_ports(Config) when is_list(Config) -> %% Config2 = ignore_cores:setup(?MODULE, iter_max_ports, Config, true), try - iter_max_ports_test(Config2) + iter_max_ports_test(Config2) after - ignore_cores:restore(Config2) + ignore_cores:restore(Config2) end. - - + + iter_max_ports_test(Config) -> - Dog = test_server:timetrap(test_server:minutes(30)), + ct:timetrap({minutes, 30}), PortTest = port_test(Config), Command = lists:concat([PortTest, " -h0 -q"]), Iters = case os:type() of - {win32,_} -> 4; - _ -> 10 - end, + {win32,_} -> 4; + _ -> 10 + end, %% Run on a different node in order to limit the effect if this test fails. Dir = filename:dirname(code:which(?MODULE)), {ok,Node} = test_server:start_node(test_iter_max_socks,slave, - [{args,"+Q 2048 -pa " ++ Dir}]), + [{args,"+Q 2048 -pa " ++ Dir}]), L = rpc:call(Node,?MODULE,do_iter_max_ports,[Iters, Command]), test_server:stop_node(Node), io:format("Result: ~p",[L]), all_equal(L), all_equal(L), - test_server:timetrap_cancel(Dog), {comment, "Max ports: " ++ integer_to_list(hd(L))}. do_iter_max_ports(N, Command) when N > 0 -> @@ -672,46 +665,54 @@ max_ports(Command) -> close_ports([P|Ps]) -> P ! {self(), close}, receive - {P,closed} -> - ok + {P,closed} -> + ok end, close_ports(Ps); close_ports([]) -> ok. open_ports(Name, Settings) -> - test_server:sleep(5), + case os:type() of + {unix, freebsd} -> + %% FreeBsd has issues with sendmsg/recvmsg in fork + %% implementation and we therefor have to spawn + %% slower to make sure that we always hit the same + %% make roof. + test_server:sleep(10); + _ -> + test_server:sleep(5) + end, case catch open_port(Name, Settings) of - P when is_port(P) -> - [P| open_ports(Name, Settings)]; - {'EXIT', {Code, _}} -> - case Code of - enfile -> - []; - emfile -> - []; - system_limit -> - []; - enomem -> - []; - Other -> - test_server:fail({open_ports, Other}) - end; - Other -> - test_server:fail({open_ports, Other}) + P when is_port(P) -> + [P| open_ports(Name, Settings)]; + {'EXIT', {Code, _}} -> + case Code of + enfile -> + []; + emfile -> + []; + system_limit -> + []; + enomem -> + []; + Other -> + ct:fail({open_ports, Other}) + end; + Other -> + ct:fail({open_ports, Other}) end. %% Tests that exit(Port, Term) works (has been known to crash the emulator). -t_exit(suite) -> []; t_exit(Config) when is_list(Config) -> process_flag(trap_exit, true), Pid = fun_spawn(fun suicide_port/1, [Config]), receive - {'EXIT', Pid, die} -> - ok; - Other -> - test_server:fail({bad_message, Other}) + {'EXIT', Pid, die} -> + ok; + Other -> + ct:fail({bad_message, Other}) end. suicide_port(Config) when is_list(Config) -> @@ -720,118 +721,105 @@ suicide_port(Config) when is_list(Config) -> receive after infinity -> ok end. -tps_16_bytes(doc) -> ""; -tps_16_bytes(suite) -> []; tps_16_bytes(Config) when is_list(Config) -> tps(16, Config). -tps_1K(doc) -> ""; -tps_1K(suite) -> []; tps_1K(Config) when is_list(Config) -> tps(1024, Config). tps(Size, Config) -> - Dog = test_server:timetrap(test_server:seconds(300)), + ct:timetrap({minutes, 5}), PortTest = port_test(Config), Packet = list_to_binary(random_packet(Size, "e")), Port = open_port({spawn, PortTest}, [binary, {packet, 2}]), Transactions = 10000, {Elapsed, ok} = test_server:timecall(?MODULE, tps, - [Port, Packet, Transactions]), - test_server:timetrap_cancel(Dog), + [Port, Packet, Transactions]), {comment, integer_to_list(trunc(Transactions/Elapsed+0.5)) ++ " transactions/s"}. tps(_Port, _Packet, 0) -> ok; tps(Port, Packet, N) -> port_command(Port, Packet), receive - {Port, {data, Packet}} -> - tps(Port, Packet, N-1); - Other -> - test_server:fail({bad_message, Other}) + {Port, {data, Packet}} -> + tps(Port, Packet, N-1); + Other -> + ct:fail({bad_message, Other}) end. %% Line I/O test line(Config) when is_list(Config) -> + ct:timetrap({minutes, 5}), Siz = 110, - Dog = test_server:timetrap(test_server:seconds(300)), Packet1 = random_packet(Siz), Packet2 = random_packet(Siz div 2), %% Test that packets are split into lines port_expect(Config,[{lists:append([Packet1, io_lib:nl(), Packet2, - io_lib:nl()]), - [{eol, Packet1}, {eol, Packet2}]}], - 0, "", [{line,Siz}]), + io_lib:nl()]), + [{eol, Packet1}, {eol, Packet2}]}], + 0, "", [{line,Siz}]), %% Test the same for binaries port_expect(Config,[{lists:append([Packet1, io_lib:nl(), Packet2, - io_lib:nl()]), - [{eol, Packet1}, {eol, Packet2}]}], - 0, "", [{line,Siz},binary]), + io_lib:nl()]), + [{eol, Packet1}, {eol, Packet2}]}], + 0, "", [{line,Siz},binary]), %% Test that too long lines get split port_expect(Config,[{lists:append([Packet1, io_lib:nl(), Packet1, - Packet2, io_lib:nl()]), - [{eol, Packet1}, {noeol, Packet1}, - {eol, Packet2}]}], 0, "", [{line,Siz}]), + Packet2, io_lib:nl()]), + [{eol, Packet1}, {noeol, Packet1}, + {eol, Packet2}]}], 0, "", [{line,Siz}]), %% Test that last output from closing port program gets received. L1 = lists:append([Packet1, io_lib:nl(), Packet2]), S1 = lists:flatten(io_lib:format("-l~w", [length(L1)])), io:format("S1 = ~w, L1 = ~w~n", [S1,L1]), port_expect(Config,[{L1, - [{eol, Packet1}, {noeol, Packet2}, eof]}], 0, - S1, [{line,Siz},eof]), + [{eol, Packet1}, {noeol, Packet2}, eof]}], 0, + S1, [{line,Siz},eof]), %% Test that lonely <CR> Don't get treated as newlines port_expect(Config,[{lists:append([Packet1, [13], Packet2, - io_lib:nl()]), - [{noeol, Packet1}, {eol, [13 |Packet2]}]}], - 0, "", [{line,Siz}]), + io_lib:nl()]), + [{noeol, Packet1}, {eol, [13 |Packet2]}]}], + 0, "", [{line,Siz}]), %% Test that packets get built up to lines (delayed output from %% port program) port_expect(Config,[{Packet2,[]}, - {lists:append([Packet2, io_lib:nl(), - Packet1, io_lib:nl()]), - [{eol, lists:append(Packet2, Packet2)}, - {eol, Packet1}]}], 0, "-d", [{line,Siz}]), + {lists:append([Packet2, io_lib:nl(), + Packet1, io_lib:nl()]), + [{eol, lists:append(Packet2, Packet2)}, + {eol, Packet1}]}], 0, "-d", [{line,Siz}]), %% Test that we get badarg if trying both packet and line bad_argument(Config, [{packet, 5}, {line, 5}]), - test_server:timetrap_cancel(Dog), ok. -%%% Redirection of stderr test -stderr_to_stdout(suite) -> - []; -stderr_to_stdout(doc) -> - "Test that redirection of standard error to standard output works."; +%% Test that redirection of standard error to standard output works. stderr_to_stdout(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(60)), + ct:timetrap({minutes, 1}), %% See that it works Packet = random_packet(10), port_expect(Config,[{Packet,[Packet]}], 0, "-e -l10", - [stderr_to_stdout]), + [stderr_to_stdout]), %% stream_ping(Config, 10, "-e", [stderr_to_stdout]), %% See that it doesn't always happen (will generate garbage on stderr) port_expect(Config,[{Packet,[eof]}], 0, "-e -l10", [line,eof]), - test_server:timetrap_cancel(Dog), ok. bad_argument(Config, ArgList) -> PortTest = port_test(Config), case catch open_port({spawn, PortTest}, ArgList) of - {'EXIT', {badarg, _}} -> - ok + {'EXIT', {badarg, _}} -> + ok end. - + %% 'env' option %% (Can perhaps be made smaller by calling the other utility functions %% in this module.) -env(suite) -> - []; -env(doc) -> - ["Test that the 'env' option works"]; +%% +%% Test that the 'env' option works env(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(60)), - Priv = ?config(priv_dir, Config), + ct:timetrap({minutes, 1}), + Priv = proplists:get_value(priv_dir, Config), Temp = filename:join(Priv, "env_fun.bin"), PluppVal = "dirty monkey", @@ -841,36 +829,34 @@ env(Config) when is_list(Config) -> os:putenv(Long, "nisse"), env_slave(Temp, [{"plupp",PluppVal}, - {"DIR_PLUPP","###glurfrik"}], - fun() -> - PluppVal = os:getenv("plupp"), - "###glurfrik" = os:getenv("DIR_PLUPP"), - "nisse" = os:getenv(Long) - end), + {"DIR_PLUPP","###glurfrik"}], + fun() -> + PluppVal = os:getenv("plupp"), + "###glurfrik" = os:getenv("DIR_PLUPP"), + "nisse" = os:getenv(Long) + end), env_slave(Temp, [{"must_define_something","some_value"}, - {"certainly_not_existing",false}, - {"ends_with_equal", "value="}, - {Long,false}, - {"glurf","a glorfy string"}]), + {"certainly_not_existing",false}, + {"ends_with_equal", "value="}, + {Long,false}, + {"glurf","a glorfy string"}]), %% A lot of non existing variables (mingled with existing) NotExistingList = [{lists:flatten(io_lib:format("V~p_not_existing",[X])),false} - || X <- lists:seq(1,150)], + || X <- lists:seq(1,150)], ExistingList = [{lists:flatten(io_lib:format("V~p_existing",[X])),"a_value"} - || X <- lists:seq(1,150)], + || X <- lists:seq(1,150)], env_slave(Temp, lists:sort(ExistingList ++ NotExistingList)), - - test_server:timetrap_cancel(Dog), ok. env_slave(File, Env) -> F = fun() -> - lists:foreach(fun({Name,Val}) -> - Val = os:getenv(Name) - end, Env) - end, + lists:foreach(fun({Name,Val}) -> + Val = os:getenv(Name) + end, Env) + end, env_slave(File, Env, F). env_slave(File, Env, Body) -> @@ -878,27 +864,26 @@ env_slave(File, Env, Body) -> Program = atom_to_list(lib:progname()), Dir = filename:dirname(code:which(?MODULE)), Cmd = Program ++ " -pz " ++ Dir ++ - " -noinput -run " ++ ?MODULE_STRING ++ " env_slave_main " ++ - File ++ " -run erlang halt", + " -noinput -run " ++ ?MODULE_STRING ++ " env_slave_main " ++ + File ++ " -run erlang halt", Port = open_port({spawn, Cmd}, [{env,Env},{line,256}]), receive - {Port,{data,{eol,"ok"}}} -> - ok; - {Port,{data,{eol,Error}}} -> - io:format("~p\n", [Error]), - test_server:fail(); - Other -> - test_server:fail(Other) + {Port,{data,{eol,"ok"}}} -> + ok; + {Port,{data,{eol,Error}}} -> + ct:fail("eol error ~p\n", [Error]); + Other -> + ct:fail(Other) end. env_slave_main([File]) -> {ok,Body0} = file:read_file(File), Body = binary_to_term(Body0), case Body() of - {'EXIT',Reason} -> - io:format("Error: ~p\n", [Reason]); - _ -> - io:format("ok\n") + {'EXIT',Reason} -> + io:format("Error: ~p\n", [Reason]); + _ -> + io:format("ok\n") end, init:stop(). @@ -918,64 +903,114 @@ bad_env(Config) when is_list(Config) -> ok. try_bad_env(Env) -> - try open_port({spawn,"ls"}, [{env,Env}]) - catch - error:badarg -> ok + badarg = try open_port({spawn,"ls"}, [{env,Env}]) + catch + error:badarg -> badarg + end. + + +%% Test that we can handle a very very large environment gracefully. +huge_env(Config) when is_list(Config) -> + ct:timetrap({minutes, 2}), + Vars = case os:type() of + {win32,_} -> 500; + _ -> + %% We create a huge environment, + %% 20000 variables is about 25MB + %% which seems to be the limit on Linux. + 20000 + end, + Env = [{[$a + I div (25*25*25*25) rem 25, + $a + I div (25*25*25) rem 25, + $a + I div (25*25) rem 25, + $a+I div 25 rem 25, $a+I rem 25], + lists:duplicate(100,$a+I rem 25)} + || I <- lists:seq(1,Vars)], + try erlang:open_port({spawn,"ls"},[exit_status, {env, Env}]) of + P -> + receive + {P, {exit_status,N}} = M -> + %% We test that the exit status is an integer, this means + %% that the child program has started. If we get an atom + %% something went wrong in the driver which is not ok. + ct:log("Got ~p",[M]), + true = is_integer(N) + end + catch E:R -> + %% Have to catch the error here, as printing the stackdump + %% in the ct log is way to heavy for some test machines. + ct:fail("Open port failed ~p:~p",[E,R]) end. + +%% Test bad 'args' options. +bad_args(Config) when is_list(Config) -> + try_bad_args({args, [self()]}), + try_bad_args({args, ["head" | "tail"]}), + try_bad_args({args, ["head", "body" | "tail"]}), + try_bad_args({args, [<<"head">>, <<"body">> | <<"tail">>]}), + try_bad_args({args, not_a_list}), + try_bad_args({args, ["string",<<"binary">>, 1472, "string"]}), + try_bad_args({args, ["string",<<"binary">>], "element #3"}), + ok. + +try_bad_args(Args) -> + badarg = try open_port({spawn_executable,"ls"}, [Args]) + catch + error:badarg -> badarg + end. + + + %% 'cd' option %% (Can perhaps be made smaller by calling the other utility functions %% in this module.) -cd(suite) -> - []; -cd(doc) -> - ["Test that the 'cd' option works"]; +%% +%% Test that the 'cd' option works cd(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(60)), + ct:timetrap({minutes, 1}), Program = atom_to_list(lib:progname()), - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), TestDir = filename:join(DataDir, "dir"), Cmd = Program ++ " -pz " ++ DataDir ++ - " -noshell -s port_test pwd -s erlang halt", + " -noshell -s port_test pwd -s erlang halt", _ = open_port({spawn, Cmd}, - [{cd, TestDir}, - {line, 256}]), + [{cd, TestDir}, + {line, 256}]), receive - {_, {data, {eol, String}}} -> - case filename_equal(String, TestDir) of - true -> - ok; - false -> - test_server:fail({cd, String}) - end; - Other2 -> - test_server:fail({env, Other2}) + {_, {data, {eol, String}}} -> + case filename_equal(String, TestDir) of + true -> + ok; + false -> + ct:fail({cd, String}) + end; + Other2 -> + ct:fail({env, Other2}) end, _ = open_port({spawn, Cmd}, - [{cd, unicode:characters_to_binary(TestDir)}, - {line, 256}]), + [{cd, unicode:characters_to_binary(TestDir)}, + {line, 256}]), receive - {_, {data, {eol, String2}}} -> - case filename_equal(String2, TestDir) of - true -> - ok; - false -> - test_server:fail({cd, String2}) - end; - Other3 -> - test_server:fail({env, Other3}) + {_, {data, {eol, String2}}} -> + case filename_equal(String2, TestDir) of + true -> + ok; + false -> + ct:fail({cd, String2}) + end; + Other3 -> + ct:fail({env, Other3}) end, - - test_server:timetrap_cancel(Dog), ok. filename_equal(A, B) -> case os:type() of - {win32, _} -> - win_filename_equal(A, B); - _ -> - A == B + {win32, _} -> + win_filename_equal(A, B); + _ -> + A == B end. win_filename_equal([], []) -> @@ -986,10 +1021,10 @@ win_filename_equal(_, []) -> false; win_filename_equal([C1 | Rest1], [C2 | Rest2]) -> case tolower(C1) == tolower(C2) of - true -> - win_filename_equal(Rest1, Rest2); - false -> - false + true -> + win_filename_equal(Rest1, Rest2); + false -> + false end. tolower(C) when C >= $A, C =< $Z -> @@ -997,17 +1032,14 @@ tolower(C) when C >= $A, C =< $Z -> tolower(C) -> C. -otp_3906(suite) -> - []; -otp_3906(doc) -> - ["Tests that child process deaths are managed correctly when there are " - " a large amount of concurrently dying children. See ticket OTP-3906."]; +%% Tests that child process deaths are managed correctly when there are +%% a large amount of concurrently dying children. See ticket OTP-3906. otp_3906(Config) when is_list(Config) -> case os:type() of - {unix, OSName} -> - otp_3906(Config, OSName); - _ -> - {skipped, "Only run on Unix systems"} + {unix, OSName} -> + otp_3906(Config, OSName); + _ -> + {skipped, "Only run on Unix systems"} end. -define(OTP_3906_CHILDREN, 1000). @@ -1020,83 +1052,83 @@ otp_3906(Config) when is_list(Config) -> otp_3906(Config, OSName) -> DataDir = filename:dirname(proplists:get_value(data_dir,Config)), {ok, Variables} = file:consult( - filename:join([DataDir,"..","..", - "test_server","variables"])), + filename:join([DataDir,"..","..", + "test_server","variables"])), case lists:keysearch('CC', 1, Variables) of - {value,{'CC', CC}} -> - SuiteDir = filename:dirname(code:which(?MODULE)), - PrivDir = ?config(priv_dir, Config), - Prog = otp_3906_make_prog(CC, PrivDir), - {ok, Node} = test_server:start_node(otp_3906, - slave, - [{args, " -pa " ++ SuiteDir}, - {linked, false}]), - OP = process_flag(priority, max), - OTE = process_flag(trap_exit, true), - FS = spawn_link(Node, - ?MODULE, - otp_3906_start_forker_starter, - [?OTP_3906_CHILDREN, [], self(), Prog]), - Result = receive - {'EXIT', _ForkerStarter, Reason} -> - {failed, Reason}; - {emulator_pid, EmPid} -> - case otp_3906_wait_result(FS, 0, 0) of - {succeded, - ?OTP_3906_CHILDREN, - ?OTP_3906_CHILDREN} -> - succeded; - {succeded, Forked, Exited} -> - otp_3906_list_defunct(EmPid, OSName), - {failed, - {mismatch, - {forked, Forked}, - {exited, Exited}}}; - Res -> - otp_3906_list_defunct(EmPid, OSName), - Res - end - end, - process_flag(trap_exit, OTE), - process_flag(priority, OP), - test_server:stop_node(Node), - case Result of - succeded -> - ok; - _ -> - test_server:fail(Result) - end; - _ -> - {skipped, "No C compiler found"} + {value,{'CC', CC}} -> + SuiteDir = filename:dirname(code:which(?MODULE)), + PrivDir = proplists:get_value(priv_dir, Config), + Prog = otp_3906_make_prog(CC, PrivDir), + {ok, Node} = test_server:start_node(otp_3906, + slave, + [{args, " -pa " ++ SuiteDir}, + {linked, false}]), + OP = process_flag(priority, max), + OTE = process_flag(trap_exit, true), + FS = spawn_link(Node, + ?MODULE, + otp_3906_start_forker_starter, + [?OTP_3906_CHILDREN, [], self(), Prog]), + Result = receive + {'EXIT', _ForkerStarter, Reason} -> + {failed, Reason}; + {emulator_pid, EmPid} -> + case otp_3906_wait_result(FS, 0, 0) of + {succeded, + ?OTP_3906_CHILDREN, + ?OTP_3906_CHILDREN} -> + succeded; + {succeded, Forked, Exited} -> + otp_3906_list_defunct(EmPid, OSName), + {failed, + {mismatch, + {forked, Forked}, + {exited, Exited}}}; + Res -> + otp_3906_list_defunct(EmPid, OSName), + Res + end + end, + process_flag(trap_exit, OTE), + process_flag(priority, OP), + test_server:stop_node(Node), + case Result of + succeded -> + ok; + _ -> + ct:fail(Result) + end; + _ -> + {skipped, "No C compiler found"} end. otp_3906_list_defunct(EmPid, OSName) -> % Guess ps switches to use and what to grep for (could be improved) {Switches, Zombie} = case OSName of - BSD when BSD == darwin; - BSD == openbsd; - BSD == netbsd; - BSD == freebsd -> - {"-ajx", "Z"}; - _ -> - {"-ef", "[dD]efunct"} - end, - test_server:format("Emulator pid: ~s~n" - "Listing of zombie processes:~n" - "~s~n", - [EmPid, - otp_3906_htmlize(os:cmd("ps " - ++ Switches - ++ " | grep " - ++ Zombie))]). + BSD when BSD == darwin; + BSD == openbsd; + BSD == netbsd; + BSD == freebsd -> + {"-ajx", "Z"}; + _ -> + {"-ef", "[dD]efunct"} + end, + io:format("Emulator pid: ~s~n" + "Listing of zombie processes:~n" + "~s~n", + [EmPid, + otp_3906_htmlize(os:cmd("ps " + ++ Switches + ++ " | grep " + ++ Zombie))]). otp_3906_htmlize([]) -> []; otp_3906_htmlize([C | Cs]) -> case [C] of - "<" -> "<" ++ otp_3906_htmlize(Cs); - ">" -> ">" ++ otp_3906_htmlize(Cs); - _ -> [C | otp_3906_htmlize(Cs)] + "<" -> "<" ++ otp_3906_htmlize(Cs); + ">" -> ">" ++ otp_3906_htmlize(Cs); + _ -> [C | otp_3906_htmlize(Cs)] end. otp_3906_make_prog(CC, PrivDir) -> @@ -1104,12 +1136,12 @@ otp_3906_make_prog(CC, PrivDir) -> TrgtFileName = filename:join(PrivDir, ?OTP_3906_PROGNAME), {ok, SrcFile} = file:open(SrcFileName, write), io:format(SrcFile, - "int ~n" - "main(void) ~n" - "{ ~n" - " return ~p; ~n" - "} ~n", - [?OTP_3906_EXIT_STATUS]), + "int ~n" + "main(void) ~n" + "{ ~n" + " return ~p; ~n" + "} ~n", + [?OTP_3906_EXIT_STATUS]), file:close(SrcFile), os:cmd(CC ++ " " ++ SrcFileName ++ " -o " ++ TrgtFileName), TrgtFileName. @@ -1117,21 +1149,21 @@ otp_3906_make_prog(CC, PrivDir) -> otp_3906_wait_result(ForkerStarter, F, E) -> receive - {'EXIT', ForkerStarter, Reason} -> - {failed, {Reason, {forked, F}, {exited, E}}}; - forked -> - otp_3906_wait_result(ForkerStarter, F+1, E); - exited -> - otp_3906_wait_result(ForkerStarter, F, E+1); - tick -> - otp_3906_wait_result(ForkerStarter, F, E); - succeded -> - {succeded, F, E} + {'EXIT', ForkerStarter, Reason} -> + {failed, {Reason, {forked, F}, {exited, E}}}; + forked -> + otp_3906_wait_result(ForkerStarter, F+1, E); + exited -> + otp_3906_wait_result(ForkerStarter, F, E+1); + tick -> + otp_3906_wait_result(ForkerStarter, F, E); + succeded -> + {succeded, F, E} after - ?OTP_3906_TICK_TIMEOUT -> - unlink(ForkerStarter), - exit(ForkerStarter, timeout), - {failed, {timeout, {forked, F}, {exited, E}}} + ?OTP_3906_TICK_TIMEOUT -> + unlink(ForkerStarter), + exit(ForkerStarter, timeout), + {failed, {timeout, {forked, F}, {exited, E}}} end. otp_3906_collect([], _) -> @@ -1141,17 +1173,17 @@ otp_3906_collect(RefList, Sup) -> otp_3906_collect_one(RefList, Sup) -> receive - Ref when is_reference(Ref) -> - Sup ! tick, - lists:delete(Ref, RefList) + Ref when is_reference(Ref) -> + Sup ! tick, + lists:delete(Ref, RefList) end. - + otp_3906_start_forker(N, Sup, Prog) -> Ref = make_ref(), spawn_opt(?MODULE, - otp_3906_forker, - [N, self(), Ref, Sup, Prog], - [link, {priority, max}]), + otp_3906_forker, + [N, self(), Ref, Sup, Prog], + [link, {priority, max}]), Ref. otp_3906_start_forker_starter(N, RefList, Sup, Prog) -> @@ -1170,18 +1202,18 @@ otp_3906_forker_starter(N, RefList, Sup, Prog) otp_3906_forker_starter(N, RefList, Sup, Prog) when is_integer(N), N > ?OTP_3906_OSP_P_ERLP -> otp_3906_forker_starter(N-?OTP_3906_OSP_P_ERLP, - [otp_3906_start_forker(?OTP_3906_OSP_P_ERLP, - Sup, - Prog)|RefList], - Sup, - Prog); + [otp_3906_start_forker(?OTP_3906_OSP_P_ERLP, + Sup, + Prog)|RefList], + Sup, + Prog); otp_3906_forker_starter(N, RefList, Sup, Prog) when is_integer(N) -> otp_3906_forker_starter(0, - [otp_3906_start_forker(N, - Sup, - Prog)|RefList], - Sup, - Prog). + [otp_3906_start_forker(N, + Sup, + Prog)|RefList], + Sup, + Prog). otp_3906_forker(0, Parent, Ref, _, _) -> unlink(Parent), @@ -1190,183 +1222,165 @@ otp_3906_forker(N, Parent, Ref, Sup, Prog) -> Port = erlang:open_port({spawn, Prog}, [exit_status, in]), Sup ! forked, receive - {Port, {exit_status, ?OTP_3906_EXIT_STATUS}} -> - Sup ! exited, - otp_3906_forker(N-1, Parent, Ref, Sup, Prog); - {Port, Res} -> - exit(Res); - Other -> - exit(Other) + {Port, {exit_status, ?OTP_3906_EXIT_STATUS}} -> + Sup ! exited, + otp_3906_forker(N-1, Parent, Ref, Sup, Prog); + {Port, Res} -> + exit(Res); + Other -> + exit(Other) end. -otp_4389(suite) -> []; -otp_4389(doc) -> []; otp_4389(Config) when is_list(Config) -> case os:type() of - {unix, _} -> - Dog = test_server:timetrap(test_server:seconds(240)), - TCR = self(), - case get_true_cmd() of - True when is_list(True) -> - lists:foreach( - fun (P) -> - receive - {P, ok} -> ok; - {P, Err} -> ?t:fail(Err) - end - end, - lists:map( - fun(_) -> - spawn_link( - fun() -> - process_flag(trap_exit, true), - case catch open_port({spawn, True}, - [stream,exit_status]) of - P when is_port(P) -> - receive - {P,{exit_status,_}} -> - TCR ! {self(),ok}; - {'EXIT',_,{R2,_}} when R2 == emfile; - R2 == eagain -> - TCR ! {self(),ok}; - Err2 -> - TCR ! {self(),{msg,Err2}} - end; - {'EXIT',{R1,_}} when R1 == emfile; - R1 == eagain -> - TCR ! {self(),ok}; - Err1 -> - TCR ! {self(), {open_port,Err1}} - end - end) - end, - lists:duplicate(1000,[]))), - test_server:timetrap_cancel(Dog), - {comment, - "This test case doesn't always fail when the bug that " - "it tests for is present (it is most likely to fail on" - " a multi processor machine). If the test case fails it" - " will fail by deadlocking the emulator."}; - _ -> - {skipped, "\"true\" command not found"} - end; - _ -> - {skip,"Only run on Unix"} + {unix, _} -> + ct:timetrap({minutes, 4}), + TCR = self(), + case get_true_cmd() of + True when is_list(True) -> + lists:foreach( + fun (P) -> + receive + {P, ok} -> ok; + {P, Err} -> ct:fail(Err) + end + end, + lists:map( + fun(_) -> + spawn_link( + fun() -> + process_flag(trap_exit, true), + case catch open_port({spawn, True}, + [stream,exit_status]) of + P when is_port(P) -> + receive + {P,{exit_status,_}} -> + TCR ! {self(),ok}; + {'EXIT',_,{R2,_}} when R2 == emfile; + R2 == eagain; + R2 == enomem -> + TCR ! {self(),ok}; + Err2 -> + TCR ! {self(),{msg,Err2}} + end; + {'EXIT',{R1,_}} when R1 == emfile; + R1 == eagain; + R1 == enomem -> + TCR ! {self(),ok}; + Err1 -> + TCR ! {self(), {open_port,Err1}} + end + end) + end, + lists:duplicate(1000,[]))), + {comment, + "This test case doesn't always fail when the bug that " + "it tests for is present (it is most likely to fail on" + " a multi processor machine). If the test case fails it" + " will fail by deadlocking the emulator."}; + _ -> + {skipped, "\"true\" command not found"} + end; + _ -> + {skip,"Only run on Unix"} end. get_true_cmd() -> DoFileExist = fun (FileName) -> - case file:read_file_info(FileName) of - {ok, _} -> throw(FileName); - _ -> not_found - end - end, + case file:read_file_info(FileName) of + {ok, _} -> throw(FileName); + _ -> not_found + end + end, catch begin - %% First check in /usr/bin and /bin - DoFileExist("/usr/bin/true"), - DoFileExist("/bin/true"), - %% Try which - case filename:dirname(os:cmd("which true")) of - "." -> not_found; - TrueDir -> filename:join(TrueDir, "true") - end - end. + %% First check in /usr/bin and /bin + DoFileExist("/usr/bin/true"), + DoFileExist("/bin/true"), + %% Try which + case filename:dirname(os:cmd("which true")) of + "." -> not_found; + TrueDir -> filename:join(TrueDir, "true") + end + end. %% 'exit_status' option -exit_status(suite) -> - []; -exit_status(doc) -> - ["Test that the 'exit_status' option works"]; +%% +%% Test that the 'exit_status' option works exit_status(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(60)), - port_expect(Config,[{"x", - [{exit_status, 5}]}], - 1, "", [exit_status]), - test_server:timetrap_cancel(Dog), + ct:timetrap({minutes, 1}), + port_expect(Config, + [{"x", [{exit_status, 5}]}], + 1, "", [exit_status]), ok. -spawn_driver(suite) -> - []; -spawn_driver(doc) -> - ["Test spawning a driver specifically"]; +%% Test spawning a driver specifically spawn_driver(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), ok = load_driver(Path, "echo_drv"), Port = erlang:open_port({spawn_driver, "echo_drv"}, []), Port ! {self(), {command, "Hello port!"}}, receive - {Port, {data, "Hello port!"}} = Msg1 -> - io:format("~p~n", [Msg1]), - ok; - Other -> - test_server:fail({unexpected, Other}) - end, + {Port, {data, "Hello port!"}} = Msg1 -> + io:format("~p~n", [Msg1]), + ok; + Other -> + ct:fail({unexpected, Other}) + end, Port ! {self(), close}, receive {Port, closed} -> ok end, Port2 = erlang:open_port({spawn_driver, "echo_drv -Hello port?"}, - []), + []), receive - {Port2, {data, "Hello port?"}} = Msg2 -> - io:format("~p~n", [Msg2]), - ok; - Other2 -> - test_server:fail({unexpected2, Other2}) - end, + {Port2, {data, "Hello port?"}} = Msg2 -> + io:format("~p~n", [Msg2]), + ok; + Other2 -> + ct:fail({unexpected2, Other2}) + end, Port2 ! {self(), close}, receive {Port2, closed} -> ok end, {'EXIT',{badarg,_}} = (catch erlang:open_port({spawn_driver, "ls"}, [])), {'EXIT',{badarg,_}} = (catch erlang:open_port({spawn_driver, "cmd"}, [])), {'EXIT',{badarg,_}} = (catch erlang:open_port({spawn_driver, os:find_executable("erl")}, [])), - test_server:timetrap_cancel(Dog), ok. -parallelism_option(suite) -> - []; -parallelism_option(doc) -> - ["Test parallelism option of open_port"]; +%% Test parallelism option of open_port parallelism_option(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Path = ?config(data_dir, Config), - ?line ok = load_driver(Path, "echo_drv"), - ?line Port = erlang:open_port({spawn_driver, "echo_drv"}, - [{parallelism, true}]), - ?line {parallelism, true} = erlang:port_info(Port, parallelism), - ?line Port ! {self(), {command, "Hello port!"}}, - ?line receive - {Port, {data, "Hello port!"}} = Msg1 -> - io:format("~p~n", [Msg1]), - ok; - Other -> - test_server:fail({unexpected, Other}) - end, - ?line Port ! {self(), close}, - ?line receive {Port, closed} -> ok end, - - ?line Port2 = erlang:open_port({spawn_driver, "echo_drv -Hello port?"}, - [{parallelism, false}]), - ?line {parallelism, false} = erlang:port_info(Port2, parallelism), - ?line receive - {Port2, {data, "Hello port?"}} = Msg2 -> - io:format("~p~n", [Msg2]), - ok; - Other2 -> - test_server:fail({unexpected2, Other2}) - end, - ?line Port2 ! {self(), close}, - ?line receive {Port2, closed} -> ok end, - ?line test_server:timetrap_cancel(Dog), + Path = proplists:get_value(data_dir, Config), + ok = load_driver(Path, "echo_drv"), + Port = erlang:open_port({spawn_driver, "echo_drv"}, + [{parallelism, true}]), + {parallelism, true} = erlang:port_info(Port, parallelism), + Port ! {self(), {command, "Hello port!"}}, + receive + {Port, {data, "Hello port!"}} = Msg1 -> + io:format("~p~n", [Msg1]), + ok; + Other -> + ct:fail({unexpected, Other}) + end, + Port ! {self(), close}, + receive {Port, closed} -> ok end, + + Port2 = erlang:open_port({spawn_driver, "echo_drv -Hello port?"}, + [{parallelism, false}]), + {parallelism, false} = erlang:port_info(Port2, parallelism), + receive + {Port2, {data, "Hello port?"}} = Msg2 -> + io:format("~p~n", [Msg2]), + ok; + Other2 -> + ct:fail({unexpected2, Other2}) + end, + Port2 ! {self(), close}, + receive {Port2, closed} -> ok end, ok. -spawn_executable(suite) -> - []; -spawn_executable(doc) -> - ["Test spawning an executable specifically"]; +%% Test spawning an executable specifically spawn_executable(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), EchoArgs1 = filename:join([DataDir,"echo_args"]), ExactFile1 = filename:nativename(os:find_executable(EchoArgs1)), [ExactFile1] = run_echo_args(DataDir,[]), @@ -1376,25 +1390,25 @@ spawn_executable(Config) when is_list(Config) -> ["echo_arguments"] = run_echo_args(DataDir,["echo_arguments"]), ["echo_arguments"] = run_echo_args(DataDir,[binary, "echo_arguments"]), [ExactFile1,"hello world","dlrow olleh"] = - run_echo_args(DataDir,[ExactFile1,"hello world","dlrow olleh"]), + run_echo_args(DataDir,[ExactFile1,"hello world","dlrow olleh"]), [ExactFile1] = run_echo_args(DataDir,[default]), [ExactFile1] = run_echo_args(DataDir,[binary, default]), [ExactFile1,"hello world","dlrow olleh"] = - run_echo_args(DataDir,[switch_order,ExactFile1,"hello world", - "dlrow olleh"]), + run_echo_args(DataDir,[switch_order,ExactFile1,"hello world", + "dlrow olleh"]), [ExactFile1,"hello world","dlrow olleh"] = - run_echo_args(DataDir,[binary,switch_order,ExactFile1,"hello world", - "dlrow olleh"]), + run_echo_args(DataDir,[binary,switch_order,ExactFile1,"hello world", + "dlrow olleh"]), [ExactFile1,"hello world","dlrow olleh"] = - run_echo_args(DataDir,[default,"hello world","dlrow olleh"]), + run_echo_args(DataDir,[default,"hello world","dlrow olleh"]), [ExactFile1,"hello world","dlrow olleh"] = - run_echo_args_2("\""++ExactFile1++"\" "++"\"hello world\" \"dlrow olleh\""), + run_echo_args_2("\""++ExactFile1++"\" "++"\"hello world\" \"dlrow olleh\""), [ExactFile1,"hello world","dlrow olleh"] = - run_echo_args_2(unicode:characters_to_binary("\""++ExactFile1++"\" "++"\"hello world\" \"dlrow olleh\"")), + run_echo_args_2(unicode:characters_to_binary("\""++ExactFile1++"\" "++"\"hello world\" \"dlrow olleh\"")), - PrivDir = ?config(priv_dir, Config), - SpaceDir =filename:join([PrivDir,"With Spaces"]), + PrivDir = proplists:get_value(priv_dir, Config), + SpaceDir = filename:join([PrivDir,"With Spaces"]), file:make_dir(SpaceDir), Executable = filename:basename(ExactFile1), file:copy(ExactFile1,filename:join([SpaceDir,Executable])), @@ -1405,33 +1419,32 @@ spawn_executable(Config) when is_list(Config) -> ["echo_args"] = run_echo_args(SpaceDir,["echo_args"]), ["echo_arguments"] = run_echo_args(SpaceDir,["echo_arguments"]), [ExactFile2,"hello world","dlrow olleh"] = - run_echo_args(SpaceDir,[ExactFile2,"hello world","dlrow olleh"]), + run_echo_args(SpaceDir,[ExactFile2,"hello world","dlrow olleh"]), [ExactFile2,"hello world","dlrow olleh"] = - run_echo_args(SpaceDir,[binary, 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"]), + 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"]), + 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", - "dlrow olleh"]), + run_echo_args(SpaceDir,[switch_order,ExactFile2,"hello world", "dlrow olleh"]), [ExactFile2,"hello world","dlrow olleh"] = - run_echo_args(SpaceDir,[default,"hello world","dlrow olleh"]), + run_echo_args(SpaceDir,[default,"hello world","dlrow olleh"]), [ExactFile2,"hello world","dlrow olleh"] = - run_echo_args_2("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\""), + run_echo_args_2("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\""), [ExactFile2,"hello world","dlrow olleh"] = - run_echo_args_2(unicode:characters_to_binary("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\"")), + run_echo_args_2(unicode:characters_to_binary("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\"")), ExeExt = - case string:to_lower(lists:last(string:tokens(ExactFile2,"."))) of - "exe" -> - ".exe"; - _ -> - "" - end, + case string:to_lower(lists:last(string:tokens(ExactFile2,"."))) of + "exe" -> + ".exe"; + _ -> + "" + end, Executable2 = "spoky name"++ExeExt, file:copy(ExactFile1,filename:join([SpaceDir,Executable2])), ExactFile3 = filename:nativename(filename:join([SpaceDir,Executable2])), @@ -1440,38 +1453,37 @@ spawn_executable(Config) when is_list(Config) -> ["echo_args"] = run_echo_args(SpaceDir,Executable2,["echo_args"]), ["echo_arguments"] = run_echo_args(SpaceDir,Executable2,["echo_arguments"]), [ExactFile3,"hello world","dlrow olleh"] = - run_echo_args(SpaceDir,Executable2,[ExactFile3,"hello world","dlrow olleh"]), + run_echo_args(SpaceDir,Executable2,[ExactFile3,"hello world","dlrow olleh"]), [ExactFile3] = run_echo_args(SpaceDir,Executable2,[default]), [ExactFile3,"hello world","dlrow olleh"] = - run_echo_args(SpaceDir,Executable2, - [switch_order,ExactFile3,"hello world", - "dlrow olleh"]), + run_echo_args(SpaceDir,Executable2, + [switch_order,ExactFile3,"hello world", + "dlrow olleh"]), [ExactFile3,"hello world","dlrow olleh"] = - run_echo_args(SpaceDir,Executable2, - [default,"hello world","dlrow olleh"]), + run_echo_args(SpaceDir,Executable2, + [default,"hello world","dlrow olleh"]), [ExactFile3,"hello world","dlrow olleh"] = - run_echo_args_2("\""++ExactFile3++"\" "++"\"hello world\" \"dlrow olleh\""), + run_echo_args_2("\""++ExactFile3++"\" "++"\"hello world\" \"dlrow olleh\""), [ExactFile3,"hello world","dlrow olleh"] = - run_echo_args_2(unicode:characters_to_binary("\""++ExactFile3++"\" "++"\"hello world\" \"dlrow olleh\"")), + run_echo_args_2(unicode:characters_to_binary("\""++ExactFile3++"\" "++"\"hello world\" \"dlrow olleh\"")), {'EXIT',{enoent,_}} = (catch run_echo_args(SpaceDir,"fnurflmonfi", - [default,"hello world", - "dlrow olleh"])), + [default,"hello world", + "dlrow olleh"])), NonExec = "kronxfrt"++ExeExt, file:write_file(filename:join([SpaceDir,NonExec]), - <<"Not an executable">>), + <<"Not an executable">>), {'EXIT',{eacces,_}} = (catch run_echo_args(SpaceDir,NonExec, - [default,"hello world", - "dlrow olleh"])), + [default,"hello world", + "dlrow olleh"])), {'EXIT',{enoent,_}} = (catch open_port({spawn_executable,"cmd"},[])), {'EXIT',{enoent,_}} = (catch open_port({spawn_executable,"sh"},[])), case os:type() of - {win32,_} -> - test_bat_file(SpaceDir); - {unix,_} -> - test_sh_file(SpaceDir) + {win32,_} -> + test_bat_file(SpaceDir); + {unix,_} -> + test_sh_file(SpaceDir) end, - test_server:timetrap_cancel(Dog), ok. unregister_name(Config) when is_list(Config) -> @@ -1482,29 +1494,29 @@ test_bat_file(Dir) -> FN = "tf.bat", Full = filename:join([Dir,FN]), D = [<<"@echo off\r\n">>, - <<"echo argv[0]:^|%0^|\r\n">>, - <<"if \"%1\" == \"\" goto done\r\n">>, - <<"echo argv[1]:^|%1^|\r\n">>, - <<"if \"%2\" == \"\" goto done\r\n">>, - <<"echo argv[2]:^|%2^|\r\n">>, - <<"if \"%3\" == \"\" goto done\r\n">>, - <<"echo argv[3]:^|%3^|\r\n">>, - <<"if \"%4\" == \"\" goto done\r\n">>, - <<"echo argv[4]:^|%4^|\r\n">>, - <<"if \"%5\" == \"\" goto done\r\n">>, - <<"echo argv[5]:^|%5^|\r\n">>, - <<"\r\n">>, - <<":done\r\n">>, - <<"\r\n">>], + <<"echo argv[0]:^|%0^|\r\n">>, + <<"if \"%1\" == \"\" goto done\r\n">>, + <<"echo argv[1]:^|%1^|\r\n">>, + <<"if \"%2\" == \"\" goto done\r\n">>, + <<"echo argv[2]:^|%2^|\r\n">>, + <<"if \"%3\" == \"\" goto done\r\n">>, + <<"echo argv[3]:^|%3^|\r\n">>, + <<"if \"%4\" == \"\" goto done\r\n">>, + <<"echo argv[4]:^|%4^|\r\n">>, + <<"if \"%5\" == \"\" goto done\r\n">>, + <<"echo argv[5]:^|%5^|\r\n">>, + <<"\r\n">>, + <<":done\r\n">>, + <<"\r\n">>], file:write_file(Full,list_to_binary(D)), EF = filename:basename(FN), [DN,"hello","world"] = - run_echo_args(Dir,FN, - [default,"hello","world"]), + run_echo_args(Dir,FN, + [default,"hello","world"]), %% The arg0 argumant should be ignored when running batch files [DN,"hello","world"] = - run_echo_args(Dir,FN, - ["knaskurt","hello","world"]), + run_echo_args(Dir,FN, + ["knaskurt","hello","world"]), EF = filename:basename(DN), ok. @@ -1512,40 +1524,40 @@ test_sh_file(Dir) -> FN = "tf.sh", Full = filename:join([Dir,FN]), D = [<<"#! /bin/sh\n">>, - <<"echo 'argv[0]:|'$0'|'\n">>, - <<"i=1\n">>, - <<"while [ '!' -z \"$1\" ]; do\n">>, - <<" echo 'argv['$i']:|'\"$1\"'|'\n">>, - <<" shift\n">>, - <<" i=`expr $i + 1`\n">>, - <<"done\n">>], + <<"echo 'argv[0]:|'$0'|'\n">>, + <<"i=1\n">>, + <<"while [ '!' -z \"$1\" ]; do\n">>, + <<" echo 'argv['$i']:|'\"$1\"'|'\n">>, + <<" shift\n">>, + <<" i=`expr $i + 1`\n">>, + <<"done\n">>], file:write_file(Full,list_to_binary(D)), chmodplusx(Full), [Full,"hello","world"] = - run_echo_args(Dir,FN, - [default,"hello","world"]), + run_echo_args(Dir,FN, + [default,"hello","world"]), [Full,"hello","world of spaces"] = - run_echo_args(Dir,FN, - [default,"hello","world of spaces"]), + run_echo_args(Dir,FN, + [default,"hello","world of spaces"]), file:write_file(filename:join([Dir,"testfile1"]),<<"testdata1">>), file:write_file(filename:join([Dir,"testfile2"]),<<"testdata2">>), Pattern = filename:join([Dir,"testfile*"]), L = filelib:wildcard(Pattern), 2 = length(L), [Full,"hello",Pattern] = - run_echo_args(Dir,FN, - [default,"hello",Pattern]), - ok. + run_echo_args(Dir,FN, + [default,"hello",Pattern]), + ok. + - chmodplusx(Filename) -> case file:read_file_info(Filename) of - {ok,FI} -> - FI2 = FI#file_info{mode = ((FI#file_info.mode) bor 8#00100)}, - file:write_file_info(Filename,FI2); - _ -> - ok + {ok,FI} -> + FI2 = FI#file_info{mode = ((FI#file_info.mode) bor 8#00100)}, + file:write_file_info(Filename,FI2); + _ -> + ok end. run_echo_args_2(FullnameAndArgs) -> @@ -1554,7 +1566,7 @@ run_echo_args_2(FullnameAndArgs) -> Port ! {self(), close}, receive {Port, closed} -> ok end, parse_echo_args_output(Data). - + run_echo_args(Where,Args) -> run_echo_args(Where,"echo_args",Args). @@ -1562,9 +1574,9 @@ run_echo_args(Where,Prog,Args) -> {Binary, ArgvArg} = pack_argv(Args), Command0 = filename:join([Where,Prog]), Command = case Binary of - true -> unicode:characters_to_binary(Command0); - false -> Command0 - end, + true -> unicode:characters_to_binary(Command0); + false -> Command0 + end, Port = open_port({spawn_executable,Command},ArgvArg++[eof]), Data = collect_data(Port), Port ! {self(), close}, @@ -1578,14 +1590,14 @@ pack_argv(Args) -> pack_argv(Args, Binary) -> case Args of - [] -> - []; - [default|T] -> - [{args,[make_bin(Arg,Binary) || Arg <- T]}]; - [switch_order,H|T] -> - [{args,[make_bin(Arg,Binary) || Arg <- T]},{arg0,make_bin(H,Binary)}]; - [H|T] -> - [{arg0,make_bin(H,Binary)},{args,[make_bin(Arg,Binary) || Arg <- T]}] + [] -> + []; + [default|T] -> + [{args,[make_bin(Arg,Binary) || Arg <- T]}]; + [switch_order,H|T] -> + [{args,[make_bin(Arg,Binary) || Arg <- T]},{arg0,make_bin(H,Binary)}]; + [H|T] -> + [{arg0,make_bin(H,Binary)},{args,[make_bin(Arg,Binary) || Arg <- T]}] end. make_bin(Str, false) -> Str; @@ -1593,54 +1605,49 @@ make_bin(Str, true) -> unicode:characters_to_binary(Str). collect_data(Port) -> receive - {Port, {data, Data}} -> - Data ++ collect_data(Port); - {Port, eof} -> - [] + {Port, {data, Data}} -> + Data ++ collect_data(Port); + {Port, eof} -> + [] end. parse_echo_args_output(Data) -> [lists:last(string:tokens(S,"|")) || S <- string:tokens(Data,"\r\n")]. -mix_up_ports(suite) -> - []; -mix_up_ports(doc) -> - ["Test that the emulator does not mix up ports when the port table wraps"]; +%% Test that the emulator does not mix up ports when the port table wraps mix_up_ports(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), ok = load_driver(Path, "echo_drv"), Port = erlang:open_port({spawn, "echo_drv"}, []), Port ! {self(), {command, "Hello port!"}}, receive - {Port, {data, "Hello port!"}} = Msg1 -> - io:format("~p~n", [Msg1]), - ok; - Other -> - test_server:fail({unexpected, Other}) - end, + {Port, {data, "Hello port!"}} = Msg1 -> + io:format("~p~n", [Msg1]), + ok; + Other -> + ct:fail({unexpected, Other}) + end, Port ! {self(), close}, receive {Port, closed} -> ok end, loop(start, done, - fun(P) -> - Q = - (catch erlang:open_port({spawn, "echo_drv"}, [])), -%% io:format("~p ", [Q]), - if is_port(Q) -> - Q; - true -> - io:format("~p~n", [P]), - done - end - end), + fun(P) -> + Q = + (catch erlang:open_port({spawn, "echo_drv"}, [])), + %% io:format("~p ", [Q]), + if is_port(Q) -> + Q; + true -> + io:format("~p~n", [P]), + done + end + end), Port ! {self(), {command, "Hello again port!"}}, receive - Msg2 -> - test_server:fail({unexpected, Msg2}) - after 1000 -> - ok - end, - test_server:timetrap_cancel(Dog), + Msg2 -> + ct:fail({unexpected, Msg2}) + after 1000 -> + ok + end, ok. loop(Stop, Stop, Fun) when is_function(Fun) -> @@ -1649,131 +1656,118 @@ loop(Start, Stop, Fun) when is_function(Fun) -> loop(Fun(Start), Stop, Fun). -otp_5112(suite) -> - []; -otp_5112(doc) -> - ["Test that link to connected process is taken away when port calls", - "driver_exit() also when the port index has wrapped"]; +%% Test that link to connected process is taken away when port calls +%% driver_exit() also when the port index has wrapped otp_5112(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), ok = load_driver(Path, "exit_drv"), Port = otp_5112_get_wrapped_port(), - ?t:format("Max ports: ~p~n",[max_ports()]), - ?t:format("Port: ~p~n",[Port]), + io:format("Max ports: ~p~n",[max_ports()]), + io:format("Port: ~p~n",[Port]), {links, Links1} = process_info(self(),links), - ?t:format("Links1: ~p~n",[Links1]), + io:format("Links1: ~p~n",[Links1]), true = lists:member(Port, Links1), Port ! {self(), {command, ""}}, - ?line wait_until(fun () -> lists:member(Port, erlang:ports()) == false end), + wait_until(fun () -> lists:member(Port, erlang:ports()) == false end), {links, Links2} = process_info(self(),links), - ?t:format("Links2: ~p~n",[Links2]), + io:format("Links2: ~p~n",[Links2]), false = lists:member(Port, Links2), %% This used to fail - test_server:timetrap_cancel(Dog), ok. otp_5112_get_wrapped_port() -> P1 = erlang:open_port({spawn, "exit_drv"}, []), case port_ix(P1) < max_ports() of - true -> - ?t:format("Need to wrap port index (~p)~n", [P1]), - otp_5112_wrap_port_ix([P1]), - P2 = erlang:open_port({spawn, "exit_drv"}, []), - false = port_ix(P2) < max_ports(), - P2; - false -> - ?t:format("Port index already wrapped (~p)~n", [P1]), - P1 - end. + true -> + io:format("Need to wrap port index (~p)~n", [P1]), + otp_5112_wrap_port_ix([P1]), + P2 = erlang:open_port({spawn, "exit_drv"}, []), + false = port_ix(P2) < max_ports(), + P2; + false -> + io:format("Port index already wrapped (~p)~n", [P1]), + P1 + end. otp_5112_wrap_port_ix(Ports) -> case (catch erlang:open_port({spawn, "exit_drv"}, [])) of - Port when is_port(Port) -> - otp_5112_wrap_port_ix([Port|Ports]); - _ -> - %% Port table now full; empty port table - lists:foreach(fun (P) -> P ! {self(), close} end, - Ports), - ok - end. + Port when is_port(Port) -> + otp_5112_wrap_port_ix([Port|Ports]); + _ -> + %% Port table now full; empty port table + lists:foreach(fun (P) -> P ! {self(), close} end, + Ports), + ok + end. -otp_5119(suite) -> - []; -otp_5119(doc) -> - ["Test that port index is not unnecessarily wrapped"]; +%% Test that port index is not unnecessarily wrapped otp_5119(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), ok = load_driver(Path, "exit_drv"), PI1 = port_ix(otp_5119_fill_empty_port_tab([])), Port2 = erlang:open_port({spawn, "exit_drv"}, []), PI2 = port_ix(Port2), {PortIx1, PortIx2} = case PI2 > PI1 of - true -> - {PI1, PI2}; - false -> - {port_ix(otp_5119_fill_empty_port_tab([Port2])), - port_ix(erlang:open_port({spawn, "exit_drv"}, []))} - end, + true -> + {PI1, PI2}; + false -> + {port_ix(otp_5119_fill_empty_port_tab([Port2])), + port_ix(erlang:open_port({spawn, "exit_drv"}, []))} + end, MaxPorts = max_ports(), - ?t:format("PortIx1 = ~p ~p~n", [PI1, PortIx1]), - ?t:format("PortIx2 = ~p ~p~n", [PI2, PortIx2]), - ?t:format("MaxPorts = ~p~n", [MaxPorts]), + io:format("PortIx1 = ~p ~p~n", [PI1, PortIx1]), + io:format("PortIx2 = ~p ~p~n", [PI2, PortIx2]), + io:format("MaxPorts = ~p~n", [MaxPorts]), true = PortIx2 > PortIx1, true = PortIx2 =< PortIx1 + MaxPorts, - test_server:timetrap_cancel(Dog), ok. otp_5119_fill_empty_port_tab(Ports) -> case (catch erlang:open_port({spawn, "exit_drv"}, [])) of - Port when is_port(Port) -> - otp_5119_fill_empty_port_tab([Port|Ports]); - _ -> - %% Port table now full; empty port table - lists:foreach(fun (P) -> P ! {self(), close} end, - Ports), - [LastPort|_] = Ports, - LastPort - end. + Port when is_port(Port) -> + otp_5119_fill_empty_port_tab([Port|Ports]); + _ -> + %% Port table now full; empty port table + lists:foreach(fun (P) -> P ! {self(), close} end, + Ports), + [LastPort|_] = Ports, + LastPort + end. max_ports() -> erlang:system_info(port_limit). port_ix(Port) when is_port(Port) -> ["#Port",_,PortIxStr] = string:tokens(erlang:port_to_list(Port), - "<.>"), + "<.>"), list_to_integer(PortIxStr). -otp_6224(doc) -> ["Check that port command failure doesn't crash the emulator"]; -otp_6224(suite) -> []; +%% Check that port command failure doesn't crash the emulator otp_6224(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), ok = load_driver(Path, "failure_drv"), Go = make_ref(), Failer = spawn(fun () -> - receive Go -> ok end, - Port = open_port({spawn, "failure_drv"}, - []), - Port ! {self(), {command, "Fail, please!"}}, - otp_6224_loop() - end), + receive Go -> ok end, + Port = open_port({spawn, "failure_drv"}, + []), + Port ! {self(), {command, "Fail, please!"}}, + otp_6224_loop() + end), Mon = erlang:monitor(process, Failer), Failer ! Go, receive - {'DOWN', Mon, process, Failer, Reason} -> - case Reason of - {driver_failed, _} -> ok; - driver_failed -> ok; - _ -> ?t:fail({unexpected_exit_reason, - Reason}) - end - end, - test_server:timetrap_cancel(Dog), + {'DOWN', Mon, process, Failer, Reason} -> + case Reason of + {driver_failed, _} -> ok; + driver_failed -> ok; + _ -> ct:fail({unexpected_exit_reason, + Reason}) + end + end, ok. - + otp_6224_loop() -> receive _ -> ok after 0 -> ok end, otp_6224_loop(). @@ -1782,29 +1776,26 @@ otp_6224_loop() -> -define(EXIT_STATUS_MSB_MAX_PROCS, 64). -define(EXIT_STATUS_MSB_MAX_PORTS, 300). -exit_status_multi_scheduling_block(doc) -> []; -exit_status_multi_scheduling_block(suite) -> []; exit_status_multi_scheduling_block(Config) when is_list(Config) -> Repeat = 3, - case ?t:os_type() of - {unix, _} -> - Dog = ?t:timetrap(test_server:minutes(2*Repeat)), - SleepSecs = 6, - try - lists:foreach(fun (_) -> - exit_status_msb_test(Config, - SleepSecs) - end, - lists:seq(1, Repeat)) - after - %% Wait for the system to recover (regardless - %% of success or not) otherwise later testcases - %% may unnecessarily fail. - ?t:timetrap_cancel(Dog), - receive after SleepSecs+500 -> ok end - end; - _ -> {skip, "Not implemented for this OS"} - end. + case os:type() of + {unix, _} -> + ct:timetrap({minutes, 2*Repeat}), + SleepSecs = 6, + try + lists:foreach(fun (_) -> + exit_status_msb_test(Config, + SleepSecs) + end, + lists:seq(1, Repeat)) + after + %% Wait for the system to recover (regardless + %% of success or not) otherwise later testcases + %% may unnecessarily fail. + receive after SleepSecs+500 -> ok end + end; + _ -> {skip, "Not implemented for this OS"} + end. exit_status_msb_test(Config, SleepSecs) when is_list(Config) -> %% @@ -1814,131 +1805,131 @@ exit_status_msb_test(Config, SleepSecs) when is_list(Config) -> %% NoSchedsOnln = erlang:system_info(schedulers_online), Parent = self(), - ?t:format("SleepSecs = ~p~n", [SleepSecs]), + io:format("SleepSecs = ~p~n", [SleepSecs]), PortProg = "sleep " ++ integer_to_list(SleepSecs), Start = erlang:monotonic_time(micro_seconds), NoProcs = case NoSchedsOnln of - NProcs when NProcs < ?EXIT_STATUS_MSB_MAX_PROCS -> - NProcs; - _ -> - ?EXIT_STATUS_MSB_MAX_PROCS - end, + NProcs when NProcs < ?EXIT_STATUS_MSB_MAX_PROCS -> + NProcs; + _ -> + ?EXIT_STATUS_MSB_MAX_PROCS + end, NoPortsPerProc = case 20*NoProcs of - TNPorts when TNPorts < ?EXIT_STATUS_MSB_MAX_PORTS -> 20; - _ -> ?EXIT_STATUS_MSB_MAX_PORTS div NoProcs - end, - ?t:format("NoProcs = ~p~nNoPortsPerProc = ~p~n", - [NoProcs, NoPortsPerProc]), + TNPorts when TNPorts < ?EXIT_STATUS_MSB_MAX_PORTS -> 20; + _ -> ?EXIT_STATUS_MSB_MAX_PORTS div NoProcs + end, + io:format("NoProcs = ~p~nNoPortsPerProc = ~p~n", + [NoProcs, NoPortsPerProc]), ProcFun - = fun () -> - PrtSIds = lists:map( - fun (_) -> - erlang:yield(), - case catch open_port({spawn, PortProg}, - [exit_status]) of - Prt when is_port(Prt) -> - {Prt, - erlang:system_info(scheduler_id)}; - {'EXIT', {Err, _}} when Err == eagain; - Err == emfile -> - noop; - {'EXIT', Err} when Err == eagain; - Err == emfile -> - noop; - Error -> - ?t:fail(Error) - end - end, - lists:seq(1, NoPortsPerProc)), - SIds = lists:filter(fun (noop) -> false; - (_) -> true - end, - lists:map(fun (noop) -> noop; - ({_, SId}) -> SId - end, - PrtSIds)), - process_flag(scheduler, 0), - Parent ! {self(), started, SIds}, - lists:foreach( - fun (noop) -> - noop; - ({Port, _}) -> - receive - {Port, {exit_status, 0}} -> - ok; - {Port, {exit_status, Status}} when Status > 128 -> - %% Sometimes happens when we have created - %% too many ports. - ok; - {Port, {exit_status, _}} = ESMsg -> - {Port, {exit_status, 0}} = ESMsg - end - end, - PrtSIds), - Parent ! {self(), done} - end, + = fun () -> + PrtSIds = lists:map( + fun (_) -> + erlang:yield(), + case catch open_port({spawn, PortProg}, + [exit_status]) of + Prt when is_port(Prt) -> + {Prt, + erlang:system_info(scheduler_id)}; + {'EXIT', {Err, _}} when Err == eagain; + Err == emfile; + Err == enomem -> + noop; + {'EXIT', Err} when Err == eagain; + Err == emfile; + Err == enomem -> + noop; + Error -> + ct:fail(Error) + end + end, + lists:seq(1, NoPortsPerProc)), + SIds = lists:filter(fun (noop) -> false; + (_) -> true + end, + lists:map(fun (noop) -> noop; + ({_, SId}) -> SId + end, + PrtSIds)), + process_flag(scheduler, 0), + Parent ! {self(), started, SIds}, + lists:foreach( + fun (noop) -> + noop; + ({Port, _}) -> + receive + {Port, {exit_status, 0}} -> + ok; + {Port, {exit_status, Status}} when Status > 128 -> + %% Sometimes happens when we have created + %% too many ports. + ok; + {Port, {exit_status, _}} = ESMsg -> + {Port, {exit_status, 0}} = ESMsg + end + end, + PrtSIds), + Parent ! {self(), done} + end, Procs = lists:map(fun (N) -> - spawn_opt(ProcFun, - [link, - {scheduler, - (N rem NoSchedsOnln)+1}]) - end, - lists:seq(1, NoProcs)), + spawn_opt(ProcFun, + [link, + {scheduler, + (N rem NoSchedsOnln)+1}]) + end, + lists:seq(1, NoProcs)), SIds = lists:map(fun (P) -> - receive {P, started, SIds} -> SIds end - end, - Procs), + receive {P, started, SIds} -> SIds end + end, + Procs), StartedTime = (erlang:monotonic_time(micro_seconds) - Start)/1000000, - ?t:format("StartedTime = ~p~n", [StartedTime]), + io: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 = (erlang:monotonic_time(micro_seconds) - Start)/1000000, - ?t:format("DoneTime = ~p~n", [DoneTime]), + io:format("DoneTime = ~p~n", [DoneTime]), true = DoneTime > SleepSecs, ok = verify_multi_scheduling_blocked(), erlang:system_flag(multi_scheduling, unblock), case {length(lists:usort(lists:flatten(SIds))), NoSchedsOnln} of - {N, N} -> - ok; - {N, M} -> - ?t:fail("Failed to create ports on all" - ++ integer_to_list(M) ++ " available" - "schedulers. Only created ports on " - ++ integer_to_list(N) ++ " schedulers.") - end. + {N, N} -> + ok; + {N, M} -> + ct:fail("Failed to create ports on all ~w available" + "schedulers. Only created ports on ~w schedulers.", [M, N]) + end. save_sid(SIds) -> SId = erlang:system_info(scheduler_id), case lists:member(SId, SIds) of - true -> SIds; - false -> [SId|SIds] + true -> SIds; + false -> [SId|SIds] end. sid_proc(SIds) -> NewSIds = save_sid(SIds), receive - {From, want_sids} -> - From ! {self(), sids, NewSIds} + {From, want_sids} -> + From ! {self(), sids, NewSIds} after 0 -> - sid_proc(NewSIds) + sid_proc(NewSIds) end. verify_multi_scheduling_blocked() -> Procs = lists:map(fun (_) -> - spawn_link(fun () -> sid_proc([]) end) - end, - lists:seq(1, 3*erlang:system_info(schedulers_online))), + spawn_link(fun () -> sid_proc([]) end) + end, + lists:seq(1, 3*erlang:system_info(schedulers_online))), receive after 1000 -> ok end, SIds = lists:map(fun (P) -> - P ! {self(), want_sids}, - receive {P, sids, PSIds} -> PSIds end - end, - Procs), + P ! {self(), want_sids}, + receive {P, sids, PSIds} -> PSIds end + end, + Procs), 1 = length(lists:usort(lists:flatten(SIds))), ok. - - + + %%% Pinging functions. stream_ping(Config, Size, CmdLine, Options) -> @@ -1947,10 +1938,10 @@ stream_ping(Config, Size, CmdLine, Options) -> ping(Config, Sizes, HSize, CmdLine, Options) -> Actions = lists:map(fun(Size) -> - [$p|Packet] = random_packet(Size, "ping"), - {[$p|Packet], [[$P|Packet]]} - end, - Sizes), + [$p|Packet] = random_packet(Size, "ping"), + {[$p|Packet], [[$P|Packet]]} + end, + Sizes), port_expect(Config, Actions, HSize, CmdLine, Options). %% expect_input(Sizes, HSize, CmdLine, Options) @@ -1972,7 +1963,7 @@ expect_input1(Config, [Size|Rest], Params, Expect, ReplyCommand) -> expect_input1(Config, [], {HSize, CmdLine0, Options}, Expect, ReplyCommand) -> CmdLine = build_cmd_line(CmdLine0, ReplyCommand, []), port_expect(Config, [{false, lists:reverse(Expect)}], - HSize, CmdLine, Options). + HSize, CmdLine, Options). build_cmd_line(FixedCmdLine, [Cmd|Rest], []) -> build_cmd_line(FixedCmdLine, Rest, [Cmd]); @@ -1995,15 +1986,15 @@ build_cmd_line(FixedCmdLine, [], Result) -> %% Returns the port. port_expect(Config, Actions, HSize, CmdLine, Options0) -> -% io:format("port_expect(~p, ~p, ~p, ~p)", -% [Actions, HSize, CmdLine, Options0]), + % io:format("port_expect(~p, ~p, ~p, ~p)", + % [Actions, HSize, CmdLine, Options0]), PortTest = port_test(Config), Cmd = lists:concat([PortTest, " -h", HSize, " ", CmdLine]), PortType = - case HSize of - 0 -> stream; - _ -> {packet, HSize} - end, + case HSize of + 0 -> stream; + _ -> {packet, HSize} + end, Options = [PortType|Options0], io:format("open_port({spawn, ~p}, ~p)", [Cmd, Options]), Port = open_port({spawn, Cmd}, Options), @@ -2014,11 +2005,11 @@ port_expect(Port, [{Send, Expects}|Rest], Options) when is_list(Expects) -> port_send(Port, Send), IsBinaryPort = lists:member(binary, Options), Receiver = - case {lists:member(stream, Options), line_option(Options)} of - {false, _} -> fun receive_all/2; - {true,false} -> fun stream_receive_all/2; - {_, true} -> fun receive_all/2 - end, + case {lists:member(stream, Options), line_option(Options)} of + {false, _} -> fun receive_all/2; + {true,false} -> fun stream_receive_all/2; + {_, true} -> fun receive_all/2 + end, Receiver(Port, maybe_to_binary(Expects, IsBinaryPort)), port_expect(Port, Rest, Options); port_expect(_, [], _) -> @@ -2046,34 +2037,34 @@ maybe_to_binary(Expects, false) -> port_send(_Port, false) -> ok; port_send(Port, Send) when is_list(Send) -> -% io:format("port_send(~p, ~p)", [Port, Send]), + % io:format("port_send(~p, ~p)", [Port, Send]), Port ! {self(), {command, Send}}. receive_all(Port, [Expect|Rest]) -> -% io:format("receive_all(~p, [~p|Rest])", [Port, Expect]), + % io:format("receive_all(~p, [~p|Rest])", [Port, Expect]), receive - {Port, {data, Expect}} -> - io:format("Received ~s", [format(Expect)]), - ok; - {Port, {data, Other}} -> - io:format("Received ~s; expected ~s", - [format(Other), format(Expect)]), - test_server:fail(bad_message); - Other -> - %% (We're not yet prepared for receiving both 'eol' and - %% 'exit_status'; remember that they may appear in any order.) - case {Expect, Rest, Other} of - {eof, [], {Port, eof}} -> - io:format("Received soft EOF.",[]), - ok; - {{exit_status, S}, [], {Port, {exit_status, S}}} -> - io:format("Received exit status ~p.",[S]), - ok; - _ -> -%%% io:format("Unexpected message: ~s", [format(Other)]), - io:format("Unexpected message: ~w", [Other]), - test_server:fail(unexpected_message) - end + {Port, {data, Expect}} -> + io:format("Received ~s", [format(Expect)]), + ok; + {Port, {data, Other}} -> + io:format("Received ~s; expected ~s", + [format(Other), format(Expect)]), + ct:fail(bad_message); + Other -> + %% (We're not yet prepared for receiving both 'eol' and + %% 'exit_status'; remember that they may appear in any order.) + case {Expect, Rest, Other} of + {eof, [], {Port, eof}} -> + io:format("Received soft EOF.",[]), + ok; + {{exit_status, S}, [], {Port, {exit_status, S}}} -> + io:format("Received exit status ~p.",[S]), + ok; + _ -> + %%% io:format("Unexpected message: ~s", [format(Other)]), + io:format("Unexpected message: ~w", [Other]), + ct:fail(unexpected_message) + end end, receive_all(Port, Rest); receive_all(_Port, []) -> @@ -2088,30 +2079,30 @@ stream_receive_all1(_Port, []) -> ok; stream_receive_all1(Port, Expect) -> receive - {Port, {data, Data}} -> - Remaining = compare(Data, Expect), - stream_receive_all1(Port, Remaining); - Other -> - test_server:fail({bad_message, Other}) + {Port, {data, Data}} -> + Remaining = compare(Data, Expect), + stream_receive_all1(Port, Remaining); + Other -> + ct:fail({bad_message, Other}) end. compare(B1, B2) when is_binary(B1), is_binary(B2), byte_size(B1) =< byte_size(B2) -> case split_binary(B2, size(B1)) of - {B1,Remaining} -> - Remaining; - _Other -> - test_server:fail(nomatch) + {B1,Remaining} -> + Remaining; + _Other -> + ct:fail(nomatch) end; compare(B1, B2) when is_binary(B1), is_binary(B2) -> - test_server:fail(too_much_data); + ct:fail(too_much_data); compare([X|Rest1], [X|Rest2]) -> compare(Rest1, Rest2); compare([_|_], [_|_]) -> - test_server:fail(nomatch); + ct:fail(nomatch); compare([], Remaining) -> Remaining; compare(_Data, []) -> - test_server:fail(too_much_data). + ct:fail(too_much_data). maybe_to_list(Bin) when is_binary(Bin) -> binary_to_list(Bin); @@ -2122,10 +2113,10 @@ format({Eol,List}) -> io_lib:format("tuple<~w,~s>",[Eol, maybe_to_list(List)]); format(List) when is_list(List) -> case list_at_least(50, List) of - true -> - io_lib:format("\"~-50s...\"", [List]); - false -> - io_lib:format("~p", [List]) + true -> + io_lib:format("\"~-50s...\"", [List]); + false -> + io_lib:format("~p", [List]) end; format(Bin) when is_binary(Bin), size(Bin) >= 50 -> io_lib:format("binary<~-50s...>", [binary_to_list(Bin, 1, 50)]); @@ -2152,17 +2143,17 @@ build_packet(0, Result, _NextChar) -> lists:reverse(Result); build_packet(Left, Result, NextChar0) -> NextChar = - if - NextChar0 >= 126 -> - 33; - true -> - NextChar0+1 - end, + if + NextChar0 >= 126 -> + 33; + true -> + NextChar0+1 + end, build_packet(Left-1, [NextChar0|Result], NextChar). sizes() -> [10, 13, 64, 127, 128, 255, 256, 1023, 1024, - 32767, 32768, 65535, 65536]. + 32767, 32768, 65535, 65536]. sizes(Header_Size) -> sizes(Header_Size, sizes(), []). @@ -2183,15 +2174,14 @@ random_char(Chars) -> lists:nth(uniform(length(Chars)), Chars). uniform(N) -> - case get(random_seed) of - undefined -> - {X, Y, Z} = Seed = time(), - io:format("Random seed = ~p\n",[Seed]), - random:seed(X, Y, Z); - _ -> - ok + case rand:export_seed() of + undefined -> + rand:seed(exsplus), + io:format("Random seed = ~p\n", [rand:export_seed()]); + _ -> + ok end, - random:uniform(N). + rand:uniform(N). fun_spawn(Fun) -> fun_spawn(Fun, []). @@ -2200,13 +2190,11 @@ fun_spawn(Fun, Args) -> spawn_link(erlang, apply, [Fun, Args]). port_test(Config) when is_list(Config) -> - filename:join(?config(data_dir, Config), "port_test"). - + filename:join(proplists:get_value(data_dir, Config), "port_test"). -ports(doc) -> "Test that erlang:ports/0 returns a consistent snapshot of ports"; -ports(suite) -> []; +%% Test that erlang:ports/0 returns a consistent snapshot of ports ports(Config) when is_list(Config) -> - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), ok = load_driver(Path, "exit_drv"), receive after 1000 -> ok end, % Wait for other ports to stabilize @@ -2233,7 +2221,7 @@ ports_snapshots(Iter, TrafficPid, OtherPorts) -> TrafficPid ! {self(), stop}, receive {TrafficPid, EventList, TrafficPorts} -> ok end, - + %%io:format("Snapshot=~p\n", [Snapshot]), ports_verify(Snapshot, OtherPorts ++ TrafficPorts, EventList), @@ -2245,78 +2233,77 @@ ports_traffic(MaxPorts) -> ports_traffic_stopped(MaxPorts, {PortList, PortCnt}) -> receive - start -> - %%io:format("Traffic started in ~p\n",[self()]), - ports_traffic_started(MaxPorts, {PortList, PortCnt}, []); - {Pid,die} -> - lists:foreach(fun(Port)-> erlang:port_close(Port) end, - PortList), - Pid ! {self(),dead} + start -> + %%io:format("Traffic started in ~p\n",[self()]), + ports_traffic_started(MaxPorts, {PortList, PortCnt}, []); + {Pid,die} -> + lists:foreach(fun(Port)-> erlang:port_close(Port) end, + PortList), + Pid ! {self(),dead} end. ports_traffic_started(MaxPorts, {PortList, PortCnt}, EventList) -> receive - {Pid, stop} -> - %%io:format("Traffic stopped in ~p\n",[self()]), - Pid ! {self(), EventList, PortList}, - ports_traffic_stopped(MaxPorts, {PortList, PortCnt}) + {Pid, stop} -> + %%io:format("Traffic stopped in ~p\n",[self()]), + Pid ! {self(), EventList, PortList}, + ports_traffic_stopped(MaxPorts, {PortList, PortCnt}) after 0 -> - ports_traffic_do(MaxPorts, {PortList, PortCnt}, EventList) + ports_traffic_do(MaxPorts, {PortList, PortCnt}, EventList) end. ports_traffic_do(MaxPorts, {PortList, PortCnt}, EventList) -> N = uniform(MaxPorts), case N > PortCnt of - true -> % Open port - P = open_port({spawn, "exit_drv"}, []), - %%io:format("Created port ~p\n",[P]), - ports_traffic_started(MaxPorts, {[P|PortList], PortCnt+1}, - [{open,P}|EventList]); - - false -> % Close port - P = lists:nth(N, PortList), - %%io:format("Close port ~p\n",[P]), - true = erlang:port_close(P), - ports_traffic_started(MaxPorts, {lists:delete(P,PortList), PortCnt-1}, - [{close,P}|EventList]) + true -> % Open port + P = open_port({spawn, "exit_drv"}, []), + %%io:format("Created port ~p\n",[P]), + ports_traffic_started(MaxPorts, {[P|PortList], PortCnt+1}, + [{open,P}|EventList]); + + false -> % Close port + P = lists:nth(N, PortList), + %%io:format("Close port ~p\n",[P]), + true = erlang:port_close(P), + ports_traffic_started(MaxPorts, {lists:delete(P,PortList), PortCnt-1}, + [{close,P}|EventList]) end. ports_verify(Ports, PortsAfter, EventList) -> %%io:format("Candidate=~p\nEvents=~p\n", [PortsAfter, EventList]), case lists:sort(Ports) =:= lists:sort(PortsAfter) of - true -> - io:format("Snapshot of ~p ports verified ok.\n",[length(Ports)]), - ok; - false -> - %% Note that we track the event list "backwards", undoing open/close: - case EventList of - [{open,P} | Tail] -> - ports_verify(Ports, lists:delete(P,PortsAfter), Tail); - - [{close,P} | Tail] -> - ports_verify(Ports, [P | PortsAfter], Tail); - - [] -> - test_server:fail("Inconsistent snapshot from erlang:ports()") - end + true -> + io:format("Snapshot of ~p ports verified ok.\n",[length(Ports)]), + ok; + false -> + %% Note that we track the event list "backwards", undoing open/close: + case EventList of + [{open,P} | Tail] -> + ports_verify(Ports, lists:delete(P,PortsAfter), Tail); + + [{close,P} | Tail] -> + ports_verify(Ports, [P | PortsAfter], Tail); + + [] -> + ct:fail("Inconsistent snapshot from erlang:ports()") + end end. load_driver(Dir, Driver) -> case erl_ddll:load_driver(Dir, Driver) of - ok -> ok; - {error, Error} = Res -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - Res + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res end. -close_deaf_port(doc) -> ["Send data to port program that does not read it, then close port." - "Primary targeting Windows to test threaded_handle_closer in sys.c"]; -close_deaf_port(suite) -> []; +%% Send data to port program that does not read it, then close port. +%% Primary targeting Windows to test threaded_handle_closer in sys.c close_deaf_port(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(100)), - DataDir = ?config(data_dir, Config), + ct:timetrap({minutes, 2}), + DataDir = proplists:get_value(data_dir, Config), DeadPort = os:find_executable("dead_port", DataDir), Port = open_port({spawn,DeadPort++" 60"},[]), erlang:port_command(Port,"Hello, can you hear me!?!?"), @@ -2325,83 +2312,82 @@ close_deaf_port(Config) when is_list(Config) -> Res = close_deaf_port_1(0, DeadPort), io:format("Waiting for OS procs to terminate...\n"), receive after 5*1000 -> ok end, - test_server:timetrap_cancel(Dog), Res. close_deaf_port_1(200, _) -> ok; close_deaf_port_1(N, Cmd) -> - Timeout = integer_to_list(random:uniform(5*1000)), + Timeout = integer_to_list(rand:uniform(5*1000)), try open_port({spawn_executable,Cmd},[{args,[Timeout]}]) of - Port -> - erlang:port_command(Port,"Hello, can you hear me!?!?"), - port_close(Port), - close_deaf_port_1(N+1, Cmd) + Port -> + erlang:port_command(Port,"Hello, can you hear me!?!?"), + port_close(Port), + close_deaf_port_1(N+1, Cmd) catch - _:eagain -> - {comment, "Could not spawn more than " ++ integer_to_list(N) ++ " OS processes."} + _:eagain -> + {comment, "Could not spawn more than " ++ integer_to_list(N) ++ " OS processes."} end. %% Test undocumented port_set_data/2 and port_get_data/1 %% Hammer from multiple processes a while %% and then abrubtly close the port (OTP-12208). port_setget_data(Config) when is_list(Config) -> - ok = load_driver(?config(data_dir, Config), "echo_drv"), + ok = load_driver(proplists:get_value(data_dir, Config), "echo_drv"), Port = erlang:open_port({spawn_driver, "echo_drv"}, []), NSched = erlang:system_info(schedulers_online), HeapData = {1,2,3,<<"A heap binary">>,fun()->"This is fun"end, - list_to_binary(lists:seq(1,100))}, + list_to_binary(lists:seq(1,100))}, PRs = lists:map(fun(I) -> - spawn_opt(fun() -> port_setget_data_hammer(Port,HeapData,false,1) end, - [monitor, {scheduler, I rem NSched}]) - end, - lists:seq(1,10)), + spawn_opt(fun() -> port_setget_data_hammer(Port,HeapData,false,1) end, + [monitor, {scheduler, I rem NSched}]) + end, + lists:seq(1,10)), receive after 100 -> ok end, Papa = self(), lists:foreach(fun({Pid,_}) -> Pid ! {Papa,prepare_for_close} end, PRs), lists:foreach(fun({Pid,_}) -> - receive {Pid,prepare_for_close} -> ok end - end, - PRs), + receive {Pid,prepare_for_close} -> ok end + end, + PRs), port_close(Port), lists:foreach(fun({Pid,Ref}) -> - receive {'DOWN', Ref, process, Pid, normal} -> ok end - end, - PRs), + receive {'DOWN', Ref, process, Pid, normal} -> ok end + end, + PRs), ok. port_setget_data_hammer(Port, HeapData, IsSet0, N) -> - Rand = random:uniform(3), + Rand = rand:uniform(3), IsSet1 = try case Rand of - 1 -> true = erlang:port_set_data(Port, atom), true; - 2 -> true = erlang:port_set_data(Port, HeapData), true; - 3 -> case erlang:port_get_data(Port) of - atom -> true; - HeapData -> true; - undefined -> false=IsSet0 - end - end - catch - error:badarg -> - true = get(prepare_for_close), - io:format("~p did ~p rounds before port closed\n", [self(), N]), - exit(normal) - end, + 1 -> true = erlang:port_set_data(Port, atom), true; + 2 -> true = erlang:port_set_data(Port, HeapData), true; + 3 -> case erlang:port_get_data(Port) of + atom -> true; + HeapData -> true; + undefined -> false=IsSet0 + end + end + catch + error:badarg -> + true = get(prepare_for_close), + io:format("~p did ~p rounds before port closed\n", [self(), N]), + exit(normal) + end, receive {Papa, prepare_for_close} -> - put(prepare_for_close, true), - Papa ! {self(),prepare_for_close} + put(prepare_for_close, true), + Papa ! {self(),prepare_for_close} after 0 -> - ok + ok end, port_setget_data_hammer(Port, HeapData, IsSet1, N+1). wait_until(Fun) -> case catch Fun() of - true -> - ok; - _ -> - receive after 100 -> ok end, - wait_until(Fun) + true -> + ok; + _ -> + receive after 100 -> ok end, + wait_until(Fun) end. diff --git a/erts/emulator/test/port_SUITE_data/dead_port.c b/erts/emulator/test/port_SUITE_data/dead_port.c index c859dbc402..26f09f33c7 100644 --- a/erts/emulator/test/port_SUITE_data/dead_port.c +++ b/erts/emulator/test/port_SUITE_data/dead_port.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/port_SUITE_data/port_test.c b/erts/emulator/test/port_SUITE_data/port_test.c index 7abefab2e3..cc3ebdf0f8 100644 --- a/erts/emulator/test/port_SUITE_data/port_test.c +++ b/erts/emulator/test/port_SUITE_data/port_test.c @@ -13,6 +13,7 @@ #ifndef __WIN32__ #include <unistd.h> +#include <limits.h> #include <sys/time.h> @@ -48,6 +49,7 @@ typedef struct { * after reading the header for a packet * before reading the rest. */ + int fd_count; /* Count the number of open fds */ int break_mode; /* If set, this program will close standard * input, which should case broken pipe * error in the writer. @@ -107,7 +109,7 @@ MAIN(argc, argv) int argc; char *argv[]; { - int ret; + int ret, fd_count; if((port_data = (PORT_TEST_DATA *) malloc(sizeof(PORT_TEST_DATA))) == NULL) { fprintf(stderr, "Couldn't malloc for port_data"); exit(1); @@ -115,6 +117,7 @@ char *argv[]; port_data->header_size = 0; port_data->io_buf_size = 0; port_data->delay_mode = 0; + port_data->fd_count = 0; port_data->break_mode = 0; port_data->quit_mode = 0; port_data->slow_writes = 0; @@ -144,6 +147,9 @@ char *argv[]; case 'e': port_data->fd_to_erl = 2; break; + case 'f': + port_data->fd_count = 1; + break; case 'h': /* Header size for packets. */ switch (argv[1][2]) { case '0': port_data->header_size = 0; break; @@ -189,18 +195,31 @@ char *argv[]; /* XXX Add error printout here */ } + if (port_data->fd_count) { +#ifdef __WIN32__ + DWORD handles; + GetProcessHandleCount(GetCurrentProcess(), &handles); + fd_count = handles; +#else + int i; + for (i = 0, fd_count = 0; i < 1024; i++) + if (fcntl(i, F_GETFD) >= 0) { + fd_count++; + } +#endif + } + + if (port_data->output_file) + replace_stdout(port_data->output_file); + + if (port_data->fd_count) + reply(&fd_count, sizeof(fd_count)); + if (port_data->no_packet_loop){ free(port_data); exit(0); } - /* - * If an output file was given, let it replace standard output. - */ - - if (port_data->output_file) - replace_stdout(port_data->output_file); - ret = packet_loop(); if(port_data->io_buf_size > 0) free(port_data->io_buf); diff --git a/erts/emulator/test/port_SUITE_data/port_test.erl b/erts/emulator/test/port_SUITE_data/port_test.erl index b07038e73d..406d376b26 100644 --- a/erts/emulator/test/port_SUITE_data/port_test.erl +++ b/erts/emulator/test/port_SUITE_data/port_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/port_bif_SUITE.erl b/erts/emulator/test/port_bif_SUITE.erl index b65a22a528..e1e1ec9fb9 100644 --- a/erts/emulator/test/port_bif_SUITE.erl +++ b/erts/emulator/test/port_bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,8 +21,8 @@ -module(port_bif_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, command/1, +-export([all/0, suite/0, groups/0, + command/1, command_e_1/1, command_e_2/1, command_e_3/1, command_e_4/1, port_info1/1, port_info2/1, port_info_os_pid/1, port_info_race/1, @@ -30,11 +30,11 @@ -export([do_command_e_1/1, do_command_e_2/1, do_command_e_4/1]). --export([init_per_testcase/2, end_per_testcase/2]). +-include_lib("common_test/include/ct.hrl"). --include_lib("test_server/include/test_server.hrl"). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 10}}]. all() -> [command, {group, port_info}, connect, control, @@ -46,27 +46,6 @@ groups() -> {port_info, [], [port_info1, port_info2, port_info_os_pid, port_info_race]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - - -init_per_testcase(_Func, Config) when is_list(Config) -> - Dog=test_server:timetrap(test_server:minutes(10)), - [{watchdog, Dog}|Config]. -end_per_testcase(_Func, Config) when is_list(Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog). - command(Config) when is_list(Config) -> load_control_drv(Config), @@ -87,17 +66,17 @@ do_command(P, Data) -> {P,{data,Data0}} -> case {list_to_binary(Data0),list_to_binary([Data])} of {B,B} -> ok; - _ -> test_server:fail({unexpected_data,Data0}) + _ -> ct:fail({unexpected_data,Data0}) end; Other -> - test_server:fail({unexpected_message,Other}) + ct:fail({unexpected_message,Other}) end. %% port_command/2: badarg 1st arg command_e_1(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), Program = filename:join(DataDir, "port_test"), process_flag(trap_exit, true), @@ -106,9 +85,9 @@ command_e_1(Config) when is_list(Config) -> {'EXIT', Pid, {badarg, _}} when is_pid(Pid) -> ok; Other -> - test_server:fail(Other) + ct:fail(Other) after 10000 -> - test_server:fail(timeout) + ct:fail(timeout) end, ok. @@ -119,7 +98,7 @@ do_command_e_1(Program) -> %% port_command/2: badarg 2nd arg command_e_2(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), Program = filename:join(DataDir, "port_test"), process_flag(trap_exit, true), @@ -128,9 +107,9 @@ command_e_2(Config) when is_list(Config) -> {'EXIT', Pid, {badarg, _}} when is_pid(Pid) -> ok; Other -> - test_server:fail(Other) + ct:fail(Other) after 10000 -> - test_server:fail(timeout) + ct:fail(timeout) end, ok. @@ -141,7 +120,7 @@ do_command_e_2(Program) -> %% port_command/2: Posix signals trapped command_e_3(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), Program = filename:join(DataDir, "port_test"), process_flag(trap_exit, true), @@ -152,15 +131,15 @@ command_e_3(Config) when is_list(Config) -> {'EXIT', Port, einval} when is_port(Port) -> ok; Other -> - test_server:fail(Other) + ct:fail(Other) after 10000 -> - test_server:fail(timeout) + ct:fail(timeout) end, ok. %% port_command/2: Posix exit signals not trapped command_e_4(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), Program = filename:join(DataDir, "port_test"), process_flag(trap_exit, true), @@ -169,9 +148,9 @@ command_e_4(Config) when is_list(Config) -> {'EXIT', Pid, {einval, _}} when is_pid(Pid) -> ok; Other -> - test_server:fail(Other) + ct:fail(Other) after 10000 -> - test_server:fail(timeout) + ct:fail(timeout) end, ok. @@ -248,7 +227,7 @@ do_port_info_os_pid() -> {os_pid, InfoOSPid} = erlang:port_info(P, os_pid), EchoPidStr = receive {P, {data, EchoPidStr0}} -> EchoPidStr0 - after 10000 -> test_server:fail(timeout) + after 10000 -> ct:fail(timeout) end, {ok, [EchoPid], []} = io_lib:fread("~u\n", EchoPidStr), {value,{os_pid, InfoOSPid}}=lists:keysearch(os_pid, 1, A), @@ -257,7 +236,7 @@ do_port_info_os_pid() -> ok. port_info_race(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), Program = filename:join(DataDir, "port_test"), Top = self(), P1 = open_port({spawn,Program}, [{packet,1}]), @@ -283,10 +262,9 @@ output_test(_, _, Input, Output) when Output > 16#1fffffff -> output_test(P, Bin, Input0, Output0) -> erlang:port_command(P, Bin), receive - {P,{data,Bin}} -> ok; - Other -> - io:format("~p", [Other]), - ?t:fail() + {P,{data,Bin}} -> ok; + Other -> + ct:fail("~p", [Other]) end, Input = Input0 + size(Bin), Output = Output0 + size(Bin), @@ -296,8 +274,8 @@ output_test(P, Bin, Input0, Output0) -> %% We can't test much here, but hopefully a debug-built emulator will crasch %% if there is something wrong with the heap allocation. case erlang:statistics(io) of - {{input,In},{output,Out}} when is_integer(In), is_integer(Out) -> - ok + {{input,In},{output,Out}} when is_integer(In), is_integer(Out) -> + ok end, output_test(P, Bin, Input, Output). @@ -345,7 +323,7 @@ connect(Config) when is_list(Config) -> exit(P, you_should_die), receive {'EXIT',RecPid,you_should_die} -> ok; - Other -> ?line ?t:fail({bad_message,Other}) + Other -> ct:fail({bad_message,Other}) end, %% Done. @@ -410,7 +388,7 @@ test_op(P, Op) -> <<Op:32>> = list_to_binary(R). echo_to_busy(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), + ct:timetrap({seconds, 10}), load_control_drv(Config), P = open_port({spawn, control_drv}, []), erlang:port_control(P, $b, [1]), % Set to busy. @@ -422,11 +400,10 @@ echo_to_busy(Config) when is_list(Config) -> {Echoer, done} -> ok; {Echoer, Other} -> - test_server:fail(Other); + ct:fail(Other); Other -> - test_server:fail({unexpected_message, Other}) + ct:fail({unexpected_message, Other}) end, - test_server:timetrap_cancel(Dog), ok. echoer(P, ReplyTo) -> @@ -451,7 +428,7 @@ echo(P, Size) -> Packet = erlang:port_control(P, $e, [unaligned_sub_bin(Bin)]). load_control_drv(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), erl_ddll:start(), ok = load_driver(DataDir, "control_drv"). @@ -485,14 +462,7 @@ random_char(Chars) -> lists:nth(uniform(length(Chars)), Chars). uniform(N) -> - case get(random_seed) of - undefined -> - {X, Y, Z} = time(), - random:seed(X, Y, Z); - _ -> - ok - end, - random:uniform(N). + rand:uniform(N). unaligned_sub_bin(Bin0) -> Bin1 = <<0:3,Bin0/binary,31:5>>, diff --git a/erts/emulator/test/port_trace_SUITE.erl b/erts/emulator/test/port_trace_SUITE.erl new file mode 100644 index 0000000000..bfdea0761b --- /dev/null +++ b/erts/emulator/test/port_trace_SUITE.erl @@ -0,0 +1,614 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + + +-module(port_trace_SUITE). + +-export([all/0, suite/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([port_specs/1, ports/1, open_close/1, + command/1, control/1, connect/1, call/1, + output/1, output2/1, output_binary/1, + outputv/1, set_timer/1, failure_eof/1, + failure_atom/1, failure_posix/1, + failure/1, output_term/1, + driver_output_term/1, + send_term/1, driver_send_term/1]). + +-define(ECHO_DRV_NOOP, 0). +-define(ECHO_DRV_OUTPUT, 1). +-define(ECHO_DRV_OUTPUT2, 2). +-define(ECHO_DRV_OUTPUT_BINARY, 3). +-define(ECHO_DRV_OUTPUTV, 4). +-define(ECHO_DRV_SET_TIMER, 5). +-define(ECHO_DRV_FAILURE_EOF, 6). +-define(ECHO_DRV_FAILURE_ATOM, 7). +-define(ECHO_DRV_FAILURE_POSIX, 8). +-define(ECHO_DRV_FAILURE, 9). +-define(ECHO_DRV_OUTPUT_TERM, 10). +-define(ECHO_DRV_DRIVER_OUTPUT_TERM, 11). +-define(ECHO_DRV_SEND_TERM, 12). +-define(ECHO_DRV_DRIVER_SEND_TERM, 13). +-define(ECHO_DRV_SAVE_CALLER, 14). + +suite() -> [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 30}}]. + +all() -> + [port_specs, ports, open_close, + command, control, connect, call, + output, output2, output_binary, + outputv, set_timer, failure_eof, + failure_atom, failure_posix, + failure, output_term, + driver_output_term, + send_term, driver_send_term]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + erlang:trace(all, false, [all]), + os:unsetenv("OUTPUTV"), + reload_drv(Config), + Config. + +end_per_testcase(_Func, _Config) -> + erlang:trace(all, false, [all]), + ok. + +%% Test the first argument of trace/3 +port_specs(_Config) -> + + S = self(), + + Tracer = fun F() -> + receive + stop -> + ok; + M -> + S ! M, + F() + end + end, + + Test = fun(TraceSpec, Info1, Info2) -> + {TracerPid,Ref} = spawn_monitor(Tracer), + Prt1 = erlang:open_port({spawn, echo_drv}, [binary]), + erlang:trace(TraceSpec, true, ['receive', {tracer, TracerPid}]), + %% We disable trace messages from the testcase process + erlang:trace(self(), false, ['receive']), + Prt2 = erlang:open_port({spawn, echo_drv}, [binary]), + + InfoCheck = + fun(Info, Prt) -> + if + Info -> + {tracer, TracerPid} = erlang:trace_info(Prt, tracer), + {flags,['receive']} = erlang:trace_info(Prt, flags); + not Info -> + {tracer,[]} = erlang:trace_info(Prt, tracer), + {flags,[]} = erlang:trace_info(Prt, flags) + end + end, + InfoCheck(Info1, Prt1), + InfoCheck(Info2, Prt2), + + %% These may create trace messages + erlang:port_command(Prt1, <<?ECHO_DRV_NOOP>>), + erlang:port_command(Prt2, <<?ECHO_DRV_NOOP>>), + + %% Test what happens when the tracer dies + trace_delivered(), + TracerPid ! stop, + receive {'DOWN', Ref, process, TracerPid, normal} -> ok end, + + %% These should not generate any trace messages + erlang:port_command(Prt1, <<?ECHO_DRV_NOOP>>), + erlang:port_command(Prt2, <<?ECHO_DRV_NOOP>>), + + InfoCheck(false, Prt1), + InfoCheck(false, Prt2), + + erlang:port_close(Prt1), + erlang:port_close(Prt2), + erlang:trace(all, false, [all]), + {Prt1, Prt2} + end, + + {_Prt11, Prt12} = Test(new, false, true), + [{trace, Prt12, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt12), + + {_Prt21, Prt22} = Test(new_ports, false, true), + [{trace, Prt22, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt22), + + {Prt31, _Prt32} = Test(existing, true, false), + [{trace, Prt31, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt31), + + {Prt41, _Prt42} = Test(existing_ports, true, false), + [{trace, Prt41, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt41), + + {Prt51, Prt52} = Test(all, true, true), + [{trace, Prt51, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt51), + [{trace, Prt52, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt52), + + {Prt61, Prt62} = Test(ports, true, true), + [{trace, Prt61, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt61), + [{trace, Prt62, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt62), + + ok. + +%% Test that the 'ports' trace flag works +ports(_Config) -> + + {Prt, S} = trace_and_open([ports],[binary]), + + [{trace, Prt, open, S, echo_drv}, + {trace, Prt, getting_linked, S}] = flush(), + + register(?MODULE, Prt), + unregister(?MODULE), + register(?MODULE, Prt), + + [{trace,Prt,register,port_trace_SUITE}, + {trace,Prt,unregister,port_trace_SUITE}, + {trace,Prt,register,port_trace_SUITE}] = flush(), + + unlink(Prt), + link(Prt), + + [{trace,Prt,getting_unlinked,S}, + {trace,Prt,getting_linked,S}] = flush(), + + erlang:port_close(Prt), + + [{trace,Prt,closed,normal}, + {trace,Prt,unregister,port_trace_SUITE}, + {trace,Prt,unlink,S}] = flush(), + + ok. + +%% Test that port_close and ! close generate correct trace messages +open_close(_Config) -> + + S = trace_ports([send,'receive']), + + Prt = erlang:open_port({spawn, echo_drv}, [binary]), + erlang:port_close(Prt), + [{trace, Prt, 'receive', {S, close}}] = flush(), + + Prt2 = erlang:open_port({spawn, echo_drv}, [binary]), + Prt2 ! {S, close}, + recv({Prt2, closed}), + [{trace, Prt2, 'receive', {S, close}}, + {trace, Prt2, send, closed, S}] = flush(), + + catch erlang:port_close(Prt2), + [] = flush(), + + ok. + +%% Test that port_command and ! command generate correct trace messages +command(Config) -> + + Flags = [send,'receive'], + S = trace_ports(Flags), + Prt = erlang:open_port({spawn, echo_drv}, [binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_NOOP:8>>), + [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_NOOP:8>>}}}] = flush(), + + erlang:port_command(Prt, [?ECHO_DRV_NOOP, <<0:8>>]), + [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_NOOP:8,0:8>>}}}] = flush(), + + Prt ! {S, {command, <<?ECHO_DRV_NOOP:8>>}}, + [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_NOOP:8>>}}}] = flush(), + + OutputMsg = <<?ECHO_DRV_NOOP:8,0:(8*512)>>, + Prt ! {S, {command, OutputMsg}}, + [{trace, Prt, 'receive', {S, {command, OutputMsg}}}] = flush(), + + close(Prt, Flags), + + os:putenv("OUTPUTV","true"), + reload_drv(Config), + + Prt2 = erlang:open_port({spawn, echo_drv}, [binary]), + OutputvMsg = [<<0:8>>,<<0:(8*512)>>,<<0:(8*256)>>,<<0:8>>], + + erlang:port_command(Prt2, OutputvMsg), + [{trace, Prt2, 'receive', {S, {command, OutputvMsg}}}] = flush(), + + Prt2 ! {S, {command, OutputvMsg}}, + [{trace, Prt2, 'receive', {S, {command, OutputvMsg}}}] = flush(), + + close(Prt2, Flags), + + os:unsetenv("OUTPUTV"), + + ok. + +%% Test that port_control generate correct trace messages +control(_Config) -> + + Flags = [send,'receive'], + {Prt, S} = trace_and_open(Flags,[binary]), + + [0] = erlang:port_control(Prt, 1, <<?ECHO_DRV_NOOP:8, 0:8>>), + [{trace, Prt, 'receive', {S, {control, {1, <<?ECHO_DRV_NOOP:8, 0:8>>}}}}, + {trace, Prt, send, {Prt, {control, <<0:8>>}}, S}] = flush(), + + [0] = erlang:port_control(Prt, (1 bsl 32) - 1, <<?ECHO_DRV_NOOP:8, 0:8>>), + [{trace, Prt, 'receive', {S, {control, {(1 bsl 32) - 1, <<?ECHO_DRV_NOOP:8, 0:8>>}}}}, + {trace, Prt, send, {Prt, {control, <<0:8>>}}, S}] = flush(), + + Msg = <<?ECHO_DRV_NOOP:8, 0:(8*512)>>, + Pat = lists:duplicate(512, 0), + Pat = erlang:port_control(Prt, 1, Msg), + [{trace, Prt, 'receive', {S, {control, {1, Msg}}}}, + {trace, Prt, send, {Prt, {control, <<0:(8*512)>>}}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that port_connect and ! connect generate correct trace messages +%% This includes that the proper getting_linked messages are sent +connect(_Config) -> + + + {Prt, S} = trace_and_open([send, 'receive', ports],[binary]), + + flush(), + + {Pid,Ref} = spawn_monitor( + fun() -> + receive + go -> + Prt ! {self(), {connect, S}}, + receive {Prt, connected} -> unlink(Prt) end + end + end), + erlang:trace(Pid, true, [send, 'receive', procs]), + + erlang:port_connect(Prt, Pid), + unlink(Prt), + + [{trace,Prt,getting_linked,Pid}, + {trace,Prt,'receive',{S,{connect,Pid}}}, + {trace,Prt,send,{Prt,connected},S}, + {trace,Prt,getting_unlinked, S}] = flush(Prt), + + [{trace,Pid,getting_linked,Prt}] = flush(), + + Pid ! go, + recv({'DOWN',Ref,process,Pid,normal}), + + [{trace,Prt,'receive',{Pid,{connect,S}}}, + {trace,Prt,send,{Prt,connected},Pid}, + {trace,Prt,getting_unlinked,Pid}] = flush(Prt), + + [{trace,Pid,'receive',go}, + {trace,Pid,send,{Pid,{connect,S}}, Prt}, + {trace,Pid,'receive',{Prt,connected}}, + {trace,Pid,unlink,Prt}, + {trace,Pid,exit,normal}] = flush(), + + erlang:port_close(Prt), + [{trace, Prt, 'receive', {S, close}}, + {trace, Prt, closed, normal}] = flush(), + ok. + +%% Test that port_call generate correct trace messages +call(_Config) -> + + Flags = [send,'receive'], + {Prt, S} = trace_and_open(Flags,[binary]), + + Test = fun(Msg) -> + BinMsg = term_to_binary(Msg), + + Msg = erlang:port_call(Prt, 0, Msg), + [{trace, Prt, 'receive', {S, {call, {0, BinMsg}}}}, + {trace, Prt, send, {Prt, {call, BinMsg}}, S}] = flush() + end, + + Test({hello, world, make_ref()}), + Test({hello, world, lists:seq(1,1000)}), + + close(Prt, Flags), + + ok. + +%% Test that driver_output generate correct trace messages +output(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT, 123456:32>>), + recv({Prt,{data,<<123456:32>>}}), + + [{trace, Prt, send, {Prt, {data, <<123456:32>>}}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_output2 generate correct trace messages +output2(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT2, 123456:32>>), + recv({Prt,{data,[$a|<<123456:32>>]}}), + [{trace, Prt, send, {Prt, {data, [$a|<<123456:32>>]}}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_output_binary generate correct trace messages +output_binary(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT_BINARY, 0, 123456:32>>), + recv({Prt,{data,[$a|<<123456:32>>]}}), + [{trace, Prt, send, {Prt, {data, [$a|<<123456:32>>]}}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_outputv generate correct trace messages +outputv(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_OUTPUTV, 123456:32>>), + recv({Prt,{data,[$a|<<123456:32>>]}}), + + [{trace, Prt, send, {Prt, {data, [$a|<<123456:32>>]}}, S}] = flush(), + + erlang:port_close(Prt), + [] = flush(), + + ok. + +%% Test that driver_set_timer generate correct trace messages +set_timer(_Config) -> + + Flags = [send,'receive'], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_SET_TIMER>>), + timer:sleep(100), + [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_SET_TIMER>>}}}, + {trace, Prt, 'receive', timeout}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_failure* generate correct trace messages +failure_eof(_Config) -> + + Flags = [send,'receive', ports], + S = trace_ports(Flags), + + Prt = erlang:open_port({spawn, echo_drv}, [eof, binary]), + [{trace, Prt, open, S, echo_drv}, + {trace, Prt, getting_linked, S}] = flush(), + + erlang:port_command(Prt, <<?ECHO_DRV_FAILURE_EOF>>), + recv({Prt,eof}), + [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_FAILURE_EOF>>}}}, + {trace, Prt, send, {Prt, eof}, S}] = flush(), + + close(Prt, Flags), + + %% Run same test without eof option + failure_test(<<?ECHO_DRV_FAILURE_EOF>>, normal). + +failure_atom(_Config) -> + failure_test(<<?ECHO_DRV_FAILURE_ATOM, "failure\0">>, failure). +failure_posix(_Config) -> + failure_test(<<?ECHO_DRV_FAILURE_POSIX>>, eagain). +failure(_Config) -> + failure_test(<<?ECHO_DRV_FAILURE, 1>>, 1). + +failure_test(Failure, Reason) -> + + {Prt, S} = trace_and_open([send, 'receive', ports],[binary]), + + [{trace, Prt, open, S, echo_drv}, + {trace, Prt, getting_linked, S}] = flush(), + + process_flag(trap_exit, true), + erlang:port_command(Prt, Failure), + try + recv({'EXIT',Prt,Reason}) + after + process_flag(trap_exit, false) + end, + [{trace, Prt, 'receive', {S, {command, Failure}}}, + {trace, Prt, closed, Reason}, + {trace, Prt, unlink, S}] = flush(), + + ok. + +%% Test that erl_drv_output_term generate correct trace messages +output_term(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT_TERM, 123456:32>>), + recv({echo, Prt, <<123456:32>>}), + [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_output_term generate correct trace messages +driver_output_term(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_DRIVER_OUTPUT_TERM, 123456:32>>), + recv({echo, Prt, <<123456:32>>}), + [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that erl_drv_send_term generate correct trace messages +send_term(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_SEND_TERM, 123456:32>>), + recv({echo, Prt, <<123456:32>>}), + [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(), + + {Pid, Ref} = spawn_monitor(fun() -> erlang:port_command(Prt, <<?ECHO_DRV_SAVE_CALLER>>) end), + recv({'DOWN',Ref,process,Pid,normal}), + erlang:port_command(Prt, <<?ECHO_DRV_SEND_TERM, 123456:32>>), + [{trace, Prt, send_to_non_existing_process, {echo, Prt, <<123456:32>>}, Pid}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_send_term generate correct trace messages +driver_send_term(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_DRIVER_SEND_TERM, 123456:32>>), + recv({echo, Prt, <<123456:32>>}), + [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(), + + {Pid, Ref} = spawn_monitor(fun() -> erlang:port_command(Prt, <<?ECHO_DRV_SAVE_CALLER>>) end), + recv({'DOWN',Ref,process,Pid,normal}), + erlang:port_command(Prt, <<?ECHO_DRV_SEND_TERM, 123456:32>>), + [{trace, Prt, send_to_non_existing_process, {echo, Prt, <<123456:32>>}, Pid}] = flush(), + + close(Prt, Flags), + + ok. + +%%%%%%%%%%%%%%%%%%% +%% Helper functions +%%%%%%%%%%%%%%%%%%% + +trace_ports(TraceFlags) -> + erlang:trace(new_ports, true, TraceFlags), + self(). + +trace_and_open(TraceFlags, OpenFlags) -> + S = self(), + Ports = proplists:get_value(ports, TraceFlags), + [trace_ports(TraceFlags) || Ports], + Prt = erlang:open_port({spawn, echo_drv}, OpenFlags), + [erlang:trace(Prt, true, TraceFlags) || Ports == undefined], + {Prt, S}. + +close(Prt, Flags) -> + Recv = proplists:get_value('receive', Flags), + Ports = proplists:get_value(ports, Flags), + S = self(), + + erlang:port_close(Prt), + + if Recv, Ports -> + [{trace, Prt, 'receive', {S, close}}, + {trace, Prt, closed, normal}, + {trace, Prt, unlink, S}] = flush(); + Recv -> + [{trace, Prt, 'receive', {S, close}}] = flush(); + Ports -> + [{trace, Prt, closed, normal}, + {trace, Prt, unlink, S}] = flush(); + true -> + [] = flush() + end. + +trace_delivered() -> + Ref = erlang:trace_delivered(all), + receive {trace_delivered, all, Ref} -> ok end. + +flush() -> + flush(all). +flush(From) -> + trace_delivered(), + f(From). + +f(From) -> + receive + M when From =:= all; element(2, M) == From -> + [M | f(From)] + after 0 -> + [] + end. + +recv(Msg) -> + receive Msg -> ok after 100 -> ct:fail({did_not_get_data,Msg,flush()}) end. + +load_drv(Config) -> + Path = proplists:get_value(data_dir, Config), + case erl_ddll:load_driver(Path, echo_drv) of + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + ct:fail(Res) + end. + +reload_drv(Config) -> + erl_ddll:unload_driver(echo_drv), + load_drv(Config). diff --git a/erts/emulator/test/port_trace_SUITE_data/Makefile.src b/erts/emulator/test/port_trace_SUITE_data/Makefile.src new file mode 100644 index 0000000000..c1bf142ccf --- /dev/null +++ b/erts/emulator/test/port_trace_SUITE_data/Makefile.src @@ -0,0 +1,3 @@ +all: echo_drv@dll@ + +@SHLIB_RULES@ diff --git a/erts/emulator/test/port_trace_SUITE_data/echo_drv.c b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c new file mode 100644 index 0000000000..b5ae9389b4 --- /dev/null +++ b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c @@ -0,0 +1,241 @@ +#include <stdio.h> +#include "erl_driver.h" +#include <errno.h> +#include <string.h> + + +/* ------------------------------------------------------------------------- +** Data types +**/ + + +typedef struct _erl_drv_data { + ErlDrvPort erlang_port; + ErlDrvTermData caller; +} EchoDrvData; + +#define ECHO_DRV_NOOP 0 +#define ECHO_DRV_OUTPUT 1 +#define ECHO_DRV_OUTPUT2 2 +#define ECHO_DRV_OUTPUT_BINARY 3 +#define ECHO_DRV_OUTPUTV 4 +#define ECHO_DRV_SET_TIMER 5 +#define ECHO_DRV_FAILURE_EOF 6 +#define ECHO_DRV_FAILURE_ATOM 7 +#define ECHO_DRV_FAILURE_POSIX 8 +#define ECHO_DRV_FAILURE 9 +#define ECHO_DRV_OUTPUT_TERM 10 +#define ECHO_DRV_DRIVER_OUTPUT_TERM 11 +#define ECHO_DRV_SEND_TERM 12 +#define ECHO_DRV_DRIVER_SEND_TERM 13 +#define ECHO_DRV_SAVE_CALLER 14 + + +/* ------------------------------------------------------------------------- +** Entry struct +**/ + +static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command); +static void echo_drv_stop(ErlDrvData drv_data); +static void echo_drv_output(ErlDrvData drv_data, char *buf, + ErlDrvSizeT len); +static void echo_drv_outputv(ErlDrvData drv_data, ErlIOVec *iov); +static void echo_drv_finish(void); +static ErlDrvSSizeT echo_drv_control(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen); +static void echo_drv_timeout(ErlDrvData drv_data); +static ErlDrvSSizeT echo_drv_call(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, + unsigned int *flags); + +static ErlDrvEntry echo_drv_entry = { + NULL, /* init */ + echo_drv_start, + echo_drv_stop, + echo_drv_output, + NULL, /* ready_input */ + NULL, /* ready_output */ + "echo_drv", + echo_drv_finish, + NULL, /* handle */ + echo_drv_control, + echo_drv_timeout, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, /* flush */ + echo_drv_call, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, + NULL, + NULL, + NULL +}; + +/* ------------------------------------------------------------------------- +** Entry functions +**/ + +DRIVER_INIT(echo_drv) +{ + char buff[5]; + size_t size = sizeof(buff); + + if (erl_drv_getenv("OUTPUTV", buff, &size) == -1) { + echo_drv_entry.outputv = NULL; + } else { + echo_drv_entry.outputv = echo_drv_outputv; + } + + return &echo_drv_entry; +} + +static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command) +{ + EchoDrvData *echo_drv_data_p = driver_alloc(sizeof(EchoDrvData)); + echo_drv_data_p->erlang_port = port; + echo_drv_data_p->caller = driver_caller(port); + return echo_drv_data_p; +} + +static void echo_drv_stop(EchoDrvData *data_p) { + driver_free(data_p); +} + +static void echo_drv_outputv(ErlDrvData drv_data, ErlIOVec *iov) +{ + return; +} + +static void echo_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) { + EchoDrvData* data_p = (EchoDrvData *) drv_data; + ErlDrvPort port = data_p->erlang_port; + + switch (buf[0]) { + case ECHO_DRV_OUTPUT: + { + driver_output(port, buf+1, len-1); + break; + } + case ECHO_DRV_OUTPUT2: + { + driver_output2(port, "a", 1, buf+1, len-1); + break; + } + case ECHO_DRV_OUTPUT_BINARY: + { + ErlDrvBinary *bin = driver_alloc_binary(len-1); + memcpy(&bin->orig_bytes, buf+1, len-1); + driver_output_binary(port, "a", 1, bin, 1, len - 2); + driver_free_binary(bin); + break; + } + case ECHO_DRV_OUTPUTV: + { + ErlIOVec iov; + ErlDrvSizeT sz; + driver_enq(port, buf + 1, len - 1); + sz = driver_peekqv(port, &iov); + driver_outputv(port, "a", 1, &iov, 0); + driver_deq(port, sz); + break; + } + case ECHO_DRV_SET_TIMER: + { + driver_set_timer(port, 10); + break; + } + case ECHO_DRV_FAILURE_EOF: + { + driver_failure_eof(port); + break; + } + case ECHO_DRV_FAILURE_ATOM: + { + driver_failure_atom(port, buf+1); + break; + } + case ECHO_DRV_FAILURE_POSIX: + { + driver_failure_posix(port, EAGAIN); + break; + } + case ECHO_DRV_FAILURE: + { + driver_failure(port, buf[1]); + break; + } + case ECHO_DRV_OUTPUT_TERM: + case ECHO_DRV_DRIVER_OUTPUT_TERM: + case ECHO_DRV_SEND_TERM: + case ECHO_DRV_DRIVER_SEND_TERM: + { + ErlDrvTermData term[] = { + ERL_DRV_ATOM, driver_mk_atom("echo"), + ERL_DRV_PORT, driver_mk_port(port), + ERL_DRV_BUF2BINARY, (ErlDrvTermData)(buf+1), + (ErlDrvTermData)(len - 1), + ERL_DRV_TUPLE, 3}; + switch (buf[0]) { + case ECHO_DRV_OUTPUT_TERM: + erl_drv_output_term(driver_mk_port(port), term, sizeof(term) / sizeof(ErlDrvTermData)); + break; + case ECHO_DRV_DRIVER_OUTPUT_TERM: + driver_output_term(port, term, sizeof(term) / sizeof(ErlDrvTermData)); + break; + case ECHO_DRV_SEND_TERM: + driver_send_term(port, data_p->caller, + term, sizeof(term) / sizeof(ErlDrvTermData)); + break; + case ECHO_DRV_DRIVER_SEND_TERM: + erl_drv_send_term(driver_mk_port(port), data_p->caller, + term, sizeof(term) / sizeof(ErlDrvTermData)); + break; + } + break; + } + case ECHO_DRV_SAVE_CALLER: + data_p->caller = driver_caller(port); + break; + default: + break; + } +} + +static void echo_drv_finish() { + +} + +static ErlDrvSSizeT echo_drv_control(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen) +{ + if ((len - 1) > rlen) + *rbuf = driver_alloc(len - 1); + memcpy(*rbuf, buf+1, len-1); + return len-1; +} + +static void echo_drv_timeout(ErlDrvData drv_data) +{ + +} + +static ErlDrvSSizeT echo_drv_call(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, + unsigned int *flags) +{ + if ((len - command) > rlen) + *rbuf = driver_alloc(len - command); + memcpy(*rbuf, buf+command, len-command); + return len-command; +} diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index 97aa5e573e..61a68f9759 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -26,7 +26,7 @@ %% process_info/1,2 %% register/2 (partially) --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(heap_binary_size, 64). @@ -41,6 +41,7 @@ process_info_2_list/1, process_info_lock_reschedule/1, process_info_lock_reschedule2/1, process_info_lock_reschedule3/1, + process_info_garbage_collection/1, bump_reductions/1, low_prio/1, binary_owner/1, yield/1, yield2/1, process_status_exiting/1, otp_4725/1, bad_register/1, garbage_collect/1, otp_6237/1, @@ -66,7 +67,9 @@ -export([hangaround/2, processes_bif_test/0, do_processes/1, processes_term_proc_list_test/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 9}}]. all() -> [spawn_with_binaries, t_exit_1, {group, t_exit_2}, @@ -75,7 +78,9 @@ all() -> process_info_other_dist_msg, process_info_2_list, process_info_lock_reschedule, process_info_lock_reschedule2, - process_info_lock_reschedule3, process_status_exiting, + process_info_lock_reschedule3, + process_info_garbage_collection, + process_status_exiting, bump_reductions, low_prio, yield, yield2, otp_4725, bad_register, garbage_collect, process_info_messages, process_flag_badarg, process_flag_heap_size, @@ -113,7 +118,7 @@ init_per_suite(Config) -> [{started_apps, A}|Config]. end_per_suite(Config) -> - As = ?config(started_apps, Config), + As = proplists:get_value(started_apps, Config), lists:foreach(fun (A) -> application:stop(A) end, As), catch erts_debug:set_internal_state(available_internal_state, false), Config. @@ -125,12 +130,10 @@ end_per_group(_GroupName, Config) -> Config. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(10)), - [{watchdog, Dog},{testcase, Func}|Config]. + [{testcase, Func}|Config]. end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). + ok. fun_spawn(Fun) -> spawn_link(erlang, apply, [Fun, []]). @@ -155,11 +158,10 @@ binary_owner(Bin) when is_binary(Bin) -> %% Tests exit/1 with a big message. t_exit_1(Config) when is_list(Config) -> + ct:timetrap({seconds, 20}), start_spawner(), - Dog = test_server:timetrap(test_server:seconds(20)), process_flag(trap_exit, true), test_server:do_times(10, fun t_exit_1/0), - test_server:timetrap_cancel(Dog), stop_spawner(), ok. @@ -173,11 +175,10 @@ t_exit_1() -> %% Tests exit/2 with a lot of data in the exit message. t_exit_2_other(Config) when is_list(Config) -> + ct:timetrap({seconds, 20}), start_spawner(), - Dog = test_server:timetrap(test_server:seconds(20)), process_flag(trap_exit, true), test_server:do_times(10, fun t_exit_2_other/0), - test_server:timetrap_cancel(Dog), stop_spawner(), ok. @@ -191,34 +192,32 @@ t_exit_2_other() -> %% Tests that exit(Pid, normal) does not kill another process.; t_exit_2_other_normal(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(20)), + ct:timetrap({seconds, 20}), process_flag(trap_exit, true), Pid = fun_spawn(fun() -> receive x -> ok end end), exit(Pid, normal), receive {'EXIT', Pid, Reason} -> - test_server:fail({process_died, Reason}) + ct:fail({process_died, Reason}) after 1000 -> ok end, case process_info(Pid) of undefined -> - test_server:fail(process_died_on_normal); + ct:fail(process_died_on_normal); List when is_list(List) -> ok end, exit(Pid, kill), - test_server:timetrap_cancel(Dog), ok. %% Tests that we can trap an exit message sent with exit/2 from %% the same process. self_exit(Config) when is_list(Config) -> + ct:timetrap({seconds, 10}), start_spawner(), - Dog = test_server:timetrap(test_server:seconds(10)), process_flag(trap_exit, true), test_server:do_times(200, fun self_exit/0), - test_server:timetrap_cancel(Dog), stop_spawner(), ok. @@ -237,7 +236,7 @@ normal_suicide_exit(Config) when is_list(Config) -> Pid = fun_spawn(fun() -> exit(self(), normal) end), receive {'EXIT', Pid, normal} -> ok; - Other -> test_server:fail({bad_message, Other}) + Other -> ct:fail({bad_message, Other}) end. %% Tests exit(self(), Term) is equivalent to exit(Term) for a process @@ -248,7 +247,7 @@ abnormal_suicide_exit(Config) when is_list(Config) -> Pid = fun_spawn(fun() -> exit(self(), Garbage) end), receive {'EXIT', Pid, Garbage} -> ok; - Other -> test_server:fail({bad_message, Other}) + Other -> ct:fail({bad_message, Other}) end. %% Tests that exit(self(), die) cannot be catched. @@ -257,21 +256,20 @@ t_exit_2_catch(Config) when is_list(Config) -> Pid = fun_spawn(fun() -> catch exit(self(), die) end), receive {'EXIT', Pid, normal} -> - test_server:fail(catch_worked); + ct:fail(catch_worked); {'EXIT', Pid, die} -> ok; Other -> - test_server:fail({bad_message, Other}) + ct:fail({bad_message, Other}) end. %% Tests trapping of an 'EXIT' message generated by a bad argument to %% the abs/1 bif. The 'EXIT' message will intentionally be very big. trap_exit_badarg(Config) when is_list(Config) -> + ct:timetrap({seconds, 10}), start_spawner(), - Dog = test_server:timetrap(test_server:seconds(10)), process_flag(trap_exit, true), test_server:do_times(10, fun trap_exit_badarg/0), - test_server:timetrap_cancel(Dog), stop_spawner(), ok. @@ -285,7 +283,7 @@ trap_exit_badarg() -> ok; Other -> ok = io:format("Bad EXIT message: ~P", [Other, 30]), - test_server:fail(bad_exit_message) + ct:fail(bad_exit_message) end. bad_guy(Arg) -> @@ -317,10 +315,9 @@ big_binary(N, Acc) -> %% Test receiving an EXIT message when spawning a BIF with bad arguments. trap_exit_badarg_in_bif(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(10)), + ct:timetrap({seconds, 10}), process_flag(trap_exit, true), test_server:do_times(10, fun trap_exit_badarg_bif/0), - test_server:timetrap_cancel(Dog), ok. trap_exit_badarg_bif() -> @@ -329,7 +326,7 @@ trap_exit_badarg_bif() -> {'EXIT', Pid, {badarg, _}} -> ok; Other -> - test_server:fail({unexpected, Other}) + ct:fail({unexpected, Other}) end. %% The following sequences of events have crasched Beam. @@ -342,15 +339,13 @@ trap_exit_badarg_bif() -> %% 3) The process will crash the next time it executes 'receive'. exit_and_timeout(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(20)), + ct:timetrap({seconds, 20}), process_flag(trap_exit, true), Parent = self(), Low = fun_spawn(fun() -> eat_low(Parent) end), High = fun_spawn(fun() -> eat_high(Low) end), eat_wait_for(Low, High), - - test_server:timetrap_cancel(Dog), ok. @@ -361,7 +356,7 @@ eat_wait_for(Low, High) -> {'EXIT', High, normal} -> eat_wait_for(Low, High); Other -> - test_server:fail({bad_message, Other}) + ct:fail({bad_message, Other}) end. eat_low(_Parent) -> @@ -394,14 +389,12 @@ loop(StopTime) -> %% Tries to send two different exit messages to a process. %% (The second one should be ignored.) exit_twice(Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:seconds(20)), + ct:timetrap({seconds, 20}), process_flag(trap_exit, true), Low = fun_spawn(fun etwice_low/0), High = fun_spawn(fun() -> etwice_high(Low) end), etwice_wait_for(Low, High), - - test_server:timetrap_cancel(Dog), ok. etwice_wait_for(Low, High) -> @@ -409,11 +402,11 @@ etwice_wait_for(Low, High) -> {'EXIT', Low, first} -> ok; {'EXIT', Low, Other} -> - test_server:fail({wrong_exit_reason, Other}); + ct:fail({wrong_exit_reason, Other}); {'EXIT', High, normal} -> etwice_wait_for(Low, High); Other -> - test_server:fail({bad_message, Other}) + ct:fail({bad_message, Other}) end. etwice_low() -> @@ -666,10 +659,6 @@ chk_pi_order([],[]) -> chk_pi_order([{Arg, _}| Values], [Arg|Args]) -> chk_pi_order(Values, Args). -process_info_2_list(doc) -> - []; -process_info_2_list(suite) -> - []; process_info_2_list(Config) when is_list(Config) -> Proc = spawn(fun () -> receive after infinity -> ok end end), register(process_SUITE_process_info_2_list1, self()), @@ -702,10 +691,6 @@ process_info_2_list(Config) when is_list(Config) -> lists:foreach(fun ({backtrace, _}) -> ok end, V3), ok. -process_info_lock_reschedule(doc) -> - []; -process_info_lock_reschedule(suite) -> - []; process_info_lock_reschedule(Config) when is_list(Config) -> %% We need a process that is running and an item that requires %% process_info to take the main process lock. @@ -738,7 +723,7 @@ process_info_lock_reschedule(Config) when is_list(Config) -> exit(Target2, bang), OkStatus; {status, BadStatus} -> - ?t:fail(BadStatus) + ct:fail(BadStatus) end. pi_loop(_Name, _Pid, 0) -> @@ -747,10 +732,6 @@ pi_loop(Name, Pid, N) -> {registered_name, Name} = process_info(Pid, registered_name), pi_loop(Name, Pid, N-1). -process_info_lock_reschedule2(doc) -> - []; -process_info_lock_reschedule2(suite) -> - []; process_info_lock_reschedule2(Config) when is_list(Config) -> Parent = self(), Fun = fun () -> @@ -806,10 +787,6 @@ do_pi_msg_len(PT, AT) -> lists:map(fun (_) -> ok end, [a,b,c,d]), {message_queue_len, _} = process_info(element(2,PT), element(2,AT)). -process_info_lock_reschedule3(doc) -> - []; -process_info_lock_reschedule3(suite) -> - []; process_info_lock_reschedule3(Config) when is_list(Config) -> %% We need a process that is running and an item that requires %% process_info to take the main process lock. @@ -840,7 +817,7 @@ process_info_lock_reschedule3(Config) when is_list(Config) -> exit(Target2, bang), OkStatus; {status, BadStatus} -> - ?t:fail(BadStatus) + ct:fail(BadStatus) end. process_status_exiting(Config) when is_list(Config) -> @@ -932,6 +909,48 @@ start_spawner() -> stop_spawner() -> ok. +%% Tests erlang:process_info(Pid, garbage_collection_info) +process_info_garbage_collection(_Config) -> + Parent = self(), + Pid = spawn_link( + fun() -> + receive go -> ok end, + (fun F(0) -> + Parent ! deep, + receive ok -> ok end, + []; + F(N) -> + timer:sleep(1), + [lists:seq(1,100) | F(N-1)] + end)(1000), + Parent ! shallow, + receive done -> ok end + end), + {garbage_collection_info, Before} = + erlang:process_info(Pid, garbage_collection_info), + Pid ! go, receive deep -> ok end, + {_, Deep} = erlang:process_info(Pid, garbage_collection_info), + Pid ! ok, receive shallow -> ok end, + {_, After} = erlang:process_info(Pid, garbage_collection_info), + Pid ! done, + + %% Do some general checks to see if everything seems to be roughly correct + ct:log("Before: ~p",[Before]), + ct:log("Deep: ~p",[Deep]), + ct:log("After: ~p",[After]), + + %% Check stack_size + true = proplists:get_value(stack_size, Before) < proplists:get_value(stack_size, Deep), + true = proplists:get_value(stack_size, After) < proplists:get_value(stack_size, Deep), + + %% Check used heap size + true = proplists:get_value(heap_size, Before) + proplists:get_value(old_heap_size, Before) + < proplists:get_value(heap_size, Deep) + proplists:get_value(old_heap_size, Deep), + true = proplists:get_value(heap_size, Before) + proplists:get_value(old_heap_size, Before) + < proplists:get_value(heap_size, After) + proplists:get_value(old_heap_size, After), + + ok. + %% Tests erlang:bump_reductions/1. bump_reductions(Config) when is_list(Config) -> erlang:garbage_collect(), @@ -942,10 +961,10 @@ bump_reductions(Config) when is_list(Config) -> case R2-R1 of Diff when Diff < 100 -> ok = io:format("R1 = ~w, R2 = ~w", [R1, R2]), - test_server:fail({small_diff, Diff}); + ct:fail({small_diff, Diff}); Diff when Diff > 110 -> ok = io:format("R1 = ~w, R2 = ~w", [R1, R2]), - test_server:fail({big_diff, Diff}); + ct:fail({big_diff, Diff}); Diff -> io:format("~p\n", [Diff]), ok @@ -984,7 +1003,7 @@ low_prio_test(Config) when is_list(Config) -> process_flag(trap_exit, true), S = spawn_link(?MODULE, prio_server, [0, 0]), PCs = spawn_prio_clients(S, erlang:system_info(schedulers_online)), - timer:sleep(2000), + ct:sleep({seconds,3}), lists:foreach(fun (P) -> exit(P, kill) end, PCs), S ! exit, receive {'EXIT', S, {A, B}} -> check_prio(A, B) end, @@ -1032,8 +1051,7 @@ make_unaligned_sub_binary(Bin0) -> <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), Bin. -yield(doc) -> - "Tests erlang:yield/1."; +%% Tests erlang:yield/1 yield(Config) when is_list(Config) -> case catch erlang:system_info(modified_timing_level) of Level when is_integer(Level) -> @@ -1074,7 +1092,7 @@ yield_test() -> {Diff, _} -> ok = io:format("R1 = ~w, R2 = ~w, Schedcnt = ~w", [R1, R2, Schedcnt]), - test_server:fail({measurement_error, Diff, Schedcnt}) + ct:fail({measurement_error, Diff, Schedcnt}) end. call_yield() -> @@ -1111,8 +1129,6 @@ schedcnt(stop, {Ref, Pid}) when is_reference(Ref), is_pid(Pid) -> Cnt end. -yield2(doc) -> []; -yield2(suite) -> []; yield2(Config) when is_list(Config) -> Me = self(), Go = make_ref(), @@ -1163,7 +1179,7 @@ yield2(Config) when is_list(Config) -> io:format("Reductions = ~p~n", [Reductions]), ok; {RedDiff, Reductions} -> - ?t:fail({unexpected_reduction_count, Reductions}) + ct:fail({unexpected_reduction_count, Reductions}) end, none = next_tmsg(P), @@ -1204,8 +1220,6 @@ fail_register(Name, Process) -> {'EXIT',{badarg,_}} = (catch Name ! anything_goes), ok. -garbage_collect(doc) -> []; -garbage_collect(suite) -> []; garbage_collect(Config) when is_list(Config) -> Prio = process_flag(priority, high), true = erlang:garbage_collect(), @@ -1244,10 +1258,7 @@ garbage_collect(Config) when is_list(Config) -> process_flag(priority, Prio), ok. -process_info_messages(doc) -> - ["This used to cause the nofrag emulator to dump core"]; -process_info_messages(suite) -> - []; +%% This used to cause the nofrag emulator to dump core process_info_messages(Config) when is_list(Config) -> process_info_messages_test(), ok. @@ -1305,10 +1316,6 @@ process_info_messages_test() -> chk_badarg(Fun) -> try Fun(), exit(no_badarg) catch error:badarg -> ok end. -process_flag_badarg(doc) -> - []; -process_flag_badarg(suite) -> - []; process_flag_badarg(Config) when is_list(Config) -> chk_badarg(fun () -> process_flag(gurka, banan) end), chk_badarg(fun () -> process_flag(trap_exit, gurka) end), @@ -1326,8 +1333,6 @@ process_flag_badarg(Config) when is_list(Config) -> -include_lib("stdlib/include/ms_transform.hrl"). -otp_6237(doc) -> []; -otp_6237(suite) -> []; otp_6237(Config) when is_list(Config) -> Slctrs = lists:map(fun (_) -> spawn_link(fun () -> @@ -1394,10 +1399,6 @@ otp_6237_select_loop() -> conses_per_red, debug_level}). -processes_large_tab(doc) -> - []; -processes_large_tab(suite) -> - []; processes_large_tab(Config) when is_list(Config) -> sys_mem_cond_run(2048, fun () -> processes_large_tab_test(Config) end). @@ -1425,7 +1426,7 @@ processes_large_tab_test(Config) -> #ptab_list_bif_info{debug_level = Lvl} when Lvl > MaxDbgLvl -> 20; #ptab_list_bif_info{debug_level = Lvl} when Lvl < 0 -> - ?t:fail({debug_level, Lvl}); + ct:fail({debug_level, Lvl}); #ptab_list_bif_info{debug_level = Lvl} -> Lvl end, @@ -1443,15 +1444,11 @@ processes_large_tab_test(Config) -> [processes_bif_info]) of #ptab_list_bif_info{tab_chunks = Chunks} when is_integer(Chunks), Chunks > 1 -> ok; - PBInfo -> ?t:fail(PBInfo) + PBInfo -> ct:fail(PBInfo) end, stop_node(LargeNode), chk_processes_bif_test_res(Res). -processes_default_tab(doc) -> - []; -processes_default_tab(suite) -> - []; processes_default_tab(Config) when is_list(Config) -> sys_mem_cond_run(1024, fun () -> processes_default_tab_test(Config) end). @@ -1461,10 +1458,6 @@ processes_default_tab_test(Config) -> stop_node(DefaultNode), chk_processes_bif_test_res(Res). -processes_small_tab(doc) -> - []; -processes_small_tab(suite) -> - []; processes_small_tab(Config) when is_list(Config) -> {ok, SmallNode} = start_node(Config, "+P 1024"), Res = rpc:call(SmallNode, ?MODULE, processes_bif_test, []), @@ -1473,10 +1466,6 @@ processes_small_tab(Config) when is_list(Config) -> true = PBInfo#ptab_list_bif_info.tab_chunks < 10, chk_processes_bif_test_res(Res). -processes_this_tab(doc) -> - []; -processes_this_tab(suite) -> - []; processes_this_tab(Config) when is_list(Config) -> Mem = case {erlang:system_info(build_type), erlang:system_info(allocator)} of @@ -1490,7 +1479,7 @@ processes_this_tab(Config) when is_list(Config) -> chk_processes_bif_test_res(ok) -> ok; chk_processes_bif_test_res({comment, _} = Comment) -> Comment; -chk_processes_bif_test_res(Failure) -> ?t:fail(Failure). +chk_processes_bif_test_res(Failure) -> ct:fail(Failure). print_processes_bif_info(#ptab_list_bif_info{min_start_reds = MinStartReds, tab_chunks = TabChunks, @@ -1501,7 +1490,7 @@ print_processes_bif_info(#ptab_list_bif_info{min_start_reds = MinStartReds, term_procs_max_reds = TPMaxReds, conses_per_red = ConsesPerRed, debug_level = DbgLvl}) -> - ?t:format("processes/0 bif info on node ~p:~n" + io:format("processes/0 bif info on node ~p:~n" "Min start reductions = ~p~n" "Process table chunks = ~p~n" "Process table chunks size = ~p~n" @@ -1542,7 +1531,7 @@ processes_unexpected_result(CorrectProcs, Procs) -> status, priority], MissingProcs = CorrectProcs -- Procs, - ?t:format("Missing processes: ~p", + io:format("Missing processes: ~p", [lists:map(fun (Pid) -> [{pid, Pid} | case process_info(Pid, ProcInfo) of @@ -1552,7 +1541,7 @@ processes_unexpected_result(CorrectProcs, Procs) -> end, MissingProcs)]), SuperfluousProcs = Procs -- CorrectProcs, - ?t:format("Superfluous processes: ~p", + io:format("Superfluous processes: ~p", [lists:map(fun (Pid) -> [{pid, Pid} | case process_info(Pid, ProcInfo) of @@ -1561,7 +1550,7 @@ processes_unexpected_result(CorrectProcs, Procs) -> end] end, SuperfluousProcs)]), - ?t:fail(unexpected_result). + ct:fail(unexpected_result). hangaround(Cleaner, Type) -> %% Type is only used to distinguish different processes from @@ -1666,7 +1655,7 @@ do_processes_bif_test(WantReds, DieTest, Processes) -> DoIt = make_ref(), GetGoing = make_ref(), {NoTestProcs, TestProcs} = spawn_initial_hangarounds(Cleaner), - ?t:format("Testing with ~p processes~n", [NoTestProcs]), + io:format("Testing with ~p processes~n", [NoTestProcs]), SpawnHangAround = fun () -> spawn(?MODULE, hangaround, [Cleaner, new_hangaround]) end, @@ -1708,7 +1697,7 @@ do_processes_bif_test(WantReds, DieTest, Processes) -> Procs = lists:sort(Procs0), CorrectProcs = lists:sort(CorrectProcs0), LengthCorrectProcs = length(CorrectProcs), - ?t:format("~p = length(CorrectProcs)~n", [LengthCorrectProcs]), + io:format("~p = length(CorrectProcs)~n", [LengthCorrectProcs]), true = LengthCorrectProcs > NoTestProcs, case CorrectProcs =:= Procs of true -> @@ -1729,12 +1718,12 @@ do_processes_bif_test(WantReds, DieTest, Processes) -> do_processes_bif_die_test(false, _Processes) -> - ?t:format("Skipping test killing process executing processes/0~n",[]), + io:format("Skipping test killing process executing processes/0~n",[]), ok; do_processes_bif_die_test(true, Processes) -> do_processes_bif_die_test(5, Processes); do_processes_bif_die_test(N, Processes) -> - ?t:format("Doing test killing process executing processes/0~n",[]), + io:format("Doing test killing process executing processes/0~n",[]), try Tester = self(), Oooh_Nooooooo = make_ref(), @@ -1784,8 +1773,8 @@ do_processes_bif_die_test(N, Processes) -> ok catch throw:{kill_in_trap, R} when N > 0 -> - ?t:format("Failed to kill in trap: ~p~n", [R]), - ?t:format("Trying again~n", []), + io:format("Failed to kill in trap: ~p~n", [R]), + io:format("Trying again~n", []), do_processes_bif_die_test(N-1, Processes) end. @@ -1815,7 +1804,7 @@ wait_until_system_recover(Tmr) -> receive {timeout, Tmr, _} -> Comment = "WARNING: Test processes still hanging around!", - ?t:format("~s~n", [Comment]), + io:format("~s~n", [Comment]), put(processes_bif_testcase_comment, Comment), lists:foreach( fun (P) when P == self() -> @@ -1823,7 +1812,7 @@ wait_until_system_recover(Tmr) -> (P) -> case process_info(P, initial_call) of {initial_call,{?MODULE, _, _} = MFA} -> - ?t:format("~p ~p~n", [P, MFA]); + io:format("~p ~p~n", [P, MFA]); {initial_call,{_, _, _}} -> ok; undefined -> @@ -1839,10 +1828,6 @@ wait_until_system_recover(Tmr) -> receive {timeout, Tmr, _} -> ok after 0 -> ok end, ok. -processes_last_call_trap(doc) -> - []; -processes_last_call_trap(suite) -> - []; processes_last_call_trap(Config) when is_list(Config) -> enable_internal_state(), Processes = fun () -> processes() end, @@ -1865,10 +1850,6 @@ processes_last_call_trap(Config) when is_list(Config) -> my_processes() -> processes(). -processes_apply_trap(doc) -> - []; -processes_apply_trap(suite) -> - []; processes_apply_trap(Config) when is_list(Config) -> enable_internal_state(), PBInfo = erts_debug:get_internal_state(processes_bif_info), @@ -1883,10 +1864,6 @@ processes_apply_trap(Config) when is_list(Config) -> apply(erlang, processes, []) end, lists:seq(1,100)). -processes_gc_trap(doc) -> - []; -processes_gc_trap(suite) -> - []; processes_gc_trap(Config) when is_list(Config) -> Tester = self(), enable_internal_state(), @@ -1925,10 +1902,6 @@ processes_gc_trap(Config) when is_list(Config) -> exit(Suspendee, bang), ok. -process_flag_heap_size(doc) -> - []; -process_flag_heap_size(suite) -> - []; process_flag_heap_size(Config) when is_list(Config) -> HSize = 2586, % must be gc fib+ number VHSize = 318187, % must be gc fib+ number @@ -1940,10 +1913,6 @@ process_flag_heap_size(Config) when is_list(Config) -> VHSize = erlang:process_flag(min_bin_vheap_size, OldVHmin), ok. -spawn_opt_heap_size(doc) -> - []; -spawn_opt_heap_size(suite) -> - []; spawn_opt_heap_size(Config) when is_list(Config) -> HSize = 987, % must be gc fib+ number VHSize = 46422, % must be gc fib+ number @@ -1954,10 +1923,6 @@ spawn_opt_heap_size(Config) when is_list(Config) -> Pid ! stop, ok. -processes_term_proc_list(doc) -> - []; -processes_term_proc_list(suite) -> - []; processes_term_proc_list(Config) when is_list(Config) -> Tester = self(), as_expected = processes_term_proc_list_test(false), @@ -2107,24 +2072,12 @@ processes_term_proc_list_test(MustChk) -> as_expected. -otp_7738_waiting(doc) -> - []; -otp_7738_waiting(suite) -> - []; otp_7738_waiting(Config) when is_list(Config) -> otp_7738_test(waiting). -otp_7738_suspended(doc) -> - []; -otp_7738_suspended(suite) -> - []; otp_7738_suspended(Config) when is_list(Config) -> otp_7738_test(suspended). -otp_7738_resume(doc) -> - []; -otp_7738_resume(suite) -> - []; otp_7738_resume(Config) when is_list(Config) -> otp_7738_test(resume). @@ -2193,8 +2146,8 @@ do_otp_7738_test(Type) -> ok after 2000 -> I = process_info(R, [status, message_queue_len]), - ?t:format("~p~n", [I]), - ?t:fail(no_progress) + io:format("~p~n", [I]), + ct:fail(no_progress) end, ok. @@ -2281,7 +2234,7 @@ no_priority_inversion2(Config) when is_list(Config) -> RH = request_gc(PL, high), receive {garbage_collect, _, _} -> - ?t:fail(unexpected_gc) + ct:fail(unexpected_gc) after 1000 -> ok end, @@ -2390,7 +2343,7 @@ gc_request_when_gc_disabled(Config) when is_list(Config) -> async = garbage_collect(P, [{async, ReqId}]), receive {garbage_collect, ReqId, Result} -> - ?t:fail({unexpected_gc, Result}); + ct:fail({unexpected_gc, Result}); {P, gc_state, true} -> ok end, @@ -2460,15 +2413,15 @@ start_node(Config, Args) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" - ++ atom_to_list(?config(testcase, Config)) + ++ atom_to_list(proplists:get_value(testcase, Config)) ++ "-" ++ integer_to_list(erlang:system_time(seconds)) ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), - ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). + test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). enable_internal_state() -> case catch erts_debug:get_internal_state(available_internal_state) of diff --git a/erts/emulator/test/pseudoknot_SUITE.erl b/erts/emulator/test/pseudoknot_SUITE.erl index 58ef3cd563..ed4d40ac65 100644 --- a/erts/emulator/test/pseudoknot_SUITE.erl +++ b/erts/emulator/test/pseudoknot_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/random_iolist.erl b/erts/emulator/test/random_iolist.erl index 9a0f034e72..555f063e0a 100644 --- a/erts/emulator/test/random_iolist.erl +++ b/erts/emulator/test/random_iolist.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -36,7 +36,7 @@ run2(Iter,Fun1,Fun2) -> compare2(Iter,Fun1,Fun2). random_byte() -> - random:uniform(256) - 1. + rand:uniform(256) - 1. random_list(0,Acc) -> Acc; @@ -45,7 +45,7 @@ random_list(N,Acc) -> random_binary(N) -> B = list_to_binary(random_list(N,[])), - case {random:uniform(2),size(B)} of + case {rand:uniform(2),size(B)} of {2,M} when M > 1 -> S = M-1, <<_:3,C:S/binary,_:5>> = B, @@ -57,7 +57,7 @@ random_list(N) -> random_list(N,[]). front() -> - case random:uniform(10) of + case rand:uniform(10) of 10 -> false; _ -> @@ -65,7 +65,7 @@ front() -> end. any_type() -> - case random:uniform(10) of + case rand:uniform(10) of 1 -> list; 2 -> @@ -77,7 +77,7 @@ any_type() -> end. tail_type() -> - case random:uniform(5) of + case rand:uniform(5) of 1 -> list; 2 -> @@ -90,9 +90,9 @@ random_length(N) -> UpperLimit = 255, case N of M when M > UpperLimit -> - random:uniform(UpperLimit+1) - 1; + rand:uniform(UpperLimit+1) - 1; _ -> - random:uniform(N+1) - 1 + rand:uniform(N+1) - 1 end. random_iolist(0,Acc) -> @@ -139,7 +139,7 @@ random_iolist(N) -> standard_seed() -> - random:seed(1201,855653,380975). + rand:seed(exsplus, {1201,855653,380975}). do_comp(List,F1,F2) -> X = F1(List), diff --git a/erts/emulator/test/receive_SUITE.erl b/erts/emulator/test/receive_SUITE.erl index ccae0df72e..83653a7a36 100644 --- a/erts/emulator/test/receive_SUITE.erl +++ b/erts/emulator/test/receive_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,15 +22,14 @@ %% Tests receive after. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, call_with_huge_message_queue/1,receive_in_between/1]). --export([init_per_testcase/2,end_per_testcase/2]). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> [call_with_huge_message_queue, receive_in_between]. @@ -38,27 +37,6 @@ all() -> groups() -> []. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(3)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - call_with_huge_message_queue(Config) when is_list(Config) -> Pid = spawn_link(fun echo_loop/0), @@ -77,8 +55,7 @@ call_with_huge_message_queue(Config) when is_list(Config) -> Q when Q < 10 -> ok; Q -> - io:format("Best Q = ~p", [Q]), - ?t:fail() + ct:fail("Best Q = ~p", [Q]) end, ok. diff --git a/erts/emulator/test/ref_SUITE.erl b/erts/emulator/test/ref_SUITE.erl index 1042c23d65..5f519d522e 100644 --- a/erts/emulator/test/ref_SUITE.erl +++ b/erts/emulator/test/ref_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,54 +20,29 @@ -module(ref_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([all/0, suite/0]). -export([wrap_1/1]). -export([loop_ref/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -init_per_testcase(_, Config) -> - ?line Dog=test_server:timetrap(test_server:minutes(2)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_, Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> [wrap_1]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -wrap_1(doc) -> "Check that refs don't wrap around easily."; +%% Check that refs don't wrap around easily. wrap_1(Config) when is_list(Config) -> - ?line spawn_link(?MODULE, loop_ref, [self()]), - ?line receive - done -> - test_server:fail(wrapfast) - after 30000 -> - ok - end, + spawn_link(?MODULE, loop_ref, [self()]), + receive + done -> + ct:fail(wrapfast) + after 30000 -> + ok + end, ok. loop_ref(Parent) -> diff --git a/erts/emulator/test/register_SUITE.erl b/erts/emulator/test/register_SUITE.erl index 5ecca0f547..43ae749498 100644 --- a/erts/emulator/test/register_SUITE.erl +++ b/erts/emulator/test/register_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,47 +23,20 @@ %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). --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([all/0, suite/0]). -export([otp_8099/1]). --define(DEFAULT_TIMEOUT, ?t:minutes(2)). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> [otp_8099]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Case, Config) when is_list(Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, Dog}, {testcase, Case} | Config]. - -end_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - %% %% Test cases %% @@ -83,25 +56,20 @@ otp_8099(Config) when is_list(Config) -> otp_8099_test(0) -> ok; otp_8099_test(N) -> - ?line P = spawn(fun () -> otp_8099_proc() end), - ?line case catch register(?OTP_8099_NAME, P) of + P = spawn(fun () -> otp_8099_proc() end), + case catch register(?OTP_8099_NAME, P) of true -> - ?line ok; + ok; _ -> - ?line OP = whereis(?OTP_8099_NAME), - ?line (catch unregister(?OTP_8099_NAME)), - ?line (catch exit(OP, kill)), - ?line true = (catch register(?OTP_8099_NAME, P)) + OP = whereis(?OTP_8099_NAME), + (catch unregister(?OTP_8099_NAME)), + (catch exit(OP, kill)), + true = (catch register(?OTP_8099_NAME, P)) end, - ?line P = whereis(?OTP_8099_NAME), - ?line exit(P, kill), - ?line otp_8099_test(N-1). + P = whereis(?OTP_8099_NAME), + exit(P, kill), + otp_8099_test(N-1). otp_8099_proc() -> receive _ -> ok end, otp_8099_proc(). - -%% -%% Utils -%% - diff --git a/erts/emulator/test/save_calls_SUITE.erl b/erts/emulator/test/save_calls_SUITE.erl index 4e50fdc898..af1a0d35d6 100644 --- a/erts/emulator/test/save_calls_SUITE.erl +++ b/erts/emulator/test/save_calls_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,12 +20,9 @@ -module(save_calls_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --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([all/0, suite/0, init_per_testcase/2,end_per_testcase/2]). -export([save_calls_1/1,dont_break_reductions/1]). @@ -36,36 +33,21 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [save_calls_1, dont_break_reductions]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - init_per_testcase(dont_break_reductions,Config) -> %% Skip on --enable-native-libs as hipe rescedules after each %% function call. case erlang:system_info(hipe_architecture) of - undefined -> - Config; - Architecture -> - {lists, ListsBinary, _ListsFilename} = code:get_object_code(lists), - ChunkName = hipe_unified_loader:chunk_name(Architecture), - NativeChunk = beam_lib:chunks(ListsBinary, [ChunkName]), - case NativeChunk of - {ok,{_,[{_,Bin}]}} when is_binary(Bin) -> - {skip,"Does not work for --enable-native-libs"}; - {error, beam_lib, _} -> Config - end + undefined -> + Config; + Architecture -> + {lists, ListsBinary, _ListsFilename} = code:get_object_code(lists), + ChunkName = hipe_unified_loader:chunk_name(Architecture), + NativeChunk = beam_lib:chunks(ListsBinary, [ChunkName]), + case NativeChunk of + {ok,{_,[{_,Bin}]}} when is_binary(Bin) -> + {skip,"Does not work for --enable-native-libs"}; + {error, beam_lib, _} -> Config + end end; init_per_testcase(_,Config) -> Config. @@ -73,92 +55,89 @@ init_per_testcase(_,Config) -> end_per_testcase(_,_Config) -> ok. -dont_break_reductions(suite) -> - []; -dont_break_reductions(doc) -> - ["Check that save_calls dont break reduction-based scheduling"]; +%% Check that save_calls dont break reduction-based scheduling dont_break_reductions(Config) when is_list(Config) -> - ?line RPS1 = reds_per_sched(0), - ?line RPS2 = reds_per_sched(20), - ?line Diff = abs(RPS1 - RPS2), - ?line true = (Diff < (0.05 * RPS1)), + RPS1 = reds_per_sched(0), + RPS2 = reds_per_sched(20), + Diff = abs(RPS1 - RPS2), + true = (Diff < (0.05 * RPS1)), ok. reds_per_sched(SaveCalls) -> - ?line Parent = self(), - ?line HowMany = 10000, - ?line Pid = spawn(fun() -> - process_flag(save_calls,SaveCalls), - receive - go -> - carmichaels_below(HowMany), - Parent ! erlang:process_info(self(),reductions) - end - end), - ?line TH = spawn(fun() -> trace_handler(0,Parent,Pid) end), - ?line erlang:trace(Pid, true,[running,procs,{tracer,TH}]), - ?line Pid ! go, - ?line {Sched,Reds} = receive - {accumulated,X} -> - receive {reductions,Y} -> - {X,Y} - after 30000 -> - timeout - end - after 30000 -> - timeout - end, - ?line Reds div Sched. + Parent = self(), + HowMany = 10000, + Pid = spawn(fun() -> + process_flag(save_calls,SaveCalls), + receive + go -> + carmichaels_below(HowMany), + Parent ! erlang:process_info(self(),reductions) + end + end), + TH = spawn(fun() -> trace_handler(0,Parent,Pid) end), + erlang:trace(Pid, true,[running,procs,{tracer,TH}]), + Pid ! go, + {Sched,Reds} = receive + {accumulated,X} -> + receive {reductions,Y} -> + {X,Y} + after 30000 -> + timeout + end + after 30000 -> + timeout + end, + Reds div Sched. trace_handler(Acc,Parent,Client) -> receive - {trace,Client,out,_} -> - trace_handler(Acc+1,Parent,Client); - {trace,Client,exit,_} -> - Parent ! {accumulated, Acc}; - _ -> - trace_handler(Acc,Parent,Client) + {trace,Client,out,_} -> + trace_handler(Acc+1,Parent,Client); + {trace,Client,exit,_} -> + Parent ! {accumulated, Acc}; + _ -> + trace_handler(Acc,Parent,Client) after 10000 -> - ok + ok end. -save_calls_1(doc) -> "Test call saving."; +%% Test call saving. save_calls_1(Config) when is_list(Config) -> case test_server:is_native(?MODULE) of - true -> {skipped,"Native code"}; - false -> save_calls_1() + true -> {skipped,"Native code"}; + false -> save_calls_1() end. - + save_calls_1() -> - ?line erlang:process_flag(self(), save_calls, 0), - ?line {last_calls, false} = process_info(self(), last_calls), - - ?line erlang:process_flag(self(), save_calls, 10), - ?line {last_calls, _L1} = process_info(self(), last_calls), - ?line ?MODULE:do_bipp(), - ?line {last_calls, L2} = process_info(self(), last_calls), - ?line L21 = lists:filter(fun is_local_function/1, L2), - ?line case L21 of - [{?MODULE,do_bipp,0}, - timeout, - 'send', - {?MODULE,do_bopp,1}, - 'receive', - timeout, - {?MODULE,do_bepp,0}] -> - ok; - X -> - test_server:fail({l21, X}) - end, - - ?line erlang:process_flag(self(), save_calls, 10), - ?line {last_calls, L3} = process_info(self(), last_calls), + erlang:process_flag(self(), save_calls, 0), + {last_calls, false} = process_info(self(), last_calls), + + erlang:process_flag(self(), save_calls, 10), + {last_calls, _L1} = process_info(self(), last_calls), + ?MODULE:do_bipp(), + {last_calls, L2} = process_info(self(), last_calls), + L21 = lists:filter(fun is_local_function/1, L2), + case L21 of + [{?MODULE,do_bipp,0}, + timeout, + 'send', + {?MODULE,do_bopp,1}, + 'receive', + timeout, + {?MODULE,do_bepp,0}] -> + ok; + X -> + ct:fail({l21, X}) + end, + + erlang:process_flag(self(), save_calls, 10), + {last_calls, L3} = process_info(self(), last_calls), true = (L3 /= false), - ?line L31 = lists:filter(fun is_local_function/1, L3), - ?line [] = L31, + L31 = lists:filter(fun is_local_function/1, L3), + [] = L31, erlang:process_flag(self(), save_calls, 0), %% Also check that it works on another process ... @@ -183,7 +162,7 @@ do_bapp() -> do_bopp(T) -> receive - X -> X + X -> X after T -> ok end. @@ -200,25 +179,25 @@ is_local_function(_) -> % Number crunching for reds test. carmichaels_below(N) -> - random:seed(3172,9814,20125), + rand:seed(exsplus, {3172,9814,20125}), carmichaels_below(1,N). carmichaels_below(N,N2) when N >= N2 -> 0; carmichaels_below(N,N2) -> X = case fast_prime(N,10) of - false -> 0; - true -> - case fast_prime2(N,10) of - true -> - %io:format("Prime: ~p~n",[N]), - 0; - false -> - io:format("Carmichael: ~p (dividable by ~p)~n", - [N,smallest_divisor(N)]), - 1 - end - end, + false -> 0; + true -> + case fast_prime2(N,10) of + true -> + %io:format("Prime: ~p~n",[N]), + 0; + false -> + io:format("Carmichael: ~p (dividable by ~p)~n", + [N,smallest_divisor(N)]), + 1 + end + end, X+carmichaels_below(N+2,N2). expmod(_,E,_) when E == 0 -> @@ -230,7 +209,7 @@ expmod(Base,Exp,Mod) -> (Base * expmod(Base,Exp - 1,Mod)) rem Mod. uniform(N) -> - random:uniform(N-1). + rand:uniform(N-1). fermat(N) -> R = uniform(N), @@ -242,30 +221,30 @@ do_fast_prime(_N,0) -> true; do_fast_prime(N,Times) -> case fermat(N) of - true -> - do_fast_prime(N,Times-1); - false -> - false + true -> + do_fast_prime(N,Times-1); + false -> + false end. - + fast_prime(N,T) -> do_fast_prime(N,T). expmod2(_,E,_) when E == 0 -> 1; expmod2(Base,Exp,Mod) when (Exp rem 2) == 0 -> -%% Uncomment the code below to simulate scheduling bug! -% case erlang:process_info(self(),last_calls) of -% {last_calls,false} -> ok; -% _ -> erlang:yield() -% end, + %% Uncomment the code below to simulate scheduling bug! + % case erlang:process_info(self(),last_calls) of + % {last_calls,false} -> ok; + % _ -> erlang:yield() + % end, X = expmod2(Base,Exp div 2,Mod), Y=(X*X) rem Mod, if - Y == 1, X =/= 1, X =/= (Mod - 1) -> - 0; - true -> - Y rem Mod + Y == 1, X =/= 1, X =/= (Mod - 1) -> + 0; + true -> + Y rem Mod end; expmod2(Base,Exp,Mod) -> (Base * expmod2(Base,Exp - 1,Mod)) rem Mod. @@ -280,12 +259,12 @@ do_fast_prime2(_N,0) -> true; do_fast_prime2(N,Times) -> case miller_rabbin(N) of - true -> - do_fast_prime2(N,Times-1); - false -> - false + true -> + do_fast_prime2(N,Times-1); + false -> + false end. - + fast_prime2(N,T) -> do_fast_prime2(N,T). @@ -294,17 +273,16 @@ smallest_divisor(N) -> find_divisor(N,TD) -> if - TD*TD > N -> - N; - true -> - case divides(TD,N) of - true -> - TD; - false -> - find_divisor(N,TD+1) - end + TD*TD > N -> + N; + true -> + case divides(TD,N) of + true -> + TD; + false -> + find_divisor(N,TD+1) + end end. divides(A,B) -> (B rem A) == 0. - diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 986a73ebb1..6b49b68ec8 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2011. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -31,12 +31,12 @@ %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). --export([all/0, suite/0,groups/0,init_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2, end_per_suite/1]). +-export([all/0, suite/0, groups/0, + init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2]). -export([equal/1, few_low/1, @@ -54,23 +54,25 @@ sct_cmd/1, sbt_cmd/1, scheduler_threads/1, + scheduler_suspend_basic/1, scheduler_suspend/1, dirty_scheduler_threads/1, + dirty_scheduler_exit/1, reader_groups/1]). --define(DEFAULT_TIMEOUT, ?t:minutes(15)). - --define(MIN_SCHEDULER_TEST_TIMEOUT, ?t:minutes(1)). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 15}}]. all() -> [equal, few_low, many_low, equal_with_part_time_high, equal_with_part_time_max, equal_and_high_with_part_time_max, equal_with_high, - equal_with_high_max, bound_process, - {group, scheduler_bind}, scheduler_threads, scheduler_suspend, - dirty_scheduler_threads, + equal_with_high_max, + bound_process, + {group, scheduler_bind}, scheduler_threads, + scheduler_suspend_basic, scheduler_suspend, + dirty_scheduler_threads, dirty_scheduler_exit, reader_groups]. groups() -> @@ -85,12 +87,6 @@ end_per_suite(Config) -> catch erts_debug:set_internal_state(available_internal_state, false), Config. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - init_per_testcase(update_cpu_info, Config) -> case os:find_executable("taskset") of false -> @@ -102,15 +98,12 @@ init_per_testcase(Case, Config) when is_list(Config) -> init_per_tc(Case, Config). init_per_tc(Case, Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), process_flag(priority, max), erlang:display({'------------', ?MODULE, Case, '------------'}), OkRes = ok, - [{watchdog, Dog}, {testcase, Case}, {ok_res, OkRes} |Config]. + [{testcase, Case}, {ok_res, OkRes} |Config]. end_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), ok. -define(ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED, (2000*2000)). @@ -130,130 +123,130 @@ many_low(Config) when is_list(Config) -> low_normal_test(Config, 2*active_schedulers(), 1000). low_normal_test(Config, NW, LW) -> - ?line Tracer = start_tracer(), - ?line Low = workers(LW, low), - ?line Normal = workers(NW, normal), - ?line Res = do_it(Tracer, Low, Normal, [], []), - ?line chk_result(Res, LW, NW, 0, 0, true, false, false), - ?line workers_exit([Low, Normal]), - ?line ok(Res, Config). + Tracer = start_tracer(), + Low = workers(LW, low), + Normal = workers(NW, normal), + Res = do_it(Tracer, Low, Normal, [], []), + chk_result(Res, LW, NW, 0, 0, true, false, false), + workers_exit([Low, Normal]), + ok(Res, Config). equal_with_part_time_high(Config) when is_list(Config) -> - ?line NW = 500, - ?line LW = 500, - ?line HW = 1, - ?line Tracer = start_tracer(), - ?line Normal = workers(NW, normal), - ?line Low = workers(LW, low), - ?line High = part_time_workers(HW, high), - ?line Res = do_it(Tracer, Low, Normal, High, []), - ?line chk_result(Res, LW, NW, HW, 0, true, true, false), - ?line workers_exit([Low, Normal, High]), - ?line ok(Res, Config). + NW = 500, + LW = 500, + HW = 1, + Tracer = start_tracer(), + Normal = workers(NW, normal), + Low = workers(LW, low), + High = part_time_workers(HW, high), + Res = do_it(Tracer, Low, Normal, High, []), + chk_result(Res, LW, NW, HW, 0, true, true, false), + workers_exit([Low, Normal, High]), + ok(Res, Config). equal_and_high_with_part_time_max(Config) when is_list(Config) -> - ?line NW = 500, - ?line LW = 500, - ?line HW = 500, - ?line MW = 1, - ?line Tracer = start_tracer(), - ?line Low = workers(LW, low), - ?line Normal = workers(NW, normal), - ?line High = workers(HW, high), - ?line Max = part_time_workers(MW, max), - ?line Res = do_it(Tracer, Low, Normal, High, Max), - ?line chk_result(Res, LW, NW, HW, MW, false, true, true), - ?line workers_exit([Low, Normal, Max]), - ?line ok(Res, Config). + NW = 500, + LW = 500, + HW = 500, + MW = 1, + Tracer = start_tracer(), + Low = workers(LW, low), + Normal = workers(NW, normal), + High = workers(HW, high), + Max = part_time_workers(MW, max), + Res = do_it(Tracer, Low, Normal, High, Max), + chk_result(Res, LW, NW, HW, MW, false, true, true), + workers_exit([Low, Normal, Max]), + ok(Res, Config). equal_with_part_time_max(Config) when is_list(Config) -> - ?line NW = 500, - ?line LW = 500, - ?line MW = 1, - ?line Tracer = start_tracer(), - ?line Low = workers(LW, low), - ?line Normal = workers(NW, normal), - ?line Max = part_time_workers(MW, max), - ?line Res = do_it(Tracer, Low, Normal, [], Max), - ?line chk_result(Res, LW, NW, 0, MW, true, false, true), - ?line workers_exit([Low, Normal, Max]), - ?line ok(Res, Config). + NW = 500, + LW = 500, + MW = 1, + Tracer = start_tracer(), + Low = workers(LW, low), + Normal = workers(NW, normal), + Max = part_time_workers(MW, max), + Res = do_it(Tracer, Low, Normal, [], Max), + chk_result(Res, LW, NW, 0, MW, true, false, true), + workers_exit([Low, Normal, Max]), + ok(Res, Config). equal_with_high(Config) when is_list(Config) -> - ?line NW = 500, - ?line LW = 500, - ?line HW = 1, - ?line Tracer = start_tracer(), - ?line Low = workers(LW, low), - ?line Normal = workers(NW, normal), - ?line High = workers(HW, high), - ?line Res = do_it(Tracer, Low, Normal, High, []), - ?line LNExe = case active_schedulers() of + NW = 500, + LW = 500, + HW = 1, + Tracer = start_tracer(), + Low = workers(LW, low), + Normal = workers(NW, normal), + High = workers(HW, high), + Res = do_it(Tracer, Low, Normal, High, []), + LNExe = case active_schedulers() of S when S =< HW -> false; _ -> true end, - ?line chk_result(Res, LW, NW, HW, 0, LNExe, true, false), - ?line workers_exit([Low, Normal, High]), - ?line ok(Res, Config). + chk_result(Res, LW, NW, HW, 0, LNExe, true, false), + workers_exit([Low, Normal, High]), + ok(Res, Config). equal_with_high_max(Config) when is_list(Config) -> - ?line NW = 500, - ?line LW = 500, - ?line HW = 1, - ?line MW = 1, - ?line Tracer = start_tracer(), - ?line Normal = workers(NW, normal), - ?line Low = workers(LW, low), - ?line High = workers(HW, high), - ?line Max = workers(MW, max), - ?line Res = do_it(Tracer, Low, Normal, High, Max), - ?line {LNExe, HExe} = case active_schedulers() of + NW = 500, + LW = 500, + HW = 1, + MW = 1, + Tracer = start_tracer(), + Normal = workers(NW, normal), + Low = workers(LW, low), + High = workers(HW, high), + Max = workers(MW, max), + Res = do_it(Tracer, Low, Normal, High, Max), + {LNExe, HExe} = case active_schedulers() of S when S =< MW -> {false, false}; S when S =< (MW + HW) -> {false, true}; _ -> {true, true} end, - ?line chk_result(Res, LW, NW, HW, MW, LNExe, HExe, true), - ?line workers_exit([Low, Normal, Max]), - ?line ok(Res, Config). + chk_result(Res, LW, NW, HW, MW, LNExe, HExe, true), + workers_exit([Low, Normal, Max]), + ok(Res, Config). bound_process(Config) when is_list(Config) -> case erlang:system_info(run_queues) == erlang:system_info(schedulers) of - true -> - ?line NStartBase = 20000, - ?line NStart = case {erlang:system_info(debug_compiled), - erlang:system_info(lock_checking)} of - {true, true} -> NStartBase div 100; - {_, true} -> NStartBase div 10; - _ -> NStartBase - end, - ?line MStart = 100, - ?line Seq = lists:seq(1, 100), - ?line Tester = self(), - ?line Procs = lists:map( - fun (N) when N rem 2 == 0 -> - spawn_opt(fun () -> - bound_loop(NStart, - NStart, - MStart, - 1), - Tester ! {self(), done} - end, - [{scheduler, 1}, link]); - (_N) -> - spawn_link(fun () -> - bound_loop(NStart, - NStart, - MStart, - false), - Tester ! {self(), done} - end) - end, - Seq), - ?line lists:foreach(fun (P) -> receive {P, done} -> ok end end, - Procs), - ?line ok; - false -> - {skipped, "Functionality not supported"} + true -> + NStartBase = 20000, + NStart = case {erlang:system_info(debug_compiled), + erlang:system_info(lock_checking)} of + {true, true} -> NStartBase div 100; + {_, true} -> NStartBase div 10; + _ -> NStartBase + end, + MStart = 100, + Seq = lists:seq(1, 100), + Tester = self(), + Procs = lists:map( + fun (N) when N rem 2 == 0 -> + spawn_opt(fun () -> + bound_loop(NStart, + NStart, + MStart, + 1), + Tester ! {self(), done} + end, + [{scheduler, 1}, link]); + (_N) -> + spawn_link(fun () -> + bound_loop(NStart, + NStart, + MStart, + false), + Tester ! {self(), done} + end) + end, + Seq), + lists:foreach(fun (P) -> receive {P, done} -> ok end end, + Procs), + ok; + false -> + {skipped, "Functionality not supported"} end. bound_loop(_, 0, 0, _) -> @@ -487,59 +480,59 @@ bound_loop(NS, N, M, Sched) -> ":L30-31t0-1c15n3p0"). -define(TOPOLOGY_F_TERM, - [{processor,[{node,[{core,[{thread,{logical,0}}, - {thread,{logical,1}}]}, - {core,[{thread,{logical,2}}, - {thread,{logical,3}}]}, - {core,[{thread,{logical,4}}, - {thread,{logical,5}}]}, - {core,[{thread,{logical,6}}, - {thread,{logical,7}}]}]}, - {node,[{core,[{thread,{logical,8}}, - {thread,{logical,9}}]}, - {core,[{thread,{logical,10}}, - {thread,{logical,11}}]}, - {core,[{thread,{logical,12}}, - {thread,{logical,13}}]}, - {core,[{thread,{logical,14}}, - {thread,{logical,15}}]}]}, - {node,[{core,[{thread,{logical,16}}, - {thread,{logical,17}}]}, - {core,[{thread,{logical,18}}, - {thread,{logical,19}}]}, - {core,[{thread,{logical,20}}, - {thread,{logical,21}}]}, - {core,[{thread,{logical,22}}, - {thread,{logical,23}}]}]}, - {node,[{core,[{thread,{logical,24}}, - {thread,{logical,25}}]}, - {core,[{thread,{logical,26}}, - {thread,{logical,27}}]}, - {core,[{thread,{logical,28}}, - {thread,{logical,29}}]}, - {core,[{thread,{logical,30}}, - {thread,{logical,31}}]}]}]}]). + [{processor,[{node,[{core,[{thread,{logical,0}}, + {thread,{logical,1}}]}, + {core,[{thread,{logical,2}}, + {thread,{logical,3}}]}, + {core,[{thread,{logical,4}}, + {thread,{logical,5}}]}, + {core,[{thread,{logical,6}}, + {thread,{logical,7}}]}]}, + {node,[{core,[{thread,{logical,8}}, + {thread,{logical,9}}]}, + {core,[{thread,{logical,10}}, + {thread,{logical,11}}]}, + {core,[{thread,{logical,12}}, + {thread,{logical,13}}]}, + {core,[{thread,{logical,14}}, + {thread,{logical,15}}]}]}, + {node,[{core,[{thread,{logical,16}}, + {thread,{logical,17}}]}, + {core,[{thread,{logical,18}}, + {thread,{logical,19}}]}, + {core,[{thread,{logical,20}}, + {thread,{logical,21}}]}, + {core,[{thread,{logical,22}}, + {thread,{logical,23}}]}]}, + {node,[{core,[{thread,{logical,24}}, + {thread,{logical,25}}]}, + {core,[{thread,{logical,26}}, + {thread,{logical,27}}]}, + {core,[{thread,{logical,28}}, + {thread,{logical,29}}]}, + {core,[{thread,{logical,30}}, + {thread,{logical,31}}]}]}]}]). bindings(Node, BindType) -> Parent = self(), Ref = make_ref(), Pid = spawn_link(Node, - fun () -> - enable_internal_state(), - Res = (catch erts_debug:get_internal_state( - {fake_scheduler_bindings, - BindType})), - Parent ! {Ref, Res} - end), + fun () -> + enable_internal_state(), + Res = (catch erts_debug:get_internal_state( + {fake_scheduler_bindings, + BindType})), + Parent ! {Ref, Res} + end), receive - {Ref, Res} -> - ?t:format("~p: ~p~n", [BindType, Res]), - unlink(Pid), - Res + {Ref, Res} -> + io:format("~p: ~p~n", [BindType, Res]), + unlink(Pid), + Res end. scheduler_bind_types(Config) when is_list(Config) -> - ?line OldRelFlags = clear_erl_rel_flags(), + OldRelFlags = clear_erl_rel_flags(), try scheduler_bind_types_test(Config, ?TOPOLOGY_A_TERM, @@ -568,267 +561,267 @@ scheduler_bind_types(Config) when is_list(Config) -> after restore_erl_rel_flags(OldRelFlags) end, - ?line ok. + ok. scheduler_bind_types_test(Config, Topology, CmdLine, TermLetter) -> - ?line ?t:format("Testing (~p): ~p~n", [TermLetter, Topology]), - ?line {ok, Node0} = start_node(Config), - ?line _ = rpc:call(Node0, erlang, system_flag, [cpu_topology, Topology]), - ?line cmp(Topology, rpc:call(Node0, erlang, system_info, [cpu_topology])), - ?line check_bind_types(Node0, TermLetter), - ?line stop_node(Node0), - ?line {ok, Node1} = start_node(Config, CmdLine), - ?line cmp(Topology, rpc:call(Node1, erlang, system_info, [cpu_topology])), - ?line check_bind_types(Node1, TermLetter), - ?line stop_node(Node1). + io:format("Testing (~p): ~p~n", [TermLetter, Topology]), + {ok, Node0} = start_node(Config), + _ = rpc:call(Node0, erlang, system_flag, [cpu_topology, Topology]), + cmp(Topology, rpc:call(Node0, erlang, system_info, [cpu_topology])), + check_bind_types(Node0, TermLetter), + stop_node(Node0), + {ok, Node1} = start_node(Config, CmdLine), + cmp(Topology, rpc:call(Node1, erlang, system_info, [cpu_topology])), + check_bind_types(Node1, TermLetter), + stop_node(Node1). check_bind_types(Node, a) -> - ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} - = bindings(Node, no_spread), - ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} - = bindings(Node, thread_spread), - ?line {0,4,8,12,2,6,10,14,1,5,9,13,3,7,11,15} - = bindings(Node, processor_spread), - ?line {0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15} - = bindings(Node, spread), - ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15} - = bindings(Node, no_node_thread_spread), - ?line {0,4,2,6,1,5,3,7,8,12,10,14,9,13,11,15} - = bindings(Node, no_node_processor_spread), - ?line {0,4,2,6,8,12,10,14,1,5,3,7,9,13,11,15} - = bindings(Node, thread_no_node_processor_spread), - ?line {0,4,2,6,8,12,10,14,1,5,3,7,9,13,11,15} - = bindings(Node, default_bind), - ?line ok; + {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} + = bindings(Node, no_spread), + {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, thread_spread), + {0,4,8,12,2,6,10,14,1,5,9,13,3,7,11,15} + = bindings(Node, processor_spread), + {0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15} + = bindings(Node, spread), + {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15} + = bindings(Node, no_node_thread_spread), + {0,4,2,6,1,5,3,7,8,12,10,14,9,13,11,15} + = bindings(Node, no_node_processor_spread), + {0,4,2,6,8,12,10,14,1,5,3,7,9,13,11,15} + = bindings(Node, thread_no_node_processor_spread), + {0,4,2,6,8,12,10,14,1,5,3,7,9,13,11,15} + = bindings(Node, default_bind), + ok; check_bind_types(Node, b) -> - ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} - = bindings(Node, no_spread), - ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} - = bindings(Node, thread_spread), - ?line {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15} - = bindings(Node, processor_spread), - ?line {0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15} - = bindings(Node, spread), - ?line {0,2,1,3,4,6,5,7,8,10,9,11,12,14,13,15} - = bindings(Node, no_node_thread_spread), - ?line {0,2,1,3,4,6,5,7,8,10,9,11,12,14,13,15} - = bindings(Node, no_node_processor_spread), - ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} - = bindings(Node, thread_no_node_processor_spread), - ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} - = bindings(Node, default_bind), - ?line ok; + {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} + = bindings(Node, no_spread), + {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, thread_spread), + {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15} + = bindings(Node, processor_spread), + {0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15} + = bindings(Node, spread), + {0,2,1,3,4,6,5,7,8,10,9,11,12,14,13,15} + = bindings(Node, no_node_thread_spread), + {0,2,1,3,4,6,5,7,8,10,9,11,12,14,13,15} + = bindings(Node, no_node_processor_spread), + {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, thread_no_node_processor_spread), + {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, default_bind), + ok; check_bind_types(Node, c) -> - ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, - 25,26,27,28,29,30,31} = bindings(Node, no_spread), - ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15, - 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread), - ?line {0,4,8,16,20,24,2,6,10,18,22,26,12,28,14,30,1,5,9,17,21,25, - 3,7,11,19,23,27,13,29,15,31} = bindings(Node, processor_spread), - ?line {0,8,16,24,4,20,12,28,2,10,18,26,6,22,14,30,1,9,17,25,5,21,13,29,3,11, - 19,27,7,23,15,31} = bindings(Node, spread), - ?line {0,2,4,6,1,3,5,7,8,10,9,11,12,14,13,15,16,18,20,22,17,19,21,23,24,26, - 25,27,28,30,29,31} = bindings(Node, no_node_thread_spread), - ?line {0,4,2,6,1,5,3,7,8,10,9,11,12,14,13,15,16,20,18,22,17,21,19,23,24,26, - 25,27,28,30,29,31} = bindings(Node, no_node_processor_spread), - ?line {0,4,2,6,8,10,12,14,16,20,18,22,24,26,28,30,1,5,3,7,9,11,13,15,17,21, - 19,23,25,27,29,31} = bindings(Node, thread_no_node_processor_spread), - ?line {0,4,2,6,8,10,12,14,16,20,18,22,24,26,28,30,1,5,3,7,9,11,13,15,17,21, - 19,23,25,27,29,31} = bindings(Node, default_bind), - ?line ok; + {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, + 25,26,27,28,29,30,31} = bindings(Node, no_spread), + {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15, + 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread), + {0,4,8,16,20,24,2,6,10,18,22,26,12,28,14,30,1,5,9,17,21,25, + 3,7,11,19,23,27,13,29,15,31} = bindings(Node, processor_spread), + {0,8,16,24,4,20,12,28,2,10,18,26,6,22,14,30,1,9,17,25,5,21,13,29,3,11, + 19,27,7,23,15,31} = bindings(Node, spread), + {0,2,4,6,1,3,5,7,8,10,9,11,12,14,13,15,16,18,20,22,17,19,21,23,24,26, + 25,27,28,30,29,31} = bindings(Node, no_node_thread_spread), + {0,4,2,6,1,5,3,7,8,10,9,11,12,14,13,15,16,20,18,22,17,21,19,23,24,26, + 25,27,28,30,29,31} = bindings(Node, no_node_processor_spread), + {0,4,2,6,8,10,12,14,16,20,18,22,24,26,28,30,1,5,3,7,9,11,13,15,17,21, + 19,23,25,27,29,31} = bindings(Node, thread_no_node_processor_spread), + {0,4,2,6,8,10,12,14,16,20,18,22,24,26,28,30,1,5,3,7,9,11,13,15,17,21, + 19,23,25,27,29,31} = bindings(Node, default_bind), + ok; check_bind_types(Node, d) -> - ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, - 25,26,27,28,29,30,31} = bindings(Node, no_spread), - ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15, - 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread), - ?line {0,8,12,16,24,28,2,10,14,18,26,30,4,20,6,22,1,9,13,17,25,29,3,11,15, - 19,27,31,5,21,7,23} = bindings(Node, processor_spread), - ?line {0,8,16,24,12,28,4,20,2,10,18,26,14,30,6,22,1,9,17,25,13,29,5,21,3,11, - 19,27,15,31,7,23} = bindings(Node, spread), - ?line {0,2,1,3,4,6,5,7,8,10,12,14,9,11,13,15,16,18,17,19,20,22,21,23,24,26, - 28,30,25,27,29,31} = bindings(Node, no_node_thread_spread), - ?line {0,2,1,3,4,6,5,7,8,12,10,14,9,13,11,15,16,18,17,19,20,22,21,23,24,28, - 26,30,25,29,27,31} = bindings(Node, no_node_processor_spread), - ?line {0,2,4,6,8,12,10,14,16,18,20,22,24,28,26,30,1,3,5,7,9,13,11,15,17,19, - 21,23,25,29,27,31} = bindings(Node, thread_no_node_processor_spread), - ?line {0,2,4,6,8,12,10,14,16,18,20,22,24,28,26,30,1,3,5,7,9,13,11,15,17,19, - 21,23,25,29,27,31} = bindings(Node, default_bind), - ?line ok; + {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, + 25,26,27,28,29,30,31} = bindings(Node, no_spread), + {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15, + 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread), + {0,8,12,16,24,28,2,10,14,18,26,30,4,20,6,22,1,9,13,17,25,29,3,11,15, + 19,27,31,5,21,7,23} = bindings(Node, processor_spread), + {0,8,16,24,12,28,4,20,2,10,18,26,14,30,6,22,1,9,17,25,13,29,5,21,3,11, + 19,27,15,31,7,23} = bindings(Node, spread), + {0,2,1,3,4,6,5,7,8,10,12,14,9,11,13,15,16,18,17,19,20,22,21,23,24,26, + 28,30,25,27,29,31} = bindings(Node, no_node_thread_spread), + {0,2,1,3,4,6,5,7,8,12,10,14,9,13,11,15,16,18,17,19,20,22,21,23,24,28, + 26,30,25,29,27,31} = bindings(Node, no_node_processor_spread), + {0,2,4,6,8,12,10,14,16,18,20,22,24,28,26,30,1,3,5,7,9,13,11,15,17,19, + 21,23,25,29,27,31} = bindings(Node, thread_no_node_processor_spread), + {0,2,4,6,8,12,10,14,16,18,20,22,24,28,26,30,1,3,5,7,9,13,11,15,17,19, + 21,23,25,29,27,31} = bindings(Node, default_bind), + ok; check_bind_types(Node, e) -> - ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} - = bindings(Node, no_spread), - ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} - = bindings(Node, thread_spread), - ?line {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15} - = bindings(Node, processor_spread), - ?line {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15} - = bindings(Node, spread), - ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15} - = bindings(Node, no_node_thread_spread), - ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15} - = bindings(Node, no_node_processor_spread), - ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} - = bindings(Node, thread_no_node_processor_spread), - ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} - = bindings(Node, default_bind), - ?line ok; + {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} + = bindings(Node, no_spread), + {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, thread_spread), + {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15} + = bindings(Node, processor_spread), + {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15} + = bindings(Node, spread), + {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15} + = bindings(Node, no_node_thread_spread), + {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15} + = bindings(Node, no_node_processor_spread), + {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, thread_no_node_processor_spread), + {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, default_bind), + ok; check_bind_types(Node, f) -> - ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, - 25,26,27,28,29,30,31} = bindings(Node, no_spread), - ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15, - 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread), - ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13, - 15,17,19,21,23,25,27,29,31} = bindings(Node, processor_spread), - ?line {0,8,16,24,2,10,18,26,4,12,20,28,6,14,22,30,1,9,17,25,3,11,19,27,5,13, - 21,29,7,15,23,31} = bindings(Node, spread), - ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15,16,18,20,22,17,19,21,23,24,26, - 28,30,25,27,29,31} = bindings(Node, no_node_thread_spread), - ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15,16,18,20,22,17,19,21,23,24,26, - 28,30,25,27,29,31} = bindings(Node, no_node_processor_spread), - ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,17,19, - 21,23,25,27,29,31} = bindings(Node, thread_no_node_processor_spread), - ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,17,19, - 21,23,25,27,29,31} = bindings(Node, default_bind), - ?line ok; + {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, + 25,26,27,28,29,30,31} = bindings(Node, no_spread), + {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15, + 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread), + {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13, + 15,17,19,21,23,25,27,29,31} = bindings(Node, processor_spread), + {0,8,16,24,2,10,18,26,4,12,20,28,6,14,22,30,1,9,17,25,3,11,19,27,5,13, + 21,29,7,15,23,31} = bindings(Node, spread), + {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15,16,18,20,22,17,19,21,23,24,26, + 28,30,25,27,29,31} = bindings(Node, no_node_thread_spread), + {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15,16,18,20,22,17,19,21,23,24,26, + 28,30,25,27,29,31} = bindings(Node, no_node_processor_spread), + {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,17,19, + 21,23,25,27,29,31} = bindings(Node, thread_no_node_processor_spread), + {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,17,19, + 21,23,25,27,29,31} = bindings(Node, default_bind), + ok; check_bind_types(Node, _) -> - ?line bindings(Node, no_spread), - ?line bindings(Node, thread_spread), - ?line bindings(Node, processor_spread), - ?line bindings(Node, spread), - ?line bindings(Node, no_node_thread_spread), - ?line bindings(Node, no_node_processor_spread), - ?line bindings(Node, thread_no_node_processor_spread), - ?line bindings(Node, default_bind), - ?line ok. + bindings(Node, no_spread), + bindings(Node, thread_spread), + bindings(Node, processor_spread), + bindings(Node, spread), + bindings(Node, no_node_thread_spread), + bindings(Node, no_node_processor_spread), + bindings(Node, thread_no_node_processor_spread), + bindings(Node, default_bind), + ok. cpu_topology(Config) when is_list(Config) -> - ?line OldRelFlags = clear_erl_rel_flags(), + OldRelFlags = clear_erl_rel_flags(), try - ?line cpu_topology_test( - Config, - [{node,[{processor,[{core,{logical,0}}, - {core,{logical,1}}]}]}, - {processor,[{node,[{core,{logical,2}}, - {core,{logical,3}}]}]}, - {node,[{processor,[{core,{logical,4}}, - {core,{logical,5}}]}]}, - {processor,[{node,[{core,{logical,6}}, - {core,{logical,7}}]}]}], - "+sct " - "L0-1c0-1p0n0" - ":L2-3c0-1n1p1" - ":L4-5c0-1p2n2" - ":L6-7c0-1n3p3"), - ?line cpu_topology_test( - Config, - [{node,[{processor,[{core,{logical,0}}, - {core,{logical,1}}]}, - {processor,[{core,{logical,2}}, - {core,{logical,3}}]}]}, - {processor,[{node,[{core,{logical,4}}, - {core,{logical,5}}]}, - {node,[{core,{logical,6}}, - {core,{logical,7}}]}]}, - {node,[{processor,[{core,{logical,8}}, - {core,{logical,9}}]}, - {processor,[{core,{logical,10}}, - {core,{logical,11}}]}]}, - {processor,[{node,[{core,{logical,12}}, - {core,{logical,13}}]}, - {node,[{core,{logical,14}}, - {core,{logical,15}}]}]}], - "+sct " - "L0-1c0-1p0n0" - ":L2-3c0-1p1n0" - ":L4-5c0-1n1p2" - ":L6-7c2-3n2p2" - ":L8-9c0-1p3n3" - ":L10-11c0-1p4n3" - ":L12-13c0-1n4p5" - ":L14-15c2-3n5p5"), - ?line cpu_topology_test( - Config, - [{node,[{processor,[{core,{logical,0}}, - {core,{logical,1}}]}]}, - {processor,[{node,[{core,{logical,2}}, - {core,{logical,3}}]}]}, - {processor,[{node,[{core,{logical,4}}, - {core,{logical,5}}]}]}, - {node,[{processor,[{core,{logical,6}}, - {core,{logical,7}}]}]}, - {node,[{processor,[{core,{logical,8}}, - {core,{logical,9}}]}]}, - {processor,[{node,[{core,{logical,10}}, - {core,{logical,11}}]}]}], - "+sct " - "L0-1c0-1p0n0" - ":L2-3c0-1n1p1" - ":L4-5c0-1n2p2" - ":L6-7c0-1p3n3" - ":L8-9c0-1p4n4" - ":L10-11c0-1n5p5") + cpu_topology_test( + Config, + [{node,[{processor,[{core,{logical,0}}, + {core,{logical,1}}]}]}, + {processor,[{node,[{core,{logical,2}}, + {core,{logical,3}}]}]}, + {node,[{processor,[{core,{logical,4}}, + {core,{logical,5}}]}]}, + {processor,[{node,[{core,{logical,6}}, + {core,{logical,7}}]}]}], + "+sct " + "L0-1c0-1p0n0" + ":L2-3c0-1n1p1" + ":L4-5c0-1p2n2" + ":L6-7c0-1n3p3"), + cpu_topology_test( + Config, + [{node,[{processor,[{core,{logical,0}}, + {core,{logical,1}}]}, + {processor,[{core,{logical,2}}, + {core,{logical,3}}]}]}, + {processor,[{node,[{core,{logical,4}}, + {core,{logical,5}}]}, + {node,[{core,{logical,6}}, + {core,{logical,7}}]}]}, + {node,[{processor,[{core,{logical,8}}, + {core,{logical,9}}]}, + {processor,[{core,{logical,10}}, + {core,{logical,11}}]}]}, + {processor,[{node,[{core,{logical,12}}, + {core,{logical,13}}]}, + {node,[{core,{logical,14}}, + {core,{logical,15}}]}]}], + "+sct " + "L0-1c0-1p0n0" + ":L2-3c0-1p1n0" + ":L4-5c0-1n1p2" + ":L6-7c2-3n2p2" + ":L8-9c0-1p3n3" + ":L10-11c0-1p4n3" + ":L12-13c0-1n4p5" + ":L14-15c2-3n5p5"), + cpu_topology_test( + Config, + [{node,[{processor,[{core,{logical,0}}, + {core,{logical,1}}]}]}, + {processor,[{node,[{core,{logical,2}}, + {core,{logical,3}}]}]}, + {processor,[{node,[{core,{logical,4}}, + {core,{logical,5}}]}]}, + {node,[{processor,[{core,{logical,6}}, + {core,{logical,7}}]}]}, + {node,[{processor,[{core,{logical,8}}, + {core,{logical,9}}]}]}, + {processor,[{node,[{core,{logical,10}}, + {core,{logical,11}}]}]}], + "+sct " + "L0-1c0-1p0n0" + ":L2-3c0-1n1p1" + ":L4-5c0-1n2p2" + ":L6-7c0-1p3n3" + ":L8-9c0-1p4n4" + ":L10-11c0-1n5p5") after - restore_erl_rel_flags(OldRelFlags) + restore_erl_rel_flags(OldRelFlags) end, - ?line ok. + ok. cpu_topology_test(Config, Topology, Cmd) -> - ?line ?t:format("Testing~n ~p~n ~p~n", [Topology, Cmd]), - ?line cpu_topology_bif_test(Config, Topology), - ?line cpu_topology_cmdline_test(Config, Topology, Cmd), - ?line ok. + io:format("Testing~n ~p~n ~p~n", [Topology, Cmd]), + cpu_topology_bif_test(Config, Topology), + cpu_topology_cmdline_test(Config, Topology, Cmd), + ok. cpu_topology_bif_test(_Config, false) -> - ?line ok; + ok; cpu_topology_bif_test(Config, Topology) -> - ?line {ok, Node} = start_node(Config), - ?line _ = rpc:call(Node, erlang, system_flag, [cpu_topology, Topology]), - ?line cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])), - ?line stop_node(Node), - ?line ok. + {ok, Node} = start_node(Config), + _ = rpc:call(Node, erlang, system_flag, [cpu_topology, Topology]), + cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])), + stop_node(Node), + ok. cpu_topology_cmdline_test(_Config, _Topology, false) -> - ?line ok; + ok; cpu_topology_cmdline_test(Config, Topology, Cmd) -> - ?line {ok, Node} = start_node(Config, Cmd), - ?line cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])), - ?line stop_node(Node), - ?line ok. + {ok, Node} = start_node(Config, Cmd), + cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])), + stop_node(Node), + ok. update_cpu_info(Config) when is_list(Config) -> - ?line OldOnline = erlang:system_info(schedulers_online), - ?line OldAff = get_affinity_mask(), - ?line ?t:format("START - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n", + OldOnline = erlang:system_info(schedulers_online), + OldAff = get_affinity_mask(), + io:format("START - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n", [OldAff, OldOnline, erlang:system_info(scheduler_bindings)]), - ?line case {erlang:system_info(logical_processors_available), OldAff} of + case {erlang:system_info(logical_processors_available), OldAff} of {Avail, _} when Avail == unknown; OldAff == unknown -> %% Nothing much to test; just a smoke test case erlang:system_info(update_cpu_info) of - unchanged -> ?line ok; - changed -> ?line ok + unchanged -> ok; + changed -> ok end; _ -> try - ?line adjust_schedulers_online(), + adjust_schedulers_online(), case erlang:system_info(schedulers_online) of 1 -> %% Nothing much to test; just a smoke test - ?line ok; + ok; Onln0 -> %% unset least significant bit - ?line Aff = (OldAff band (OldAff - 1)), - ?line set_affinity_mask(Aff), - ?line Onln1 = Onln0 - 1, - ?line case adjust_schedulers_online() of + Aff = (OldAff band (OldAff - 1)), + set_affinity_mask(Aff), + Onln1 = Onln0 - 1, + case adjust_schedulers_online() of {Onln0, Onln1} -> - ?line Onln1 = erlang:system_info(schedulers_online), - ?line receive after 500 -> ok end, - ?line ?t:format("TEST - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n", + Onln1 = erlang:system_info(schedulers_online), + receive after 500 -> ok end, + io:format("TEST - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n", [Aff, Onln1, erlang:system_info(scheduler_bindings)]), - ?line unchanged = adjust_schedulers_online(), - ?line ok; + unchanged = adjust_schedulers_online(), + ok; Fail -> - ?line ?t:fail(Fail) + ct:fail(Fail) end end after @@ -836,7 +829,7 @@ update_cpu_info(Config) when is_list(Config) -> adjust_schedulers_online(), erlang:system_flag(schedulers_online, OldOnline), receive after 500 -> ok end, - ?t:format("END - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n", + io:format("END - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n", [get_affinity_mask(), erlang:system_info(schedulers_online), erlang:system_info(scheduler_bindings)]) @@ -883,7 +876,7 @@ get_affinity_mask(_Port, _Status, Affinity) -> Affinity. get_affinity_mask() -> - case ?t:os_type() of + case os:type() of {unix, linux} -> case catch open_port({spawn, "taskset -p " ++ os:getpid()}, [exit_status]) of @@ -927,21 +920,21 @@ set_affinity_mask(Mask) -> end. sct_cmd(Config) when is_list(Config) -> - ?line Topology = ?TOPOLOGY_A_TERM, - ?line OldRelFlags = clear_erl_rel_flags(), + Topology = ?TOPOLOGY_A_TERM, + OldRelFlags = clear_erl_rel_flags(), try - ?line {ok, Node} = start_node(Config, ?TOPOLOGY_A_CMD), - ?line cmp(Topology, + {ok, Node} = start_node(Config, ?TOPOLOGY_A_CMD), + cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])), - ?line cmp(Topology, + cmp(Topology, rpc:call(Node, erlang, system_flag, [cpu_topology, Topology])), - ?line cmp(Topology, + cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])), - ?line stop_node(Node) + stop_node(Node) after restore_erl_rel_flags(OldRelFlags) end, - ?line ok. + ok. -define(BIND_TYPES, [{"u", unbound}, @@ -965,7 +958,7 @@ sbt_cmd(Config) when is_list(Config) -> end, case Bind of notsup -> - ?line {skipped, "Binding of schedulers not supported"}; + {skipped, "Binding of schedulers not supported"}; go_for_it -> CpuTCmd = case erlang:system_info({cpu_topology,detected}) of undefined -> @@ -988,14 +981,14 @@ sbt_cmd(Config) when is_list(Config) -> end, case CpuTCmd of false -> - ?line {skipped, "Don't know how to create cpu topology"}; + {skipped, "Don't know how to create cpu topology"}; _ -> case erlang:system_info(logical_processors) of LP when is_integer(LP) -> OldRelFlags = clear_erl_rel_flags(), try lists:foreach(fun ({ClBt, Bt}) -> - ?line sbt_test(Config, + sbt_test(Config, CpuTCmd, ClBt, Bt, @@ -1005,44 +998,44 @@ sbt_cmd(Config) when is_list(Config) -> after restore_erl_rel_flags(OldRelFlags) end, - ?line ok; + ok; _ -> - ?line {skipped, + {skipped, "Don't know the amount of logical processors"} end end end. sbt_test(Config, CpuTCmd, ClBt, Bt, LP) -> - ?line ?t:format("Testing +sbt ~s (~p)~n", [ClBt, Bt]), - ?line LPS = integer_to_list(LP), - ?line Cmd = CpuTCmd++" +sbt "++ClBt++" +S"++LPS++":"++LPS, - ?line {ok, Node} = start_node(Config, Cmd), - ?line Bt = rpc:call(Node, + io:format("Testing +sbt ~s (~p)~n", [ClBt, Bt]), + LPS = integer_to_list(LP), + Cmd = CpuTCmd++" +sbt "++ClBt++" +S"++LPS++":"++LPS, + {ok, Node} = start_node(Config, Cmd), + Bt = rpc:call(Node, erlang, system_info, [scheduler_bind_type]), - ?line SB = rpc:call(Node, + SB = rpc:call(Node, erlang, system_info, [scheduler_bindings]), - ?line ?t:format("scheduler bindings: ~p~n", [SB]), - ?line BS = case {Bt, erlang:system_info(logical_processors_available)} of + io:format("scheduler bindings: ~p~n", [SB]), + BS = case {Bt, erlang:system_info(logical_processors_available)} of {unbound, _} -> 0; {_, Int} when is_integer(Int) -> Int; {_, _} -> LP end, - ?line lists:foldl(fun (S, 0) -> - ?line unbound = S, + lists:foldl(fun (S, 0) -> + unbound = S, 0; (S, N) -> - ?line true = is_integer(S), + true = is_integer(S), N-1 end, BS, tuple_to_list(SB)), - ?line stop_node(Node), - ?line ok. + stop_node(Node), + ok. scheduler_threads(Config) when is_list(Config) -> SmpSupport = erlang:system_info(smp_support), @@ -1130,6 +1123,7 @@ dirty_schedulers_online_test(true) -> dirty_schedulers_online_smp_test(erlang:system_info(schedulers_online)). dirty_schedulers_online_smp_test(SchedOnln) when SchedOnln < 4 -> ok; dirty_schedulers_online_smp_test(SchedOnln) -> + receive after 500 -> ok end, DirtyCPUSchedOnln = erlang:system_info(dirty_cpu_schedulers_online), SchedOnln = DirtyCPUSchedOnln, HalfSchedOnln = SchedOnln div 2, @@ -1138,9 +1132,11 @@ dirty_schedulers_online_smp_test(SchedOnln) -> HalfDirtyCPUSchedOnln = erlang:system_flag(schedulers_online, SchedOnln), DirtyCPUSchedOnln = erlang:system_flag(dirty_cpu_schedulers_online, HalfDirtyCPUSchedOnln), + receive after 500 -> ok end, HalfDirtyCPUSchedOnln = erlang:system_info(dirty_cpu_schedulers_online), QrtrDirtyCPUSchedOnln = HalfDirtyCPUSchedOnln div 2, SchedOnln = erlang:system_flag(schedulers_online, HalfSchedOnln), + receive after 500 -> ok end, QrtrDirtyCPUSchedOnln = erlang:system_info(dirty_cpu_schedulers_online), ok. @@ -1166,49 +1162,208 @@ get_dsstate(Config, Cmd) -> stop_node(Node), {DSCPU, DSCPUOnln, DSIO}. +dirty_scheduler_exit(Config) when is_list(Config) -> + try + erlang:system_info(dirty_cpu_schedulers), + dirty_scheduler_exit_test(Config) + catch + error:badarg -> + {skipped, "No dirty scheduler support"} + end. + +dirty_scheduler_exit_test(Config) -> + {ok, Node} = start_node(Config, "+SDio 1"), + [ok] = mcall(Node, + [fun() -> + Path = proplists:get_value(data_dir, Config), + Lib = atom_to_list(?MODULE), + ok = erlang:load_nif(filename:join(Path,Lib), []), + ok = test_dirty_scheduler_exit() + end]), + stop_node(Node), + ok. + +test_dirty_scheduler_exit() -> + process_flag(trap_exit,true), + test_dse(10,[]). +test_dse(0,Pids) -> + timer:sleep(100), + kill_dse(Pids,[]); +test_dse(N,Pids) -> + Pid = spawn_link(fun dirty_sleeper/0), + test_dse(N-1,[Pid|Pids]). +kill_dse([],Killed) -> + wait_dse(Killed); +kill_dse([Pid|Pids],AlreadyKilled) -> + exit(Pid,kill), + kill_dse(Pids,[Pid|AlreadyKilled]). +wait_dse([]) -> + ok; +wait_dse([Pid|Pids]) -> + receive + {'EXIT',Pid,killed} -> + ok + end, + wait_dse(Pids). + +dirty_sleeper() -> + erlang:nif_error({error,?MODULE}). + +scheduler_suspend_basic(Config) when is_list(Config) -> + case erlang:system_info(multi_scheduling) of + disabled -> + {skip, "Nothing to test"}; + _ -> + Onln = erlang:system_info(schedulers_online), + try + scheduler_suspend_basic_test() + after + erlang:system_flag(schedulers_online, Onln) + end + end. + +scheduler_suspend_basic_test() -> + %% The receives after setting scheduler states are there + %% since the operation is not fully synchronous. For example, + %% we do not wait for dirty cpu schedulers online to complete + %% before returning from erlang:system_flag(schedulers_online, _). + + erlang:system_flag(schedulers_online, + erlang:system_info(schedulers)), + try + erlang:system_flag(dirty_cpu_schedulers_online, + erlang:system_info(dirty_cpu_schedulers)), + receive after 500 -> ok end + catch + _ : _ -> + ok + end, + + S0 = sched_state(), + io:format("~p~n", [S0]), + {{normal,NTot0,NOnln0,NAct0}, + {dirty_cpu,DCTot0,DCOnln0,DCAct0}, + {dirty_io,DITot0,DIOnln0,DIAct0}} = S0, + enabled = erlang:system_info(multi_scheduling), + + DCOne = case DCTot0 of + 0 -> 0; + _ -> 1 + end, + + blocked_normal = erlang:system_flag(multi_scheduling, block_normal), + blocked_normal = erlang:system_info(multi_scheduling), + {{normal,NTot0,NOnln0,1}, + {dirty_cpu,DCTot0,DCOnln0,DCAct0}, + {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(), + + NOnln0 = erlang:system_flag(schedulers_online, 1), + receive after 500 -> ok end, + {{normal,NTot0,1,1}, + {dirty_cpu,DCTot0,DCOne,DCOne}, + {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(), + + 1 = erlang:system_flag(schedulers_online, NOnln0), + receive after 500 -> ok end, + {{normal,NTot0,NOnln0,1}, + {dirty_cpu,DCTot0,DCOnln0,DCAct0}, + {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(), + + blocked = erlang:system_flag(multi_scheduling, block), + blocked = erlang:system_info(multi_scheduling), + receive after 500 -> ok end, + {{normal,NTot0,NOnln0,1}, + {dirty_cpu,DCTot0,DCOnln0,0}, + {dirty_io,DITot0,DIOnln0,0}} = sched_state(), + + NOnln0 = erlang:system_flag(schedulers_online, 1), + receive after 500 -> ok end, + {{normal,NTot0,1,1}, + {dirty_cpu,DCTot0,DCOne,0}, + {dirty_io,DITot0,DIOnln0,0}} = sched_state(), + + 1 = erlang:system_flag(schedulers_online, NOnln0), + receive after 500 -> ok end, + {{normal,NTot0,NOnln0,1}, + {dirty_cpu,DCTot0,DCOnln0,0}, + {dirty_io,DITot0,DIOnln0,0}} = sched_state(), + + blocked = erlang:system_flag(multi_scheduling, unblock_normal), + blocked = erlang:system_info(multi_scheduling), + {{normal,NTot0,NOnln0,1}, + {dirty_cpu,DCTot0,DCOnln0,0}, + {dirty_io,DITot0,DIOnln0,0}} = sched_state(), + + enabled = erlang:system_flag(multi_scheduling, unblock), + enabled = erlang:system_info(multi_scheduling), + receive after 500 -> ok end, + {{normal,NTot0,NOnln0,NAct0}, + {dirty_cpu,DCTot0,DCOnln0,DCAct0}, + {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(), + + NOnln0 = erlang:system_flag(schedulers_online, 1), + receive after 500 -> ok end, + {{normal,NTot0,1,1}, + {dirty_cpu,DCTot0,DCOne,DCOne}, + {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(), + + 1 = erlang:system_flag(schedulers_online, NOnln0), + receive after 500 -> ok end, + {{normal,NTot0,NOnln0,NAct0}, + {dirty_cpu,DCTot0,DCOnln0,DCAct0}, + {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(), + + ok. + + scheduler_suspend(Config) when is_list(Config) -> - ?line Dog = ?t:timetrap(?t:minutes(5)), - ?line lists:foreach(fun (S) -> scheduler_suspend_test(Config, S) end, + ct:timetrap({minutes, 5}), + lists:foreach(fun (S) -> scheduler_suspend_test(Config, S) end, [64, 32, 16, default]), - ?line ?t:timetrap_cancel(Dog), - ?line ok. + ok. scheduler_suspend_test(Config, Schedulers) -> - ?line Cmd = case Schedulers of + Cmd = case Schedulers of default -> ""; _ -> S = integer_to_list(Schedulers), "+S"++S++":"++S end, - ?line {ok, Node} = start_node(Config, Cmd), - ?line [SState] = mcall(Node, [fun () -> - erlang:system_info(schedulers_state) - end]), - ?line ?t:format("SState=~p~n", [SState]), - ?line {Sched, SchedOnln, _SchedAvail} = SState, - ?line true = is_integer(Sched), - ?line [ok] = mcall(Node, [fun () -> sst0_loop(300) end]), - ?line [ok] = mcall(Node, [fun () -> sst1_loop(300) end]), - ?line [ok] = mcall(Node, [fun () -> sst2_loop(300) end]), - ?line [ok, ok, ok, ok, ok] = mcall(Node, - [fun () -> sst0_loop(200) end, - fun () -> sst1_loop(200) end, - fun () -> sst2_loop(200) end, - fun () -> sst2_loop(200) end, - fun () -> sst3_loop(Sched, 200) end]), - ?line [SState] = mcall(Node, [fun () -> - case Sched == SchedOnln of - false -> - Sched = erlang:system_flag( - schedulers_online, - SchedOnln); - true -> - ok - end, - erlang:system_info(schedulers_state) - end]), - ?line stop_node(Node), - ?line ok. + {ok, Node} = start_node(Config, Cmd), + [SState] = mcall(Node, [fun () -> + erlang:system_info(schedulers_state) + end]), + + io:format("SState=~p~n", [SState]), + {Sched, SchedOnln, _SchedAvail} = SState, + true = is_integer(Sched), + [ok] = mcall(Node, [fun () -> sst0_loop(300) end]), + [ok] = mcall(Node, [fun () -> sst1_loop(300) end]), + [ok] = mcall(Node, [fun () -> sst2_loop(300) end]), + [ok] = mcall(Node, [fun () -> sst4_loop(300) end]), + [ok] = mcall(Node, [fun () -> sst5_loop(300) end]), + [ok, ok, ok, ok, + ok, ok, ok] = mcall(Node, + [fun () -> sst0_loop(200) end, + fun () -> sst1_loop(200) end, + fun () -> sst2_loop(200) end, + fun () -> sst2_loop(200) end, + fun () -> sst3_loop(Sched, 200) end, + fun () -> sst4_loop(200) end, + fun () -> sst5_loop(200) end]), + [SState] = mcall(Node, [fun () -> + case Sched == SchedOnln of + false -> + Sched = erlang:system_flag( + schedulers_online, + SchedOnln); + true -> + ok + end, + erlang:system_info(schedulers_state) + end]), + stop_node(Node), + ok. sst0_loop(0) -> @@ -1272,270 +1427,283 @@ sst3_loop_with_dirty_schedulers(S, DS, N) -> erlang:system_flag(dirty_cpu_schedulers_online, DS), sst3_loop_with_dirty_schedulers(S, DS, N-1). +sst4_loop(0) -> + ok; +sst4_loop(N) -> + erlang:system_flag(multi_scheduling, block_normal), + erlang:system_flag(multi_scheduling, unblock_normal), + sst4_loop(N-1). + +sst5_loop(0) -> + ok; +sst5_loop(N) -> + erlang:system_flag(multi_scheduling, block_normal), + erlang:system_flag(multi_scheduling, unblock_normal), + sst5_loop(N-1). + reader_groups(Config) when is_list(Config) -> %% White box testing. These results are correct, but other results %% could be too... %% The actual tilepro64 topology CPUT0 = [{processor,[{node,[{core,{logical,0}}, - {core,{logical,1}}, - {core,{logical,2}}, - {core,{logical,8}}, - {core,{logical,9}}, - {core,{logical,10}}, - {core,{logical,11}}, - {core,{logical,16}}, - {core,{logical,17}}, - {core,{logical,18}}, - {core,{logical,19}}, - {core,{logical,24}}, - {core,{logical,25}}, - {core,{logical,27}}, - {core,{logical,29}}]}, - {node,[{core,{logical,3}}, - {core,{logical,4}}, - {core,{logical,5}}, - {core,{logical,6}}, - {core,{logical,7}}, - {core,{logical,12}}, - {core,{logical,13}}, - {core,{logical,14}}, - {core,{logical,15}}, - {core,{logical,20}}, - {core,{logical,21}}, - {core,{logical,22}}, - {core,{logical,23}}, - {core,{logical,28}}, - {core,{logical,30}}]}, - {node,[{core,{logical,31}}, - {core,{logical,36}}, - {core,{logical,37}}, - {core,{logical,38}}, - {core,{logical,44}}, - {core,{logical,45}}, - {core,{logical,46}}, - {core,{logical,47}}, - {core,{logical,51}}, - {core,{logical,52}}, - {core,{logical,53}}, - {core,{logical,54}}, - {core,{logical,55}}, - {core,{logical,60}}, - {core,{logical,61}}]}, - {node,[{core,{logical,26}}, - {core,{logical,32}}, - {core,{logical,33}}, - {core,{logical,34}}, - {core,{logical,35}}, - {core,{logical,39}}, - {core,{logical,40}}, - {core,{logical,41}}, - {core,{logical,42}}, - {core,{logical,43}}, - {core,{logical,48}}, - {core,{logical,49}}, - {core,{logical,50}}, - {core,{logical,58}}]}]}], - - ?line [{0,1},{1,1},{2,1},{3,3},{4,3},{5,3},{6,3},{7,3},{8,1},{9,1},{10,1}, - {11,1},{12,3},{13,3},{14,4},{15,4},{16,2},{17,2},{18,2},{19,2}, - {20,4},{21,4},{22,4},{23,4},{24,2},{25,2},{26,7},{27,2},{28,4}, - {29,2},{30,4},{31,5},{32,7},{33,7},{34,7},{35,7},{36,5},{37,5}, - {38,5},{39,7},{40,7},{41,8},{42,8},{43,8},{44,5},{45,5},{46,5}, - {47,6},{48,8},{49,8},{50,8},{51,6},{52,6},{53,6},{54,6},{55,6}, - {58,8},{60,6},{61,6}] - = reader_groups_map(CPUT0, 8), + {core,{logical,1}}, + {core,{logical,2}}, + {core,{logical,8}}, + {core,{logical,9}}, + {core,{logical,10}}, + {core,{logical,11}}, + {core,{logical,16}}, + {core,{logical,17}}, + {core,{logical,18}}, + {core,{logical,19}}, + {core,{logical,24}}, + {core,{logical,25}}, + {core,{logical,27}}, + {core,{logical,29}}]}, + {node,[{core,{logical,3}}, + {core,{logical,4}}, + {core,{logical,5}}, + {core,{logical,6}}, + {core,{logical,7}}, + {core,{logical,12}}, + {core,{logical,13}}, + {core,{logical,14}}, + {core,{logical,15}}, + {core,{logical,20}}, + {core,{logical,21}}, + {core,{logical,22}}, + {core,{logical,23}}, + {core,{logical,28}}, + {core,{logical,30}}]}, + {node,[{core,{logical,31}}, + {core,{logical,36}}, + {core,{logical,37}}, + {core,{logical,38}}, + {core,{logical,44}}, + {core,{logical,45}}, + {core,{logical,46}}, + {core,{logical,47}}, + {core,{logical,51}}, + {core,{logical,52}}, + {core,{logical,53}}, + {core,{logical,54}}, + {core,{logical,55}}, + {core,{logical,60}}, + {core,{logical,61}}]}, + {node,[{core,{logical,26}}, + {core,{logical,32}}, + {core,{logical,33}}, + {core,{logical,34}}, + {core,{logical,35}}, + {core,{logical,39}}, + {core,{logical,40}}, + {core,{logical,41}}, + {core,{logical,42}}, + {core,{logical,43}}, + {core,{logical,48}}, + {core,{logical,49}}, + {core,{logical,50}}, + {core,{logical,58}}]}]}], + + [{0,1},{1,1},{2,1},{3,3},{4,3},{5,3},{6,3},{7,3},{8,1},{9,1},{10,1}, + {11,1},{12,3},{13,3},{14,4},{15,4},{16,2},{17,2},{18,2},{19,2}, + {20,4},{21,4},{22,4},{23,4},{24,2},{25,2},{26,7},{27,2},{28,4}, + {29,2},{30,4},{31,5},{32,7},{33,7},{34,7},{35,7},{36,5},{37,5}, + {38,5},{39,7},{40,7},{41,8},{42,8},{43,8},{44,5},{45,5},{46,5}, + {47,6},{48,8},{49,8},{50,8},{51,6},{52,6},{53,6},{54,6},{55,6}, + {58,8},{60,6},{61,6}] + = reader_groups_map(CPUT0, 8), CPUT1 = [n([p([c([t(l(0)),t(l(1)),t(l(2)),t(l(3))]), - c([t(l(4)),t(l(5)),t(l(6)),t(l(7))]), - c([t(l(8)),t(l(9)),t(l(10)),t(l(11))]), - c([t(l(12)),t(l(13)),t(l(14)),t(l(15))])]), - p([c([t(l(16)),t(l(17)),t(l(18)),t(l(19))]), - c([t(l(20)),t(l(21)),t(l(22)),t(l(23))]), - c([t(l(24)),t(l(25)),t(l(26)),t(l(27))]), - c([t(l(28)),t(l(29)),t(l(30)),t(l(31))])])]), - n([p([c([t(l(32)),t(l(33)),t(l(34)),t(l(35))]), - c([t(l(36)),t(l(37)),t(l(38)),t(l(39))]), - c([t(l(40)),t(l(41)),t(l(42)),t(l(43))]), - c([t(l(44)),t(l(45)),t(l(46)),t(l(47))])]), - p([c([t(l(48)),t(l(49)),t(l(50)),t(l(51))]), - c([t(l(52)),t(l(53)),t(l(54)),t(l(55))]), - c([t(l(56)),t(l(57)),t(l(58)),t(l(59))]), - c([t(l(60)),t(l(61)),t(l(62)),t(l(63))])])]), - n([p([c([t(l(64)),t(l(65)),t(l(66)),t(l(67))]), - c([t(l(68)),t(l(69)),t(l(70)),t(l(71))]), - c([t(l(72)),t(l(73)),t(l(74)),t(l(75))]), - c([t(l(76)),t(l(77)),t(l(78)),t(l(79))])]), - p([c([t(l(80)),t(l(81)),t(l(82)),t(l(83))]), - c([t(l(84)),t(l(85)),t(l(86)),t(l(87))]), - c([t(l(88)),t(l(89)),t(l(90)),t(l(91))]), - c([t(l(92)),t(l(93)),t(l(94)),t(l(95))])])]), - n([p([c([t(l(96)),t(l(97)),t(l(98)),t(l(99))]), - c([t(l(100)),t(l(101)),t(l(102)),t(l(103))]), - c([t(l(104)),t(l(105)),t(l(106)),t(l(107))]), - c([t(l(108)),t(l(109)),t(l(110)),t(l(111))])]), - p([c([t(l(112)),t(l(113)),t(l(114)),t(l(115))]), - c([t(l(116)),t(l(117)),t(l(118)),t(l(119))]), - c([t(l(120)),t(l(121)),t(l(122)),t(l(123))]), - c([t(l(124)),t(l(125)),t(l(126)),t(l(127))])])])], - - ?line [{0,1},{1,1},{2,1},{3,1},{4,2},{5,2},{6,2},{7,2},{8,3},{9,3}, - {10,3},{11,3},{12,4},{13,4},{14,4},{15,4},{16,5},{17,5},{18,5}, - {19,5},{20,6},{21,6},{22,6},{23,6},{24,7},{25,7},{26,7},{27,7}, - {28,8},{29,8},{30,8},{31,8},{32,9},{33,9},{34,9},{35,9},{36,10}, - {37,10},{38,10},{39,10},{40,11},{41,11},{42,11},{43,11},{44,12}, - {45,12},{46,12},{47,12},{48,13},{49,13},{50,13},{51,13},{52,14}, - {53,14},{54,14},{55,14},{56,15},{57,15},{58,15},{59,15},{60,16}, - {61,16},{62,16},{63,16},{64,17},{65,17},{66,17},{67,17},{68,18}, - {69,18},{70,18},{71,18},{72,19},{73,19},{74,19},{75,19},{76,20}, - {77,20},{78,20},{79,20},{80,21},{81,21},{82,21},{83,21},{84,22}, - {85,22},{86,22},{87,22},{88,23},{89,23},{90,23},{91,23},{92,24}, - {93,24},{94,24},{95,24},{96,25},{97,25},{98,25},{99,25},{100,26}, - {101,26},{102,26},{103,26},{104,27},{105,27},{106,27},{107,27}, - {108,28},{109,28},{110,28},{111,28},{112,29},{113,29},{114,29}, - {115,29},{116,30},{117,30},{118,30},{119,30},{120,31},{121,31}, - {122,31},{123,31},{124,32},{125,32},{126,32},{127,32}] - = reader_groups_map(CPUT1, 128), - - ?line [{0,1},{1,1},{2,1},{3,1},{4,1},{5,1},{6,1},{7,1},{8,1},{9,1},{10,1}, - {11,1},{12,1},{13,1},{14,1},{15,1},{16,1},{17,1},{18,1},{19,1}, - {20,1},{21,1},{22,1},{23,1},{24,1},{25,1},{26,1},{27,1},{28,1}, - {29,1},{30,1},{31,1},{32,1},{33,1},{34,1},{35,1},{36,1},{37,1}, - {38,1},{39,1},{40,1},{41,1},{42,1},{43,1},{44,1},{45,1},{46,1}, - {47,1},{48,1},{49,1},{50,1},{51,1},{52,1},{53,1},{54,1},{55,1}, - {56,1},{57,1},{58,1},{59,1},{60,1},{61,1},{62,1},{63,1},{64,2}, - {65,2},{66,2},{67,2},{68,2},{69,2},{70,2},{71,2},{72,2},{73,2}, - {74,2},{75,2},{76,2},{77,2},{78,2},{79,2},{80,2},{81,2},{82,2}, - {83,2},{84,2},{85,2},{86,2},{87,2},{88,2},{89,2},{90,2},{91,2}, - {92,2},{93,2},{94,2},{95,2},{96,2},{97,2},{98,2},{99,2},{100,2}, - {101,2},{102,2},{103,2},{104,2},{105,2},{106,2},{107,2},{108,2}, - {109,2},{110,2},{111,2},{112,2},{113,2},{114,2},{115,2},{116,2}, - {117,2},{118,2},{119,2},{120,2},{121,2},{122,2},{123,2},{124,2}, - {125,2},{126,2},{127,2}] - = reader_groups_map(CPUT1, 2), - - ?line [{0,1},{1,1},{2,1},{3,1},{4,2},{5,2},{6,2},{7,2},{8,3},{9,3},{10,3}, - {11,3},{12,3},{13,3},{14,3},{15,3},{16,4},{17,4},{18,4},{19,4}, - {20,4},{21,4},{22,4},{23,4},{24,5},{25,5},{26,5},{27,5},{28,5}, - {29,5},{30,5},{31,5},{32,6},{33,6},{34,6},{35,6},{36,6},{37,6}, - {38,6},{39,6},{40,7},{41,7},{42,7},{43,7},{44,7},{45,7},{46,7}, - {47,7},{48,8},{49,8},{50,8},{51,8},{52,8},{53,8},{54,8},{55,8}, - {56,9},{57,9},{58,9},{59,9},{60,9},{61,9},{62,9},{63,9},{64,10}, - {65,10},{66,10},{67,10},{68,10},{69,10},{70,10},{71,10},{72,11}, - {73,11},{74,11},{75,11},{76,11},{77,11},{78,11},{79,11},{80,12}, - {81,12},{82,12},{83,12},{84,12},{85,12},{86,12},{87,12},{88,13}, - {89,13},{90,13},{91,13},{92,13},{93,13},{94,13},{95,13},{96,14}, - {97,14},{98,14},{99,14},{100,14},{101,14},{102,14},{103,14}, - {104,15},{105,15},{106,15},{107,15},{108,15},{109,15},{110,15}, - {111,15},{112,16},{113,16},{114,16},{115,16},{116,16},{117,16}, - {118,16},{119,16},{120,17},{121,17},{122,17},{123,17},{124,17}, - {125,17},{126,17},{127,17}] - = reader_groups_map(CPUT1, 17), - - ?line [{0,1},{1,1},{2,1},{3,1},{4,1},{5,1},{6,1},{7,1},{8,1},{9,1},{10,1}, - {11,1},{12,1},{13,1},{14,1},{15,1},{16,2},{17,2},{18,2},{19,2}, - {20,2},{21,2},{22,2},{23,2},{24,2},{25,2},{26,2},{27,2},{28,2}, - {29,2},{30,2},{31,2},{32,3},{33,3},{34,3},{35,3},{36,3},{37,3}, - {38,3},{39,3},{40,3},{41,3},{42,3},{43,3},{44,3},{45,3},{46,3}, - {47,3},{48,4},{49,4},{50,4},{51,4},{52,4},{53,4},{54,4},{55,4}, - {56,4},{57,4},{58,4},{59,4},{60,4},{61,4},{62,4},{63,4},{64,5}, - {65,5},{66,5},{67,5},{68,5},{69,5},{70,5},{71,5},{72,5},{73,5}, - {74,5},{75,5},{76,5},{77,5},{78,5},{79,5},{80,6},{81,6},{82,6}, - {83,6},{84,6},{85,6},{86,6},{87,6},{88,6},{89,6},{90,6},{91,6}, - {92,6},{93,6},{94,6},{95,6},{96,7},{97,7},{98,7},{99,7},{100,7}, - {101,7},{102,7},{103,7},{104,7},{105,7},{106,7},{107,7},{108,7}, - {109,7},{110,7},{111,7},{112,7},{113,7},{114,7},{115,7},{116,7}, - {117,7},{118,7},{119,7},{120,7},{121,7},{122,7},{123,7},{124,7}, - {125,7},{126,7},{127,7}] - = reader_groups_map(CPUT1, 7), - - ?line CPUT2 = [p([c(l(0)),c(l(1)),c(l(2)),c(l(3)),c(l(4))]), - p([t(l(5)),t(l(6)),t(l(7)),t(l(8)),t(l(9))]), - p([t(l(10))]), - p([c(l(11)),c(l(12)),c(l(13))]), - p([c(l(14)),c(l(15))])], - - ?line [{0,1},{1,1},{2,1},{3,1},{4,1}, - {5,2},{6,2},{7,2},{8,2},{9,2}, - {10,3}, - {11,4},{12,4},{13,4}, - {14,5},{15,5}] = reader_groups_map(CPUT2, 5), - - - ?line [{0,1},{1,1},{2,2},{3,2},{4,2}, - {5,3},{6,3},{7,3},{8,3},{9,3}, - {10,4}, - {11,5},{12,5},{13,5}, - {14,6},{15,6}] = reader_groups_map(CPUT2, 6), - - ?line [{0,1},{1,1},{2,2},{3,2},{4,2}, - {5,3},{6,3},{7,3},{8,3},{9,3}, - {10,4}, - {11,5},{12,6},{13,6}, - {14,7},{15,7}] = reader_groups_map(CPUT2, 7), - - ?line [{0,1},{1,1},{2,2},{3,2},{4,2}, - {5,3},{6,3},{7,3},{8,3},{9,3}, - {10,4}, - {11,5},{12,6},{13,6}, - {14,7},{15,8}] = reader_groups_map(CPUT2, 8), - - ?line [{0,1},{1,2},{2,2},{3,3},{4,3}, - {5,4},{6,4},{7,4},{8,4},{9,4}, - {10,5}, - {11,6},{12,7},{13,7}, - {14,8},{15,9}] = reader_groups_map(CPUT2, 9), - - ?line [{0,1},{1,2},{2,2},{3,3},{4,3}, - {5,4},{6,4},{7,4},{8,4},{9,4}, - {10,5}, - {11,6},{12,7},{13,8}, - {14,9},{15,10}] = reader_groups_map(CPUT2, 10), - - ?line [{0,1},{1,2},{2,3},{3,4},{4,4}, - {5,5},{6,5},{7,5},{8,5},{9,5}, - {10,6}, - {11,7},{12,8},{13,9}, - {14,10},{15,11}] = reader_groups_map(CPUT2, 11), - - ?line [{0,1},{1,2},{2,3},{3,4},{4,5}, - {5,6},{6,6},{7,6},{8,6},{9,6}, - {10,7}, - {11,8},{12,9},{13,10}, - {14,11},{15,12}] = reader_groups_map(CPUT2, 100), + c([t(l(4)),t(l(5)),t(l(6)),t(l(7))]), + c([t(l(8)),t(l(9)),t(l(10)),t(l(11))]), + c([t(l(12)),t(l(13)),t(l(14)),t(l(15))])]), + p([c([t(l(16)),t(l(17)),t(l(18)),t(l(19))]), + c([t(l(20)),t(l(21)),t(l(22)),t(l(23))]), + c([t(l(24)),t(l(25)),t(l(26)),t(l(27))]), + c([t(l(28)),t(l(29)),t(l(30)),t(l(31))])])]), + n([p([c([t(l(32)),t(l(33)),t(l(34)),t(l(35))]), + c([t(l(36)),t(l(37)),t(l(38)),t(l(39))]), + c([t(l(40)),t(l(41)),t(l(42)),t(l(43))]), + c([t(l(44)),t(l(45)),t(l(46)),t(l(47))])]), + p([c([t(l(48)),t(l(49)),t(l(50)),t(l(51))]), + c([t(l(52)),t(l(53)),t(l(54)),t(l(55))]), + c([t(l(56)),t(l(57)),t(l(58)),t(l(59))]), + c([t(l(60)),t(l(61)),t(l(62)),t(l(63))])])]), + n([p([c([t(l(64)),t(l(65)),t(l(66)),t(l(67))]), + c([t(l(68)),t(l(69)),t(l(70)),t(l(71))]), + c([t(l(72)),t(l(73)),t(l(74)),t(l(75))]), + c([t(l(76)),t(l(77)),t(l(78)),t(l(79))])]), + p([c([t(l(80)),t(l(81)),t(l(82)),t(l(83))]), + c([t(l(84)),t(l(85)),t(l(86)),t(l(87))]), + c([t(l(88)),t(l(89)),t(l(90)),t(l(91))]), + c([t(l(92)),t(l(93)),t(l(94)),t(l(95))])])]), + n([p([c([t(l(96)),t(l(97)),t(l(98)),t(l(99))]), + c([t(l(100)),t(l(101)),t(l(102)),t(l(103))]), + c([t(l(104)),t(l(105)),t(l(106)),t(l(107))]), + c([t(l(108)),t(l(109)),t(l(110)),t(l(111))])]), + p([c([t(l(112)),t(l(113)),t(l(114)),t(l(115))]), + c([t(l(116)),t(l(117)),t(l(118)),t(l(119))]), + c([t(l(120)),t(l(121)),t(l(122)),t(l(123))]), + c([t(l(124)),t(l(125)),t(l(126)),t(l(127))])])])], + + [{0,1},{1,1},{2,1},{3,1},{4,2},{5,2},{6,2},{7,2},{8,3},{9,3}, + {10,3},{11,3},{12,4},{13,4},{14,4},{15,4},{16,5},{17,5},{18,5}, + {19,5},{20,6},{21,6},{22,6},{23,6},{24,7},{25,7},{26,7},{27,7}, + {28,8},{29,8},{30,8},{31,8},{32,9},{33,9},{34,9},{35,9},{36,10}, + {37,10},{38,10},{39,10},{40,11},{41,11},{42,11},{43,11},{44,12}, + {45,12},{46,12},{47,12},{48,13},{49,13},{50,13},{51,13},{52,14}, + {53,14},{54,14},{55,14},{56,15},{57,15},{58,15},{59,15},{60,16}, + {61,16},{62,16},{63,16},{64,17},{65,17},{66,17},{67,17},{68,18}, + {69,18},{70,18},{71,18},{72,19},{73,19},{74,19},{75,19},{76,20}, + {77,20},{78,20},{79,20},{80,21},{81,21},{82,21},{83,21},{84,22}, + {85,22},{86,22},{87,22},{88,23},{89,23},{90,23},{91,23},{92,24}, + {93,24},{94,24},{95,24},{96,25},{97,25},{98,25},{99,25},{100,26}, + {101,26},{102,26},{103,26},{104,27},{105,27},{106,27},{107,27}, + {108,28},{109,28},{110,28},{111,28},{112,29},{113,29},{114,29}, + {115,29},{116,30},{117,30},{118,30},{119,30},{120,31},{121,31}, + {122,31},{123,31},{124,32},{125,32},{126,32},{127,32}] + = reader_groups_map(CPUT1, 128), + + [{0,1},{1,1},{2,1},{3,1},{4,1},{5,1},{6,1},{7,1},{8,1},{9,1},{10,1}, + {11,1},{12,1},{13,1},{14,1},{15,1},{16,1},{17,1},{18,1},{19,1}, + {20,1},{21,1},{22,1},{23,1},{24,1},{25,1},{26,1},{27,1},{28,1}, + {29,1},{30,1},{31,1},{32,1},{33,1},{34,1},{35,1},{36,1},{37,1}, + {38,1},{39,1},{40,1},{41,1},{42,1},{43,1},{44,1},{45,1},{46,1}, + {47,1},{48,1},{49,1},{50,1},{51,1},{52,1},{53,1},{54,1},{55,1}, + {56,1},{57,1},{58,1},{59,1},{60,1},{61,1},{62,1},{63,1},{64,2}, + {65,2},{66,2},{67,2},{68,2},{69,2},{70,2},{71,2},{72,2},{73,2}, + {74,2},{75,2},{76,2},{77,2},{78,2},{79,2},{80,2},{81,2},{82,2}, + {83,2},{84,2},{85,2},{86,2},{87,2},{88,2},{89,2},{90,2},{91,2}, + {92,2},{93,2},{94,2},{95,2},{96,2},{97,2},{98,2},{99,2},{100,2}, + {101,2},{102,2},{103,2},{104,2},{105,2},{106,2},{107,2},{108,2}, + {109,2},{110,2},{111,2},{112,2},{113,2},{114,2},{115,2},{116,2}, + {117,2},{118,2},{119,2},{120,2},{121,2},{122,2},{123,2},{124,2}, + {125,2},{126,2},{127,2}] + = reader_groups_map(CPUT1, 2), + + [{0,1},{1,1},{2,1},{3,1},{4,2},{5,2},{6,2},{7,2},{8,3},{9,3},{10,3}, + {11,3},{12,3},{13,3},{14,3},{15,3},{16,4},{17,4},{18,4},{19,4}, + {20,4},{21,4},{22,4},{23,4},{24,5},{25,5},{26,5},{27,5},{28,5}, + {29,5},{30,5},{31,5},{32,6},{33,6},{34,6},{35,6},{36,6},{37,6}, + {38,6},{39,6},{40,7},{41,7},{42,7},{43,7},{44,7},{45,7},{46,7}, + {47,7},{48,8},{49,8},{50,8},{51,8},{52,8},{53,8},{54,8},{55,8}, + {56,9},{57,9},{58,9},{59,9},{60,9},{61,9},{62,9},{63,9},{64,10}, + {65,10},{66,10},{67,10},{68,10},{69,10},{70,10},{71,10},{72,11}, + {73,11},{74,11},{75,11},{76,11},{77,11},{78,11},{79,11},{80,12}, + {81,12},{82,12},{83,12},{84,12},{85,12},{86,12},{87,12},{88,13}, + {89,13},{90,13},{91,13},{92,13},{93,13},{94,13},{95,13},{96,14}, + {97,14},{98,14},{99,14},{100,14},{101,14},{102,14},{103,14}, + {104,15},{105,15},{106,15},{107,15},{108,15},{109,15},{110,15}, + {111,15},{112,16},{113,16},{114,16},{115,16},{116,16},{117,16}, + {118,16},{119,16},{120,17},{121,17},{122,17},{123,17},{124,17}, + {125,17},{126,17},{127,17}] + = reader_groups_map(CPUT1, 17), + + [{0,1},{1,1},{2,1},{3,1},{4,1},{5,1},{6,1},{7,1},{8,1},{9,1},{10,1}, + {11,1},{12,1},{13,1},{14,1},{15,1},{16,2},{17,2},{18,2},{19,2}, + {20,2},{21,2},{22,2},{23,2},{24,2},{25,2},{26,2},{27,2},{28,2}, + {29,2},{30,2},{31,2},{32,3},{33,3},{34,3},{35,3},{36,3},{37,3}, + {38,3},{39,3},{40,3},{41,3},{42,3},{43,3},{44,3},{45,3},{46,3}, + {47,3},{48,4},{49,4},{50,4},{51,4},{52,4},{53,4},{54,4},{55,4}, + {56,4},{57,4},{58,4},{59,4},{60,4},{61,4},{62,4},{63,4},{64,5}, + {65,5},{66,5},{67,5},{68,5},{69,5},{70,5},{71,5},{72,5},{73,5}, + {74,5},{75,5},{76,5},{77,5},{78,5},{79,5},{80,6},{81,6},{82,6}, + {83,6},{84,6},{85,6},{86,6},{87,6},{88,6},{89,6},{90,6},{91,6}, + {92,6},{93,6},{94,6},{95,6},{96,7},{97,7},{98,7},{99,7},{100,7}, + {101,7},{102,7},{103,7},{104,7},{105,7},{106,7},{107,7},{108,7}, + {109,7},{110,7},{111,7},{112,7},{113,7},{114,7},{115,7},{116,7}, + {117,7},{118,7},{119,7},{120,7},{121,7},{122,7},{123,7},{124,7}, + {125,7},{126,7},{127,7}] + = reader_groups_map(CPUT1, 7), + + CPUT2 = [p([c(l(0)),c(l(1)),c(l(2)),c(l(3)),c(l(4))]), + p([t(l(5)),t(l(6)),t(l(7)),t(l(8)),t(l(9))]), + p([t(l(10))]), + p([c(l(11)),c(l(12)),c(l(13))]), + p([c(l(14)),c(l(15))])], + + [{0,1},{1,1},{2,1},{3,1},{4,1}, + {5,2},{6,2},{7,2},{8,2},{9,2}, + {10,3}, + {11,4},{12,4},{13,4}, + {14,5},{15,5}] = reader_groups_map(CPUT2, 5), + + + [{0,1},{1,1},{2,2},{3,2},{4,2}, + {5,3},{6,3},{7,3},{8,3},{9,3}, + {10,4}, + {11,5},{12,5},{13,5}, + {14,6},{15,6}] = reader_groups_map(CPUT2, 6), + + [{0,1},{1,1},{2,2},{3,2},{4,2}, + {5,3},{6,3},{7,3},{8,3},{9,3}, + {10,4}, + {11,5},{12,6},{13,6}, + {14,7},{15,7}] = reader_groups_map(CPUT2, 7), + + [{0,1},{1,1},{2,2},{3,2},{4,2}, + {5,3},{6,3},{7,3},{8,3},{9,3}, + {10,4}, + {11,5},{12,6},{13,6}, + {14,7},{15,8}] = reader_groups_map(CPUT2, 8), + + [{0,1},{1,2},{2,2},{3,3},{4,3}, + {5,4},{6,4},{7,4},{8,4},{9,4}, + {10,5}, + {11,6},{12,7},{13,7}, + {14,8},{15,9}] = reader_groups_map(CPUT2, 9), + + [{0,1},{1,2},{2,2},{3,3},{4,3}, + {5,4},{6,4},{7,4},{8,4},{9,4}, + {10,5}, + {11,6},{12,7},{13,8}, + {14,9},{15,10}] = reader_groups_map(CPUT2, 10), + + [{0,1},{1,2},{2,3},{3,4},{4,4}, + {5,5},{6,5},{7,5},{8,5},{9,5}, + {10,6}, + {11,7},{12,8},{13,9}, + {14,10},{15,11}] = reader_groups_map(CPUT2, 11), + + [{0,1},{1,2},{2,3},{3,4},{4,5}, + {5,6},{6,6},{7,6},{8,6},{9,6}, + {10,7}, + {11,8},{12,9},{13,10}, + {14,11},{15,12}] = reader_groups_map(CPUT2, 100), CPUT3 = [p([t(l(5)),t(l(6)),t(l(7)),t(l(8)),t(l(9))]), - p([t(l(10))]), - p([c(l(11)),c(l(12)),c(l(13))]), - p([c(l(14)),c(l(15))]), - p([c(l(0)),c(l(1)),c(l(2)),c(l(3)),c(l(4))])], + p([t(l(10))]), + p([c(l(11)),c(l(12)),c(l(13))]), + p([c(l(14)),c(l(15))]), + p([c(l(0)),c(l(1)),c(l(2)),c(l(3)),c(l(4))])], - ?line [{0,5},{1,5},{2,6},{3,6},{4,6}, - {5,1},{6,1},{7,1},{8,1},{9,1}, - {10,2},{11,3},{12,3},{13,3}, - {14,4},{15,4}] = reader_groups_map(CPUT3, 6), + [{0,5},{1,5},{2,6},{3,6},{4,6}, + {5,1},{6,1},{7,1},{8,1},{9,1}, + {10,2},{11,3},{12,3},{13,3}, + {14,4},{15,4}] = reader_groups_map(CPUT3, 6), CPUT4 = [p([t(l(0)),t(l(1)),t(l(2)),t(l(3)),t(l(4))]), - p([t(l(5))]), - p([c(l(6)),c(l(7)),c(l(8))]), - p([c(l(9)),c(l(10))]), - p([c(l(11)),c(l(12)),c(l(13)),c(l(14)),c(l(15))])], - - ?line [{0,1},{1,1},{2,1},{3,1},{4,1}, - {5,2}, - {6,3},{7,3},{8,3}, - {9,4},{10,4}, - {11,5},{12,5},{13,6},{14,6},{15,6}] = reader_groups_map(CPUT4, 6), - - ?line [{0,1},{1,1},{2,1},{3,1},{4,1}, - {5,2}, - {6,3},{7,4},{8,4}, - {9,5},{10,5}, - {11,6},{12,6},{13,7},{14,7},{15,7}] = reader_groups_map(CPUT4, 7), - - ?line [{0,1},{65535,2}] = reader_groups_map([c(l(0)),c(l(65535))], 10), - - ?line ok. + p([t(l(5))]), + p([c(l(6)),c(l(7)),c(l(8))]), + p([c(l(9)),c(l(10))]), + p([c(l(11)),c(l(12)),c(l(13)),c(l(14)),c(l(15))])], + + [{0,1},{1,1},{2,1},{3,1},{4,1}, + {5,2}, + {6,3},{7,3},{8,3}, + {9,4},{10,4}, + {11,5},{12,5},{13,6},{14,6},{15,6}] = reader_groups_map(CPUT4, 6), + + [{0,1},{1,1},{2,1},{3,1},{4,1}, + {5,2}, + {6,3},{7,4},{8,4}, + {9,5},{10,5}, + {11,6},{12,6},{13,7},{14,7},{15,7}] = reader_groups_map(CPUT4, 7), + + [{0,1},{65535,2}] = reader_groups_map([c(l(0)),c(l(65535))], 10), + ok. reader_groups_map(CPUT, Groups) -> @@ -1550,6 +1718,34 @@ reader_groups_map(CPUT, Groups) -> %% Utils %% +sched_state() -> + sched_state(erlang:system_info(all_schedulers_state), + undefined, + {dirty_cpu,0,0,0}, + {dirty_io,0,0,0}). + + +sched_state([], N, DC, DI) -> + try + chk_basic(N), + chk_basic(DC), + chk_basic(DI), + {N, DC, DI} + catch + _ : _ -> + ct:fail({inconsisten_scheduler_state, {N, DC, DI}}) + end; +sched_state([{normal, _, _, _} = S | Rest], _S, DC, DI) -> + sched_state(Rest, S, DC, DI); +sched_state([{dirty_cpu, _, _, _} = DC | Rest], S, _DC, DI) -> + sched_state(Rest, S, DC, DI); +sched_state([{dirty_io, _, _, _} = DI | Rest], S, DC, _DI) -> + sched_state(Rest, S, DC, DI). + +chk_basic({_Type, Tot, Onln, Act}) -> + true = Tot >= Onln, + true = Onln >= Act. + l(Id) -> {logical, Id}. @@ -1568,21 +1764,21 @@ n(X) -> mcall(Node, Funs) -> Parent = self(), Refs = lists:map(fun (Fun) -> - Ref = make_ref(), - spawn_link(Node, - fun () -> - Res = Fun(), - unlink(Parent), - Parent ! {Ref, Res} - end), - Ref - end, Funs), + Ref = make_ref(), + spawn_link(Node, + fun () -> + Res = Fun(), + unlink(Parent), + Parent ! {Ref, Res} + end), + Ref + end, Funs), lists:map(fun (Ref) -> - receive - {Ref, Res} -> - Res - end - end, Refs). + receive + {Ref, Res} -> + Res + end + end, Refs). erl_rel_flag_var() -> "ERL_OTP"++erlang:system_info(otp_release)++"_FLAGS". @@ -1606,101 +1802,101 @@ restore_erl_rel_flags(OldValue) -> ok(too_slow, _Config) -> {comment, "Too slow system to do any actual testing..."}; ok(_Res, Config) -> - ?config(ok_res, Config). + proplists:get_value(ok_res, Config). chk_result(too_slow, - _LWorkers, - _NWorkers, - _HWorkers, - _MWorkers, - _LNShouldWork, - _HShouldWork, - _MShouldWork) -> - ?line ok; + _LWorkers, + _NWorkers, + _HWorkers, + _MWorkers, + _LNShouldWork, + _HShouldWork, + _MShouldWork) -> + ok; chk_result([{low, L, Lmin, _Lmax}, - {normal, N, Nmin, _Nmax}, - {high, H, Hmin, _Hmax}, - {max, M, Mmin, _Mmax}] = Res, - LWorkers, - NWorkers, - HWorkers, - MWorkers, - LNShouldWork, - HShouldWork, - MShouldWork) -> - ?line ?t:format("~p~n", [Res]), - ?line Relax = relax_limits(), + {normal, N, Nmin, _Nmax}, + {high, H, Hmin, _Hmax}, + {max, M, Mmin, _Mmax}] = Res, + LWorkers, + NWorkers, + HWorkers, + MWorkers, + LNShouldWork, + HShouldWork, + MShouldWork) -> + io:format("~p~n", [Res]), + Relax = relax_limits(), case {L, N} of - {0, 0} -> - ?line false = LNShouldWork; - _ -> - ?line {LminRatioLim, - NminRatioLim, - LNRatioLimMin, - LNRatioLimMax} = case Relax of - false -> {0.5, 0.5, 0.05, 0.25}; - true -> {0.05, 0.05, 0.01, 0.4} - end, - ?line Lavg = L/LWorkers, - ?line Navg = N/NWorkers, - ?line Ratio = Lavg/Navg, - ?line LminRatio = Lmin/Lavg, - ?line NminRatio = Nmin/Navg, - ?line ?t:format("low min ratio=~p~n" - "normal min ratio=~p~n" - "low avg=~p~n" - "normal avg=~p~n" - "low/normal ratio=~p~n", - [LminRatio, NminRatio, Lavg, Navg, Ratio]), - erlang:display({low_min_ratio, LminRatio}), - erlang:display({normal_min_ratio, NminRatio}), - erlang:display({low_avg, Lavg}), - erlang:display({normal_avg, Navg}), - erlang:display({low_normal_ratio, Ratio}), - ?line chk_lim(LminRatioLim, LminRatio, 1.0, low_min_ratio), - ?line chk_lim(NminRatioLim, NminRatio, 1.0, normal_min_ratio), - ?line chk_lim(LNRatioLimMin, Ratio, LNRatioLimMax, low_normal_ratio), - ?line true = LNShouldWork, - ?line ok + {0, 0} -> + false = LNShouldWork; + _ -> + {LminRatioLim, + NminRatioLim, + LNRatioLimMin, + LNRatioLimMax} = case Relax of + false -> {0.5, 0.5, 0.05, 0.25}; + true -> {0.05, 0.05, 0.01, 0.4} + end, + Lavg = L/LWorkers, + Navg = N/NWorkers, + Ratio = Lavg/Navg, + LminRatio = Lmin/Lavg, + NminRatio = Nmin/Navg, + io:format("low min ratio=~p~n" + "normal min ratio=~p~n" + "low avg=~p~n" + "normal avg=~p~n" + "low/normal ratio=~p~n", + [LminRatio, NminRatio, Lavg, Navg, Ratio]), + erlang:display({low_min_ratio, LminRatio}), + erlang:display({normal_min_ratio, NminRatio}), + erlang:display({low_avg, Lavg}), + erlang:display({normal_avg, Navg}), + erlang:display({low_normal_ratio, Ratio}), + chk_lim(LminRatioLim, LminRatio, 1.0, low_min_ratio), + chk_lim(NminRatioLim, NminRatio, 1.0, normal_min_ratio), + chk_lim(LNRatioLimMin, Ratio, LNRatioLimMax, low_normal_ratio), + true = LNShouldWork, + ok end, case H of - 0 -> - ?line false = HShouldWork; - _ -> - ?line HminRatioLim = case Relax of - false -> 0.5; - true -> 0.1 - end, - ?line Havg = H/HWorkers, - ?line HminRatio = Hmin/Havg, - erlang:display({high_min_ratio, HminRatio}), - ?line chk_lim(HminRatioLim, HminRatio, 1.0, high_min_ratio), - ?line true = HShouldWork, - ?line ok + 0 -> + false = HShouldWork; + _ -> + HminRatioLim = case Relax of + false -> 0.5; + true -> 0.1 + end, + Havg = H/HWorkers, + HminRatio = Hmin/Havg, + erlang:display({high_min_ratio, HminRatio}), + chk_lim(HminRatioLim, HminRatio, 1.0, high_min_ratio), + true = HShouldWork, + ok end, case M of - 0 -> - ?line false = MShouldWork; - _ -> - ?line MminRatioLim = case Relax of - false -> 0.5; - true -> 0.1 - end, - ?line Mavg = M/MWorkers, - ?line MminRatio = Mmin/Mavg, - erlang:display({max_min_ratio, MminRatio}), - ?line chk_lim(MminRatioLim, MminRatio, 1.0, max_min_ratio), - ?line true = MShouldWork, - ?line ok + 0 -> + false = MShouldWork; + _ -> + MminRatioLim = case Relax of + false -> 0.5; + true -> 0.1 + end, + Mavg = M/MWorkers, + MminRatio = Mmin/Mavg, + erlang:display({max_min_ratio, MminRatio}), + chk_lim(MminRatioLim, MminRatio, 1.0, max_min_ratio), + true = MShouldWork, + ok end, - ?line ok. + ok. chk_lim(Min, V, Max, _What) when Min =< V, V =< Max -> ok; chk_lim(_Min, V, _Max, What) -> - ?t:fail({bad, What, V}). + ct:fail({bad, What, V}). snd(_Msg, []) -> []; @@ -1711,7 +1907,7 @@ snd(Msg, [P|Ps]) -> relax_limits() -> case strange_system_scale() of Scale when Scale > 1 -> - ?t:format("Relaxing limits~n", []), + io:format("Relaxing limits~n", []), true; _ -> false @@ -1836,8 +2032,8 @@ do_it(Tracer, Low, Normal, High, Max, RedsPerSchedLimit) -> 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 + Timeout = (15 - 4)*60*1000 - BalanceWait, + Res = case Timeout < 60*1000 of true -> stop_work(Low, Normal, High, Max), too_slow; @@ -1907,55 +2103,55 @@ part_time_workers(N, Prio) -> tracer(Low, Normal, High, Max) -> receive - {tracees, Prio, Tracees} -> - save_tracees(Prio, Tracees), - case Prio of - low -> tracer(Tracees++Low, Normal, High, Max); - normal -> tracer(Low, Tracees++Normal, High, Max); - high -> tracer(Low, Normal, Tracees++High, Max); - max -> tracer(Low, Normal, High, Tracees++Max) - end; - {get_result, Ref, Who} -> - Delivered = erlang:trace_delivered(all), - receive - {trace_delivered, all, Delivered} -> - ok - end, - {Lc, Nc, Hc, Mc} = read_trace(), - GetMinMax - = fun (Prio, Procs) -> - LargeNum = 1 bsl 64, - case lists:foldl(fun (P, {Mn, Mx} = MnMx) -> - {Prio, C} = get(P), - case C < Mn of - true -> - case C > Mx of - true -> - {C, C}; - false -> - {C, Mx} - end; - false -> - case C > Mx of - true -> {Mn, C}; - false -> MnMx - end - end - end, - {LargeNum, 0}, - Procs) of - {LargeNum, 0} -> {0, 0}; - Res -> Res - end - end, - {Lmin, Lmax} = GetMinMax(low, Low), - {Nmin, Nmax} = GetMinMax(normal, Normal), - {Hmin, Hmax} = GetMinMax(high, High), - {Mmin, Mmax} = GetMinMax(max, Max), - Who ! {trace_result, Ref, [{low, Lc, Lmin, Lmax}, - {normal, Nc, Nmin, Nmax}, - {high, Hc, Hmin, Hmax}, - {max, Mc, Mmin, Mmax}]} + {tracees, Prio, Tracees} -> + save_tracees(Prio, Tracees), + case Prio of + low -> tracer(Tracees++Low, Normal, High, Max); + normal -> tracer(Low, Tracees++Normal, High, Max); + high -> tracer(Low, Normal, Tracees++High, Max); + max -> tracer(Low, Normal, High, Tracees++Max) + end; + {get_result, Ref, Who} -> + Delivered = erlang:trace_delivered(all), + receive + {trace_delivered, all, Delivered} -> + ok + end, + {Lc, Nc, Hc, Mc} = read_trace(), + GetMinMax + = fun (Prio, Procs) -> + LargeNum = 1 bsl 64, + case lists:foldl(fun (P, {Mn, Mx} = MnMx) -> + {Prio, C} = get(P), + case C < Mn of + true -> + case C > Mx of + true -> + {C, C}; + false -> + {C, Mx} + end; + false -> + case C > Mx of + true -> {Mn, C}; + false -> MnMx + end + end + end, + {LargeNum, 0}, + Procs) of + {LargeNum, 0} -> {0, 0}; + Res -> Res + end + end, + {Lmin, Lmax} = GetMinMax(low, Low), + {Nmin, Nmax} = GetMinMax(normal, Normal), + {Hmin, Hmax} = GetMinMax(high, High), + {Mmin, Mmax} = GetMinMax(max, Max), + Who ! {trace_result, Ref, [{low, Lc, Lmin, Lmax}, + {normal, Nc, Nmin, Nmax}, + {high, Hc, Hmin, Hmax}, + {max, Mc, Mmin, Mmax}]} end. read_trace() -> @@ -2031,15 +2227,15 @@ start_node(Config, Args) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" - ++ atom_to_list(?config(testcase, Config)) + ++ atom_to_list(proplists:get_value(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}]). + test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). enable_internal_state() -> @@ -2051,7 +2247,7 @@ enable_internal_state() -> cmp(X, X) -> ok; cmp(X, Y) -> - ?t:format("cmp failed:~n X=~p~n Y=~p~n", [X,Y]), + io:format("cmp failed:~n X=~p~n Y=~p~n", [X,Y]), cmp_aux(X, Y). @@ -2063,7 +2259,7 @@ cmp_aux(T0, T1) when is_tuple(T0), is_tuple(T1), size(T0) == size(T1) -> cmp_aux(X, X) -> ok; cmp_aux(F0, F1) -> - ?t:fail({no_match, F0, F1}). + ct:fail({no_match, F0, F1}). cmp_tuple(_T0, _T1, N, Sz) when N > Sz -> ok; diff --git a/erts/emulator/test/scheduler_SUITE_data/Makefile.src b/erts/emulator/test/scheduler_SUITE_data/Makefile.src new file mode 100644 index 0000000000..859112cf19 --- /dev/null +++ b/erts/emulator/test/scheduler_SUITE_data/Makefile.src @@ -0,0 +1,8 @@ + +SCHEDULER_LIBS = scheduler_SUITE@dll@ + +all: $(SCHEDULER_LIBS) + +@SHLIB_RULES@ + +$(SCHEDULER_LIBS): scheduler_SUITE.c diff --git a/erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c b/erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c new file mode 100644 index 0000000000..ab4863337f --- /dev/null +++ b/erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c @@ -0,0 +1,37 @@ +#ifndef __WIN32__ +#include <unistd.h> +#endif +#include "erl_nif.h" + +static int +load(ErlNifEnv* env, void** priv, ERL_NIF_TERM info) +{ + ErlNifSysInfo sys_info; + enif_system_info(&sys_info, sizeof(ErlNifSysInfo)); + if (!sys_info.smp_support || !sys_info.dirty_scheduler_support) + return 1; + return 0; +} + +static ERL_NIF_TERM +dirty_sleeper(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ +#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT +#ifdef __WIN32__ + Sleep(3000); +#else + sleep(3); +#endif +#endif + return enif_make_atom(env, "ok"); +} + +static ErlNifFunc funcs[] = { +#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT + {"dirty_sleeper", 0, dirty_sleeper, ERL_NIF_DIRTY_JOB_IO_BOUND} +#else + {"dirty_sleeper", 0, dirty_sleeper, 0} +#endif +}; + +ERL_NIF_INIT(scheduler_SUITE, funcs, &load, NULL, NULL, NULL); diff --git a/erts/emulator/test/send_term_SUITE.erl b/erts/emulator/test/send_term_SUITE.erl index 670865cd3f..8afe4e4ac1 100644 --- a/erts/emulator/test/send_term_SUITE.erl +++ b/erts/emulator/test/send_term_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2014. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,49 +20,25 @@ -module(send_term_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2,basic/1]). --export([init_per_testcase/2,end_per_testcase/2]). +-export([all/0, suite/0, basic/1]). -export([generate_external_terms_files/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(3)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> [basic]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - basic(Config) when is_list(Config) -> Drv = "send_term_drv", - ?line P = start_driver(Config, Drv), + P = start_driver(Config, Drv), - ?line [] = term(P, 0), - ?line Self = self(), + [] = term(P, 0), + Self = self(), {blurf,42,[],[-42,{}|"abc"++P],"kalle",3.1416,Self,#{}} = term(P, 1), Map41 = maps:from_list([{blurf, 42}, @@ -76,36 +52,36 @@ basic(Config) when is_list(Config) -> {3.1416, Self}, {#{}, blurf}]), Map42 = term(P, 42), - ?line Deep = lists:seq(0, 199), - ?line Deep = term(P, 2), - ?line {B1,B2} = term(P, 3), - ?line B1 = list_to_binary(lists:seq(0, 255)), - ?line B2 = list_to_binary(lists:seq(23, 255-17)), + Deep = lists:seq(0, 199), + Deep = term(P, 2), + {B1,B2} = term(P, 3), + B1 = list_to_binary(lists:seq(0, 255)), + B2 = list_to_binary(lists:seq(23, 255-17)), %% Pid sending. We need another process. - ?line Child = spawn_link(fun() -> + Child = spawn_link(fun() -> erlang:port_command(P, [4]) end), - ?line {Self,Child} = receive_any(), + {Self,Child} = receive_any(), %% ERL_DRV_EXT2TERM - ?line ExpectExt2Term = expected_ext2term_drv(?config(data_dir, Config)), - ?line ExpectExt2Term = term(P, 5), + ExpectExt2Term = expected_ext2term_drv(proplists:get_value(data_dir, Config)), + ExpectExt2Term = term(P, 5), %% ERL_DRV_INT, ERL_DRV_UINT - ?line case erlang:system_info({wordsize, external}) of + case erlang:system_info({wordsize, external}) of 4 -> - ?line {-1, 4294967295} = term(P, 6); + {-1, 4294967295} = term(P, 6); 8 -> - ?line {-1, 18446744073709551615} = term(P, 6) + {-1, 18446744073709551615} = term(P, 6) end, %% ERL_DRV_BUF2BINARY - ?line ExpectedBinTup = {<<>>, + ExpectedBinTup = {<<>>, <<>>, list_to_binary(lists:duplicate(17,17)), list_to_binary(lists:duplicate(1024,17))}, - ?line ExpectedBinTup = term(P, 7), + ExpectedBinTup = term(P, 7), %% single terms Singles = [{[], 8}, % ERL_DRV_NIL @@ -140,35 +116,34 @@ basic(Config) when is_list(Config) -> {-20233590931456, 38}, % ERL_DRV_INT64 {-9223372036854775808, 39}, {#{}, 40}], % ERL_DRV_MAP - ?line {Terms, Ops} = lists:unzip(Singles), - ?line Terms = term(P,Ops), + {Terms, Ops} = lists:unzip(Singles), + Terms = term(P,Ops), AFloat = term(P, 26), % ERL_DRV_FLOAT - ?line true = AFloat < 0.001, - ?line true = AFloat > -0.001, + true = AFloat < 0.001, + true = AFloat > -0.001, %% Failure cases. - ?line [] = term(P, 127), - ?line receive + [] = term(P, 127), + receive Any -> - ?line io:format("Unexpected: ~p\n", [Any]), - ?line ?t:fail() + ct:fail("Unexpected: ~p\n", [Any]) after 0 -> ok end, - ?line ok = chk_temp_alloc(), + ok = chk_temp_alloc(), %% In a private heap system, verify that there are no binaries %% left for the process. - ?line erlang:garbage_collect(), %Get rid of binaries. + erlang:garbage_collect(), %Get rid of binaries. case erlang:system_info(heap_type) of private -> - ?line {binary,[]} = process_info(self(), binary); + {binary,[]} = process_info(self(), binary); _ -> ok end, - ?line stop_driver(P, Drv), + stop_driver(P, Drv), ok. term(P, Op) -> @@ -184,28 +159,28 @@ chk_temp_alloc() -> case erlang:system_info({allocator,temp_alloc}) of false -> %% Temp alloc is not enabled - ?line ok; + ok; TIL -> %% Verify that we havn't got anything allocated by temp_alloc lists:foreach( fun ({instance, _, TI}) -> - ?line {value, {mbcs, MBCInfo}} + {value, {mbcs, MBCInfo}} = lists:keysearch(mbcs, 1, TI), - ?line {value, {blocks, 0, _, _}} + {value, {blocks, 0, _, _}} = lists:keysearch(blocks, 1, MBCInfo), - ?line {value, {sbcs, SBCInfo}} + {value, {sbcs, SBCInfo}} = lists:keysearch(sbcs, 1, TI), - ?line {value, {blocks, 0, _, _}} + {value, {blocks, 0, _, _}} = lists:keysearch(blocks, 1, SBCInfo) end, TIL), - ?line ok + ok end. %% Start/stop drivers. start_driver(Config, Name) -> - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), erl_ddll:start(), ok = load_driver(Path, Name), open_port({spawn, Name}, []). @@ -219,17 +194,17 @@ load_driver(Dir, Driver) -> end. stop_driver(Port, Name) -> - ?line true = erlang:port_close(Port), + true = erlang:port_close(Port), receive {Port,Message} -> - ?t:fail({strange_message_from_port,Message}) + ct:fail({strange_message_from_port,Message}) after 0 -> ok end, %% Unload the driver. ok = erl_ddll:unload_driver(Name), - ?line ok = erl_ddll:stop(). + ok = erl_ddll:stop(). get_external_terms(DataDir) -> {ok, Bin} = file:read_file([DataDir, "ext_terms.bin"]), @@ -261,37 +236,36 @@ generate_external_terms_files(BaseDir) -> RPort = hd(rpc:call(Node, erlang, ports, [])), true = is_port(RPort), slave:stop(Node), - Terms = - [{4711, -4711, [an_atom, "a list"]}, - [1000000000000000000000,-1111111111111111, "blupp!", blipp], - {RPid, {RRef, RPort}, self(), hd(erlang:ports()), make_ref()}, - {{}, [], [], fun () -> ok end, <<"hej hopp trallalaaaaaaaaaaaaaaa">>}, - [44444444444444444444444,-44444444444, "b!", blippppppp], - {4711, RPid, {RRef, RPort}, -4711, [an_atom, "a list"]}, - {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())}, - {4711, -4711, [an_atom, "a list"]}, - {4711, -4711, [atom, "list"]}, - {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())}, - {4444444444444444444,-44444, {{{{{{{{{{{{}}}}}}}}}}}}, make_ref()}, - {444444444444444444444,-44444, [[[[[[[[[[[1]]]]]]]]]]], make_ref()}, - {444444444444444444,-44444, {{{{{{{{{{{{2}}}}}}}}}}}}, make_ref()}, - {4444444444444444444444,-44444, {{{{{{{{{{{{3}}}}}}}}}}}}, make_ref()}, - {44444444444444444444,-44444, {{{{{{{{{{{{4}}}}}}}}}}}}, make_ref()}, - {4444444444444444,-44444, [[[[[[[[[[[5]]]]]]]]]]], make_ref()}, - {444444444444444444444,-44444, {{{{{{{{{{{{6}}}}}}}}}}}}, make_ref()}, - {444444444444444,-44444, {{{{{{{{{{{{7}}}}}}}}}}}}, make_ref()}, - {4444444444444444444,-44444, {{{{{{{{{{{{8}}}}}}}}}}}}, make_ref()}, - #{}, - #{1 => 11, 2 => 22, 3 => 33}, - maps:from_list([{K,K*11} || K <- lists:seq(1,100)])], + Terms = [{4711, -4711, [an_atom, "a list"]}, + [1000000000000000000000,-1111111111111111, "blupp!", blipp], + {RPid, {RRef, RPort}, self(), hd(erlang:ports()), make_ref()}, + {{}, [], [], fun () -> ok end, <<"hej hopp trallalaaaaaaaaaaaaaaa">>}, + [44444444444444444444444,-44444444444, "b!", blippppppp], + {4711, RPid, {RRef, RPort}, -4711, [an_atom, "a list"]}, + {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())}, + {4711, -4711, [an_atom, "a list"]}, + {4711, -4711, [atom, "list"]}, + {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())}, + {4444444444444444444,-44444, {{{{{{{{{{{{}}}}}}}}}}}}, make_ref()}, + {444444444444444444444,-44444, [[[[[[[[[[[1]]]]]]]]]]], make_ref()}, + {444444444444444444,-44444, {{{{{{{{{{{{2}}}}}}}}}}}}, make_ref()}, + {4444444444444444444444,-44444, {{{{{{{{{{{{3}}}}}}}}}}}}, make_ref()}, + {44444444444444444444,-44444, {{{{{{{{{{{{4}}}}}}}}}}}}, make_ref()}, + {4444444444444444,-44444, [[[[[[[[[[[5]]]]]]]]]]], make_ref()}, + {444444444444444444444,-44444, {{{{{{{{{{{{6}}}}}}}}}}}}, make_ref()}, + {444444444444444,-44444, {{{{{{{{{{{{7}}}}}}}}}}}}, make_ref()}, + {4444444444444444444,-44444, {{{{{{{{{{{{8}}}}}}}}}}}}, make_ref()}, + #{}, + #{1 => 11, 2 => 22, 3 => 33}, + maps:from_list([{K,K*11} || K <- lists:seq(1,100)])], ok = file:write_file(filename:join([BaseDir, - "send_term_SUITE_data", - "ext_terms.bin"]), - term_to_binary(Terms, [compressed])), + "send_term_SUITE_data", + "ext_terms.bin"]), + term_to_binary(Terms, [compressed])), {ok, IoDev} = file:open(filename:join([BaseDir, - "send_term_SUITE_data", - "ext_terms.h"]), - [write]), + "send_term_SUITE_data", + "ext_terms.h"]), + [write]), write_ext_terms_h(IoDev, Terms), file:close(IoDev). @@ -301,12 +275,12 @@ write_ext_terms_h(IoDev, Terms) -> io:format(IoDev, "#define EXT_TERMS_H__~n",[]), {ExtTerms, MaxSize} = make_ext_terms(Terms), io:format(IoDev, - "static struct {~n" - " unsigned char ext[~p];~n" - " int ext_size;~n" - " unsigned char cext[~p];~n" - " int cext_size;~n" - "} ext_terms[] = {~n",[MaxSize, MaxSize]), + "static struct {~n" + " unsigned char ext[~p];~n" + " int ext_size;~n" + " unsigned char cext[~p];~n" + " int cext_size;~n" + "} ext_terms[] = {~n",[MaxSize, MaxSize]), E = write_ext_terms_h(IoDev, ExtTerms, 0), io:format(IoDev, "};~n",[]), io:format(IoDev, "#define NO_OF_EXT_TERMS ~p~n", [E]), diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl index 2e51712737..c3e303bbd1 100644 --- a/erts/emulator/test/sensitive_SUITE.erl +++ b/erts/emulator/test/sensitive_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,28 +20,20 @@ -module(sensitive_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --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, - stickiness/1,send_trace/1,recv_trace/1,proc_trace/1,call_trace/1, - meta_trace/1,running_trace/1,gc_trace/1,seq_trace/1, - t_process_info/1,t_process_display/1,save_calls/1]). +-export([all/0, suite/0, + stickiness/1,send_trace/1,recv_trace/1,proc_trace/1,call_trace/1, + meta_trace/1,running_trace/1,gc_trace/1,seq_trace/1, + t_process_info/1,t_process_display/1,save_calls/1]). -export([remote_process_display/0,an_exported_function/1]). -import(lists, [keysearch/3,foreach/2,sort/1]). -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(5)), - [{watchdog,Dog}|Config]. - -end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 5}}]. all() -> [stickiness, send_trace, recv_trace, proc_trace, @@ -49,164 +41,148 @@ all() -> seq_trace, t_process_info, t_process_display, save_calls]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - stickiness(Config) when is_list(Config) -> - ?line {Tracer,Mref} = spawn_monitor(fun() -> - receive after infinity -> ok end - end), - ?line false = process_flag(sensitive, true), + {Tracer,Mref} = spawn_monitor(fun() -> + receive after infinity -> ok end + end), + false = process_flag(sensitive, true), put(foo, bar), Flags = sort([send,'receive',procs,call,running,garbage_collection, - set_on_spawn,set_on_first_spawn,set_on_link,set_on_first_link]), - ?line foreach(fun(F) -> - 1 = erlang:trace(self(), true, [F,{tracer,Tracer}]) - end, Flags), - ?line foreach(fun(F) -> - 1 = erlang:trace(self(), false, [F,{tracer,Tracer}]) - end, Flags), - ?line 1 = erlang:trace(self(), true, [{tracer,Tracer}|Flags]), - ?line 1 = erlang:trace(self(), false, [{tracer,Tracer}|Flags]), - - ?line {messages,[]} = process_info(Tracer, messages), + set_on_spawn,set_on_first_spawn,set_on_link,set_on_first_link]), + foreach(fun(F) -> + 1 = erlang:trace(self(), true, [F,{tracer,Tracer}]) + end, Flags), + foreach(fun(F) -> + 1 = erlang:trace(self(), false, [F,{tracer,Tracer}]) + end, Flags), + 1 = erlang:trace(self(), true, [{tracer,Tracer}|Flags]), + 1 = erlang:trace(self(), false, [{tracer,Tracer}|Flags]), + + {messages,[]} = process_info(Tracer, messages), exit(Tracer, kill), receive {'DOWN',Mref,_,_,_} -> ok end, - + case process_info(self(), dictionary) of - {dictionary,[]} -> ok; - {dictionary,_} -> ?line ?t:fail(sensitive_flag_cleared) + {dictionary,[]} -> ok; + {dictionary,_} -> ct:fail(sensitive_flag_cleared) end, NewTracer = spawn_link(fun() -> receive after infinity -> ok end end), - ?line 1 = erlang:trace(self(), true, [{tracer,NewTracer}|Flags]), - ?line Flags = sort(element(2, erlang:trace_info(self(), flags))), - ?line {tracer,NewTracer} = erlang:trace_info(self(), tracer), + 1 = erlang:trace(self(), true, [{tracer,NewTracer}|Flags]), + Flags = sort(element(2, erlang:trace_info(self(), flags))), + {tracer,NewTracer} = erlang:trace_info(self(), tracer), %% Process still sensitive. Tracer should disappear when we clear %% all trace flags. - ?line 1 = erlang:trace(self(), false, [{tracer,NewTracer}|Flags]), - ?line {tracer,[]} = erlang:trace_info(self(), tracer), + 1 = erlang:trace(self(), false, [{tracer,NewTracer}|Flags]), + {tracer,[]} = erlang:trace_info(self(), tracer), - ?line unlink(NewTracer), exit(NewTracer, kill), + unlink(NewTracer), exit(NewTracer, kill), ok. send_trace(Config) when is_list(Config) -> - ?line {Dead,Mref} = spawn_monitor(fun() -> ok end), + {Dead,Mref} = spawn_monitor(fun() -> ok end), receive {'DOWN',Mref,_,_,_} -> ok end, - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - ?line Sink = spawn_link(fun() -> receive after infinity -> ok end end), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + Sink = spawn_link(fun() -> receive after infinity -> ok end end), Self = self(), - ?line 1 = erlang:trace(self(), true, [send,{tracer,Tracer}]), - ?line Dead ! before, - ?line Sink ! before, - ?line false = process_flag(sensitive, true), - ?line Sink ! {blurf,lists:seq(1, 50)}, - ?line true = process_flag(sensitive, true), - ?line Sink ! lists:seq(1, 100), - ?line Dead ! forget_me, - ?line true = process_flag(sensitive, false), - ?line Sink ! after1, - ?line false = process_flag(sensitive, false), - ?line Sink ! after2, - ?line Dead ! after2, - ?line wait_trace(Self), - - ?line {messages,Messages} = process_info(Tracer, messages), - ?line [{trace,Self,send_to_non_existing_process,before,Dead}, - {trace,Self,send,before,Sink}, - {trace,Self,send,after1,Sink}, - {trace,Self,send,after2,Sink}, - {trace,Self,send_to_non_existing_process,after2,Dead}] = Messages, - - ?line unlink(Tracer), exit(Tracer, kill), - ?line unlink(Sink), exit(Sink, kill), + 1 = erlang:trace(self(), true, [send,{tracer,Tracer}]), + Dead ! before, + Sink ! before, + false = process_flag(sensitive, true), + Sink ! {blurf,lists:seq(1, 50)}, + true = process_flag(sensitive, true), + Sink ! lists:seq(1, 100), + Dead ! forget_me, + true = process_flag(sensitive, false), + Sink ! after1, + false = process_flag(sensitive, false), + Sink ! after2, + Dead ! after2, + wait_trace(Self), + + {messages,Messages} = process_info(Tracer, messages), + [{trace,Self,send_to_non_existing_process,before,Dead}, + {trace,Self,send,before,Sink}, + {trace,Self,send,after1,Sink}, + {trace,Self,send,after2,Sink}, + {trace,Self,send_to_non_existing_process,after2,Dead}] = Messages, + + unlink(Tracer), exit(Tracer, kill), + unlink(Sink), exit(Sink, kill), ok. recv_trace(Config) when is_list(Config) -> Parent = self(), - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - ?line Sender = spawn_link(fun() -> recv_trace_sender(Parent) end), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + Sender = spawn_link(fun() -> recv_trace_sender(Parent) end), - ?line 1 = erlang:trace(self(), true, ['receive',{tracer,Tracer}]), + 1 = erlang:trace(self(), true, ['receive',{tracer,Tracer}]), Sender ! 1, receive a -> wait_trace(Sender) end, - ?line false = process_flag(sensitive, true), + false = process_flag(sensitive, true), Sender ! 2, receive {b,[x,y,z]} -> wait_trace(Sender) end, - - ?line true = process_flag(sensitive, false), + + true = process_flag(sensitive, false), Sender ! 3, receive c -> wait_trace(Sender) end, - - ?line {messages,Messages} = process_info(Tracer, messages), + + {messages,Messages} = process_info(Tracer, messages), [{trace,Parent,'receive',a}, {trace,Parent,'receive',{trace_delivered,_,_}}, {trace,Parent,'receive',c}|_] = Messages, - ?line unlink(Tracer), exit(Tracer, kill), - ?line unlink(Sender), exit(Sender, kill), + unlink(Tracer), exit(Tracer, kill), + unlink(Sender), exit(Sender, kill), ok. recv_trace_sender(Pid) -> receive - 1 -> Pid ! a; - 2 -> Pid ! {b,[x,y,z]}; - 3 -> Pid ! c + 1 -> Pid ! a; + 2 -> Pid ! {b,[x,y,z]}; + 3 -> Pid ! c end, recv_trace_sender(Pid). proc_trace(Config) when is_list(Config) -> Self = self(), - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - ?line 1 = erlang:trace(self(), true, [procs,{tracer,Tracer}]), - ?line false = process_flag(sensitive, true), + 1 = erlang:trace(self(), true, [procs,{tracer,Tracer}]), + false = process_flag(sensitive, true), spawn(fun() -> ok end), - ?line register(nisse, self()), - ?line unregister(nisse), - ?line link(Tracer), - ?line unlink(Tracer), - ?line Linker0 = spawn_link(fun() -> ok end), + register(nisse, self()), + unregister(nisse), + link(Tracer), + unlink(Tracer), + Linker0 = spawn_link(fun() -> ok end), Mref0 = erlang:monitor(process, Linker0), - ?line {_,Mref} = spawn_monitor(fun() -> link(Self), unlink(Self) end), + {_,Mref} = spawn_monitor(fun() -> link(Self), unlink(Self) end), receive {'DOWN',Mref0,_,_,_} -> ok end, receive {'DOWN',Mref,_,_,_} -> ok end, - ?line true = process_flag(sensitive, false), + true = process_flag(sensitive, false), Dead = spawn(fun() -> ok end), - ?line register(arne, self()), - ?line unregister(arne), - ?line {Linker,Mref2} = spawn_monitor(fun() -> link(Self), unlink(Self) end), + register(arne, self()), + unregister(arne), + {Linker,Mref2} = spawn_monitor(fun() -> link(Self), unlink(Self) end), receive {'DOWN',Mref2,_,_,_} -> ok end, - ?line Last = spawn_link(fun() -> ok end), + Last = spawn_link(fun() -> ok end), receive after 10 -> ok end, - ?line wait_trace(all), - ?line {messages,Messages} = process_info(Tracer, messages), + wait_trace(all), + {messages,Messages} = process_info(Tracer, messages), [{trace,Self,spawn,Dead,{erlang,apply,_}}, {trace,Self,register,arne}, {trace,Self,unregister,arne}, @@ -217,80 +193,80 @@ proc_trace(Config) when is_list(Config) -> {trace,Self,link,Last}, {trace,Self,getting_unlinked,Last}] = Messages, - ?line unlink(Tracer), exit(Tracer, kill), + unlink(Tracer), exit(Tracer, kill), ok. call_trace(Config) when is_list(Config) -> Self = self(), - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - - ?line 1 = erlang:trace(self(), true, [call,{tracer,Tracer}]), - ?line 1 = erlang:trace_pattern({?MODULE,an_exported_function,1}, - true, [global]), - ?line 1 = erlang:trace_pattern({erlang,list_to_binary,1}, true, [global]), - ?line 1 = erlang:trace_pattern({erlang,binary_to_list,1}, true, [local]), - ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, true, [local]), - - ?line false = process_flag(sensitive, true), - ?line {ok,42} = a_local_function(42), - ?line 7 = an_exported_function(6), - ?line <<7,8,9,10>> = list_to_binary(id([7,8,9,10])), - ?line [42,43] = binary_to_list(id(<<42,43>>)), - ?line true = process_flag(sensitive, false), - - ?line {ok,{a,b}} = a_local_function({a,b}), - ?line 1 = an_exported_function(0), - ?line <<1,2,3>> = list_to_binary(id([1,2,3])), - ?line [42,43,44] = binary_to_list(id(<<42,43,44>>)), - - ?line wait_trace(Self), - - ?line {messages,Messages} = process_info(Tracer, messages), - ?line [{trace,Self,call,{?MODULE,a_local_function,[{a,b}]}}, - {trace,Self,call,{?MODULE,an_exported_function,[0]}}, - {trace,Self,call,{?MODULE,id,[_]}}, - {trace,Self,call,{erlang,list_to_binary,[[1,2,3]]}}, - {trace,Self,call,{sensitive_SUITE,id,[<<42,43,44>>]}}, - {trace,Self,call,{erlang,binary_to_list,[<<42,43,44>>]}}, - {trace,Self,call,{?MODULE,wait_trace,[Self]}}] = Messages, - - ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, false, [local]), - ?line erlang:trace_pattern({erlang,'_','_'}, false, [local]), - ?line erlang:trace_pattern({'_','_','_'}, false, [global]), - - ?line unlink(Tracer), exit(Tracer, kill), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + + 1 = erlang:trace(self(), true, [call,{tracer,Tracer}]), + 1 = erlang:trace_pattern({?MODULE,an_exported_function,1}, + true, [global]), + 1 = erlang:trace_pattern({erlang,list_to_binary,1}, true, [global]), + 1 = erlang:trace_pattern({erlang,binary_to_list,1}, true, [local]), + Local = erlang:trace_pattern({?MODULE,'_','_'}, true, [local]), + + false = process_flag(sensitive, true), + {ok,42} = a_local_function(42), + 7 = an_exported_function(6), + <<7,8,9,10>> = list_to_binary(id([7,8,9,10])), + [42,43] = binary_to_list(id(<<42,43>>)), + true = process_flag(sensitive, false), + + {ok,{a,b}} = a_local_function({a,b}), + 1 = an_exported_function(0), + <<1,2,3>> = list_to_binary(id([1,2,3])), + [42,43,44] = binary_to_list(id(<<42,43,44>>)), + + wait_trace(Self), + + {messages,Messages} = process_info(Tracer, messages), + [{trace,Self,call,{?MODULE,a_local_function,[{a,b}]}}, + {trace,Self,call,{?MODULE,an_exported_function,[0]}}, + {trace,Self,call,{?MODULE,id,[_]}}, + {trace,Self,call,{erlang,list_to_binary,[[1,2,3]]}}, + {trace,Self,call,{sensitive_SUITE,id,[<<42,43,44>>]}}, + {trace,Self,call,{erlang,binary_to_list,[<<42,43,44>>]}}, + {trace,Self,call,{?MODULE,wait_trace,[Self]}}] = Messages, + + Local = erlang:trace_pattern({?MODULE,'_','_'}, false, [local]), + erlang:trace_pattern({erlang,'_','_'}, false, [local]), + erlang:trace_pattern({'_','_','_'}, false, [global]), + + unlink(Tracer), exit(Tracer, kill), ok. meta_trace(Config) when is_list(Config) -> Self = self(), - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - - ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, true, [{meta,Tracer}]), - ?line 1 = erlang:trace_pattern({erlang,list_to_binary,1}, true, [{meta,Tracer}]), - - ?line false = process_flag(sensitive, true), - ?line {ok,blurf} = a_local_function(blurf), - ?line 100 = an_exported_function(99), - ?line <<8,9,10>> = list_to_binary(id([8,9,10])), - ?line true = process_flag(sensitive, false), - - ?line {ok,{x,y}} = a_local_function({x,y}), - ?line 1 = an_exported_function(0), - ?line <<10>> = list_to_binary(id([10])), - ?line wait_trace(Self), - - ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, false, [meta]), - ?line 1 = erlang:trace_pattern({erlang,list_to_binary,1}, false, [meta]), - ?line a_local_function(0), - - ?line {messages,Messages} = process_info(Tracer, messages), - ?line [{trace_ts,Self,call,{?MODULE,a_local_function,[{x,y}]},{_,_,_}}, - {trace_ts,Self,call,{?MODULE,an_exported_function,[0]},{_,_,_}}, - {trace_ts,Self,call,{?MODULE,id,[_]},{_,_,_}}, - {trace_ts,Self,call,{erlang,list_to_binary,[[10]]},{_,_,_}}, - {trace_ts,Self,call,{?MODULE,wait_trace,[Self]},{_,_,_}}] = Messages, - - ?line unlink(Tracer), exit(Tracer, kill), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + + Local = erlang:trace_pattern({?MODULE,'_','_'}, true, [{meta,Tracer}]), + 1 = erlang:trace_pattern({erlang,list_to_binary,1}, true, [{meta,Tracer}]), + + false = process_flag(sensitive, true), + {ok,blurf} = a_local_function(blurf), + 100 = an_exported_function(99), + <<8,9,10>> = list_to_binary(id([8,9,10])), + true = process_flag(sensitive, false), + + {ok,{x,y}} = a_local_function({x,y}), + 1 = an_exported_function(0), + <<10>> = list_to_binary(id([10])), + wait_trace(Self), + + Local = erlang:trace_pattern({?MODULE,'_','_'}, false, [meta]), + 1 = erlang:trace_pattern({erlang,list_to_binary,1}, false, [meta]), + a_local_function(0), + + {messages,Messages} = process_info(Tracer, messages), + [{trace_ts,Self,call,{?MODULE,a_local_function,[{x,y}]},{_,_,_}}, + {trace_ts,Self,call,{?MODULE,an_exported_function,[0]},{_,_,_}}, + {trace_ts,Self,call,{?MODULE,id,[_]},{_,_,_}}, + {trace_ts,Self,call,{erlang,list_to_binary,[[10]]},{_,_,_}}, + {trace_ts,Self,call,{?MODULE,wait_trace,[Self]},{_,_,_}}] = Messages, + + unlink(Tracer), exit(Tracer, kill), ok. a_local_function(A) -> @@ -301,66 +277,66 @@ an_exported_function(X) -> running_trace(Config) when is_list(Config) -> Self = self(), - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - ?line false = process_flag(sensitive, true), - ?line 1 = erlang:trace(Self, true, [running,{tracer,Tracer}]), + false = process_flag(sensitive, true), + 1 = erlang:trace(Self, true, [running,{tracer,Tracer}]), erlang:yield(), erlang:yield(), erlang:yield(), erlang:yield(), erlang:yield(), erlang:yield(), erlang:yield(), erlang:yield(), - ?line true = process_flag(sensitive, false), + true = process_flag(sensitive, false), erlang:yield(), - ?line 1 = erlang:trace(Self, false, [running,{tracer,Tracer}]), + 1 = erlang:trace(Self, false, [running,{tracer,Tracer}]), - ?line wait_trace(Self), - ?line {messages,Messages} = process_info(Tracer, messages), - ?line [{trace,Self,out,{sensitive_SUITE,running_trace,1}}, - {trace,Self,in,{sensitive_SUITE,running_trace,1}}] = Messages, + wait_trace(Self), + {messages,Messages} = process_info(Tracer, messages), + [{trace,Self,out,{sensitive_SUITE,running_trace,1}}, + {trace,Self,in,{sensitive_SUITE,running_trace,1}}] = Messages, - ?line unlink(Tracer), exit(Tracer, kill), + unlink(Tracer), exit(Tracer, kill), ok. gc_trace(Config) when is_list(Config) -> Self = self(), - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - ?line false = process_flag(sensitive, true), - ?line 1 = erlang:trace(Self, true, [garbage_collection,{tracer,Tracer}]), + false = process_flag(sensitive, true), + 1 = erlang:trace(Self, true, [garbage_collection,{tracer,Tracer}]), erlang:garbage_collect(), erlang:garbage_collect(), erlang:garbage_collect(), erlang:garbage_collect(), erlang:garbage_collect(), erlang:garbage_collect(), erlang:garbage_collect(), erlang:garbage_collect(), - ?line true = process_flag(sensitive, false), + true = process_flag(sensitive, false), erlang:garbage_collect(), - ?line 1 = erlang:trace(Self, false, [garbage_collection,{tracer,Tracer}]), + 1 = erlang:trace(Self, false, [garbage_collection,{tracer,Tracer}]), - ?line wait_trace(Self), - ?line {messages,Messages} = process_info(Tracer, messages), - ?line [{trace,Self,gc_start,_},{trace,Self,gc_end,_}] = Messages, + wait_trace(Self), + {messages,Messages} = process_info(Tracer, messages), + [{trace,Self,gc_major_start,_},{trace,Self,gc_major_end,_}] = Messages, - ?line unlink(Tracer), exit(Tracer, kill), + unlink(Tracer), exit(Tracer, kill), ok. seq_trace(Config) when is_list(Config) -> Self = self(), - ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), - ?line seq_trace:set_system_tracer(Tracer), - - ?line false = process_flag(sensitive, true), - - ?line Echo = spawn_link(fun() -> - receive - {Pid,Message} -> - Pid ! {reply,Message} - end - end), - ?line Sender = spawn_link(fun() -> - seq_trace:set_token(label, 42), - seq_trace:set_token('receive', true), - seq_trace:set_token(send, true), - seq_trace:set_token(print, true), - seq_trace:print(42, "trace started"), - Self ! blurf - end), + Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + seq_trace:set_system_tracer(Tracer), + + false = process_flag(sensitive, true), + + Echo = spawn_link(fun() -> + receive + {Pid,Message} -> + Pid ! {reply,Message} + end + end), + Sender = spawn_link(fun() -> + seq_trace:set_token(label, 42), + seq_trace:set_token('receive', true), + seq_trace:set_token(send, true), + seq_trace:set_token(print, true), + seq_trace:print(42, "trace started"), + Self ! blurf + end), seq_trace:set_token(label, 17), seq_trace:set_token('receive', true), seq_trace:set_token(send, true), @@ -370,49 +346,49 @@ seq_trace(Config) when is_list(Config) -> receive {reply,hello} -> ok end, receive blurf -> ok end, - ?line wait_trace(all), + wait_trace(all), + + {messages,Messages} = process_info(Tracer, messages), + [{seq_trace,17,{'receive',{0,2},Self,Echo,{Self,hello}}}, + {seq_trace,17,{send,{2,3},Echo,Self,{reply,hello}}}] = + [M || {seq_trace,17,_}=M <- Messages], - ?line {messages,Messages} = process_info(Tracer, messages), - ?line [{seq_trace,17,{'receive',{0,2},Self,Echo,{Self,hello}}}, - {seq_trace,17,{send,{2,3},Echo,Self,{reply,hello}}}] = - [M || {seq_trace,17,_}=M <- Messages], + [{seq_trace,42,{print,{0,1},Sender,[],"trace started"}}, + {seq_trace,42,{send,{0,2},Sender,Self,blurf}}] = + [M || {seq_trace,42,_}=M <- Messages], - ?line [{seq_trace,42,{print,{0,1},Sender,[],"trace started"}}, - {seq_trace,42,{send,{0,2},Sender,Self,blurf}}] = - [M || {seq_trace,42,_}=M <- Messages], - - ?line unlink(Tracer), exit(Tracer, kill), - ?line unlink(Echo), exit(Echo, kill), - ?line unlink(Sender), exit(Sender, kill), + unlink(Tracer), exit(Tracer, kill), + unlink(Echo), exit(Echo, kill), + unlink(Sender), exit(Sender, kill), ok. t_process_info(Config) when is_list(Config) -> Parent = self(), - ?line Pid = spawn_link(fun() -> - put(foo, bar), - false = process_flag(sensitive, true), - Parent ! go, - receive - revert -> - true = process_flag(sensitive, false), - Parent ! go_again, - receive never -> ok end - end end), + Pid = spawn_link(fun() -> + put(foo, bar), + false = process_flag(sensitive, true), + Parent ! go, + receive + revert -> + true = process_flag(sensitive, false), + Parent ! go_again, + receive never -> ok end + end end), receive go -> ok end, - ?line put(foo, bar), - ?line self() ! Pid ! {i,am,a,message}, + put(foo, bar), + self() ! Pid ! {i,am,a,message}, - ?line false = process_flag(sensitive, true), - ?line t_process_info_suppressed(self()), - ?line t_process_info_suppressed(Pid), + false = process_flag(sensitive, true), + t_process_info_suppressed(self()), + t_process_info_suppressed(Pid), - ?line true = process_flag(sensitive, false), + true = process_flag(sensitive, false), Pid ! revert, receive go_again -> ok end, - ?line t_process_info_normal(self()), - ?line t_process_info_normal(Pid), + t_process_info_normal(self()), + t_process_info_normal(Pid), ok. t_process_info_suppressed(Pid) -> @@ -423,7 +399,7 @@ t_process_info_suppressed(Pid) -> t_process_info_normal(Pid) -> {value,{foo,bar}} = keysearch(foo, 1, my_process_info(Pid, dictionary)), case process_info(Pid, backtrace) of - {backtrace,Bin} when size(Bin) > 20 -> ok + {backtrace,Bin} when size(Bin) > 20 -> ok end, [{i,am,a,message}] = my_process_info(Pid, messages). @@ -431,16 +407,16 @@ my_process_info(Pid, Tag) -> {Tag,Value} = process_info(Pid, Tag), All = process_info(Pid), case keysearch(Tag, 1, All) of - false -> Value; - {value,{Tag,Value}} -> Value + false -> Value; + {value,{Tag,Value}} -> Value end. t_process_display(Config) when is_list(Config) -> - ?line Dir = filename:dirname(code:which(?MODULE)), - ?line Cmd = atom_to_list(lib:progname()) ++ " -noinput -pa " ++ Dir ++ - " -run " ++ ?MODULE_STRING ++ " remote_process_display", - ?line io:put_chars(Cmd), - ?line P = open_port({spawn,Cmd}, [in,stderr_to_stdout,eof]), + Dir = filename:dirname(code:which(?MODULE)), + Cmd = atom_to_list(lib:progname()) ++ " -noinput -pa " ++ Dir ++ + " -run " ++ ?MODULE_STRING ++ " remote_process_display", + io:put_chars(Cmd), + P = open_port({spawn,Cmd}, [in,stderr_to_stdout,eof]), <<"done",_/binary>> = get_all(P), ok. @@ -456,27 +432,26 @@ get_all(P) -> get_all(P, Acc) -> receive - {P,{data,S}} -> - get_all(P, [Acc|S]); - {P,eof} -> - iolist_to_binary(Acc) + {P,{data,S}} -> + get_all(P, [Acc|S]); + {P,eof} -> + iolist_to_binary(Acc) end. save_calls(Config) when is_list(Config) -> process_flag(save_calls, 10), false = process_flag(sensitive, true), - ?line {last_calls,LastCalls} = process_info(self(), last_calls), - ?line [{erlang,process_flag,2}] = LastCalls, - ?line [2,4,6] = lists:map(fun(E) -> 2*E end, [1,2,3]), - ?line {last_calls,LastCalls} = process_info(self(), last_calls), + {last_calls,LastCalls} = process_info(self(), last_calls), + [{erlang,process_flag,2}] = LastCalls, + [2,4,6] = lists:map(fun(E) -> 2*E end, [1,2,3]), + {last_calls,LastCalls} = process_info(self(), last_calls), ok. wait_trace(Pid) -> Ref = erlang:trace_delivered(Pid), receive - {trace_delivered,Pid,Ref} -> ok + {trace_delivered,Pid,Ref} -> ok end. - + id(I) -> I. - diff --git a/erts/emulator/test/signal_SUITE.erl b/erts/emulator/test/signal_SUITE.erl index 4aa690fb0f..0b11fa13f5 100644 --- a/erts/emulator/test/signal_SUITE.erl +++ b/erts/emulator/test/signal_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,12 +28,10 @@ -module(signal_SUITE). -author('[email protected]'). --define(DEFAULT_TIMEOUT_SECONDS, 120). - %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-include_lib("common_test/include/ct.hrl"). +-export([all/0, suite/0,init_per_suite/1, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2]). % Test cases -export([xm_sig_order/1, @@ -51,16 +49,12 @@ pending_exit_group_leader/1, exit_before_pending_exit/1]). --export([init_per_testcase/2, end_per_testcase/2]). - init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - ?line Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMEOUT_SECONDS)), available_internal_state(true), - ?line [{testcase, Func},{watchdog, Dog}|Config]. + [{testcase, Func}|Config]. end_per_testcase(_Func, Config) -> - ?line Dog = ?config(watchdog, Config), - ?line ?t:timetrap_cancel(Dog). + ok. init_per_suite(Config) -> Config. @@ -70,7 +64,9 @@ end_per_suite(_Config) -> catch erts_debug:set_internal_state(not_running_optimization, true), available_internal_state(false). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> [xm_sig_order, pending_exit_unlink_process, @@ -83,41 +79,30 @@ all() -> pending_exit_process_info_2, pending_exit_group_leader, exit_before_pending_exit]. -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -xm_sig_order(doc) -> ["Test that exit signals and messages are received " - "in correct order"]; -xm_sig_order(suite) -> []; +%% Test that exit signals and messages are received in correct order xm_sig_order(Config) when is_list(Config) -> - ?line LNode = node(), - ?line repeat(fun () -> xm_sig_order_test(LNode) end, 1000), - ?line {ok, RNode} = start_node(Config), - ?line repeat(fun () -> xm_sig_order_test(RNode) end, 1000), - ?line stop_node(RNode), - ?line ok. + LNode = node(), + repeat(fun () -> xm_sig_order_test(LNode) end, 1000), + {ok, RNode} = start_node(Config), + repeat(fun () -> xm_sig_order_test(RNode) end, 1000), + stop_node(RNode), + ok. xm_sig_order_test(Node) -> - ?line P = spawn(Node, fun () -> xm_sig_order_proc() end), - ?line M = erlang:monitor(process, P), - ?line P ! may_reach, - ?line P ! may_reach, - ?line P ! may_reach, - ?line exit(P, good_signal_order), - ?line P ! may_not_reach, - ?line P ! may_not_reach, - ?line P ! may_not_reach, - ?line receive + P = spawn(Node, fun () -> xm_sig_order_proc() end), + M = erlang:monitor(process, P), + P ! may_reach, + P ! may_reach, + P ! may_reach, + exit(P, good_signal_order), + P ! may_not_reach, + P ! may_not_reach, + P ! may_not_reach, + receive {'DOWN', M, process, P, R} -> - ?line good_signal_order = R + good_signal_order = R end. xm_sig_order_proc() -> @@ -128,168 +113,149 @@ xm_sig_order_proc() -> end, xm_sig_order_proc(). -pending_exit_unlink_process(doc) -> []; -pending_exit_unlink_process(suite) -> []; pending_exit_unlink_process(Config) when is_list(Config) -> - ?line pending_exit_test(self(), unlink). + pending_exit_test(self(), unlink). -pending_exit_unlink_dist_process(doc) -> []; -pending_exit_unlink_dist_process(suite) -> []; pending_exit_unlink_dist_process(Config) when is_list(Config) -> - ?line {ok, Node} = start_node(Config), - ?line From = spawn(Node, fun () -> receive after infinity -> ok end end), - ?line Res = pending_exit_test(From, unlink), - ?line stop_node(Node), - ?line Res. - -pending_exit_unlink_port(doc) -> []; -pending_exit_unlink_port(suite) -> []; + {ok, Node} = start_node(Config), + From = spawn(Node, fun () -> receive after infinity -> ok end end), + Res = pending_exit_test(From, unlink), + stop_node(Node), + Res. + pending_exit_unlink_port(Config) when is_list(Config) -> - ?line pending_exit_test(hd(erlang:ports()), unlink). + pending_exit_test(hd(erlang:ports()), unlink). -pending_exit_trap_exit(doc) -> []; -pending_exit_trap_exit(suite) -> []; pending_exit_trap_exit(Config) when is_list(Config) -> - ?line pending_exit_test(self(), trap_exit). + pending_exit_test(self(), trap_exit). -pending_exit_receive(doc) -> []; -pending_exit_receive(suite) -> []; pending_exit_receive(Config) when is_list(Config) -> - ?line pending_exit_test(self(), 'receive'). + pending_exit_test(self(), 'receive'). -pending_exit_exit(doc) -> []; -pending_exit_exit(suite) -> []; pending_exit_exit(Config) when is_list(Config) -> - ?line pending_exit_test(self(), exit). + pending_exit_test(self(), exit). -pending_exit_gc(doc) -> []; -pending_exit_gc(suite) -> []; pending_exit_gc(Config) when is_list(Config) -> - ?line pending_exit_test(self(), gc). + pending_exit_test(self(), gc). pending_exit_test(From, Type) -> - ?line case catch erlang:system_info(smp_support) of - true -> - ?line OTE = process_flag(trap_exit, true), - ?line Ref = make_ref(), - ?line Master = self(), - ?line ExitBySignal = case Type of - gc -> - lists:duplicate(10000, - exit_by_signal); - _ -> - exit_by_signal - end, - ?line Pid = spawn_link( - fun () -> - receive go -> ok end, - false = have_pending_exit(), - exit = fake_exit(From, - self(), - ExitBySignal), - true = have_pending_exit(), - Master ! {self(), Ref, Type}, - case Type of - gc -> - force_gc(), - erlang:yield(); - unlink -> - unlink(From); - trap_exit -> - process_flag(trap_exit, true); - 'receive' -> - receive _ -> ok - after 0 -> ok - end; - exit -> - ok - end, - exit(exit_by_myself) - end), - ?line Mon = erlang:monitor(process, Pid), - ?line Pid ! go, - ?line Reason = receive - {'DOWN', Mon, process, Pid, R} -> - ?line receive - {Pid, Ref, Type} -> - ?line ok - after 0 -> - ?line ?t:fail(premature_exit) - end, - ?line case Type of - exit -> - ?line exit_by_myself = R; - _ -> - ?line ExitBySignal = R - end - end, - ?line receive - {'EXIT', Pid, R2} -> - ?line Reason = R2 - end, - ?line process_flag(trap_exit, OTE), - ?line ok, - {comment, - "Test only valid with current SMP emulator."}; - _ -> - {skipped, - "SMP support not enabled. " - "Test only valid with current SMP emulator."} - end. + case catch erlang:system_info(smp_support) of + true -> + OTE = process_flag(trap_exit, true), + Ref = make_ref(), + Master = self(), + ExitBySignal = case Type of + gc -> + lists:duplicate(10000, + exit_by_signal); + _ -> + exit_by_signal + end, + Pid = spawn_link( + fun () -> + receive go -> ok end, + false = have_pending_exit(), + exit = fake_exit(From, + self(), + ExitBySignal), + true = have_pending_exit(), + Master ! {self(), Ref, Type}, + case Type of + gc -> + force_gc(), + erlang:yield(); + unlink -> + unlink(From); + trap_exit -> + process_flag(trap_exit, true); + 'receive' -> + receive _ -> ok + after 0 -> ok + end; + exit -> + ok + end, + exit(exit_by_myself) + end), + Mon = erlang:monitor(process, Pid), + Pid ! go, + Reason = receive + {'DOWN', Mon, process, Pid, R} -> + receive + {Pid, Ref, Type} -> + ok + after 0 -> + ct:fail(premature_exit) + end, + case Type of + exit -> + exit_by_myself = R; + _ -> + ExitBySignal = R + end + end, + receive + {'EXIT', Pid, R2} -> + Reason = R2 + end, + process_flag(trap_exit, OTE), + ok, + {comment, "Test only valid with current SMP emulator."}; + _ -> + {skipped, "SMP support not enabled. Test only valid with current SMP emulator."} + end. -exit_before_pending_exit(doc) -> []; -exit_before_pending_exit(suite) -> []; exit_before_pending_exit(Config) when is_list(Config) -> %% This is a testcase testcase very specific to the smp %% implementation as it is of the time of writing. %% %% The testcase tries to check that a process can %% exit by itself even though it has a pending exit. - ?line OTE = process_flag(trap_exit, true), - ?line Master = self(), - ?line Tester = spawn_link( - fun () -> - Opts = case {erlang:system_info(run_queues), - erlang:system_info(schedulers_online)} of - {RQ, SO} when RQ =:= 1; SO =:= 1 -> []; - _ -> - process_flag(scheduler, 1), - [{scheduler, 2}] - end, - P = self(), - Exiter = spawn_opt(fun () -> - receive - {exit_me, P, R} -> - exit(P, R) - end - end, Opts), - erlang:yield(), - Exiter ! {exit_me, self(), exited_by_exiter}, - %% We want to get a pending exit - %% before we exit ourselves. We - %% don't want to be scheduled out - %% since we will then see the - %% pending exit. - %% - %% Do something that takes - %% relatively long time but - %% consumes few reductions... - repeat(fun() -> erlang:system_info(procs) end,10), - %% ... then exit. - Master ! {self(), - pending_exit, - have_pending_exit()}, - exit(exited_by_myself) - end), - ?line PendingExit = receive {Tester, pending_exit, PE} -> PE end, - ?line receive + OTE = process_flag(trap_exit, true), + Master = self(), + Tester = spawn_link( + fun () -> + Opts = case {erlang:system_info(run_queues), + erlang:system_info(schedulers_online)} of + {RQ, SO} when RQ =:= 1; SO =:= 1 -> []; + _ -> + process_flag(scheduler, 1), + [{scheduler, 2}] + end, + P = self(), + Exiter = spawn_opt(fun () -> + receive + {exit_me, P, R} -> + exit(P, R) + end + end, Opts), + erlang:yield(), + Exiter ! {exit_me, self(), exited_by_exiter}, + %% We want to get a pending exit + %% before we exit ourselves. We + %% don't want to be scheduled out + %% since we will then see the + %% pending exit. + %% + %% Do something that takes + %% relatively long time but + %% consumes few reductions... + repeat(fun() -> erlang:system_info(procs) end,10), + %% ... then exit. + Master ! {self(), + pending_exit, + have_pending_exit()}, + exit(exited_by_myself) + end), + PendingExit = receive {Tester, pending_exit, PE} -> PE end, + receive {'EXIT', Tester, exited_by_myself} -> - ?line process_flag(trap_exit, OTE), - ?line ok; + process_flag(trap_exit, OTE), + ok; Msg -> - ?line ?t:fail({unexpected_message, Msg}) + ct:fail({unexpected_message, Msg}) end, NoScheds = integer_to_list(erlang:system_info(schedulers_online)), {comment, @@ -304,101 +270,101 @@ exit_before_pending_exit(Config) when is_list(Config) -> -define(PE_INFO_REPEAT, 100). pending_exit_is_process_alive(Config) when is_list(Config) -> - ?line S = exit_op_test_init(), - ?line TestFun = fun (P) -> false = is_process_alive(P) end, - ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), - ?line verify_pending_exit_success(S), - ?line comment(). + S = exit_op_test_init(), + TestFun = fun (P) -> false = is_process_alive(P) end, + repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), + verify_pending_exit_success(S), + comment(). pending_exit_process_info_1(Config) when is_list(Config) -> - ?line S = exit_op_test_init(), - ?line TestFun = fun (P) -> + S = exit_op_test_init(), + TestFun = fun (P) -> undefined = process_info(P) end, - ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), - ?line verify_pending_exit_success(S), - ?line comment(). + repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), + verify_pending_exit_success(S), + comment(). pending_exit_process_info_2(Config) when is_list(Config) -> - ?line S0 = exit_op_test_init(), - ?line repeated_exit_op_test(fun (P) -> + S0 = exit_op_test_init(), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, messages) end, ?PE_INFO_REPEAT), - ?line S1 = verify_pending_exit_success(S0), - ?line repeated_exit_op_test(fun (P) -> + S1 = verify_pending_exit_success(S0), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, status) end, ?PE_INFO_REPEAT), - ?line S2 = verify_pending_exit_success(S1), - ?line repeated_exit_op_test(fun (P) -> + S2 = verify_pending_exit_success(S1), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, links) end, ?PE_INFO_REPEAT), - ?line S3 = verify_pending_exit_success(S2), - ?line repeated_exit_op_test(fun (P) -> + S3 = verify_pending_exit_success(S2), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, [messages]) end, ?PE_INFO_REPEAT), - ?line S4 = verify_pending_exit_success(S3), - ?line repeated_exit_op_test(fun (P) -> + S4 = verify_pending_exit_success(S3), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, [status]) end, ?PE_INFO_REPEAT), - ?line S5 = verify_pending_exit_success(S4), - ?line repeated_exit_op_test(fun (P) -> + S5 = verify_pending_exit_success(S4), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, [links]) end, ?PE_INFO_REPEAT), - ?line S6 = verify_pending_exit_success(S5), - ?line repeated_exit_op_test(fun (P) -> + S6 = verify_pending_exit_success(S5), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, [status, links]) end, ?PE_INFO_REPEAT), - ?line S7 = verify_pending_exit_success(S6), - ?line repeated_exit_op_test(fun (P) -> + S7 = verify_pending_exit_success(S6), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, [messages, status]) end, ?PE_INFO_REPEAT), - ?line S8 = verify_pending_exit_success(S7), - ?line repeated_exit_op_test(fun (P) -> + S8 = verify_pending_exit_success(S7), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, [messages, links]) end, ?PE_INFO_REPEAT), - ?line S9 = verify_pending_exit_success(S8), - ?line repeated_exit_op_test( + S9 = verify_pending_exit_success(S8), + repeated_exit_op_test( fun (P) -> undefined = process_info(P, [message_queue_len, status]) end, ?PE_INFO_REPEAT), - ?line S10 = verify_pending_exit_success(S9), - ?line repeated_exit_op_test(fun (P) -> + S10 = verify_pending_exit_success(S9), + repeated_exit_op_test(fun (P) -> undefined = process_info(P, [messages, links, status]) end, ?PE_INFO_REPEAT), - ?line verify_pending_exit_success(S10), - ?line comment(). + verify_pending_exit_success(S10), + comment(). pending_exit_process_display(Config) when is_list(Config) -> - ?line S = exit_op_test_init(), - ?line TestFun = fun (P) -> + S = exit_op_test_init(), + TestFun = fun (P) -> badarg = try erlang:process_display(P, backtrace) catch error:badarg -> badarg end end, - ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), - ?line verify_pending_exit_success(S), - ?line comment(). + repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), + verify_pending_exit_success(S), + comment(). pending_exit_group_leader(Config) when is_list(Config) -> - ?line S = exit_op_test_init(), - ?line TestFun = fun (P) -> + S = exit_op_test_init(), + TestFun = fun (P) -> badarg = try group_leader(self(), P) catch error:badarg -> badarg end end, - ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), - ?line verify_pending_exit_success(S), - ?line comment(). + repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), + verify_pending_exit_success(S), + comment(). %% %% -- Internal utils -------------------------------------------------------- @@ -517,14 +483,14 @@ repeat(Fun, N) when is_integer(N) -> start_node(Config) -> Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" ++ atom_to_list(?config(testcase, Config)) + ++ "-" ++ atom_to_list(proplists:get_value(testcase, Config)) ++ "-" ++ 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}]). + test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). have_pending_exit() -> have_pending_exit(self()). @@ -540,15 +506,15 @@ fake_exit(From, To, Reason) -> available_internal_state(Bool) when Bool == true; Bool == false -> case {Bool, - (catch erts_debug:get_internal_state(available_internal_state))} of - {true, true} -> - true; - {false, true} -> - erts_debug:set_internal_state(available_internal_state, false), - true; - {true, _} -> - erts_debug:set_internal_state(available_internal_state, true), - false; - {false, _} -> - false + (catch erts_debug:get_internal_state(available_internal_state))} of + {true, true} -> + true; + {false, true} -> + erts_debug:set_internal_state(available_internal_state, false), + true; + {true, _} -> + erts_debug:set_internal_state(available_internal_state, true), + false; + {false, _} -> + false end. diff --git a/erts/emulator/test/smoke_test_SUITE.erl b/erts/emulator/test/smoke_test_SUITE.erl index 5bb98e5ad9..042c7225d5 100644 --- a/erts/emulator/test/smoke_test_SUITE.erl +++ b/erts/emulator/test/smoke_test_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2012. All Rights Reserved. +%% Copyright Ericsson AB 2011-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,38 +20,21 @@ -module(smoke_test_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %-compile(export_all). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]). -export([boot_combo/1, native_atomics/1, jump_table/1]). --define(DEFAULT_TIMEOUT, ?t:minutes(2)). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> [boot_combo, native_atomics, jump_table]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - init_per_testcase(boot_combo = Case, Config) when is_list(Config) -> case erlang:system_info(build_type) of opt -> @@ -63,12 +46,9 @@ init_per_testcase(Case, Config) when is_list(Config) -> init_per_tc(Case, Config). init_per_tc(Case, Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{testcase, Case},{watchdog, Dog}|Config]. + [{testcase, Case}|Config]. end_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), ok. %%% @@ -111,13 +91,13 @@ native_atomics(Config) when is_list(Config) -> NA64Key = "64-bit native atomics", DWNAKey = "Double word native atomics", EthreadInfo = erlang:system_info(ethread_info), - ?t:format("~p~n", [EthreadInfo]), + io:format("~p~n", [EthreadInfo]), {value,{NA32Key, NA32, _}} = lists:keysearch(NA32Key, 1, EthreadInfo), {value,{NA64Key, NA64, _}} = lists:keysearch(NA64Key, 1, EthreadInfo), {value,{DWNAKey, DWNA, _}} = lists:keysearch(DWNAKey, 1, EthreadInfo), case {erlang:system_info(build_type), erlang:system_info(smp_support), NA32, NA64, DWNA} of {opt, true, "no", "no", _} -> - ?t:fail(optimized_smp_runtime_without_native_atomics); + ct:fail(optimized_smp_runtime_without_native_atomics); {_, false, "no", "no", _} -> {comment, "No native atomics"}; _ -> @@ -134,7 +114,7 @@ jump_table(Config) when is_list(Config) -> false -> case erlang:system_info(build_type) of opt -> - ?t:fail(optimized_without_beam_jump_table); + ct:fail(optimized_without_beam_jump_table); BT -> {comment, "No beam jump table, but build type is " ++ atom_to_list(BT)} end @@ -149,7 +129,7 @@ chk_boot(Config, Args, Fun) -> true = os:putenv("ERL_ZFLAGS", Args), Success = make_ref(), Parent = self(), - ?t:format("--- Testing ~s~n", [Args]), + io:format("--- Testing ~s~n", [Args]), {ok, Node} = start_node(Config), Pid = spawn_link(Node, fun () -> Fun(), @@ -159,7 +139,7 @@ chk_boot(Config, Args, Fun) -> {Pid, Success} -> Node = node(Pid), stop_node(Node), - ?t:format("--- Success!~n", []), + io:format("--- Success!~n", []), ok end. @@ -170,14 +150,14 @@ start_node(Config, Args) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" - ++ atom_to_list(?config(testcase, Config)) + ++ atom_to_list(proplists:get_value(testcase, Config)) ++ "-" ++ integer_to_list(erlang:system_time(seconds)) ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), Opts = [{args, "-pa "++Pa++" "++Args}], - ?t:start_node(Name, slave, Opts). + test_server:start_node(Name, slave, Opts). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index a6305d453c..71ef003b25 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,40 +22,31 @@ %% Tests the statistics/1 bif. --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([all/0, suite/0, groups/0, wall_clock_zero_diff/1, wall_clock_update/1, runtime_zero_diff/1, runtime_update/1, runtime_diff/1, run_queue_one/1, scheduler_wall_time/1, reductions/1, reductions_big/1, garbage_collection/1, io/1, - badarg/1, run_queues_lengths_active_tasks/1]). + badarg/1, run_queues_lengths_active_tasks/1, msacc/1]). %% Internal exports. -export([hog/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -init_per_testcase(_, Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(300)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_, Config) -> - Dog = ?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. all() -> [{group, wall_clock}, {group, runtime}, reductions, reductions_big, {group, run_queue}, scheduler_wall_time, garbage_collection, io, badarg, - run_queues_lengths_active_tasks]. + run_queues_lengths_active_tasks, + msacc]. groups() -> [{wall_clock, [], @@ -64,61 +55,42 @@ groups() -> [runtime_zero_diff, runtime_update, runtime_diff]}, {run_queue, [], [run_queue_one]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - - %%% Testing statistics(wall_clock). - - -wall_clock_zero_diff(doc) -> - "Tests that the 'Wall clock since last call' element of the result " - "is zero when statistics(runtime) is called twice in succession."; +%% Tests that the 'Wall clock since last call' element of the result +%% is zero when statistics(runtime) is called twice in succession. wall_clock_zero_diff(Config) when is_list(Config) -> wall_clock_zero_diff1(16). wall_clock_zero_diff1(N) when N > 0 -> - ?line {Time, _} = statistics(wall_clock), - ?line case statistics(wall_clock) of - {Time, 0} -> ok; - _ -> wall_clock_zero_diff1(N-1) + {Time, _} = statistics(wall_clock), + case statistics(wall_clock) of + {Time, 0} -> ok; + _ -> wall_clock_zero_diff1(N-1) end; wall_clock_zero_diff1(0) -> - ?line test_server:fail("Difference never zero."). + ct:fail("Difference never zero."). -wall_clock_update(doc) -> - "Test that the time differences returned by two calls to " - "statistics(wall_clock) are compatible, and are within a small number " - "of ms of the amount of real time we waited for."; +%% Test that the time differences returned by two calls to +%% statistics(wall_clock) are compatible, and are within a small number +%% of ms of the amount of real time we waited for. wall_clock_update(Config) when is_list(Config) -> wall_clock_update1(6). wall_clock_update1(N) when N > 0 -> - ?line {T1_wc_time, _} = statistics(wall_clock), - ?line receive after 1000 -> ok end, - ?line {T2_wc_time, Wc_Diff} = statistics(wall_clock), - - ?line Wc_Diff = T2_wc_time - T1_wc_time, - ?line test_server:format("Wall clock diff = ~p; should be = 1000..1040~n", - [Wc_Diff]), - case ?t:is_debug() of - false -> - ?line true = Wc_Diff =< 1040; - true -> - ?line true = Wc_Diff =< 2000 %Be more tolerant in debug-compiled emulator. + {T1_wc_time, _} = statistics(wall_clock), + receive after 1000 -> ok end, + {T2_wc_time, Wc_Diff} = statistics(wall_clock), + + Wc_Diff = T2_wc_time - T1_wc_time, + io:format("Wall clock diff = ~p; should be = 1000..1040~n", [Wc_Diff]), + case test_server:is_debug() of + false -> + true = Wc_Diff =< 1040; + true -> + true = Wc_Diff =< 2000 %Be more tolerant in debug-compiled emulator. end, - ?line true = Wc_Diff >= 1000, + true = Wc_Diff >= 1000, wall_clock_update1(N-1); wall_clock_update1(0) -> ok. @@ -127,64 +99,60 @@ wall_clock_update1(0) -> %%% Test statistics(runtime). -runtime_zero_diff(doc) -> - "Tests that the difference between the times returned from two consectuitive " - "calls to statistics(runtime) is zero."; +%% Tests that the difference between the times returned from two consectuitive +%% calls to statistics(runtime) is zero. runtime_zero_diff(Config) when is_list(Config) -> - ?line runtime_zero_diff1(16). + runtime_zero_diff1(16). runtime_zero_diff1(N) when N > 0 -> - ?line {T1, _} = statistics(runtime), - ?line case statistics(runtime) of - {T1, 0} -> ok; - _ -> runtime_zero_diff1(N-1) - end; + {T1, _} = statistics(runtime), + case statistics(runtime) of + {T1, 0} -> ok; + _ -> runtime_zero_diff1(N-1) + end; runtime_zero_diff1(0) -> - ?line test_server:fail("statistics(runtime) never returned zero difference"). + ct:fail("statistics(runtime) never returned zero difference"). -runtime_update(doc) -> - "Test that the statistics(runtime) returns a substanstially " - "updated difference after running a process that takes all CPU " - " power of the Erlang process for a second."; +%% Test that the statistics(runtime) returns a substanstially +%% updated difference after running a process that takes all CPU +%% power of the Erlang process for a second. runtime_update(Config) when is_list(Config) -> - case ?t:is_cover() of - false -> - ?line process_flag(priority, high), - do_runtime_update(10); - true -> - {skip,"Cover-compiled"} + case test_server:is_cover() of + false -> + process_flag(priority, high), + do_runtime_update(10); + true -> + {skip,"Cover-compiled"} end. do_runtime_update(0) -> {comment,"Never close enough"}; do_runtime_update(N) -> - ?line {T1,Diff0} = statistics(runtime), - ?line spawn_link(fun cpu_heavy/0), + {T1,Diff0} = statistics(runtime), + spawn_link(fun cpu_heavy/0), receive after 1000 -> ok end, - ?line {T2,Diff} = statistics(runtime), - ?line true = is_integer(T1+T2+Diff0+Diff), - ?line test_server:format("T1 = ~p, T2 = ~p, Diff = ~p, T2-T1 = ~p", - [T1,T2,Diff,T2-T1]), - ?line if - T2 - T1 =:= Diff, 900 =< Diff, Diff =< 1500 -> ok; - true -> do_runtime_update(N-1) - end. - + {T2,Diff} = statistics(runtime), + true = is_integer(T1+T2+Diff0+Diff), + io:format("T1 = ~p, T2 = ~p, Diff = ~p, T2-T1 = ~p", [T1,T2,Diff,T2-T1]), + if + T2 - T1 =:= Diff, 900 =< Diff, Diff =< 1500 -> ok; + true -> do_runtime_update(N-1) + end. + cpu_heavy() -> cpu_heavy(). -runtime_diff(doc) -> - "Test that the difference between two consecutive absolute runtimes is " - "equal to the last relative runtime. The loop runs a lot of times since " - "the bug which this test case tests for showed up only rarely."; +%% Test that the difference between two consecutive absolute runtimes is +%% equal to the last relative runtime. The loop runs a lot of times since +%% the bug which this test case tests for showed up only rarely. runtime_diff(Config) when is_list(Config) -> runtime_diff1(1000). runtime_diff1(N) when N > 0 -> - ?line {T1_wc_time, _} = statistics(runtime), - ?line do_much(), - ?line {T2_wc_time, Wc_Diff} = statistics(runtime), - ?line Wc_Diff = T2_wc_time - T1_wc_time, + {T1_wc_time, _} = statistics(runtime), + do_much(), + {T2_wc_time, Wc_Diff} = statistics(runtime), + Wc_Diff = T2_wc_time - T1_wc_time, runtime_diff1(N-1); runtime_diff1(0) -> ok. @@ -202,10 +170,9 @@ do_much(N) -> do_much(N-1). -reductions(doc) -> - "Test that statistics(reductions) is callable, and that " - "Total_Reductions and Reductions_Since_Last_Call make sense. " - "(This to fail on pre-R3A version of JAM."; +%% Test that statistics(reductions) is callable, and that +%% Total_Reductions and Reductions_Since_Last_Call make sense. +%% This to fail on pre-R3A version of JAM. reductions(Config) when is_list(Config) -> {Reductions, _} = statistics(reductions), @@ -218,13 +185,13 @@ reductions(Config) when is_list(Config) -> reductions(300, Reductions, Mask). reductions(N, Previous, Mask) when N > 0 -> - ?line {Reductions, Diff} = statistics(reductions), - ?line build_some_garbage(), - ?line if Reductions > 0 -> ok end, - ?line if Diff >= 0 -> ok end, + {Reductions, Diff} = statistics(reductions), + build_some_garbage(), + if Reductions > 0 -> ok end, + if Diff >= 0 -> ok end, io:format("Previous = ~p, Reductions = ~p, Diff = ~p, DiffShouldBe = ~p", - [Previous, Reductions, Diff, (Reductions-Previous) band Mask]), - ?line if Reductions == ((Previous+Diff) band Mask) -> reductions(N-1, Reductions, Mask) end; + [Previous, Reductions, Diff, (Reductions-Previous) band Mask]), + if Reductions == ((Previous+Diff) band Mask) -> reductions(N-1, Reductions, Mask) end; reductions(0, _, _) -> ok. @@ -233,126 +200,123 @@ build_some_garbage() -> %% a garbage collection in the scheduler. processes(). -reductions_big(doc) -> - "Test that the number of reductions can be returned as a big number."; +%% Test that the number of reductions can be returned as a big number. reductions_big(Config) when is_list(Config) -> - ?line reductions_big_loop(), + reductions_big_loop(), ok. reductions_big_loop() -> erlang:yield(), case statistics(reductions) of - {Red, Diff} when Red >= 16#7ffFFFF -> - ok = io:format("Reductions = ~w, Diff = ~w", [Red, Diff]); - _ -> - reductions_big_loop() + {Red, Diff} when Red >= 16#7ffFFFF -> + ok = io:format("Reductions = ~w, Diff = ~w", [Red, Diff]); + _ -> + reductions_big_loop() end. %%% Tests of statistics(run_queue). -run_queue_one(doc) -> - "Tests that statistics(run_queue) returns 1 if we start a " - "CPU-bound process."; +%% Tests that statistics(run_queue) returns 1 if we start a +%% CPU-bound process. run_queue_one(Config) when is_list(Config) -> - ?line MS = erlang:system_flag(multi_scheduling, block), - ?line run_queue_one_test(Config), - ?line erlang:system_flag(multi_scheduling, unblock), + MS = erlang:system_flag(multi_scheduling, block), + run_queue_one_test(Config), + erlang:system_flag(multi_scheduling, unblock), case MS of - blocked -> - {comment, - "Multi-scheduling blocked during test. This test-case " - "was not written to work with multiple schedulers."}; - _ -> ok + blocked -> + {comment, + "Multi-scheduling blocked during test. This test-case " + "was not written to work with multiple schedulers."}; + _ -> ok end. - + run_queue_one_test(Config) when is_list(Config) -> - ?line _Hog = spawn_link(?MODULE, hog, [self()]), - ?line receive - hog_started -> ok - end, - ?line receive after 100 -> ok end, % Give hog a head start. - ?line case statistics(run_queue) of - N when N >= 1 -> ok; - Other -> ?line ?t:fail({unexpected,Other}) - end, + _Hog = spawn_link(?MODULE, hog, [self()]), + receive + hog_started -> ok + end, + receive after 100 -> ok end, % Give hog a head start. + case statistics(run_queue) of + N when N >= 1 -> ok; + Other -> ct:fail({unexpected,Other}) + end, ok. %% CPU-bound process, going at low priority. It will always be ready %% to run. hog(Pid) -> - ?line process_flag(priority, low), - ?line Pid ! hog_started, - ?line Mon = erlang:monitor(process, Pid), - ?line hog_iter(0, Mon). + process_flag(priority, low), + Pid ! hog_started, + Mon = erlang:monitor(process, Pid), + hog_iter(0, Mon). hog_iter(N, Mon) when N > 0 -> receive - {'DOWN', Mon, _, _, _} -> ok + {'DOWN', Mon, _, _, _} -> ok after 0 -> - ?line hog_iter(N-1, Mon) + hog_iter(N-1, Mon) end; hog_iter(0, Mon) -> - ?line hog_iter(10000, Mon). + hog_iter(10000, Mon). %%% Tests of statistics(scheduler_wall_time). -scheduler_wall_time(doc) -> - "Tests that statistics(scheduler_wall_time) works as intended"; +%% Tests that statistics(scheduler_wall_time) works as intended scheduler_wall_time(Config) when is_list(Config) -> %% Should return undefined if system_flag is not turned on yet undefined = statistics(scheduler_wall_time), %% Turn on statistics false = erlang:system_flag(scheduler_wall_time, true), try - Schedulers = erlang:system_info(schedulers_online), - %% Let testserver and everyone else finish their work - timer:sleep(1500), - %% Empty load - EmptyLoad = get_load(), - {false, _} = {lists:any(fun(Load) -> Load > 50 end, EmptyLoad),EmptyLoad}, - MeMySelfAndI = self(), - StartHog = fun() -> - Pid = spawn(?MODULE, hog, [self()]), - receive hog_started -> MeMySelfAndI ! go end, - Pid - end, - P1 = StartHog(), - %% Max on one, the other schedulers empty (hopefully) - %% Be generous the process can jump between schedulers - %% which is ok and we don't want the test to fail for wrong reasons - _L1 = [S1Load|EmptyScheds1] = get_load(), - {true,_} = {S1Load > 50,S1Load}, - {false,_} = {lists:any(fun(Load) -> Load > 50 end, EmptyScheds1),EmptyScheds1}, - {true,_} = {lists:sum(EmptyScheds1) < 60,EmptyScheds1}, - - %% 50% load - HalfHogs = [StartHog() || _ <- lists:seq(1, (Schedulers-1) div 2)], - HalfLoad = lists:sum(get_load()) div Schedulers, - if Schedulers < 2, HalfLoad > 80 -> ok; %% Ok only one scheduler online and one hog - %% We want roughly 50% load - HalfLoad > 40, HalfLoad < 60 -> ok; - true -> exit({halfload, HalfLoad}) - end, - - %% 100% load - LastHogs = [StartHog() || _ <- lists:seq(1, Schedulers div 2)], - FullScheds = get_load(), - {false,_} = {lists:any(fun(Load) -> Load < 80 end, FullScheds),FullScheds}, - FullLoad = lists:sum(FullScheds) div Schedulers, - if FullLoad > 90 -> ok; - true -> exit({fullload, FullLoad}) - end, - - [exit(Pid, kill) || Pid <- [P1|HalfHogs++LastHogs]], - AfterLoad = get_load(), - {false,_} = {lists:any(fun(Load) -> Load > 25 end, AfterLoad),AfterLoad}, - true = erlang:system_flag(scheduler_wall_time, false) + Schedulers = erlang:system_info(schedulers_online), + %% Let testserver and everyone else finish their work + timer:sleep(1500), + %% Empty load + EmptyLoad = get_load(), + {false, _} = {lists:any(fun(Load) -> Load > 50 end, EmptyLoad),EmptyLoad}, + MeMySelfAndI = self(), + StartHog = fun() -> + Pid = spawn(?MODULE, hog, [self()]), + receive hog_started -> MeMySelfAndI ! go end, + Pid + end, + P1 = StartHog(), + %% Max on one, the other schedulers empty (hopefully) + %% Be generous the process can jump between schedulers + %% which is ok and we don't want the test to fail for wrong reasons + _L1 = [S1Load|EmptyScheds1] = get_load(), + {true,_} = {S1Load > 50,S1Load}, + {false,_} = {lists:any(fun(Load) -> Load > 50 end, EmptyScheds1),EmptyScheds1}, + {true,_} = {lists:sum(EmptyScheds1) < 60,EmptyScheds1}, + + %% 50% load + HalfHogs = [StartHog() || _ <- lists:seq(1, (Schedulers-1) div 2)], + HalfLoad = lists:sum(get_load()) div Schedulers, + if Schedulers < 2, HalfLoad > 80 -> ok; %% Ok only one scheduler online and one hog + %% We want roughly 50% load + HalfLoad > 40, HalfLoad < 60 -> ok; + true -> exit({halfload, HalfLoad}) + end, + + %% 100% load + LastHogs = [StartHog() || _ <- lists:seq(1, Schedulers div 2)], + FullScheds = get_load(), + {false,_} = {lists:any(fun(Load) -> Load < 80 end, FullScheds),FullScheds}, + FullLoad = lists:sum(FullScheds) div Schedulers, + if FullLoad > 90 -> ok; + true -> exit({fullload, FullLoad}) + end, + + [exit(Pid, kill) || Pid <- [P1|HalfHogs++LastHogs]], + AfterLoad = get_load(), + {false,_} = {lists:any(fun(Load) -> Load > 25 end, AfterLoad),AfterLoad}, + true = erlang:system_flag(scheduler_wall_time, false) after - erlang:system_flag(scheduler_wall_time, false) + erlang:system_flag(scheduler_wall_time, false) end. get_load() -> @@ -366,62 +330,59 @@ load_percentage([{Id, WN, TN}|Ss], [{Id, WP, TP}|Ps]) -> load_percentage([], []) -> []. -garbage_collection(doc) -> - "Tests that statistics(garbage_collection) is callable. " - "It is not clear how to test anything more."; +%% Tests that statistics(garbage_collection) is callable. +%% It is not clear how to test anything more. garbage_collection(Config) when is_list(Config) -> - ?line Bin = list_to_binary(lists:duplicate(19999, 42)), - ?line case statistics(garbage_collection) of - {Gcs0,R,0} when is_integer(Gcs0), is_integer(R) -> - ?line io:format("Reclaimed: ~p", [R]), - ?line Gcs = garbage_collection_1(Gcs0, Bin), - ?line io:format("Reclaimed: ~p", - [element(2, statistics(garbage_collection))]), - {comment,integer_to_list(Gcs-Gcs0)++" GCs"} - end. + Bin = list_to_binary(lists:duplicate(19999, 42)), + case statistics(garbage_collection) of + {Gcs0,R,0} when is_integer(Gcs0), is_integer(R) -> + io:format("Reclaimed: ~p", [R]), + Gcs = garbage_collection_1(Gcs0, Bin), + io:format("Reclaimed: ~p", + [element(2, statistics(garbage_collection))]), + {comment,integer_to_list(Gcs-Gcs0)++" GCs"} + end. garbage_collection_1(Gcs0, Bin) -> case statistics(garbage_collection) of - {Gcs,Reclaimed,0} when Gcs >= Gcs0 -> - if - Reclaimed > 16#7ffffff -> - Gcs; - true -> - _ = binary_to_list(Bin), - erlang:garbage_collect(), - garbage_collection_1(Gcs, Bin) - end + {Gcs,Reclaimed,0} when Gcs >= Gcs0 -> + if + Reclaimed > 16#7ffffff -> + Gcs; + true -> + _ = binary_to_list(Bin), + erlang:garbage_collect(), + garbage_collection_1(Gcs, Bin) + end end. -io(doc) -> - "Tests that statistics(io) is callable. " - "This could be improved to test something more."; +%% Tests that statistics(io) is callable. +%% This could be improved to test something more. io(Config) when is_list(Config) -> - ?line case statistics(io) of - {{input,In},{output,Out}} when is_integer(In), is_integer(Out) -> ok - end. + case statistics(io) of + {{input,In},{output,Out}} when is_integer(In), is_integer(Out) -> ok + end. -badarg(doc) -> - "Tests that some illegal arguments to statistics fails."; +%% Tests that some illegal arguments to statistics fails. badarg(Config) when is_list(Config) -> - ?line case catch statistics(1) of - {'EXIT', {badarg, _}} -> ok - end, - ?line case catch statistics(bad_atom) of - {'EXIT', {badarg, _}} -> ok - end. + case catch statistics(1) of + {'EXIT', {badarg, _}} -> ok + end, + case catch statistics(bad_atom) of + {'EXIT', {badarg, _}} -> ok + end. tok_loop() -> tok_loop(). run_queues_lengths_active_tasks(Config) -> TokLoops = lists:map(fun (_) -> - spawn_opt(fun () -> - tok_loop() - end, - [link, {priority, low}]) - end, - lists:seq(1,10)), + spawn_opt(fun () -> + tok_loop() + end, + [link, {priority, low}]) + end, + lists:seq(1,10)), TRQLs0 = statistics(total_run_queue_lengths), TATs0 = statistics(total_active_tasks), @@ -464,9 +425,119 @@ run_queues_lengths_active_tasks(Config) -> erlang:system_flag(schedulers_online, SO), lists:foreach(fun (P) -> - unlink(P), - exit(P, bang) - end, - TokLoops), + unlink(P), + exit(P, bang) + end, + TokLoops), ok. + +%% Tests that statistics(microstate_statistics) works. +msacc(Config) -> + + %% Test if crypto nif is available + Niff = try crypto:strong_rand_bytes(1), ok catch _:_ -> nok end, + TmpFile = filename:join(proplists:get_value(priv_dir,Config),"file.tmp"), + + false = erlang:system_flag(microstate_accounting, true), + + msacc_test(TmpFile), + + true = erlang:system_flag(microstate_accounting, false), + + MsaccStats = erlang:statistics(microstate_accounting), + + case os:type() of + {win32, _} -> + %% Some windows have a very poor accuracy on their + %% timing primitives, so we just make sure that + %% some state besides sleep has been triggered. + Sum = lists:sum( + lists:map(fun({sleep, _V}) -> 0; + ({_, V}) -> V + end, maps:to_list(msacc_sum_states())) + ), + if Sum > 0 -> + ok; + true -> + ct:fail({no_states_triggered, MsaccStats}) + end; + _ -> + + %% Make sure that all states were triggered at least once + maps:map(fun(nif, 0) -> + case Niff of + ok -> + ct:fail({zero_state,nif}); + nok -> + ok + end; + (aux, 0) -> + %% aux will be zero if we do not have smp support + %% or no async threads + case erlang:system_info(smp_support) orelse + erlang:system_info(thread_pool_size) > 0 + of + false -> + ok; + true -> + ct:log("msacc: ~p",[MsaccStats]), + ct:fail({zero_state,aux}) + end; + (Key, 0) -> + ct:log("msacc: ~p",[MsaccStats]), + ct:fail({zero_state,Key}); + (_,_) -> ok + end, msacc_sum_states()) + end, + + erlang:system_flag(microstate_accounting, reset), + + msacc_test(TmpFile), + + %% Make sure all counters are zero after stopping and resetting + maps:map(fun(_Key, 0) -> ok; + (Key,_) -> + ct:log("msacc: ~p",[erlang:statistics(microstate_accounting)]), + ct:fail({non_zero_state,Key}) + end,msacc_sum_states()). + +%% This test tries to make sure to trigger all of the different available states +msacc_test(TmpFile) -> + + %% We write some data + [file:write_file(TmpFile,<<0:(1024*1024*8)>>,[raw]) || _ <- lists:seq(1,100)], + + %% Do some ETS operations + Tid = ets:new(table, []), + ets:insert(Tid, {1, hello}), + ets:delete(Tid), + + %% Collect some garbage + [erlang:garbage_collect() || _ <- lists:seq(1,100)], + + %% Send some messages + [begin self() ! {hello},receive _ -> ok end end || _ <- lists:seq(1,100)], + + %% Setup some timers + Refs = [erlang:send_after(10000,self(),ok) || _ <- lists:seq(1,100)], + + %% Do some nif work + catch [crypto:strong_rand_bytes(128) || _ <- lists:seq(1,100)], + + %% Cancel some timers + [erlang:cancel_timer(R) || R <- Refs], + + %% Wait for a while + timer:sleep(100). + +msacc_sum_states() -> + Stats = erlang:statistics(microstate_accounting), + [#{ counters := C }|_] = Stats, + InitialCounters = maps:map(fun(_,_) -> 0 end,C), + lists:foldl(fun(#{ counters := Counters }, Cnt) -> + maps:fold(fun(Key, Value, Acc) -> + NewValue = Value+maps:get(Key,Acc), + maps:update(Key, NewValue, Acc) + end, Cnt, Counters) + end,InitialCounters,Stats). diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index bee42c07d9..f31d474c20 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -31,55 +31,25 @@ %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -%-compile(export_all). --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([all/0, suite/0]). --export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1, memory/1, - ets_limit/1]). +-export([process_count/1, system_version/1, misc_smoke_tests/1, + heap_size/1, wordsize/1, memory/1, ets_limit/1]). --define(DEFAULT_TIMEOUT, ?t:minutes(2)). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> [process_count, system_version, misc_smoke_tests, heap_size, wordsize, memory, ets_limit]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - %%% %%% The test cases ------------------------------------------------------------- %%% -process_count(doc) -> []; -process_count(suite) -> []; process_count(Config) when is_list(Config) -> case catch erlang:system_info(modified_timing_level) of Level when is_integer(Level) -> @@ -92,37 +62,37 @@ process_count(Config) when is_list(Config) -> end. process_count_test() -> - ?line OldPrio = process_flag(priority, max), - ?line check_procs(10), - ?line check_procs(11234), - ?line check_procs(57), - ?line check_procs(1030), - ?line check_procs(687), - ?line check_procs(7923), - ?line check_procs(5302), - ?line check_procs(12456), - ?line check_procs(14), - ?line check_procs(1125), - ?line check_procs(236), - ?line check_procs(125), - ?line check_procs(2346), - ?line process_flag(priority, OldPrio), - ?line ok. + OldPrio = process_flag(priority, max), + check_procs(10), + check_procs(11234), + check_procs(57), + check_procs(1030), + check_procs(687), + check_procs(7923), + check_procs(5302), + check_procs(12456), + check_procs(14), + check_procs(1125), + check_procs(236), + check_procs(125), + check_procs(2346), + process_flag(priority, OldPrio), + ok. check_procs(N) -> - ?line CP = length(processes()), - ?line Procs = start_procs(N), - ?line check_pc(CP+N), - ?line stop_procs(Procs), - ?line check_pc(CP). + CP = length(processes()), + Procs = start_procs(N), + check_pc(CP+N), + stop_procs(Procs), + check_pc(CP). check_pc(E) -> - ?line P = length(processes()), - ?line SI = erlang:system_info(process_count), - ?line ?t:format("E=~p; P=~p; SI=~p~n", [E, P, SI]), - ?line E = P, - ?line P = SI. + P = length(processes()), + SI = erlang:system_info(process_count), + io:format("E=~p; P=~p; SI=~p~n", [E, P, SI]), + E = P, + P = SI. start_procs(N) -> lists:map(fun (_) -> @@ -143,55 +113,44 @@ stop_procs(PMs) -> end, PMs). -system_version(doc) -> []; -system_version(suite) -> []; system_version(Config) when is_list(Config) -> - ?line {comment, erlang:system_info(system_version)}. + {comment, erlang:system_info(system_version)}. -misc_smoke_tests(doc) -> []; -misc_smoke_tests(suite) -> []; misc_smoke_tests(Config) when is_list(Config) -> - ?line true = is_binary(erlang:system_info(info)), - ?line true = is_binary(erlang:system_info(procs)), - ?line true = is_binary(erlang:system_info(loaded)), - ?line true = is_binary(erlang:system_info(dist)), - ?line ok = try erlang:system_info({cpu_topology,erts_get_cpu_topology_error_case}), fail catch error:badarg -> ok end, + true = is_binary(erlang:system_info(info)), + true = is_binary(erlang:system_info(procs)), + true = is_binary(erlang:system_info(loaded)), + true = is_binary(erlang:system_info(dist)), + ok = try erlang:system_info({cpu_topology,erts_get_cpu_topology_error_case}), fail catch error:badarg -> ok end, true = lists:member(erlang:system_info(tolerant_timeofday), [enabled, disabled]), - ?line ok. + ok. -heap_size(doc) -> []; -heap_size(suite) -> []; heap_size(Config) when is_list(Config) -> - ?line {min_bin_vheap_size, VHmin} = erlang:system_info(min_bin_vheap_size), - ?line {min_heap_size, Hmin} = erlang:system_info(min_heap_size), - ?line GCinf = erlang:system_info(garbage_collection), - ?line VHmin = proplists:get_value(min_bin_vheap_size, GCinf), - ?line Hmin = proplists:get_value(min_heap_size, GCinf), + {min_bin_vheap_size, VHmin} = erlang:system_info(min_bin_vheap_size), + {min_heap_size, Hmin} = erlang:system_info(min_heap_size), + GCinf = erlang:system_info(garbage_collection), + VHmin = proplists:get_value(min_bin_vheap_size, GCinf), + Hmin = proplists:get_value(min_heap_size, GCinf), ok. -wordsize(suite) -> - []; -wordsize(doc) -> - ["Tests the various wordsize variants"]; +%% Tests the various wordsize variants wordsize(Config) when is_list(Config) -> - ?line A = erlang:system_info(wordsize), - ?line true = is_integer(A), - ?line A = erlang:system_info({wordsize,internal}), - ?line B = erlang:system_info({wordsize,external}), - ?line true = A =< B, + A = erlang:system_info(wordsize), + true = is_integer(A), + A = erlang:system_info({wordsize,internal}), + B = erlang:system_info({wordsize,external}), + true = A =< B, case {B,A} of {4,4} -> {comment, "True 32-bit emulator"}; {8,8} -> {comment, "True 64-bit emulator"}; - {8,4} -> - {comment, "Halfword 64-bit emulator"}; Other -> exit({unexpected_wordsizes,Other}) end. -memory(doc) -> ["Verify that erlang:memory/0 and memory results in crashdump produce are similar"]; +%% Verify that erlang:memory/0 and memory results in crashdump produce are similar memory(Config) when is_list(Config) -> %% %% Verify that erlang:memory/0 and memory results in @@ -246,8 +205,7 @@ memory_test(_Config) -> end) end, 1000 div erlang:system_info(schedulers_online)) - end, - []), + end, []), cmp_memory(MWs, "spawn procs"), Ps = lists:flatten(DPs), @@ -255,14 +213,12 @@ memory_test(_Config) -> mem_workers_call(MWs, fun () -> lists:foreach(fun (P) -> link(P) end, Ps) - end, - []), + end, []), cmp_memory(MWs, "link procs"), mem_workers_call(MWs, fun () -> lists:foreach(fun (P) -> unlink(P) end, Ps) - end, - []), + end, []), cmp_memory(MWs, "unlink procs"), mem_workers_call(MWs, @@ -279,8 +235,7 @@ memory_test(_Config) -> true = is_reference(Tmr), put('BIF_TMRS', [Tmr|Tmrs]) end, Ps) - end, - []), + end, []), cmp_memory(MWs, "start BIF timer procs"), mem_workers_call(MWs, @@ -291,8 +246,7 @@ memory_test(_Config) -> end, get('BIF_TMRS')), put('BIF_TMRS', undefined), garbage_collect() - end, - []), + end, []), erts_debug:set_internal_state(wait, deallocations), cmp_memory(MWs, "cancel BIF timer procs"), @@ -301,8 +255,7 @@ memory_test(_Config) -> lists:map(fun (P) -> monitor(process, P) end, Ps) - end, - []), + end, []), cmp_memory(MWs, "monitor procs"), Ms = lists:flatten(DMs), mem_workers_call(MWs, @@ -310,8 +263,7 @@ memory_test(_Config) -> lists:foreach(fun (M) -> demonitor(M) end, Ms) - end, - []), + end, []), cmp_memory(MWs, "demonitor procs"), mem_workers_call(MWs, @@ -319,8 +271,7 @@ memory_test(_Config) -> lists:foreach(fun (P) -> P ! {a, "message", make_ref()} end, Ps) - end, - []), + end, []), cmp_memory(MWs, "message procs"), mem_workers_call(MWs, @@ -343,8 +294,7 @@ memory_test(_Config) -> fun () -> put(binary_data, mapn(fun (_) -> list_to_binary(lists:duplicate(256,$?)) end, 100)) - end, - []), + end, []), cmp_memory(MWs, "store binary data"), @@ -352,8 +302,7 @@ memory_test(_Config) -> fun () -> put(binary_data, false), garbage_collect() - end, - []), + end, []), cmp_memory(MWs, "release binary data"), mem_workers_call(MWs, @@ -361,8 +310,7 @@ memory_test(_Config) -> list_to_atom("an ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), list_to_atom("another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))), list_to_atom("yet another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))) - end, - []), + end, []), cmp_memory(MWs, "new atoms"), @@ -373,16 +321,14 @@ memory_test(_Config) -> ets:insert(T, {banan, lists:seq(1,1024)}), ets:insert(T, {appelsin, make_ref()}), put(ets_id, T) - end, - []), + end, []), cmp_memory(MWs, "store ets data"), mem_workers_call(MWs, fun () -> ets:delete(get(ets_id)), put(ets_id, false) - end, - []), + end, []), cmp_memory(MWs, "remove ets data"), lists:foreach(fun (MW) -> @@ -392,8 +338,7 @@ memory_test(_Config) -> receive {'DOWN', Mon, _, _, _} -> ok end - end, - MWs), + end, MWs), ok. mem_worker() -> @@ -408,22 +353,19 @@ mem_worker() -> mem_workers_call(MWs, Fun, Args) -> lists:foreach(fun (MW) -> - MW ! {call, self(), Fun, Args} - end, - MWs), + MW ! {call, self(), Fun, Args} + end, MWs), lists:map(fun (MW) -> - receive - {reply, MW, Res} -> - Res - end - end, - MWs). + receive + {reply, MW, Res} -> + Res + end + end, MWs). mem_workers_cast(MWs, Fun, Args) -> lists:foreach(fun (MW) -> MW ! {cast, self(), Fun, Args} - end, - MWs). + end, MWs). spawn_mem_workers() -> spawn_mem_workers(erlang:system_info(schedulers_online)). @@ -436,7 +378,6 @@ spawn_mem_workers(N) -> link]) | spawn_mem_workers(N-1)]. - mem_get(X, Mem) -> case lists:keyfind(X, 1, Mem) of {X, Val} -> Val; @@ -504,25 +445,25 @@ cmp_memory(MWs, Str) -> "crash dump memory = ~p~n", [Str, EM, EDM]), - ?line check_sane_memory(EM), - ?line check_sane_memory(EDM), + check_sane_memory(EM), + check_sane_memory(EDM), %% We expect these to always give us exactly the same result - ?line cmp_memory(atom, EM, EDM, 1), - ?line cmp_memory(atom_used, EM, EDM, 1), - ?line cmp_memory(binary, EM, EDM, 1), - ?line cmp_memory(code, EM, EDM, 1), - ?line cmp_memory(ets, EM, EDM, 1), + cmp_memory(atom, EM, EDM, 1), + cmp_memory(atom_used, EM, EDM, 1), + cmp_memory(binary, EM, EDM, 1), + cmp_memory(code, EM, EDM, 1), + cmp_memory(ets, EM, EDM, 1), %% Total, processes, processes_used, and system will seldom %% give us exactly the same result since the two readings %% aren't taken atomically. - ?line cmp_memory(total, EM, EDM, 1.05), - ?line cmp_memory(processes, EM, EDM, 1.05), - ?line cmp_memory(processes_used, EM, EDM, 1.05), - ?line cmp_memory(system, EM, EDM, 1.05), + cmp_memory(total, EM, EDM, 1.05), + cmp_memory(processes, EM, EDM, 1.05), + cmp_memory(processes_used, EM, EDM, 1.05), + cmp_memory(system, EM, EDM, 1.05), ok. @@ -531,9 +472,7 @@ mapn(_Fun, 0) -> mapn(Fun, N) -> [Fun(N) | mapn(Fun, N-1)]. -ets_limit(doc) -> - "Verify system_info(ets_limit) reflects max ETS table settings."; -ets_limit(suite) -> []; +%% Verify system_info(ets_limit) reflects max ETS table settings. ets_limit(Config0) when is_list(Config0) -> Config = [{testcase,ets_limit}|Config0], true = is_integer(get_ets_limit(Config)), @@ -567,12 +506,12 @@ start_node(Config, Envs) when is_list(Config) -> Pa = filename:dirname(code:which(?MODULE)), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" - ++ atom_to_list(?config(testcase, Config)) + ++ atom_to_list(proplists:get_value(testcase, Config)) ++ "-" ++ integer_to_list(erlang:system_time(seconds)) ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), - ?t:start_node(Name, peer, [{args, "-pa "++Pa}, {env, Envs}]). + test_server:start_node(Name, peer, [{args, "-pa "++Pa}, {env, Envs}]). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl index 2ecb4a28a7..2e359b11ce 100644 --- a/erts/emulator/test/system_profile_SUITE.erl +++ b/erts/emulator/test/system_profile_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2012. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,61 +23,29 @@ -module(system_profile_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, system_profile_on_and_off/1, - runnable_procs/1, - runnable_ports/1, + runnable_procs/1, runnable_ports/1, dont_profile_profiler/1, - scheduler/1 - ]). - --export([init_per_testcase/2, end_per_testcase/2]). + scheduler/1, sane_location/1]). -export([profiler_process/1, ring_loop/1, port_echo_start/0, list_load/0, run_load/2]). --include_lib("test_server/include/test_server.hrl"). - --define(default_timeout, ?t:minutes(1)). +-include_lib("common_test/include/ct.hrl"). -init_per_testcase(_Case, Config) -> - Dog=?t:timetrap(?default_timeout), - [{watchdog, Dog}|Config]. -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [system_profile_on_and_off, runnable_procs, - runnable_ports, scheduler, dont_profile_profiler]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - + runnable_ports, scheduler, dont_profile_profiler, + sane_location]. %% No specification clause needed for an init function in a conf case!!! %% Test switching system_profiling on and off. -system_profile_on_and_off(suite) -> - []; -system_profile_on_and_off(doc) -> - ["Tests switching system_profiling on and off."]; system_profile_on_and_off(Config) when is_list(Config) -> Pid = start_profiler_process(), @@ -106,12 +74,7 @@ system_profile_on_and_off(Config) when is_list(Config) -> exit(Pid,kill), ok. -%% Test runnable_procs - -runnable_procs(suite) -> - []; -runnable_procs(doc) -> - ["Tests system_profiling with runnable_procs."]; +%% Tests system_profiling with runnable_procs. runnable_procs(Config) when is_list(Config) -> lists:foreach(fun (TsType) -> Arg = case TsType of @@ -148,10 +111,7 @@ do_runnable_procs({TsType, TsTypeFlag}) -> exit(Pid,kill), ok. -runnable_ports(suite) -> - []; -runnable_ports(doc) -> - ["Tests system_profiling with runnable_port."]; +%% Tests system_profiling with runnable_port. runnable_ports(Config) when is_list(Config) -> lists:foreach(fun (TsType) -> Arg = case TsType of @@ -184,10 +144,7 @@ do_runnable_ports({TsType, TsTypeFlag}, Config) -> exit(Pid,kill), ok. -scheduler(suite) -> - []; -scheduler(doc) -> - ["Tests system_profiling with scheduler."]; +%% Tests system_profiling with scheduler. scheduler(Config) when is_list(Config) -> case {erlang:system_info(smp_support), erlang:system_info(schedulers_online)} of {false,_} -> {skipped, "No need for scheduler test when smp support is disabled."}; @@ -209,11 +166,7 @@ scheduler(Config) when is_list(Config) -> strict_monotonic_timestamp]) end. -% the profiler pid should not be profiled -dont_profile_profiler(suite) -> - []; -dont_profile_profiler(doc) -> - ["Ensure system profiler process is not profiled."]; +%% Ensure system profiler process is not profiled. dont_profile_profiler(Config) when is_list(Config) -> Pid = start_profiler_process(), @@ -231,6 +184,33 @@ dont_profile_profiler(Config) when is_list(Config) -> exit(Pid,kill), ok. +%% Check sane location (of exits) +sane_location(Config) when is_list(Config) -> + Check = spawn_link(fun() -> flush_sane_location() end), + erlang:system_profile(Check, [runnable_procs]), + Me = self(), + Pids = [spawn_link(fun() -> wat(Me) end) || _ <- lists:seq(1,100)], + [receive {Pid,ok} -> ok end || Pid <- Pids], + Check ! {Me, done}, + receive {Check,ok} -> ok end, + ok. + +wat(Pid) -> + Pid ! {self(), ok}. + +flush_sane_location() -> + receive + {profile,_,_,{M,F,A},_} when is_atom(M), is_atom(F), + is_integer(A) -> + flush_sane_location(); + {profile,_,_,0,_} -> + flush_sane_location(); + {Pid,done} when is_pid(Pid) -> + Pid ! {self(), ok}; + M -> + ct:fail({badness,M}) + end. + %%% Check scheduler profiling @@ -421,7 +401,7 @@ ring_loop(RelayTo) -> %% API echo(Config) -> - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), erl_ddll:load_driver(Path, echo_drv), Pid = spawn_link(?MODULE, port_echo_start, []), Pid ! {self(), get_ports}, @@ -481,7 +461,7 @@ check_ts(no_timestamp, Ts) -> no_timestamp = Ts catch _ : _ -> - ?t:fail({unexpected_timestamp, Ts}) + ct:fail({unexpected_timestamp, Ts}) end, ok; check_ts(timestamp, Ts) -> @@ -492,7 +472,7 @@ check_ts(timestamp, Ts) -> true = is_integer(Us) catch _ : _ -> - ?t:fail({unexpected_timestamp, Ts}) + ct:fail({unexpected_timestamp, Ts}) end, ok; check_ts(monotonic_timestamp, Ts) -> @@ -500,7 +480,7 @@ check_ts(monotonic_timestamp, Ts) -> true = is_integer(Ts) catch _ : _ -> - ?t:fail({unexpected_timestamp, Ts}) + ct:fail({unexpected_timestamp, Ts}) end, ok; check_ts(strict_monotonic_timestamp, Ts) -> @@ -510,7 +490,7 @@ check_ts(strict_monotonic_timestamp, Ts) -> true = is_integer(UMI) catch _ : _ -> - ?t:fail({unexpected_timestamp, Ts}) + ct:fail({unexpected_timestamp, Ts}) end, ok. @@ -534,7 +514,7 @@ run_load(N, Pids) -> run_load(N - 1, [Pid | Pids]). list_load() -> - ok = case math:sin(random:uniform(32451)) of + ok = case math:sin(rand:uniform(32451)) of A when is_float(A) -> ok; _ -> ok end, diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl index 787870588d..76d440529f 100644 --- a/erts/emulator/test/time_SUITE.erl +++ b/erts/emulator/test/time_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -48,7 +48,7 @@ -export([local_to_univ_utc/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([linear_time/1]). @@ -69,7 +69,7 @@ init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> [{testcase, Func}|Config]. -end_per_testcase(_Func, Config) -> +end_per_testcase(_Func, _Config) -> ok. suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -103,32 +103,29 @@ end_per_group(_GroupName, Config) -> Config. -local_to_univ_utc(suite) -> - []; -local_to_univ_utc(doc) -> - ["Test that DST = true on timezones without DST is ignored"]; +%% Test that DST = true on timezones without DST is ignored local_to_univ_utc(Config) when is_list(Config) -> case os:type() of {unix,_} -> %% TZ variable has a meaning - ?line {ok, Node} = + {ok, Node} = test_server:start_node(local_univ_utc,peer, [{args, "-env TZ UTC"}]), - ?line {{2008,8,1},{0,0,0}} = + {{2008,8,1},{0,0,0}} = rpc:call(Node, erlang,localtime_to_universaltime, [{{2008, 8, 1}, {0, 0, 0}}, false]), - ?line {{2008,8,1},{0,0,0}} = + {{2008,8,1},{0,0,0}} = rpc:call(Node, erlang,localtime_to_universaltime, [{{2008, 8, 1}, {0, 0, 0}}, true]), - ?line [{{2008,8,1},{0,0,0}}] = + [{{2008,8,1},{0,0,0}}] = rpc:call(Node, calendar,local_time_to_universal_time_dst, [{{2008, 8, 1}, {0, 0, 0}}]), - ?line test_server:stop_node(Node), + test_server:stop_node(Node), ok; _ -> {skip,"Only valid on Unix"} @@ -138,24 +135,24 @@ local_to_univ_utc(Config) when is_list(Config) -> %% Tests conversion from univeral to local time. univ_to_local(Config) when is_list(Config) -> - ?line test_univ_to_local(test_data()). + test_univ_to_local(test_data()). test_univ_to_local([{Utc, Local}|Rest]) -> - ?line io:format("Testing ~p => ~p~n", [Local, Utc]), - ?line Local = erlang:universaltime_to_localtime(Utc), - ?line test_univ_to_local(Rest); + io:format("Testing ~p => ~p~n", [Local, Utc]), + Local = erlang:universaltime_to_localtime(Utc), + test_univ_to_local(Rest); test_univ_to_local([]) -> ok. %% Tests conversion from local to universal time. local_to_univ(Config) when is_list(Config) -> - ?line test_local_to_univ(test_data()). + test_local_to_univ(test_data()). test_local_to_univ([{Utc, Local}|Rest]) -> - ?line io:format("Testing ~p => ~p~n", [Utc, Local]), - ?line Utc = erlang:localtime_to_universaltime(Local), - ?line test_local_to_univ(Rest); + io:format("Testing ~p => ~p~n", [Utc, Local]), + Utc = erlang:localtime_to_universaltime(Local), + test_local_to_univ(Rest); test_local_to_univ([]) -> ok. @@ -163,11 +160,11 @@ test_local_to_univ([]) -> %% generate a badarg. bad_univ_to_local(Config) when is_list(Config) -> - ?line bad_test_univ_to_local(bad_dates()). + bad_test_univ_to_local(bad_dates()). bad_test_univ_to_local([Utc|Rest]) -> - ?line io:format("Testing ~p~n", [Utc]), - ?line case catch erlang:universaltime_to_localtime(Utc) of + io:format("Testing ~p~n", [Utc]), + case catch erlang:universaltime_to_localtime(Utc) of {'EXIT', {badarg, _}} -> bad_test_univ_to_local(Rest) end; bad_test_univ_to_local([]) -> @@ -177,11 +174,11 @@ bad_test_univ_to_local([]) -> %% generate a badarg. bad_local_to_univ(Config) when is_list(Config) -> - ?line bad_test_local_to_univ(bad_dates()). + bad_test_local_to_univ(bad_dates()). bad_test_local_to_univ([Local|Rest]) -> - ?line io:format("Testing ~p~n", [Local]), - ?line case catch erlang:localtime_to_universaltime(Local) of + io:format("Testing ~p~n", [Local]), + case catch erlang:localtime_to_universaltime(Local) of {'EXIT', {badarg, _}} -> bad_test_local_to_univ(Rest) end; bad_test_local_to_univ([]) -> @@ -227,13 +224,13 @@ consistency(Config) when is_list(Config) -> %% Daylight-saving calculations are incorrect from the last %% Sunday of March and October to the end of the month. - ?line ok = compare_date_time_and_localtime(16), - ?line ok = compare_local_and_universal(16). + ok = compare_date_time_and_localtime(16), + ok = compare_local_and_universal(16). compare_date_time_and_localtime(Times) when Times > 0 -> - ?line {Year, Mon, Day} = date(), - ?line {Hour, Min, Sec} = time(), - ?line case erlang:localtime() of + {Year, Mon, Day} = date(), + {Hour, Min, Sec} = time(), + case erlang:localtime() of {{Year, Mon, Day}, {Hour, Min, Sec}} -> ok; _ -> compare_date_time_and_localtime(Times-1) end; @@ -315,10 +312,7 @@ effective_timezone1(_) -> %% Test (the bif) os:timestamp/0, which is something quite like, but not %% similar to erlang:now... -timestamp(suite) -> - []; -timestamp(doc) -> - ["Test that os:timestamp works."]; +%% Test that os:timestamp works. timestamp(Config) when is_list(Config) -> try repeating_timestamp_check(100000) @@ -334,7 +328,7 @@ timestamp(Config) when is_list(Config) -> true -> {skip, "Seems to be time warp test run..."}; false -> - test_server:fail(Failure) + ct:fail(Failure) end end. @@ -368,9 +362,7 @@ repeating_timestamp_check(N) -> C < 1000000 -> ok; true -> - test_server:fail( - lists:flatten( - io_lib:format("Strange return from os:timestamp/0 ~w~n",[TS]))) + ct:fail("Strange return from os:timestamp/0 ~w~n",[TS]) end, %% I assume the now and timestamp should not differ more than 1 hour, %% which is safe assuming the system has not had a large time-warp @@ -403,22 +395,22 @@ repeating_timestamp_check(N) -> %% times (in microseconds). now_unique(Config) when is_list(Config) -> - ?line now_unique(1000, now(), []), - ?line fast_now_unique(100000, now()). + now_unique(1000, now(), []), + fast_now_unique(100000, now()). now_unique(N, Previous, Result) when N > 0 -> - ?line case now() of + case now() of Previous -> - test_server:fail("now/0 returned the same value twice"); + ct:fail("now/0 returned the same value twice"); New -> now_unique(N-1, New, [New|Result]) end; now_unique(0, _, [Then|Rest]) -> - ?line now_calc_increment(Rest, microsecs(Then), []). + now_calc_increment(Rest, microsecs(Then), []). now_calc_increment([Then|Rest], Previous, _Result) -> - ?line This = microsecs(Then), - ?line now_calc_increment(Rest, This, [Previous-This]); + This = microsecs(Then), + now_calc_increment(Rest, This, [Previous-This]); now_calc_increment([], _, Differences) -> {comment, "Median increment: " ++ integer_to_list(median(Differences))}. @@ -426,15 +418,15 @@ fast_now_unique(0, _) -> ok; fast_now_unique(N, Then) -> case now() of Then -> - ?line ?t:fail("now/0 returned the same value twice"); + ct:fail("now/0 returned the same value twice"); Now -> fast_now_unique(N-1, Now) end. median(Unsorted_List) -> - ?line Length = length(Unsorted_List), - ?line List = lists:sort(Unsorted_List), - ?line case Length rem 2 of + Length = length(Unsorted_List), + List = lists:sort(Unsorted_List), + case Length rem 2 of 0 -> % Even length. [A, B] = lists:nthtail((Length div 2)-1, List), (A+B)/2; @@ -450,31 +442,30 @@ microsecs({Mega_Secs, Secs, Microsecs}) -> %% calls to erlang:localtime(). now_update(Config) when is_list(Config) -> - case ?t:is_debug() of - false -> ?line now_update1(10); + case test_server:is_debug() of + false -> now_update1(10); true -> {skip,"Unreliable in DEBUG build"} end. now_update1(N) when N > 0 -> - ?line T1_linear = linear_time(erlang:localtime()), - ?line T1_now = microsecs(now()), + T1_linear = linear_time(erlang:localtime()), + T1_now = microsecs(now()), - ?line receive after 1008 -> ok end, + receive after 1008 -> ok end, - ?line T2_linear = linear_time(erlang:localtime()), - ?line T2_now = microsecs(now()), + T2_linear = linear_time(erlang:localtime()), + T2_now = microsecs(now()), - ?line Linear_Diff = (T2_linear-T1_linear)*1000000, - ?line Now_Diff = T2_now-T1_now, - test_server:format("Localtime diff = ~p; now() diff = ~p", - [Linear_Diff, Now_Diff]), - ?line case abs(Linear_Diff - Now_Diff) of + Linear_Diff = (T2_linear-T1_linear)*1000000, + Now_Diff = T2_now-T1_now, + io:format("Localtime diff = ~p; now() diff = ~p", [Linear_Diff, Now_Diff]), + case abs(Linear_Diff - Now_Diff) of Abs_Delta when Abs_Delta =< 40000 -> ok; _ -> now_update1(N-1) end; now_update1(0) -> - ?line test_server:fail(). + ct:fail("now_update zero"). time_warp_modes(Config) when is_list(Config) -> %% All time warp modes always supported in @@ -551,14 +542,14 @@ check_time_warp_mode(Config, TimeCorrection, TimeWarpMode) -> io:format("Uptime inconsistency", []), case {TimeCorrection, erlang:system_info(time_correction)} of {true, true} -> - ?t:fail(uptime_inconsistency); + ct:fail(uptime_inconsistency); {true, false} -> _ = erlang:time_offset(), receive {'CHANGE', Mon, time_offset, clock_service, _} -> ignore after 1000 -> - ?t:fail(uptime_inconsistency) + ct:fail(uptime_inconsistency) end; _ -> ignore @@ -728,10 +719,10 @@ check_time_offset_res_conv(Mon, Res) -> TORes2 -> case check_time_offset_change(Mon, TO, 1000) of {TO, false} -> - ?t:fail({time_unit_conversion_inconsistency, + ct:fail({time_unit_conversion_inconsistency, TO, TORes, TORes2}); {_NewTO, true} -> - ?t:format("time_offset changed", []), + io:format("time_offset changed", []), check_time_offset_res_conv(Mon, Res) end end. @@ -776,25 +767,21 @@ chk_strc(Res0, Res1) -> 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. + io:format("rand values ~p -> ~p~n", [FR, TR]), + rand:seed(exsplus, {268438039,268440479,268439161}), + Values = lists:map(fun (_) -> rand: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 -> + ct:fail({Failure, CV, V, FR, TR}) + end + end, + lists:foreach(CheckFun, Values). chk_values_per_value(_FromRes, _ToRes, @@ -805,7 +792,7 @@ chk_values_per_value(_FromRes, _ToRes, case ((MinFromValuesPerToValue =< FromValueCount) andalso (FromValueCount =< MaxFromValuesPerToValue)) of false -> - ?t:fail({MinFromValuesPerToValue, + ct:fail({MinFromValuesPerToValue, FromValueCount, MaxFromValuesPerToValue}); true -> @@ -815,28 +802,28 @@ 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 + ToValue -> + chk_values_per_value(FromRes, ToRes, + Value+1, EndValue, + MinFromValuesPerToValue, + MaxFromValuesPerToValue, + ToValue, FromValueCount+1); + NewToValue -> + case ((MinFromValuesPerToValue =< FromValueCount) + andalso (FromValueCount =< MaxFromValuesPerToValue)) of + false -> + ct: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) -> @@ -849,11 +836,11 @@ erlang_timestamp(Config) when is_list(Config) -> check_erlang_timestamp(Done, Mon, TO) -> receive - {timeout, Done, timeout} -> - erlang:demonitor(Mon, [flush]), - ok + {timeout, Done, timeout} -> + erlang:demonitor(Mon, [flush]), + ok after 0 -> - do_check_erlang_timestamp(Done, Mon, TO) + do_check_erlang_timestamp(Done, Mon, TO) end. do_check_erlang_timestamp(Done, Mon, TO) -> @@ -878,13 +865,13 @@ do_check_erlang_timestamp(Done, Mon, TO) -> check_erlang_timestamp(Done, Mon, NewTO); false -> io:format("TsMin=~p TsTime=~p TsMax=~p~n", [TsMin, TsTime, TsMax]), - ?t:format("Detected inconsistency; " + io:format("Detected inconsistency; " "checking for time_offset change...", []), case check_time_offset_change(Mon, TO, 1000) of {TO, false} -> - ?t:fail(timestamp_inconsistency); + ct:fail(timestamp_inconsistency); {NewTO, true} -> - ?t:format("time_offset changed", []), + io:format("time_offset changed", []), check_erlang_timestamp(Done, Mon, NewTO) end end. @@ -925,13 +912,13 @@ test_data() -> _ -> {?timezone,?dst_timezone} end, - ?line test_data(nondst_dates(), TZ) ++ + test_data(nondst_dates(), TZ) ++ test_data(dst_dates(), DSTTZ) ++ crossover_test_data(crossover_dates(), TZ). %% test_data1() -> -%% ?line test_data(nondst_dates(), ?timezone) ++ +%% test_data(nondst_dates(), ?timezone) ++ %% test_data(dst_dates(), ?dst_timezone) ++ %% crossover_test_data(crossover_dates(), ?timezone). @@ -939,16 +926,16 @@ crossover_test_data([{Year, Month, Day}|Rest], TimeZone) when TimeZone > 0 -> Hour = 23, Min = 35, Sec = 55, - ?line Utc = {{Year, Month, Day}, {Hour, Min, Sec}}, - ?line Local = {{Year, Month, Day+1}, {Hour+TimeZone-24, Min, Sec}}, - ?line [{Utc, Local}|crossover_test_data(Rest, TimeZone)]; + Utc = {{Year, Month, Day}, {Hour, Min, Sec}}, + Local = {{Year, Month, Day+1}, {Hour+TimeZone-24, Min, Sec}}, + [{Utc, Local}|crossover_test_data(Rest, TimeZone)]; crossover_test_data([{Year, Month, Day}|Rest], TimeZone) when TimeZone < 0 -> Hour = 0, Min = 23, Sec = 12, - ?line Utc = {{Year, Month, Day}, {Hour, Min, Sec}}, - ?line Local = {{Year, Month, Day-1}, {Hour+TimeZone+24, Min, Sec}}, - ?line [{Utc, Local}|crossover_test_data(Rest, TimeZone)]; + Utc = {{Year, Month, Day}, {Hour, Min, Sec}}, + Local = {{Year, Month, Day-1}, {Hour+TimeZone+24, Min, Sec}}, + [{Utc, Local}|crossover_test_data(Rest, TimeZone)]; crossover_test_data([], _) -> []. @@ -956,9 +943,9 @@ test_data([Date|Rest], TimeZone) -> Hour = 12, Min = 45, Sec = 7, - ?line Utc = {Date, {Hour, Min, Sec}}, - ?line Local = {Date, {Hour+TimeZone, Min, Sec}}, - ?line [{Utc, Local}|test_data(Rest, TimeZone)]; + Utc = {Date, {Hour, Min, Sec}}, + Local = {Date, {Hour+TimeZone, Min, Sec}}, + [{Utc, Local}|test_data(Rest, TimeZone)]; test_data([], _) -> []. @@ -1049,7 +1036,7 @@ start_node(Config) -> start_node(Config, ""). start_node(Config, Args) -> - TestCase = ?config(testcase, Config), + TestCase = proplists:get_value(testcase, Config), PA = filename:dirname(code:which(?MODULE)), ESTime = erlang:monotonic_time(1) + erlang:time_offset(1), Unique = erlang:unique_integer([positive]), diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl index 51d59f09f3..a5f11bd959 100644 --- a/erts/emulator/test/timer_bif_SUITE.erl +++ b/erts/emulator/test/timer_bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,8 +20,7 @@ -module(timer_bif_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1, init_per_testcase/2,end_per_testcase/2]). -export([start_timer_1/1, send_after_1/1, send_after_2/1, send_after_3/1, cancel_timer_1/1, @@ -33,23 +32,20 @@ % same_time_yielding_with_cancel_other_accessor/1, auto_cancel_yielding/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.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 true -> ok; _ -> erts_debug:set_internal_state(available_internal_state, true) end, - [{watchdog, Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - test_server:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) -> @@ -59,7 +55,9 @@ init_per_suite(Config) -> end_per_suite(_Config) -> catch erts_debug:set_internal_state(available_internal_state, false). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 5}}]. all() -> [start_timer_1, send_after_1, send_after_2, @@ -72,17 +70,8 @@ all() -> % same_time_yielding_with_cancel_other_accessor, auto_cancel_yielding]. -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -start_timer_1(doc) -> ["Basic start_timer/3 functionality"]; +%% Basic start_timer/3 functionality start_timer_1(Config) when is_list(Config) -> Ref1 = erlang:start_timer(1000, self(), plopp), ok = get(1100, {timeout, Ref1, plopp}), @@ -102,54 +91,54 @@ start_timer_1(Config) when is_list(Config) -> no_message = get(900, {timeout, Ref3, plopp}), ok. -send_after_1(doc) -> ["Basic send_after/3 functionality"]; +%% Basic send_after/3 functionality send_after_1(Config) when is_list(Config) -> - ?line Ref3 = erlang:send_after(1000, self(), plipp), - ?line ok = get(1500, plipp), - ?line false = erlang:read_timer(Ref3), + Ref3 = erlang:send_after(1000, self(), plipp), + ok = get(1500, plipp), + false = erlang:read_timer(Ref3), ok. -start_timer_big(doc) -> ["Big timeouts for start_timer/3"]; +%% Big timeouts for start_timer/3 start_timer_big(Config) when is_list(Config) -> - ?line Big = 1 bsl 31, - ?line R = erlang:start_timer(Big, self(), hej), - ?line timer:sleep(200), - ?line Left = erlang:cancel_timer(R), - ?line case Big - Left of - Diff when Diff >= 200, Diff < 10000 -> - ok; - _Diff -> - test_server:fail({big, Big, Left}) - end, + Big = 1 bsl 31, + R = erlang:start_timer(Big, self(), hej), + timer:sleep(200), + Left = erlang:cancel_timer(R), + case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + ct:fail({big, Big, Left}) + end, ok. -send_after_big(doc) -> ["Big timeouts for send_after/3"]; +%% Big timeouts for send_after/3 send_after_big(Config) when is_list(Config) -> - ?line Big = 1 bsl 31, - ?line R = erlang:send_after(Big, self(), hej), - ?line timer:sleep(200), - ?line Left = erlang:cancel_timer(R), - ?line case Big - Left of - Diff when Diff >= 200, Diff < 10000 -> - ok; - _Diff -> - test_server:fail({big, Big, Left}) - end, + Big = 1 bsl 31, + R = erlang:send_after(Big, self(), hej), + timer:sleep(200), + Left = erlang:cancel_timer(R), + case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + ct:fail({big, Big, Left}) + end, ok. -send_after_2(doc) -> ["send_after/3: messages in the right order, kind version"]; +%% send_after/3: messages in the right order, kind version send_after_2(Config) when is_list(Config) -> - ?line _ = erlang:send_after(5000, self(), last), - ?line _ = erlang:send_after(0, self(), a0), - ?line _ = erlang:send_after(200, self(), a2), - ?line _ = erlang:send_after(100, self(), a1), - ?line _ = erlang:send_after(500, self(), a5), - ?line _ = erlang:send_after(300, self(), a3), - ?line _ = erlang:send_after(400, self(), a4), - ?line [a0,a1,a2,a3,a4,a5,last] = collect(last), + _ = erlang:send_after(5000, self(), last), + _ = erlang:send_after(0, self(), a0), + _ = erlang:send_after(200, self(), a2), + _ = erlang:send_after(100, self(), a1), + _ = erlang:send_after(500, self(), a5), + _ = erlang:send_after(300, self(), a3), + _ = erlang:send_after(400, self(), a4), + [a0,a1,a2,a3,a4,a5,last] = collect(last), ok. -send_after_3(doc) -> ["send_after/3: messages in the right order, worse than send_after_2"]; +%% send_after/3: messages in the right order, worse than send_after_2 send_after_3(Config) when is_list(Config) -> _ = erlang:send_after(100, self(), b1), _ = erlang:send_after(101, self(), b2), @@ -157,74 +146,70 @@ send_after_3(Config) when is_list(Config) -> _ = erlang:send_after(103, self(), last), [b1, b2, b3, last] = collect(last), -% This behaviour is not guaranteed: -% ?line _ = erlang:send_after(100, self(), c1), -% ?line _ = erlang:send_after(100, self(), c2), -% ?line _ = erlang:send_after(100, self(), c3), -% ?line _ = erlang:send_after(100, self(), last), -% ?line [c1, c2, c3, last] = collect(last), + % This behaviour is not guaranteed: + % _ = erlang:send_after(100, self(), c1), + % _ = erlang:send_after(100, self(), c2), + % _ = erlang:send_after(100, self(), c3), + % _ = erlang:send_after(100, self(), last), + % [c1, c2, c3, last] = collect(last), ok. -cancel_timer_1(doc) -> ["Check trivial cancel_timer/1 behaviour"]; +%% Check trivial cancel_timer/1 behaviour cancel_timer_1(Config) when is_list(Config) -> - ?line false = erlang:cancel_timer(make_ref()), + false = erlang:cancel_timer(make_ref()), ok. -start_timer_e(doc) -> ["Error cases for start_timer/3"]; +%% 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(1 bsl 64, - self(), hej)), + {'EXIT', _} = (catch erlang:start_timer(-4, self(), hej)), + {'EXIT', _} = (catch erlang:start_timer(1 bsl 64, + self(), hej)), - ?line {'EXIT', _} = (catch erlang:start_timer(4.5, self(), hej)), - ?line {'EXIT', _} = (catch erlang:start_timer(a, self(), hej)), + {'EXIT', _} = (catch erlang:start_timer(4.5, self(), hej)), + {'EXIT', _} = (catch erlang:start_timer(a, self(), hej)), - ?line Node = start_slave(), - ?line Pid = spawn(Node, timer, sleep, [10000]), - ?line {'EXIT', _} = (catch erlang:start_timer(1000, Pid, hej)), - ?line stop_slave(Node), + Node = start_slave(), + Pid = spawn(Node, timer, sleep, [10000]), + {'EXIT', _} = (catch erlang:start_timer(1000, Pid, hej)), + stop_slave(Node), ok. -send_after_e(doc) -> ["Error cases for send_after/3"]; -send_after_e(suite) -> []; +%% Error cases for send_after/3 send_after_e(Config) when is_list(Config) -> - ?line {'EXIT', _} = (catch erlang:send_after(-4, self(), hej)), - ?line {'EXIT', _} = (catch erlang:send_after(1 bsl 64, - self(), hej)), + {'EXIT', _} = (catch erlang:send_after(-4, self(), hej)), + {'EXIT', _} = (catch erlang:send_after(1 bsl 64, + self(), hej)), - ?line {'EXIT', _} = (catch erlang:send_after(4.5, self(), hej)), - ?line {'EXIT', _} = (catch erlang:send_after(a, self(), hej)), + {'EXIT', _} = (catch erlang:send_after(4.5, self(), hej)), + {'EXIT', _} = (catch erlang:send_after(a, self(), hej)), - ?line Node = start_slave(), - ?line Pid = spawn(Node, timer, sleep, [10000]), - ?line {'EXIT', _} = (catch erlang:send_after(1000, Pid, hej)), - ?line stop_slave(Node), + Node = start_slave(), + Pid = spawn(Node, timer, sleep, [10000]), + {'EXIT', _} = (catch erlang:send_after(1000, Pid, hej)), + stop_slave(Node), ok. -cancel_timer_e(doc) -> ["Error cases for cancel_timer/1"]; -cancel_timer_e(suite) -> []; +%% Error cases for cancel_timer/1 cancel_timer_e(Config) when is_list(Config) -> - ?line {'EXIT', _} = (catch erlang:cancel_timer(1)), - ?line {'EXIT', _} = (catch erlang:cancel_timer(self())), - ?line {'EXIT', _} = (catch erlang:cancel_timer(a)), + {'EXIT', _} = (catch erlang:cancel_timer(1)), + {'EXIT', _} = (catch erlang:cancel_timer(self())), + {'EXIT', _} = (catch erlang:cancel_timer(a)), ok. -read_timer_trivial(doc) -> ["Trivial and error test cases for read_timer/1."]; -read_timer_trivial(suite) -> []; +%% Trivial and error test cases for read_timer/1. read_timer_trivial(Config) when is_list(Config) -> - ?line false = erlang:read_timer(make_ref()), - ?line {'EXIT', _} = (catch erlang:read_timer(42)), - ?line {'EXIT', _} = (catch erlang:read_timer(423497834744444444457667444444)), - ?line {'EXIT', _} = (catch erlang:read_timer(self())), - ?line {'EXIT', _} = (catch erlang:read_timer(ab)), + false = erlang:read_timer(make_ref()), + {'EXIT', _} = (catch erlang:read_timer(42)), + {'EXIT', _} = (catch erlang:read_timer(423497834744444444457667444444)), + {'EXIT', _} = (catch erlang:read_timer(self())), + {'EXIT', _} = (catch erlang:read_timer(ab)), ok. -read_timer(doc) -> ["Test that read_timer/1 seems to return the correct values."]; -read_timer(suite) -> []; +%% Test that read_timer/1 seems to return the correct values. read_timer(Config) when is_list(Config) -> process_flag(scheduler, 1), Big = 1 bsl 31, @@ -234,22 +219,21 @@ read_timer(Config) when is_list(Config) -> Left = erlang:read_timer(R), Left2 = erlang:cancel_timer(R), case Left == Left2 of - true -> ok; - false -> Left = Left2 + 1 + true -> ok; + false -> Left = Left2 + 1 end, false = erlang:read_timer(R), case Big - Left of - Diff when Diff >= 200, Diff < 10000 -> - ok; - _Diff -> - test_server:fail({big, Big, Left}) + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + ct:fail({big, Big, Left}) end, process_flag(scheduler, 0), ok. -read_timer_async(doc) -> ["Test that read_timer/1 seems to return the correct values."]; -read_timer_async(suite) -> []; +%% Test that read_timer/1 seems to return the correct values. read_timer_async(Config) when is_list(Config) -> process_flag(scheduler, 1), Big = 1 bsl 33, @@ -266,73 +250,69 @@ read_timer_async(Config) when is_list(Config) -> {read_timer, R, Left} = receive_one(), {cancel_timer, R, Left2} = receive_one(), case Left == Left2 of - true -> ok; - false -> Left = Left2 + 1 + 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}) + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + ct:fail({big, Big, Left}) end, process_flag(scheduler, 0), ok. -cleanup(doc) -> []; -cleanup(suite) -> []; cleanup(Config) when is_list(Config) -> - ?line Mem = mem(), + Mem = mem(), %% Timer on dead process - ?line P1 = spawn(fun () -> ok end), - ?line wait_until(fun () -> process_is_cleaned_up(P1) end), - ?line T1 = erlang:start_timer(?SHORT_TIMEOUT*2, P1, "hej"), - ?line T2 = erlang:send_after(?SHORT_TIMEOUT*2, P1, "hej"), + P1 = spawn(fun () -> ok end), + wait_until(fun () -> process_is_cleaned_up(P1) end), + T1 = erlang:start_timer(?SHORT_TIMEOUT*2, P1, "hej"), + 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(), + Mem = mem(), + false = erlang:read_timer(T1), + false = erlang:read_timer(T2), + Mem = mem(), %% Process dies before timeout - ?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), + P2 = spawn(fun () -> receive after (?SHORT_TIMEOUT div 10) -> ok end end), + T3 = erlang:start_timer(?SHORT_TIMEOUT*2, P2, "hej"), + T4 = erlang:send_after(?SHORT_TIMEOUT*2, P2, "hej"), + true = mem_larger_than(Mem), + true = is_integer(erlang:read_timer(T3)), + true = is_integer(erlang:read_timer(T4)), + 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(), + false = erlang:read_timer(T3), + false = erlang:read_timer(T4), + Mem = mem(), %% Cancel timer - ?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(), + P3 = spawn(fun () -> receive after ?SHORT_TIMEOUT*4 -> ok end end), + T5 = erlang:start_timer(?SHORT_TIMEOUT*2, P3, "hej"), + T6 = erlang:send_after(?SHORT_TIMEOUT*2, P3, "hej"), + true = mem_larger_than(Mem), + true = is_integer(erlang:cancel_timer(T5)), + true = is_integer(erlang:cancel_timer(T6)), + false = erlang:read_timer(T5), + false = erlang:read_timer(T6), + exit(P3, kill), + wait_until(fun () -> process_is_cleaned_up(P3) end), + Mem = mem(), %% Timeout - ?line Ref = make_ref(), - ?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, - ?line receive Ref -> ok end, - ?line Mem = mem(), - ?line ok. - - -evil_timers(doc) -> []; -evil_timers(suite) -> []; + Ref = make_ref(), + T7 = erlang:start_timer(?SHORT_TIMEOUT+1, self(), Ref), + T8 = erlang:send_after(?SHORT_TIMEOUT+1, self(), Ref), + true = mem_larger_than(Mem), + true = is_integer(erlang:read_timer(T7)), + true = is_integer(erlang:read_timer(T8)), + receive {timeout, T7, Ref} -> ok end, + receive Ref -> ok end, + Mem = mem(), + ok. + + evil_timers(Config) when is_list(Config) -> %% Create a composite term consisting of at least: %% * externals (remote pids, ports, and refs) @@ -344,38 +324,38 @@ evil_timers(Config) when is_list(Config) -> %% * lists %% since data of these types have to be adjusted if moved %% in memory - ?line Self = self(), - ?line R1 = make_ref(), - ?line Node = start_slave(), - ?line spawn_link(Node, - fun () -> - Self ! {R1, - [lists:sublist(erlang:ports(), 3), - [make_ref(), make_ref(), make_ref()], - lists:sublist(processes(), 3), - [fun () -> gurka end, - fun (A) -> A + 1 end, - fun (A, B) -> A + B end]]} - end), - ?line ExtList = receive {R1, L} -> L end, - ?line stop_slave(Node), - ?line BinList = [<<"bla">>, - <<"blipp">>, - <<"blupp">>, - list_to_binary(lists:duplicate(1000000,$a)), - list_to_binary(lists:duplicate(1000000,$b)), - list_to_binary(lists:duplicate(1000000,$c))], - ?line FunList = [fun () -> gurka end, - fun (A) -> A + 1 end, - fun (A, B) -> A + B end], - ?line PidList = lists:sublist(processes(), 3), - ?line PortList = lists:sublist(erlang:ports(), 3), - ?line RefList = [make_ref(), make_ref(), make_ref()], - ?line BigList = [111111111111, 22222222222222, 333333333333333333], - ?line Msg = {BinList,[FunList,{RefList,ExtList,PidList,PortList,BigList}]}, - %% ?line ?t:format("Msg=~p~n",[Msg]), - - ?line Prio = process_flag(priority, max), + Self = self(), + R1 = make_ref(), + Node = start_slave(), + spawn_link(Node, + fun () -> + Self ! {R1, + [lists:sublist(erlang:ports(), 3), + [make_ref(), make_ref(), make_ref()], + lists:sublist(processes(), 3), + [fun () -> gurka end, + fun (A) -> A + 1 end, + fun (A, B) -> A + B end]]} + end), + ExtList = receive {R1, L} -> L end, + stop_slave(Node), + BinList = [<<"bla">>, + <<"blipp">>, + <<"blupp">>, + list_to_binary(lists:duplicate(1000000,$a)), + list_to_binary(lists:duplicate(1000000,$b)), + list_to_binary(lists:duplicate(1000000,$c))], + FunList = [fun () -> gurka end, + fun (A) -> A + 1 end, + fun (A, B) -> A + B end], + PidList = lists:sublist(processes(), 3), + PortList = lists:sublist(erlang:ports(), 3), + RefList = [make_ref(), make_ref(), make_ref()], + BigList = [111111111111, 22222222222222, 333333333333333333], + Msg = {BinList,[FunList,{RefList,ExtList,PidList,PortList,BigList}]}, + %% io:format("Msg=~p~n",[Msg]), + + Prio = process_flag(priority, max), %% %% In the smp case there are four major cases we want to test: %% @@ -388,8 +368,8 @@ evil_timers(Config) when is_list(Config) -> %% be allocated in the previously allocated message buffer along %% with Msg, i.e. the previously allocated message buffer will be %% reallocated and potentially moved. - ?line TimeOutMsgs0 = evil_setup_timers(200, Self, Msg), - ?line RecvTimeOutMsgs0 = evil_recv_timeouts(200), + TimeOutMsgs0 = evil_setup_timers(200, Self, Msg), + RecvTimeOutMsgs0 = evil_recv_timeouts(200), %% 2. A timer started with erlang:start_timer(Time, Receiver, Msg), %% where Msg is an immediate term, expires, and the receivers main %% lock *can not* be acquired immediately (typically when the @@ -397,8 +377,8 @@ evil_timers(Config) when is_list(Config) -> %% %% The wrap tuple will in this case be allocated in a new %% message buffer. - ?line TimeOutMsgs1 = evil_setup_timers(200, Self, immediate), - ?line RecvTimeOutMsgs1 = evil_recv_timeouts(200), + TimeOutMsgs1 = evil_setup_timers(200, Self, immediate), + RecvTimeOutMsgs1 = evil_recv_timeouts(200), %% 3. A timer started with erlang:start_timer(Time, Receiver, Msg), %% where Msg is a composite term, expires, and the receivers main %% lock *can* be acquired immediately (typically when the receiver @@ -407,13 +387,13 @@ evil_timers(Config) when is_list(Config) -> %% The wrap tuple will in this case be allocated on the receivers %% heap, and Msg is passed in the previously allocated message %% buffer. - ?line R2 = make_ref(), - ?line spawn_link(fun () -> - Self ! {R2, evil_setup_timers(200, Self, Msg)} - end), - ?line receive after 1000 -> ok end, - ?line TimeOutMsgs2 = receive {R2, TOM2} -> TOM2 end, - ?line RecvTimeOutMsgs2 = evil_recv_timeouts(200), + R2 = make_ref(), + spawn_link(fun () -> + Self ! {R2, evil_setup_timers(200, Self, Msg)} + end), + receive after 1000 -> ok end, + TimeOutMsgs2 = receive {R2, TOM2} -> TOM2 end, + RecvTimeOutMsgs2 = evil_recv_timeouts(200), %% 4. A timer started with erlang:start_timer(Time, Receiver, Msg), %% where Msg is an immediate term, expires, and the Receivers main %% lock *can* be acquired immediately (typically when the receiver @@ -421,109 +401,107 @@ evil_timers(Config) when is_list(Config) -> %% %% The wrap tuple will in this case be allocated on the receivers %% heap. - ?line R3 = make_ref(), - ?line spawn_link(fun () -> - Self ! {R3, evil_setup_timers(200,Self,immediate)} - end), - ?line receive after 1000 -> ok end, - ?line TimeOutMsgs3 = receive {R3, TOM3} -> TOM3 end, - ?line RecvTimeOutMsgs3 = evil_recv_timeouts(200), + R3 = make_ref(), + spawn_link(fun () -> + Self ! {R3, evil_setup_timers(200,Self,immediate)} + end), + receive after 1000 -> ok end, + TimeOutMsgs3 = receive {R3, TOM3} -> TOM3 end, + RecvTimeOutMsgs3 = evil_recv_timeouts(200), %% Garge collection will hopefully crash the emulator if something %% is wrong... - ?line garbage_collect(), - ?line garbage_collect(), - ?line garbage_collect(), + garbage_collect(), + garbage_collect(), + garbage_collect(), %% Make sure we got the timeouts we expected %% %% Note timeouts are *not* guaranteed to be delivered in order - ?line ok = match(lists:sort(RecvTimeOutMsgs0), lists:sort(TimeOutMsgs0)), - ?line ok = match(lists:sort(RecvTimeOutMsgs1), lists:sort(TimeOutMsgs1)), - ?line ok = match(lists:sort(RecvTimeOutMsgs2), lists:sort(TimeOutMsgs2)), - ?line ok = match(lists:sort(RecvTimeOutMsgs3), lists:sort(TimeOutMsgs3)), + ok = match(lists:sort(RecvTimeOutMsgs0), lists:sort(TimeOutMsgs0)), + ok = match(lists:sort(RecvTimeOutMsgs1), lists:sort(TimeOutMsgs1)), + ok = match(lists:sort(RecvTimeOutMsgs2), lists:sort(TimeOutMsgs2)), + ok = match(lists:sort(RecvTimeOutMsgs3), lists:sort(TimeOutMsgs3)), - ?line process_flag(priority, Prio), - ?line ok. + process_flag(priority, Prio), + ok. evil_setup_timers(N, Receiver, Msg) -> - ?line evil_setup_timers(0, N, Receiver, Msg, []). + evil_setup_timers(0, N, Receiver, Msg, []). evil_setup_timers(N, N, _Receiver, _Msg, TOs) -> - ?line TOs; + TOs; evil_setup_timers(N, Max, Receiver, Msg, TOs) -> - ?line TRef = erlang:start_timer(N, Receiver, Msg), - ?line evil_setup_timers(N+1, Max, Receiver, Msg, [{timeout,TRef,Msg}|TOs]). + TRef = erlang:start_timer(N, Receiver, Msg), + evil_setup_timers(N+1, Max, Receiver, Msg, [{timeout,TRef,Msg}|TOs]). evil_recv_timeouts(M) -> - ?line evil_recv_timeouts([], 0, M). + evil_recv_timeouts([], 0, M). evil_recv_timeouts(TOs, N, N) -> - ?line TOs; + TOs; evil_recv_timeouts(TOs, N, M) -> - ?line receive - {timeout, _, _} = TO -> - ?line evil_recv_timeouts([TO|TOs], N+1, M) - after 0 -> - ?line evil_recv_timeouts(TOs, N, M) - end. - -registered_process(doc) -> []; -registered_process(suite) -> []; + receive + {timeout, _, _} = TO -> + evil_recv_timeouts([TO|TOs], N+1, M) + after 0 -> + evil_recv_timeouts(TOs, N, M) + end. + registered_process(Config) when is_list(Config) -> - ?line Mem = mem(), + Mem = mem(), %% Cancel - ?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_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), - ?line false = erlang:read_timer(T2), - ?line Mem = mem(), + T1 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, "hej"), + T2 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, "hej"), + undefined = whereis(?MODULE), + true = mem_larger_than(Mem), + true = is_integer(erlang:cancel_timer(T1)), + true = is_integer(erlang:cancel_timer(T2)), + false = erlang:read_timer(T1), + false = erlang:read_timer(T2), + Mem = mem(), %% Timeout register after start - ?line Ref1 = make_ref(), - ?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_larger_than(Mem), - ?line true = is_integer(erlang:read_timer(T3)), - ?line true = is_integer(erlang:read_timer(T4)), - ?line true = register(?MODULE, self()), - ?line receive {timeout, T3, Ref1} -> ok end, - ?line receive Ref1 -> ok end, - ?line Mem = mem(), + Ref1 = make_ref(), + T3 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, Ref1), + T4 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, Ref1), + undefined = whereis(?MODULE), + true = mem_larger_than(Mem), + true = is_integer(erlang:read_timer(T3)), + true = is_integer(erlang:read_timer(T4)), + true = register(?MODULE, self()), + receive {timeout, T3, Ref1} -> ok end, + receive Ref1 -> ok end, + Mem = mem(), %% Timeout register before start - ?line Ref2 = make_ref(), - ?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, - ?line receive Ref2 -> ok end, - ?line Mem = mem(), - ?line true = unregister(?MODULE), - ?line ok. + Ref2 = make_ref(), + T5 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, Ref2), + T6 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, Ref2), + true = mem_larger_than(Mem), + true = is_integer(erlang:read_timer(T5)), + true = is_integer(erlang:read_timer(T6)), + receive {timeout, T5, Ref2} -> ok end, + receive Ref2 -> ok end, + Mem = mem(), + true = unregister(?MODULE), + ok. 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)), + 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 + opt -> true = Done < Tmo + 200; + _ -> true = Done < Tmo + 1000 end, Mem = mem(), ok. @@ -539,19 +517,19 @@ same_time_yielding_with_cancel_other(Config) when is_list(Config) -> do_cancel_tmrs(Tmo, Tmrs, Tester) -> BeginCancel = erlang:convert_time_unit(Tmo, - milli_seconds, - micro_seconds) - 100, + milli_seconds, + micro_seconds) - 100, busy_wait_until(fun () -> - erlang:monotonic_time(micro_seconds) >= BeginCancel - end), + erlang:monotonic_time(micro_seconds) >= BeginCancel + end), lists:foreach(fun (Tmr) -> - erlang:cancel_timer(Tmr, - [{async, true}, - {info, true}]) - end, Tmrs), + erlang:cancel_timer(Tmr, + [{async, true}, + {info, true}]) + end, Tmrs), case Tester == self() of - true -> ok; - false -> forward_msgs(Tester) + true -> ok; + false -> forward_msgs(Tester) end. same_time_yielding_with_cancel_test(Other, Accessor) -> @@ -560,57 +538,57 @@ same_time_yielding_with_cancel_test(Other, Accessor) -> 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, + 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, + 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)), + 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} + 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), + 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 + true -> exit(Cancelor, bang); + false -> ok end, {comment, "Timeouts: " ++ integer_to_list(Tmos) ++ " Cancels: " @@ -620,16 +598,16 @@ 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), + 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), @@ -641,46 +619,46 @@ process_is_cleaned_up(P) when is_pid(P) -> wait_until(Pred) when is_function(Pred) -> case catch Pred() of - true -> ok; - _ -> receive after 50 -> ok end, wait_until(Pred) + true -> ok; + _ -> 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) + true -> ok; + _ -> busy_wait_until(Pred) end. forward_msgs(To) -> receive - Msg -> - To ! Msg + Msg -> + To ! Msg end, forward_msgs(To). get(Time, Msg) -> receive - Msg -> - ok + Msg -> + ok after Time - -> - no_message + -> + no_message end. get_msg() -> receive - Msg -> - {ok, Msg} + Msg -> + {ok, Msg} after 0 -> - empty + empty end. start_slave() -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?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}]), + Pa = filename:dirname(code:which(?MODULE)), + Name = atom_to_list(?MODULE) + ++ "-" ++ integer_to_list(erlang:system_time(seconds)) + ++ "-" ++ integer_to_list(erlang:unique_integer([positive])), + {ok, Node} = test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]), Node. stop_slave(Node) -> @@ -691,18 +669,18 @@ collect(Last) -> receive_one() -> receive - Msg -> - Msg + Msg -> + Msg end. collect(Last, Msgs0) -> Msg = receive_one(), Msgs = Msgs0 ++ [Msg], case Msg of - Last -> - Msgs; - _ -> - collect(Last, Msgs) + Last -> + Msgs; + _ -> + collect(Last, Msgs) end. match(X, X) -> @@ -751,8 +729,8 @@ mem() -> erts_debug:set_internal_state(wait, timer_cancellations), 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 + {-1, -1} -> no_fix_alloc; + {A, U} -> io:format("mem = ~p ~p~n", [A, U]), U end. mem_get() -> @@ -765,8 +743,8 @@ mem_recv(0, _Ref, AU) -> AU; mem_recv(N, Ref, AU) -> receive - {Ref, _, IL} -> - mem_recv(N-1, Ref, mem_parse_ilists(IL, AU)) + {Ref, _, IL} -> + mem_recv(N-1, Ref, mem_parse_ilists(IL, AU)) end. @@ -779,19 +757,19 @@ 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} + {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 -> + 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_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index 6eae182e45..29e043dd5c 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -24,183 +24,262 @@ %%% Tests the trace BIF. %%% --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, receive_trace/1, self_send/1, +-export([all/0, suite/0, link_receive_call_correlation/0, + receive_trace/1, link_receive_call_correlation/1, self_send/1, timeout_trace/1, send_trace/1, - procs_trace/1, dist_procs_trace/1, + procs_trace/1, dist_procs_trace/1, procs_new_trace/1, suspend/1, mutual_suspend/1, suspend_exit/1, suspender_exit/1, suspend_system_limit/1, suspend_opts/1, suspend_waiting/1, new_clear/1, existing_clear/1, set_on_spawn/1, set_on_first_spawn/1, cpu_timestamp/1, + set_on_link/1, set_on_first_link/1, system_monitor_args/1, more_system_monitor_args/1, system_monitor_long_gc_1/1, system_monitor_long_gc_2/1, system_monitor_large_heap_1/1, system_monitor_large_heap_2/1, system_monitor_long_schedule/1, bad_flag/1, trace_delivered/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %%% Internal exports -export([process/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 5}}]. all() -> - [cpu_timestamp, receive_trace, self_send, timeout_trace, + [cpu_timestamp, receive_trace, link_receive_call_correlation, + self_send, timeout_trace, send_trace, procs_trace, dist_procs_trace, suspend, mutual_suspend, suspend_exit, suspender_exit, suspend_system_limit, suspend_opts, suspend_waiting, new_clear, existing_clear, set_on_spawn, - set_on_first_spawn, system_monitor_args, + set_on_first_spawn, set_on_link, set_on_first_link, + system_monitor_args, more_system_monitor_args, system_monitor_long_gc_1, system_monitor_long_gc_2, system_monitor_large_heap_1, - system_monitor_long_schedule, + system_monitor_long_schedule, system_monitor_large_heap_2, bad_flag, trace_delivered]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - %% No longer testing anything, just reporting whether cpu_timestamp %% is enabled or not. cpu_timestamp(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - %% Test whether cpu_timestamp is implemented on this platform. - ?line Works = try erlang:trace(all, true, [cpu_timestamp]) of - _ -> - ?line erlang:trace(all, false, [cpu_timestamp]), - true - catch - error:badarg -> false - end, - - ?line test_server:timetrap_cancel(Dog), + Works = try erlang:trace(all, true, [cpu_timestamp]) of + _ -> + erlang:trace(all, false, [cpu_timestamp]), + true + catch + error:badarg -> false + end, {comment,case Works of - false -> "cpu_timestamp is NOT implemented/does not work"; - true -> "cpu_timestamp works" - end}. + false -> "cpu_timestamp is NOT implemented/does not work"; + true -> "cpu_timestamp works" + end}. %% Tests that trace(Pid, How, ['receive']) works. receive_trace(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - ?line Receiver = fun_spawn(fun receiver/0), - ?line process_flag(trap_exit, true), + Receiver = fun_spawn(fun receiver/0), + process_flag(trap_exit, true), %% Trace the process; make sure that we receive the trace messages. - ?line 1 = erlang:trace(Receiver, true, ['receive']), - ?line Hello = {hello, world}, - ?line Receiver ! Hello, - ?line {trace, Receiver, 'receive', Hello} = receive_first(), - ?line Hello2 = {hello, again, world}, - ?line Receiver ! Hello2, - ?line {trace, Receiver, 'receive', Hello2} = receive_first(), - ?line receive_nothing(), + 1 = erlang:trace(Receiver, true, ['receive']), + Hello = {hello, world}, + Receiver ! Hello, + {trace, Receiver, 'receive', Hello} = receive_first_trace(), + Hello2 = {hello, again, world}, + Receiver ! Hello2, + {trace, Receiver, 'receive', Hello2} = receive_first_trace(), + receive_nothing(), %% Another process should not be able to trace Receiver. - ?line Intruder = fun_spawn(fun() -> erlang:trace(Receiver, true, ['receive']) end), - ?line {'EXIT', Intruder, {badarg, _}} = receive_first(), + Intruder = fun_spawn(fun() -> erlang:trace(Receiver, true, ['receive']) end), + {'EXIT', Intruder, {badarg, _}} = receive_first(), %% Untrace the process; we should not receive anything. - ?line 1 = erlang:trace(Receiver, false, ['receive']), - ?line Receiver ! {hello, there}, - ?line Receiver ! any_garbage, - ?line receive_nothing(), - - %% Done. - ?line test_server:timetrap_cancel(Dog), + 1 = erlang:trace(Receiver, false, ['receive']), + Receiver ! {hello, there}, + Receiver ! any_garbage, + receive_nothing(), ok. -self_send(doc) -> ["Test that traces are generated for messages sent ", - "and received to/from self()."]; +%% Tests that receive of a message always happens before a call with +%% that message and that links/unlinks are ordered together with the +%% 'receive'. +link_receive_call_correlation() -> + [{timetrap, {minutes, 5}}]. +link_receive_call_correlation(Config) when is_list(Config) -> + Receiver = fun_spawn(fun F() -> + receive + stop -> ok; + M -> receive_msg(M), F() + end + end), + process_flag(trap_exit, true), + + %% Trace the process; make sure that we receive the trace messages. + 1 = erlang:trace(Receiver, true, ['receive', procs, call, timestamp, scheduler_id]), + 1 = erlang:trace_pattern({?MODULE, receive_msg, '_'}, [], [local]), + + Num = 100000, + + (fun F(0) -> []; + F(N) -> + if N rem 2 == 0 -> + link(Receiver); + true -> + unlink(Receiver) + end, + [Receiver ! N | F(N-1)] + end)(Num), + + Receiver ! stop, + MonRef = erlang:monitor(process, Receiver), + receive {'DOWN', MonRef, _, _, _} -> ok end, + Ref = erlang:trace_delivered(Receiver), + receive {trace_delivered, _, Ref} -> ok end, + + Msgs = (fun F() -> receive M -> [M | F()] after 1 -> [] end end)(), + + case check_consistent(Receiver, Num, Num, Num, Msgs) of + ok -> + ok; + {error, Reason} -> + ct:log("~p", [Msgs]), + ct:fail({error, Reason}) + end. + +-define(schedid, , _). + +check_consistent(_Pid, Recv, Call, _LU, [Msg | _]) when Recv > Call -> + {error, Msg}; +check_consistent(Pid, Recv, Call, LU, [Msg | Msgs]) -> + + case Msg of + {trace, Pid, 'receive', Recv ?schedid} -> + check_consistent(Pid,Recv - 1, Call, LU, Msgs); + {trace_ts, Pid, 'receive', Recv ?schedid, _} -> + check_consistent(Pid,Recv - 1, Call, LU, Msgs); + + {trace, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid} -> + check_consistent(Pid,Recv, Call - 1, LU, Msgs); + {trace_ts, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid, _} -> + check_consistent(Pid,Recv, Call - 1, LU, Msgs); + + %% We check that for each receive we have gotten a + %% getting_linked or getting_unlinked message. Also + %% if we receive a getting_linked, then the next + %% message we expect to receive is an even number + %% and odd number for getting_unlinked. + {trace, Pid, getting_linked, _Self ?schedid} + when Recv rem 2 == 0, Recv == LU -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs); + {trace_ts, Pid, getting_linked, _Self ?schedid, _} + when Recv rem 2 == 0, Recv == LU -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs); + + {trace, Pid, getting_unlinked, _Self ?schedid} + when Recv rem 2 == 1, Recv == LU -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs); + {trace_ts, Pid, getting_unlinked, _Self ?schedid, _} + when Recv rem 2 == 1, Recv == LU -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs); + + {trace,Pid,'receive',Ignore ?schedid} + when Ignore == stop; Ignore == timeout -> + check_consistent(Pid, Recv, Call, LU, Msgs); + {trace_ts,Pid,'receive',Ignore ?schedid,_} + when Ignore == stop; Ignore == timeout -> + check_consistent(Pid, Recv, Call, LU, Msgs); + + {trace, Pid, exit, normal ?schedid} -> + check_consistent(Pid, Recv, Call, LU, Msgs); + {trace_ts, Pid, exit, normal ?schedid, _} -> + check_consistent(Pid, Recv, Call, LU, Msgs); + {'EXIT', Pid, normal} -> + check_consistent(Pid, Recv, Call, LU, Msgs); + Msg -> + {error, Msg} + end; +check_consistent(_, 0, 0, 0, []) -> + ok; +check_consistent(_, Recv, Call, LU, []) -> + {error,{Recv, Call, LU}}. + +receive_msg(M) -> + M. + +%% Test that traces are generated for messages sent +%% and received to/from self(). self_send(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - ?line Fun = - fun(Self, Parent) -> receive - go_ahead -> - self() ! from_myself, - Self(Self, Parent); - from_myself -> - Parent ! done - end - end, - ?line Self = self(), - ?line SelfSender = fun_spawn(Fun, [Fun, Self]), - ?line erlang:trace(SelfSender, true, ['receive', 'send']), - ?line SelfSender ! go_ahead, - ?line receive {trace, SelfSender, 'receive', go_ahead} -> ok end, - ?line receive {trace, SelfSender, 'receive', from_myself} -> ok end, - ?line receive - {trace,SelfSender,send,from_myself,SelfSender} -> ok - end, - ?line receive {trace,SelfSender,send,done,Self} -> ok end, - ?line receive done -> ok end, - - ?line test_server:timetrap_cancel(Dog), + Fun = + fun(Self, Parent) -> receive + go_ahead -> + self() ! from_myself, + Self(Self, Parent); + from_myself -> + Parent ! done + end + end, + Self = self(), + SelfSender = fun_spawn(Fun, [Fun, Self]), + erlang:trace(SelfSender, true, ['receive', 'send']), + SelfSender ! go_ahead, + receive {trace, SelfSender, 'receive', go_ahead} -> ok end, + receive {trace, SelfSender, 'receive', from_myself} -> ok end, + receive + {trace,SelfSender,send,from_myself,SelfSender} -> ok + end, + receive {trace,SelfSender,send,done,Self} -> ok end, + receive done -> ok end, ok. %% Test that we can receive timeout traces. timeout_trace(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - - ?line Process = fun_spawn(fun process/0), - ?line 1 = erlang:trace(Process, true, ['receive']), - ?line Process ! timeout_please, - ?line {trace, Process, 'receive', timeout_please} = receive_first(), - ?line {trace, Process, 'receive', timeout} = receive_first(), - ?line receive_nothing(), - - ?line test_server:timetrap_cancel(Dog), + Process = fun_spawn(fun process/0), + 1 = erlang:trace(Process, true, ['receive']), + Process ! timeout_please, + {trace, Process, 'receive', timeout_please} = receive_first_trace(), + {trace, Process, 'receive', timeout} = receive_first_trace(), + receive_nothing(), ok. %% Tests that trace(Pid, How, [send]) works. send_trace(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - ?line process_flag(trap_exit, true), - ?line Sender = fun_spawn(fun sender/0), - ?line Receiver = fun_spawn(fun receiver/0), + process_flag(trap_exit, true), + Sender = fun_spawn(fun sender/0), + Receiver = fun_spawn(fun receiver/0), %% Check that a message sent to another process is traced. - ?line 1 = erlang:trace(Sender, true, [send]), - ?line Sender ! {send_please, Receiver, to_receiver}, - ?line {trace, Sender, send, to_receiver, Receiver} = receive_first(), - ?line receive_nothing(), + 1 = erlang:trace(Sender, true, [send]), + Sender ! {send_please, Receiver, to_receiver}, + {trace, Sender, send, to_receiver, Receiver} = receive_first_trace(), + receive_nothing(), %% Check that a message sent to another registered process is traced. register(?MODULE,Receiver), Sender ! {send_please, ?MODULE, to_receiver}, - {trace, Sender, send, to_receiver, ?MODULE} = receive_first(), + {trace, Sender, send, to_receiver, ?MODULE} = receive_first_trace(), receive_nothing(), unregister(?MODULE), %% Check that a message sent to this process is traced. - ?line Sender ! {send_please, self(), to_myself}, - ?line receive to_myself -> ok end, - ?line Self = self(), - ?line {trace, Sender, send, to_myself, Self} = receive_first(), - ?line receive_nothing(), + Sender ! {send_please, self(), to_myself}, + receive to_myself -> ok end, + Self = self(), + {trace, Sender, send, to_myself, Self} = receive_first_trace(), + receive_nothing(), %% Check that a message sent to dead process is traced. {Pid,Ref} = spawn_monitor(fun() -> ok end), receive {'DOWN',Ref,_,_,_} -> ok end, Sender ! {send_please, Pid, to_dead}, - {trace, Sender, send_to_non_existing_process, to_dead, Pid} = receive_first(), + {trace, Sender, send_to_non_existing_process, to_dead, Pid} = receive_first_trace(), receive_nothing(), %% Check that a message sent to unknown registrated process is traced. @@ -208,314 +287,365 @@ send_trace(Config) when is_list(Config) -> 1 = erlang:trace(BadargSender, true, [send]), unlink(BadargSender), BadargSender ! {send_please, not_registered, to_unknown}, - {trace, BadargSender, send, to_unknown, not_registered} = receive_first(), + {trace, BadargSender, send, to_unknown, not_registered} = receive_first_trace(), receive_nothing(), %% Another process should not be able to trace Sender. - ?line Intruder = fun_spawn(fun() -> erlang:trace(Sender, true, [send]) end), - ?line {'EXIT', Intruder, {badarg, _}} = receive_first(), + Intruder = fun_spawn(fun() -> erlang:trace(Sender, true, [send]) end), + {'EXIT', Intruder, {badarg, _}} = receive_first(), %% Untrace the sender process and make sure that we receive no more %% trace messages. - ?line 1 = erlang:trace(Sender, false, [send]), - ?line Sender ! {send_please, Receiver, to_receiver}, - ?line Sender ! {send_please, self(), to_myself_again}, - ?line receive to_myself_again -> ok end, - ?line receive_nothing(), - - %% Done. - ?line test_server:timetrap_cancel(Dog), + 1 = erlang:trace(Sender, false, [send]), + Sender ! {send_please, Receiver, to_receiver}, + Sender ! {send_please, self(), to_myself_again}, + receive to_myself_again -> ok end, + receive_nothing(), ok. %% Test trace(Pid, How, [procs]). procs_trace(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - ?line Name = list_to_atom(atom_to_list(?MODULE)++"_procs_trace"), - ?line Self = self(), - ?line process_flag(trap_exit, true), + Name = list_to_atom(atom_to_list(?MODULE)++"_procs_trace"), + Self = self(), + process_flag(trap_exit, true), %% - ?line Proc1 = spawn_link(?MODULE, process, [Self]), - ?line io:format("Proc1 = ~p ~n", [Proc1]), - ?line Proc2 = spawn(?MODULE, process, [Self]), - ?line io:format("Proc2 = ~p ~n", [Proc2]), + Proc1 = spawn_link(?MODULE, process, [Self]), + io:format("Proc1 = ~p ~n", [Proc1]), + Proc2 = spawn(?MODULE, process, [Self]), + io:format("Proc2 = ~p ~n", [Proc2]), %% - ?line 1 = erlang:trace(Proc1, true, [procs]), - ?line MFA = {?MODULE, process, [Self]}, + 1 = erlang:trace(Proc1, true, [procs, set_on_first_spawn]), + MFA = {?MODULE, process, [Self]}, %% %% spawn, link - ?line Proc1 ! {spawn_link_please, Self, MFA}, - ?line Proc3 = receive {spawned, Proc1, P3} -> P3 end, - ?line {trace, Proc1, spawn, Proc3, MFA} = receive_first(), - ?line io:format("Proc3 = ~p ~n", [Proc3]), - ?line {trace, Proc1, link, Proc3} = receive_first(), - ?line receive_nothing(), + Proc1 ! {spawn_link_please, Self, MFA}, + Proc3 = receive {spawned, Proc1, P3} -> P3 end, + receive {trace, Proc3, spawned, Proc1, MFA} -> ok end, + receive {trace, Proc3, getting_linked, Proc1} -> ok end, + {trace, Proc1, spawn, Proc3, MFA} = receive_first_trace(), + io:format("Proc3 = ~p ~n", [Proc3]), + {trace, Proc1, link, Proc3} = receive_first_trace(), + receive_nothing(), %% %% getting_unlinked by exit() - ?line Proc1 ! {trap_exit_please, true}, - ?line Reason3 = make_ref(), - ?line Proc1 ! {send_please, Proc3, {exit_please, Reason3}}, - ?line receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end, - ?line {trace, Proc1, getting_unlinked, Proc3} = receive_first(), - ?line Proc1 ! {trap_exit_please, false}, - ?line receive_nothing(), + Proc1 ! {trap_exit_please, true}, + Reason3 = make_ref(), + Proc1 ! {send_please, Proc3, {exit_please, Reason3}}, + receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end, + receive {trace, Proc3, exit, Reason3} -> ok end, + {trace, Proc1, getting_unlinked, Proc3} = receive_first_trace(), + Proc1 ! {trap_exit_please, false}, + receive_nothing(), %% %% link - ?line Proc1 ! {link_please, Proc2}, - ?line {trace, Proc1, link, Proc2} = receive_first(), - ?line receive_nothing(), + Proc1 ! {link_please, Proc2}, + {trace, Proc1, link, Proc2} = receive_first_trace(), + receive_nothing(), %% %% unlink - ?line Proc1 ! {unlink_please, Proc2}, - ?line {trace, Proc1, unlink, Proc2} = receive_first(), - ?line receive_nothing(), + Proc1 ! {unlink_please, Proc2}, + {trace, Proc1, unlink, Proc2} = receive_first_trace(), + receive_nothing(), %% %% getting_linked - ?line Proc2 ! {link_please, Proc1}, - ?line {trace, Proc1, getting_linked, Proc2} = receive_first(), - ?line receive_nothing(), + Proc2 ! {link_please, Proc1}, + {trace, Proc1, getting_linked, Proc2} = receive_first_trace(), + receive_nothing(), %% %% getting_unlinked - ?line Proc2 ! {unlink_please, Proc1}, - ?line {trace, Proc1, getting_unlinked, Proc2} = receive_first(), - ?line receive_nothing(), + Proc2 ! {unlink_please, Proc1}, + {trace, Proc1, getting_unlinked, Proc2} = receive_first_trace(), + receive_nothing(), %% %% register - ?line true = register(Name, Proc1), - ?line {trace, Proc1, register, Name} = receive_first(), - ?line receive_nothing(), + true = register(Name, Proc1), + {trace, Proc1, register, Name} = receive_first_trace(), + receive_nothing(), %% %% unregister - ?line true = unregister(Name), - ?line {trace, Proc1, unregister, Name} = receive_first(), - ?line receive_nothing(), + true = unregister(Name), + {trace, Proc1, unregister, Name} = receive_first_trace(), + receive_nothing(), %% %% exit (with registered name, due to link) - ?line Reason4 = make_ref(), - ?line Proc1 ! {spawn_link_please, Self, MFA}, - ?line Proc4 = receive {spawned, Proc1, P4} -> P4 end, - ?line {trace, Proc1, spawn, Proc4, MFA} = receive_first(), - ?line io:format("Proc4 = ~p ~n", [Proc4]), - ?line {trace, Proc1, link, Proc4} = receive_first(), - ?line Proc1 ! {register_please, Name, Proc1}, - ?line {trace, Proc1, register, Name} = receive_first(), - ?line Proc4 ! {exit_please, Reason4}, - ?line receive {'EXIT', Proc1, Reason4} -> ok end, - ?line {trace, Proc1, exit, Reason4} = receive_first(), - ?line {trace, Proc1, unregister, Name} = receive_first(), - ?line receive_nothing(), + Reason4 = make_ref(), + Proc1 ! {spawn_link_please, Self, MFA}, + Proc4 = receive {spawned, Proc1, P4} -> P4 end, + {trace, Proc1, spawn, Proc4, MFA} = receive_first_trace(), + io:format("Proc4 = ~p ~n", [Proc4]), + {trace, Proc1, link, Proc4} = receive_first_trace(), + Proc1 ! {register_please, Name, Proc1}, + {trace, Proc1, register, Name} = receive_first_trace(), + Proc4 ! {exit_please, Reason4}, + receive {'EXIT', Proc1, Reason4} -> ok end, + {trace, Proc1, exit, Reason4} = receive_first_trace(), + {trace, Proc1, unregister, Name} = receive_first_trace(), + receive_nothing(), %% %% exit (not linked to tracing process) - ?line 1 = erlang:trace(Proc2, true, [procs]), - ?line Reason2 = make_ref(), - ?line Proc2 ! {exit_please, Reason2}, - ?line {trace, Proc2, exit, Reason2} = receive_first(), - ?line receive_nothing(), - %% - %% Done. - ?line test_server:timetrap_cancel(Dog), + 1 = erlang:trace(Proc2, true, [procs]), + Reason2 = make_ref(), + Proc2 ! {exit_please, Reason2}, + {trace, Proc2, exit, Reason2} = receive_first_trace(), + receive_nothing(), ok. dist_procs_trace(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(15)), - ?line OtherName = atom_to_list(?MODULE)++"_dist_procs_trace", - ?line {ok, OtherNode} = start_node(OtherName), - ?line Self = self(), - ?line process_flag(trap_exit, true), + ct:timetrap({seconds, 15}), + OtherName = atom_to_list(?MODULE)++"_dist_procs_trace", + {ok, OtherNode} = start_node(OtherName), + Self = self(), + process_flag(trap_exit, true), %% - ?line Proc1 = spawn_link(?MODULE, process, [Self]), - ?line io:format("Proc1 = ~p ~n", [Proc1]), - ?line Proc2 = spawn(OtherNode, ?MODULE, process, [Self]), - ?line io:format("Proc2 = ~p ~n", [Proc2]), + Proc1 = spawn_link(?MODULE, process, [Self]), + io:format("Proc1 = ~p ~n", [Proc1]), + Proc2 = spawn(OtherNode, ?MODULE, process, [Self]), + io:format("Proc2 = ~p ~n", [Proc2]), %% - ?line 1 = erlang:trace(Proc1, true, [procs]), - ?line MFA = {?MODULE, process, [Self]}, + 1 = erlang:trace(Proc1, true, [procs]), + MFA = {?MODULE, process, [Self]}, %% %% getting_unlinked by exit() - ?line Proc1 ! {spawn_link_please, Self, OtherNode, MFA}, - ?line Proc1 ! {trap_exit_please, true}, - ?line Proc3 = receive {spawned, Proc1, P3} -> P3 end, - ?line io:format("Proc3 = ~p ~n", [Proc3]), - ?line {trace, Proc1, getting_linked, Proc3} = receive_first(), - ?line Reason3 = make_ref(), - ?line Proc1 ! {send_please, Proc3, {exit_please, Reason3}}, - ?line receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end, - ?line {trace, Proc1, getting_unlinked, Proc3} = receive_first(), - ?line Proc1 ! {trap_exit_please, false}, - ?line receive_nothing(), + Proc1 ! {spawn_link_please, Self, OtherNode, MFA}, + Proc1 ! {trap_exit_please, true}, + Proc3 = receive {spawned, Proc1, P3} -> P3 end, + io:format("Proc3 = ~p ~n", [Proc3]), + {trace, Proc1, getting_linked, Proc3} = receive_first_trace(), + Reason3 = make_ref(), + Proc1 ! {send_please, Proc3, {exit_please, Reason3}}, + receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end, + {trace, Proc1, getting_unlinked, Proc3} = receive_first_trace(), + Proc1 ! {trap_exit_please, false}, + receive_nothing(), %% %% link - ?line Proc1 ! {link_please, Proc2}, - ?line {trace, Proc1, link, Proc2} = receive_first(), - ?line receive_nothing(), + Proc1 ! {link_please, Proc2}, + {trace, Proc1, link, Proc2} = receive_first_trace(), + receive_nothing(), %% %% unlink - ?line Proc1 ! {unlink_please, Proc2}, - ?line {trace, Proc1, unlink, Proc2} = receive_first(), - ?line receive_nothing(), + Proc1 ! {unlink_please, Proc2}, + {trace, Proc1, unlink, Proc2} = receive_first_trace(), + receive_nothing(), %% %% getting_linked - ?line Proc2 ! {link_please, Proc1}, - ?line {trace, Proc1, getting_linked, Proc2} = receive_first(), - ?line receive_nothing(), + Proc2 ! {link_please, Proc1}, + {trace, Proc1, getting_linked, Proc2} = receive_first_trace(), + receive_nothing(), %% %% getting_unlinked - ?line Proc2 ! {unlink_please, Proc1}, - ?line {trace, Proc1, getting_unlinked, Proc2} = receive_first(), - ?line receive_nothing(), + Proc2 ! {unlink_please, Proc1}, + {trace, Proc1, getting_unlinked, Proc2} = receive_first_trace(), + receive_nothing(), %% %% exit (with registered name, due to link) - ?line Name = list_to_atom(OtherName), - ?line Reason2 = make_ref(), - ?line Proc1 ! {link_please, Proc2}, - ?line {trace, Proc1, link, Proc2} = receive_first(), - ?line Proc1 ! {register_please, Name, Proc1}, - ?line {trace, Proc1, register, Name} = receive_first(), - ?line Proc2 ! {exit_please, Reason2}, - ?line receive {'EXIT', Proc1, Reason2} -> ok end, - ?line {trace, Proc1, exit, Reason2} = receive_first(), - ?line {trace, Proc1, unregister, Name} = receive_first(), - ?line receive_nothing(), + Name = list_to_atom(OtherName), + Reason2 = make_ref(), + Proc1 ! {link_please, Proc2}, + {trace, Proc1, link, Proc2} = receive_first_trace(), + Proc1 ! {register_please, Name, Proc1}, + {trace, Proc1, register, Name} = receive_first_trace(), + Proc2 ! {exit_please, Reason2}, + receive {'EXIT', Proc1, Reason2} -> ok end, + {trace, Proc1, exit, Reason2} = receive_first_trace(), + {trace, Proc1, unregister, Name} = receive_first_trace(), + receive_nothing(), %% %% Done. - ?line true = stop_node(OtherNode), - ?line test_server:timetrap_cancel(Dog), + true = stop_node(OtherNode), ok. +%% Test trace(new, How, [procs]). +procs_new_trace(Config) when is_list(Config) -> + Self = self(), + process_flag(trap_exit, true), + %% + Proc1 = spawn_link(?MODULE, process, [Self]), + io:format("Proc1 = ~p ~n", [Proc1]), + %% + 0 = erlang:trace(new, true, [procs]), + + MFA = {?MODULE, process, [Self]}, + %% + %% spawn, link + Proc1 ! {spawn_link_please, Self, MFA}, + Proc3 = receive {spawned, Proc1, P3} -> P3 end, + receive {trace, Proc3, spawned, Proc1, MFA} -> ok end, + receive {trace, Proc3, getting_linked, Proc1} -> ok end, + io:format("Proc3 = ~p ~n", [Proc3]), + receive_nothing(), + %% + %% + %% exit (not linked to tracing process) + Reason1 = make_ref(), + Proc1 ! {exit_please, Reason1}, + receive {'EXIT', Proc1, Reason1} -> ok end, + {trace, Proc3, exit, Reason1} = receive_first_trace(), + receive_nothing(), + ok. %% Tests trace(Pid, How, [set_on_spawn]). set_on_spawn(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - ?line Listener = fun_spawn(fun process/0), + Listener = fun_spawn(fun process/0), %% Create and trace a process with the set_on_spawn flag. %% Make sure it is traced. - ?line Father_SOS = fun_spawn(fun process/0), - ?line 1 = erlang:trace(Father_SOS, true, [send, set_on_spawn]), - ?line true = is_send_traced(Father_SOS, Listener, sos_father), + Father_SOS = fun_spawn(fun process/0), + 1 = erlang:trace(Father_SOS, true, [send, set_on_spawn]), + true = is_send_traced(Father_SOS, Listener, sos_father), %% Have the process spawn of two children and test that they %% are traced. - ?line [Child1, Child2] = spawn_children(Father_SOS, 2), - ?line true = is_send_traced(Child1, Listener, child1), - ?line true = is_send_traced(Child2, Listener, child2), + [Child1, Child2] = spawn_children(Father_SOS, 2), + true = is_send_traced(Child1, Listener, child1), + true = is_send_traced(Child2, Listener, child2), %% Second generation. [Child11, Child12] = spawn_children(Child1, 2), - ?line true = is_send_traced(Child11, Listener, child11), - ?line true = is_send_traced(Child12, Listener, child12), - - %% Done. - ?line test_server:timetrap_cancel(Dog), + true = is_send_traced(Child11, Listener, child11), + true = is_send_traced(Child12, Listener, child12), ok. %% Tests trace(Pid, How, [set_on_first_spawn]). set_on_first_spawn(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line Listener = fun_spawn(fun process/0), + ct:timetrap({seconds, 10}), + Listener = fun_spawn(fun process/0), %% Create and trace a process with the set_on_first_spawn flag. %% Make sure it is traced. - ?line Parent = fun_spawn(fun process/0), - ?line 1 = erlang:trace(Parent, true, [send, set_on_first_spawn]), - ?line is_send_traced(Parent, Listener, sos_father), + Parent = fun_spawn(fun process/0), + 1 = erlang:trace(Parent, true, [send, set_on_first_spawn]), + is_send_traced(Parent, Listener, sos_father), %% Have the process spawn off three children and test that the %% first is traced. - ?line [Child1, Child2, Child3] = spawn_children(Parent, 3), - ?line true = is_send_traced(Child1, Listener, child1), - ?line false = is_send_traced(Child2, Listener, child2), - ?line false = is_send_traced(Child3, Listener, child3), - ?line receive_nothing(), + [Child1, Child2, Child3] = spawn_children(Parent, 3), + true = is_send_traced(Child1, Listener, child1), + false = is_send_traced(Child2, Listener, child2), + false = is_send_traced(Child3, Listener, child3), + receive_nothing(), + ok. - %% Done. - ?line test_server:timetrap_cancel(Dog), +%% Tests trace(Pid, How, [set_on_link]). + +set_on_link(Config) -> + Listener = fun_spawn(fun process/0), + + %% Create and trace a process with the set_on_link flag. + %% Make sure it is traced. + Father_SOL = fun_spawn(fun process/0), + 1 = erlang:trace(Father_SOL, true, [send, set_on_link]), + true = is_send_traced(Father_SOL, Listener, sol_father), + + %% Have the process spawn of two children and test that they + %% are traced. + [Child1, Child2] = spawn_children(Father_SOL, 2), + true = is_send_traced(Child1, Listener, child1), + true = is_send_traced(Child2, Listener, child2), + + %% Second generation. + [Child11, Child12] = spawn_children(Child1, 2), + true = is_send_traced(Child11, Listener, child11), + true = is_send_traced(Child12, Listener, child12), + ok. + +%% Tests trace(Pid, How, [set_on_first_spawn]). + +set_on_first_link(Config) -> + ct:timetrap({seconds, 10}), + Listener = fun_spawn(fun process/0), + + %% Create and trace a process with the set_on_first_spawn flag. + %% Make sure it is traced. + Parent = fun_spawn(fun process/0), + 1 = erlang:trace(Parent, true, [send, set_on_first_link]), + is_send_traced(Parent, Listener, sol_father), + + %% Have the process spawn off three children and test that the + %% first is traced. + [Child1, Child2, Child3] = spawn_children(Parent, 3), + true = is_send_traced(Child1, Listener, child1), + false = is_send_traced(Child2, Listener, child2), + false = is_send_traced(Child3, Listener, child3), + receive_nothing(), ok. -system_monitor_args(doc) -> - ["Tests arguments to erlang:system_monitor/0-2)"]; + +%% Tests arguments to erlang:system_monitor/0,1,2 system_monitor_args(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - ?line Self = self(), + Self = self(), %% - ?line OldMonitor = erlang:system_monitor(undefined), - ?line undefined = erlang:system_monitor(Self, [{long_gc,0}]), - ?line MinT = case erlang:system_monitor() of - {Self,[{long_gc,T}]} when is_integer(T), T > 0 -> T; - Other1 -> test_server:fault(Other1) - end, - ?line {Self,[{long_gc,MinT}]} = erlang:system_monitor(), - ?line {Self,[{long_gc,MinT}]} = - erlang:system_monitor({Self,[{large_heap,0}]}), - ?line MinN = case erlang:system_monitor() of - {Self,[{large_heap,N}]} when is_integer(N), N > 0 -> N; - Other2 -> test_server:fault(Other2) - end, - ?line {Self,[{large_heap,MinN}]} = erlang:system_monitor(), - ?line {Self,[{large_heap,MinN}]} = - erlang:system_monitor(Self, [busy_port]), - ?line {Self,[busy_port]} = erlang:system_monitor(), - ?line {Self,[busy_port]} = - erlang:system_monitor({Self,[busy_dist_port]}), - ?line {Self,[busy_dist_port]} = erlang:system_monitor(), - ?line All = lists:sort([busy_port,busy_dist_port, - {long_gc,1},{large_heap,65535}]), - ?line {Self,[busy_dist_port]} = erlang:system_monitor(Self, All), - ?line {Self,A1} = erlang:system_monitor(), - ?line All = lists:sort(A1), - ?line {Self,A1} = erlang:system_monitor(Self, []), - ?line Pid = spawn(fun () -> receive {Self,die} -> exit(die) end end), - ?line Mref = erlang:monitor(process, Pid), - ?line undefined = erlang:system_monitor(Pid, All), - ?line {Pid,A2} = erlang:system_monitor(), - ?line All = lists:sort(A2), - ?line Pid ! {Self,die}, - ?line receive {'DOWN',Mref,_,_,_} -> ok end, - ?line undefined = erlang:system_monitor(OldMonitor), - ?line erlang:yield(), - ?line OldMonitor = erlang:system_monitor(), + OldMonitor = erlang:system_monitor(undefined), + undefined = erlang:system_monitor(Self, [{long_gc,0}]), + MinT = case erlang:system_monitor() of + {Self,[{long_gc,T}]} when is_integer(T), T > 0 -> T; + Other1 -> test_server:fault(Other1) + end, + {Self,[{long_gc,MinT}]} = erlang:system_monitor(), + {Self,[{long_gc,MinT}]} = + erlang:system_monitor({Self,[{large_heap,0}]}), + MinN = case erlang:system_monitor() of + {Self,[{large_heap,N}]} when is_integer(N), N > 0 -> N; + Other2 -> test_server:fault(Other2) + end, + {Self,[{large_heap,MinN}]} = erlang:system_monitor(), + {Self,[{large_heap,MinN}]} = + erlang:system_monitor(Self, [busy_port]), + {Self,[busy_port]} = erlang:system_monitor(), + {Self,[busy_port]} = + erlang:system_monitor({Self,[busy_dist_port]}), + {Self,[busy_dist_port]} = erlang:system_monitor(), + All = lists:sort([busy_port,busy_dist_port, + {long_gc,1},{large_heap,65535}]), + {Self,[busy_dist_port]} = erlang:system_monitor(Self, All), + {Self,A1} = erlang:system_monitor(), + All = lists:sort(A1), + {Self,A1} = erlang:system_monitor(Self, []), + Pid = spawn(fun () -> receive {Self,die} -> exit(die) end end), + Mref = erlang:monitor(process, Pid), + undefined = erlang:system_monitor(Pid, All), + {Pid,A2} = erlang:system_monitor(), + All = lists:sort(A2), + Pid ! {Self,die}, + receive {'DOWN',Mref,_,_,_} -> ok end, + undefined = erlang:system_monitor(OldMonitor), + erlang:yield(), + OldMonitor = erlang:system_monitor(), %% - ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor(atom)), - ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor({})), - ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1})), - ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1,2,3})), - ?line {'EXIT',{badarg,_}} = - (catch erlang:system_monitor({Self,atom})), - ?line {'EXIT',{badarg,_}} = - (catch erlang:system_monitor(atom, atom)), - ?line {'EXIT',{badarg,_}} = - (catch erlang:system_monitor({Self,[busy_port|busy_dist_port]})), - ?line {'EXIT',{badarg,_}} = - (catch erlang:system_monitor(Self, [{long_gc,-1}])), - ?line {'EXIT',{badarg,_}} = - (catch erlang:system_monitor({Self,[{long_gc,atom}]})), - ?line {'EXIT',{badarg,_}} = - (catch erlang:system_monitor(Self,[{large_heap,-1}])), - ?line {'EXIT',{badarg,_}} = - (catch erlang:system_monitor({Self,[{large_heap,atom}]})), - %% Done. - ?line test_server:timetrap_cancel(Dog), + {'EXIT',{badarg,_}} = (catch erlang:system_monitor(atom)), + {'EXIT',{badarg,_}} = (catch erlang:system_monitor({})), + {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1})), + {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1,2,3})), + {'EXIT',{badarg,_}} = + (catch erlang:system_monitor({Self,atom})), + {'EXIT',{badarg,_}} = + (catch erlang:system_monitor(atom, atom)), + {'EXIT',{badarg,_}} = + (catch erlang:system_monitor({Self,[busy_port|busy_dist_port]})), + {'EXIT',{badarg,_}} = + (catch erlang:system_monitor(Self, [{long_gc,-1}])), + {'EXIT',{badarg,_}} = + (catch erlang:system_monitor({Self,[{long_gc,atom}]})), + {'EXIT',{badarg,_}} = + (catch erlang:system_monitor(Self,[{large_heap,-1}])), + {'EXIT',{badarg,_}} = + (catch erlang:system_monitor({Self,[{large_heap,atom}]})), ok. -more_system_monitor_args(doc) -> - ["Tests arguments to erlang:system_monitor/0-2)"]; +%% Tests arguments to erlang:system_monitor/0,1,2 more_system_monitor_args(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - - ?line try_l(64000), - ?line try_l(16#7ffffff), - ?line try_l(16#3fffffff), - ?line try_l(16#7fffffff), - ?line try_l(16#ffffffff), - - %% Done. - ?line test_server:timetrap_cancel(Dog), + try_l(64000), + try_l(16#7ffffff), + try_l(16#3fffffff), + try_l(16#7fffffff), + try_l(16#ffffffff), ok. try_l(Val) -> @@ -523,29 +653,29 @@ try_l(Val) -> Arbitrary1 = 77777, Arbitrary2 = 88888, - ?line erlang:system_monitor(undefined), + erlang:system_monitor(undefined), - ?line undefined = erlang:system_monitor(Self, [{long_gc,Val},{large_heap,Arbitrary1}]), + undefined = erlang:system_monitor(Self, [{long_gc,Val},{large_heap,Arbitrary1}]), - ?line {Self,Comb0} = erlang:system_monitor(Self, [{long_gc,Arbitrary2},{large_heap,Val}]), - ?line [{large_heap,Arbitrary1},{long_gc,Val}] = lists:sort(Comb0), + {Self,Comb0} = erlang:system_monitor(Self, [{long_gc,Arbitrary2},{large_heap,Val}]), + [{large_heap,Arbitrary1},{long_gc,Val}] = lists:sort(Comb0), - ?line {Self,Comb1} = erlang:system_monitor(undefined), - ?line [{large_heap,Val},{long_gc,Arbitrary2}] = lists:sort(Comb1). + {Self,Comb1} = erlang:system_monitor(undefined), + [{large_heap,Val},{long_gc,Arbitrary2}] = lists:sort(Comb1). monitor_sys(Parent) -> receive - {monitor,Pid,long_schedule,Data} when is_pid(Pid) -> - io:format("Long schedule of ~w: ~w~n",[Pid,Data]), - Parent ! {Pid,Data}, - monitor_sys(Parent); - {monitor,Port,long_schedule,Data} when is_port(Port) -> - {name,Name} = erlang:port_info(Port,name), - io:format("Long schedule of ~w (~p): ~w~n",[Port,Name,Data]), - Parent ! {Port,Data}, - monitor_sys(Parent); - Other -> - erlang:display(Other) + {monitor,Pid,long_schedule,Data} when is_pid(Pid) -> + io:format("Long schedule of ~w: ~w~n",[Pid,Data]), + Parent ! {Pid,Data}, + monitor_sys(Parent); + {monitor,Port,long_schedule,Data} when is_port(Port) -> + {name,Name} = erlang:port_info(Port,name), + io:format("Long schedule of ~w (~p): ~w~n",[Port,Name,Data]), + Parent ! {Port,Data}, + monitor_sys(Parent); + Other -> + erlang:display(Other) end. start_monitor() -> @@ -555,18 +685,15 @@ start_monitor() -> erlang:yield(), % Need to be rescheduled for the trace to take ok. -system_monitor_long_schedule(suite) -> - []; -system_monitor_long_schedule(doc) -> - ["Tests erlang:system_monitor(Pid, [{long_schedule,Time}])"]; +%% Tests erlang:system_monitor(Pid, [{long_schedule,Time}]) system_monitor_long_schedule(Config) when is_list(Config) -> - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), erl_ddll:start(), case (catch load_driver(Path, slow_drv)) of - ok -> - do_system_monitor_long_schedule(); - _Error -> - {skip, "Unable to load slow_drv (windows or no usleep()?)"} + ok -> + do_system_monitor_long_schedule(); + _Error -> + {skip, "Unable to load slow_drv (windows or no usleep()?)"} end. do_system_monitor_long_schedule() -> start_monitor(), @@ -574,18 +701,18 @@ do_system_monitor_long_schedule() -> "ok" = erlang:port_control(Port,0,[]), Self = self(), receive - {Self,L} when is_list(L) -> - ok + {Self,L} when is_list(L) -> + ok after 1000 -> - ?t:fail(no_trace_of_pid) + ct:fail(no_trace_of_pid) end, "ok" = erlang:port_control(Port,1,[]), "ok" = erlang:port_control(Port,2,[]), receive - {Port,LL} when is_list(LL) -> - ok + {Port,LL} when is_list(LL) -> + ok after 1000 -> - ?t:fail(no_trace_of_port) + ct:fail(no_trace_of_port) end, port_close(Port), erlang:system_monitor(undefined), @@ -594,214 +721,200 @@ do_system_monitor_long_schedule() -> -define(LONG_GC_SLEEP, 670). -system_monitor_long_gc_1(suite) -> - []; -system_monitor_long_gc_1(doc) -> - ["Tests erlang:system_monitor(Pid, [{long_gc,Time}])"]; +%% Tests erlang:system_monitor(Pid, [{long_gc,Time}]) system_monitor_long_gc_1(Config) when is_list(Config) -> erts_debug:set_internal_state(available_internal_state, true), try - case erts_debug:get_internal_state(force_heap_frags) of - true -> - {skip,"emulator with FORCE_HEAP_FRAGS defined"}; - false -> - %% Add ?LONG_GC_SLEEP ms to all gc - ?line erts_debug:set_internal_state(test_long_gc_sleep, - ?LONG_GC_SLEEP), - ?line LoadFun = fun () -> - garbage_collect(), - self() - end, - ?line long_gc(LoadFun, false) - end + case erts_debug:get_internal_state(force_heap_frags) of + true -> + {skip,"emulator with FORCE_HEAP_FRAGS defined"}; + false -> + %% Add ?LONG_GC_SLEEP ms to all gc + erts_debug:set_internal_state(test_long_gc_sleep, + ?LONG_GC_SLEEP), + LoadFun = fun () -> + garbage_collect(), + self() + end, + long_gc(LoadFun, false) + end after - erts_debug:set_internal_state(test_long_gc_sleep, 0), - erts_debug:set_internal_state(available_internal_state, false) + erts_debug:set_internal_state(test_long_gc_sleep, 0), + erts_debug:set_internal_state(available_internal_state, false) end. -system_monitor_long_gc_2(suite) -> - []; -system_monitor_long_gc_2(doc) -> - ["Tests erlang:system_monitor(Pid, [{long_gc,Time}])"]; +%% Tests erlang:system_monitor(Pid, [{long_gc,Time}]) system_monitor_long_gc_2(Config) when is_list(Config) -> erts_debug:set_internal_state(available_internal_state, true), try - case erts_debug:get_internal_state(force_heap_frags) of - true -> - {skip,"emulator with FORCE_HEAP_FRAGS defined"}; - false -> - %% Add ?LONG_GC_SLEEP ms to all gc - ?line erts_debug:set_internal_state(test_long_gc_sleep, - ?LONG_GC_SLEEP), - ?line Parent = self(), - ?line LoadFun = - fun () -> - Ref = make_ref(), - Pid = - spawn_link( - fun () -> - garbage_collect(), - Parent ! {Ref, self()} - end), - receive {Ref, Pid} -> Pid end - end, - ?line long_gc(LoadFun, true), - ?line long_gc(LoadFun, true), - ?line long_gc(LoadFun, true) - end + case erts_debug:get_internal_state(force_heap_frags) of + true -> + {skip,"emulator with FORCE_HEAP_FRAGS defined"}; + false -> + %% Add ?LONG_GC_SLEEP ms to all gc + erts_debug:set_internal_state(test_long_gc_sleep, + ?LONG_GC_SLEEP), + Parent = self(), + LoadFun = + fun () -> + Ref = make_ref(), + Pid = + spawn_link( + fun () -> + garbage_collect(), + Parent ! {Ref, self()} + end), + receive {Ref, Pid} -> Pid end + end, + long_gc(LoadFun, true), + long_gc(LoadFun, true), + long_gc(LoadFun, true) + end after - erts_debug:set_internal_state(test_long_gc_sleep, 0), - erts_debug:set_internal_state(available_internal_state, false) + erts_debug:set_internal_state(test_long_gc_sleep, 0), + erts_debug:set_internal_state(available_internal_state, false) end. long_gc(LoadFun, ExpectMonMsg) -> - ?line Self = self(), - ?line Time = 1, - ?line OldMonitor = erlang:system_monitor(Self, [{long_gc,Time}]), - ?line Pid = LoadFun(), - ?line Ref = erlang:trace_delivered(Pid), - ?line receive {trace_delivered, Pid, Ref} -> ok end, - ?line {Self,[{long_gc,Time}]} = erlang:system_monitor(OldMonitor), - ?line case {long_gc_check(Pid, Time, undefined), ExpectMonMsg} of - {ok, true} when Pid =/= Self -> - ok; - {ok, false} -> - ?line ?t:fail(unexpected_system_monitor_message_received); - {undefined, false} -> - ok; - {undefined, true} -> - ?line ?t:fail(no_system_monitor_message_received) - end. + Self = self(), + Time = 1, + OldMonitor = erlang:system_monitor(Self, [{long_gc,Time}]), + Pid = LoadFun(), + Ref = erlang:trace_delivered(Pid), + receive {trace_delivered, Pid, Ref} -> ok end, + {Self,[{long_gc,Time}]} = erlang:system_monitor(OldMonitor), + case {long_gc_check(Pid, Time, undefined), ExpectMonMsg} of + {ok, true} when Pid =/= Self -> + ok; + {ok, false} -> + ct:fail(unexpected_system_monitor_message_received); + {undefined, false} -> + ok; + {undefined, true} -> + ct:fail(no_system_monitor_message_received) + end. long_gc_check(Pid, Time, Result) -> receive - {monitor,Pid,long_gc,L} = Monitor -> - case lists:foldl( - fun (_, error) -> - error; - ({timeout,T}, N) when is_integer(T), - Time =< T, T =< 10*?LONG_GC_SLEEP -> - %% OTP-7622. The time T must be within reasonable limits - %% for the test to pass. - N-1; - ({heap_size,_}, N) -> - N-1; - ({old_heap_size,_}, N) -> - N-1; - ({stack_size,_}, N) -> - N-1; - ({mbuf_size,_}, N) -> - N-1; - ({heap_block_size,_}, N) -> - N-1; - ({old_heap_block_size,_}, N) -> - N-1; - (_, _) -> - error - end, 7, L) of - 0 -> - long_gc_check(Pid, Time, ok); - error -> - {error,Monitor} - end; - {monitor,_,long_gc,_} -> - long_gc_check(Pid, Time, Result); - Other -> - {error,Other} + {monitor,Pid,long_gc,L} = Monitor -> + case lists:foldl( + fun (_, error) -> + error; + ({timeout,T}, N) when is_integer(T), + Time =< T, T =< 10*?LONG_GC_SLEEP -> + %% OTP-7622. The time T must be within reasonable limits + %% for the test to pass. + N-1; + ({heap_size,_}, N) -> + N-1; + ({old_heap_size,_}, N) -> + N-1; + ({stack_size,_}, N) -> + N-1; + ({mbuf_size,_}, N) -> + N-1; + ({heap_block_size,_}, N) -> + N-1; + ({old_heap_block_size,_}, N) -> + N-1; + (_, _) -> + error + end, 7, L) of + 0 -> + long_gc_check(Pid, Time, ok); + error -> + {error,Monitor} + end; + {monitor,_,long_gc,_} -> + long_gc_check(Pid, Time, Result); + Other -> + {error,Other} after 0 -> - Result + Result end. -system_monitor_large_heap_1(suite) -> - []; -system_monitor_large_heap_1(doc) -> - ["Tests erlang:system_monitor(Pid, [{large_heap,Size}])"]; +%% Tests erlang:system_monitor(Pid, [{large_heap,Size}]) system_monitor_large_heap_1(Config) when is_list(Config) -> - ?line LoadFun = - fun (Size) -> - List = seq(1,2*Size), - garbage_collect(), - true = lists:prefix([1], List), - self() - end, - ?line large_heap(LoadFun, false). - -system_monitor_large_heap_2(suite) -> - []; -system_monitor_large_heap_2(doc) -> - ["Tests erlang:system_monitor(Pid, [{large_heap,Size}])"]; + LoadFun = + fun (Size) -> + List = seq(1,2*Size), + garbage_collect(), + true = lists:prefix([1], List), + self() + end, + large_heap(LoadFun, false). + +%% Tests erlang:system_monitor(Pid, [{large_heap,Size}]) system_monitor_large_heap_2(Config) when is_list(Config) -> - ?line Parent = self(), - ?line LoadFun = - fun (Size) -> - Ref = make_ref(), - Pid = - spawn_opt(fun () -> - garbage_collect(), - Parent ! {Ref, self()} - end, - [link, {min_heap_size, 2*Size}]), - receive {Ref, Pid} -> Pid end - end, - ?line large_heap(LoadFun, true). + Parent = self(), + LoadFun = + fun (Size) -> + Ref = make_ref(), + Pid = + spawn_opt(fun () -> + garbage_collect(), + Parent ! {Ref, self()} + end, + [link, {min_heap_size, 2*Size}]), + receive {Ref, Pid} -> Pid end + end, + large_heap(LoadFun, true). large_heap(LoadFun, ExpectMonMsg) -> - ?line Dog = test_server:timetrap(test_server:seconds(20)), + ct:timetrap({seconds, 20}), %% - ?line Size = 65535, - ?line Self = self(), - ?line NewMonitor = {Self,[{large_heap,Size}]}, - ?line OldMonitor = erlang:system_monitor(NewMonitor), - ?line Pid = LoadFun(Size), - ?line Ref = erlang:trace_delivered(Pid), - ?line receive {trace_delivered, Pid, Ref} -> ok end, - ?line {Self,[{large_heap,Size}]} = erlang:system_monitor(OldMonitor), - ?line case {large_heap_check(Pid, Size, undefined), ExpectMonMsg} of - {ok, true} when Pid =/= Self -> - ?line ok; - {ok, false} -> - ?line ?t:fail(unexpected_system_monitor_message_received); - {undefined, false} -> - ?line ok; - {undefined, true} -> - ?line ?t:fail(no_system_monitor_message_received) - end, - %% - ?line test_server:timetrap_cancel(Dog), + Size = 65535, + Self = self(), + NewMonitor = {Self,[{large_heap,Size}]}, + OldMonitor = erlang:system_monitor(NewMonitor), + Pid = LoadFun(Size), + Ref = erlang:trace_delivered(Pid), + receive {trace_delivered, Pid, Ref} -> ok end, + {Self,[{large_heap,Size}]} = erlang:system_monitor(OldMonitor), + case {large_heap_check(Pid, Size, undefined), ExpectMonMsg} of + {ok, true} when Pid =/= Self -> + ok; + {ok, false} -> + ct:fail(unexpected_system_monitor_message_received); + {undefined, false} -> + ok; + {undefined, true} -> + ct:fail(no_system_monitor_message_received) + end, ok. large_heap_check(Pid, Size, Result) -> receive - {monitor,Pid,large_heap,L} = Monitor -> - case lists:foldl( - fun (_, error) -> - error; - ({heap_size,_}, N) -> - N-1; - ({old_heap_size,_}, N) -> - N-1; - ({stack_size,_}, N) -> - N-1; - ({mbuf_size,_}, N) -> - N-1; - ({heap_block_size,_}, N) -> - N-1; - ({old_heap_block_size,_}, N) -> - N-1; - (_, _) -> - error - end, 6, L) of - 0 -> - large_heap_check(Pid, Size, ok); - error -> - {error,Monitor} - end; - {monitor,_,large_heap,_} -> - large_heap_check(Pid, Size, Result); - Other -> - {error,Other} + {monitor,Pid,large_heap,L} = Monitor -> + case lists:foldl( + fun (_, error) -> + error; + ({heap_size,_}, N) -> + N-1; + ({old_heap_size,_}, N) -> + N-1; + ({stack_size,_}, N) -> + N-1; + ({mbuf_size,_}, N) -> + N-1; + ({heap_block_size,_}, N) -> + N-1; + ({old_heap_block_size,_}, N) -> + N-1; + (_, _) -> + error + end, 6, L) of + 0 -> + large_heap_check(Pid, Size, ok); + error -> + {error,Monitor} + end; + {monitor,_,large_heap,_} -> + large_heap_check(Pid, Size, Result); + Other -> + {error,Other} after 0 -> - Result + Result end. seq(N, M) -> @@ -816,11 +929,11 @@ seq(N, M, R) -> is_send_traced(Pid, Listener, Msg) -> Pid ! {send_please, Listener, Msg}, receive - Any -> - {trace, Pid, send, Msg, Listener} = Any, - true + Any -> + {trace, Pid, send, Msg, Listener} = Any, + true after 1000 -> - false + false end. %% This procedure assumes that the Parent process is send traced. @@ -834,146 +947,131 @@ spawn_children(Parent, Number, Result) -> Self = self(), Parent ! {spawn_please, Self, fun process/0}, Child = - receive - {trace, Parent, send, {spawned, Pid}, Self} -> Pid - end, receive - {spawned, Child} -> - spawn_children(Parent, Number-1, [Child|Result]) + {trace, Parent, send, {spawned, Pid}, Self} -> Pid + end, + receive + {spawned, Child} -> + spawn_children(Parent, Number-1, [Child|Result]) end. -suspend(doc) -> "Test erlang:suspend/1 and erlang:resume/1."; +%% Test erlang:suspend/1 and erlang:resume/1. suspend(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(2)), - - ?line Worker = fun_spawn(fun worker/0), + ct:timetrap({minutes,2}), + Worker = fun_spawn(fun worker/0), %% Suspend a process and test that it is suspended. - ?line ok = do_suspend(Worker, 10000), - - %% Done. - ?line test_server:timetrap_cancel(Dog), + ok = do_suspend(Worker, 10000), ok. do_suspend(_Pid, 0) -> - ?line ok; + ok; do_suspend(Pid, N) -> %% Suspend a process and test that it is suspended. - ?line true = erlang:suspend_process(Pid), - ?line {status, suspended} = process_info(Pid, status), + true = erlang:suspend_process(Pid), + {status, suspended} = process_info(Pid, status), %% Unsuspend the process and make sure it starts working. - ?line true = erlang:resume_process(Pid), - ?line case process_info(Pid, status) of - {status, runnable} -> ?line ok; - {status, running} -> ?line ok; - {status, garbage_collecting} -> ?line ok; - ST -> ?line ?t:fail(ST) - end, - ?line erlang:yield(), - ?line do_suspend(Pid, N-1). - - - -mutual_suspend(doc) -> - []; -mutual_suspend(suite) -> - []; + true = erlang:resume_process(Pid), + case process_info(Pid, status) of + {status, runnable} -> ok; + {status, running} -> ok; + {status, garbage_collecting} -> ok; + ST -> ct:fail(ST) + end, + erlang:yield(), + do_suspend(Pid, N-1). + + + mutual_suspend(Config) when is_list(Config) -> - ?line TimeoutSecs = 5*60, - ?line Dog = test_server:timetrap(test_server:minutes(TimeoutSecs)), - ?line Parent = self(), - ?line Fun = fun () -> - receive - {go, Pid} -> - do_mutual_suspend(Pid, 100000) - end, - Parent ! {done, self()}, - receive after infinity -> ok end - end, - ?line P1 = spawn_link(Fun), - ?line P2 = spawn_link(Fun), - ?line T1 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops), - ?line T2 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops), - ?line P1 ! {go, P2}, - ?line P2 ! {go, P1}, - ?line Res1 = receive - {done, P1} -> done; - {timeout,T1,_} -> timeout - end, - ?line Res2 = receive - {done, P2} -> done; - {timeout,T2,_} -> timeout - end, - ?line P1S = process_info(P1, status), - ?line P2S = process_info(P2, status), - ?line ?t:format("P1S=~p P2S=~p", [P1S, P2S]), - ?line false = {status, suspended} == P1S, - ?line false = {status, suspended} == P2S, - ?line unlink(P1), exit(P1, bang), - ?line unlink(P2), exit(P2, bang), - ?line done = Res1, - ?line done = Res2, - %% Done. - ?line test_server:timetrap_cancel(Dog), - ?line ok. - + TimeoutSecs = 5*60, + ct:timetrap({seconds, TimeoutSecs}), + Parent = self(), + Fun = fun () -> + receive + {go, Pid} -> + do_mutual_suspend(Pid, 100000) + end, + Parent ! {done, self()}, + receive after infinity -> ok end + end, + P1 = spawn_link(Fun), + P2 = spawn_link(Fun), + T1 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops), + T2 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops), + P1 ! {go, P2}, + P2 ! {go, P1}, + Res1 = receive + {done, P1} -> done; + {timeout,T1,_} -> timeout + end, + Res2 = receive + {done, P2} -> done; + {timeout,T2,_} -> timeout + end, + P1S = process_info(P1, status), + P2S = process_info(P2, status), + io:format("P1S=~p P2S=~p", [P1S, P2S]), + false = {status, suspended} == P1S, + false = {status, suspended} == P2S, + unlink(P1), exit(P1, bang), + unlink(P2), exit(P2, bang), + done = Res1, + done = Res2, + ok. + do_mutual_suspend(_Pid, 0) -> - ?line ok; + ok; do_mutual_suspend(Pid, N) -> %% Suspend a process and test that it is suspended. - ?line true = erlang:suspend_process(Pid), - ?line {status, suspended} = process_info(Pid, status), + true = erlang:suspend_process(Pid), + {status, suspended} = process_info(Pid, status), %% Unsuspend the process. - ?line true = erlang:resume_process(Pid), - ?line do_mutual_suspend(Pid, N-1). + true = erlang:resume_process(Pid), + do_mutual_suspend(Pid, N-1). -suspend_exit(doc) -> - []; -suspend_exit(suite) -> - []; suspend_exit(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(2)), - ?line random:seed(4711,17,4711), - ?line do_suspend_exit(5000), - ?line test_server:timetrap_cancel(Dog), - ?line ok. + ct:timetrap({minutes, 2}), + rand:seed(exsplus, {4711,17,4711}), + do_suspend_exit(5000), + ok. do_suspend_exit(0) -> - ?line ok; + ok; do_suspend_exit(N) -> - ?line Work = random:uniform(50), - ?line Parent = self(), - ?line {Suspendee, Mon2} - = spawn_monitor(fun () -> - suspend_exit_work(Work), - exit(normal) - end), - ?line {Suspender, Mon1} - = spawn_monitor( - fun () -> - suspend_exit_work(Work div 2), - Parent ! {doing_suspend, self()}, - case catch erlang:suspend_process(Suspendee) of - {'EXIT', _} -> - ok; - true -> - ?line erlang:resume_process(Suspendee) - end - end), - ?line receive - {doing_suspend, Suspender} -> - case N rem 2 of - 0 -> exit(Suspender, bang); - 1 -> ok - end - end, - ?line receive {'DOWN', Mon1, process, Suspender, _} -> ok end, - ?line receive {'DOWN', Mon2, process, Suspendee, _} -> ok end, - ?line do_suspend_exit(N-1). - - - - + Work = rand:uniform(50), + Parent = self(), + {Suspendee, Mon2} + = spawn_monitor(fun () -> + suspend_exit_work(Work), + exit(normal) + end), + {Suspender, Mon1} + = spawn_monitor( + fun () -> + suspend_exit_work(Work div 2), + Parent ! {doing_suspend, self()}, + case catch erlang:suspend_process(Suspendee) of + {'EXIT', _} -> + ok; + true -> + erlang:resume_process(Suspendee) + end + end), + receive + {doing_suspend, Suspender} -> + case N rem 2 of + 0 -> exit(Suspender, bang); + 1 -> ok + end + end, + receive {'DOWN', Mon1, process, Suspender, _} -> ok end, + receive {'DOWN', Mon2, process, Suspendee, _} -> ok end, + do_suspend_exit(N-1). + + + + suspend_exit_work(0) -> ok; suspend_exit_work(N) -> @@ -985,320 +1083,305 @@ suspend_exit_work(N) -> chk_suspended(P, Bool, Line) -> {Bool, Line} = {({status, suspended} == process_info(P, status)), Line}. -suspender_exit(doc) -> - []; -suspender_exit(suite) -> - []; suspender_exit(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(3)), - ?line P1 = spawn_link(fun () -> receive after infinity -> ok end end), - ?line {'EXIT', _} = (catch erlang:resume_process(P1)), - ?line {P2, M2} = spawn_monitor( - fun () -> - ?CHK_SUSPENDED(P1, false), - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - erlang:suspend_process(P1), - erlang:suspend_process(P1), - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - erlang:resume_process(P1), - erlang:resume_process(P1), - erlang:resume_process(P1), - ?CHK_SUSPENDED(P1, true), - erlang:resume_process(P1), - ?CHK_SUSPENDED(P1, false), - erlang:suspend_process(P1), - erlang:suspend_process(P1), - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - exit(bang) - end), - ?line receive - {'DOWN', M2,process,P2,R2} -> - ?line bang = R2, - ?line ?CHK_SUSPENDED(P1, false) - end, - ?line Parent = self(), - ?line {P3, M3} = spawn_monitor( - fun () -> - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - Parent ! self(), - receive after infinity -> ok end - end), - ?line {P4, M4} = spawn_monitor( - fun () -> - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - Parent ! self(), - receive after infinity -> ok end - end), - ?line {P5, M5} = spawn_monitor( - fun () -> - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - Parent ! self(), - receive after infinity -> ok end - end), - ?line {P6, M6} = spawn_monitor( - fun () -> - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - Parent ! self(), - receive after infinity -> ok end - end), - ?line {P7, M7} = spawn_monitor( - fun () -> - erlang:suspend_process(P1), - ?CHK_SUSPENDED(P1, true), - Parent ! self(), - receive after infinity -> ok end - end), - ?line receive P3 -> ok end, - ?line receive P4 -> ok end, - ?line receive P5 -> ok end, - ?line receive P6 -> ok end, - ?line receive P7 -> ok end, - ?line ?CHK_SUSPENDED(P1, true), - ?line exit(P3, bang), - ?line receive - {'DOWN',M3,process,P3,R3} -> - ?line bang = R3, - ?line ?CHK_SUSPENDED(P1, true) - end, - ?line exit(P4, bang), - ?line receive - {'DOWN',M4,process,P4,R4} -> - ?line bang = R4, - ?line ?CHK_SUSPENDED(P1, true) - end, - ?line exit(P5, bang), - ?line receive - {'DOWN',M5,process,P5,R5} -> - ?line bang = R5, - ?line ?CHK_SUSPENDED(P1, true) - end, - ?line exit(P6, bang), - ?line receive - {'DOWN',M6,process,P6,R6} -> - ?line bang = R6, - ?line ?CHK_SUSPENDED(P1, true) - end, - ?line exit(P7, bang), - ?line receive - {'DOWN',M7,process,P7,R7} -> - ?line bang = R7, - ?line ?CHK_SUSPENDED(P1, false) - end, - ?line unlink(P1), - ?line exit(P1, bong), - ?line test_server:timetrap_cancel(Dog), - ?line ok. - -suspend_system_limit(doc) -> - []; -suspend_system_limit(suite) -> - []; + ct:timetrap({minutes, 3}), + P1 = spawn_link(fun () -> receive after infinity -> ok end end), + {'EXIT', _} = (catch erlang:resume_process(P1)), + {P2, M2} = spawn_monitor( + fun () -> + ?CHK_SUSPENDED(P1, false), + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + erlang:suspend_process(P1), + erlang:suspend_process(P1), + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + erlang:resume_process(P1), + erlang:resume_process(P1), + erlang:resume_process(P1), + ?CHK_SUSPENDED(P1, true), + erlang:resume_process(P1), + ?CHK_SUSPENDED(P1, false), + erlang:suspend_process(P1), + erlang:suspend_process(P1), + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + exit(bang) + end), + receive + {'DOWN', M2,process,P2,R2} -> + bang = R2, + ?CHK_SUSPENDED(P1, false) + end, + Parent = self(), + {P3, M3} = spawn_monitor( + fun () -> + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + Parent ! self(), + receive after infinity -> ok end + end), + {P4, M4} = spawn_monitor( + fun () -> + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + Parent ! self(), + receive after infinity -> ok end + end), + {P5, M5} = spawn_monitor( + fun () -> + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + Parent ! self(), + receive after infinity -> ok end + end), + {P6, M6} = spawn_monitor( + fun () -> + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + Parent ! self(), + receive after infinity -> ok end + end), + {P7, M7} = spawn_monitor( + fun () -> + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + Parent ! self(), + receive after infinity -> ok end + end), + receive P3 -> ok end, + receive P4 -> ok end, + receive P5 -> ok end, + receive P6 -> ok end, + receive P7 -> ok end, + ?CHK_SUSPENDED(P1, true), + exit(P3, bang), + receive + {'DOWN',M3,process,P3,R3} -> + bang = R3, + ?CHK_SUSPENDED(P1, true) + end, + exit(P4, bang), + receive + {'DOWN',M4,process,P4,R4} -> + bang = R4, + ?CHK_SUSPENDED(P1, true) + end, + exit(P5, bang), + receive + {'DOWN',M5,process,P5,R5} -> + bang = R5, + ?CHK_SUSPENDED(P1, true) + end, + exit(P6, bang), + receive + {'DOWN',M6,process,P6,R6} -> + bang = R6, + ?CHK_SUSPENDED(P1, true) + end, + exit(P7, bang), + receive + {'DOWN',M7,process,P7,R7} -> + bang = R7, + ?CHK_SUSPENDED(P1, false) + end, + unlink(P1), + exit(P1, bong), + ok. + suspend_system_limit(Config) when is_list(Config) -> case os:getenv("ERL_EXTREME_TESTING") of - "true" -> - ?line Dog = test_server:timetrap(test_server:minutes(3*60)), - ?line P = spawn_link(fun () -> receive after infinity -> ok end end), - ?line suspend_until_system_limit(P), - ?line unlink(P), - ?line exit(P, bye), - ?line test_server:timetrap_cancel(Dog), - ?line ok; - _ -> - {skip, "Takes too long time for normal testing"} + "true" -> + ct:timetrap({minutes, 3*60}), + P = spawn_link(fun () -> receive after infinity -> ok end end), + suspend_until_system_limit(P), + unlink(P), + exit(P, bye), + ok; + _ -> + {skip, "Takes too long time for normal testing"} end. suspend_until_system_limit(P) -> - ?line suspend_until_system_limit(P, 0, 0). + suspend_until_system_limit(P, 0, 0). suspend_until_system_limit(P, N, M) -> NewM = case M of - 1 -> - ?line ?CHK_SUSPENDED(P, true), 2; - 1000000 -> - erlang:display(N), 1; - _ -> - M+1 - end, - ?line case catch erlang:suspend_process(P) of - true -> - suspend_until_system_limit(P, N+1, NewM); - {'EXIT', R} when R == system_limit; - element(1, R) == system_limit -> - ?line ?t:format("system limit at ~p~n", [N]), - ?line resume_from_system_limit(P, N, 0); - Error -> - ?line ?t:fail(Error) - end. + 1 -> + ?CHK_SUSPENDED(P, true), 2; + 1000000 -> + erlang:display(N), 1; + _ -> + M+1 + end, + case catch erlang:suspend_process(P) of + true -> + suspend_until_system_limit(P, N+1, NewM); + {'EXIT', R} when R == system_limit; + element(1, R) == system_limit -> + io:format("system limit at ~p~n", [N]), + resume_from_system_limit(P, N, 0); + Error -> + ct:fail(Error) + end. resume_from_system_limit(P, 0, _) -> - ?line ?CHK_SUSPENDED(P, false), - ?line {'EXIT', _} = (catch erlang:resume_process(P)), - ?line ok; + ?CHK_SUSPENDED(P, false), + {'EXIT', _} = (catch erlang:resume_process(P)), + ok; resume_from_system_limit(P, N, M) -> - ?line NewM = case M of - 1 -> - ?line ?CHK_SUSPENDED(P, true), 2; - 1000000 -> - erlang:display(N), 1; - _ -> - M+1 - end, - ?line erlang:resume_process(P), - ?line resume_from_system_limit(P, N-1, NewM). + NewM = case M of + 1 -> + ?CHK_SUSPENDED(P, true), 2; + 1000000 -> + erlang:display(N), 1; + _ -> + M+1 + end, + erlang:resume_process(P), + resume_from_system_limit(P, N-1, NewM). -record(susp_info, {async = 0, - dbl_async = 0, - synced = 0, - async_once = 0}). - -suspend_opts(doc) -> - []; -suspend_opts(suite) -> - []; + dbl_async = 0, + synced = 0, + async_once = 0}). + suspend_opts(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(3)), - ?line Self = self(), - ?line wait_for_empty_runq(10), - ?line Tok = spawn_link(fun () -> - Self ! self(), - tok_trace_loop(Self, 0, 1000000000) - end), - ?line TC = 1000, - ?line receive Tok -> ok end, - ?line SF = fun (N, #susp_info {async = A, - dbl_async = AA, - synced = S, - async_once = AO} = Acc) -> - ?line erlang:suspend_process(Tok, [asynchronous]), - ?line Res = case {suspend_count(Tok), N rem 4} of - {0, 2} -> - ?line erlang:suspend_process(Tok, - [asynchronous]), - case suspend_count(Tok) of - 2 -> - ?line erlang:resume_process(Tok), - ?line Acc#susp_info{async = A+1}; - 0 -> - ?line erlang:resume_process(Tok), - ?line Acc#susp_info{async = A+1, - dbl_async = AA+1} - end; - {0, 1} -> - ?line erlang:suspend_process(Tok, - [asynchronous, - unless_suspending]), - case suspend_count(Tok) of - 1 -> - ?line Acc#susp_info{async = A+1}; - 0 -> - ?line Acc#susp_info{async = A+1, - async_once = AO+1} - end; - {0, 0} -> - ?line erlang:suspend_process(Tok, - [unless_suspending]), - ?line 1 = suspend_count(Tok), - ?line Acc#susp_info{async = A+1, - synced = S+1}; - {0, _} -> - ?line Acc#susp_info{async = A+1}; - _ -> - Acc - end, - ?line erlang:resume_process(Tok), - ?line erlang:yield(), - ?line Res - end, - ?line SI = repeat_acc(SF, TC, #susp_info{}), - ?line erlang:suspend_process(Tok, [asynchronous]), + ct:timetrap({minutes, 3}), + Self = self(), + wait_for_empty_runq(10), + Tok = spawn_link(fun () -> + Self ! self(), + tok_trace_loop(Self, 0, 1000000000) + end), + TC = 1000, + receive Tok -> ok end, + SF = fun (N, #susp_info {async = A, + dbl_async = AA, + synced = S, + async_once = AO} = Acc) -> + erlang:suspend_process(Tok, [asynchronous]), + Res = case {suspend_count(Tok), N rem 4} of + {0, 2} -> + erlang:suspend_process(Tok, + [asynchronous]), + case suspend_count(Tok) of + 2 -> + erlang:resume_process(Tok), + Acc#susp_info{async = A+1}; + 0 -> + erlang:resume_process(Tok), + Acc#susp_info{async = A+1, + dbl_async = AA+1} + end; + {0, 1} -> + erlang:suspend_process(Tok, + [asynchronous, + unless_suspending]), + case suspend_count(Tok) of + 1 -> + Acc#susp_info{async = A+1}; + 0 -> + Acc#susp_info{async = A+1, + async_once = AO+1} + end; + {0, 0} -> + erlang:suspend_process(Tok, + [unless_suspending]), + 1 = suspend_count(Tok), + Acc#susp_info{async = A+1, + synced = S+1}; + {0, _} -> + Acc#susp_info{async = A+1}; + _ -> + Acc + end, + erlang:resume_process(Tok), + erlang:yield(), + Res + end, + SI = repeat_acc(SF, TC, #susp_info{}), + erlang:suspend_process(Tok, [asynchronous]), %% Verify that it eventually suspends - ?line WaitTime0 = 10, - ?line WaitTime1 = case {erlang:system_info(debug_compiled), - erlang:system_info(lock_checking)} of - {false, false} -> - WaitTime0; - {false, true} -> - WaitTime0*5; - _ -> - WaitTime0*10 - end, - ?line WaitTime = case {erlang:system_info(schedulers_online), - erlang:system_info(logical_processors)} of - {Schdlrs, CPUs} when is_integer(CPUs), - Schdlrs =< CPUs -> - WaitTime1; - _ -> - WaitTime1*10 - end, - ?line receive after WaitTime -> ok end, - ?line 1 = suspend_count(Tok), - ?line erlang:suspend_process(Tok, [asynchronous]), - ?line 2 = suspend_count(Tok), - ?line erlang:suspend_process(Tok, [asynchronous]), - ?line 3 = suspend_count(Tok), - ?line erlang:suspend_process(Tok), - ?line 4 = suspend_count(Tok), - ?line erlang:suspend_process(Tok), - ?line 5 = suspend_count(Tok), - ?line erlang:suspend_process(Tok, [unless_suspending]), - ?line 5 = suspend_count(Tok), - ?line erlang:suspend_process(Tok, [unless_suspending, - asynchronous]), - ?line 5 = suspend_count(Tok), - ?line erlang:resume_process(Tok), - ?line erlang:resume_process(Tok), - ?line erlang:resume_process(Tok), - ?line erlang:resume_process(Tok), - ?line 1 = suspend_count(Tok), - ?line ?t:format("Main suspends: ~p~n" - "Main async: ~p~n" - "Double async: ~p~n" - "Async once: ~p~n" - "Synced: ~p~n", - [TC, - SI#susp_info.async, - SI#susp_info.dbl_async, - SI#susp_info.async_once, - SI#susp_info.synced]), - ?line case erlang:system_info(schedulers_online) of - 1 -> - ?line ok; - _ -> - ?line true = SI#susp_info.async =/= 0 - end, - ?line unlink(Tok), - ?line exit(Tok, bang), - ?line test_server:timetrap_cancel(Dog), - ?line ok. + WaitTime0 = 10, + WaitTime1 = case {erlang:system_info(debug_compiled), + erlang:system_info(lock_checking)} of + {false, false} -> + WaitTime0; + {false, true} -> + WaitTime0*5; + _ -> + WaitTime0*10 + end, + WaitTime = case {erlang:system_info(schedulers_online), + erlang:system_info(logical_processors)} of + {Schdlrs, CPUs} when is_integer(CPUs), + Schdlrs =< CPUs -> + WaitTime1; + _ -> + WaitTime1*10 + end, + receive after WaitTime -> ok end, + 1 = suspend_count(Tok), + erlang:suspend_process(Tok, [asynchronous]), + 2 = suspend_count(Tok), + erlang:suspend_process(Tok, [asynchronous]), + 3 = suspend_count(Tok), + erlang:suspend_process(Tok), + 4 = suspend_count(Tok), + erlang:suspend_process(Tok), + 5 = suspend_count(Tok), + erlang:suspend_process(Tok, [unless_suspending]), + 5 = suspend_count(Tok), + erlang:suspend_process(Tok, [unless_suspending, + asynchronous]), + 5 = suspend_count(Tok), + erlang:resume_process(Tok), + erlang:resume_process(Tok), + erlang:resume_process(Tok), + erlang:resume_process(Tok), + 1 = suspend_count(Tok), + io:format("Main suspends: ~p~n" + "Main async: ~p~n" + "Double async: ~p~n" + "Async once: ~p~n" + "Synced: ~p~n", + [TC, + SI#susp_info.async, + SI#susp_info.dbl_async, + SI#susp_info.async_once, + SI#susp_info.synced]), + case erlang:system_info(schedulers_online) of + 1 -> + ok; + _ -> + true = SI#susp_info.async =/= 0 + end, + unlink(Tok), + exit(Tok, bang), + ok. suspend_count(Suspendee) -> suspend_count(self(), Suspendee). suspend_count(Suspender, Suspendee) -> {suspending, SList} = process_info(Suspender, suspending), - + case lists:keysearch(Suspendee, 1, SList) of - {value, {_Suspendee, 0, 0}} -> - ?line ?t:fail({bad_suspendee_list, SList}); - {value, {Suspendee, Count, 0}} when is_integer(Count), Count > 0 -> - {status, suspended} = process_info(Suspendee, status), - Count; - {value, {Suspendee, 0, Outstanding}} when is_integer(Outstanding), - Outstanding > 0 -> - 0; - false -> - 0; - Error -> - ?line ?t:fail({bad_suspendee_list, Error, SList}) + {value, {_Suspendee, 0, 0}} -> + ct:fail({bad_suspendee_list, SList}); + {value, {Suspendee, Count, 0}} when is_integer(Count), Count > 0 -> + {status, suspended} = process_info(Suspendee, status), + Count; + {value, {Suspendee, 0, Outstanding}} when is_integer(Outstanding), + Outstanding > 0 -> + 0; + false -> + 0; + Error -> + ct:fail({bad_suspendee_list, Error, SList}) end. - + repeat_acc(Fun, N, Acc) -> repeat_acc(Fun, 0, N, Acc). @@ -1306,121 +1389,101 @@ repeat_acc(_Fun, N, N, Acc) -> Acc; repeat_acc(Fun, N, M, Acc) -> repeat_acc(Fun, N+1, M, Fun(N, Acc)). - + %% Tests that waiting process can be suspended %% (bug in R2D and earlier; see OTP-1488). -suspend_waiting(doc) -> "Test that a waiting process can be suspended."; +%% Test that a waiting process can be suspended. suspend_waiting(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - - ?line Process = fun_spawn(fun process/0), - ?line receive after 1 -> ok end, - ?line true = erlang:suspend_process(Process), - ?line {status, suspended} = process_info(Process, status), - - %% Done. - ?line test_server:timetrap_cancel(Dog), + Process = fun_spawn(fun process/0), + receive after 1 -> ok end, + true = erlang:suspend_process(Process), + {status, suspended} = process_info(Process, status), ok. - -new_clear(doc) -> - "Test that erlang:trace(new, true, ...) is cleared when tracer dies."; +%% Test that erlang:trace(new, true, ...) is cleared when tracer dies. new_clear(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - - ?line Tracer = spawn(fun receiver/0), - ?line 0 = erlang:trace(new, true, [send, {tracer, Tracer}]), - ?line {flags, [send]} = erlang:trace_info(new, flags), - ?line {tracer, Tracer} = erlang:trace_info(new, tracer), - ?line Mref = erlang:monitor(process, Tracer), - ?line true = exit(Tracer, done), + Tracer = spawn(fun receiver/0), + 0 = erlang:trace(new, true, [send, {tracer, Tracer}]), + {flags, [send]} = erlang:trace_info(new, flags), + {tracer, Tracer} = erlang:trace_info(new, tracer), + Mref = erlang:monitor(process, Tracer), + true = exit(Tracer, done), receive - {'DOWN',Mref,_,_,_} -> ok + {'DOWN',Mref,_,_,_} -> ok end, - ?line {flags, []} = erlang:trace_info(new, flags), - ?line {tracer, []} = erlang:trace_info(new, tracer), - - %% Done. - ?line test_server:timetrap_cancel(Dog), - + {flags, []} = erlang:trace_info(new, flags), + {tracer, []} = erlang:trace_info(new, tracer), ok. -existing_clear(doc) -> - "Test that erlang:trace(all, false, ...) works without tracer."; +%% Test that erlang:trace(all, false, ...) works without tracer. existing_clear(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(5)), - ?line Self = self(), - - ?line Tracer = fun_spawn(fun receiver/0), - ?line N = erlang:trace(existing, true, [send, {tracer, Tracer}]), - ?line {flags, [send]} = erlang:trace_info(Self, flags), - ?line {tracer, Tracer} = erlang:trace_info(Self, tracer), - ?line M = erlang:trace(all, false, [all]), - ?line io:format("Started trace on ~p processes and stopped on ~p~n", - [N, M]), - ?line {flags, []} = erlang:trace_info(Self, flags), - ?line {tracer, []} = erlang:trace_info(Self, tracer), - ?line M = N + 1, % Since trace could not be enabled on the tracer. + Self = self(), + + Tracer = fun_spawn(fun receiver/0), + N = erlang:trace(existing, true, [send, {tracer, Tracer}]), + {flags, [send]} = erlang:trace_info(Self, flags), + {tracer, Tracer} = erlang:trace_info(Self, tracer), + M = erlang:trace(all, false, [all]), + io:format("Started trace on ~p processes and stopped on ~p~n", + [N, M]), + {flags, []} = erlang:trace_info(Self, flags), + {tracer, []} = erlang:trace_info(Self, tracer), + M = N, % Used to be N + 1, but from 19.0 the tracer is also traced - %% Done. - ?line test_server:timetrap_cancel(Dog), ok. -bad_flag(doc) -> "Test that an invalid flag cause badarg"; -bad_flag(suite) -> []; +%% Test that an invalid flag cause badarg bad_flag(Config) when is_list(Config) -> %% A bad flag could deadlock the SMP emulator in erts-5.5 - ?line {'EXIT', {badarg, _}} = (catch erlang:trace(new, - true, - [not_a_valid_flag])), - ?line ok. + {'EXIT', {badarg, _}} = (catch erlang:trace(new, + true, + [not_a_valid_flag])), + ok. -trace_delivered(doc) -> "Test erlang:trace_delivered/1"; -trace_delivered(suite) -> []; +%% Test erlang:trace_delivered/1 trace_delivered(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(60)), - ?line TokLoops = 10000, - ?line Go = make_ref(), - ?line Parent = self(), - ?line Tok = spawn(fun () -> - receive Go -> gone end, - tok_trace_loop(Parent, 0, TokLoops) - end), - ?line 1 = erlang:trace(Tok, true, [procs]), - ?line Mon = erlang:monitor(process, Tok), - ?line NoOfTraceMessages = 4*TokLoops + 1, - ?line io:format("Expect a total of ~p trace messages~n", - [NoOfTraceMessages]), - ?line Tok ! Go, - ?line NoOfTraceMessages = drop_trace_until_down(Tok, Mon), - ?line receive - Msg -> - ?line ?t:fail({unexpected_message, Msg}) - after 1000 -> - ?line test_server:timetrap_cancel(Dog), - ?line ok - end. + ct:timetrap({minutes, 1}), + TokLoops = 10000, + Go = make_ref(), + Parent = self(), + Tok = spawn(fun () -> + receive Go -> gone end, + tok_trace_loop(Parent, 0, TokLoops) + end), + 1 = erlang:trace(Tok, true, [procs]), + Mon = erlang:monitor(process, Tok), + NoOfTraceMessages = 4*TokLoops + 1, + io:format("Expect a total of ~p trace messages~n", + [NoOfTraceMessages]), + Tok ! Go, + NoOfTraceMessages = drop_trace_until_down(Tok, Mon), + receive + Msg -> + ct:fail({unexpected_message, Msg}) + after 1000 -> + ok + end. drop_trace_until_down(Proc, Mon) -> drop_trace_until_down(Proc, Mon, false, 0, 0). drop_trace_until_down(Proc, Mon, TDRef, N, D) -> case receive Msg -> Msg end of - {trace_delivered, Proc, TDRef} -> - io:format("~p trace messages on 'DOWN'~n", [D]), - io:format("Got a total of ~p trace messages~n", [N]), - N; - {'DOWN', Mon, process, Proc, _} -> - Ref = erlang:trace_delivered(Proc), - drop_trace_until_down(Proc, Mon, Ref, N, N); - Trace when is_tuple(Trace), - element(1, Trace) == trace, - element(2, Trace) == Proc -> - drop_trace_until_down(Proc, Mon, TDRef, N+1, D) + {trace_delivered, Proc, TDRef} -> + io:format("~p trace messages on 'DOWN'~n", [D]), + io:format("Got a total of ~p trace messages~n", [N]), + N; + {'DOWN', Mon, process, Proc, _} -> + Ref = erlang:trace_delivered(Proc), + drop_trace_until_down(Proc, Mon, Ref, N, N); + Trace when is_tuple(Trace), + element(1, Trace) == trace, + element(2, Trace) == Proc -> + drop_trace_until_down(Proc, Mon, TDRef, N+1, D) end. tok_trace_loop(_, N, N) -> @@ -1437,17 +1500,24 @@ tok_trace_loop(Parent, N, M) -> receive_first() -> receive - Any -> Any + Any -> Any + end. + +%% Waits for and returns the first message in the message queue. + +receive_first_trace() -> + receive + Any when element(1,Any) =:= trace; element(1,Any) =:= trace_ts -> Any end. %% Ensures that there is no message in the message queue. receive_nothing() -> receive - Any -> - test_server:fail({unexpected_message, Any}) + Any -> + ct:fail({unexpected_message, Any}) after 200 -> - ok + ok end. @@ -1455,39 +1525,39 @@ receive_nothing() -> process(Dest) -> receive - {send_please, To, What} -> - To ! What, - process(Dest); - {spawn_link_please, ReplyTo, {M, F, A}} -> - Pid = spawn_link(M, F, A), - ReplyTo ! {spawned, self(), Pid}, - process(Dest); - {spawn_link_please, ReplyTo, Node, {M, F, A}} -> - Pid = spawn_link(Node, M, F, A), - ReplyTo ! {spawned, self(), Pid}, - process(Dest); - {link_please, Pid} -> - link(Pid), - process(Dest); - {unlink_please, Pid} -> - unlink(Pid), - process(Dest); - {register_please, Name, Pid} -> - register(Name, Pid), - process(Dest); - {unregister_please, Name} -> - unregister(Name), - process(Dest); - {exit_please, Reason} -> - exit(Reason); - {trap_exit_please, State} -> - process_flag(trap_exit, State), - process(Dest); - Other -> - Dest ! {self(), Other}, - process(Dest) + {send_please, To, What} -> + To ! What, + process(Dest); + {spawn_link_please, ReplyTo, {M, F, A}} -> + Pid = spawn_link(M, F, A), + ReplyTo ! {spawned, self(), Pid}, + process(Dest); + {spawn_link_please, ReplyTo, Node, {M, F, A}} -> + Pid = spawn_link(Node, M, F, A), + ReplyTo ! {spawned, self(), Pid}, + process(Dest); + {link_please, Pid} -> + link(Pid), + process(Dest); + {unlink_please, Pid} -> + unlink(Pid), + process(Dest); + {register_please, Name, Pid} -> + register(Name, Pid), + process(Dest); + {unregister_please, Name} -> + unregister(Name), + process(Dest); + {exit_please, Reason} -> + exit(Reason); + {trap_exit_please, State} -> + process_flag(trap_exit, State), + process(Dest); + Other -> + Dest ! {self(), Other}, + process(Dest) after 3000 -> - exit(timeout) + exit(timeout) end. @@ -1495,17 +1565,17 @@ process(Dest) -> process() -> receive - {spawn_please, ReplyTo, Fun} -> - Pid = fun_spawn(Fun), - ReplyTo ! {spawned, Pid}, - process(); - {send_please, To, What} -> - To ! What, - process(); - timeout_please -> - receive after 1 -> process() end; - _Other -> - process() + {spawn_please, ReplyTo, Fun} -> + Pid = fun_spawn(Fun), + ReplyTo ! {spawned, Pid}, + process(); + {send_please, To, What} -> + To ! What, + process(); + timeout_please -> + receive after 1 -> process() end; + _Other -> + process() end. @@ -1513,9 +1583,9 @@ process() -> sender() -> receive - {send_please, To, What} -> - To ! What, - sender() + {send_please, To, What} -> + To ! What, + sender() end. @@ -1523,7 +1593,7 @@ sender() -> receiver() -> receive - _Any -> receiver() + _Any -> receiver() end. %% Works as long as it receives CPU time. Will always be RUNNABLE. @@ -1544,8 +1614,8 @@ fun_spawn(Fun, Args) -> start_node(Name) -> Pa = filename:dirname(code:which(?MODULE)), Cookie = atom_to_list(erlang:get_cookie()), - test_server:start_node(Name, slave, - [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]). + test_server:start_node(Name, slave, + [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]). stop_node(Node) -> test_server:stop_node(Node). @@ -1553,11 +1623,11 @@ stop_node(Node) -> wait_for_empty_runq(DeadLine) -> case statistics(run_queue) of - 0 -> true; - RQLen -> - erlang:display("Waiting for empty run queue"), - MSDL = DeadLine*1000, - wait_for_empty_runq(MSDL, MSDL, RQLen) + 0 -> true; + RQLen -> + erlang:display("Waiting for empty run queue"), + MSDL = DeadLine*1000, + wait_for_empty_runq(MSDL, MSDL, RQLen) end. wait_for_empty_runq(DeadLine, Left, RQLen) when Left =< 0 -> @@ -1568,48 +1638,48 @@ wait_for_empty_runq(DeadLine, Left, _RQLen) -> UntilDeadLine = Left - Wait, receive after Wait -> ok end, case statistics(run_queue) of - 0 -> - erlang:display("Waited for " - ++ integer_to_list(DeadLine - - UntilDeadLine) - ++ " ms for empty run queue."), - true; - NewRQLen -> - wait_for_empty_runq(DeadLine, - UntilDeadLine, - NewRQLen) + 0 -> + erlang:display("Waited for " + ++ integer_to_list(DeadLine + - UntilDeadLine) + ++ " ms for empty run queue."), + true; + NewRQLen -> + wait_for_empty_runq(DeadLine, + UntilDeadLine, + NewRQLen) end. issue_non_empty_runq_warning(DeadLine, RQLen) -> PIs = lists:foldl( - fun (P, Acc) -> - case process_info(P, - [status, - initial_call, - current_function, - registered_name, - reductions, - message_queue_len]) of - [{status, Runnable} | _] = PI when Runnable /= waiting, - Runnable /= suspended -> - [[{pid, P} | PI] | Acc]; - _ -> - Acc - end - end, - [], - processes()), - ?t:format("WARNING: Unexpected runnable processes in system (waited ~p sec).~n" - " Run queue length: ~p~n" - " Self: ~p~n" - " Processes info: ~p~n", - [DeadLine div 1000, RQLen, self(), PIs]), + fun (P, Acc) -> + case process_info(P, + [status, + initial_call, + current_function, + registered_name, + reductions, + message_queue_len]) of + [{status, Runnable} | _] = PI when Runnable /= waiting, + Runnable /= suspended -> + [[{pid, P} | PI] | Acc]; + _ -> + Acc + end + end, + [], + processes()), + io:format("WARNING: Unexpected runnable processes in system (waited ~p sec).~n" + " Run queue length: ~p~n" + " Self: ~p~n" + " Processes info: ~p~n", + [DeadLine div 1000, RQLen, self(), PIs]), receive after 1000 -> ok end. load_driver(Dir, Driver) -> case erl_ddll:load_driver(Dir, Driver) of - ok -> ok; - {error, Error} = Res -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - Res + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res end. diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl index 96b7dd159f..8c3ffccc45 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-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,10 +20,9 @@ -module(trace_bif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-export([all/0, suite/0]). -export([trace_bif/1, trace_bif_timestamp/1, trace_on_and_off/1, trace_bif_local/1, trace_bif_timestamp_local/1, trace_bif_return/1, not_run/1, @@ -42,99 +41,82 @@ all() -> trace_bif_return, trace_info_old_code] end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - not_run(Config) when is_list(Config) -> {skipped,"Native code"}. -trace_on_and_off(doc) -> - "Tests switching tracing on and off."; +%% Tests switching tracing on and off. trace_on_and_off(Config) when is_list(Config) -> - ?line Pid = spawn(?MODULE, bif_process, []), - ?line Self = self(), - ?line 1 = erlang:trace(Pid, true, [call,timestamp]), - ?line {flags, Flags} = erlang:trace_info(Pid,flags), - ?line [call,timestamp] = lists:sort(Flags), - ?line {tracer, Self} = erlang:trace_info(Pid,tracer), - ?line 1 = erlang:trace(Pid, false, [timestamp]), - ?line {flags,[call]} = erlang:trace_info(Pid,flags), - ?line {tracer, Self} = erlang:trace_info(Pid,tracer), - ?line 1 = erlang:trace(Pid, false, [call]), - ?line {flags,[]} = erlang:trace_info(Pid,flags), - ?line {tracer, []} = erlang:trace_info(Pid,tracer), - ?line exit(Pid,kill), + Pid = spawn(?MODULE, bif_process, []), + Self = self(), + 1 = erlang:trace(Pid, true, [call,timestamp]), + {flags, Flags} = erlang:trace_info(Pid,flags), + [call,timestamp] = lists:sort(Flags), + {tracer, Self} = erlang:trace_info(Pid,tracer), + 1 = erlang:trace(Pid, false, [timestamp]), + {flags,[call]} = erlang:trace_info(Pid,flags), + {tracer, Self} = erlang:trace_info(Pid,tracer), + 1 = erlang:trace(Pid, false, [call]), + {flags,[]} = erlang:trace_info(Pid,flags), + {tracer, []} = erlang:trace_info(Pid,tracer), + exit(Pid,kill), ok. -trace_bif(doc) -> "Test tracing BIFs."; +%% Test tracing BIFs. trace_bif(Config) when is_list(Config) -> do_trace_bif([]). -trace_bif_local(doc) -> "Test tracing BIFs with local flag."; +%% Test tracing BIFs with local flag. trace_bif_local(Config) when is_list(Config) -> do_trace_bif([local]). do_trace_bif(Flags) -> - ?line Pid = spawn(?MODULE, bif_process, []), - ?line 1 = erlang:trace(Pid, true, [call]), - ?line erlang:trace_pattern({erlang,'_','_'}, [], Flags), - ?line Pid ! {do_bif, time, []}, - ?line receive_trace_msg({trace,Pid,call,{erlang,time, []}}), - ?line Pid ! {do_bif, statistics, [runtime]}, - ?line receive_trace_msg({trace,Pid,call, - {erlang,statistics, [runtime]}}), - - ?line Pid ! {do_time_bif}, - ?line receive_trace_msg({trace,Pid,call, - {erlang,time, []}}), - - ?line Pid ! {do_statistics_bif}, - ?line receive_trace_msg({trace,Pid,call, - {erlang,statistics, [runtime]}}), - - ?line 1 = erlang:trace(Pid, false, [call]), - ?line erlang:trace_pattern({erlang,'_','_'}, false, Flags), - ?line exit(Pid, die), + Pid = spawn(?MODULE, bif_process, []), + 1 = erlang:trace(Pid, true, [call]), + erlang:trace_pattern({erlang,'_','_'}, [], Flags), + Pid ! {do_bif, time, []}, + receive_trace_msg({trace,Pid,call,{erlang,time, []}}), + Pid ! {do_bif, statistics, [runtime]}, + receive_trace_msg({trace,Pid,call, + {erlang,statistics, [runtime]}}), + + Pid ! {do_time_bif}, + receive_trace_msg({trace,Pid,call, + {erlang,time, []}}), + + Pid ! {do_statistics_bif}, + receive_trace_msg({trace,Pid,call, + {erlang,statistics, [runtime]}}), + + 1 = erlang:trace(Pid, false, [call]), + erlang:trace_pattern({erlang,'_','_'}, false, Flags), + exit(Pid, die), ok. -trace_bif_timestamp(doc) -> "Test tracing BIFs with timestamps."; +%% Test tracing BIFs with timestamps. trace_bif_timestamp(Config) when is_list(Config) -> do_trace_bif_timestamp([], timestamp, [timestamp]), do_trace_bif_timestamp([], timestamp, - [timestamp, - monotonic_timestamp, - strict_monotonic_timestamp]), + [timestamp, + monotonic_timestamp, + strict_monotonic_timestamp]), do_trace_bif_timestamp([], strict_monotonic_timestamp, - [strict_monotonic_timestamp]), + [strict_monotonic_timestamp]), do_trace_bif_timestamp([], strict_monotonic_timestamp, - [monotonic_timestamp, strict_monotonic_timestamp]), + [monotonic_timestamp, strict_monotonic_timestamp]), do_trace_bif_timestamp([], monotonic_timestamp, [monotonic_timestamp]). - -trace_bif_timestamp_local(doc) -> - "Test tracing BIFs with timestamps and local flag."; + +%% Test tracing BIFs with timestamps and local flag. trace_bif_timestamp_local(Config) when is_list(Config) -> do_trace_bif_timestamp([local], timestamp, [timestamp]), do_trace_bif_timestamp([local], timestamp, - [timestamp, - monotonic_timestamp, - strict_monotonic_timestamp]), + [timestamp, + monotonic_timestamp, + strict_monotonic_timestamp]), do_trace_bif_timestamp([local], strict_monotonic_timestamp, - [strict_monotonic_timestamp]), + [strict_monotonic_timestamp]), do_trace_bif_timestamp([local], strict_monotonic_timestamp, - [monotonic_timestamp, strict_monotonic_timestamp]), + [monotonic_timestamp, strict_monotonic_timestamp]), do_trace_bif_timestamp([local], monotonic_timestamp, [monotonic_timestamp]). do_trace_bif_timestamp(Flags, TsType, TsFlags) -> @@ -146,22 +128,22 @@ do_trace_bif_timestamp(Flags, TsType, TsFlags) -> Ts0 = make_ts(TsType), Pid ! {do_bif, time, []}, Ts1 = receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}, - Ts0,TsType), + Ts0,TsType), Pid ! {do_bif, statistics, [runtime]}, Ts2 = receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}, - Ts1, TsType), + {erlang,statistics, [runtime]}}, + Ts1, TsType), Pid ! {do_time_bif}, Ts3 = receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,time, []}}, - Ts2, TsType), + {erlang,time, []}}, + Ts2, TsType), Pid ! {do_statistics_bif}, Ts4 = receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}, - Ts3, TsType), + {erlang,statistics, [runtime]}}, + Ts3, TsType), check_ts(TsType, Ts4, make_ts(TsType)), @@ -170,11 +152,11 @@ do_trace_bif_timestamp(Flags, TsType, TsFlags) -> Pid ! {do_statistics_bif}, receive_trace_msg({trace,Pid,call, - {erlang,statistics, [runtime]}}), + {erlang,statistics, [runtime]}}), Pid ! {do_bif, statistics, [runtime]}, receive_trace_msg({trace,Pid,call, - {erlang,statistics, [runtime]}}), + {erlang,statistics, [runtime]}}), 1 = erlang:trace(Pid, false, [call]), erlang:trace_pattern({erlang,'_','_'}, false, Flags), @@ -182,18 +164,17 @@ do_trace_bif_timestamp(Flags, TsType, TsFlags) -> exit(Pid, die), ok. -trace_bif_return(doc) -> - "Test tracing BIF's with return/return_to trace."; +%% Test tracing BIF's with return/return_to trace. trace_bif_return(Config) when is_list(Config) -> do_trace_bif_return(timestamp, [timestamp]), do_trace_bif_return(timestamp, - [timestamp, - monotonic_timestamp, - strict_monotonic_timestamp]), + [timestamp, + monotonic_timestamp, + strict_monotonic_timestamp]), do_trace_bif_return(strict_monotonic_timestamp, - [strict_monotonic_timestamp]), + [strict_monotonic_timestamp]), do_trace_bif_return(strict_monotonic_timestamp, - [monotonic_timestamp, strict_monotonic_timestamp]), + [monotonic_timestamp, strict_monotonic_timestamp]), do_trace_bif_return(monotonic_timestamp, [monotonic_timestamp]). do_trace_bif_return(TsType, TsFlags) -> @@ -201,114 +182,107 @@ do_trace_bif_return(TsType, TsFlags) -> Pid=spawn(?MODULE, bif_process, []), 1 = erlang:trace(Pid, true, [call,return_to]++TsFlags), erlang:trace_pattern({erlang,'_','_'}, [{'_',[],[{return_trace}]}], - [local]), + [local]), Ts0 = make_ts(TsType), Pid ! {do_bif, time, []}, Ts1 = receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}, - Ts0, TsType), + Ts0, TsType), Ts2 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,time,0}}, - Ts1, TsType), + {erlang,time,0}}, + Ts1, TsType), Ts3 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}, - Ts2, TsType), - - + {?MODULE, bif_process,0}}, + Ts2, TsType), + + Pid ! {do_bif, statistics, [runtime]}, Ts4 = receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}, - Ts3, TsType), + {erlang,statistics, [runtime]}}, + Ts3, TsType), Ts5 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,statistics,1}}, - Ts4, TsType), + {erlang,statistics,1}}, + Ts4, TsType), Ts6 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}, - Ts5, TsType), - - + {?MODULE, bif_process,0}}, + Ts5, TsType), + + Pid ! {do_time_bif}, Ts7 = receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,time, []}}, - Ts6, TsType), + {erlang,time, []}}, + Ts6, TsType), Ts8 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,time,0}}, - Ts7, TsType), + {erlang,time,0}}, + Ts7, TsType), Ts9 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}, - Ts8, TsType), + {?MODULE, bif_process,0}}, + Ts8, TsType), Pid ! {do_statistics_bif}, Ts10 = receive_trace_msg_ts({trace_ts,Pid,call, - {erlang,statistics, [runtime]}}, - Ts9, TsType), + {erlang,statistics, [runtime]}}, + Ts9, TsType), Ts11 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {erlang,statistics,1}}, - Ts10, TsType), + {erlang,statistics,1}}, + Ts10, TsType), Ts12 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, bif_process,0}}, - Ts11, TsType), + {?MODULE, bif_process,0}}, + Ts11, TsType), check_ts(TsType, Ts12, make_ts(TsType)), ok. - - + + receive_trace_msg(Mess) -> receive - Mess -> - ok; - Other -> - io:format("Expected: ~p,~nGot: ~p~n", [Mess, Other]), - ?t:fail() + Mess -> + ok; + Other -> + ct:fail("Expected: ~p,~nGot: ~p~n", [Mess, Other]) after 5000 -> - io:format("Expected: ~p,~nGot: timeout~n", [Mess]), - ?t:fail() + ct:fail("Expected: ~p,~nGot: timeout~n", [Mess]) end. receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}, PrevTs, TsType) -> receive - {trace_ts, Pid, call, {erlang, F, A}, Ts} -> - check_ts(TsType, PrevTs, Ts), - Ts; - Other -> - io:format("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n" - "Got: ~p~n", - [Pid, erlang, F, A, Other]), - ?t:fail() - after 5000 -> - io:format("Got timeout~n", []), - ?t:fail() + {trace_ts, Pid, call, {erlang, F, A}, Ts} = M -> + io:format("~p (PrevTs: ~p)~n",[M, PrevTs]), + check_ts(TsType, PrevTs, Ts), + Ts; + Other -> + ct:fail("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n" + "Got: ~p~n", + [Pid, erlang, F, A, Other]) + after 5000 -> + ct:fail("Got timeout~n", []) end. receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}, PrevTs, TsType) -> receive - {trace_ts, Pid, return_from, {erlang, F, A}, _Value, Ts} -> - check_ts(TsType, PrevTs, Ts), - Ts; - Other -> - io:format("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n" - "Got: ~p~n", - [Pid, erlang, F, A, Other]), - ?t:fail() - after 5000 -> - io:format("Got timeout~n", []), - ?t:fail() + {trace_ts, Pid, return_from, {erlang, F, A}, _Value, Ts} = M -> + io:format("~p (PrevTs: ~p)~n",[M, PrevTs]), + check_ts(TsType, PrevTs, Ts), + Ts; + Other -> + ct:fail("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n" + "Got: ~p~n", [Pid, erlang, F, A, Other]) + after 5000 -> + ct:fail("Got timeout~n", []) end. receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}, PrevTs, TsType) -> receive - {trace_ts, Pid, return_to, {M, F, A}, Ts} -> - check_ts(TsType, PrevTs, Ts), - Ts; - Other -> - io:format("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n" - "Got: ~p~n", - [Pid, M, F, A, Other]), - ?t:fail() - after 5000 -> - io:format("Got timeout~n", []), - ?t:fail() + {trace_ts, Pid, return_to, {M, F, A}, Ts} = Msg -> + io:format("~p (PrevTs: ~p)~n",[Msg, PrevTs]), + check_ts(TsType, PrevTs, Ts), + Ts; + Other -> + ct:fail("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n" + "Got: ~p~n", [Pid, M, F, A, Other]) + after 5000 -> + ct:fail("Got timeout~n", []) end. make_ts(timestamp) -> @@ -340,37 +314,37 @@ check_ts(strict_monotonic_timestamp, PrevTs, Ts) -> bif_process() -> receive - {do_bif, Name, Args} -> - apply(erlang, Name, Args), - bif_process(); - {do_time_bif} -> - %% Match the return value to ensure that the time() call - %% is not optimized away. - {_,_,_} = time(), - bif_process(); - {do_statistics_bif} -> - statistics(runtime), - bif_process(); - _Stuff -> - bif_process() + {do_bif, Name, Args} -> + apply(erlang, Name, Args), + bif_process(); + {do_time_bif} -> + %% Match the return value to ensure that the time() call + %% is not optimized away. + {_,_,_} = time(), + bif_process(); + {do_statistics_bif} -> + statistics(runtime), + bif_process(); + _Stuff -> + bif_process() end. - -trace_info_old_code(doc) -> "trace_info on deleted module (OTP-5057)."; + +%% trace_info on deleted module (OTP-5057). 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,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. + MFA = {M,F,0} = {test,foo,0}, + Fname = atom_to_list(M)++".erl", + AbsForms = + [{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,M,Mbin} = compile:forms(AbsForms), + {module,M} = code:load_binary(M, Fname, Mbin), + true = erlang:delete_module(M), + {traced,undefined} = erlang:trace_info(MFA, traced), ok. a(L) -> diff --git a/erts/emulator/test/trace_call_count_SUITE.erl b/erts/emulator/test/trace_call_count_SUITE.erl index c7881bbd70..5f871835bc 100644 --- a/erts/emulator/test/trace_call_count_SUITE.erl +++ b/erts/emulator/test/trace_call_count_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -43,7 +43,7 @@ -define(config(A,B),config(A,B)). -export([config/2]). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. -ifdef(debug). @@ -70,18 +70,17 @@ config(priv_dir,_) -> pause_and_restart/1, combo/1]). init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(test_server:seconds(30)), - [{watchdog, Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> +end_per_testcase(_Case, _Config) -> erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_count]), erlang:trace_pattern(on_load, false, [local,meta,call_count]), erlang:trace(all, false, [all]), - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), ok. -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. all() -> case test_server:is_native(trace_call_count_SUITE) of @@ -109,38 +108,23 @@ end_per_group(_GroupName, Config) -> not_run(Config) when is_list(Config) -> {skipped,"Native code"}. -basic(suite) -> - []; -basic(doc) -> - ["Tests basic call count trace"]; +%% Tests basic call count trace basic(Config) when is_list(Config) -> basic_test(). -on_and_off(suite) -> - []; -on_and_off(doc) -> - ["Tests turning trace parameters on and off"]; +%% Tests turning trace parameters on and off on_and_off(Config) when is_list(Config) -> on_and_off_test(). -info(suite) -> - []; -info(doc) -> - ["Tests the trace_info BIF"]; +%% Tests the trace_info BIF info(Config) when is_list(Config) -> info_test(). -pause_and_restart(suite) -> - []; -pause_and_restart(doc) -> - ["Tests pausing and restarting call counters"]; +%% Tests pausing and restarting call counters pause_and_restart(Config) when is_list(Config) -> pause_and_restart_test(). -combo(suite) -> - []; -combo(doc) -> - ["Tests combining local call trace and meta trace with call count trace"]; +%% Tests combining local call trace and meta trace with call count trace combo(Config) when is_list(Config) -> combo_test(). @@ -161,168 +145,168 @@ combo(Config) when is_list(Config) -> %%% basic_test() -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), - ?line M = 1000, + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + M = 1000, %% - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]), - ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_count]), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line {call_count,0} = erlang:trace_info({?MODULE,seq_r,3}, call_count), - ?line Lr = seq_r(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line {call_count,1} = erlang:trace_info({?MODULE,seq_r,3}, call_count), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq_r,4}, call_count), - ?line L = lists:reverse(Lr), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]), + 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_count]), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + {call_count,0} = erlang:trace_info({?MODULE,seq_r,3}, call_count), + Lr = seq_r(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + {call_count,1} = erlang:trace_info({?MODULE,seq_r,3}, call_count), + {call_count,M} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + L = lists:reverse(Lr), %% - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% on_and_off_test() -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), - ?line M = 100, + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + M = 100, %% - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line N = erlang:trace_pattern({?MODULE,'_','_'}, true, [call_count]), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line P = erlang:trace_pattern({'_','_','_'}, true, [call_count]), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_count]), - ?line {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line {call_count,0} = erlang:trace_info({?MODULE,seq_r,4}, call_count), - ?line Lr = seq_r(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq_r,4}, call_count), - ?line N = erlang:trace_pattern({?MODULE,'_','_'}, false, [call_count]), - ?line {call_count,false} = erlang:trace_info({?MODULE,seq_r,4}, call_count), - ?line Lr = seq_r(1, M, fun(X) -> X+1 end), - ?line {call_count,false} = erlang:trace_info({?MODULE,seq_r,4}, call_count), - ?line L = lists:reverse(Lr), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + N = erlang:trace_pattern({?MODULE,'_','_'}, true, [call_count]), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + P = erlang:trace_pattern({'_','_','_'}, true, [call_count]), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_count]), + {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count), + {call_count,0} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + Lr = seq_r(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + N = erlang:trace_pattern({?MODULE,'_','_'}, false, [call_count]), + {call_count,false} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + Lr = seq_r(1, M, fun(X) -> X+1 end), + {call_count,false} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + L = lists:reverse(Lr), %% - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% info_test() -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), %% - ?line 1 = erlang:trace_pattern({?MODULE,seq,3}, true, [call_count]), - ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_count]), - ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line {all,[_|_]=L} = erlang:trace_info({?MODULE,seq,3}, all), - ?line {value,{call_count,0}} = lists:keysearch(call_count, 1, L), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_count]), - ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_count]), - ?line {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line {all,false} = erlang:trace_info({?MODULE,seq,3}, all), + 1 = erlang:trace_pattern({?MODULE,seq,3}, true, [call_count]), + {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_count]), + {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), + {all,[_|_]=L} = erlang:trace_info({?MODULE,seq,3}, all), + {value,{call_count,0}} = lists:keysearch(call_count, 1, L), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_count]), + {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_count]), + {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count), + {all,false} = erlang:trace_info({?MODULE,seq,3}, all), %% - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pause_and_restart_test() -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), - ?line M = 100, + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + M = 100, %% - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]), - ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_count]), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_count]), - ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), - ?line L = seq(1, M, fun(X) -> X+1 end), - ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]), + {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_count]), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_count]), + {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), + L = seq(1, M, fun(X) -> X+1 end), + {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), %% - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% combo_test() -> - ?line Self = self(), - - ?line MetaMatchSpec = [{'_',[],[{return_trace}]}], - ?line Flags = lists:sort([call, return_to]), - ?line LocalTracer = spawn_link(fun () -> relay_n(5, Self) end), - ?line MetaTracer = spawn_link(fun () -> relay_n(9, Self) end), - ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, [], [local]), - ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, - MetaMatchSpec, - [{meta,MetaTracer}, call_count]), - ?line 1 = erlang:trace(Self, true, [{tracer,LocalTracer} | Flags]), + Self = self(), + + MetaMatchSpec = [{'_',[],[{return_trace}]}], + Flags = lists:sort([call, return_to]), + LocalTracer = spawn_link(fun () -> relay_n(5, Self) end), + MetaTracer = spawn_link(fun () -> relay_n(9, Self) end), + 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, [], [local]), + 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, + MetaMatchSpec, + [{meta,MetaTracer}, call_count]), + 1 = erlang:trace(Self, true, [{tracer,LocalTracer} | Flags]), %% - ?line {traced,local} = - erlang:trace_info({?MODULE,seq_r,3}, traced), - ?line {match_spec,[]} = - erlang:trace_info({?MODULE,seq_r,3}, match_spec), - ?line {meta,MetaTracer} = - erlang:trace_info({?MODULE,seq_r,3}, meta), - ?line {meta_match_spec,MetaMatchSpec} = - erlang:trace_info({?MODULE,seq_r,3}, meta_match_spec), - ?line {call_count,0} = - erlang:trace_info({?MODULE,seq_r,3}, call_count), + {traced,local} = + erlang:trace_info({?MODULE,seq_r,3}, traced), + {match_spec,[]} = + erlang:trace_info({?MODULE,seq_r,3}, match_spec), + {meta,MetaTracer} = + erlang:trace_info({?MODULE,seq_r,3}, meta), + {meta_match_spec,MetaMatchSpec} = + erlang:trace_info({?MODULE,seq_r,3}, meta_match_spec), + {call_count,0} = + erlang:trace_info({?MODULE,seq_r,3}, call_count), %% - ?line {all,[_|_]=TraceInfo} = - erlang:trace_info({?MODULE,seq_r,3}, all), - ?line {value,{traced,local}} = - lists:keysearch(traced, 1, TraceInfo), - ?line {value,{match_spec,[]}} = - lists:keysearch(match_spec, 1, TraceInfo), - ?line {value,{meta,MetaTracer}} = - lists:keysearch(meta, 1, TraceInfo), - ?line {value,{meta_match_spec,MetaMatchSpec}} = - lists:keysearch(meta_match_spec, 1, TraceInfo), - ?line {value,{call_count,0}} = - lists:keysearch(call_count, 1, TraceInfo), + {all,[_|_]=TraceInfo} = + erlang:trace_info({?MODULE,seq_r,3}, all), + {value,{traced,local}} = + lists:keysearch(traced, 1, TraceInfo), + {value,{match_spec,[]}} = + lists:keysearch(match_spec, 1, TraceInfo), + {value,{meta,MetaTracer}} = + lists:keysearch(meta, 1, TraceInfo), + {value,{meta_match_spec,MetaMatchSpec}} = + lists:keysearch(meta_match_spec, 1, TraceInfo), + {value,{call_count,0}} = + lists:keysearch(call_count, 1, TraceInfo), %% - ?line [3,2,1] = seq_r(1, 3, fun(X) -> X+1 end), + [3,2,1] = seq_r(1, 3, fun(X) -> X+1 end), %% - ?line List = collect(100), - ?line {MetaR, LocalR} = - lists:foldl( - fun ({P,X}, {M,L}) when P == MetaTracer -> - {[X|M],L}; - ({P,X}, {M,L}) when P == LocalTracer -> - {M,[X|L]} - end, - {[],[]}, - List), - ?line Meta = lists:reverse(MetaR), - ?line Local = lists:reverse(LocalR), - ?line [?CTT(Self,{?MODULE,seq_r,[1,3,_]}), - ?CTT(Self,{?MODULE,seq_r,[1,3,_,[]]}), - ?CTT(Self,{?MODULE,seq_r,[2,3,_,[1]]}), - ?CTT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}), - ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), - ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), - ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), - ?RFT(Self,{?MODULE,seq_r,3},[3,2,1])] = Meta, - ?line [?CT(Self,{?MODULE,seq_r,[1,3,_]}), - ?CT(Self,{?MODULE,seq_r,[1,3,_,[]]}), - ?CT(Self,{?MODULE,seq_r,[2,3,_,[1]]}), - ?CT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}), - ?RT(Self,{?MODULE,combo_test,0})] = Local, - ?line {call_count,1} = erlang:trace_info({?MODULE,seq_r,3}, call_count), - ?line {call_count,3} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + List = collect(100), + {MetaR, LocalR} = + lists:foldl( + fun ({P,X}, {M,L}) when P == MetaTracer -> + {[X|M],L}; + ({P,X}, {M,L}) when P == LocalTracer -> + {M,[X|L]} + end, + {[],[]}, + List), + Meta = lists:reverse(MetaR), + Local = lists:reverse(LocalR), + [?CTT(Self,{?MODULE,seq_r,[1,3,_]}), + ?CTT(Self,{?MODULE,seq_r,[1,3,_,[]]}), + ?CTT(Self,{?MODULE,seq_r,[2,3,_,[1]]}), + ?CTT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}), + ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), + ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), + ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), + ?RFT(Self,{?MODULE,seq_r,3},[3,2,1])] = Meta, + [?CT(Self,{?MODULE,seq_r,[1,3,_]}), + ?CT(Self,{?MODULE,seq_r,[1,3,_,[]]}), + ?CT(Self,{?MODULE,seq_r,[2,3,_,[1]]}), + ?CT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}), + ?RT(Self,{?MODULE,combo_test,0})] = Local, + {call_count,1} = erlang:trace_info({?MODULE,seq_r,3}, call_count), + {call_count,3} = erlang:trace_info({?MODULE,seq_r,4}, call_count), %% - ?line erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_count]), - ?line erlang:trace_pattern(on_load, false, [local,meta,call_count]), - ?line erlang:trace(all, false, [all]), + erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_count]), + erlang:trace_pattern(on_load, false, [local,meta,call_count]), + erlang:trace(all, false, [all]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -352,8 +336,8 @@ relay_n(0, _) -> ok; relay_n(N, Dest) -> receive Msg -> - Dest ! {self(), Msg}, - relay_n(N-1, Dest) + Dest ! {self(), Msg}, + relay_n(N-1, Dest) end. @@ -367,15 +351,15 @@ collect(Time) -> collect(A, 0) -> receive - Mess -> - collect([Mess | A], 0) + Mess -> + collect([Mess | A], 0) after 0 -> - A + A end; collect(A, Ref) -> receive - {timeout, Ref, done} -> - collect(A, 0); - Mess -> - collect([Mess | A], Ref) + {timeout, Ref, done} -> + collect(A, 0); + Mess -> + collect([Mess | A], Ref) end. diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl index f359e1bd80..40c8bc4340 100644 --- a/erts/emulator/test/trace_call_time_SUITE.erl +++ b/erts/emulator/test/trace_call_time_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -58,32 +58,30 @@ %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% When run in test server. --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2, not_run/1]). -export([basic/1, on_and_off/1, info/1, pause_and_restart/1, scheduling/1, called_function/1, combo/1, bif/1, nif/1]). init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(test_server:seconds(400)), erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time,call_count]), erlang:trace_pattern(on_load, false, [local,meta,call_time,call_count]), timer:now_diff(now(),now()), - [{watchdog, Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> +end_per_testcase(_Case, _Config) -> erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time,call_count]), erlang:trace_pattern(on_load, false, [local,meta,call_time,call_count]), erlang:trace(all, false, [all]), - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), ok. -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 10}}]. all() -> case test_server:is_native(trace_call_time_SUITE) of @@ -93,382 +91,339 @@ all() -> combo, bif, nif, called_function, dead_tracer] end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - not_run(Config) when is_list(Config) -> {skipped,"Native code"}. -basic(suite) -> - []; -basic(doc) -> - ["Tests basic call count trace"]; +%% Tests basic call time trace basic(Config) when is_list(Config) -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), - ?line M = 1000, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + M = 1000, %% - ?line 1 = erlang:trace_pattern({?MODULE,seq, '_'}, true, [call_time]), - ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_time]), - ?line Pid = setup(), - ?line {L, T1} = execute(Pid, fun() -> seq(1, M, fun(X) -> (X+1) end) end), - ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1), - ?line ok = check_trace_info({?MODULE, seq_r, 3}, [], none), - - ?line {Lr, T2} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> (X+1) end) end), - ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1), - ?line ok = check_trace_info({?MODULE, seq_r, 3}, [{Pid, 1, 0, 0}], T2/M), - ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Pid, M, 0, 0}], T2), - ?line L = lists:reverse(Lr), + 1 = erlang:trace_pattern({?MODULE,seq, '_'}, true, [call_time]), + 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_time]), + Pid = setup(), + {L, T1} = execute(Pid, fun() -> seq(1, M, fun(X) -> (X+1) end) end), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1), + ok = check_trace_info({?MODULE, seq_r, 3}, [], none), + + {Lr, T2} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> (X+1) end) end), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1), + ok = check_trace_info({?MODULE, seq_r, 3}, [{Pid, 1, 0, 0}], T2/M), + ok = check_trace_info({?MODULE, seq_r, 4}, [{Pid, M, 0, 0}], T2), + L = lists:reverse(Lr), %% - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), - ?line Pid ! quit, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + Pid ! quit, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -on_and_off(suite) -> - []; -on_and_off(doc) -> - ["Tests turning trace parameters on and off"]; +%% "Tests turning trace parameters on and off on_and_off(Config) when is_list(Config) -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), - ?line M = 100, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + M = 100, %% - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_time]), - ?line Pid = setup(), - ?line {L, T1} = execute(Pid, {?MODULE, seq, [1, M, fun(X) -> X+1 end]}), - ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1), - - ?line N = erlang:trace_pattern({?MODULE,'_','_'}, true, [call_time]), - ?line {L, T2} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), - ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T2), - - ?line P = erlang:trace_pattern({'_','_','_'}, true, [call_time]), - ?line {L, T3} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), - ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T3), - - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_time]), - ?line ok = check_trace_info({?MODULE, seq, 3}, false, none), - ?line {L, _T4} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), - ?line ok = check_trace_info({?MODULE, seq, 3}, false, none), - ?line ok = check_trace_info({?MODULE, seq_r, 4}, [], none), - ?line {Lr, T5} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> X+1 end) end), - ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Pid,M,0,0}], T5), - - ?line N = erlang:trace_pattern({?MODULE,'_','_'}, false, [call_time]), - ?line ok = check_trace_info({?MODULE, seq_r, 4}, false, none), - ?line {Lr, _T6} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> X+1 end) end), - ?line ok = check_trace_info({?MODULE, seq_r, 4}, false, none), - ?line L = lists:reverse(Lr), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_time]), + Pid = setup(), + {L, T1} = execute(Pid, {?MODULE, seq, [1, M, fun(X) -> X+1 end]}), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1), + + N = erlang:trace_pattern({?MODULE,'_','_'}, true, [call_time]), + {L, T2} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T2), + + P = erlang:trace_pattern({'_','_','_'}, true, [call_time]), + {L, T3} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T3), + + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_time]), + ok = check_trace_info({?MODULE, seq, 3}, false, none), + {L, _T4} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq, 3}, false, none), + ok = check_trace_info({?MODULE, seq_r, 4}, [], none), + {Lr, T5} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq_r, 4}, [{Pid,M,0,0}], T5), + + N = erlang:trace_pattern({?MODULE,'_','_'}, false, [call_time]), + ok = check_trace_info({?MODULE, seq_r, 4}, false, none), + {Lr, _T6} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq_r, 4}, false, none), + L = lists:reverse(Lr), %% - ?line Pid ! quit, - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + Pid ! quit, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -info(suite) -> - []; -info(doc) -> - ["Tests the trace_info BIF"]; +%% Tests the trace_info BIF info(Config) when is_list(Config) -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), %% - ?line 1 = erlang:trace_pattern({?MODULE,seq,3}, true, [call_time]), - ?line {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_time]), - ?line {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time), - ?line {all,[_|_]=L} = erlang:trace_info({?MODULE,seq,3}, all), - ?line {value,{call_time,[]}} = lists:keysearch(call_time, 1, L), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_time]), - ?line {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_time]), - ?line {call_time,false} = erlang:trace_info({?MODULE,seq,3}, call_time), - ?line {all,false} = erlang:trace_info({?MODULE,seq,3}, all), + 1 = erlang:trace_pattern({?MODULE,seq,3}, true, [call_time]), + {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_time]), + {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time), + {all,[_|_]=L} = erlang:trace_info({?MODULE,seq,3}, all), + {value,{call_time,[]}} = lists:keysearch(call_time, 1, L), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_time]), + {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_time]), + {call_time,false} = erlang:trace_info({?MODULE,seq,3}, call_time), + {all,false} = erlang:trace_info({?MODULE,seq,3}, all), %% - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -pause_and_restart(suite) -> - []; -pause_and_restart(doc) -> - ["Tests pausing and restarting call time counters"]; +%% Tests pausing and restarting call time counters pause_and_restart(Config) when is_list(Config) -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), - ?line M = 100, - ?line Pid = setup(), + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + M = 100, + Pid = setup(), %% - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_time]), - ?line ok = check_trace_info({?MODULE, seq, 3}, [], none), - ?line {L, T1} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), - ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T1), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_time]), - ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T1), - ?line {L, T2} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), - ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T2), - ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_time]), - ?line ok = check_trace_info({?MODULE, seq, 3}, [], none), - ?line {L, T3} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), - ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T3), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_time]), + ok = check_trace_info({?MODULE, seq, 3}, [], none), + {L, T1} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T1), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_time]), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T1), + {L, T2} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T2), + 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_time]), + ok = check_trace_info({?MODULE, seq, 3}, [], none), + {L, T3} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end), + ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T3), %% - ?line Pid ! quit, - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + Pid ! quit, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -scheduling(suite) -> - []; -scheduling(doc) -> - ["Tests in/out scheduling of call time counters"]; +%% Tests in/out scheduling of call time counters scheduling(Config) when is_list(Config) -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), - ?line M = 1000000, - ?line Np = erlang:system_info(schedulers_online), - ?line F = 12, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + M = 1000000, + Np = erlang:system_info(schedulers_online), + F = 12, %% setup load processes %% (single, no internal calls) - ?line erlang:trace_pattern({?MODULE,loaded,1}, true, [call_time]), + erlang:trace_pattern({?MODULE,loaded,1}, true, [call_time]), - ?line Pids = [setup() || _ <- lists:seq(1, F*Np)], - ?line {_Ls,T1} = execute(Pids, {?MODULE,loaded,[M]}), - ?line [Pid ! quit || Pid <- Pids], + Pids = [setup() || _ <- lists:seq(1, F*Np)], + {_Ls,T1} = execute(Pids, {?MODULE,loaded,[M]}), + [Pid ! quit || Pid <- Pids], %% logic dictates that each process will get ~ 1/F of the schedulers time - ?line {call_time, CT} = erlang:trace_info({?MODULE,loaded,1}, call_time), - - ?line lists:foreach(fun (Pid) -> - ?line ok = case check_process_time(lists:keysearch(Pid, 1, CT), M, F, T1) of - schedule_time_error -> - test_server:comment("Warning: Failed time ratio"), - ok; - Other -> Other - end - end, Pids), - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + {call_time, CT} = erlang:trace_info({?MODULE,loaded,1}, call_time), + + lists:foreach(fun (Pid) -> + ok = case check_process_time(lists:keysearch(Pid, 1, CT), M, F, T1) of + schedule_time_error -> + test_server:comment("Warning: Failed time ratio"), + ok; + Other -> Other + end + end, Pids), + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -combo(suite) -> - []; -combo(doc) -> - ["Tests combining local call trace and meta trace with call time trace"]; +%% "Tests combining local call trace and meta trace with call time trace combo(Config) when is_list(Config) -> - ?line Self = self(), - ?line Nbc = 3, - ?line MetaMs = [{'_',[],[{return_trace}]}], - ?line Flags = lists:sort([call, return_to]), - ?line LocalTracer = spawn_link(fun () -> relay_n(5 + Nbc + 3, Self) end), - ?line MetaTracer = spawn_link(fun () -> relay_n(9 + Nbc + 3, Self) end), - ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, [], [local]), - ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_time]), - ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, MetaMs, [{meta,MetaTracer}]), - ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_count]), + Self = self(), + Nbc = 3, + MetaMs = [{'_',[],[{return_trace}]}], + Flags = lists:sort([call, return_to]), + LocalTracer = spawn_link(fun () -> relay_n(5 + Nbc + 3, Self) end), + MetaTracer = spawn_link(fun () -> relay_n(9 + Nbc + 3, Self) end), + 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, [], [local]), + 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_time]), + 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, MetaMs, [{meta,MetaTracer}]), + 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_count]), % bifs - ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, [], [local]), - ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]), - ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, MetaMs, [{meta,MetaTracer}]), + 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, [], [local]), + 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]), + 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, MetaMs, [{meta,MetaTracer}]), %% not implemented - %?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_count]), + %2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_count]), - ?line 1 = erlang:trace(Self, true, [{tracer,LocalTracer} | Flags]), + 1 = erlang:trace(Self, true, [{tracer,LocalTracer} | Flags]), %% - ?line {traced,local} = - erlang:trace_info({?MODULE,seq_r,3}, traced), - ?line {match_spec,[]} = - erlang:trace_info({?MODULE,seq_r,3}, match_spec), - ?line {meta,MetaTracer} = - erlang:trace_info({?MODULE,seq_r,3}, meta), - ?line {meta_match_spec,MetaMs} = - erlang:trace_info({?MODULE,seq_r,3}, meta_match_spec), - ?line ok = check_trace_info({?MODULE, seq_r, 3}, [], none), + {traced,local} = + erlang:trace_info({?MODULE,seq_r,3}, traced), + {match_spec,[]} = + erlang:trace_info({?MODULE,seq_r,3}, match_spec), + {meta,MetaTracer} = + erlang:trace_info({?MODULE,seq_r,3}, meta), + {meta_match_spec,MetaMs} = + erlang:trace_info({?MODULE,seq_r,3}, meta_match_spec), + ok = check_trace_info({?MODULE, seq_r, 3}, [], none), %% check empty trace_info for ?MODULE:seq_r/3 - ?line {all,[_|_]=TraceInfo} = erlang:trace_info({?MODULE,seq_r,3}, all), - ?line {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfo), - ?line {value,{match_spec,[]}} = lists:keysearch(match_spec, 1, TraceInfo), - ?line {value,{meta,MetaTracer}} = lists:keysearch(meta, 1, TraceInfo), - ?line {value,{meta_match_spec,MetaMs}} = lists:keysearch(meta_match_spec, 1, TraceInfo), - ?line {value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfo), - ?line {value,{call_time,[]}} = lists:keysearch(call_time, 1, TraceInfo), + {all,[_|_]=TraceInfo} = erlang:trace_info({?MODULE,seq_r,3}, all), + {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfo), + {value,{match_spec,[]}} = lists:keysearch(match_spec, 1, TraceInfo), + {value,{meta,MetaTracer}} = lists:keysearch(meta, 1, TraceInfo), + {value,{meta_match_spec,MetaMs}} = lists:keysearch(meta_match_spec, 1, TraceInfo), + {value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfo), + {value,{call_time,[]}} = lists:keysearch(call_time, 1, TraceInfo), %% check empty trace_info for erlang:term_to_binary/1 - ?line {all, [_|_] = TraceInfoBif} = erlang:trace_info({erlang, term_to_binary, 1}, all), - ?line {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfoBif), - ?line {value,{match_spec,[]}} = lists:keysearch(match_spec, 1, TraceInfoBif), - ?line {value,{meta, MetaTracer}} = lists:keysearch(meta, 1, TraceInfoBif), - ?line {value,{meta_match_spec,MetaMs}} = lists:keysearch(meta_match_spec, 1, TraceInfoBif), + {all, [_|_] = TraceInfoBif} = erlang:trace_info({erlang, term_to_binary, 1}, all), + {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfoBif), + {value,{match_spec,[]}} = lists:keysearch(match_spec, 1, TraceInfoBif), + {value,{meta, MetaTracer}} = lists:keysearch(meta, 1, TraceInfoBif), + {value,{meta_match_spec,MetaMs}} = lists:keysearch(meta_match_spec, 1, TraceInfoBif), %% not implemented - ?line {value,{call_count,false}} = lists:keysearch(call_count, 1, TraceInfoBif), - %?line {value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfoBif), - ?line {value,{call_time,[]}} = lists:keysearch(call_time, 1, TraceInfoBif), + {value,{call_count,false}} = lists:keysearch(call_count, 1, TraceInfoBif), + %{value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfoBif), + {value,{call_time,[]}} = lists:keysearch(call_time, 1, TraceInfoBif), %% - ?line [3,2,1] = seq_r(1, 3, fun(X) -> X+1 end), - ?line T0 = erlang:monotonic_time(), - ?line with_bif(Nbc), - ?line T1 = erlang:monotonic_time(), - ?line TimeB = erlang:convert_time_unit(T1-T0, native, micro_seconds), + [3,2,1] = seq_r(1, 3, fun(X) -> X+1 end), + T0 = erlang:monotonic_time(), + with_bif(Nbc), + T1 = erlang:monotonic_time(), + TimeB = erlang:convert_time_unit(T1-T0, native, micro_seconds), %% - ?line List = collect(100), - ?line {MetaR, LocalR} = - lists:foldl( - fun ({P,X}, {M,L}) when P == MetaTracer -> - {[X|M],L}; - ({P,X}, {M,L}) when P == LocalTracer -> - {M,[X|L]} - end, - {[],[]}, - List), - ?line Meta = lists:reverse(MetaR), - ?line Local = lists:reverse(LocalR), - - ?line [?CTT(Self,{?MODULE,seq_r,[1,3,_]}), - ?CTT(Self,{?MODULE,seq_r,[1,3,_,[]]}), - ?CTT(Self,{?MODULE,seq_r,[2,3,_,[1]]}), - ?CTT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}), - ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), - ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), - ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), - ?RFT(Self,{?MODULE,seq_r,3},[3,2,1]), - ?CTT(Self,{erlang,term_to_binary,[3]}), % bif - ?RFT(Self,{erlang,term_to_binary,1},<<131,97,3>>), - ?CTT(Self,{erlang,term_to_binary,[2]}), - ?RFT(Self,{erlang,term_to_binary,1},<<131,97,2>>) - ] = Meta, - - ?line [?CT(Self,{?MODULE,seq_r,[1,3,_]}), - ?CT(Self,{?MODULE,seq_r,[1,3,_,[]]}), - ?CT(Self,{?MODULE,seq_r,[2,3,_,[1]]}), - ?CT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}), - ?RT(Self,{?MODULE,combo,1}), - ?CT(Self,{erlang,term_to_binary,[3]}), % bif - ?RT(Self,{?MODULE,with_bif,1}), - ?CT(Self,{erlang,term_to_binary,[2]}), - ?RT(Self,{?MODULE,with_bif,1}) - ] = Local, - - ?line ok = check_trace_info({?MODULE, seq_r, 3}, [{Self,1,0,0}], 1), - ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Self,3,0,0}], 1), - ?line ok = check_trace_info({?MODULE, seq_r, 3}, [{Self,1,0,0}], 1), - ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Self,3,0,0}], 1), - ?line ok = check_trace_info({erlang, term_to_binary, 1}, [{self(), Nbc - 1, 0, 0}], TimeB), + List = collect(100), + {MetaR, LocalR} = + lists:foldl( + fun ({P,X}, {M,L}) when P == MetaTracer -> + {[X|M],L}; + ({P,X}, {M,L}) when P == LocalTracer -> + {M,[X|L]} + end, + {[],[]}, + List), + Meta = lists:reverse(MetaR), + Local = lists:reverse(LocalR), + + [?CTT(Self,{?MODULE,seq_r,[1,3,_]}), + ?CTT(Self,{?MODULE,seq_r,[1,3,_,[]]}), + ?CTT(Self,{?MODULE,seq_r,[2,3,_,[1]]}), + ?CTT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}), + ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), + ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), + ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), + ?RFT(Self,{?MODULE,seq_r,3},[3,2,1]), + ?CTT(Self,{erlang,term_to_binary,[3]}), % bif + ?RFT(Self,{erlang,term_to_binary,1},<<131,97,3>>), + ?CTT(Self,{erlang,term_to_binary,[2]}), + ?RFT(Self,{erlang,term_to_binary,1},<<131,97,2>>) + ] = Meta, + + [?CT(Self,{?MODULE,seq_r,[1,3,_]}), + ?CT(Self,{?MODULE,seq_r,[1,3,_,[]]}), + ?CT(Self,{?MODULE,seq_r,[2,3,_,[1]]}), + ?CT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}), + ?RT(Self,{?MODULE,combo,1}), + ?CT(Self,{erlang,term_to_binary,[3]}), % bif + ?RT(Self,{?MODULE,with_bif,1}), + ?CT(Self,{erlang,term_to_binary,[2]}), + ?RT(Self,{?MODULE,with_bif,1}) + ] = Local, + + ok = check_trace_info({?MODULE, seq_r, 3}, [{Self,1,0,0}], 1), + ok = check_trace_info({?MODULE, seq_r, 4}, [{Self,3,0,0}], 1), + ok = check_trace_info({?MODULE, seq_r, 3}, [{Self,1,0,0}], 1), + ok = check_trace_info({?MODULE, seq_r, 4}, [{Self,3,0,0}], 1), + ok = check_trace_info({erlang, term_to_binary, 1}, [{self(), Nbc - 1, 0, 0}], TimeB), %% - ?line erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time]), - ?line erlang:trace_pattern(on_load, false, [local,meta,call_time]), - ?line erlang:trace(all, false, [all]), + erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time]), + erlang:trace_pattern(on_load, false, [local,meta,call_time]), + erlang:trace(all, false, [all]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -bif(suite) -> - []; -bif(doc) -> - ["Tests tracing of bifs"]; +%% Tests tracing of bifs bif(Config) when is_list(Config) -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), - ?line M = 1000000, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + M = 1000000, %% - ?line 2 = erlang:trace_pattern({erlang, binary_to_term, '_'}, true, [call_time]), - ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]), - ?line Pid = setup(), - ?line {L, T1} = execute(Pid, fun() -> with_bif(M) end), + 2 = erlang:trace_pattern({erlang, binary_to_term, '_'}, true, [call_time]), + 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]), + Pid = setup(), + {L, T1} = execute(Pid, fun() -> with_bif(M) end), - ?line ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M - 1, 0, 0}], T1/2), - ?line ok = check_trace_info({erlang, term_to_binary, 1}, [{Pid, M - 1, 0, 0}], T1/2), + ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M - 1, 0, 0}], T1/2), + ok = check_trace_info({erlang, term_to_binary, 1}, [{Pid, M - 1, 0, 0}], T1/2), % disable term2binary - ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, false, [call_time]), + 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, false, [call_time]), - ?line {L, T2} = execute(Pid, fun() -> with_bif(M) end), + {L, T2} = execute(Pid, fun() -> with_bif(M) end), - ?line ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M*2 - 2, 0, 0}], T1/2 + T2), - ?line ok = check_trace_info({erlang, term_to_binary, 1}, false, none), + ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M*2 - 2, 0, 0}], T1/2 + T2), + ok = check_trace_info({erlang, term_to_binary, 1}, false, none), %% - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), - ?line Pid ! quit, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + Pid ! quit, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -nif(suite) -> - []; -nif(doc) -> - ["Tests tracing of nifs"]; +%% Tests tracing of nifs nif(Config) when is_list(Config) -> load_nif(Config), - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), - ?line M = 1000000, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + M = 1000000, %% - ?line 1 = erlang:trace_pattern({?MODULE, nif_dec, '_'}, true, [call_time]), - ?line 1 = erlang:trace_pattern({?MODULE, with_nif, '_'}, true, [call_time]), - ?line Pid = setup(), - ?line {_, T1} = execute(Pid, fun() -> with_nif(M) end), + 1 = erlang:trace_pattern({?MODULE, nif_dec, '_'}, true, [call_time]), + 1 = erlang:trace_pattern({?MODULE, with_nif, '_'}, true, [call_time]), + Pid = setup(), + {_, T1} = execute(Pid, fun() -> with_nif(M) end), % the nif is called M - 1 times, the last time the function with 'with_nif' % returns ok and does not call the nif. - ?line ok = check_trace_info({?MODULE, nif_dec, 1}, [{Pid, M-1, 0, 0}], T1/5*4), - ?line ok = check_trace_info({?MODULE, with_nif, 1}, [{Pid, M, 0, 0}], T1/5), + ok = check_trace_info({?MODULE, nif_dec, 1}, [{Pid, M-1, 0, 0}], T1/5*4), + ok = check_trace_info({?MODULE, with_nif, 1}, [{Pid, M, 0, 0}], T1/5), %% - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), - ?line Pid ! quit, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + Pid ! quit, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -called_function(suite) -> - []; -called_function(doc) -> - ["Tests combining nested function calls and that the time accumulates to the right function"]; +%% Tests combining nested function calls and that the time accumulates to the right function called_function(Config) when is_list(Config) -> - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), - ?line M = 2100, - ?line Pid = setup(), + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + M = 2100, + Pid = setup(), %% - ?line 1 = erlang:trace_pattern({?MODULE,a_function,'_'}, true, [call_time]), - ?line {L, T1} = execute(Pid, {?MODULE, a_function, [M]}), - ?line ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M, 0, 0}], T1), + 1 = erlang:trace_pattern({?MODULE,a_function,'_'}, true, [call_time]), + {L, T1} = execute(Pid, {?MODULE, a_function, [M]}), + ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M, 0, 0}], T1), - ?line 1 = erlang:trace_pattern({?MODULE,a_called_function,'_'}, true, [call_time]), - ?line {L, T2} = execute(Pid, {?MODULE, a_function, [M]}), - ?line ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M+M, 0, 0}], T1 + M*?SINGLE_CALL_US_TIME), - ?line ok = check_trace_info({?MODULE, a_called_function, 1}, [{Pid, M, 0, 0}], T2), + 1 = erlang:trace_pattern({?MODULE,a_called_function,'_'}, true, [call_time]), + {L, T2} = execute(Pid, {?MODULE, a_function, [M]}), + ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M+M, 0, 0}], T1 + M*?SINGLE_CALL_US_TIME), + ok = check_trace_info({?MODULE, a_called_function, 1}, [{Pid, M, 0, 0}], T2), - ?line 1 = erlang:trace_pattern({?MODULE,dec,'_'}, true, [call_time]), - ?line {L, T3} = execute(Pid, {?MODULE, a_function, [M]}), - ?line ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M+M+M, 0, 0}], T1 + (M+M)*?SINGLE_CALL_US_TIME), - ?line ok = check_trace_info({?MODULE, a_called_function, 1}, [{Pid, M+M, 0, 0}], T2 + M*?SINGLE_CALL_US_TIME ), - ?line ok = check_trace_info({?MODULE, dec, 1}, [{Pid, M, 0, 0}], T3), + 1 = erlang:trace_pattern({?MODULE,dec,'_'}, true, [call_time]), + {L, T3} = execute(Pid, {?MODULE, a_function, [M]}), + ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M+M+M, 0, 0}], T1 + (M+M)*?SINGLE_CALL_US_TIME), + ok = check_trace_info({?MODULE, a_called_function, 1}, [{Pid, M+M, 0, 0}], T2 + M*?SINGLE_CALL_US_TIME ), + ok = check_trace_info({?MODULE, dec, 1}, [{Pid, M, 0, 0}], T3), - ?line Pid ! quit, - ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), + Pid ! quit, + P = erlang:trace_pattern({'_','_','_'}, false, [call_time]), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -482,8 +437,8 @@ dead_tracer(Config) when is_list(Config) -> Ref = erlang:monitor(process, FirstTracer), FirstTracer ! quit, receive - {'DOWN',Ref,process,FirstTracer,normal} -> - ok + {'DOWN',Ref,process,FirstTracer,normal} -> + ok end, erlang:yield(), @@ -513,26 +468,26 @@ dead_tracer(Config) when is_list(Config) -> other_than_self(Info) -> [{Pid,MFA} || {MFA,[{Pid,_,_,_}]} <- Info, - Pid =/= self()]. + Pid =/= self()]. tell_tracer(Tracer, Fun) -> Tracer ! {execute,self(),Fun}, receive - {Tracer,executed} -> - ok + {Tracer,executed} -> + ok end. tracer() -> spawn_link(fun Loop() -> - receive - quit -> - ok; - {execute,From,Fun} -> - Fun(), - From ! {self(),executed}, - Loop() - end - end). + receive + quit -> + ok; + {execute,From,Fun} -> + Fun(), + From ! {self(),executed}, + Loop() + end + end). turn_on_tracing(Pid) -> _ = erlang:trace(Pid, true, [call,set_on_spawn]), @@ -542,18 +497,18 @@ turn_on_tracing(Pid) -> collect_all_info() -> collect_all_info([{?MODULE,F,A} || {F,A} <- module_info(functions)] ++ - erlang:system_info(snifs)). + erlang:system_info(snifs)). collect_all_info([MFA|T]) -> CallTime = erlang:trace_info(MFA, call_time), erlang:trace_pattern(MFA, restart, [call_time]), case CallTime of - {call_time,false} -> - collect_all_info(T); - {call_time,[]} -> - collect_all_info(T); - {call_time,[_|_]=List} -> - [{MFA,List}|collect_all_info(T)] + {call_time,false} -> + collect_all_info(T); + {call_time,[]} -> + collect_all_info(T); + {call_time,[_|_]=List} -> + [{MFA,List}|collect_all_info(T)] end; collect_all_info([]) -> []. @@ -566,8 +521,8 @@ collect_all_info([]) -> []. %% Local helpers load_nif(Config) -> - ?line Path = ?config(data_dir, Config), - ?line ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0). + Path = proplists:get_value(data_dir, Config), + ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0). %% Stack recursive seq @@ -614,39 +569,39 @@ seq_r(Start, Stop, Succ, R) -> % Check call time tracing data and print mismatches check_trace_info(Mfa, [{Pid, C,_,_}] = Expect, Time) -> case erlang:trace_info(Mfa, call_time) of - % Time tests are somewhat problematic. We want to know if Time (EXPECTED_TIME) and S*1000000 + Us (ACTUAL_TIME) - % is the same. - % If the ratio EXPECTED_TIME/ACTUAL_TIME is ~ 1 or if EXPECTED_TIME - ACTUAL_TIME is near zero, the test is ok. - {call_time,[{Pid,C,S,Us}]} when S >= 0, Us >= 0, abs(1 - Time/(S*1000000 + Us)) < ?R_ERROR; abs(Time - S*1000000 - Us) < ?US_ERROR -> - ok; - {call_time,[{Pid,C,S,Us}]} -> - Sum = S*1000000 + Us, - io:format("Expected ~p -> {call_time, ~p (Time ~p us)}~n - got ~w s. ~w us. = ~w us. - ~w -> delta ~w (ratio ~.2f, should be 1.0)~n", - [Mfa, Expect, Time, S, Us, Sum, Time, Sum - Time, Time/Sum]), - time_error; - Other -> - io:format("Expected ~p -> {call_time, ~p (Time ~p us)}~n - got ~p~n", [ Mfa, Expect, Time, Other]), - time_count_error + % Time tests are somewhat problematic. We want to know if Time (EXPECTED_TIME) and S*1000000 + Us (ACTUAL_TIME) + % is the same. + % If the ratio EXPECTED_TIME/ACTUAL_TIME is ~ 1 or if EXPECTED_TIME - ACTUAL_TIME is near zero, the test is ok. + {call_time,[{Pid,C,S,Us}]} when S >= 0, Us >= 0, abs(1 - Time/(S*1000000 + Us)) < ?R_ERROR; abs(Time - S*1000000 - Us) < ?US_ERROR -> + ok; + {call_time,[{Pid,C,S,Us}]} -> + Sum = S*1000000 + Us, + io:format("Expected ~p -> {call_time, ~p (Time ~p us)}~n - got ~w s. ~w us. = ~w us. - ~w -> delta ~w (ratio ~.2f, should be 1.0)~n", + [Mfa, Expect, Time, S, Us, Sum, Time, Sum - Time, Time/Sum]), + time_error; + Other -> + io:format("Expected ~p -> {call_time, ~p (Time ~p us)}~n - got ~p~n", [ Mfa, Expect, Time, Other]), + time_count_error end; check_trace_info(Mfa, Expect, _) -> case erlang:trace_info(Mfa, call_time) of - {call_time, Expect} -> - ok; - Other -> - io:format("Expected ~p -> {call_time, ~p}~n - got ~p~n", [Mfa, Expect, Other]), - result_not_expected_error + {call_time, Expect} -> + ok; + Other -> + io:format("Expected ~p -> {call_time, ~p}~n - got ~p~n", [Mfa, Expect, Other]), + result_not_expected_error end. %check process time check_process_time({value,{Pid, M, S, Us}}, M, F, Time) -> - ?line Sum = S*1000000 + Us, + Sum = S*1000000 + Us, if - abs(1 - (F/(Time/Sum))) < ?R_ERROR -> - ok; - true -> - io:format("- Pid ~p, Got ratio ~.2f, expected ratio ~w~n", [Pid, Time/Sum,F]), - schedule_time_error + abs(1 - (F/(Time/Sum))) < ?R_ERROR -> + ok; + true -> + io:format("- Pid ~p, Got ratio ~.2f, expected ratio ~w~n", [Pid, Time/Sum,F]), + schedule_time_error end; check_process_time(Other, M, _, _) -> io:format(" - Got ~p, expected count ~w~n", [Other, M]), @@ -659,8 +614,8 @@ relay_n(0, _) -> ok; relay_n(N, Dest) -> receive Msg -> - Dest ! {self(), Msg}, - relay_n(N-1, Dest) + Dest ! {self(), Msg}, + relay_n(N-1, Dest) end. @@ -674,17 +629,17 @@ collect(Time) -> collect(A, 0) -> receive - Mess -> - collect([Mess | A], 0) + Mess -> + collect([Mess | A], 0) after 0 -> - A + A end; collect(A, Ref) -> receive - {timeout, Ref, done} -> - collect(A, 0); - Mess -> - collect([Mess | A], Ref) + {timeout, Ref, done} -> + collect(A, 0); + Mess -> + collect([Mess | A], Ref) end. setup() -> @@ -712,12 +667,12 @@ execute(P, Mfa) -> loop() -> receive - quit -> - ok; - {Pid, execute, Fun } when is_function(Fun) -> - Pid ! {self(), answer, erlang:apply(Fun, [])}, - loop(); - {Pid, execute, {M, F, A}} -> - Pid ! {self(), answer, erlang:apply(M, F, A)}, - loop() + quit -> + ok; + {Pid, execute, Fun } when is_function(Fun) -> + Pid ! {self(), answer, erlang:apply(Fun, [])}, + loop(); + {Pid, execute, {M, F, A}} -> + Pid ! {self(), answer, erlang:apply(M, F, A)}, + loop() end. diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl index 7431099340..74c05f24e0 100644 --- a/erts/emulator/test/trace_local_SUITE.erl +++ b/erts/emulator/test/trace_local_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -29,69 +29,44 @@ -export([exported/1, exported_wrap/1, loop/4, apply_slave_async/5, match/2, clause/2, id/1, undef/1, lists_reverse/2]). -%% -%% Define to run outside of test server -%% -%% (rotten feature) -%% -%%-define(STANDALONE,1). - + %% %% Define for debug output %% %%-define(debug,1). --ifdef(STANDALONE). --define(config(A,B),config(A,B)). --export([config/2]). --define(DEFAULT_RECEIVE_TIMEOUT, 1000). --else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(DEFAULT_RECEIVE_TIMEOUT, infinity). --endif. - + -ifdef(debug). --ifdef(STANDALONE). --define(line, erlang:display({?MODULE,?LINE}), ). --endif. -define(dbgformat(A,B),io:format(A,B)). -else. --ifdef(STANDALONE). --define(line, noop, ). --endif. -define(dbgformat(A,B),noop). -endif. - --ifdef(STANDALONE). -config(priv_dir,_) -> - ".". --else. %%% When run in test server %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, basic/1, bit_syntax/1, - return/1, on_and_off/1, systematic_on_off/1, - stack_grow/1,info/1, delete/1, - exception/1, exception_apply/1, - exception_function/1, exception_apply_function/1, - exception_nocatch/1, exception_nocatch_apply/1, - exception_nocatch_function/1, exception_nocatch_apply_function/1, - exception_meta/1, exception_meta_apply/1, - exception_meta_function/1, exception_meta_apply_function/1, - exception_meta_nocatch/1, exception_meta_nocatch_apply/1, - exception_meta_nocatch_function/1, - exception_meta_nocatch_apply_function/1, - concurrency/1, - init_per_testcase/2, end_per_testcase/2]). +-export([all/0, suite/0, + basic/1, bit_syntax/1, + return/1, on_and_off/1, systematic_on_off/1, + stack_grow/1,info/1, delete/1, + exception/1, exception_apply/1, + exception_function/1, exception_apply_function/1, + exception_nocatch/1, exception_nocatch_apply/1, + exception_nocatch_function/1, exception_nocatch_apply_function/1, + exception_meta/1, exception_meta_apply/1, + exception_meta_function/1, exception_meta_apply_function/1, + exception_meta_nocatch/1, exception_meta_nocatch_apply/1, + exception_meta_nocatch_function/1, + exception_meta_nocatch_apply_function/1, + concurrency/1, + init_per_testcase/2, end_per_testcase/2]). + init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(test_server:minutes(2)), - [{watchdog, Dog}|Config]. + Config. end_per_testcase(_Case, Config) -> shutdown(), - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), %% Reloading the module will clear all trace patterns, and %% in a debug-compiled emulator run assertions of the counters @@ -99,168 +74,127 @@ end_per_testcase(_Case, Config) -> c:l(?MODULE). - - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> case test_server:is_native(trace_local_SUITE) of - true -> [not_run]; - false -> - [basic, bit_syntax, return, on_and_off, systematic_on_off, - stack_grow, - info, delete, exception, exception_apply, - exception_function, exception_apply_function, - exception_nocatch, exception_nocatch_apply, - exception_nocatch_function, - exception_nocatch_apply_function, exception_meta, - exception_meta_apply, exception_meta_function, - exception_meta_apply_function, exception_meta_nocatch, - exception_meta_nocatch_apply, - exception_meta_nocatch_function, - exception_meta_nocatch_apply_function, - concurrency] + true -> [not_run]; + false -> + [basic, bit_syntax, return, on_and_off, systematic_on_off, + stack_grow, + info, delete, exception, exception_apply, + exception_function, exception_apply_function, + exception_nocatch, exception_nocatch_apply, + exception_nocatch_function, + exception_nocatch_apply_function, exception_meta, + exception_meta_apply, exception_meta_function, + exception_meta_apply_function, exception_meta_nocatch, + exception_meta_nocatch_apply, + exception_meta_nocatch_function, + exception_meta_nocatch_apply_function, + concurrency] end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - not_run(Config) when is_list(Config) -> {skipped,"Native code"}. -basic(doc) -> - ["Tests basic local call-trace"]; +%% Tests basic local call-trace basic(Config) when is_list(Config) -> basic_test(). -bit_syntax(doc) -> - "OTP-7399: Make sure that code that uses the optimized bit syntax matching " - "can be traced without crashing the emulator."; +%% OTP-7399: Make sure that code that uses the optimized bit syntax matching +%% can be traced without crashing the emulator. bit_syntax(Config) when is_list(Config) -> bit_syntax_test(). -return(doc) -> - ["Tests the different types of return trace"]; +%% Tests the different types of return trace return(Config) when is_list(Config) -> return_test(). - -on_and_off(doc) -> - ["Tests turning trace parameters on and off, " - "both for trace and trace_pattern"]; + +%% Tests turning trace parameters on and off, +%% both for trace and trace_pattern on_and_off(Config) when is_list(Config) -> on_and_off_test(). - -stack_grow(doc) -> - ["Tests the stack growth during return traces"]; + +%% Tests the stack growth during return traces stack_grow(Config) when is_list(Config) -> stack_grow_test(). - -info(doc) -> - ["Tests the trace_info BIF"]; + +%% Tests the trace_info BIF info(Config) when is_list(Config) -> info_test(). - -delete(doc) -> - ["Tests putting trace on deleted modules"]; + +%% Tests putting trace on deleted modules delete(Config) when is_list(Config) -> delete_test(Config). -exception(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception(Config) when is_list(Config) -> exception_test([]). -exception_apply(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception_apply(Config) when is_list(Config) -> exception_test([apply]). -exception_function(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception_function(Config) when is_list(Config) -> exception_test([function]). -exception_apply_function(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception_apply_function(Config) when is_list(Config) -> exception_test([apply,function]). -exception_nocatch(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception_nocatch(Config) when is_list(Config) -> exception_test([nocatch]). -exception_nocatch_apply(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception_nocatch_apply(Config) when is_list(Config) -> exception_test([nocatch,apply]). -exception_nocatch_function(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception_nocatch_function(Config) when is_list(Config) -> exception_test([nocatch,function]). -exception_nocatch_apply_function(doc) -> - ["Tests exception_trace"]; +%% Tests exception_trace exception_nocatch_apply_function(Config) when is_list(Config) -> exception_test([nocatch,apply,function]). -exception_meta(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta(Config) when is_list(Config) -> exception_test([meta]). -exception_meta_apply(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta_apply(Config) when is_list(Config) -> exception_test([meta,apply]). -exception_meta_function(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta_function(Config) when is_list(Config) -> exception_test([meta,function]). -exception_meta_apply_function(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta_apply_function(Config) when is_list(Config) -> exception_test([meta,apply,function]). -exception_meta_nocatch(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta_nocatch(Config) when is_list(Config) -> exception_test([meta,nocatch]). -exception_meta_nocatch_apply(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta_nocatch_apply(Config) when is_list(Config) -> exception_test([meta,nocatch,apply]). -exception_meta_nocatch_function(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta_nocatch_function(Config) when is_list(Config) -> exception_test([meta,nocatch,function]). -exception_meta_nocatch_apply_function(doc) -> - ["Tests meta exception_trace"]; +%% Tests meta exception_trace exception_meta_nocatch_apply_function(Config) when is_list(Config) -> exception_test([meta,nocatch,apply,function]). --endif. - - %%% Message patterns and expect functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -309,28 +243,28 @@ expect_pid(Pid, Msg) when is_tuple(Msg) -> same(Msg, expect_receive(Pid)); expect_pid(Pid, Fun) when is_function(Fun, 1) -> case Fun(expect_receive(Pid)) of - next -> - expect_pid(Pid, Fun); - done -> - ok; - Other -> - expect_pid(Pid, Other) + next -> + expect_pid(Pid, Fun); + done -> + ok; + Other -> + expect_pid(Pid, Other) end. expect_receive(Pid) when is_pid(Pid) -> receive - Msg when is_tuple(Msg), - element(1, Msg) == trace, - element(2, Msg) =/= Pid; - %% - is_tuple(Msg), - element(1, Msg) == trace_ts, - element(2, Msg) =/= Pid -> - expect_receive(Pid); - Msg -> - expect_msg(Pid, Msg) + Msg when is_tuple(Msg), + element(1, Msg) == trace, + element(2, Msg) =/= Pid; + %% + is_tuple(Msg), + element(1, Msg) == trace_ts, + element(2, Msg) =/= Pid -> + expect_receive(Pid); + Msg -> + expect_msg(Pid, Msg) after 100 -> - {nm} + {nm} end. expect_msg(P, ?pCT(P,M,F,Args)) -> {ct,{M,F},Args}; @@ -343,18 +277,18 @@ expect_msg(P, ?pRT(P,M,F,Arity)) -> {rt,{M,F,Arity}}; expect_msg(P, ?pRTT(P,M,F,Arity)) -> {rtt,{M,F,Arity}}; expect_msg(P, Msg) when is_tuple(Msg) -> case tuple_to_list(Msg) of - [trace,P|T] -> - list_to_tuple([trace|T]); - [trace_ts,P|[_|_]=T] -> - list_to_tuple([trace_ts|reverse(tl(reverse(T)))]); - _ -> - Msg + [trace,P|T] -> + list_to_tuple([trace|T]); + [trace_ts,P|[_|_]=T] -> + list_to_tuple([trace_ts|reverse(tl(reverse(T)))]); + _ -> + Msg end. same(A, B) -> case [A|B] of - [X|X] -> - ok + [X|X] -> + ok end. @@ -362,73 +296,73 @@ same(A, B) -> %%% tests %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% basic_test() -> - ?line setup([call]), + setup([call]), NumMatches = erlang:trace_pattern({?MODULE,'_','_'},[],[local]), NumMatches = erlang:trace_pattern({?MODULE,'_','_'},[],[local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported,[1]), - ?line ?CT(?MODULE,local,[1]), - ?line ?CT(?MODULE,local2,[1]), - ?line ?CT(?MODULE,local_tail,[1]), - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line [1,1,1,1] = lambda_slave(fun() -> - exported_wrap(1) - end), - ?line ?NM, - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line [1,1,1,1] = lambda_slave(fun() -> - exported_wrap(1) - end), - ?line ?CT(?MODULE,_,_), %% The fun - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported,[1]), - ?line ?CT(?MODULE,local,[1]), - ?line ?CT(?MODULE,local2,[1]), - ?line ?CT(?MODULE,local_tail,[1]), - ?line erlang:trace_pattern({?MODULE,'_','_'},false,[local]), - ?line shutdown(), - ?line ?NM, + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported,[1]), + ?CT(?MODULE,local,[1]), + ?CT(?MODULE,local2,[1]), + ?CT(?MODULE,local_tail,[1]), + erlang:trace_pattern({?MODULE,'_','_'},[],[]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + [1,1,1,1] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?NM, + erlang:trace_pattern({?MODULE,'_','_'},[],[local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + [1,1,1,1] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?CT(?MODULE,_,_), %% The fun + ?CT(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported,[1]), + ?CT(?MODULE,local,[1]), + ?CT(?MODULE,local2,[1]), + ?CT(?MODULE,local_tail,[1]), + erlang:trace_pattern({?MODULE,'_','_'},false,[local]), + shutdown(), + ?NM, ok. %% OTP-7399. bit_syntax_test() -> - ?line setup([call]), - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - - ?line lambda_slave(fun() -> - 6 = bs_sum_a(<<1,2,3>>, 0), - 10 = bs_sum_b(0, <<1,2,3,4>>), - 26 = bs_sum_c(<<3:4,5:4,7:4,11:4>>, 0) - end), - ?line ?CT(?MODULE,_,[]), %Ignore call to the fun. - - ?line ?CT(?MODULE,bs_sum_a,[<<1,2,3>>,0]), - ?line ?CT(?MODULE,bs_sum_a,[<<2,3>>,1]), - ?line ?CT(?MODULE,bs_sum_a,[<<3>>,3]), - ?line ?CT(?MODULE,bs_sum_a,[<<>>,6]), - - ?line ?CT(?MODULE,bs_sum_b,[0,<<1,2,3,4>>]), - ?line ?CT(?MODULE,bs_sum_b,[1,<<2,3,4>>]), - ?line ?CT(?MODULE,bs_sum_b,[3,<<3,4>>]), - ?line ?CT(?MODULE,bs_sum_b,[6,<<4>>]), - ?line ?CT(?MODULE,bs_sum_b,[10,<<>>]), - - ?line ?CT(?MODULE,bs_sum_c,[<<3:4,5:4,7:4,11:4>>, 0]), - ?line ?CT(?MODULE,bs_sum_c,[<<5:4,7:4,11:4>>, 3]), - ?line ?CT(?MODULE,bs_sum_c,[<<7:4,11:4>>, 8]), - ?line ?CT(?MODULE,bs_sum_c,[<<11:4>>, 15]), - ?line ?CT(?MODULE,bs_sum_c,[<<>>, 26]), - - ?line erlang:trace_pattern({?MODULE,'_','_'},false,[local]), - ?line shutdown(), - ?line ?NM, + setup([call]), + erlang:trace_pattern({?MODULE,'_','_'},[],[local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + + lambda_slave(fun() -> + 6 = bs_sum_a(<<1,2,3>>, 0), + 10 = bs_sum_b(0, <<1,2,3,4>>), + 26 = bs_sum_c(<<3:4,5:4,7:4,11:4>>, 0) + end), + ?CT(?MODULE,_,[]), %Ignore call to the fun. + + ?CT(?MODULE,bs_sum_a,[<<1,2,3>>,0]), + ?CT(?MODULE,bs_sum_a,[<<2,3>>,1]), + ?CT(?MODULE,bs_sum_a,[<<3>>,3]), + ?CT(?MODULE,bs_sum_a,[<<>>,6]), + + ?CT(?MODULE,bs_sum_b,[0,<<1,2,3,4>>]), + ?CT(?MODULE,bs_sum_b,[1,<<2,3,4>>]), + ?CT(?MODULE,bs_sum_b,[3,<<3,4>>]), + ?CT(?MODULE,bs_sum_b,[6,<<4>>]), + ?CT(?MODULE,bs_sum_b,[10,<<>>]), + + ?CT(?MODULE,bs_sum_c,[<<3:4,5:4,7:4,11:4>>, 0]), + ?CT(?MODULE,bs_sum_c,[<<5:4,7:4,11:4>>, 3]), + ?CT(?MODULE,bs_sum_c,[<<7:4,11:4>>, 8]), + ?CT(?MODULE,bs_sum_c,[<<11:4>>, 15]), + ?CT(?MODULE,bs_sum_c,[<<>>, 26]), + + erlang:trace_pattern({?MODULE,'_','_'},false,[local]), + shutdown(), + ?NM, ok. @@ -442,149 +376,149 @@ bs_sum_c(<<H:4,T/bits>>, Acc) -> bs_sum_c(T, H+Acc); bs_sum_c(<<>>, Acc) -> Acc. return_test() -> - ?line setup([call]), - ?line erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], - [local]), - ?line erlang:trace_pattern({erlang,hash,'_'},[{'_',[],[{return_trace}]}], - [local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported,[1]), - ?line ?CT(?MODULE,local,[1]), - ?line ?CT(?MODULE,local2,[1]), - ?line ?CT(?MODULE,local_tail,[1]), - ?line ?CT(erlang,hash,[1,1]), - ?line ?RF(erlang,hash,2,1), - ?line ?RF(?MODULE,local_tail,1,[1,1]), - ?line ?RF(?MODULE,local2,1,[1,1]), - ?line ?RF(?MODULE,local,1,[1,1,1]), - ?line ?RF(?MODULE,exported,1,[1,1,1,1]), - ?line ?RF(?MODULE,exported_wrap,1,[1,1,1,1]), - ?line shutdown(), - ?line setup([call,return_to]), - ?line erlang:trace_pattern({?MODULE,'_','_'},[], - [local]), - ?line erlang:trace_pattern({erlang,hash,'_'},[], - [local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported,[1]), - ?line ?CT(?MODULE,local,[1]), - ?line ?CT(?MODULE,local2,[1]), - ?line ?CT(?MODULE,local_tail,[1]), - ?line ?CT(erlang,hash,[1,1]), - ?line ?RT(?MODULE,local_tail,1), - ?line ?RT(?MODULE,local,1), - ?line ?RT(?MODULE,exported,1), - ?line ?RT(?MODULE,slave,2), - ?line shutdown(), - ?line setup([call,return_to]), - ?line erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], - [local]), - ?line erlang:trace_pattern({erlang,hash,'_'},[{'_',[],[{return_trace}]}], - [local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported,[1]), - ?line ?CT(?MODULE,local,[1]), - ?line ?CT(?MODULE,local2,[1]), - ?line ?CT(?MODULE,local_tail,[1]), - ?line ?CT(erlang,hash,[1,1]), - ?line ?RF(erlang,hash,2,1), - ?line ?RT(?MODULE,local_tail,1), - ?line ?RF(?MODULE,local_tail,1,[1,1]), - ?line ?RF(?MODULE,local2,1,[1,1]), - ?line ?RT(?MODULE,local,1), - ?line ?RF(?MODULE,local,1,[1,1,1]), - ?line ?RT(?MODULE,exported,1), - ?line ?RF(?MODULE,exported,1,[1,1,1,1]), - ?line ?RF(?MODULE,exported_wrap,1,[1,1,1,1]), - ?line ?RT(?MODULE,slave,2), - ?line shutdown(), - ?line ?NM, + setup([call]), + erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], + [local]), + erlang:trace_pattern({erlang,hash,'_'},[{'_',[],[{return_trace}]}], + [local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported,[1]), + ?CT(?MODULE,local,[1]), + ?CT(?MODULE,local2,[1]), + ?CT(?MODULE,local_tail,[1]), + ?CT(erlang,hash,[1,1]), + ?RF(erlang,hash,2,1), + ?RF(?MODULE,local_tail,1,[1,1]), + ?RF(?MODULE,local2,1,[1,1]), + ?RF(?MODULE,local,1,[1,1,1]), + ?RF(?MODULE,exported,1,[1,1,1,1]), + ?RF(?MODULE,exported_wrap,1,[1,1,1,1]), + shutdown(), + setup([call,return_to]), + erlang:trace_pattern({?MODULE,'_','_'},[], + [local]), + erlang:trace_pattern({erlang,hash,'_'},[], + [local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported,[1]), + ?CT(?MODULE,local,[1]), + ?CT(?MODULE,local2,[1]), + ?CT(?MODULE,local_tail,[1]), + ?CT(erlang,hash,[1,1]), + ?RT(?MODULE,local_tail,1), + ?RT(?MODULE,local,1), + ?RT(?MODULE,exported,1), + ?RT(?MODULE,slave,2), + shutdown(), + setup([call,return_to]), + erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], + [local]), + erlang:trace_pattern({erlang,hash,'_'},[{'_',[],[{return_trace}]}], + [local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported,[1]), + ?CT(?MODULE,local,[1]), + ?CT(?MODULE,local2,[1]), + ?CT(?MODULE,local_tail,[1]), + ?CT(erlang,hash,[1,1]), + ?RF(erlang,hash,2,1), + ?RT(?MODULE,local_tail,1), + ?RF(?MODULE,local_tail,1,[1,1]), + ?RF(?MODULE,local2,1,[1,1]), + ?RT(?MODULE,local,1), + ?RF(?MODULE,local,1,[1,1,1]), + ?RT(?MODULE,exported,1), + ?RF(?MODULE,exported,1,[1,1,1,1]), + ?RF(?MODULE,exported_wrap,1,[1,1,1,1]), + ?RT(?MODULE,slave,2), + shutdown(), + ?NM, ok. on_and_off_test() -> - ?line Pid = setup([call]), - ?line 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line LocalTail = fun() -> - local_tail(1) - end, - ?line [1,1] = lambda_slave(LocalTail), - ?line ?CT(?MODULE,local_tail,[1]), - ?line erlang:trace(Pid,true,[return_to]), - ?line [1,1] = lambda_slave(LocalTail), - ?line ?CT(?MODULE,local_tail,[1]), - ?line ?RT(?MODULE,_,_), - ?line 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]), - ?line [1,1] = lambda_slave(LocalTail), - ?line ?NM, - ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[global]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[local]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?RT(?MODULE,slave,2), - ?line 1 = erlang:trace_pattern({erlang,hash,2},[],[local]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(erlang,hash,[1,1]), - ?line ?RT(?MODULE,local_tail,1), - ?line ?RT(?MODULE,slave,2), - ?line erlang:trace(Pid,true,[timestamp]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(?MODULE,exported_wrap,[1]), - ?line ?CTT(erlang,hash,[1,1]), - ?line ?RTT(?MODULE,local_tail,1), - ?line ?RTT(?MODULE,slave,2), - ?line erlang:trace(Pid,false,[return_to,timestamp]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(erlang,hash,[1,1]), - ?line erlang:trace(Pid,true,[return_to]), - ?line 1 = erlang:trace_pattern({erlang,hash,2},[],[]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(erlang,hash,[1,1]), - ?line ?RT(?MODULE,slave,2), - ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]), - ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CT(?MODULE,exported_wrap,[1]), - ?line ?CT(erlang,hash,[1,1]), - ?line shutdown(), - ?line erlang:trace_pattern({'_','_','_'},false,[local]), - ?line N = erlang:trace_pattern({erlang,'_','_'},true,[local]), - ?line case erlang:trace_pattern({erlang,'_','_'},false,[local]) of - N -> - ok; - Else -> - exit({number_mismatch, {expected, N}, {got, Else}}) - end, - ?line case erlang:trace_pattern({erlang,'_','_'},false,[local]) of - N -> - ok; - Else2 -> - exit({number_mismatch, {expected, N}, {got, Else2}}) - end, - ?line M = erlang:trace_pattern({erlang,'_','_'},true,[]), - ?line case erlang:trace_pattern({erlang,'_','_'},false,[]) of - M -> - ok; - Else3 -> - exit({number_mismatch, {expected, N}, {got, Else3}}) - end, - ?line case erlang:trace_pattern({erlang,'_','_'},false,[]) of - M -> - ok; - Else4 -> - exit({number_mismatch, {expected, N}, {got, Else4}}) - end, - ?line ?NM, + Pid = setup([call]), + 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + LocalTail = fun() -> + local_tail(1) + end, + [1,1] = lambda_slave(LocalTail), + ?CT(?MODULE,local_tail,[1]), + erlang:trace(Pid,true,[return_to]), + [1,1] = lambda_slave(LocalTail), + ?CT(?MODULE,local_tail,[1]), + ?RT(?MODULE,_,_), + 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]), + [1,1] = lambda_slave(LocalTail), + ?NM, + 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[global]), + [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[local]), + [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?RT(?MODULE,slave,2), + 1 = erlang:trace_pattern({erlang,hash,2},[],[local]), + [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(erlang,hash,[1,1]), + ?RT(?MODULE,local_tail,1), + ?RT(?MODULE,slave,2), + erlang:trace(Pid,true,[timestamp]), + [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(?MODULE,exported_wrap,[1]), + ?CTT(erlang,hash,[1,1]), + ?RTT(?MODULE,local_tail,1), + ?RTT(?MODULE,slave,2), + erlang:trace(Pid,false,[return_to,timestamp]), + [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(erlang,hash,[1,1]), + erlang:trace(Pid,true,[return_to]), + 1 = erlang:trace_pattern({erlang,hash,2},[],[]), + [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(erlang,hash,[1,1]), + ?RT(?MODULE,slave,2), + 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]), + [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?CT(?MODULE,exported_wrap,[1]), + ?CT(erlang,hash,[1,1]), + shutdown(), + erlang:trace_pattern({'_','_','_'},false,[local]), + N = erlang:trace_pattern({erlang,'_','_'},true,[local]), + case erlang:trace_pattern({erlang,'_','_'},false,[local]) of + N -> + ok; + Else -> + exit({number_mismatch, {expected, N}, {got, Else}}) + end, + case erlang:trace_pattern({erlang,'_','_'},false,[local]) of + N -> + ok; + Else2 -> + exit({number_mismatch, {expected, N}, {got, Else2}}) + end, + M = erlang:trace_pattern({erlang,'_','_'},true,[]), + case erlang:trace_pattern({erlang,'_','_'},false,[]) of + M -> + ok; + Else3 -> + exit({number_mismatch, {expected, N}, {got, Else3}}) + end, + case erlang:trace_pattern({erlang,'_','_'},false,[]) of + M -> + ok; + Else4 -> + exit({number_mismatch, {expected, N}, {got, Else4}}) + end, + ?NM, ok. systematic_on_off(Config) when is_list(Config) -> @@ -634,12 +568,12 @@ systematic_on_off_1(Local) -> verify_trace_info(Global, Local) -> case erlang:trace_info({?MODULE,exported_wrap,1}, all) of - {all,false} -> - false = Global, - [] = Local; - {all,Ps} -> - io:format("~p\n", [Ps]), - [verify_trace_info(P, Global, Local) || P <- Ps] + {all,false} -> + false = Global, + [] = Local; + {all,Ps} -> + io:format("~p\n", [Ps]), + [verify_trace_info(P, Global, Local) || P <- Ps] end, global_call(Global, Local), local_call(Local), @@ -651,12 +585,10 @@ verify_trace_info({match_spec,[]}, _, _) -> ok; verify_trace_info({meta_match_spec,[]}, _, _) -> ok; verify_trace_info({LocalFlag,Bool}, _, Local) when is_boolean(Bool) -> try - Bool = lists:member(LocalFlag, Local) + Bool = lists:member(LocalFlag, Local) catch - error:_ -> - io:format("Line ~p: {~p,~p}, false, ~p\n", - [?LINE,LocalFlag,Bool,Local]), - ?t:fail() + error:_ -> + ct:fail("Line ~p: {~p,~p}, false, ~p\n", [?LINE,LocalFlag,Bool,Local]) end; verify_trace_info({meta,Pid}, false, Local) when is_pid(Pid) -> true = lists:member(meta, Local); @@ -668,10 +600,10 @@ verify_trace_info({call_count,_}, false, Local) -> global_call(Global, Local) -> apply_slave(?MODULE, exported_wrap, [global_call]), case Global of - false -> - recv_local_call(Local, [global_call]); - true -> - ?CT(?MODULE, exported_wrap, [global_call]) + false -> + recv_local_call(Local, [global_call]); + true -> + ?CT(?MODULE, exported_wrap, [global_call]) end. local_call(Local) -> @@ -680,16 +612,16 @@ local_call(Local) -> recv_local_call(Local, Args) -> case lists:member(local, Local) of - false -> - ok; - true -> - ?CT(?MODULE, exported_wrap, Args) + false -> + ok; + true -> + ?CT(?MODULE, exported_wrap, Args) end, case lists:member(meta, Local) of - false -> - ok; - true -> - ?CTT(?MODULE, exported_wrap, Args) + false -> + ok; + true -> + ?CTT(?MODULE, exported_wrap, Args) end, ok. @@ -698,99 +630,99 @@ combinations([_]=One) -> combinations([H|T]) -> Cs = combinations(T), [[H|C] || C <- Cs] ++ Cs. - + stack_grow_test() -> - ?line setup([call,return_to]), - ?line 1 = erlang:trace_pattern({?MODULE,loop,4}, - [{'_',[],[{return_trace}]}],[local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line Num = 1 bsl 15, - ?line Fun = - fun(_F,0) -> ok; - (F,N) -> - receive _A -> - receive _B -> - receive _C -> - F(F,N-1) - end - end - end - end, - ?line apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), - ?line Fun(Fun,Num + 1), - ?line ?NM, + setup([call,return_to]), + 1 = erlang:trace_pattern({?MODULE,loop,4}, + [{'_',[],[{return_trace}]}],[local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + Num = 1 bsl 15, + Fun = + fun(_F,0) -> ok; + (F,N) -> + receive _A -> + receive _B -> + receive _C -> + F(F,N-1) + end + end + end + end, + apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), + Fun(Fun,Num + 1), + ?NM, ok. info_test() -> - ?line Flags1 = lists:sort([call,return_to]), - ?line Pid = setup(Flags1), - ?line Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]}, - {'_',[],[]}], - ?line erlang:trace_pattern({?MODULE,exported_wrap,1},Prog,[local]), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), - ?line Self = self(), - ?line {flags,L} = erlang:trace_info(Pid,flags), - ?line case lists:sort(L) of - Flags1 -> - ok; - Wrong1 -> - exit({bad_result, {erlang,trace_info,[Pid,flags]}, - {expected, Flags1}, {got, Wrong1}}) - end, - ?line {tracer,Tracer} = erlang:trace_info(Pid,tracer), - ?line case Tracer of - Self -> - ok; - Wrong2 -> - exit({bad_result, {erlang,trace_info,[Pid,tracer]}, - {expected, Self}, {got, Wrong2}}) - end, - ?line {traced,local} = erlang:trace_info({?MODULE,exported_wrap,1},traced), - ?line {match_spec, MS} = - erlang:trace_info({?MODULE,exported_wrap,1},match_spec), - ?line case MS of - Prog -> - ok; - Wrong3 -> - exit({bad_result, {erlang,trace_info, - [{?MODULE,exported_wrap,1}, - match_spec]}, - {expected, Prog}, {got, Wrong3}}) - end, - ?line erlang:garbage_collect(self()), - ?line receive - after 1 -> - ok - end, - ?line io:format("~p~n",[MS]), - ?line {match_spec,MS2} = - erlang:trace_info({?MODULE,exported_wrap,1},match_spec), - ?line io:format("~p~n",[MS2]), - ?line erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]), - ?line {traced,global} = - erlang:trace_info({?MODULE,exported_wrap,1},traced), - ?line {match_spec,[]} = - erlang:trace_info({?MODULE,exported_wrap,1},match_spec), - ?line {traced,undefined} = - erlang:trace_info({?MODULE,exported_wrap,2},traced), - ?line {match_spec,undefined} = - erlang:trace_info({?MODULE,exported_wrap,2},match_spec), - ?line {traced,false} = erlang:trace_info({?MODULE,exported,1},traced), - ?line {match_spec,false} = - erlang:trace_info({?MODULE,exported,1},match_spec), - ?line shutdown(), + Flags1 = lists:sort([call,return_to]), + Pid = setup(Flags1), + Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]}, + {'_',[],[]}], + erlang:trace_pattern({?MODULE,exported_wrap,1},Prog,[local]), + erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + Self = self(), + {flags,L} = erlang:trace_info(Pid,flags), + case lists:sort(L) of + Flags1 -> + ok; + Wrong1 -> + exit({bad_result, {erlang,trace_info,[Pid,flags]}, + {expected, Flags1}, {got, Wrong1}}) + end, + {tracer,Tracer} = erlang:trace_info(Pid,tracer), + case Tracer of + Self -> + ok; + Wrong2 -> + exit({bad_result, {erlang,trace_info,[Pid,tracer]}, + {expected, Self}, {got, Wrong2}}) + end, + {traced,local} = erlang:trace_info({?MODULE,exported_wrap,1},traced), + {match_spec, MS} = + erlang:trace_info({?MODULE,exported_wrap,1},match_spec), + case MS of + Prog -> + ok; + Wrong3 -> + exit({bad_result, {erlang,trace_info, + [{?MODULE,exported_wrap,1}, + match_spec]}, + {expected, Prog}, {got, Wrong3}}) + end, + erlang:garbage_collect(self()), + receive + after 1 -> + ok + end, + io:format("~p~n",[MS]), + {match_spec,MS2} = + erlang:trace_info({?MODULE,exported_wrap,1},match_spec), + io:format("~p~n",[MS2]), + erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]), + {traced,global} = + erlang:trace_info({?MODULE,exported_wrap,1},traced), + {match_spec,[]} = + erlang:trace_info({?MODULE,exported_wrap,1},match_spec), + {traced,undefined} = + erlang:trace_info({?MODULE,exported_wrap,2},traced), + {match_spec,undefined} = + erlang:trace_info({?MODULE,exported_wrap,2},match_spec), + {traced,false} = erlang:trace_info({?MODULE,exported,1},traced), + {match_spec,false} = + erlang:trace_info({?MODULE,exported,1},match_spec), + shutdown(), ok. delete_test(Config) -> - ?line Priv = ?config(priv_dir, Config), - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "trace_local_dummy"), - ?line {ok,trace_local_dummy} = c:c(File, [{outdir,Priv}]), - ?line code:purge(trace_local_dummy), - ?line code:delete(trace_local_dummy), - ?line 0 = erlang:trace_pattern({trace_local_dummy,'_','_'},true,[local]), - ?line ?NM, + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + File = filename:join(Data, "trace_local_dummy"), + {ok,trace_local_dummy} = c:c(File, [{outdir,Priv}]), + code:purge(trace_local_dummy), + code:delete(trace_local_dummy), + 0 = erlang:trace_pattern({trace_local_dummy,'_','_'},true,[local]), + ?NM, ok. @@ -798,34 +730,34 @@ delete_test(Config) -> %%% exception_test %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% exception_test(Opts) -> - ?line {ProcFlags,PatFlags} = - case proplists:get_bool(meta, Opts) of - true -> {[timestamp],[meta]}; - false -> {[call,return_to,timestamp],[local]} - end, - ?line case proplists:get_bool(nocatch, Opts) of - false -> - ?line Exceptions = exceptions(), - ?line exception_test_setup(ProcFlags, PatFlags), - ?line lists:foreach( - fun ({Func,Args}) -> - ?line exception_test(Opts, Func, Args) - end, - Exceptions), - ?line shutdown(); - true -> - ?line Exceptions = exceptions(), - ?line lists:foreach( - fun ({Func,Args}) -> - ?line exception_test_setup( - [procs|ProcFlags], - PatFlags), - ?line exception_test(Opts, Func, Args), - ?line shutdown() - end, - Exceptions) - end, - ?line ok. + {ProcFlags,PatFlags} = + case proplists:get_bool(meta, Opts) of + true -> {[timestamp],[meta]}; + false -> {[call,return_to,timestamp],[local]} + end, + case proplists:get_bool(nocatch, Opts) of + false -> + Exceptions = exceptions(), + exception_test_setup(ProcFlags, PatFlags), + lists:foreach( + fun ({Func,Args}) -> + exception_test(Opts, Func, Args) + end, + Exceptions), + shutdown(); + true -> + Exceptions = exceptions(), + lists:foreach( + fun ({Func,Args}) -> + exception_test_setup( + [procs|ProcFlags], + PatFlags), + exception_test(Opts, Func, Args), + shutdown() + end, + Exceptions) + end, + ok. exceptions() -> Ref = make_ref(), @@ -848,65 +780,65 @@ exceptions() -> {{?MODULE,lists_reverse}, [LL,[]]}]. exception_test_setup(ProcFlags, PatFlags) -> - ?line Pid = setup(ProcFlags), - ?line io:format("=== exception_test_setup(~p, ~p): ~p~n", - [ProcFlags,PatFlags,Pid]), - ?line Mprog = [{'_',[],[{exception_trace}]}], - ?line erlang:trace_pattern({?MODULE,'_','_'}, Mprog, PatFlags), - ?line erlang:trace_pattern({?MODULE,slave,'_'},false,PatFlags), - ?line [1,1,1,1,1] = - [erlang:trace_pattern({erlang,F,A}, Mprog, PatFlags) - || {F,A} <- [{exit,1},{error,1},{error,2},{throw,1},{'++',2}]], - ?line 1 = erlang:trace_pattern({lists,reverse,2}, Mprog, PatFlags), - ?line ok. + Pid = setup(ProcFlags), + io:format("=== exception_test_setup(~p, ~p): ~p~n", + [ProcFlags,PatFlags,Pid]), + Mprog = [{'_',[],[{exception_trace}]}], + erlang:trace_pattern({?MODULE,'_','_'}, Mprog, PatFlags), + erlang:trace_pattern({?MODULE,slave,'_'},false,PatFlags), + [1,1,1,1,1] = + [erlang:trace_pattern({erlang,F,A}, Mprog, PatFlags) + || {F,A} <- [{exit,1},{error,1},{error,2},{throw,1},{'++',2}]], + 1 = erlang:trace_pattern({lists,reverse,2}, Mprog, PatFlags), + ok. -record(exc_opts, {nocatch=false, meta=false}). exception_test(Opts, Func0, Args0) -> - ?line io:format("=== exception_test(~p, ~p, ~p)~n", - [Opts,Func0,abbr(Args0)]), - ?line Apply = proplists:get_bool(apply, Opts), - ?line Function = proplists:get_bool(function, Opts), - ?line Nocatch = proplists:get_bool(nocatch, Opts), - ?line Meta = proplists:get_bool(meta, Opts), - ?line ExcOpts = #exc_opts{nocatch=Nocatch,meta=Meta}, - + io:format("=== exception_test(~p, ~p, ~p)~n", + [Opts,Func0,abbr(Args0)]), + Apply = proplists:get_bool(apply, Opts), + Function = proplists:get_bool(function, Opts), + Nocatch = proplists:get_bool(nocatch, Opts), + Meta = proplists:get_bool(meta, Opts), + ExcOpts = #exc_opts{nocatch=Nocatch,meta=Meta}, + %% Func0 and Args0 are for the innermost call, now we will %% wrap them in wrappers... - ?line {Func1,Args1} = - case Function of - true -> {fun exc/2,[Func0,Args0]}; - false -> {Func0,Args0} - end, - - ?line {Func,Args} = - case Apply of - true -> {{erlang,apply},[Func1,Args1]}; - false -> {Func1,Args1} - end, - - ?line R1 = exc_slave(ExcOpts, Func, Args), - ?line Stack2 = [{?MODULE,exc_top,3,[]},{?MODULE,slave,2,[]}], - ?line Stack3 = [{?MODULE,exc,2,[]}|Stack2], - ?line Rs = - case x_exc_top(ExcOpts, Func, Args) of % Emulation - {crash,{Reason,Stack}}=R when is_list(Stack) -> - [R, - {crash,{Reason,Stack++Stack2}}, - {crash,{Reason,Stack++Stack3}}]; - R -> - [R] - end, - ?line exception_validate(R1, Rs), - ?line case R1 of - {crash,Crash} -> - ?line expect({trace_ts,exit,Crash}); - _ when not Meta -> - ?line expect({rtt,{?MODULE,slave,2}}); - _ -> - ok - end, - ?line expect({nm}). + {Func1,Args1} = + case Function of + true -> {fun exc/2,[Func0,Args0]}; + false -> {Func0,Args0} + end, + + {Func,Args} = + case Apply of + true -> {{erlang,apply},[Func1,Args1]}; + false -> {Func1,Args1} + end, + + R1 = exc_slave(ExcOpts, Func, Args), + Stack2 = [{?MODULE,exc_top,3,[]},{?MODULE,slave,2,[]}], + Stack3 = [{?MODULE,exc,2,[]}|Stack2], + Rs = + case x_exc_top(ExcOpts, Func, Args) of % Emulation + {crash,{Reason,Stack}}=R when is_list(Stack) -> + [R, + {crash,{Reason,Stack++Stack2}}, + {crash,{Reason,Stack++Stack3}}]; + R -> + [R] + end, + exception_validate(R1, Rs), + case R1 of + {crash,Crash} -> + expect({trace_ts,exit,Crash}); + _ when not Meta -> + expect({rtt,{?MODULE,slave,2}}); + _ -> + ok + end, + expect({nm}). exception_validate(R0, Rs0) -> R = clean_location(R0), @@ -915,16 +847,16 @@ exception_validate(R0, Rs0) -> exception_validate_1(R1, [R2|Rs]) -> case [R1|R2] of - [R|R] -> - ok; - [{crash,{badarg,[{lists,reverse,[L1a,L1b],_}|T]}}| - {crash,{badarg,[{lists,reverse,[L2a,L2b],_}|T]}}] -> - same({crash,{badarg,[{lists,reverse, - [lists:reverse(L1b, L1a),[]],[]}|T]}}, - {crash,{badarg,[{lists,reverse, - [lists:reverse(L2b, L2a),[]],[]}|T]}}); - _ when is_list(Rs), Rs =/= [] -> - exception_validate(R1, Rs) + [R|R] -> + ok; + [{crash,{badarg,[{lists,reverse,[L1a,L1b],_}|T]}}| + {crash,{badarg,[{lists,reverse,[L2a,L2b],_}|T]}}] -> + same({crash,{badarg,[{lists,reverse, + [lists:reverse(L1b, L1a),[]],[]}|T]}}, + {crash,{badarg,[{lists,reverse, + [lists:reverse(L2b, L2a),[]],[]}|T]}}); + _ when is_list(Rs), Rs =/= [] -> + exception_validate(R1, Rs) end. clean_location({crash,{Reason,Stk0}}) -> @@ -942,20 +874,20 @@ concurrency(_Config) -> %% if an aligned word-sized write is not atomic. Ps0 = [spawn_monitor(fun() -> infinite_loop() end) || - _ <- lists:seq(1, 2*N)], + _ <- lists:seq(1, 2*N)], OnAndOff = fun() -> concurrency_on_and_off() end, Ps1 = [spawn_monitor(OnAndOff)|Ps0], - ?t:sleep(1000), + timer:sleep(1000), %% Now spawn off N more processes that turn on off and off %% a local trace pattern. Ps = [spawn_monitor(OnAndOff) || _ <- lists:seq(1, N)] ++ Ps1, - ?t:sleep(1000), + timer:sleep(1000), %% Clean up. [exit(Pid, kill) || {Pid,_} <- Ps], [receive - {'DOWN',Ref,process,Pid,killed} -> ok + {'DOWN',Ref,process,Pid,killed} -> ok end || {Pid,Ref} <- Ps], erlang:trace_pattern({?MODULE,infinite_loop,0}, false, [local]), ok. @@ -999,16 +931,16 @@ local_tail(Val) -> exc_top(ExcOpts, Func, Args) -> case ExcOpts#exc_opts.nocatch of - false -> - try exc_jump(Func, Args) of - Value -> - {value,Value} - catch - Class:Reason -> - {Class,Reason} - end; - true -> - {value,exc_jump(Func, Args)} + false -> + try exc_jump(Func, Args) of + Value -> + {value,Value} + catch + Class:Reason -> + {Class,Reason} + end; + true -> + {value,exc_jump(Func, Args)} end. %% x_* functions emulate the non-x_* ones. @@ -1017,42 +949,42 @@ exc_top(ExcOpts, Func, Args) -> %% The only possible place for exception %% is below exc/2. x_exc_top(ExcOpts, Func, Args) -> - ?line Rtt = not ExcOpts#exc_opts.meta, - ?line expect({ctt,{?MODULE,exc_top},[ExcOpts,Func,Args]}), - ?line case x_exc_jump(ExcOpts, Func, Args) of - Result when not ExcOpts#exc_opts.nocatch -> - ?line expect([Rtt,{rtt,{?MODULE,exc_top,3}}, - ?LINE,{rft,{?MODULE,exc_top,3},Result}]), - ?line Result; - {value,_}=Result -> - - ?line expect([Rtt,{rtt,{?MODULE,exc_top,3}}, - ?LINE,{rft,{?MODULE,exc_top,3},Result}]), - ?line Result; - {exit,Reason}=CR -> - ?line expect({eft,{?MODULE,exc_top,3},CR}), - ?line {crash,Reason}; - {error,Reason}=CR -> - ?line expect({eft,{?MODULE,exc_top,3},CR}), - ?line {crash,{Reason,x_exc_stacktrace()}}; - CR -> - ?line expect({eft,{?MODULE,exc_top,3},CR}), - ?line {crash,CR} - end. + Rtt = not ExcOpts#exc_opts.meta, + expect({ctt,{?MODULE,exc_top},[ExcOpts,Func,Args]}), + case x_exc_jump(ExcOpts, Func, Args) of + Result when not ExcOpts#exc_opts.nocatch -> + expect([Rtt,{rtt,{?MODULE,exc_top,3}}, + ?LINE,{rft,{?MODULE,exc_top,3},Result}]), + Result; + {value,_}=Result -> + + expect([Rtt,{rtt,{?MODULE,exc_top,3}}, + ?LINE,{rft,{?MODULE,exc_top,3},Result}]), + Result; + {exit,Reason}=CR -> + expect({eft,{?MODULE,exc_top,3},CR}), + {crash,Reason}; + {error,Reason}=CR -> + expect({eft,{?MODULE,exc_top,3},CR}), + {crash,{Reason,x_exc_stacktrace()}}; + CR -> + expect({eft,{?MODULE,exc_top,3},CR}), + {crash,CR} + end. exc_jump(Func, Args) -> exc(Func, Args, jump). x_exc_jump(ExcOpts, Func, Args) -> - ?line expect({ctt,{?MODULE,exc_jump},[Func,Args]}), - ?line case x_exc(ExcOpts, Func, Args, jump) of - {value,Value}=Result -> - ?line expect({rft,{?MODULE,exc_jump,2},Value}), - ?line Result; - CR -> - ?line expect({eft,{?MODULE,exc_jump,2},CR}), - ?line CR - end. + expect({ctt,{?MODULE,exc_jump},[Func,Args]}), + case x_exc(ExcOpts, Func, Args, jump) of + {value,Value}=Result -> + expect({rft,{?MODULE,exc_jump,2},Value}), + Result; + CR -> + expect({eft,{?MODULE,exc_jump,2},CR}), + CR + end. exc(Func, Args, jump) -> exc(Func, Args, do); @@ -1060,25 +992,25 @@ exc(Func, Args, do) -> exc(Func, Args). x_exc(ExcOpts, Func, Args, jump) -> - ?line expect({ctt,{?MODULE,exc},[Func,Args,jump]}), - ?line case x_exc(ExcOpts, Func, Args, do) of - {value,Value}=Result -> - ?line expect({rft,{?MODULE,exc,3},Value}), - ?line Result; - CR -> - ?line expect({eft,{?MODULE,exc,3},CR}), - ?line CR - end; + expect({ctt,{?MODULE,exc},[Func,Args,jump]}), + case x_exc(ExcOpts, Func, Args, do) of + {value,Value}=Result -> + expect({rft,{?MODULE,exc,3},Value}), + Result; + CR -> + expect({eft,{?MODULE,exc,3},CR}), + CR + end; x_exc(ExcOpts, Func, Args, do) -> - ?line expect({ctt,{?MODULE,exc},[Func,Args,do]}), - ?line case x_exc(ExcOpts, Func, Args) of - {value,Value}=Result -> - ?line expect({rft,{?MODULE,exc,3},Value}), - ?line Result; - CR -> - ?line expect({eft,{?MODULE,exc,3},CR}), - ?line CR - end. + expect({ctt,{?MODULE,exc},[Func,Args,do]}), + case x_exc(ExcOpts, Func, Args) of + {value,Value}=Result -> + expect({rft,{?MODULE,exc,3},Value}), + Result; + CR -> + expect({eft,{?MODULE,exc,3},CR}), + CR + end. exc({erlang,apply}, [{M,F},A]) -> erlang:apply(M, F, id(A)); @@ -1108,114 +1040,114 @@ exc(Func, [A,B]) when is_function(Func, 2) -> Func(A, id(B)). x_exc(ExcOpts, {erlang,apply}=Func0, [{_,_}=Func,Args]=Args0) -> - ?line expect({ctt,{?MODULE,exc},[Func0,Args0]}), - ?line x_exc_body(ExcOpts, Func, Args, true); + expect({ctt,{?MODULE,exc},[Func0,Args0]}), + x_exc_body(ExcOpts, Func, Args, true); x_exc(ExcOpts, {erlang,apply}=Func0, [Func,Args]=Args0) when is_function(Func, 2)-> - ?line expect({ctt,{?MODULE,exc},[Func0,Args0]}), - ?line x_exc_func(ExcOpts, Func, Args, Args); + expect({ctt,{?MODULE,exc},[Func0,Args0]}), + x_exc_func(ExcOpts, Func, Args, Args); x_exc(ExcOpts, {_,_}=Func, Args) -> - ?line expect({ctt,{?MODULE,exc},[Func,Args]}), - ?line x_exc_body(ExcOpts, Func, Args, false); + expect({ctt,{?MODULE,exc},[Func,Args]}), + x_exc_body(ExcOpts, Func, Args, false); x_exc(ExcOpts, Func0, [_,Args]=Args0) when is_function(Func0, 2) -> - ?line expect({ctt,{?MODULE,exc},[Func0,Args0]}), - ?line x_exc_func(ExcOpts, Func0, Args0, Args). + expect({ctt,{?MODULE,exc},[Func0,Args0]}), + x_exc_func(ExcOpts, Func0, Args0, Args). x_exc_func(ExcOpts, Func, [Func1,Args1]=Args, Id) -> %% Assumes the called fun =:= fun exc/2, %% will utterly fail otherwise. - ?line Rtt = not ExcOpts#exc_opts.meta, - ?line {module,M} = erlang:fun_info(Func, module), - ?line {name,F} = erlang:fun_info(Func, name), - ?line expect([{ctt,{?MODULE,id},[Id]}, - ?LINE,{rft,{?MODULE,id,1},Id}, - ?LINE,Rtt,{rtt,{?MODULE,exc,2}}, - ?LINE,{ctt,{M,F},Args}]), - ?line case x_exc(ExcOpts, Func1, Args1) of - {value,Value}=Result -> - ?line expect([{rft,{M,F,2},Value}, - ?LINE,{rft,{?MODULE,exc,2},Value}]), - ?line Result; - CR -> - ?line expect([{eft,{M,F,2},CR}, - ?LINE,{eft,{?MODULE,exc,2},CR}]), - ?line CR - end. + Rtt = not ExcOpts#exc_opts.meta, + {module,M} = erlang:fun_info(Func, module), + {name,F} = erlang:fun_info(Func, name), + expect([{ctt,{?MODULE,id},[Id]}, + ?LINE,{rft,{?MODULE,id,1},Id}, + ?LINE,Rtt,{rtt,{?MODULE,exc,2}}, + ?LINE,{ctt,{M,F},Args}]), + case x_exc(ExcOpts, Func1, Args1) of + {value,Value}=Result -> + expect([{rft,{M,F,2},Value}, + ?LINE,{rft,{?MODULE,exc,2},Value}]), + Result; + CR -> + expect([{eft,{M,F,2},CR}, + ?LINE,{eft,{?MODULE,exc,2},CR}]), + CR + end. x_exc_body(ExcOpts, {M,F}=Func, Args, Apply) -> - ?line Nocatch = ExcOpts#exc_opts.nocatch, - ?line Rtt = not ExcOpts#exc_opts.meta, - ?line Id = case Apply of - true -> Args; - false -> lists:last(Args) - end, - ?line expect([{ctt,{?MODULE,id},[Id]}, - ?LINE,{rft,{?MODULE,id,1},Id}, - ?LINE,Rtt,{rtt,{?MODULE,exc,2}}, - ?LINE,{ctt,{M,F},Args}]), - ?line Arity = length(Args), - ?line try exc(Func, Args) of - Value -> - ?line x_exc_value(Rtt, M, F, Args, Arity, Value), - ?line case expect() of - {rtt,{M,F,Arity}} when Rtt, Apply -> - %% We may get the above when - %% applying a BIF. - ?line expect({rft,{?MODULE,exc,2},Value}); - {rtt,{?MODULE,exc,2}} when Rtt, not Apply -> - %% We may get the above when - %% calling a BIF. - ?line expect({rft,{?MODULE,exc,2},Value}); - {rft,{?MODULE,exc,2},Value} -> - ?line ok - end, - ?line {value,Value} - catch - Thrown when Nocatch -> - ?line CR = {error,{nocatch,Thrown}}, - ?line x_exc_exception(Rtt, M, F, Args, Arity, CR), - ?line expect({eft,{?MODULE,exc,2},CR}), - ?line CR; - Class:Reason -> - ?line CR = {Class,Reason}, - ?line x_exc_exception(Rtt, M, F, Args, Arity, CR), - ?line expect({eft,{?MODULE,exc,2},CR}), - ?line CR - end. + Nocatch = ExcOpts#exc_opts.nocatch, + Rtt = not ExcOpts#exc_opts.meta, + Id = case Apply of + true -> Args; + false -> lists:last(Args) + end, + expect([{ctt,{?MODULE,id},[Id]}, + ?LINE,{rft,{?MODULE,id,1},Id}, + ?LINE,Rtt,{rtt,{?MODULE,exc,2}}, + ?LINE,{ctt,{M,F},Args}]), + Arity = length(Args), + try exc(Func, Args) of + Value -> + x_exc_value(Rtt, M, F, Args, Arity, Value), + case expect() of + {rtt,{M,F,Arity}} when Rtt, Apply -> + %% We may get the above when + %% applying a BIF. + expect({rft,{?MODULE,exc,2},Value}); + {rtt,{?MODULE,exc,2}} when Rtt, not Apply -> + %% We may get the above when + %% calling a BIF. + expect({rft,{?MODULE,exc,2},Value}); + {rft,{?MODULE,exc,2},Value} -> + ok + end, + {value,Value} + catch + Thrown when Nocatch -> + CR = {error,{nocatch,Thrown}}, + x_exc_exception(Rtt, M, F, Args, Arity, CR), + expect({eft,{?MODULE,exc,2},CR}), + CR; + Class:Reason -> + CR = {Class,Reason}, + x_exc_exception(Rtt, M, F, Args, Arity, CR), + expect({eft,{?MODULE,exc,2},CR}), + CR + end. x_exc_value(Rtt, ?MODULE, lists_reverse, [La,Lb], 2, R) -> - ?line L = lists:reverse(Lb, La), - ?line expect([fun ({ctt,{lists,reverse},[L1,L2]}) -> - ?line same(L, lists:reverse(L2, L1)), - ?line next; - (Msg) -> - ?line same({rft,{lists,reverse,2},R}, Msg), - ?line same(R, lists:reverse(L, [])), - ?line done - end, - ?LINE,Rtt,{rtt,{?MODULE,lists_reverse,2}}, - ?LINE,{rft,{?MODULE,lists_reverse,2},R}]); + L = lists:reverse(Lb, La), + expect([fun ({ctt,{lists,reverse},[L1,L2]}) -> + same(L, lists:reverse(L2, L1)), + next; + (Msg) -> + same({rft,{lists,reverse,2},R}, Msg), + same(R, lists:reverse(L, [])), + done + end, + ?LINE,Rtt,{rtt,{?MODULE,lists_reverse,2}}, + ?LINE,{rft,{?MODULE,lists_reverse,2},R}]); x_exc_value(_Rtt, M, F, _, Arity, Value) -> - ?line expect({rft,{M,F,Arity},Value}). + expect({rft,{M,F,Arity},Value}). x_exc_exception(_Rtt, ?MODULE, lists_reverse, [La,Lb], 2, CR) -> - ?line L = lists:reverse(Lb, La), - ?line expect([fun ({ctt,{lists,reverse},[L1,L2]}) -> - ?line same(L, lists:reverse(L2, L1)), - ?line next; - (Msg) -> - ?line same({eft,{lists,reverse,2},CR}, Msg), - ?line done - end, - ?LINE,{eft,{?MODULE,lists_reverse,2},CR}]); + L = lists:reverse(Lb, La), + expect([fun ({ctt,{lists,reverse},[L1,L2]}) -> + same(L, lists:reverse(L2, L1)), + next; + (Msg) -> + same({eft,{lists,reverse,2},CR}, Msg), + done + end, + ?LINE,{eft,{?MODULE,lists_reverse,2},CR}]); x_exc_exception(Rtt, ?MODULE, undef, [_], 1, {Class,Reason}=CR) -> - ?line expect([{ctt,{erlang,Class},[Reason]}, - ?LINE,{eft,{erlang,Class,1},CR}, - ?LINE,Rtt,{rtt,{error_handler,crash,1}}, - ?LINE,{eft,{?MODULE,undef,1},CR}]); + expect([{ctt,{erlang,Class},[Reason]}, + ?LINE,{eft,{erlang,Class,1},CR}, + ?LINE,Rtt,{rtt,{error_handler,crash,1}}, + ?LINE,{eft,{?MODULE,undef,1},CR}]); x_exc_exception(_Rtt, M, F, _, Arity, CR) -> - ?line expect({eft,{M,F,Arity},CR}). + expect({eft,{M,F,Arity},CR}). x_exc_stacktrace() -> x_exc_stacktrace(erlang:get_stacktrace()). @@ -1252,24 +1184,24 @@ lists_reverse(A, B) -> slave(Dest, Sync) -> Dest ! Sync, receive - {From,Tag,{apply,M,F,A}} when is_pid(From) -> - ?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]), - From ! {Tag,Res}, - slave(From, Tag); - {From,Tag,{lambda,Fun}} when is_pid(From) -> - Res = Fun(), - From ! {Tag,Res}, - slave(From, Tag); - {From,Tag,{exc_top,Catch,Func,Args}} when is_pid(From) -> - ?line ?dbgformat("Exc: ~p ~p~p ~n",[Catch,Func,Args]), - ?line Res = exc_top(Catch, Func, Args), - ?line ?dbgformat("done Exc: ~p ~p~p ~n",[Catch,Func,Args]), - From ! {Tag,Res}, - slave(From,Tag); - die -> - exit(normal) + {From,Tag,{apply,M,F,A}} when is_pid(From) -> + ?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 ! {Tag,Res}, + slave(From, Tag); + {From,Tag,{lambda,Fun}} when is_pid(From) -> + Res = Fun(), + From ! {Tag,Res}, + slave(From, Tag); + {From,Tag,{exc_top,Catch,Func,Args}} when is_pid(From) -> + ?dbgformat("Exc: ~p ~p~p ~n",[Catch,Func,Args]), + Res = exc_top(Catch, Func, Args), + ?dbgformat("done Exc: ~p ~p~p ~n",[Catch,Func,Args]), + From ! {Tag,Res}, + slave(From,Tag); + die -> + exit(normal) end. setup(ProcFlags) -> @@ -1280,30 +1212,34 @@ setup(ProcFlags) -> Pid = spawn(fun () -> slave(Self, Sync) end), Mref = erlang:monitor(process, Pid), receive - Sync -> - put(slave, {Pid,Mref}), - case ProcFlags of - [] -> ok; - _ -> - erlang:trace(Pid, true, ProcFlags) - end, - Pid + Sync -> + put(slave, {Pid,Mref}), + case ProcFlags of + [] -> ok; + _ -> + erlang:trace(Pid, true, ProcFlags) + end, + Pid end. shutdown() -> trace_off(), - {Pid,Mref} = get(slave), - try erlang:is_process_alive(Pid) of - true -> - Pid ! die, - receive - {'DOWN',Mref,process,Pid,Reason} -> - Reason - end; - _ -> - not_alive - catch _:_ -> - undefined + case get(slave) of + {Pid,Mref} -> + try erlang:is_process_alive(Pid) of + true -> + Pid ! die, + receive + {'DOWN',Mref,process,Pid,Reason} -> + Reason + end; + _ -> + not_alive + catch _:_ -> + undefined + end; + _ -> + undefined end. trace_off() -> @@ -1311,7 +1247,7 @@ trace_off() -> erlang:trace_pattern({'_','_','_'},false,[local]), erlang:trace_pattern({'_','_','_'},false,[meta]), erlang:trace(all, false, [all]). - + apply_slave_async(M,F,A) -> {Pid,Mref} = get(slave), @@ -1332,8 +1268,8 @@ lambda_slave(Fun) -> exc_slave(Opts, Func, Args) -> try request({exc_top,Opts,Func,Args}) catch - Reason -> - {crash,Reason} + Reason -> + {crash,Reason} end. request(Request) -> @@ -1344,13 +1280,13 @@ request(Request) -> result(Tag, Mref) -> receive - {Tag,Result} -> - receive - Tag -> - Result - end; - {'DOWN',Mref,process,_Pid,Reason} -> - throw(Reason) + {Tag,Result} -> + receive + Tag -> + Result + end; + {'DOWN',Mref,process,_Pid,Reason} -> + throw(Reason) end. @@ -1363,25 +1299,25 @@ receive_next() -> receive_next(TO) -> receive - M -> - M + M -> + M after TO -> - ?t:fail(timeout) + ct:fail(timeout) end. receive_no_next(TO) -> receive M -> - ?t:fail({unexpected_message,[M|flush(TO)]}) + ct:fail({unexpected_message,[M|flush(TO)]}) after TO -> - ok + ok end. flush(T) -> receive - M -> - [M|flush(T)] + M -> + [M|flush(T)] after T -> - [] + [] end. @@ -1416,19 +1352,19 @@ abbr(Term, _) -> Term. %% abbr_tuple(Tuple, N, J) when J =< size(Tuple) -> if J > N; N =< 0 -> - ['...']; + ['...']; true -> - [abbr(element(J, Tuple), N-1)|abbr_tuple(Tuple, J+1, N)] + [abbr(element(J, Tuple), N-1)|abbr_tuple(Tuple, J+1, N)] end; abbr_tuple(_, _, _) -> []. %% abbr_list(_, 0, R) -> case io_lib:printable_list(R) of - true -> - reverse(R, "..."); - false -> - reverse(R, '...') + true -> + reverse(R, "..."); + false -> + reverse(R, '...') end; abbr_list([H|T], N, R) -> M = N-1, diff --git a/erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl b/erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl index a5947de4aa..a886323302 100644 --- a/erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl +++ b/erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/test/trace_meta_SUITE.erl b/erts/emulator/test/trace_meta_SUITE.erl index 3b105ec6fe..b6a6fd5404 100644 --- a/erts/emulator/test/trace_meta_SUITE.erl +++ b/erts/emulator/test/trace_meta_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -46,7 +46,7 @@ -define(config(A,B),config(A,B)). -export([config/2]). -else. --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -endif. -ifdef(debug). @@ -66,22 +66,21 @@ config(priv_dir,_) -> ".". -else. %% When run in test server. --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2, not_run/1]). -export([basic/1, return/1, on_and_off/1, stack_grow/1, info/1, tracer/1, combo/1, nosilent/1]). init_per_testcase(_Case, Config) -> - Dog=test_server:timetrap(test_server:minutes(5)), - [{watchdog, Dog}|Config]. + Config. end_per_testcase(_Case, Config) -> shutdown(), - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), ok. -suite() -> [{ct_hooks,[ts_install_cth]}]. + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 5}}]. all() -> case test_server:is_native(trace_meta_SUITE) of @@ -91,74 +90,39 @@ case test_server:is_native(trace_meta_SUITE) of combo, nosilent] end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - not_run(Config) when is_list(Config) -> {skipped,"Native code"}. -basic(suite) -> - []; -basic(doc) -> - ["Tests basic meta trace"]; +%% Tests basic meta trace basic(Config) when is_list(Config) -> basic_test(). -return(suite) -> - []; -return(doc) -> - ["Tests return trace"]; +%% Tests return trace return(Config) when is_list(Config) -> return_test(). -on_and_off(suite) -> - []; -on_and_off(doc) -> - ["Tests turning trace parameters on and off"]; +%% Tests turning trace parameters on and off on_and_off(Config) when is_list(Config) -> on_and_off_test(). -stack_grow(doc) -> - ["Tests the stack growth during return traces"]; +%% Tests the stack growth during return traces stack_grow(Config) when is_list(Config) -> stack_grow_test(). -info(doc) -> - ["Tests the trace_info BIF"]; +%% Tests the trace_info BIF info(Config) when is_list(Config) -> info_test(). -tracer(suite) -> - []; -tracer(doc) -> - ["Tests stopping and changing tracer process"]; +%% Tests stopping and changing tracer process tracer(Config) when is_list(Config) -> tracer_test(). -combo(suite) -> - []; -combo(doc) -> - ["Tests combining local call trace with meta trace"]; +%% Tests combining local call trace with meta trace combo(Config) when is_list(Config) -> combo_test(). -nosilent(suite) -> - []; -nosilent(doc) -> - ["Tests that meta trace is not silenced by the silent process flag"]; +%% Tests that meta trace is not silenced by the silent process flag nosilent(Config) when is_list(Config) -> nosilent_test(). @@ -546,7 +510,7 @@ combo_test() -> {?RT(Slave,{?MODULE,receiver,1}), ?RF(Slave,{erlang,phash2,2},0)} -> ok; - Error1 -> ?t:fail({unexpected_message, Error1}) + Error1 -> ct:fail({unexpected_message, Error1}) end, case {receive_next_bytag(LocalTracer), receive_next_bytag(LocalTracer)} of @@ -556,7 +520,7 @@ combo_test() -> {?RT(Slave,{?MODULE,slave,1}), ?RF(Slave,{?MODULE,receiver,1},Ref)} -> ok; - Error2 -> ?t:fail({unexpected_message, Error2}) + Error2 -> ct:fail({unexpected_message, Error2}) end, shutdown(), ?NM, @@ -745,13 +709,13 @@ receive_next(TO) -> M -> M after TO -> - ?t:fail(timeout) + ct:fail(timeout) end. receive_no_next(TO) -> receive M -> - ?t:fail({unexpected_message, M}) + ct:fail({unexpected_message, M}) after TO -> ok diff --git a/erts/emulator/test/trace_nif_SUITE.erl b/erts/emulator/test/trace_nif_SUITE.erl index 1cd50350e3..8d5bff2a48 100644 --- a/erts/emulator/test/trace_nif_SUITE.erl +++ b/erts/emulator/test/trace_nif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,10 +20,9 @@ -module(trace_nif_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-export([all/0, suite/0]). -export([trace_nif/1, trace_nif_timestamp/1, trace_nif_local/1, @@ -45,259 +44,230 @@ all() -> trace_nif_return] end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - not_run(Config) when is_list(Config) -> {skipped,"Native code"}. -trace_nif(doc) -> "Test tracing NIFs."; +%% Test tracing NIFs. trace_nif(Config) when is_list(Config) -> load_nif(Config), - + do_trace_nif([]). -trace_nif_local(doc) -> "Test tracing NIFs with local flag."; +%% Test tracing NIFs with local flag. trace_nif_local(Config) when is_list(Config) -> load_nif(Config), do_trace_nif([local]). -trace_nif_meta(doc) -> "Test tracing NIFs with meta flag."; +%% Test tracing NIFs with meta flag. trace_nif_meta(Config) when is_list(Config) -> load_nif(Config), - ?line Pid=spawn_link(?MODULE, nif_process, []), - ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], [meta]), - - ?line Pid ! {apply_nif, nif, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}), - - ?line Pid ! {apply_nif, nif, ["Arg1"]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {?MODULE,nif, ["Arg1"]}}), - - ?line Pid ! {call_nif, nif, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {?MODULE,nif, []}}), - - ?line Pid ! {call_nif, nif, ["Arg1"]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {?MODULE,nif, ["Arg1"]}}), + Pid=spawn_link(?MODULE, nif_process, []), + erlang:trace_pattern({?MODULE,nif,'_'}, [], [meta]), + + Pid ! {apply_nif, nif, []}, + receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}), + + Pid ! {apply_nif, nif, ["Arg1"]}, + receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, ["Arg1"]}}), + + Pid ! {call_nif, nif, []}, + receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, []}}), + + Pid ! {call_nif, nif, ["Arg1"]}, + receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, ["Arg1"]}}), ok. do_trace_nif(Flags) -> - ?line Pid = spawn(?MODULE, nif_process, []), - ?line 1 = erlang:trace(Pid, true, [call]), - ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), - ?line Pid ! {apply_nif, nif, []}, - ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, []}}), - ?line Pid ! {apply_nif, nif, ["Arg1"]}, - ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, ["Arg1"]}}), + Pid = spawn(?MODULE, nif_process, []), + 1 = erlang:trace(Pid, true, [call]), + erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), + Pid ! {apply_nif, nif, []}, + receive_trace_msg({trace,Pid,call,{?MODULE,nif, []}}), + Pid ! {apply_nif, nif, ["Arg1"]}, + receive_trace_msg({trace,Pid,call,{?MODULE,nif, ["Arg1"]}}), + + Pid ! {call_nif, nif, []}, + receive_trace_msg({trace, Pid, call, {?MODULE,nif, []}}), - ?line Pid ! {call_nif, nif, []}, - ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, []}}), + Pid ! {call_nif, nif, ["Arg1"]}, + receive_trace_msg({trace, Pid, call, {?MODULE,nif, ["Arg1"]}}), - ?line Pid ! {call_nif, nif, ["Arg1"]}, - ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, ["Arg1"]}}), - %% Switch off - ?line 1 = erlang:trace(Pid, false, [call]), + 1 = erlang:trace(Pid, false, [call]), - ?line Pid ! {apply_nif, nif, []}, + Pid ! {apply_nif, nif, []}, receive_nothing(), - ?line Pid ! {apply_nif, nif, ["Arg1"]}, + Pid ! {apply_nif, nif, ["Arg1"]}, receive_nothing(), - ?line Pid ! {call_nif, nif, []}, + Pid ! {call_nif, nif, []}, receive_nothing(), - ?line Pid ! {call_nif, nif, ["Arg1"]}, + Pid ! {call_nif, nif, ["Arg1"]}, receive_nothing(), %% Switch on again - ?line 1 = erlang:trace(Pid, true, [call]), - ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), - ?line Pid ! {apply_nif, nif, []}, - ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, []}}), - ?line Pid ! {apply_nif, nif, ["Arg1"]}, - ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, ["Arg1"]}}), - - ?line Pid ! {call_nif, nif, []}, - ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, []}}), - - ?line Pid ! {call_nif, nif, ["Arg1"]}, - ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, ["Arg1"]}}), - - ?line 1 = erlang:trace(Pid, false, [call]), - ?line erlang:trace_pattern({?MODULE,nif,'_'}, false, Flags), - ?line exit(Pid, die), + 1 = erlang:trace(Pid, true, [call]), + erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), + Pid ! {apply_nif, nif, []}, + receive_trace_msg({trace,Pid,call,{?MODULE,nif, []}}), + Pid ! {apply_nif, nif, ["Arg1"]}, + receive_trace_msg({trace,Pid,call,{?MODULE,nif, ["Arg1"]}}), + + Pid ! {call_nif, nif, []}, + receive_trace_msg({trace, Pid, call, {?MODULE,nif, []}}), + + Pid ! {call_nif, nif, ["Arg1"]}, + receive_trace_msg({trace, Pid, call, {?MODULE,nif, ["Arg1"]}}), + + 1 = erlang:trace(Pid, false, [call]), + erlang:trace_pattern({?MODULE,nif,'_'}, false, Flags), + exit(Pid, die), ok. -trace_nif_timestamp(doc) -> "Test tracing NIFs with timestamps."; +%% Test tracing NIFs with timestamps. trace_nif_timestamp(Config) when is_list(Config) -> load_nif(Config), do_trace_nif_timestamp([]). -trace_nif_timestamp_local(doc) -> - "Test tracing NIFs with timestamps and local flag."; +%% Test tracing NIFs with timestamps and local flag. trace_nif_timestamp_local(Config) when is_list(Config) -> load_nif(Config), do_trace_nif_timestamp([local]). do_trace_nif_timestamp(Flags) -> - ?line Pid=spawn(?MODULE, nif_process, []), - ?line 1 = erlang:trace(Pid, true, [call,timestamp]), - ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), - - ?line Pid ! {apply_nif, nif, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}), - - ?line Pid ! {apply_nif, nif, ["Arg1"]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {?MODULE,nif, ["Arg1"]}}), - - ?line Pid ! {call_nif, nif, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {?MODULE,nif, []}}), - - ?line Pid ! {call_nif, nif, ["Arg1"]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {?MODULE,nif, ["Arg1"]}}), - + Pid=spawn(?MODULE, nif_process, []), + 1 = erlang:trace(Pid, true, [call,timestamp]), + erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), + + Pid ! {apply_nif, nif, []}, + receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}), + + Pid ! {apply_nif, nif, ["Arg1"]}, + receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, ["Arg1"]}}), + + Pid ! {call_nif, nif, []}, + receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, []}}), + + Pid ! {call_nif, nif, ["Arg1"]}, + receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, ["Arg1"]}}), + %% We should be able to turn off the timestamp. - ?line 1 = erlang:trace(Pid, false, [timestamp]), - - ?line Pid ! {call_nif, nif, []}, - ?line receive_trace_msg({trace,Pid,call, - {?MODULE,nif, []}}), - - ?line Pid ! {apply_nif, nif, ["tjoho"]}, - ?line receive_trace_msg({trace,Pid,call, - {?MODULE,nif, ["tjoho"]}}), - - ?line 1 = erlang:trace(Pid, false, [call]), - ?line erlang:trace_pattern({erlang,'_','_'}, false, Flags), - - ?line exit(Pid, die), + 1 = erlang:trace(Pid, false, [timestamp]), + + Pid ! {call_nif, nif, []}, + receive_trace_msg({trace,Pid,call, + {?MODULE,nif, []}}), + + Pid ! {apply_nif, nif, ["tjoho"]}, + receive_trace_msg({trace,Pid,call, + {?MODULE,nif, ["tjoho"]}}), + + 1 = erlang:trace(Pid, false, [call]), + erlang:trace_pattern({erlang,'_','_'}, false, Flags), + + exit(Pid, die), ok. -trace_nif_return(doc) -> - "Test tracing NIF's with return/return_to trace."; +%% Test tracing NIF's with return/return_to trace. trace_nif_return(Config) when is_list(Config) -> load_nif(Config), - ?line Pid=spawn(?MODULE, nif_process, []), - ?line 1 = erlang:trace(Pid, true, [call,timestamp,return_to]), - ?line erlang:trace_pattern({?MODULE,nif,'_'}, [{'_',[],[{return_trace}]}], - [local]), - - ?line Pid ! {apply_nif, nif, []}, - ?line receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {?MODULE,nif,0}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, nif_process,0}}), - - ?line Pid ! {call_nif, nif, ["Arg1"]}, - ?line receive_trace_msg_ts({trace_ts,Pid,call, - {?MODULE,nif, ["Arg1"]}}), - ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, - {?MODULE,nif,1}}), - ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, - {?MODULE, nif_process,0}}), + Pid=spawn(?MODULE, nif_process, []), + 1 = erlang:trace(Pid, true, [call,timestamp,return_to]), + erlang:trace_pattern({?MODULE,nif,'_'}, [{'_',[],[{return_trace}]}], + [local]), + + Pid ! {apply_nif, nif, []}, + receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}), + receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {?MODULE,nif,0}}), + receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, nif_process,0}}), + + Pid ! {call_nif, nif, ["Arg1"]}, + receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, ["Arg1"]}}), + receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {?MODULE,nif,1}}), + receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, nif_process,0}}), ok. receive_trace_msg(Mess) -> receive - Mess -> - ok; - Other -> - io:format("Expected: ~p,~nGot: ~p~n", [Mess, Other]), - ?t:fail() + Mess -> + ok; + Other -> + ct:fail("Expected: ~p,~nGot: ~p~n", [Mess, Other]) after 5000 -> - io:format("Expected: ~p,~nGot: timeout~n", [Mess]), - ?t:fail() + ct:fail("Expected: ~p,~nGot: timeout~n", [Mess]) end. receive_nothing() -> - ?line timeout = receive M -> M after 100 -> timeout end. + timeout = receive M -> M after 100 -> timeout end. receive_trace_msg_ts({trace_ts, Pid, call, {M,F,A}}) -> receive - {trace_ts, Pid, call, {M, F, A}, _Ts} -> - ok; - Other -> - io:format("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n" - "Got: ~p~n", - [Pid, M, F, A, Other]), - ?t:fail() + {trace_ts, Pid, call, {M, F, A}, _Ts} -> + ok; + Other -> + ct:fail("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n" + "Got: ~p~n", [Pid, M, F, A, Other]) after 5000 -> - io:format("Got timeout~n", []), - ?t:fail() + ct:fail("Got timeout~n", []) end. receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {M,F,A}}) -> receive - {trace_ts, Pid, return_from, {M, F, A}, _Value, _Ts} -> - ok; - Other -> - io:format("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n" - "Got: ~p~n", - [Pid, M, F, A, Other]), - ?t:fail() + {trace_ts, Pid, return_from, {M, F, A}, _Value, _Ts} -> + ok; + Other -> + ct:fail("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n" + "Got: ~p~n", [Pid, M, F, A, Other]) after 5000 -> - io:format("Got timeout~n", []), - ?t:fail() + ct:fail("Got timeout~n", []) end. receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}) -> receive - {trace_ts, Pid, return_to, {M, F, A}, _Ts} -> - ok; - Other -> - io:format("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n" - "Got: ~p~n", - [Pid, M, F, A, Other]), - ?t:fail() + {trace_ts, Pid, return_to, {M, F, A}, _Ts} -> + ok; + Other -> + ct:fail("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n" + "Got: ~p~n", [Pid, M, F, A, Other]) after 5000 -> - io:format("Got timeout~n", []), - ?t:fail() + ct:fail("Got timeout~n", []) end. nif_process() -> receive - {apply_nif, Name, Args} -> - ?line {ok,Args} = apply(?MODULE, Name, Args); - - {call_nif, Name, []} -> - ?line {ok, []} = ?MODULE:Name(); - - {call_nif, Name, [A1]} -> - ?line {ok, [A1]} = ?MODULE:Name(A1); - - {call_nif, Name, [A1,A2]} -> - ?line {ok,[A1,A2]} = ?MODULE:Name(A1,A2); - - {call_nif, Name, [A1,A2,A3]} -> - ?line {ok,[A1,A2,A3]} = ?MODULE:Name(A1,A2,A3) + {apply_nif, Name, Args} -> + {ok,Args} = apply(?MODULE, Name, Args); + + {call_nif, Name, []} -> + {ok, []} = ?MODULE:Name(); + + {call_nif, Name, [A1]} -> + {ok, [A1]} = ?MODULE:Name(A1); + + {call_nif, Name, [A1,A2]} -> + {ok,[A1,A2]} = ?MODULE:Name(A1,A2); + + {call_nif, Name, [A1,A2,A3]} -> + {ok,[A1,A2,A3]} = ?MODULE:Name(A1,A2,A3) end, nif_process(). load_nif(Config) -> - ?line Path = ?config(data_dir, Config), - - ?line ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0). + Path = proplists:get_value(data_dir, Config), + + ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0). nif() -> @@ -305,4 +275,3 @@ nif() -> nif(A1) -> {"Stub1",[A1]}. %exit(["nif/1 stub called",A1]). - diff --git a/erts/emulator/test/trace_port_SUITE.erl b/erts/emulator/test/trace_port_SUITE.erl index a77710205e..a66563d15b 100644 --- a/erts/emulator/test/trace_port_SUITE.erl +++ b/erts/emulator/test/trace_port_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,239 +21,205 @@ -module(trace_port_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([all/0, suite/0, call_trace/1, return_trace/1, send/1, receive_trace/1, process_events/1, schedule/1, - fake_schedule/1, - fake_schedule_after_register/1, - fake_schedule_after_getting_linked/1, - fake_schedule_after_getting_unlinked/1, gc/1, default_tracer/1, tracer_port_crash/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -test_cases() -> +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 30}}]. + +all() -> [call_trace, return_trace, send, receive_trace, - process_events, schedule, fake_schedule, - fake_schedule_after_register, - fake_schedule_after_getting_linked, - fake_schedule_after_getting_unlinked, gc, + process_events, schedule, gc, default_tracer, tracer_port_crash]. -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - test_cases(). - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:seconds(30)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -call_trace(doc) -> "Test sending call trace messages to a port."; +%% Test sending call trace messages to a port. call_trace(Config) when is_list(Config) -> case test_server:is_native(?MODULE) orelse - test_server:is_native(lists) of - true -> - {skip,"Native code"}; - false -> - ?line start_tracer(Config), - Self = self(), - ?line trace_func({lists,reverse,1}, []), - ?line trace_pid(Self, true, [call]), - ?line trace_info(Self, flags), - ?line trace_info(Self, tracer), - ?line [b,a] = lists:reverse([a,b]), - ?line expect({trace,Self,call,{lists,reverse,[[a,b]]}}), - - ?line trace_pid(Self, true, [timestamp]), - ?line trace_info(Self, flags), - ?line Huge = huge_data(), - ?line lists:reverse(Huge), - ?line expect({trace_ts,Self,call,{lists,reverse,[Huge]},ts}), - - ?line trace_pid(Self, true, [arity]), - ?line trace_info(Self, flags), - ?line [y,x] = lists:reverse([x,y]), - ?line expect({trace_ts,Self,call,{lists,reverse,1},ts}), - - ?line trace_pid(Self, false, [timestamp]), - ?line trace_info(Self, flags), - ?line [z,y,x] = lists:reverse([x,y,z]), - ?line expect({trace,Self,call,{lists,reverse,1}}), - - %% OTP-7399. Delayed sub-binary creation optimization. - ?line trace_pid(Self, false, [arity]), - ?line trace_info(Self, flags), - ?line trace_func({?MODULE,bs_sum_c,2}, [], [local]), - ?line 26 = bs_sum_c(<<3:4,5:4,7:4,11:4>>, 0), - ?line trace_func({?MODULE,bs_sum_c,2}, false, [local]), - ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<3:4,5:4,7:4,11:4>>,0]}}), - ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<5:4,7:4,11:4>>,3]}}), - ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<7:4,11:4>>,8]}}), - ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<11:4>>,15]}}), - ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<>>,26]}}), - - ?line trace_func({lists,reverse,1}, false), - ok + test_server:is_native(lists) of + true -> + {skip,"Native code"}; + false -> + start_tracer(Config), + Self = self(), + trace_func({lists,reverse,1}, []), + trace_pid(Self, true, [call]), + trace_info(Self, flags), + trace_info(Self, tracer), + [b,a] = lists:reverse([a,b]), + expect({trace,Self,call,{lists,reverse,[[a,b]]}}), + + trace_pid(Self, true, [timestamp]), + trace_info(Self, flags), + Huge = huge_data(), + lists:reverse(Huge), + expect({trace_ts,Self,call,{lists,reverse,[Huge]},ts}), + + trace_pid(Self, true, [arity]), + trace_info(Self, flags), + [y,x] = lists:reverse([x,y]), + expect({trace_ts,Self,call,{lists,reverse,1},ts}), + + trace_pid(Self, false, [timestamp]), + trace_info(Self, flags), + [z,y,x] = lists:reverse([x,y,z]), + expect({trace,Self,call,{lists,reverse,1}}), + + %% OTP-7399. Delayed sub-binary creation optimization. + trace_pid(Self, false, [arity]), + trace_info(Self, flags), + trace_func({?MODULE,bs_sum_c,2}, [], [local]), + 26 = bs_sum_c(<<3:4,5:4,7:4,11:4>>, 0), + trace_func({?MODULE,bs_sum_c,2}, false, [local]), + expect({trace,Self,call,{?MODULE,bs_sum_c,[<<3:4,5:4,7:4,11:4>>,0]}}), + expect({trace,Self,call,{?MODULE,bs_sum_c,[<<5:4,7:4,11:4>>,3]}}), + expect({trace,Self,call,{?MODULE,bs_sum_c,[<<7:4,11:4>>,8]}}), + expect({trace,Self,call,{?MODULE,bs_sum_c,[<<11:4>>,15]}}), + expect({trace,Self,call,{?MODULE,bs_sum_c,[<<>>,26]}}), + + trace_func({lists,reverse,1}, false), + ok end. bs_sum_c(<<H:4,T/bits>>, Acc) -> bs_sum_c(T, H+Acc); bs_sum_c(<<>>, Acc) -> Acc. -return_trace(doc) -> "Test the new return trace."; +%% Test the new return trace. return_trace(Config) when is_list(Config) -> case test_server:is_native(?MODULE) orelse - test_server:is_native(lists) of - true -> - {skip,"Native code"}; - false -> - ?line start_tracer(Config), - Self = self(), - MFA = {lists,reverse,1}, - - %% Plain (no timestamp, small data). - - ?line trace_func(MFA, [{['$1'],[],[{return_trace}, - {message,false}]}]), - ?line trace_pid(Self, true, [call]), - ?line trace_info(Self, flags), - ?line trace_info(Self, tracer), - ?line trace_info(MFA, match_spec), - ?line {traced,global} = trace_info(MFA, traced), - ?line [b,a] = lists:reverse([a,b]), - ?line expect({trace,Self,return_from,MFA,[b,a]}), - - %% Timestamp, huge data. - ?line trace_pid(Self, true, [timestamp]), - ?line Result = lists:reverse(huge_data()), - ?line expect({trace_ts,Self,return_from,MFA,Result,ts}), - - %% Turn off trace. - ?line trace_func(MFA, false), - ?line trace_info(MFA, match_spec), - ?line {traced,false} = trace_info(MFA, traced), - ok + test_server:is_native(lists) of + true -> + {skip,"Native code"}; + false -> + start_tracer(Config), + Self = self(), + MFA = {lists,reverse,1}, + + %% Plain (no timestamp, small data). + + trace_func(MFA, [{['$1'],[],[{return_trace}, + {message,false}]}]), + trace_pid(Self, true, [call]), + trace_info(Self, flags), + trace_info(Self, tracer), + trace_info(MFA, match_spec), + {traced,global} = trace_info(MFA, traced), + [b,a] = lists:reverse([a,b]), + expect({trace,Self,return_from,MFA,[b,a]}), + + %% Timestamp, huge data. + trace_pid(Self, true, [timestamp]), + Result = lists:reverse(huge_data()), + expect({trace_ts,Self,return_from,MFA,Result,ts}), + + %% Turn off trace. + trace_func(MFA, false), + trace_info(MFA, match_spec), + {traced,false} = trace_info(MFA, traced), + ok end. -send(doc) -> "Test sending send trace messages to a port."; +%% Test sending send trace messages to a port. send(Config) when is_list(Config) -> - ?line Tracer = start_tracer(Config), + Tracer = start_tracer(Config), Self = self(), - ?line Sender = fun_spawn(fun sender/0), - ?line trac(Sender, true, [send]), + Sender = fun_spawn(fun sender/0), + trac(Sender, true, [send]), %% Simple message, no timestamp. - ?line Bin = list_to_binary(lists:seq(1, 10)), - ?line Msg = {some_data,Bin}, + Bin = list_to_binary(lists:seq(1, 10)), + Msg = {some_data,Bin}, Sender ! {send_please,self(),Msg}, receive Msg -> ok end, - ?line expect({trace,Sender,send,Msg,Self}), + expect({trace,Sender,send,Msg,Self}), %% Timestamp. BiggerMsg = {even_bigger,Msg}, - ?line trac(Sender, true, [send,timestamp]), + trac(Sender, true, [send,timestamp]), Sender ! {send_please,self(),BiggerMsg}, receive BiggerMsg -> ok end, - ?line expect({trace_ts,Sender,send,BiggerMsg,Self,ts}), + expect({trace_ts,Sender,send,BiggerMsg,Self,ts}), %% Huge message. - ?line HugeMsg = huge_data(), + HugeMsg = huge_data(), Sender ! {send_please,self(),HugeMsg}, receive HugeMsg -> ok end, - ?line expect({trace_ts,Sender,send,HugeMsg,Self,ts}), + expect({trace_ts,Sender,send,HugeMsg,Self,ts}), %% Kill trace port and force a trace. The emulator should not crasch. - ?line unlink(Tracer), - ?line exit(Tracer, kill), + unlink(Tracer), + exit(Tracer, kill), erlang:yield(), % Make sure that port gets killed. Sender ! {send_please,Self,good_bye}, receive good_bye -> ok end, ok. -receive_trace(doc) -> "Test sending receive traces to a port."; +%% Test sending receive traces to a port. receive_trace(Config) when is_list(Config) -> - ?line start_tracer(Config), - ?line Receiver = fun_spawn(fun receiver/0), - ?line trac(Receiver, true, ['receive']), + start_tracer(Config), + Receiver = fun_spawn(fun receiver/0), + trac(Receiver, true, ['receive']), Receiver ! {hello,world}, - ?line expect({trace,Receiver,'receive',{hello,world}}), + expect({trace,Receiver,'receive',{hello,world}}), - ?line trac(Receiver, true, ['receive',timestamp]), + trac(Receiver, true, ['receive',timestamp]), Huge = {hello,huge_data()}, Receiver ! {hello,huge_data()}, - ?line expect({trace_ts,Receiver,'receive',Huge,ts}), + expect({trace_ts,Receiver,'receive',Huge,ts}), ok. -process_events(doc) -> "Tests a few process events (like getting linked)."; +%% Tests a few process events (like getting linked). process_events(Config) when is_list(Config) -> - ?line start_tracer(Config), + start_tracer(Config), Self = self(), - ?line Receiver = fun_spawn(fun receiver/0), - ?line trac(Receiver, true, [procs]), + Receiver = fun_spawn(fun receiver/0), + trac(Receiver, true, [procs]), unlink(Receiver), %It is already linked. - ?line expect({trace,Receiver,getting_unlinked,Self}), + expect({trace,Receiver,getting_unlinked,Self}), link(Receiver), - ?line expect({trace,Receiver,getting_linked,Self}), - ?line trac(Receiver, true, [procs,timestamp]), + expect({trace,Receiver,getting_linked,Self}), + trac(Receiver, true, [procs,timestamp]), unlink(Receiver), - ?line expect({trace_ts,Receiver,getting_unlinked,Self,ts}), + expect({trace_ts,Receiver,getting_unlinked,Self,ts}), link(Receiver), - ?line expect({trace_ts,Receiver,getting_linked,Self,ts}), + expect({trace_ts,Receiver,getting_linked,Self,ts}), unlink(Receiver), - ?line expect({trace_ts,Receiver,getting_unlinked,Self,ts}), + expect({trace_ts,Receiver,getting_unlinked,Self,ts}), Huge = huge_data(), exit(Receiver, Huge), - ?line expect({trace_ts,Receiver,exit,Huge,ts}), + expect({trace_ts,Receiver,exit,Huge,ts}), ok. -schedule(doc) -> "Test sending scheduling events to a port."; +%% Test sending scheduling events to a port. schedule(Config) when is_list(Config) -> - ?line start_tracer(Config), - ?line Receiver = fun_spawn(fun receiver/0), - ?line trac(Receiver, true, [running]), + start_tracer(Config), + Receiver = fun_spawn(fun receiver/0), + trac(Receiver, true, [running]), Receiver ! hi, expect({trace,Receiver,in,{?MODULE,receiver,0}}), expect({trace,Receiver,out,{?MODULE,receiver,0}}), - ?line trac(Receiver, true, [running,timestamp]), + trac(Receiver, true, [running,timestamp]), Receiver ! hi_again, expect({trace_ts,Receiver,in,{?MODULE,receiver,0},ts}), @@ -261,253 +227,93 @@ schedule(Config) when is_list(Config) -> ok. -run_fake_sched_test(Fun, Config) when is_function(Fun), is_list(Config) -> - ?line case catch erlang:system_info(smp_support) of - true -> - ?line {skipped, - "No need for faked schedule out/in trace messages " - "when smp support is enabled"}; - _ -> - ?line Fun(Config) - end. - -fake_schedule(doc) -> "Tests time compensating fake out/in scheduling."; -fake_schedule(Config) when is_list(Config) -> - ?line run_fake_sched_test(fun fake_schedule_test/1, Config). - -fake_schedule_test(Config) when is_list(Config) -> - ?line Tracer = start_tracer(Config), - ?line Port = get(tracer_port), - ?line General = fun_spawn(fun general/0), - %% - ?line trac(General, true, [send, running]), - %% - %% Test that fake out/in scheduling is not generated unless - %% both 'running' and 'timestamp' is active. - ?line [] = erlang:port_control(Port, $h, []), - ?line General ! nop, - ?line expect({trace, General, in, {?MODULE, general, 0}}), - ?line expect({trace, General, out, {?MODULE, general, 0}}), - ?line expect(), - %% - ?line trac(General, false, [running]), - ?line trac(General, true, [timestamp]), - %% - ?line Ref1 = make_ref(), - ?line Msg1 = {Port, {data, term_to_binary(Ref1)}}, - ?line [] = erlang:port_control(Port, $h, []), - ?line General ! {send, Tracer, Msg1}, - ?line expect({trace_ts, General, send, Msg1, Tracer, ts}), - ?line expect(Ref1), - ?line expect(), - %% - ?line trac(General, true, [running]), - %% - %% Test that fake out/in scheduling can be generated by the driver - ?line Ref2 = make_ref(), - ?line Msg2 = {Port, {data, term_to_binary(Ref2)}}, - ?line [] = erlang:port_control(Port, $h, []), - ?line General ! {send, Tracer, Msg2}, - ?line {_,_,_,_,Ts} = - expect({trace_ts, General, in, {?MODULE, general, 0}, ts}), - ?line expect({trace_ts, General, out, 0, Ts}), - ?line expect({trace_ts, General, in, 0, ts}), - ?line expect({trace_ts, General, send, Msg2, Tracer, ts}), - ?line expect(Ref2), - ?line expect({trace_ts, General, out, {?MODULE, general, 0}, ts}), - ?line expect(), - %% - %% Test that fake out/in scheduling is not generated after an - %% 'out' scheduling event - ?line Ref3 = make_ref(), - ?line Msg3 = {Port, {data, term_to_binary(Ref3)}}, - ?line General ! {apply, {erlang, port_control, [Port, $h, []]}}, - ?line expect({trace_ts, General, in, {?MODULE, general, 0}, ts}), - ?line expect({trace_ts, General, out, {?MODULE, general, 0}, ts}), - ?line General ! {send, Tracer, Msg3}, - ?line expect({trace_ts, General, in, {?MODULE, general, 0}, ts}), - ?line expect({trace_ts, General, send, Msg3, Tracer, ts}), - ?line expect(Ref3), - ?line expect({trace_ts, General, out, {?MODULE, general, 0}, ts}), - ?line expect(), - %% - ok. - -fake_schedule_after_register(doc) -> - "Tests fake out/in scheduling contents."; -fake_schedule_after_register(Config) when is_list(Config) -> - ?line run_fake_sched_test(fun fake_schedule_after_register_test/1, Config). - -fake_schedule_after_register_test(Config) when is_list(Config) -> - ?line start_tracer(Config), - ?line Port = get(tracer_port), - ?line G1 = fun_spawn(fun general/0), - ?line G2 = fun_spawn(fun general/0), - %% - ?line trac(G1, true, [running, timestamp, procs]), - ?line trac(G2, true, [running, timestamp]), - %% - %% Test fake out/in scheduling after certain messages - ?line erlang:yield(), - ?line G2 ! {apply, {erlang, port_control, [Port, $h, []]}}, - ?line G2 ! {apply, {erlang, register, [fake_schedule_after_register, G1]}}, - ?line expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}), - ?line {_,_,_,_,Ts} = - expect({trace_ts, G1, register, fake_schedule_after_register, ts}), - ?line expect({trace_ts, G2, out, 0, Ts}), - ?line expect({trace_ts, G2, in, 0, ts}), - ?line expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}), - ?line expect(), - %% - ok. - -fake_schedule_after_getting_linked(doc) -> - "Tests fake out/in scheduling contents."; -fake_schedule_after_getting_linked(Config) when is_list(Config) -> - ?line run_fake_sched_test(fun fake_schedule_after_getting_linked_test/1, - Config). - -fake_schedule_after_getting_linked_test(Config) when is_list(Config) -> - ?line start_tracer(Config), - ?line Port = get(tracer_port), - ?line G1 = fun_spawn(fun general/0), - ?line G2 = fun_spawn(fun general/0), - %% - ?line trac(G1, true, [running, timestamp, procs]), - ?line trac(G2, true, [running, timestamp]), - %% - %% Test fake out/in scheduling after certain messages - ?line erlang:yield(), - ?line G2 ! {apply, {erlang, port_control, [Port, $h, []]}}, - ?line G2 ! {apply, {erlang, link, [G1]}}, - ?line expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}), - ?line {_,_,_,_,Ts} = - expect({trace_ts, G1, getting_linked, G2, ts}), - ?line expect({trace_ts, G2, out, 0, Ts}), - ?line expect({trace_ts, G2, in, 0, ts}), - ?line expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}), - ?line expect(), - %% - ok. - -fake_schedule_after_getting_unlinked(doc) -> - "Tests fake out/in scheduling contents."; -fake_schedule_after_getting_unlinked(Config) when is_list(Config) -> - ?line run_fake_sched_test(fun fake_schedule_after_getting_unlinked_test/1, - Config). - -fake_schedule_after_getting_unlinked_test(Config) when is_list(Config) -> - ?line start_tracer(Config), - ?line Port = get(tracer_port), - ?line G1 = fun_spawn(fun general/0), - ?line G2 = fun_spawn(fun general/0), - %% - ?line trac(G1, true, [running, procs]), - ?line trac(G2, true, [running, timestamp]), - %% - %% Test fake out/in scheduling after certain messages - ?line erlang:yield(), - ?line G2 ! {apply, {erlang, link, [G1]}}, - ?line G2 ! {apply, {erlang, port_control, [Port, $h, []]}}, - ?line G2 ! {apply, {erlang, unlink, [G1]}}, - ?line expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}), - ?line expect({trace, G1, getting_linked, G2}), - ?line expect({trace, G1, getting_unlinked, G2}), - ?line expect({trace_ts, G2, out, 0, ts}), - ?line expect({trace_ts, G2, in, 0, ts}), - ?line expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}), - ?line expect(), - %% - ok. - -gc(doc) -> "Test sending garbage collection events to a port."; +%% Test sending garbage collection events to a port. gc(Config) when is_list(Config) -> - ?line start_tracer(Config), - ?line Garber = fun_spawn(fun garber/0, [{min_heap_size, 5000}]), - ?line trac(Garber, true, [garbage_collection]), - ?line trace_info(Garber, flags), + start_tracer(Config), + Garber = fun_spawn(fun garber/0, [{min_heap_size, 5000}]), + trac(Garber, true, [garbage_collection]), + trace_info(Garber, flags), - ?line trace_info(Garber, flags), + trace_info(Garber, flags), Garber ! hi, - expect({trace,Garber,gc_start,info}), - expect({trace,Garber,gc_end,info}), + expect({trace,Garber,gc_major_start,info}), + expect({trace,Garber,gc_major_end,info}), - ?line trac(Garber, true, [garbage_collection,timestamp]), + trac(Garber, true, [garbage_collection,timestamp]), Garber ! hi, - expect({trace_ts,Garber,gc_start,info,ts}), - expect({trace_ts,Garber,gc_end,info,ts}), + expect({trace_ts,Garber,gc_major_start,info,ts}), + expect({trace_ts,Garber,gc_major_end,info,ts}), ok. -default_tracer(doc) -> - "Test a port as default tracer."; +%% Test a port as default tracer. default_tracer(Config) when is_list(Config) -> - ?line Tracer = start_tracer(Config), - ?line TracerMonitor = erlang:monitor(process, Tracer), - ?line Port = get(tracer_port), + Tracer = start_tracer(Config), + TracerMonitor = erlang:monitor(process, Tracer), + Port = get(tracer_port), %% - ?line N = erlang:trace(all, true, [send, {tracer, Port}]), - ?line {flags, [send]} = erlang:trace_info(self(), flags), - ?line {tracer, Port} = erlang:trace_info(self(), tracer), - ?line {flags, [send]} = erlang:trace_info(new, flags), - ?line {tracer, Port} = erlang:trace_info(new, tracer), - ?line G1 = fun_spawn(fun general/0), - ?line {flags, [send]} = erlang:trace_info(G1, flags), - ?line {tracer, Port} = erlang:trace_info(G1, tracer), - ?line unlink(Tracer), - ?line exit(Port, done), - ?line receive - {'DOWN', TracerMonitor, process, Tracer, TracerExitReason} -> - ?line done = TracerExitReason - end, - ?line {flags, []} = erlang:trace_info(self(), flags), - ?line {tracer, []} = erlang:trace_info(self(), tracer), - ?line {flags, []} = erlang:trace_info(new, flags), - ?line {tracer, []} = erlang:trace_info(new, tracer), - ?line M = erlang:trace(all, false, [all]), - ?line {flags, []} = erlang:trace_info(self(), flags), - ?line {tracer, []} = erlang:trace_info(self(), tracer), - ?line {flags, []} = erlang:trace_info(G1, flags), - ?line {tracer, []} = erlang:trace_info(G1, tracer), - ?line G1 ! {apply,{erlang,exit,[normal]}}, - ?line io:format("~p = ~p.~n", [M, N]), - ?line M = N, + N = erlang:trace(all, true, [send, {tracer, Port}]), + {flags, [send]} = erlang:trace_info(self(), flags), + {tracer, Port} = erlang:trace_info(self(), tracer), + {flags, [send]} = erlang:trace_info(new, flags), + {tracer, Port} = erlang:trace_info(new, tracer), + G1 = fun_spawn(fun general/0), + {flags, [send]} = erlang:trace_info(G1, flags), + {tracer, Port} = erlang:trace_info(G1, tracer), + unlink(Tracer), + exit(Port, done), + receive + {'DOWN', TracerMonitor, process, Tracer, TracerExitReason} -> + done = TracerExitReason + end, + {flags, []} = erlang:trace_info(self(), flags), + {tracer, []} = erlang:trace_info(self(), tracer), + {flags, []} = erlang:trace_info(new, flags), + {tracer, []} = erlang:trace_info(new, tracer), + M = erlang:trace(all, false, [all]), + {flags, []} = erlang:trace_info(self(), flags), + {tracer, []} = erlang:trace_info(self(), tracer), + {flags, []} = erlang:trace_info(G1, flags), + {tracer, []} = erlang:trace_info(G1, tracer), + G1 ! {apply,{erlang,exit,[normal]}}, + io:format("~p = ~p.~n", [M, N]), + M = N - 1, % G1 has been started, but Tracer and Port have died ok. tracer_port_crash(Config) when is_list(Config) -> case test_server:is_native(?MODULE) orelse - test_server:is_native(lists) of - true -> - {skip,"Native code"}; - false -> - Tr = start_tracer(Config), - Port = get(tracer_port), - Tracee = spawn(fun () -> - register(trace_port_linker, self()), - link(Port), - receive go -> ok end, - lists:reverse([1,b,c]), - receive die -> ok end - end), - Tr ! {unlink_tracer_port, self()}, - receive {unlinked_tracer_port, Tr} -> ok end, - port_control(Port, $c, []), %% Make port commands crash tracer port... - trace_func({lists,reverse,1}, []), - trace_pid(Tracee, true, [call]), - trace_info(Tracee, flags), - trace_info(self(), tracer), - Tracee ! go, - receive after 1000 -> ok end, - case whereis(trace_port_linker) of - undefined -> - ok; - Id -> -% erts_debug:set_internal_state(available_internal_state, true), -% erts_debug:set_internal_state(abort, {trace_port_linker, Id}) - ?t:fail({trace_port_linker, Id}) - end, - undefined = process_info(Tracee), - ok + test_server:is_native(lists) of + true -> + {skip,"Native code"}; + false -> + Tr = start_tracer(Config), + Port = get(tracer_port), + Tracee = spawn(fun () -> + register(trace_port_linker, self()), + link(Port), + receive go -> ok end, + lists:reverse([1,b,c]), + receive die -> ok end + end), + Tr ! {unlink_tracer_port, self()}, + receive {unlinked_tracer_port, Tr} -> ok end, + port_control(Port, $c, []), %% Make port commands crash tracer port... + trace_func({lists,reverse,1}, []), + trace_pid(Tracee, true, [call]), + trace_info(Tracee, flags), + trace_info(self(), tracer), + Tracee ! go, + receive after 1000 -> ok end, + case whereis(trace_port_linker) of + undefined -> + ok; + Id -> + % erts_debug:set_internal_state(available_internal_state, true), + % erts_debug:set_internal_state(abort, {trace_port_linker, Id}) + ct:fail({trace_port_linker, Id}) + end, + undefined = process_info(Tracee), + ok end. %%% Help functions. @@ -523,106 +329,106 @@ huge_data(N) -> expect() -> receive - Other -> - ok = io:format("Unexpected; got ~p", [Other]), - test_server:fail({unexpected, Other}) + Other -> + ok = io:format("Unexpected; got ~p", [Other]), + ct:fail({unexpected, Other}) after 200 -> - ok + ok end. expect({trace_ts,E1,E2,info,ts}=Message) -> receive - {trace_ts,E1,E2,_Info,_Ts}=MessageTs -> - ok = io:format("Expected and got ~p", [MessageTs]), - MessageTs; - Other -> - io:format("Expected ~p; got ~p", [Message,Other]), - test_server:fail({unexpected,Other}) + {trace_ts,E1,E2,_Info,_Ts}=MessageTs -> + ok = io:format("Expected and got ~p", [MessageTs]), + MessageTs; + Other -> + io:format("Expected ~p; got ~p", [Message,Other]), + ct:fail({unexpected,Other}) after 5000 -> - io:format("Expected ~p; got nothing", [Message]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [Message]), + ct:fail(no_trace_message) end; expect({trace,E1,E2,info}=Message) -> receive - {trace,E1,E2,_Info}=MessageTs -> - ok = io:format("Expected and got ~p", [MessageTs]), - MessageTs; - Other -> - io:format("Expected ~p; got ~p", [Message,Other]), - test_server:fail({unexpected,Other}) + {trace,E1,E2,_Info}=MessageTs -> + ok = io:format("Expected and got ~p", [MessageTs]), + MessageTs; + Other -> + io:format("Expected ~p; got ~p", [Message,Other]), + ct:fail({unexpected,Other}) after 5000 -> - io:format("Expected ~p; got nothing", [Message]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [Message]), + ct:fail(no_trace_message) end; expect({trace_ts,E1,E2,E3,ts}=Message) -> receive - {trace_ts,E1,E2,E3,_Ts}=MessageTs -> - ok = io:format("Expected and got ~p", [MessageTs]), - MessageTs; - Other -> - io:format("Expected ~p; got ~p", [Message,Other]), - test_server:fail({unexpected,Other}) + {trace_ts,E1,E2,E3,_Ts}=MessageTs -> + ok = io:format("Expected and got ~p", [MessageTs]), + MessageTs; + Other -> + io:format("Expected ~p; got ~p", [Message,Other]), + ct:fail({unexpected,Other}) after 5000 -> - io:format("Expected ~p; got nothing", [Message]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [Message]), + ct:fail(no_trace_message) end; expect({trace_ts,E1,E2,E3,E4,ts}=Message) -> receive - {trace_ts,E1,E2,E3,E4,_Ts}=MessageTs -> - ok = io:format("Expected and got ~p", [MessageTs]), - MessageTs; - Other -> - io:format("Expected ~p; got ~p", [Message,Other]), - test_server:fail({unexpected,Other}) + {trace_ts,E1,E2,E3,E4,_Ts}=MessageTs -> + ok = io:format("Expected and got ~p", [MessageTs]), + MessageTs; + Other -> + io:format("Expected ~p; got ~p", [Message,Other]), + ct:fail({unexpected,Other}) after 5000 -> - io:format("Expected ~p; got nothing", [Message]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [Message]), + ct:fail(no_trace_message) end; expect(Message) -> receive - Message -> - ok = io:format("Expected and got ~p", [Message]), - Message; - Other -> - io:format("Expected ~p; got ~p", [Message,Other]), - test_server:fail({unexpected,Other}) + Message -> + ok = io:format("Expected and got ~p", [Message]), + Message; + Other -> + io:format("Expected ~p; got ~p", [Message,Other]), + ct:fail({unexpected,Other}) after 5000 -> - io:format("Expected ~p; got nothing", [Message]), - test_server:fail(no_trace_message) + io:format("Expected ~p; got nothing", [Message]), + ct:fail(no_trace_message) end. trac(What, On, Flags0) -> Flags = [{tracer,get(tracer_port)}|Flags0], get(tracer) ! {apply,self(),{erlang,trace,[What,On,Flags]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("erlang:trace(~p, ~p, ~p) -> ~p", - [What,On,Flags,Res]), + [What,On,Flags,Res]), Res. - + trace_info(What, Key) -> get(tracer) ! {apply,self(),{erlang,trace_info,[What,Key]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("erlang:trace_info(~p, ~p) -> ~p", - [What,Key,Res]), + [What,Key,Res]), Res. - + trace_func(MFA, MatchProg) -> get(tracer) ! {apply,self(),{erlang,trace_pattern,[MFA,MatchProg]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("erlang:trace_pattern(~p, ~p) -> ~p", [MFA,MatchProg,Res]), Res. trace_func(MFA, MatchProg, Flags) -> get(tracer) ! {apply,self(),{erlang,trace_pattern,[MFA,MatchProg,Flags]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("erlang:trace_pattern(~p, ~p) -> ~p", [MFA,MatchProg,Res]), Res. @@ -630,29 +436,29 @@ trace_pid(Pid, On, Flags0) -> Flags = [{tracer,get(tracer_port)}|Flags0], get(tracer) ! {apply,self(),{erlang,trace,[Pid,On,Flags]}}, Res = receive - {apply_result,Result} -> Result - end, + {apply_result,Result} -> Result + end, ok = io:format("erlang:trace(~p, ~p, ~p) -> ~p", - [Pid,On,Flags,Res]), + [Pid,On,Flags,Res]), Res. start_tracer(Config) -> - Path = ?config(data_dir, Config), + Path = proplists:get_value(data_dir, Config), ok = load_driver(Path, echo_drv), Self = self(), put(tracer, fun_spawn(fun() -> tracer(Self) end)), receive - {started,Port} -> - put(tracer_port, Port) + {started,Port} -> + put(tracer_port, Port) end, get(tracer). load_driver(Dir, Driver) -> case erl_ddll:load_driver(Dir, Driver) of - ok -> ok; - {error, Error} = Res -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - Res + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res end. tracer(RelayTo) -> @@ -662,18 +468,18 @@ tracer(RelayTo) -> tracer_loop(RelayTo, Port) -> receive - {apply,From,{M,F,A}} -> - From ! {apply_result,apply(M, F, A)}, - tracer_loop(RelayTo, Port); - {Port,{data,Msg}} -> - RelayTo ! binary_to_term(Msg), - tracer_loop(RelayTo, Port); - {unlink_tracer_port, From} -> - unlink(Port), - From ! {unlinked_tracer_port, self()}, - tracer_loop(RelayTo, Port); - Other -> - exit({bad_message,Other}) + {apply,From,{M,F,A}} -> + From ! {apply_result,apply(M, F, A)}, + tracer_loop(RelayTo, Port); + {Port,{data,Msg}} -> + RelayTo ! binary_to_term(Msg), + tracer_loop(RelayTo, Port); + {unlink_tracer_port, From} -> + unlink(Port), + From ! {unlinked_tracer_port, self()}, + tracer_loop(RelayTo, Port); + Other -> + exit({bad_message,Other}) end. fun_spawn(Fun) -> @@ -697,43 +503,43 @@ fun_spawn(Fun, Opts) -> sender() -> receive - {send_please, To, What} -> - To ! What, - sender() + {send_please, To, What} -> + To ! What, + sender() end. %% Just consumes messages from its message queue. receiver() -> receive - _Any -> receiver() + _Any -> receiver() end. %% Does a garbage collection when it receives a message. garber() -> receive - _Any -> - lists:seq(1, 100), - erlang:garbage_collect(), - garber() + _Any -> + lists:seq(1, 100), + erlang:garbage_collect(), + garber() end. %% All-purpose process general() -> receive - {apply, {M, F, Args}} -> - erlang:apply(M, F, Args), - general(); - {send, Dest, Msg} -> - Dest ! Msg, - general(); - {call_f_1, Arg} -> - f(Arg), - general(); - nop -> - general() + {apply, {M, F, Args}} -> + erlang:apply(M, F, Args), + general(); + {send, Dest, Msg} -> + Dest ! Msg, + general(); + {call_f_1, Arg} -> + f(Arg), + general(); + nop -> + general() end. f(Arg) -> diff --git a/erts/emulator/test/tracer_SUITE.erl b/erts/emulator/test/tracer_SUITE.erl new file mode 100644 index 0000000000..de44d6656a --- /dev/null +++ b/erts/emulator/test/tracer_SUITE.erl @@ -0,0 +1,627 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(tracer_SUITE). + +%%% +%%% Tests the tracer module interface +%%% + +-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([load/1, unload/1, reload/1, invalid_tracers/1]). +-export([send/1, recv/1, spawn/1, exit/1, link/1, unlink/1, + getting_linked/1, getting_unlinked/1, register/1, unregister/1, + in/1, out/1, gc_start/1, gc_end/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. + +all() -> + [load, unload, reload, invalid_tracers, {group, basic}]. + +groups() -> + [{ basic, [], [send, recv, spawn, exit, link, unlink, getting_linked, + getting_unlinked, register, unregister, in, out, + gc_start, gc_end]}]. + +init_per_suite(Config) -> + purge(), + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(TC, Config) when TC =:= load; TC =:= reload -> + + DataDir = proplists:get_value(data_dir, Config), + + Pid = erlang:spawn(fun F() -> + receive + {get, Pid} -> + Pid ! DataDir, + F() + end + end), + register(tracer_test_config, Pid), + Config; +init_per_testcase(_, Config) -> + DataDir = proplists:get_value(data_dir, Config), + case catch tracer_test:enabled(trace_status, self(), self()) of + discard -> + ok; + _ -> + tracer_test:load(DataDir) + end, + Config. + +end_per_testcase(TC, _Config) when TC =:= load; TC =:= reload -> + purge(), + exit(whereis(tracer_test_config), kill), + ok; +end_per_testcase(_, _Config) -> + purge(), + ok. + +load(_Config) -> + purge(), + 1 = erlang:trace(self(), true, [{tracer, tracer_test, []}, call]), + purge(), + 1 = erlang:trace_pattern({?MODULE, all, 0}, [], + [{meta, tracer_test, []}]), + ok. + +unload(_Config) -> + + ServerFun = fun F(0, undefined) -> + receive + {N, Pid} -> F(N, Pid) + end; + F(0, Pid) -> + Pid ! done, + F(0, undefined); + F(N, Pid) -> + ?MODULE:all(), + F(N-1, Pid) + end, + + Pid = erlang:spawn_link(fun() -> ServerFun(0, undefined) end), + + + Tc = fun(N) -> + Pid ! {N, self()}, + receive done -> ok after 1000 -> ct:fail(timeout) end, + trace_delivered(Pid) + end, + + 1 = erlang:trace(Pid, true, [{tracer, tracer_test, + {#{ call => trace}, self(), []}}, + call]), + 1 = erlang:trace_pattern({?MODULE, all, 0}, [], []), + + Tc(1), + receive _ -> ok after 0 -> ct:fail(timeout) end, + + code:purge(tracer_test), + code:delete(tracer_test), + + Tc(1), + receive M1 -> ct:fail({unexpected_message, M1}) after 0 -> ok end, + + code:purge(tracer_test), + + Tc(1), + receive M2 -> ct:fail({unexpected_message, M2}) after 0 -> ok end, + + ok. + +%% This testcase is here to make sure there are not +%% segfaults when reloading the current nifs. +reload(_Config) -> + + Tracer = spawn_opt(fun F() -> receive _M -> F() end end, + [{message_queue_data, off_heap}]), + erlang:link(Tracer), + Tracee = spawn_link(fun reload_loop/0), + + [begin + Ref = make_ref(), + State = {#{ call => trace }, Tracer, [Ref]}, + erlang:trace(Tracee, true, [{tracer, tracer_test,State}, call]), + erlang:trace_pattern({?MODULE, all, 0}, []), + + false = code:purge(tracer_test), + {module, _} = code:load_file(tracer_test), + + %% There is a race involved in between when the internal nif cache + %% is purged and when the reload_loop needs the tracer module + %% so the tracer may be removed or still there. + case erlang:trace_info(Tracee, tracer) of + {tracer, []} -> ok; + {tracer, {tracer_test, State}} -> ok + end, + + false = code:purge(tracer_test), + true = code:delete(tracer_test), + false = code:purge(tracer_test) + end || _ <- lists:seq(1,15)], + + ok. + +reload_loop() -> + ?MODULE:all(), + reload_loop(). + +invalid_tracers(_Config) -> + FailTrace = fun(A) -> + try erlang:trace(self(), true, A) of + _ -> ct:fail(A) + catch _:_ -> ok end + end, + + FailTrace([{tracer, foobar}, call]), + FailTrace([{tracer, foobar, []}, call]), + FailTrace([{tracer, make_ref(), []}, call]), + FailTrace([{tracer, lists, []}, call]), + + FailTP = fun(MS,FL) -> + try erlang:trace_pattern({?MODULE,all,0}, MS, FL) of + _ -> ct:fail({MS, FL}) + catch _:_ -> ok end + end, + + FailTP([],[{meta, foobar}]), + FailTP([],[{meta, foobar, []}]), + FailTP([],[{meta, make_ref(), []}]), + FailTP([],[{meta, lists, []}]), + + ok. + + + +send(_Config) -> + + Self = self(), + Tc = fun(Pid) -> + Pid ! fun() -> Self ! ok end, + receive ok -> ok after 100 -> ct:fail(timeout) end + end, + + Expect = fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, send, State, Pid, ok, Self, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + test(send, Tc, Expect). + + +recv(_Config) -> + + Tc = fun(Pid) -> + Pid ! ok + end, + + Expect = fun(Pid, State, EOpts) -> + receive + Msg -> + {undefined, 'receive', State, Pid, ok, undefined, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test('receive', Tc, Expect, false). + +spawn(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> erlang:spawn(lists,seq,[1,10]), ok end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, spawn, State, Pid, NewPid, + {lists,seq,[1,10]}, Opts} = Msg, + check_opts(EOpts, Opts), + true = is_pid(NewPid) andalso NewPid /= Pid + end + end, + + test(spawn, procs, Tc, Expect, true). + +exit(_Config) -> + Tc = fun(Pid) -> + Pid ! fun() -> exit end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, exit, State, Pid, normal, undefined, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test(exit, procs, Tc, Expect, true, true). + +link(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + SPid = erlang:spawn(fun() -> receive _ -> ok end end), + erlang:link(SPid), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, link, State, Pid, NewPid, undefined, Opts} = Msg, + check_opts(EOpts, Opts), + true = is_pid(NewPid) andalso NewPid /= Pid + end + end, + + test(link, procs, Tc, Expect, true). + +unlink(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + SPid = erlang:spawn(fun() -> receive _ -> ok end end), + erlang:link(SPid), + erlang:unlink(SPid), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, unlink, State, Pid, NewPid, undefined, Opts} = Msg, + check_opts(EOpts, Opts), + true = is_pid(NewPid) andalso NewPid /= Pid + end + end, + + test(unlink, procs, Tc, Expect, true). + +getting_linked(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + Self = self(), + erlang:spawn(fun() -> erlang:link(Self) end), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {NewPid, getting_linked, State, Pid, NewPid, undefined, Opts} = Msg, + check_opts(EOpts, Opts), + true = is_pid(NewPid) andalso NewPid /= Pid + end + end, + + test(getting_linked, procs, Tc, Expect, false). + +getting_unlinked(_Config) -> + Tc = fun(Pid) -> + Pid ! fun() -> + Self = self(), + erlang:spawn(fun() -> + erlang:link(Self), + erlang:unlink(Self) + end), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {NewPid, getting_unlinked, State, Pid, NewPid, undefined, Opts} = Msg, + check_opts(EOpts, Opts), + true = is_pid(NewPid) andalso NewPid /= Pid + end + end, + + test(getting_unlinked, procs, Tc, Expect, false). + +register(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + erlang:register(?MODULE, self()), + erlang:unregister(?MODULE), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, register, State, Pid, ?MODULE, undefined, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test(register, procs, Tc, Expect, true). + +unregister(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + erlang:register(?MODULE, self()), + erlang:unregister(?MODULE), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, unregister, State, Pid, ?MODULE, undefined, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test(unregister, procs, Tc, Expect, true). + +in(_Config) -> + + Tc = fun(Pid) -> + Self = self(), + Pid ! fun() -> receive after 1 -> Self ! ok end end, + receive ok -> ok end + end, + + Expect = + fun(Pid, State, EOpts) -> + N = (fun F(N) -> + receive + Msg -> + {Pid, in, State, Pid, _, + undefined, Opts} = Msg, + check_opts(EOpts, Opts), + F(N+1) + after 0 -> N + end + end)(0), + true = N > 0 + end, + + test(in, running, Tc, Expect, true). + +out(_Config) -> + Tc = fun(Pid) -> + Pid ! fun() -> receive after 10 -> exit end end, + Ref = erlang:monitor(process, Pid), + receive {'DOWN', Ref, _, _, _} -> ok end + end, + + Expect = + fun(Pid, State, EOpts) -> + %% We cannot predict how many out schedules there will be + N = (fun F(N) -> + receive + Msg -> + {Pid, out, State, Pid, _, + undefined, Opts} = Msg, + check_opts(EOpts, Opts), + F(N+1) + after 0 -> N + end + end)(0), + true = N > 0 + end, + + test(out, running, Tc, Expect, true, true). + +gc_start(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + erlang:garbage_collect(), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, gc_major_start, State, Pid, _, undefined, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test(gc_major_start, garbage_collection, Tc, Expect, true). + +gc_end(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + erlang:garbage_collect(), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, gc_major_end, State, Pid, _, undefined, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test(gc_major_end, garbage_collection, Tc, Expect, true). + +test(Event, Tc, Expect) -> + test(Event, Tc, Expect, true). +test(Event, Tc, Expect, Removes) -> + test(Event, Event, Tc, Expect, Removes). +test(Event, TraceFlag, Tc, Expect, Removes) -> + test(Event, TraceFlag, Tc, Expect, Removes, false). +test(Event, TraceFlag, Tc, Expect, Removes, Dies) -> + + ComplexState = {fun() -> ok end, <<0:(128*8)>>}, + Opts = #{ timestamp => undefined, + scheduler_id => undefined, + match_spec_result => true }, + + %% Test that trace works + State1 = {#{ Event => trace }, self(), ComplexState}, + Pid1 = start_tracee(), + 1 = erlang:trace(Pid1, true, [TraceFlag, {tracer, tracer_test, State1}]), + Tc(Pid1), + ok = trace_delivered(Pid1), + + Expect(Pid1, State1, Opts), + receive M11 -> ct:fail({unexpected, M11}) after 0 -> ok end, + if not Dies -> + {flags, [TraceFlag]} = erlang:trace_info(Pid1, flags), + {tracer, {tracer_test, State1}} = erlang:trace_info(Pid1, tracer), + erlang:trace(Pid1, false, [TraceFlag]); + true -> ok + end, + + %% Test that trace works with scheduler id and timestamp + Pid1T = start_tracee(), + 1 = erlang:trace(Pid1T, true, [TraceFlag, {tracer, tracer_test, State1}, + timestamp, scheduler_id]), + Tc(Pid1T), + ok = trace_delivered(Pid1T), + + Expect(Pid1T, State1, Opts#{ scheduler_id := number, + timestamp := timestamp}), + receive M11T -> ct:fail({unexpected, M11T}) after 0 -> ok end, + if not Dies -> + {flags, [scheduler_id, TraceFlag, timestamp]} + = erlang:trace_info(Pid1T, flags), + {tracer, {tracer_test, State1}} = erlang:trace_info(Pid1T, tracer), + erlang:trace(Pid1T, false, [TraceFlag]); + true -> ok + end, + + %% Test that discard works + Pid2 = start_tracee(), + State2 = {#{ Event => discard }, self(), ComplexState}, + 1 = erlang:trace(Pid2, true, [TraceFlag, {tracer, tracer_test, State2}]), + Tc(Pid2), + ok = trace_delivered(Pid2), + receive M2 -> ct:fail({unexpected, M2}) after 0 -> ok end, + if not Dies -> + {flags, [TraceFlag]} = erlang:trace_info(Pid2, flags), + {tracer, {tracer_test, State2}} = erlang:trace_info(Pid2, tracer), + erlang:trace(Pid2, false, [TraceFlag]); + true -> + ok + end, + + %% Test that remove works + Pid3 = start_tracee(), + State3 = {#{ Event => remove }, self(), ComplexState}, + 1 = erlang:trace(Pid3, true, [TraceFlag, {tracer, tracer_test, State3}]), + Tc(Pid3), + ok = trace_delivered(Pid3), + receive M3 -> ct:fail({unexpected, M3}) after 0 -> ok end, + if not Dies -> + if Removes -> + {flags, []} = erlang:trace_info(Pid3, flags), + {tracer, []} = erlang:trace_info(Pid3, tracer); + true -> + {flags, [TraceFlag]} = erlang:trace_info(Pid3, flags), + {tracer, {tracer_test, State3}} = erlang:trace_info(Pid3, tracer) + end, + erlang:trace(Pid3, false, [TraceFlag]); + true -> + ok + end, + ok. + +check_opts(#{ scheduler_id := number } = E, #{ scheduler_id := N } = O) + when is_integer(N) -> + E1 = maps:remove(scheduler_id, E), + O1 = maps:remove(scheduler_id, O), + if E1 == O1 -> ok; + true -> ct:fail({invalid_opts, E, O}) + end; +check_opts(Opts, Opts) -> + ok; +check_opts(E,O) -> + ct:fail({invalid_opts, E, O}). + +start_tracee() -> + spawn_link( + fun F() -> + receive + Action when is_function(Action) -> + case Action() of + ok -> + F(); + Err -> + Err + end; + _ -> + F() + end + end). + +trace_delivered(Pid) -> + Ref = erlang:trace_delivered(Pid), + receive + {trace_delivered, Pid, Ref} -> + ok + after 1000 -> + timeout + end. + +purge() -> + %% Make sure module is not loaded + case erlang:module_loaded(tracer_test) of + true -> + code:purge(tracer_test), + true = code:delete(tracer_test), + code:purge(tracer_test); + _ -> + ok + end. diff --git a/erts/emulator/test/tracer_SUITE_data/Makefile.src b/erts/emulator/test/tracer_SUITE_data/Makefile.src new file mode 100644 index 0000000000..154bd70ccc --- /dev/null +++ b/erts/emulator/test/tracer_SUITE_data/Makefile.src @@ -0,0 +1,8 @@ + +NIF_LIBS = tracer_test@dll@ + +all: $(NIF_LIBS) + +@SHLIB_RULES@ + +$(NIF_LIBS): tracer_test.c diff --git a/erts/emulator/test/tracer_SUITE_data/tracer_test.c b/erts/emulator/test/tracer_SUITE_data/tracer_test.c new file mode 100644 index 0000000000..8b4be1345d --- /dev/null +++ b/erts/emulator/test/tracer_SUITE_data/tracer_test.c @@ -0,0 +1,122 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009-2014. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#include "erl_nif.h" + +#include <stdio.h> +#include <string.h> +#include <assert.h> +#include <limits.h> + +/* NIF interface declarations */ +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); +static void unload(ErlNifEnv* env, void* priv_data); + +/* The NIFs: */ +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +static ErlNifFunc nif_funcs[] = { + {"enabled", 3, enabled}, + {"trace", 6, trace} +}; + +ERL_NIF_INIT(tracer_test, nif_funcs, load, NULL, upgrade, unload) + +static ERL_NIF_TERM atom_discard; +static ERL_NIF_TERM atom_ok; + +#define ASSERT(expr) assert(expr) + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + + atom_discard = enif_make_atom(env, "discard"); + atom_ok = enif_make_atom(env, "ok"); + + *priv_data = NULL; + + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) +{ + +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, + ERL_NIF_TERM load_info) +{ + if (*old_priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if (*priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if (load(env, priv_data, load_info)) { + return -1; + } + return 0; +} + +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int state_arity; + const ERL_NIF_TERM *state_tuple; + ERL_NIF_TERM value; + ASSERT(argc == 3); + + if (!enif_get_tuple(env, argv[1], &state_arity, &state_tuple)) + return atom_discard; + + if (enif_get_map_value(env, state_tuple[0], argv[0], &value)) { + return value; + } else { + return atom_discard; + } +} + +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int state_arity; + ErlNifPid self, to; + ERL_NIF_TERM *tuple, msg; + const ERL_NIF_TERM *state_tuple; + ASSERT(argc == 6); + + enif_get_tuple(env, argv[1], &state_arity, &state_tuple); + + tuple = enif_alloc(sizeof(ERL_NIF_TERM)*(argc+1)); + memcpy(tuple+1,argv,sizeof(ERL_NIF_TERM)*argc); + + if (enif_self(env, &self)) { + tuple[0] = enif_make_pid(env, &self); + } else { + tuple[0] = enif_make_atom(env, "undefined"); + } + + msg = enif_make_tuple_from_array(env, tuple, argc + 1); + enif_get_local_pid(env, state_tuple[1], &to); + enif_send(env, &to, NULL, msg); + enif_free(tuple); + + return atom_ok; +} diff --git a/erts/emulator/test/tracer_test.erl b/erts/emulator/test/tracer_test.erl new file mode 100644 index 0000000000..d4778f4531 --- /dev/null +++ b/erts/emulator/test/tracer_test.erl @@ -0,0 +1,55 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(tracer_test). + +%%% +%%% Test tracer +%%% + +-export([enabled/3, trace/6]). +-export([load/1, load/2]). +-on_load(load/0). + +enabled(_, _, _) -> + erlang:nif_error(nif_not_loaded). + +trace(_, _, _, _, _, _) -> + erlang:nif_error(nif_not_loaded). + +load() -> + case whereis(tracer_test_config) of + undefined -> + ok; + Pid -> + Pid ! {get, self()}, + receive + {Conf, Postfix} -> + load(Conf, Postfix); + Conf -> + load(Conf) + end + end. + +load(DataDir) -> + load(DataDir, ""). +load(DataDir, Postfix) -> + SoFile = atom_to_list(?MODULE) ++ Postfix, + erlang:load_nif(filename:join(DataDir, SoFile) , 0). diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl index f1f077be6b..79b681b4d1 100644 --- a/erts/emulator/test/tuple_SUITE.erl +++ b/erts/emulator/test/tuple_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -26,7 +26,7 @@ t_make_tuple_2/1, t_make_upper_boundry_tuple_2/1, t_make_tuple_3/1, t_append_element/1, t_append_element_upper_boundry/1, build_and_match/1, tuple_with_case/1, tuple_in_guard/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Tests tuples and the BIFs: %% @@ -64,7 +64,7 @@ init_per_suite(Config) -> [{started_apps, A}|Config]. end_per_suite(Config) -> - As = ?config(started_apps, Config), + As = proplists:get_value(started_apps, Config), lists:foreach(fun (A) -> application:stop(A) end, As), Config. @@ -259,7 +259,7 @@ t_make_tuple(Size, Element) -> lists:foreach(fun(El) when El =:= Element -> ok; (Other) -> - test_server:fail({got, Other, expected, Element}) + ct:fail({got, Other, expected, Element}) end, tuple_to_list(Tuple)). %% Tests the erlang:make_tuple/3 BIF. @@ -385,14 +385,14 @@ tuple_in_guard(Config) when is_list(Config) -> Tuple1 == {element(1, Tuple2),element(2, Tuple2)} -> ok; true -> - test_server:fail() + ct:fail("failed") end, if Tuple2 == {element(1, Tuple2),element(2, Tuple2), element(3, Tuple2)} -> ok; true -> - test_server:fail() + ct:fail("failed") end, ok. diff --git a/erts/emulator/test/unique_SUITE.erl b/erts/emulator/test/unique_SUITE.erl index 6fa634b886..c5aa80c7b4 100644 --- a/erts/emulator/test/unique_SUITE.erl +++ b/erts/emulator/test/unique_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2014. All Rights Reserved. +%% Copyright Ericsson AB 2014-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,38 +20,25 @@ -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([all/0, suite/0, init_per_suite/1, end_per_suite/1]). -export([unique_monotonic_integer_white_box/1, unique_integer_white_box/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.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]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 4}}]. 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. @@ -60,12 +47,6 @@ 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 @@ -80,15 +61,15 @@ unique_monotonic_integer_white_box(Config) when is_list(Config) -> %% 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), + 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 + {'DOWN', Mon, process, Test, Error} -> + ct:fail(Error); + Success -> + ok end, erlang:demonitor(Mon, [flush]), stop_node(Node), @@ -96,9 +77,9 @@ unique_monotonic_integer_white_box(Config) when is_list(Config) -> set_unique_monotonic_integer_state(MinCounter, NextValue) -> true = erts_debug:set_internal_state(unique_monotonic_integer_state, - NextValue-MinCounter-1). - - + NextValue-MinCounter-1). + + unique_monotonic_integer_white_box_test(TestServer, Success) -> erts_debug:set_internal_state(available_internal_state, true), @@ -130,10 +111,10 @@ unique_monotonic_integer_white_box_test(TestServer, Success) -> ?PRINT({max_counter, MaxCounter}), case WordSize of - 4 -> - MinCounter = MinSint64; - 8 -> - MinCounter = MinSmall + 4 -> + MinCounter = MinSint64; + 8 -> + MinCounter = MinSmall end, StartState = erts_debug:get_internal_state(unique_monotonic_integer_state), @@ -141,20 +122,20 @@ unique_monotonic_integer_white_box_test(TestServer, Success) -> %% 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 + 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... @@ -176,27 +157,27 @@ unique_monotonic_integer_white_box_test(TestServer, Success) -> 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() + 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), + 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), @@ -208,7 +189,7 @@ unique_monotonic_integer_white_box_test(TestServer, Success) -> %% 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), + StartState), TestServer ! Success. @@ -219,16 +200,16 @@ unique_monotonic_integer_white_box_test(TestServer, Success) -> %% -record(uniqint_info, {min_int, - max_int, - max_small, - schedulers, - sched_bits}). + 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, + max_int = MaxInt, + max_small = MaxSmall} = UinqintInfo, io:format("****************************************************~n", []), io:format("*** Around MIN_UNIQ_INT ~p ***~n", [MinInt]), io:format("****************************************************~n", []), @@ -258,7 +239,7 @@ unique_integer_white_box(Config) when is_list(Config) -> io:format("****************************************************~n", []), check_unique_integer_around(MaxInt, UinqintInfo), ok. - + %%% Internal unique_integer_white_box/1 test case @@ -267,10 +248,21 @@ calc_sched_bits(NoScheds, Shift) when NoScheds < 1 bsl Shift -> calc_sched_bits(NoScheds, Shift) -> calc_sched_bits(NoScheds, Shift+1). +schedulers() -> + S = erlang:system_info(schedulers), + try + DCPUS = erlang:system_info(dirty_cpu_schedulers), + DIOS = erlang:system_info(dirty_io_schedulers), + S+DCPUS+DIOS + catch + _ : _ -> + S + end. + init_uniqint_info() -> SmallBits = erlang:system_info({wordsize, internal})*8-4, io:format("SmallBits=~p~n", [SmallBits]), - Schedulers = erlang:system_info(schedulers), + Schedulers = schedulers(), io:format("Schedulers=~p~n", [Schedulers]), MinSmall = -1*(1 bsl (SmallBits-1)), io:format("MinSmall=~p~n", [MinSmall]), @@ -281,33 +273,33 @@ init_uniqint_info() -> 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}. + 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}) -> + 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, + 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) + RI when RI < Int -> + RI; + _ -> + smaller_valid_uniqint(Cand, UinqintInfo) end. int32_to_bigendian_list(Int) -> @@ -318,7 +310,7 @@ int32_to_bigendian_list(Int) -> Int band 16#ff]. mk_uniqint(Int, #uniqint_info {min_int = MinInt, - sched_bits = SchedBits} = _UinqintInfo) -> + sched_bits = SchedBits} = _UinqintInfo) -> Int1 = Int - MinInt, ThrId = Int1 band ((1 bsl SchedBits) - 1), Value = (Int1 bsr SchedBits) band ((1 bsl 64) - 1), @@ -334,36 +326,36 @@ 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) + true -> + io:format("OK~n~n", []); + false -> + io:format("result Int=~p FAILED~n", [Int]), + exit(badres) end. check_unique_integer_around(Int, #uniqint_info{min_int = MinInt, - max_int = MaxInt} = UinqintInfo) -> + 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, + {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)). + 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 @@ -375,17 +367,17 @@ print_ret_val(File, Line, 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}]). + Pa = filename:dirname(code:which(?MODULE)), + A = erlang:monotonic_time(1) + erlang:time_offset(1), + B = erlang:unique_integer([positive]), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B)), + test_server:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl index f4d9030255..d1085c1958 100644 --- a/erts/emulator/test/z_SUITE.erl +++ b/erts/emulator/test/z_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -30,148 +30,117 @@ %-define(line_trace, 1). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -%-compile(export_all). --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([all/0, suite/0]). -export([schedulers_alive/1, node_container_refc_check/1, long_timers/1, pollset_size/1, check_io_debug/1, get_check_io_info/0]). --define(DEFAULT_TIMEOUT, ?t:minutes(5)). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 5}}]. all() -> [schedulers_alive, node_container_refc_check, long_timers, pollset_size, check_io_debug]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - %%% %%% The test cases ------------------------------------------------------------- %%% -schedulers_alive(doc) -> ["Tests that all schedulers are actually used"]; -schedulers_alive(suite) -> []; +%% Tests that all schedulers are actually used schedulers_alive(Config) when is_list(Config) -> - ?line Master = self(), - ?line NoSchedulersOnline = erlang:system_flag( - schedulers_online, - erlang:system_info(schedulers)), - ?line NoSchedulers = erlang:system_info(schedulers), + Master = self(), + NoSchedulersOnline = erlang:system_flag( + schedulers_online, + erlang:system_info(schedulers)), + NoSchedulers = erlang:system_info(schedulers), UsedScheds = - try - ?line ?t:format("Number of schedulers configured: ~p~n", [NoSchedulers]), - ?line case erlang:system_info(multi_scheduling) of - blocked -> - ?line ?t:fail(multi_scheduling_blocked); - disabled -> - ?line ok; - enabled -> - ?t:format("Testing blocking process exit~n"), - BF = fun () -> - blocked = erlang:system_flag(multi_scheduling, - block), - Master ! {self(), blocking}, - receive after infinity -> ok end - end, - ?line Blocker = spawn_link(BF), - ?line Mon = erlang:monitor(process, Blocker), - ?line receive {Blocker, blocking} -> ok end, - ?line [Blocker] - = erlang:system_info(multi_scheduling_blockers), - ?line unlink(Blocker), - ?line exit(Blocker, kill), - ?line receive {'DOWN', Mon, _, _, _} -> ok end, - ?line enabled = erlang:system_info(multi_scheduling), - ?line [] = erlang:system_info(multi_scheduling_blockers), - ?line ok - end, - ?t:format("Testing blocked~n"), - ?line erlang:system_flag(multi_scheduling, block), - ?line case erlang:system_info(multi_scheduling) of - enabled -> - ?line ?t:fail(multi_scheduling_enabled); - blocked -> - ?line [Master] = erlang:system_info(multi_scheduling_blockers); - disabled -> ?line ok - end, - ?line Ps = lists:map( - fun (_) -> - spawn_link(fun () -> - run_on_schedulers(none, - [], - Master) - end) - end, - lists:seq(1,NoSchedulers)), - ?line receive after 1000 -> ok end, - ?line {_, 1} = verify_all_schedulers_used({[],0}, 1), - ?line lists:foreach(fun (P) -> - unlink(P), - exit(P, bang) - end, - Ps), - ?line case erlang:system_flag(multi_scheduling, unblock) of - blocked -> ?line ?t:fail(multi_scheduling_blocked); - disabled -> ?line ok; - enabled -> ?line ok - end, - erts_debug:set_internal_state(available_internal_state, true), - %% node_and_dist_references will use emulator interal thread blocking... - erts_debug:get_internal_state(node_and_dist_references), - erts_debug:set_internal_state(available_internal_state, false), - ?t:format("Testing not blocked~n"), - ?line Ps2 = lists:map( - fun (_) -> - spawn_link(fun () -> - run_on_schedulers(none, - [], - Master) - end) - end, - lists:seq(1,NoSchedulers)), - ?line receive after 1000 -> ok end, - ?line {_, NoSIDs} = verify_all_schedulers_used({[],0},NoSchedulers), - ?line lists:foreach(fun (P) -> - unlink(P), - exit(P, bang) - end, - Ps2), - NoSIDs - after - NoSchedulers = erlang:system_flag(schedulers_online, - NoSchedulersOnline), - NoSchedulersOnline = erlang:system_info(schedulers_online) - end, - ?line {comment, "Number of schedulers " ++ integer_to_list(UsedScheds)}. + try + io:format("Number of schedulers configured: ~p~n", [NoSchedulers]), + case erlang:system_info(multi_scheduling) of + blocked -> + ct:fail(multi_scheduling_blocked); + disabled -> + ok; + enabled -> + io:format("Testing blocking process exit~n"), + BF = fun () -> + blocked = erlang:system_flag(multi_scheduling, + block), + Master ! {self(), blocking}, + receive after infinity -> ok end + end, + Blocker = spawn_link(BF), + Mon = erlang:monitor(process, Blocker), + receive {Blocker, blocking} -> ok end, + [Blocker] + = erlang:system_info(multi_scheduling_blockers), + unlink(Blocker), + exit(Blocker, kill), + receive {'DOWN', Mon, _, _, _} -> ok end, + enabled = erlang:system_info(multi_scheduling), + [] = erlang:system_info(multi_scheduling_blockers), + ok + end, + io:format("Testing blocked~n"), + erlang:system_flag(multi_scheduling, block), + case erlang:system_info(multi_scheduling) of + enabled -> + ct:fail(multi_scheduling_enabled); + blocked -> + [Master] = erlang:system_info(multi_scheduling_blockers); + disabled -> ok + end, + Ps = lists:map( + fun (_) -> + spawn_link(fun () -> + run_on_schedulers(none, + [], + Master) + end) + end, + lists:seq(1,NoSchedulers)), + receive after 1000 -> ok end, + {_, 1} = verify_all_schedulers_used({[],0}, 1), + lists:foreach(fun (P) -> + unlink(P), + exit(P, bang) + end, Ps), + case erlang:system_flag(multi_scheduling, unblock) of + blocked -> ct:fail(multi_scheduling_blocked); + disabled -> ok; + enabled -> ok + end, + erts_debug:set_internal_state(available_internal_state, true), + %% node_and_dist_references will use emulator interal thread blocking... + erts_debug:get_internal_state(node_and_dist_references), + erts_debug:set_internal_state(available_internal_state, false), + io:format("Testing not blocked~n"), + Ps2 = lists:map( + fun (_) -> + spawn_link(fun () -> + run_on_schedulers(none, + [], + Master) + end) + end, + lists:seq(1,NoSchedulers)), + receive after 1000 -> ok end, + {_, NoSIDs} = verify_all_schedulers_used({[],0},NoSchedulers), + lists:foreach(fun (P) -> + unlink(P), + exit(P, bang) + end, Ps2), + NoSIDs + after + NoSchedulers = erlang:system_flag(schedulers_online, + NoSchedulersOnline), + NoSchedulersOnline = erlang:system_info(schedulers_online) + end, + {comment, "Number of schedulers " ++ integer_to_list(UsedScheds)}. run_on_schedulers(LastSID, SIDs, ReportTo) -> @@ -198,65 +167,56 @@ wait_on_used_scheduler({SIDs, SIDsLen} = State) -> true -> wait_on_used_scheduler(State); false -> - ?t:format("Scheduler ~p used~n", [SID]), + io:format("Scheduler ~p used~n", [SID]), {[SID|SIDs], SIDsLen+1} end end. verify_all_schedulers_used({UsedSIDs, UsedSIDsLen} = State, NoSchedulers) -> - ?line case NoSchedulers of + case NoSchedulers of UsedSIDsLen -> - ?line State; + State; NoSchdlrs when NoSchdlrs < UsedSIDsLen -> - ?line ?t:fail({more_schedulers_used_than_exist, + ct:fail({more_schedulers_used_than_exist, {existing_schedulers, NoSchdlrs}, {used_schedulers, UsedSIDsLen}, {used_scheduler_ids, UsedSIDs}}); _ -> - ?line NewState = wait_on_used_scheduler(State), - ?line verify_all_schedulers_used(NewState, NoSchedulers) + NewState = wait_on_used_scheduler(State), + verify_all_schedulers_used(NewState, NoSchedulers) end. -node_container_refc_check(doc) -> []; -node_container_refc_check(suite) -> []; node_container_refc_check(Config) when is_list(Config) -> - ?line node_container_SUITE:node_container_refc_check(node()), - ?line ok. + node_container_SUITE:node_container_refc_check(node()), + ok. -long_timers(doc) -> - []; -long_timers(suite) -> - []; long_timers(Config) when is_list(Config) -> - ?line ok = long_timers_test:check_result(). + ok = long_timers_test:check_result(). -pollset_size(doc) -> - []; -pollset_size(suite) -> - []; pollset_size(Config) when is_list(Config) -> - ?line Name = pollset_size_testcase_initial_state_holder, - ?line Mon = erlang:monitor(process, Name), - ?line (catch Name ! {get_initial_check_io_result, self()}), - ?line InitChkIo = receive + Name = pollset_size_testcase_initial_state_holder, + Mon = erlang:monitor(process, Name), + (catch Name ! {get_initial_check_io_result, self()}), + InitChkIo = receive {initial_check_io_result, ICIO} -> - ?line erlang:demonitor(Mon, [flush]), - ?line ICIO; + erlang:demonitor(Mon, [flush]), + ICIO; {'DOWN', Mon, _, _, Reason} -> - ?line ?t:fail({non_existing, Name, Reason}) + ct:fail({non_existing, Name, Reason}) end, - ?line FinChkIo = get_check_io_info(), - ?line io:format("Initial: ~p~nFinal: ~p~n", [InitChkIo, FinChkIo]), - ?line InitPollsetSize = lists:keysearch(total_poll_set_size, 1, InitChkIo), - ?line FinPollsetSize = lists:keysearch(total_poll_set_size, 1, FinChkIo), - ?line case InitPollsetSize =:= FinPollsetSize of + FinChkIo = get_check_io_info(), + io:format("Initial: ~p~nFinal: ~p~n", [InitChkIo, FinChkIo]), + InitPollsetSize = lists:keysearch(total_poll_set_size, 1, InitChkIo), + FinPollsetSize = lists:keysearch(total_poll_set_size, 1, FinChkIo), + HasGethost = case has_gethost() of true -> 1; _ -> 0 end, + case InitPollsetSize =:= FinPollsetSize of true -> case InitPollsetSize of {value, {total_poll_set_size, Size}} -> - ?line {comment, + {comment, "Pollset size: " ++ integer_to_list(Size)}; _ -> - ?line {skipped, + {skipped, "Pollset size information not available"} end; false -> @@ -265,40 +225,59 @@ pollset_size(Config) when is_list(Config) -> %% that is ok as long as there are at least 2 %% descriptors (dist listen socket and %% epmd socket) in the pollset. - ?line {value, {total_poll_set_size, InitSize}} + {value, {total_poll_set_size, InitSize}} = InitPollsetSize, - ?line {value, {total_poll_set_size, FinSize}} + {value, {total_poll_set_size, FinSize}} = FinPollsetSize, - ?line true = FinSize < InitSize, - ?line true = 2 =< FinSize, - ?line {comment, + true = FinSize < (InitSize + HasGethost), + true = 2 =< FinSize, + {comment, "Start pollset size: " ++ integer_to_list(InitSize) ++ " End pollset size: " ++ integer_to_list(FinSize)} end. -check_io_debug(doc) -> - []; -check_io_debug(suite) -> - []; check_io_debug(Config) when is_list(Config) -> - ?line case lists:keysearch(name, 1, erlang:system_info(check_io)) of - {value, {name, erts_poll}} -> ?line check_io_debug_test(); - _ -> ?line {skipped, "Not implemented in this emulator"} + case lists:keysearch(name, 1, erlang:system_info(check_io)) of + {value, {name, erts_poll}} -> check_io_debug_test(); + _ -> {skipped, "Not implemented in this emulator"} end. check_io_debug_test() -> - ?line erlang:display(get_check_io_info()), - ?line erts_debug:set_internal_state(available_internal_state, true), - ?line {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} + erlang:display(get_check_io_info()), + erts_debug:set_internal_state(available_internal_state, true), + {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} = CheckIoDebug = erts_debug:get_internal_state(check_io_debug), - ?line erts_debug:set_internal_state(available_internal_state, false), - ?line 0 = NoErrorFds, - ?line NoUsedFds = NoDrvSelStructs, - ?line 0 = NoDrvEvStructs, - ?line ok. + erts_debug:set_internal_state(available_internal_state, false), + HasGetHost = has_gethost(), + ct:log("check_io_debug: ~p~n" + "HasGetHost: ~p",[CheckIoDebug, HasGetHost]), + 0 = NoErrorFds, + if + NoUsedFds == NoDrvSelStructs -> + ok; + HasGetHost andalso (NoUsedFds == (NoDrvSelStructs - 1)) -> + %% If the inet_gethost port is alive, we may have + %% one extra used fd that is not selected on. + %% This happens when the initial setup of the + %% port returns an EAGAIN + ok + end, + 0 = NoDrvEvStructs, + ok. +has_gethost() -> + has_gethost(erlang:ports()). +has_gethost([P|T]) -> + case erlang:port_info(P, name) of + {name,"inet_gethost"++_} -> + true; + _ -> + has_gethost(T) + end; +has_gethost([]) -> + false. %% @@ -332,6 +311,3 @@ get_check_io_info() -> receive after 100 -> ok end, get_check_io_info() end. - - - diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 9a8c3585e6..4407f7e289 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1998-2012. All Rights Reserved. +# Copyright Ericsson AB 1998-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -54,6 +54,11 @@ $pack_mask[4] = ['BEAM_LOOSE_MASK', # Only for 64 bit wordsize 'BEAM_LOOSE_MASK', $WHOLE_WORD]; +# Mapping from packagable arguments to number of packed arguments per +# word. Initialized after the wordsize is known. + +my @args_per_word; + # There are two types of instructions: generic and specific. # The generic instructions are those generated by the Beam compiler. # Corresponding to each generic instruction, there is generally a @@ -108,7 +113,6 @@ my @if_line; # my $te_max_vars = 0; # Max number of variables ever needed. my %gen_transform; -my %min_window; my %match_engine_ops; # All opcodes for the match engine. my %gen_transform_offset; my @transformations; @@ -176,11 +180,12 @@ sub define_type_bit { } # Composed types. - define_type_bit('d', $type_bit{'x'} | $type_bit{'y'} | $type_bit{'r'}); + define_type_bit('d', $type_bit{'x'} | $type_bit{'y'}); define_type_bit('c', $type_bit{'i'} | $type_bit{'a'} | $type_bit{'n'} | $type_bit{'q'}); define_type_bit('s', $type_bit{'d'} | $type_bit{'i'} | - $type_bit{'a'} | $type_bit{'n'}); + $type_bit{'a'} | $type_bit{'n'} | + $type_bit{'q'}); define_type_bit('j', $type_bit{'f'} | $type_bit{'p'}); # Aliases (for matching purposes). @@ -236,6 +241,21 @@ while (@ARGV && $ARGV[0] =~ /^-(.*)/) { } # +# Initialize number of arguments per packed word. +# + +$args_per_word[2] = 2; +$args_per_word[3] = 3; +$args_per_word[4] = 2; +$args_per_word[5] = 3; +$args_per_word[6] = 3; + +if ($wordsize == 64) { + $pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD]; + $args_per_word[4] = 4; +} + +# # Parse the input files. # @@ -362,7 +382,6 @@ while (<>) { $gen_arity{$name} = $arity; $gen_to_spec{"$name/$arity"} = undef; $num_specific{"$name/$arity"} = 0; - $min_window{"$name/$arity"} = 255; $obsolete[$op_num] = defined $obsolete; } else { # Unnumbered generic operation. push(@unnumbered_generic, [$name, $arity]); @@ -420,7 +439,6 @@ $num_file_opcodes = @gen_opname; $gen_arity{$name} = $arity; $gen_to_spec{"$name/$arity"} = undef; $num_specific{"$name/$arity"} = 0; - $min_window{"$name/$arity"} = 255; } } @@ -527,12 +545,16 @@ sub emulator_output { my(@bits) = (0) x ($max_spec_operands/2); my($i); + my $involves_r = 0; for ($i = 0; $i < $max_spec_operands && defined $args[$i]; $i++) { my $t = $args[$i]; - if (defined $type_bit{$t}) { - my $shift = $max_genop_types * ($i % 2); - $bits[int($i/2)] |= $type_bit{$t} << $shift; + my $bits = $type_bit{$t}; + if ($t eq 'r') { + $bits |= $type_bit{'x'}; + $involves_r |= 1 << $i; } + my $shift = $max_genop_types * ($i % 2); + $bits[int($i/2)] |= $bits << $shift; } printf "/* %3d */ ", $spec_opnum; @@ -544,7 +566,7 @@ sub emulator_output { $sep = ","; } $init .= "}"; - &init_item($print_name, $init, $size, $pack, $sign, 0); + init_item($print_name, $init, $involves_r, $size, $pack, $sign, 0); $op_to_name[$spec_opnum] = $instr; $spec_opnum++; } @@ -583,7 +605,7 @@ sub emulator_output { $is_transformed{$name,$arity} or error("instruction $key has no specific instruction"); $spec_op = -1 unless defined $spec_op; - &init_item($name, $arity, $spec_op, $num_specific, $tr, $min_window{$key}); + &init_item($name, $arity, $spec_op, $num_specific, $tr); } } print "};\n"; @@ -601,24 +623,27 @@ sub emulator_output { print "#define MAX_GENERIC_OPCODE ", $num_file_opcodes-1, "\n"; print "#define NUM_GENERIC_OPS ", scalar(@gen_opname), "\n"; print "#define NUM_SPECIFIC_OPS ", scalar(@op_to_name), "\n"; + print "#define SCRATCH_X_REG 1023\n"; print "\n"; - print "#ifdef ARCH_64\n"; - print "# define BEAM_WIDE_MASK 0xFFFFUL\n"; - print "# define BEAM_LOOSE_MASK 0x1FFFUL\n"; - print "#if HALFWORD_HEAP\n"; - print "# define BEAM_TIGHT_MASK 0x1FFCUL\n"; - print "#else\n"; - print "# define BEAM_TIGHT_MASK 0x1FF8UL\n"; - print "#endif\n"; - print "# define BEAM_WIDE_SHIFT 32\n"; - print "# define BEAM_LOOSE_SHIFT 16\n"; - print "# define BEAM_TIGHT_SHIFT 16\n"; - print "#else\n"; - print "# define BEAM_LOOSE_MASK 0xFFF\n"; - print "# define BEAM_TIGHT_MASK 0xFFC\n"; - print "# define BEAM_LOOSE_SHIFT 16\n"; - print "# define BEAM_TIGHT_SHIFT 10\n"; - print "#endif\n"; + if ($wordsize == 32) { + print "#if defined(ARCH_64)\n"; + print qq[ #error "32-bit architecture assumed, but ARCH_64 is defined"\n]; + print "#endif\n"; + print "#define BEAM_LOOSE_MASK 0xFFF\n"; + print "#define BEAM_TIGHT_MASK 0xFFC\n"; + print "#define BEAM_LOOSE_SHIFT 16\n"; + print "#define BEAM_TIGHT_SHIFT 10\n"; + } elsif ($wordsize == 64) { + print "#if !defined(ARCH_64)\n"; + print qq[ #error "64-bit architecture assumed, but ARCH_64 not defined"\n]; + print "#endif\n"; + print "#define BEAM_WIDE_MASK 0xFFFFUL\n"; + print "#define BEAM_LOOSE_MASK 0xFFFFUL\n"; + print "#define BEAM_TIGHT_MASK 0xFFFFUL\n"; + print "#define BEAM_WIDE_SHIFT 32\n"; + print "#define BEAM_LOOSE_SHIFT 16\n"; + print "#define BEAM_TIGHT_SHIFT 16\n"; + } print "\n"; # @@ -734,7 +759,7 @@ sub init_item { print "${sep}NULL"; } elsif (/^\{/) { print "$sep$_"; - } elsif (/^-?\d/) { + } elsif (/^-?\d+$/) { print "$sep$_"; } else { print "$sep\"$_\""; @@ -896,6 +921,7 @@ sub basic_generator { my($var_decls) = ''; my($gen_dest_arg) = 'StoreSimpleDest'; my($i); + my($no_prefetch) = 0; # The following argument types should be included as macro arguments. my(%incl_arg) = ('c' => 1, @@ -994,6 +1020,7 @@ sub basic_generator { # $flags =~ /-fail_action/ and do { + $no_prefetch = 1; if (!defined $fail_type) { my($i); for ($i = 0; $i < @f_types; $i++) { @@ -1040,6 +1067,12 @@ sub basic_generator { "I += $size + 1;", "goto $goto;", "}"); + } elsif ($no_prefetch) { + $code = join("\n", + "{ $var_decls", + $macro_code, + "Next($size);", + "}", ""); } else { $code = join("\n", "{ $var_decls", @@ -1061,6 +1094,7 @@ sub do_pack { my($packable_args) = 0; my @is_packable; # Packability (boolean) for each argument. my $wide_packing = 0; + my(@orig_args) = @args; # # Count the number of packable arguments. If we encounter any 's' or 'd' @@ -1081,6 +1115,18 @@ sub do_pack { } } elsif ($arg =~ /^[sd]/) { return ('', '', @args); + } elsif ($arg =~ /^[scq]/ and $packable_args > 0) { + # When packing, this operand will be picked up from the + # code array, put onto the packing stack, and later put + # back into a different location in the code. The problem + # is that if this operand is a literal, the original + # location in the code would have been remembered in a + # literal patch. For packing to work, we would have to + # adjust the position in the literal patch. For the + # moment, adding additional instructions to the packing + # engine to handle this does not seem worth it, so we will + # just turn off packing. + return ('', '', @args); } else { push @is_packable, 0; } @@ -1090,7 +1136,6 @@ sub do_pack { # Get out of here if too few or too many arguments. # return ('', '', @args) if $packable_args < 2; - &error("too many packable arguments") if $packable_args > 4; my($size) = 0; my($pack_prefix) = ''; @@ -1098,14 +1143,8 @@ sub do_pack { # beginning). my($up) = ''; # Pack commands (storing back while # moving forward). - my $args_per_word; - if ($packable_args < 4 or $wordsize == 64) { - $args_per_word = $packable_args; - } else { - # 4 packable argument, 32 bit wordsize. Need 2 words. - $args_per_word = 2; - } + my $args_per_word = $args_per_word[$packable_args]; my @shift; my @mask; my @instr; @@ -1299,6 +1338,8 @@ sub tr_parse_op { foreach (split('', $type)) { &error("bad type in $op") unless defined $type_bit{$_} or $type eq '*'; + $_ eq 'r' and + error("$op: 'r' is not allowed in transformations") } } @@ -1332,7 +1373,10 @@ sub tr_parse_op { } # Get an optional value. (In destination.) + $type_val = $type eq 'x' ? 1023 : 0; if (/^=(.*)/) { + error("value not allowed in source: $op") + if $src; $type_val = $1; $_ = ''; } @@ -1351,11 +1395,6 @@ sub tr_parse_op { if $var && $type; } - # Test that source has no values. - if ($src) { - error("value not allowed in source: $op") - if $type_val; - } ($var,$type,$type_val,$cond,$cond_val); } @@ -1370,8 +1409,7 @@ sub tr_gen { foreach $ref (@g) { my($line, $orig_transform, $from_ref, $to_ref) = @$ref; - my $used_ref = used_vars($from_ref, $to_ref); - my $so_far = tr_gen_from($line, $used_ref, @$from_ref); + my $so_far = tr_gen_from($line, @$from_ref); tr_gen_to($line, $orig_transform, $so_far, @$to_ref); } @@ -1422,58 +1460,14 @@ sub tr_gen { print "};\n\n"; } -sub used_vars { - my($from_ref,$to_ref) = @_; - my %used; - my %seen; - - foreach my $ref (@$from_ref) { - my($name,$arity,@ops) = @$ref; - if ($name =~ /^[.]/) { - foreach my $var (@ops) { - $used{$var} = 1; - } - } else { - # Any variable that is used at least twice on the - # left-hand side is used. (E.g. "move R R".) - foreach my $op (@ops) { - my($var, $type, $type_val) = @$op; - next if $var eq ''; - $used{$var} = 1 if $seen{$var}; - $seen{$var} = 1; - } - } - } - - foreach my $ref (@$to_ref) { - my($name, $arity, @ops) = @$ref; - if ($name =~ /^[.]/) { - foreach my $var (@ops) { - $used{$var} = 1; - } - } else { - foreach my $op (@ops) { - my($var, $type, $type_val) = @$op; - next if $var eq ''; - $used{$var} = 1; - } - } - } - \%used; -} - sub tr_gen_from { - my($line,$used_ref,@tr) = @_; + my($line,@tr) = @_; my(%var) = (); my(%var_type); my($var_num) = 0; my(@code); - my($min_window) = 0; - my(@fix_rest_args); - my(@fix_pred_funcs); my($op, $ref); # Loop variables. my $where = "left side of transformation in line $line: "; - my %var_used = %$used_ref; my $may_fail = 0; my $is_first = 1; @@ -1495,8 +1489,20 @@ sub tr_gen_from { my $var; my(@args); - push(@fix_pred_funcs, scalar(@code)); - push(@code, [$name, @ops]); + foreach $var (@ops) { + error($where, "variable '$var' unbound") + unless defined $var{$var}; + if ($var_type{$var} eq 'scalar') { + push(@args, "var[$var{$var}]"); + } else { + push(@args, "rest_args"); + } + } + my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args); + my $op = make_op("$name()", 'pred', $pi); + my @slots = grep(/^\d+/, map { $var{$_} } @ops); + op_slot_usage($op, @slots); + push(@code, $op); next; } @@ -1509,7 +1515,6 @@ sub tr_gen_from { $opnum = $gen_opnum{$name,$arity}; push(@code, make_op("$name/$arity", 'next_instr', $opnum)); - $min_window++; foreach $op (@ops) { my($var, $type, $type_val, $cond, $val) = @$op; my $ignored_var = "$var (ignored)"; @@ -1558,15 +1563,21 @@ sub tr_gen_from { if (defined $var{$var}) { $ignored_var = ''; $may_fail = 1; - push(@code, &make_op($var, 'is_same_var', $var{$var})); + my $op = make_op($var, 'is_same_var', $var{$var}); + op_slot_usage($op, $var{$var}); + push(@code, $op); } elsif ($type eq '*') { - # - # Reserve a hole for a 'rest_args' instruction. - # + foreach my $type (values %var_type) { + error("only one use of a '*' variable is " . + "allowed on the left hand side of " . + "a transformation") + if $type eq 'array'; + } $ignored_var = ''; - push(@fix_rest_args, scalar(@code)); - push(@code, $var); - } elsif ($var_used{$var}) { + $var{$var} = 'unnumbered'; + $var_type{$var} = 'array'; + push(@code, make_op($var, 'rest_args')); + } else { $ignored_var = ''; $var_type{$var} = 'scalar'; $var{$var} = $var_num; @@ -1594,46 +1605,14 @@ sub tr_gen_from { # push(@code, make_op($may_fail ? '' : 'always reached', 'commit')); - # - # If there is an rest_args instruction, we must insert its correct - # variable number (higher than any other). - # - my $index; - &error("only one use of a '*' variable is allowed on the left hand side of a transformation") - if @fix_rest_args > 1; - foreach $index (@fix_rest_args) { - my $var = $code[$index]; - $var{$var} = $var_num++; - $var_type{$var} = 'array'; - splice(@code, $index, 1, &make_op($var, 'rest_args', $var{$var})); - } - - foreach $index (@fix_pred_funcs) { - my($name, @ops) = @{$code[$index]}; - my(@args); - my $var; - - foreach $var (@ops) { - &error($where, "variable '$var' unbound") - unless defined $var{$var}; - if ($var_type{$var} eq 'scalar') { - push(@args, "var[$var{$var}]"); - } else { - push(@args, "var+$var{$var}"); - } - } - my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args); - splice(@code, $index, 1, make_op("$name()", 'pred', $pi)); - } - $te_max_vars = $var_num if $te_max_vars < $var_num; - [$min_window, \%var, \%var_type, \@code]; + [\%var, \%var_type, \@code]; } sub tr_gen_to { my($line, $orig_transform, $so_far, @tr) = @_; - my($min_window, $var_ref, $var_type_ref, $code_ref) = @$so_far; + my($var_ref, $var_type_ref, $code_ref) = @$so_far; my(%var) = %$var_ref; my(%var_type) = %$var_type_ref; my(@code) = @$code_ref; @@ -1662,13 +1641,16 @@ sub tr_gen_to { if ($var_type{$var} eq 'scalar') { push(@args, "var[$var{$var}]"); } else { - push(@args, "var+$var{$var}"); + push(@args, "rest_args"); } } pop(@code); # Get rid of 'commit' instruction my $index = tr_next_index(\@call_table, \%call_table, $name, @args); - push(@code, make_op("$name()", 'call_end', $index)); + my $op = make_op("$name()", 'call_end', $index); + my @slots = grep(/^\d+/, map { $var{$_} } @ops); + op_slot_usage($op, @slots); + push(@code, $op); last; } @@ -1690,11 +1672,13 @@ sub tr_gen_to { my($var, $type, $type_val) = @$op; if ($type eq '*') { - push(@code, make_op($var, 'store_rest_args', $var{$var})); + push(@code, make_op($var, 'store_rest_args')); } elsif ($var ne '') { &error($where, "variable '$var' unbound") unless defined $var{$var}; - push(@code, &make_op($var, 'store_var_next_arg', $var{$var})); + my $op = make_op($var, 'store_var_next_arg', $var{$var}); + op_slot_usage($op, $var{$var}); + push(@code, $op); } elsif ($type ne '') { push(@code, &make_op('', 'store_type', "TAG_$type")); if ($type_val) { @@ -1709,6 +1693,10 @@ sub tr_gen_to { push(@code, make_op('', 'end')) unless is_instr($code[$#code], 'call_end'); + tr_maybe_keep(\@code); + tr_maybe_rename(\@code); + tr_remove_unused(\@code); + # # Chain together all codes segments having the same first operation. # @@ -1717,8 +1705,6 @@ sub tr_gen_to { my($dummy, $arity); ($dummy, $op, $arity) = @$first; my($comment) = "\n/*\n * Line $line:\n * $orig_transform\n */\n\n"; - $min_window{$key} = $min_window - if $min_window{$key} > $min_window; my $prev_last; $prev_last = pop(@{$gen_transform{$key}}) @@ -1736,6 +1722,148 @@ sub tr_gen_to { push(@{$gen_transform{$key}}, @code), } +sub tr_maybe_keep { + my($ref) = @_; + my @last_instr; + my $pos; + my $reused_instr; + + for (my $i = 0; $i < @$ref; $i++) { + my $instr = $$ref[$i]; + my($size, $instr_ref, $comment) = @$instr; + my($op, @args) = @$instr_ref; + if ($op eq 'next_instr') { + @last_instr = ($args[0]); + } elsif ($op eq 'set_var_next_arg') { + push @last_instr, $args[0]; + } elsif ($op eq 'next_arg') { + push @last_instr, 'ignored'; + } elsif ($op eq 'new_instr') { + unless (defined $pos) { + # 'new_instr' immediately after 'commit'. + $reused_instr = $args[0]; + return unless shift(@last_instr) == $reused_instr; + $pos = $i - 1; + } else { + # Second 'new_instr' after 'commit'. The instructions + # from $pos up to and including $i - 1 rebuilds the + # existing instruction exactly. + my $name = $gen_opname[$reused_instr]; + my $arity = $gen_arity[$reused_instr]; + my $reuse = make_op("$name/$arity", 'keep'); + splice @$ref, $pos, $i-$pos, ($reuse); + return; + } + } elsif ($op eq 'store_var_next_arg') { + return unless shift(@last_instr) eq $args[0]; + } elsif (defined $pos) { + return; + } + } +} + +sub tr_maybe_rename { + my($ref) = @_; + my $s = 'left'; + my $a = 0; + my $num_args = 0; + my $new_instr; + my $first; + my $i; + + for ($i = 1; $i < @$ref; $i++) { + my $instr = $$ref[$i]; + my($size, $instr_ref, $comment) = @$instr; + my($op, @args) = @$instr_ref; + + if ($s eq 'left') { + if ($op eq 'set_var_next_arg') { + if ($num_args == $a and $args[0] == $a) { + $num_args++; + } + $a++; + } elsif ($op eq 'next_arg') { + $a++; + } elsif ($op eq 'commit') { + $a = 0; + $first = $i; + $s = 'committed'; + } elsif ($op eq 'next_instr') { + return; + } + } elsif ($s eq 'committed') { + if ($op eq 'new_instr') { + $new_instr = $args[0]; + $a = 0; + $s = 'right'; + } else { + return; + } + } elsif ($s eq 'right') { + if ($op eq 'store_var_next_arg' && $args[0] == $a) { + $a++; + } elsif ($op eq 'end' && $a <= $num_args) { + my $name = $gen_opname[$new_instr]; + my $arity = $gen_arity[$new_instr]; + my $new_op = make_op("$name/$arity", 'rename', $new_instr); + splice @$ref, $first, $i-$first+1, ($new_op); + return; + } else { + return; + } + } + } +} + +sub tr_remove_unused { + my($ref) = @_; + my %used; + + # Collect all used variables. + for my $instr (@$ref) { + my $uref = $$instr[3]; + for my $slot (@$uref) { + $used{$slot} = 1; + } + } + + # Replace 'set_var_next_arg' with 'next_arg' if the variable + # is never used. + for my $instr (@$ref) { + my($size, $instr_ref, $comment) = @$instr; + my($op, @args) = @$instr_ref; + if ($op eq 'set_var_next_arg') { + my $var = $args[0]; + next if $used{$var}; + $instr = make_op("$comment (ignored)", 'next_arg'); + } + } + + # Delete a sequence of 'next_arg' instructions when they are + # redundant before instructions such as 'commit'. + my @opcode; + my %ending = (call_end => 1, + commit => 1, + next_instr => 1, + pred => 1, + rename => 1, + keep => 1); + for (my $i = 0; $i < @$ref; $i++) { + my $instr = $$ref[$i]; + my($size, $instr_ref, $comment) = @$instr; + my($opcode) = @$instr_ref; + + if ($ending{$opcode}) { + my $first = $i; + $first-- while $first > 0 and $opcode[$first-1] eq 'next_arg'; + my $n = $i - $first; + splice @$ref, $first, $n; + $i -= $n; + } + $opcode[$i] = $opcode; + } +} + sub tr_code_len { my($sum) = 0; my($ref); @@ -1748,7 +1876,12 @@ sub tr_code_len { sub make_op { my($comment, @op) = @_; - [scalar(@op), [@op], $comment]; + [scalar(@op), [@op], $comment, []]; +} + +sub op_slot_usage { + my($op_ref, @slots) = @_; + $$op_ref[3] = \@slots; } sub is_instr { diff --git a/erts/emulator/utils/beam_strip b/erts/emulator/utils/beam_strip index 0e7bc46b63..2a2d761940 100755 --- a/erts/emulator/utils/beam_strip +++ b/erts/emulator/utils/beam_strip @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2009. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/utils/count b/erts/emulator/utils/count index c4dd42c949..e0a5e8bb9a 100755 --- a/erts/emulator/utils/count +++ b/erts/emulator/utils/count @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/utils/loaded b/erts/emulator/utils/loaded index ab77ffdb6c..5e0a29c014 100644 --- a/erts/emulator/utils/loaded +++ b/erts/emulator/utils/loaded @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2011. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/emulator/utils/make_alloc_types b/erts/emulator/utils/make_alloc_types index 925b9d5810..33afe139a2 100755 --- a/erts/emulator/utils/make_alloc_types +++ b/erts/emulator/utils/make_alloc_types @@ -3,7 +3,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2009. All Rights Reserved. +# Copyright Ericsson AB 2003-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/utils/make_compiler_flags b/erts/emulator/utils/make_compiler_flags index d75ea0817e..47491a4832 100755 --- a/erts/emulator/utils/make_compiler_flags +++ b/erts/emulator/utils/make_compiler_flags @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2009. All Rights Reserved. +# Copyright Ericsson AB 1999-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/utils/make_driver_tab b/erts/emulator/utils/make_driver_tab index 3203c7110a..ffb5f58ebf 100755 --- a/erts/emulator/utils/make_driver_tab +++ b/erts/emulator/utils/make_driver_tab @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2013. All Rights Reserved. +# Copyright Ericsson AB 1999-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -31,7 +31,7 @@ my $file = ""; my $nif = ""; my @emu_drivers = (); my @static_drivers = (); -my @nifs = (); +my @static_nifs = (); my $mode = 1; while (@ARGV) { @@ -55,9 +55,14 @@ while (@ARGV) { push(@static_drivers, $d); } if ($mode == 2) { - push(@nifs, $d); + push(@static_nifs, $d); } next; + } elsif ($mode == 2) { + $d = basename $d; + $d =~ s/_nif(\..*|)$//; # strip nif.* or just nif + push(@static_nifs, $d); + next; } $d = basename $d; $d =~ s/drv(\..*|)$//; # strip drv.* or just drv @@ -120,7 +125,7 @@ typedef struct ErtsStaticNifEntry_ { EOF # prototypes -foreach (@nifs) { +foreach (@static_nifs) { my $d = ${_}; $d =~ s/\.debug//; # strip .debug print "void *".$d."_nif_init(void);\n"; @@ -129,7 +134,7 @@ foreach (@nifs) { # The array itself print "static ErtsStaticNifEntry static_nif_tab[] =\n{\n"; -foreach (@nifs) { +foreach (@static_nifs) { my $d = ${_}; $d =~ s/\.debug//; # strip .debug print "{\"${_}\",&".$d."_nif_init},\n"; diff --git a/erts/emulator/utils/make_preload b/erts/emulator/utils/make_preload index 62c4419589..f489bc2a39 100755 --- a/erts/emulator/utils/make_preload +++ b/erts/emulator/utils/make_preload @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2012. All Rights Reserved. +# Copyright Ericsson AB 1999-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/utils/make_tables b/erts/emulator/utils/make_tables index 233e95f176..c158778f43 100755 --- a/erts/emulator/utils/make_tables +++ b/erts/emulator/utils/make_tables @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2013. All Rights Reserved. +# Copyright Ericsson AB 1999-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/utils/make_version b/erts/emulator/utils/make_version index 37bdff181a..e02a42c66d 100755 --- a/erts/emulator/utils/make_version +++ b/erts/emulator/utils/make_version @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2009. All Rights Reserved. +# Copyright Ericsson AB 1999-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/emulator/utils/mkver.c b/erts/emulator/utils/mkver.c index 6641873712..6183246433 100644 --- a/erts/emulator/utils/mkver.c +++ b/erts/emulator/utils/mkver.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/emulator/valgrind/suppress.halfword b/erts/emulator/valgrind/suppress.halfword deleted file mode 100644 index 8fe448d897..0000000000 --- a/erts/emulator/valgrind/suppress.halfword +++ /dev/null @@ -1,56 +0,0 @@ -# Extra suppressions specific for the halfword emulator. - -# --- Suppress all offheap binaries --- -# Valgrinds leak check does not recognize pointers that are stored -# at unaligned addresses. In halfword emulator we store 64-bit pointers -# to offheap data on 32-bit aligned heaps. -# We solve this by suppressing allocation of all offheap structures -# that are not referenced by other tables (ie binaries). - -{ -Halfword erts_bin_nrml_alloc -Memcheck:Leak -... -fun:erts_bin_nrml_alloc -... -} - -{ -Halfword erts_bin_realloc -Memcheck:Leak -... -fun:erts_bin_realloc -... -} - -{ -Halfword erts_bin_realloc_fnf -Memcheck:Leak -... -fun:erts_bin_realloc_fnf -... -} - -{ -Halfword erts_bin_drv_alloc -Memcheck:Leak -... -fun:erts_bin_drv_alloc -... -} - -{ -Halfword erts_bin_drv_alloc_fnf -Memcheck:Leak -... -fun:erts_bin_drv_alloc_fnf -... -} - -{ -Halfword erts_create_magic_binary -Memcheck:Leak -... -fun:erts_create_magic_binary -... -} diff --git a/erts/emulator/zlib/zlib.mk b/erts/emulator/zlib/zlib.mk index 53d7badd64..3f0d64d250 100644 --- a/erts/emulator/zlib/zlib.mk +++ b/erts/emulator/zlib/zlib.mk @@ -4,7 +4,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2011-2012. All Rights Reserved. +# Copyright Ericsson AB 2011-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/epmd/Makefile b/erts/epmd/Makefile index 25a33462ee..d3308ddedc 100644 --- a/erts/epmd/Makefile +++ b/erts/epmd/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# Copyright Ericsson AB 1998-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/epmd/epmd.mk b/erts/epmd/epmd.mk index 08245b784e..b1fd04dc04 100644 --- a/erts/epmd/epmd.mk +++ b/erts/epmd/epmd.mk @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# Copyright Ericsson AB 1998-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/epmd/src/Makefile b/erts/epmd/src/Makefile index 3e09a40566..4ae13fe05a 100644 --- a/erts/epmd/src/Makefile +++ b/erts/epmd/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# Copyright Ericsson AB 1998-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/epmd/src/Makefile.in b/erts/epmd/src/Makefile.in index b6e3ba7762..da4370d5f9 100644 --- a/erts/epmd/src/Makefile.in +++ b/erts/epmd/src/Makefile.in @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1998-2012. All Rights Reserved. +# Copyright Ericsson AB 1998-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -19,10 +19,6 @@ # include $(ERL_TOP)/make/target.mk -ifeq ($(findstring ose,$(TARGET)),ose) -include $(ERL_TOP)/make/$(TARGET)/ose_lm.mk -endif - ifeq ($(TYPE),debug) PURIFY = TYPEMARKER = .debug @@ -32,21 +28,13 @@ else ifeq ($(TYPE),purify) PURIFY = purify TYPEMARKER = -ifeq ($(findstring ose,$(TARGET)),ose) - TYPE_FLAGS = -DPURIFY -else - TYPE_FLAGS = -O2 -DPURIFY -endif +TYPE_FLAGS = -O2 -DPURIFY else override TYPE = opt PURIFY = TYPEMARKER = -ifeq ($(findstring ose,$(TARGET)),ose) - TYPE_FLAGS = -else - TYPE_FLAGS = -O2 -endif +TYPE_FLAGS = -O2 endif endif @@ -68,13 +56,9 @@ else ifeq ($(findstring vxworks,$(TARGET)),vxworks) ERTS_INTERNAL_LIBS=-L../../lib/internal/$(TARGET) -lerts_internal$(ERTS_LIB_TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ else -ifeq ($(findstring ose,$(TARGET)),ose) -ERTS_INTERNAL_LIBS=-L../../lib/internal/$(TARGET) -lerts_internal$(ERTS_LIB_TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ -else ERTS_INTERNAL_LIBS=-L../../lib/internal/$(TARGET) -lerts_internal$(ERTS_LIB_TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ -lm endif endif -endif ERTS_LIB = $(ERL_TOP)/erts/lib_src/obj/$(TARGET)/$(TYPE)/MADE @@ -82,11 +66,7 @@ CC = @CC@ WFLAGS = @WFLAGS@ CFLAGS = @CFLAGS@ @DEFS@ $(TYPE_FLAGS) $(WFLAGS) $(ERTS_INCL) LD = @LD@ -ifeq ($(findstring ose,$(TARGET)),ose) -LIBS = $(ERTS_INTERNAL_LIBS) @LIBS@ -else LIBS = @LIBS@ @SYSTEMD_DAEMON_LIBS@ $(ERTS_INTERNAL_LIBS) -endif LDFLAGS = @LDFLAGS@ @@ -135,25 +115,12 @@ clean: rm -f *.o rm -f *~ core -ifeq ($(findstring ose,$(TARGET)),ose) -$(OBJDIR)/ose_confd.o: $(OSE_CONFD) - $(V_CC) $(CFLAGS) -o $@ -c $< -$(OBJDIR)/crt0_lm.o: $(CRT0_LM) - $(V_CC) $(CFLAGS) -o $@ -c $< -OSE_LM_OBJS += $(OBJDIR)/ose_confd.o $(OBJDIR)/crt0_lm.o -endif - # # Objects & executables # -ifeq ($(findstring ose,$(TARGET)),ose) -$(BINDIR)/$(EPMD): $(EPMD_OBJS) $(ERTS_LIB) $(OSE_LM_OBJS) - $(call build-ose-load-module, $@, $(EPMD_OBJS) $(OSE_LM_OBJS), $(LIBS), $(EPMD_LMCONF)) -else $(BINDIR)/$(EPMD): $(EPMD_OBJS) $(ERTS_LIB) $(ld_verbose)$(PURIFY) $(LD) $(LDFLAGS) -o $@ $(EPMD_OBJS) $(LIBS) -endif $(OBJDIR)/%.o: %.c epmd.h epmd_int.h $(V_CC) $(CFLAGS) $(EPMD_FLAGS) -o $@ -c $< diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c index 5513cb2d7e..44e997e609 100644 --- a/erts/epmd/src/epmd.c +++ b/erts/epmd/src/epmd.c @@ -2,7 +2,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2013. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -397,7 +397,7 @@ static void run_daemon(EpmdVars *g) } #endif -#if defined(VXWORKS) || defined(__OSE__) +#if defined(VXWORKS) static void run_daemon(EpmdVars *g) { run(g); @@ -592,8 +592,10 @@ void epmd_cleanup_exit(EpmdVars *g, int exitval) free(g->argv); } #ifdef HAVE_SYSTEMD_DAEMON - sd_notifyf(0, "STATUS=Exited.\n" - "ERRNO=%i", exitval); + if (g->is_systemd){ + sd_notifyf(0, "STATUS=Exited.\n" + "ERRNO=%i", exitval); + } #endif /* HAVE_SYSTEMD_DAEMON */ exit(exitval); } diff --git a/erts/epmd/src/epmd.h b/erts/epmd/src/epmd.h index 10483bb5a2..cffcd4ae7a 100644 --- a/erts/epmd/src/epmd.h +++ b/erts/epmd/src/epmd.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2010. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/epmd/src/epmd_cli.c b/erts/epmd/src/epmd_cli.c index 6fc05e153e..6fd27d46ea 100644 --- a/erts/epmd/src/epmd_cli.c +++ b/erts/epmd/src/epmd_cli.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2013. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/epmd/src/epmd_int.h b/erts/epmd/src/epmd_int.h index 09317094c7..ed9bbdb8cd 100644 --- a/erts/epmd/src/epmd_int.h +++ b/erts/epmd/src/epmd_int.h @@ -2,7 +2,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2013. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -37,13 +37,6 @@ #define DONT_USE_MAIN #endif -#ifdef __OSE__ -# define NO_DAEMON -# define NO_SYSLOG -# define NO_SYSCONF -# define NO_FCNTL -#endif - /* ************************************************************************ */ /* Standard includes */ @@ -101,12 +94,7 @@ #endif /* ! WIN32 */ #include <ctype.h> - -#if !defined(__OSE__) -# include <signal.h> -#endif - - +#include <signal.h> #include <errno.h> #ifdef HAVE_SYSLOG_H @@ -123,10 +111,6 @@ #include <stdarg.h> -#ifdef __OSE__ -# include "sys/select.h" -#endif - #ifdef HAVE_SYSTEMD_DAEMON # include <systemd/sd-daemon.h> #endif /* HAVE_SYSTEMD_DAEMON */ @@ -253,8 +237,8 @@ static const struct in6_addr in6addr_loopback = #define EPMD_TRUE 1 /* If no activity we let select() return every IDLE_TIMEOUT second - A file descriptor that are idle for CLOSE_TIMEOUT seconds and - isn't a ALIVE socket is probably hanging and we close it */ + A file descriptor that has been idle for CLOSE_TIMEOUT seconds and + isn't an ALIVE socket has probably hanged and should be closed */ #define IDLE_TIMEOUT 5 #define CLOSE_TIMEOUT 60 diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index e1bac99ef9..66c10a65bc 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -2,7 +2,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2013. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -30,11 +30,6 @@ # define INADDR_NONE 0xffffffff #endif -#if defined(__OSE__) -# include "sys/ioctl.h" -# define sleep(x) delay(x*1000) -#endif - /* * * This server is a local name server for Erlang nodes. Erlang nodes can @@ -335,7 +330,7 @@ void run(EpmdVars *g) } #endif /* HAVE_SYSTEMD_DAEMON */ -#if !defined(__WIN32__) && !defined(__OSE__) +#if !defined(__WIN32__) /* We ignore the SIGPIPE signal that is raised when we call write twice on a socket closed by the other end. */ signal(SIGPIPE, SIG_IGN); @@ -452,9 +447,11 @@ void run(EpmdVars *g) num_sockets = bound; #ifdef HAVE_SYSTEMD_DAEMON } - sd_notifyf(0, "READY=1\n" - "STATUS=Processing port mapping requests...\n" - "MAINPID=%lu", (unsigned long) getpid()); + if (g->is_systemd) { + sd_notifyf(0, "READY=1\n" + "STATUS=Processing port mapping requests...\n" + "MAINPID=%lu", (unsigned long) getpid()); + } #endif /* HAVE_SYSTEMD_DAEMON */ dbg_tty_printf(g,2,"entering the main select() loop"); diff --git a/erts/epmd/test/Makefile b/erts/epmd/test/Makefile index 7c5302a2f1..ad1315440f 100644 --- a/erts/epmd/test/Makefile +++ b/erts/epmd/test/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1998-2012. All Rights Reserved. +# Copyright Ericsson AB 1998-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/epmd/test/epmd_SUITE.erl b/erts/epmd/test/epmd_SUITE.erl index d5837e5b8c..763984267a 100644 --- a/erts/epmd/test/epmd_SUITE.erl +++ b/erts/epmd/test/epmd_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(epmd_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). diff --git a/erts/etc/Makefile b/erts/etc/Makefile index 9a14cee89c..788dfff132 100644 --- a/erts/etc/Makefile +++ b/erts/etc/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2009. All Rights Reserved. +# Copyright Ericsson AB 1999-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/common/Makefile b/erts/etc/common/Makefile index bbf51d0efd..bad1d3ddb0 100644 --- a/erts/etc/common/Makefile +++ b/erts/etc/common/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/common/Makefile.in b/erts/etc/common/Makefile.in index 8e55fa78c9..cb053a1b7c 100644 --- a/erts/etc/common/Makefile.in +++ b/erts/etc/common/Makefile.in @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2014. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -21,10 +21,6 @@ include $(ERL_TOP)/make/output.mk include $(ERL_TOP)/make/target.mk -ifeq ($(findstring ose,$(TARGET)),ose) -include $(ERL_TOP)/make/$(TARGET)/ose_lm.mk -endif - ERTS_LIB_TYPEMARKER=.$(TYPE) USING_MINGW=@MIXED_CYGWIN_MINGW@ @@ -85,18 +81,13 @@ EMUOSDIR = $(ERL_TOP)/erts/emulator/@ERLANG_OSTYPE@ SYSDIR = $(ERL_TOP)/erts/emulator/sys/@ERLANG_OSTYPE@ DRVDIR = $(ERL_TOP)/erts/emulator/drivers/@ERLANG_OSTYPE@ UXETC = ../unix -OSEETC = ../ose WINETC = ../win32 ifeq ($(TARGET), win32) ETC = $(WINETC) else -ifeq ($(findstring ose,$(TARGET)),ose) -ETC = $(OSEETC) -else ETC = $(UXETC) endif -endif ifeq ($(TARGET), win32) ERLEXEC = erlexec.dll @@ -180,25 +171,6 @@ PORT_ENTRY_POINT=erl_port_entry ENTRY_LDFLAGS=-entry:$(PORT_ENTRY_POINT) else -ifeq ($(findstring ose,$(TARGET)),ose) -ENTRY_LDFLAGS= -ENTRY_OBJ= -ERLSRV_OBJECTS= -MC_OUTPUTS= -INET_GETHOST = -INSTALL_EMBEDDED_PROGS = $(BINDIR)/run_erl_lm -INSTALL_EMBEDDED_DATA = -INSTALL_TOP = Install -INSTALL_TOP_BIN = -INSTALL_MISC = -INSTALL_SRC = -ERLEXECDIR = . -INSTALL_LIBS = -INSTALL_OBJS = -INSTALL_INCLUDES = -TEXTFILES = Install erl.src -INSTALL_PROGS = $(INSTALL_EMBEDDED_PROGS) -else # UNIX (!win32 && !ose) ENTRY_LDFLAGS= ENTRY_OBJ= ERLSRV_OBJECTS= @@ -223,7 +195,6 @@ INSTALL_PROGS = \ $(BINDIR)/$(ERLEXEC) \ $(INSTALL_EMBEDDED_PROGS) endif -endif .PHONY: etc etc: $(ENTRY_OBJ) $(INSTALL_PROGS) $(INSTALL_LIBS) $(TEXTFILES) $(INSTALL_TOP_BIN) @@ -269,8 +240,8 @@ endif rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/to_erl.o rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/dyn_erl.o rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/safe_string.o - rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/run_erl_common.o - rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/to_erl_common.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/run_erl.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/to_erl.o rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/typer.o rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/ct_run.o rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/vxcall.o @@ -423,28 +394,24 @@ $(BINDIR)/inet_gethost@EXEEXT@: $(OBJDIR)/inet_gethost.o $(ENTRY_OBJ) $(ERTS_LIB $(ld_verbose)$(PURIFY) $(LD) $(LDFLAGS) $(ENTRY_LDFLAGS) -o $@ $(OBJDIR)/inet_gethost.o $(ENTRY_OBJ) $(LIBS) $(ERTS_INTERNAL_LIBS) # run_erl -$(BINDIR)/run_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o $(OBJDIR)/run_erl_common.o - $(V_LD) $(LDFLAGS) -o $@ $^ $(LIBS) -$(OBJDIR)/run_erl.o: $(ETC)/run_erl.c ../common/run_erl_common.h $(RC_GENERATED) - $(V_CC) $(CFLAGS) -I ../common/ -o $@ -c $(ETC)/run_erl.c -$(OBJDIR)/run_erl_common.o: ../common/run_erl_common.c ../common/run_erl_common.h $(RC_GENERATED) - $(V_CC) $(CFLAGS) -o $@ -c $< +$(BINDIR)/run_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o + $(V_LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o $(LIBS) +$(OBJDIR)/run_erl.o: $(ETC)/run_erl.c $(RC_GENERATED) + $(V_CC) $(CFLAGS) -o $@ -c $(ETC)/run_erl.c # to_erl -$(BINDIR)/to_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o $(OBJDIR)/to_erl_common.o - $(V_LD) $(LDFLAGS) -o $@ $^ -$(OBJDIR)/to_erl.o: $(ETC)/to_erl.c ../common/safe_string.h $(RC_GENERATED) - $(V_CC) $(CFLAGS) -I ../common/ -o $@ -c $(ETC)/to_erl.c -$(OBJDIR)/to_erl_common.o: ../common/to_erl_common.c ../common/to_erl_common.h $(RC_GENERATED) - $(V_CC) $(CFLAGS) -o $@ -c $< +$(BINDIR)/to_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o + $(V_LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o +$(OBJDIR)/to_erl.o: $(ETC)/to_erl.c $(RC_GENERATED) + $(V_CC) $(CFLAGS) -o $@ -c $(ETC)/to_erl.c # dyn_erl $(BINDIR)/dyn_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/dyn_erl.o $(V_LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/dyn_erl.o $(OBJDIR)/dyn_erl.o: $(UXETC)/dyn_erl.c $(RC_GENERATED) $(V_CC) $(CFLAGS) -o $@ -c $(UXETC)/dyn_erl.c -$(OBJDIR)/safe_string.o: ../common/safe_string.c $(RC_GENERATED) - $(V_CC) $(CFLAGS) -o $@ -c ../common/safe_string.c +$(OBJDIR)/safe_string.o: $(ETC)/safe_string.c $(RC_GENERATED) + $(V_CC) $(CFLAGS) -o $@ -c $(ETC)/safe_string.c ifneq ($(TARGET),win32) $(BINDIR)/$(ERLEXEC): $(OBJDIR)/$(ERLEXEC).o $(ERTS_LIB) @@ -499,30 +466,6 @@ erl.src: $(UXETC)/erl.src.src ../../vsn.mk $(TARGET)/Makefile -e 's;%VSN%;$(VSN);' \ $(UXETC)/erl.src.src > erl.src -#--------------------------------------------------------- -# OSE specific targets -#--------------------------------------------------------- -ifeq ($(findstring ose,$(TARGET)),ose) -$(OBJDIR)/ose_confd.o: $(OSE_CONFD) - $(V_CC) $(CFLAGS) -o $@ -c $< -$(OBJDIR)/crt0_lm.o: $(CRT0_LM) - $(V_CC) $(CFLAGS) -o $@ -c $< -OSE_LM_OBJS += $(OBJDIR)/ose_confd.o $(OBJDIR)/crt0_lm.o - -$(BINDIR)/run_erl_lm: $(OBJDIR)/run_erl_main.o $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o $(OBJDIR)/run_erl_common.o $(OBJDIR)/to_erl_common.o $(OSE_LM_OBJS) - $(call build-ose-load-module, $@, $^, $(LIBS), $(RUN_ERL_LMCONF)) - - -$(OBJDIR)/run_erl_main.o: $(OSEETC)/run_erl_main.c $(OSEETC)/run_erl.h ../common/to_erl_common.h $(RC_GENERATED) - $(V_CC) $(CFLAGS) -I ../common/ -o $@ -c $(OSEETC)/run_erl_main.c - -endif - -#--------------------------------------------------------- -# End of ose specific targets. -#--------------------------------------------------------- - - # ---------------------------------------------------- # Release Target # ---------------------------------------------------- @@ -537,11 +480,9 @@ endif $(INSTALL_DIR) "$(RELEASE_PATH)/erts-$(VSN)/bin" ifneq ($(TARGET), win32) ifneq ($(findstring vxworks,$(TARGET)), vxworks) -ifneq ($(findstring ose,$(TARGET)), ose) $(INSTALL_SCRIPT) erl.src "$(RELEASE_PATH)/erts-$(VSN)/bin" endif endif -endif ifneq ($(INSTALL_PROGS),) $(INSTALL_PROGRAM) $(INSTALL_PROGS) "$(RELEASE_PATH)/erts-$(VSN)/bin" endif diff --git a/erts/etc/common/ct_run.c b/erts/etc/common/ct_run.c index 548514ee6c..acdfa8c8b8 100644 --- a/erts/etc/common/ct_run.c +++ b/erts/etc/common/ct_run.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2013. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -81,13 +81,14 @@ static int eargc; /* Number of arguments in eargv. */ */ static void error(char* format, ...); -static char* emalloc(size_t size); +static void* emalloc(size_t size); static char* strsave(char* string); static void push_words(char* src); static int run_erlang(char* name, char** argv); static char* get_default_emulator(char* progname); #ifdef __WIN32__ static char* possibly_quote(char* arg); +static void* erealloc(void *p, size_t size); #endif /* @@ -141,10 +142,10 @@ int main(int argc, char** argv) int i; int len; /* Convert argv to utf8 */ - argv = malloc((argc+1) * sizeof(char*)); + argv = emalloc((argc+1) * sizeof(char*)); for (i=0; i<argc; i++) { len = WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, NULL, 0, NULL, NULL); - argv[i] = malloc(len*sizeof(char)); + argv[i] = emalloc(len*sizeof(char)); WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, argv[i], len, NULL, NULL); } argv[argc] = NULL; @@ -334,7 +335,7 @@ wchar_t *make_commandline(char **argv) buff = (wchar_t *) emalloc(siz*sizeof(wchar_t)); } else if (siz < num) { siz = num; - buff = (wchar_t *) realloc(buff,siz*sizeof(wchar_t)); + buff = (wchar_t *) erealloc(buff,siz*sizeof(wchar_t)); } p = buff; num=0; @@ -437,15 +438,26 @@ error(char* format, ...) exit(1); } -static char* +static void* emalloc(size_t size) { - char *p = malloc(size); + void *p = malloc(size); if (p == NULL) error("Insufficient memory"); return p; } +#ifdef __WIN32__ +static void * +erealloc(void *p, size_t size) +{ + void *res = realloc(p, size); + if (res == NULL) + error("Insufficient memory"); + return res; +} +#endif + static char* strsave(char* string) { diff --git a/erts/etc/common/dialyzer.c b/erts/etc/common/dialyzer.c index c45626606c..6ba3605422 100644 --- a/erts/etc/common/dialyzer.c +++ b/erts/etc/common/dialyzer.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2013. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -63,13 +63,14 @@ static int eargc; /* Number of arguments in eargv. */ */ static void error(char* format, ...); -static char* emalloc(size_t size); +static void* emalloc(size_t size); static char* strsave(char* string); static void push_words(char* src); static int run_erlang(char* name, char** argv); static char* get_default_emulator(char* progname); #ifdef __WIN32__ static char* possibly_quote(char* arg); +static void* erealloc(void *p, size_t size); #endif /* @@ -164,10 +165,10 @@ int main(int argc, char** argv) #ifdef __WIN32__ int len; /* Convert argv to utf8 */ - argv = malloc((argc+1) * sizeof(char*)); + argv = emalloc((argc+1) * sizeof(char*)); for (i=0; i<argc; i++) { len = WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, NULL, 0, NULL, NULL); - argv[i] = malloc(len*sizeof(char)); + argv[i] = emalloc(len*sizeof(char)); WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, argv[i], len, NULL, NULL); } argv[argc] = NULL; @@ -310,7 +311,7 @@ wchar_t *make_commandline(char **argv) buff = (wchar_t *) emalloc(siz*sizeof(wchar_t)); } else if (siz < num) { siz = num; - buff = (wchar_t *) realloc(buff,siz*sizeof(wchar_t)); + buff = (wchar_t *) erealloc(buff,siz*sizeof(wchar_t)); } p = buff; num=0; @@ -413,15 +414,26 @@ error(char* format, ...) exit(1); } -static char* +static void* emalloc(size_t size) { - char *p = malloc(size); + void *p = malloc(size); if (p == NULL) error("Insufficient memory"); return p; } +#ifdef __WIN32__ +static void * +erealloc(void *p, size_t size) +{ + void *res = realloc(p, size); + if (res == NULL) + error("Insufficient memory"); + return res; +} +#endif + static char* strsave(char* string) { diff --git a/erts/etc/common/erlc.c b/erts/etc/common/erlc.c index f9d909e01c..b54cb31bef 100644 --- a/erts/etc/common/erlc.c +++ b/erts/etc/common/erlc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2013. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -71,13 +71,14 @@ static int pause_after_execution = 0; static char* process_opt(int* pArgc, char*** pArgv, int offset); static void error(char* format, ...); -static char* emalloc(size_t size); +static void* emalloc(size_t size); static char* strsave(char* string); static void push_words(char* src); static int run_erlang(char* name, char** argv); static char* get_default_emulator(char* progname); #ifdef __WIN32__ static char* possibly_quote(char* arg); +static void* erealloc(void *p, size_t size); #endif /* @@ -171,10 +172,10 @@ int main(int argc, char** argv) int i; int len; /* Convert argv to utf8 */ - argv = malloc((argc+1) * sizeof(char*)); + argv = emalloc((argc+1) * sizeof(char*)); for (i=0; i<argc; i++) { len = WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, NULL, 0, NULL, NULL); - argv[i] = malloc(len*sizeof(char)); + argv[i] = emalloc(len*sizeof(char)); WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, argv[i], len, NULL, NULL); } argv[argc] = NULL; @@ -370,7 +371,7 @@ wchar_t *make_commandline(char **argv) buff = (wchar_t *) emalloc(siz*sizeof(wchar_t)); } else if (siz < num) { siz = num; - buff = (wchar_t *) realloc(buff,siz*sizeof(wchar_t)); + buff = (wchar_t *) erealloc(buff,siz*sizeof(wchar_t)); } p = buff; num=0; @@ -478,15 +479,26 @@ error(char* format, ...) exit(1); } -static char* +static void* emalloc(size_t size) { - char *p = malloc(size); + void *p = malloc(size); if (p == NULL) error("Insufficient memory"); return p; } +#ifdef __WIN32__ +static void * +erealloc(void *p, size_t size) +{ + void *res = realloc(p, size); + if (res == NULL) + error("Insufficient memory"); + return res; +} +#endif + static char* strsave(char* string) { diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index af1c198281..5a5021b003 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -65,6 +65,7 @@ static const char plusM_au_allocs[]= { 'u', /* all alloc_util allocators */ 'B', /* binary_alloc */ + 'I', /* literal_alloc */ 'D', /* std_alloc */ 'E', /* ets_alloc */ 'F', /* fix_alloc */ @@ -73,6 +74,7 @@ static const char plusM_au_allocs[]= { 'R', /* driver_alloc */ 'S', /* sl_alloc */ 'T', /* temp_alloc */ + 'X', /* exec_alloc */ 'Z', /* test_alloc */ '\0' }; @@ -121,6 +123,8 @@ static char *plusM_other_switches[] = { "Ym", "Ytp", "Ytt", + "Iscs", + "Xscs", NULL }; @@ -146,6 +150,7 @@ static char *plush_val_switches[] = { "ms", "mbs", "pds", + "mqd", "", NULL }; diff --git a/erts/etc/common/escript.c b/erts/etc/common/escript.c index 7fd02ed436..71c278881c 100644 --- a/erts/etc/common/escript.c +++ b/erts/etc/common/escript.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2007-2013. All Rights Reserved. + * Copyright Ericsson AB 2007-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -71,7 +71,7 @@ static int eargc; /* Number of arguments in eargv. */ */ static void error(char* format, ...); -static char* emalloc(size_t size); +static void* emalloc(size_t size); static void efree(void *p); static char* strsave(char* string); static void push_words(char* src); @@ -79,6 +79,7 @@ static int run_erlang(char* name, char** argv); static char* get_default_emulator(char* progname); #ifdef __WIN32__ static char* possibly_quote(char* arg); +static void* erealloc(void *p, size_t size); #endif /* @@ -418,10 +419,10 @@ main(int argc, char** argv) int i; int len; /* Convert argv to utf8 */ - argv = malloc((argc+1) * sizeof(char*)); + argv = emalloc((argc+1) * sizeof(char*)); for (i=0; i<argc; i++) { len = WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, NULL, 0, NULL, NULL); - argv[i] = malloc(len*sizeof(char)); + argv[i] = emalloc(len*sizeof(char)); WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, argv[i], len, NULL, NULL); } argv[argc] = NULL; @@ -594,7 +595,7 @@ wchar_t *make_commandline(char **argv) buff = (wchar_t *) emalloc(siz*sizeof(wchar_t)); } else if (siz < num) { siz = num; - buff = (wchar_t *) realloc(buff,siz*sizeof(wchar_t)); + buff = (wchar_t *) erealloc(buff,siz*sizeof(wchar_t)); } p = buff; num=0; @@ -694,15 +695,26 @@ error(char* format, ...) exit(1); } -static char* +static void* emalloc(size_t size) { - char *p = malloc(size); + void *p = malloc(size); if (p == NULL) error("Insufficient memory"); return p; } +#ifdef __WIN32__ +static void * +erealloc(void *p, size_t size) +{ + void *res = realloc(p, size); + if (res == NULL) + error("Insufficient memory"); + return res; +} +#endif + static void efree(void *p) { diff --git a/erts/etc/common/heart.c b/erts/etc/common/heart.c index 1a826221fb..e931ae4641 100644 --- a/erts/etc/common/heart.c +++ b/erts/etc/common/heart.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/common/inet_gethost.c b/erts/etc/common/inet_gethost.c index e298c5e7f7..bc4893b0eb 100644 --- a/erts/etc/common/inet_gethost.c +++ b/erts/etc/common/inet_gethost.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2012. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -2646,7 +2646,7 @@ static void *my_realloc(void *old, size_t size) BOOL create_mesq(MesQ **q) { - MesQ *tmp = malloc(sizeof(MesQ)); + MesQ *tmp = ALLOC(sizeof(MesQ)); tmp->data_present = CreateEvent(NULL, TRUE, FALSE,NULL); if (tmp->data_present == NULL) { free(tmp); diff --git a/erts/etc/common/run_erl_common.c b/erts/etc/common/run_erl_common.c deleted file mode 100644 index c03d5e3ae2..0000000000 --- a/erts/etc/common/run_erl_common.c +++ /dev/null @@ -1,696 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2014. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#include <dirent.h> -#include <errno.h> -#include <fcntl.h> -#include <stdarg.h> -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <sys/stat.h> -#include <sys/types.h> -#include <time.h> -#include <unistd.h> - -#ifdef __ANDROID__ -# include <termios.h> -#endif - -#ifdef HAVE_SYSLOG_H -# include <syslog.h> -#endif - -#ifdef HAVE_SYS_IOCTL_H -# include <sys/ioctl.h> -#endif - -#ifdef __OSE__ -# include "ramlog.h" -#endif - -#include "run_erl_common.h" -#include "safe_string.h" - -#define DEFAULT_LOG_GENERATIONS 5 -#define LOG_MAX_GENERATIONS 1000 /* No more than 1000 log files */ -#define LOG_MIN_GENERATIONS 2 /* At least two to switch between */ -#define DEFAULT_LOG_MAXSIZE 100000 -#define LOG_MIN_MAXSIZE 1000 /* Smallast value for changing log file */ -#define LOG_STUBNAME "erlang.log." -#define LOG_PERM 0664 -#define DEFAULT_LOG_ACTIVITY_MINUTES 5 -#define DEFAULT_LOG_ALIVE_MINUTES 15 -#define DEFAULT_LOG_ALIVE_FORMAT "%a %b %e %T %Z %Y" -#define ALIVE_BUFFSIZ 1024 - -#define STATUSFILENAME "/run_erl.log" - -#define PIPE_STUBNAME "erlang.pipe" -#define PIPE_STUBLEN strlen(PIPE_STUBNAME) -#define PERM (S_IWUSR | S_IRUSR | S_IWOTH | S_IROTH | S_IWGRP | S_IRGRP) - -/* OSE has defined O_SYNC but it is not recognized by open */ -#if !defined(O_SYNC) || defined(__OSE__) -#undef O_SYNC -#define O_SYNC 0 -#define USE_FSYNC 1 -#endif - -/* Global variable definitions - * We need this complex way of handling global variables because of how - * OSE works here. We want to make it possible to run the shell command - * run_erl multiple times with different global variables without them - * effecting eachother. - */ - -#define STATUSFILE (RE_DATA->statusfile) -#define LOG_DIR (RE_DATA->log_dir) -#define STDSTATUS (RE_DATA->stdstatus) -#define LOG_GENERATIONS (RE_DATA->log_generations) -#define LOG_MAXSIZE (RE_DATA->log_maxsize) -#define LOG_ACTIVITY_MINUTES (RE_DATA->log_activity_minutes) -#define LOG_ALIVE_IN_GMT (RE_DATA->log_alive_in_gmt) -#define LOG_ALIVE_FORMAT (RE_DATA->log_alive_format) -#define RUN_DAEMON (RE_DATA->run_daemon) -#define LOG_ALIVE_MINUTES (RE_DATA->log_alive_minutes) -#define LOG_NUM (RE_DATA->log_num) -#define LFD (RE_DATA->lfd) -#define PROTOCOL_VER (RE_DATA->protocol_ver) - -struct run_erl_ { - /* constant config data */ - char statusfile[FILENAME_BUFSIZ]; - char log_dir[FILENAME_BUFSIZ]; - FILE *stdstatus; - int log_generations; - int log_maxsize; - int log_activity_minutes; - int log_alive_in_gmt; - char log_alive_format[ALIVE_BUFFSIZ+1]; - int run_daemon; - int log_alive_minutes; - /* Current log number and log fd */ - int log_num; - int lfd; - unsigned protocol_ver; -}; - -typedef struct run_erl_ run_erl; - -#ifdef __OSE__ -static OSPPDKEY run_erl_pp_key; -#define RE_DATA (*(run_erl**)ose_get_ppdata(run_erl_pp_key)) -#else -static run_erl re; -#define RE_DATA (&re) -#endif - -/* prototypes */ - -static int next_log(int log_num); -static int prev_log(int log_num); -static int find_next_log_num(void); -static int open_log(int log_num, int flags); - -/* - * getenv_int: - */ -static char *getenv_int(const char *name) { -#ifdef __OSE__ - return get_env(get_bid(current_process()),name); -#else - return getenv(name); -#endif -} - -/* - * next_log: - * Returns the index number that follows the given index number. - * (Wrapping after log_generations) - */ -static int next_log(int log_num) { - return log_num>=LOG_GENERATIONS?1:log_num+1; -} - -/* - * prev_log: - * Returns the index number that precedes the given index number. - * (Wrapping after log_generations) - */ -static int prev_log(int log_num) { - return log_num<=1?LOG_GENERATIONS:log_num-1; -} - -/* - * find_next_log_num() - * Searches through the log directory to check which logs that already - * exist. It finds the "hole" in the sequence, and returns the index - * number for the last log in the log sequence. If there is no hole, index - * 1 is returned. - */ -static int find_next_log_num(void) { - int i, next_gen, log_gen; - DIR *dirp; - struct dirent *direntp; - int log_exists[LOG_MAX_GENERATIONS+1]; - int stub_len = strlen(LOG_STUBNAME); - - /* Initialize exiting log table */ - - for(i=LOG_GENERATIONS; i>=0; i--) - log_exists[i] = 0; - dirp = opendir(LOG_DIR); - if(!dirp) { - ERRNO_ERR1(LOG_ERR,"Can't access log directory '%s'", LOG_DIR); - exit(1); - } - - /* Check the directory for existing logs */ - - while((direntp=readdir(dirp)) != NULL) { - if(strncmp(direntp->d_name,LOG_STUBNAME,stub_len)==0) { - int num = atoi(direntp->d_name+stub_len); - if(num < 1 || num > LOG_GENERATIONS) - continue; - log_exists[num] = 1; - } - } - closedir(dirp); - - /* Find out the next available log file number */ - - next_gen = 0; - for(i=LOG_GENERATIONS; i>=0; i--) { - if(log_exists[i]) - if(next_gen) - break; - else - ; - else - next_gen = i; - } - - /* Find out the current log file number */ - - if(next_gen) - log_gen = prev_log(next_gen); - else - log_gen = 1; - - return log_gen; -} /* find_next_log_num() */ - -static int open_log(int log_num, int flags) -{ - char buf[FILENAME_MAX]; - time_t now; - struct tm *tmptr; - char log_buffer[ALIVE_BUFFSIZ+1]; - - /* Remove the next log (to keep a "hole" in the log sequence) */ - sn_printf(buf, sizeof(buf), "%s/%s%d", - LOG_DIR, LOG_STUBNAME, next_log(log_num)); - unlink(buf); - - /* Create or continue on the current log file */ - sn_printf(buf, sizeof(buf), "%s/%s%d", LOG_DIR, LOG_STUBNAME, log_num); - - LFD = sf_open(buf, flags, LOG_PERM); - - if(LFD <0){ - ERRNO_ERR1(LOG_ERR,"Can't open log file '%s'.", buf); - exit(1); - } - - /* Write a LOGGING STARTED and time stamp into the log file */ - time(&now); - if (LOG_ALIVE_IN_GMT) { - tmptr = gmtime(&now); - } else { - tmptr = localtime(&now); - } - if (!strftime(log_buffer, ALIVE_BUFFSIZ, LOG_ALIVE_FORMAT, - tmptr)) { - strn_cpy(log_buffer, sizeof(log_buffer), - "(could not format time in 256 positions " - "with current format string.)"); - } - log_buffer[ALIVE_BUFFSIZ] = '\0'; - - sn_printf(buf, sizeof(buf), "\n=====\n===== LOGGING STARTED %s\n=====\n", - log_buffer); - if (erts_run_erl_write_all(LFD, buf, strlen(buf)) < 0) - erts_run_erl_log_status("Error in writing to log.\n"); - -#if USE_FSYNC - fsync(LFD); -#endif - - return LFD; -} - -/* Instead of making sure basename exists, we do our own */ -char *simple_basename(char *path) -{ - char *ptr; - for (ptr = path; *ptr != '\0'; ++ptr) { - if (*ptr == '/') { - path = ptr + 1; - } - } - return path; -} - -ssize_t sf_read(int fd, void *buffer, size_t len) { - ssize_t n = 0; - - do { n = read(fd, buffer, len); } while (n < 0 && errno == EINTR); - - return n; -} - -ssize_t sf_write(int fd, const void *buffer, size_t len) { - ssize_t n = 0; - - do { n = write(fd, buffer, len); } while (n < 0 && errno == EINTR); - - return n; -} - -int sf_open(const char *path, int type, mode_t mode) { - int fd = 0; - - do { fd = open(path, type, mode); } while(fd < 0 && errno == EINTR); - - return fd; -} - -int sf_close(int fd) { - int res = 0; - - do { res = close(fd); } while(res < 0 && errno == EINTR); - - return res; -} - -/* Call write() until entire buffer has been written or error. - * Return len or -1. - */ -int erts_run_erl_write_all(int fd, const char* buf, int len) -{ - int left = len; - int written; - for (;;) { - do { - written = write(fd,buf,left); - } while (written < 0 && errno == EINTR); - if (written == left) { - return len; - } - if (written < 0) { - return -1; - } - left -= written; - buf += written; - } - return written; -} - -/* erts_run_erl_log_status() - * Prints the arguments to a status file - * Works like printf (see vfrpintf) - */ -void erts_run_erl_log_status(const char *format,...) -{ - va_list args; - time_t now; - - if (STDSTATUS == NULL) - STDSTATUS = fopen(STATUSFILE, "w"); - if (STDSTATUS == NULL) - return; - now = time(NULL); - fprintf(STDSTATUS, "run_erl [%d] %s", -#ifdef __OSE__ - (int)current_process(), -#else - (int)getpid(), -#endif - ctime(&now)); - va_start(args, format); - vfprintf(STDSTATUS, format, args); - va_end(args); - fflush(STDSTATUS); - return; -} - -/* Fetch the current log alive minutes */ -int erts_run_erl_log_alive_minutes() { - return LOG_ALIVE_MINUTES; -} - -/* error_logf() - * Prints the arguments to stderr or syslog - * Works like printf (see vfprintf) - */ -void erts_run_erl_log_error(int priority, int line, const char *format, ...) -{ - va_list args; - va_start(args, format); - -#ifdef HAVE_SYSLOG_H - if (RUN_DAEMON) { - vsyslog(priority,format,args); - } - else -#endif -#ifdef __OSE__ - if (RUN_DAEMON) { - char *buff = malloc(sizeof(char)*1024); - vsnprintf(buff,1024,format, args); - ramlog_printf(buff); - } - else -#endif - { - time_t now = time(NULL); - fprintf(stderr, "run_erl:%d [%d] %s", line, -#ifdef __OSE__ - (int)current_process(), -#else - (int)getpid(), -#endif - ctime(&now)); - vfprintf(stderr, format, args); - } - va_end(args); -} - -/* erts_run_erl_log_write() - * Writes a message to lfd. If the current log file is full, - * a new log file is opened. - */ -int erts_run_erl_log_write(char* buf, size_t len) -{ - int size; - ssize_t res; - /* Decide if new logfile needed, and open if so */ - - size = lseek(LFD,0,SEEK_END); - if(size+len > LOG_MAXSIZE) { - int res; - do { - res = close(LFD); - } while (res < 0 && errno == EINTR); - LOG_NUM = next_log(LOG_NUM); - LFD = open_log(LOG_NUM, O_RDWR|O_CREAT|O_TRUNC|O_SYNC); - } - - /* Write to log file */ - - if ((res = erts_run_erl_write_all(LFD, buf, len)) < 0) { - erts_run_erl_log_status("Error in writing to log.\n"); - } - -#if USE_FSYNC - fsync(LFD); -#endif - return res; -} - -int erts_run_erl_log_activity(int timeout,time_t now,time_t last_activity) { - char log_alive_buffer[ALIVE_BUFFSIZ+1]; - char buf[BUFSIZ]; - - if (timeout || now - last_activity > LOG_ACTIVITY_MINUTES*60) { - /* Either a time out: 15 minutes without action, */ - /* or something is coming in right now, but it's a long time */ - /* since last time, so let's write a time stamp this message */ - struct tm *tmptr; - if (LOG_ALIVE_IN_GMT) { - tmptr = gmtime(&now); - } else { - tmptr = localtime(&now); - } - if (!strftime(log_alive_buffer, ALIVE_BUFFSIZ, LOG_ALIVE_FORMAT, - tmptr)) { - strn_cpy(log_alive_buffer, sizeof(log_alive_buffer), - "(could not format time in 256 positions " - "with current format string.)"); - } - log_alive_buffer[ALIVE_BUFFSIZ] = '\0'; - - sn_printf(buf, sizeof(buf), "\n===== %s%s\n", - timeout?"ALIVE ":"", log_alive_buffer); - return erts_run_erl_log_write(buf, strlen(buf)); - } - return 0; -} - -int erts_run_erl_log_open() { - - LOG_NUM = find_next_log_num(); - LFD = open_log(LOG_NUM, O_RDWR|O_APPEND|O_CREAT|O_SYNC); - return 0; -} - -int erts_run_erl_log_init(int daemon, char* logdir) { - char *p; - -#ifdef __OSE__ - run_erl **re_pp; - if (!run_erl_pp_key) - ose_create_ppdata("run_erl_ppdata",&run_erl_pp_key); - re_pp = (run_erl **)ose_get_ppdata(run_erl_pp_key); - *re_pp = malloc(sizeof(run_erl)); -#endif - - STDSTATUS = NULL; - LOG_GENERATIONS = DEFAULT_LOG_GENERATIONS; - LOG_MAXSIZE = DEFAULT_LOG_MAXSIZE; - LOG_ACTIVITY_MINUTES = DEFAULT_LOG_ACTIVITY_MINUTES; - LOG_ALIVE_IN_GMT = 0; - RUN_DAEMON = 0; - LOG_ALIVE_MINUTES = DEFAULT_LOG_ALIVE_MINUTES; - LFD = 0; - PROTOCOL_VER = RUN_ERL_LO_VER; /* assume lowest to begin with */ - - /* Get values for LOG file handling from the environment */ - if ((p = getenv_int("RUN_ERL_LOG_ALIVE_MINUTES"))) { - LOG_ALIVE_MINUTES = atoi(p); - if (!LOG_ALIVE_MINUTES) { - ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ALIVE_MINUTES is 1 " - "(current value is %s)",p); - } - LOG_ACTIVITY_MINUTES = LOG_ALIVE_MINUTES / 3; - if (!LOG_ACTIVITY_MINUTES) { - ++LOG_ACTIVITY_MINUTES; - } - } - if ((p = getenv_int( - "RUN_ERL_LOG_ACTIVITY_MINUTES"))) { - LOG_ACTIVITY_MINUTES = atoi(p); - if (!LOG_ACTIVITY_MINUTES) { - ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ACTIVITY_MINUTES is 1 " - "(current value is %s)",p); - } - } - if ((p = getenv_int("RUN_ERL_LOG_ALIVE_FORMAT"))) { - if (strlen(p) > ALIVE_BUFFSIZ) { - ERROR1(LOG_ERR, "RUN_ERL_LOG_ALIVE_FORMAT can contain a maximum of " - "%d characters", ALIVE_BUFFSIZ); - } - strn_cpy(LOG_ALIVE_FORMAT, sizeof(LOG_ALIVE_FORMAT), p); - } else { - strn_cpy(LOG_ALIVE_FORMAT, sizeof(LOG_ALIVE_FORMAT), - DEFAULT_LOG_ALIVE_FORMAT); - } - if ((p = getenv_int("RUN_ERL_LOG_ALIVE_IN_UTC")) - && strcmp(p,"0")) { - ++LOG_ALIVE_IN_GMT; - } - if ((p = getenv_int("RUN_ERL_LOG_GENERATIONS"))) { - LOG_GENERATIONS = atoi(p); - if (LOG_GENERATIONS < LOG_MIN_GENERATIONS) - ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_GENERATIONS is %d", - LOG_MIN_GENERATIONS); - if (LOG_GENERATIONS > LOG_MAX_GENERATIONS) - ERROR1(LOG_ERR,"Maximum RUN_ERL_LOG_GENERATIONS is %d", - LOG_MAX_GENERATIONS); - } - - if ((p = getenv_int("RUN_ERL_LOG_MAXSIZE"))) { - LOG_MAXSIZE = atoi(p); - if (LOG_MAXSIZE < LOG_MIN_MAXSIZE) - ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_MAXSIZE is %d", LOG_MIN_MAXSIZE); - } - - RUN_DAEMON = daemon; - - strn_cpy(LOG_DIR, sizeof(LOG_DIR), logdir); - strn_cpy(STATUSFILE, sizeof(STATUSFILE), LOG_DIR); - strn_cat(STATUSFILE, sizeof(STATUSFILE), STATUSFILENAME); - - return 0; -} - -/* create_fifo() - * Creates a new fifo with the given name and permission. - */ -static int create_fifo(char *name, int perm) -{ - if ((mkfifo(name, perm) < 0) && (errno != EEXIST)) - return -1; - return 0; -} - -/* - * w- and r_pipename have to be pre-allocated of atleast FILENAME_MAX size - */ -int erts_run_erl_open_fifo(char *pipename,char *w_pipename,char *r_pipename) { - int calculated_pipename = 0; - int highest_pipe_num = 0; - int fd; - - /* - * Create FIFOs and open them - */ - - if(*pipename && pipename[strlen(pipename)-1] == '/') { - /* The user wishes us to find a unique pipe name in the specified */ - /* directory */ - DIR *dirp; - struct dirent *direntp; - - calculated_pipename = 1; - dirp = opendir(pipename); - if(!dirp) { - ERRNO_ERR1(LOG_ERR,"Can't access pipe directory '%s'.", pipename); - return 1; - } - - /* Check the directory for existing pipes */ - - while((direntp=readdir(dirp)) != NULL) { - if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) { - int num = atoi(direntp->d_name+PIPE_STUBLEN+1); - if(num > highest_pipe_num) - highest_pipe_num = num; - } - } - closedir(dirp); - strn_catf(pipename, BUFSIZ, "%s.%d", - PIPE_STUBNAME, highest_pipe_num+1); - } /* if */ - - for(;;) { - /* write FIFO - is read FIFO for `to_erl' program */ - strn_cpy(w_pipename, BUFSIZ, pipename); - strn_cat(w_pipename, BUFSIZ, ".r"); - if (create_fifo(w_pipename, PERM) < 0) { - ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for writing.", - w_pipename); - return 1; - } - - /* read FIFO - is write FIFO for `to_erl' program */ - strn_cpy(r_pipename, BUFSIZ, pipename); - strn_cat(r_pipename, BUFSIZ, ".w"); - - /* Check that nobody is running run_erl already */ - if ((fd = sf_open(r_pipename, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) { - /* Open as client succeeded -- run_erl is already running! */ - sf_close(fd); - if (calculated_pipename) { - ++highest_pipe_num; - strn_catf(pipename, BUFSIZ, "%s.%d", - PIPE_STUBNAME, highest_pipe_num+1); - continue; - } - ERROR1(LOG_ERR, "Erlang already running on pipe %s.\n", pipename); - unlink(w_pipename); - return 1; - } - if (create_fifo(r_pipename, PERM) < 0) { - unlink(w_pipename); - ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for reading.", - r_pipename); - return 1; - } - break; - } - return 0; -} - -/* Extract any control sequences that are ment only for run_erl - * and should not be forwarded to the pty. - */ -int erts_run_erl_extract_ctrl_seq(char* buf, int len, int mfd) -{ - static const char prefix[] = "\033_"; - static const char suffix[] = "\033\\"; - char* bufend = buf + len; - char* start = buf; - char* command; - char* end; - - for (;;) { - start = find_str(start, bufend-start, prefix); - if (!start) break; - - command = start + strlen(prefix); - end = find_str(command, bufend-command, suffix); - if (end) { - unsigned col, row; - if (sscanf(command,"version=%u", &PROTOCOL_VER)==1) { - /*fprintf(stderr,"to_erl v%u\n", protocol_ver);*/ - } - else if (sscanf(command,"winsize=%u,%u", &col, &row)==2) { -#ifdef TIOCSWINSZ - struct winsize ws; - ws.ws_col = col; - ws.ws_row = row; - if (ioctl(mfd, TIOCSWINSZ, &ws) < 0) { - ERRNO_ERR0(LOG_ERR,"Failed to set window size"); - } -#endif - } - else { - ERROR2(LOG_ERR, "Ignoring unknown ctrl command '%.*s'\n", - (int)(end-command), command); - } - - /* Remove ctrl sequence from buf */ - end += strlen(suffix); - memmove(start, end, bufend-end); - bufend -= end - start; - } - else { - ERROR2(LOG_ERR, "Missing suffix in ctrl sequence '%.*s'\n", - (int)(bufend-start), start); - break; - } - } - return bufend - buf; -} diff --git a/erts/etc/common/run_erl_common.h b/erts/etc/common/run_erl_common.h deleted file mode 100644 index cecf7521f9..0000000000 --- a/erts/etc/common/run_erl_common.h +++ /dev/null @@ -1,97 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Functions that are common to both OSE and unix implementations of run_erl - */ -#ifndef ERL_RUN_ERL_LOG_H -#define ERL_RUN_ERL_LOG_H - -#include <stdio.h> -#include <time.h> -#include <unistd.h> - -#include "run_erl_vsn.h" - -/* Log handling */ -int erts_run_erl_log_init(int run_daemon, char* logdir); -int erts_run_erl_log_open(void); -int erts_run_erl_log_close(void); -int erts_run_erl_log_write(char *buff, size_t len); -int erts_run_erl_log_activity(int timeout, time_t now, time_t last_activity); - -void erts_run_erl_log_status(const char *format,...); -void erts_run_erl_log_error(int priority, int line, const char *format,...); - -int erts_run_erl_open_fifo(char *pipename,char *w_pipename,char *r_pipename); -int erts_run_erl_log_alive_minutes(void); -int erts_run_erl_extract_ctrl_seq(char* buf, int len, int mfd); - -/* File operations */ -ssize_t sf_read(int fd, void *buffer, size_t len); -ssize_t sf_write(int fd, const void *buffer, size_t len); -int sf_open(const char *path, int type, mode_t mode); -int sf_close(int fd); -int erts_run_erl_write_all(int fd, const char* buf, int len); -char *simple_basename(char *path); - -#ifndef LOG_ERR -#ifdef __OSE__ -#define LOG_ERR 0 -#else -#define LOG_ERR NULL -#endif -#endif - -#define ERROR0(Prio,Format) erts_run_erl_log_error(Prio,__LINE__,Format"\n") -#define ERROR1(Prio,Format,A1) erts_run_erl_log_error(Prio,__LINE__,Format"\n",A1) -#define ERROR2(Prio,Format,A1,A2) erts_run_erl_log_error(Prio,__LINE__,Format"\n",A1,A2) - -#ifdef HAVE_STRERROR -# define ADD_ERRNO(Format) "errno=%d '%s'\n"Format"\n",errno,strerror(errno) -#else -# define ADD_ERRNO(Format) "errno=%d\n"Format"\n",errno -#endif -#define ERRNO_ERR0(Prio,Format) erts_run_erl_log_error(Prio,__LINE__,ADD_ERRNO(Format)) -#define ERRNO_ERR1(Prio,Format,A1) erts_run_erl_log_error(Prio,__LINE__,ADD_ERRNO(Format),A1) -#define ERRNO_ERR2(Prio,Format,A1,A2) erts_run_erl_log_error(Prio,__LINE__,ADD_ERRNO(Format),A1,A2) - -#define RUN_ERL_USAGE \ - "%s (pipe_name|pipe_dir/) log_dir \"command [parameters ...]\"" \ - "\n\nDESCRIPTION:\n" \ - "You may also set the environment variables RUN_ERL_LOG_GENERATIONS\n" \ - "and RUN_ERL_LOG_MAXSIZE to the number of log files to use and the\n" \ - "size of the log file when to switch to the next log file\n" - -#ifndef FILENAME_MAX -#define FILENAME_MAX 250 -#endif - -#define FILENAME_BUFSIZ FILENAME_MAX - -#ifdef O_NONBLOCK -# define DONT_BLOCK_PLEASE O_NONBLOCK -#else -# define DONT_BLOCK_PLEASE O_NDELAY -# ifndef EAGAIN -# define EAGAIN -3898734 -# endif -#endif - -#endif diff --git a/erts/etc/common/to_erl_common.c b/erts/etc/common/to_erl_common.c deleted file mode 100644 index 8aa94ccfa4..0000000000 --- a/erts/etc/common/to_erl_common.c +++ /dev/null @@ -1,717 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Module: to_erl.c - * - * This module implements a process that opens two specified FIFOs, one - * for reading and one for writing; reads from its stdin, and writes what - * it has read to the write FIF0; reads from the read FIFO, and writes to - * its stdout. - * - ________ _________ - | |--<-- pipe.r (fifo1) --<--| | - | to_erl | | run_erl | (parent) - |________|-->-- pipe.w (fifo2) -->--|_________| - ^ master pty - | - | slave pty - ____V____ - | | - | "erl" | (child) - |_________| - */ -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#include <sys/types.h> -#include <sys/stat.h> -#include <sys/time.h> -#include <sys/types.h> -#include <fcntl.h> -#include <unistd.h> -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <dirent.h> -#include <errno.h> - -#ifdef __OSE__ -#include <aio.h> -#include "ose.h" -#include "efs.h" -#include "ose_spi/fm.sig" -#else /* __UNIX__ */ -#include <termios.h> -#include <signal.h> -#endif - -#ifdef HAVE_SYS_IOCTL_H -# include <sys/ioctl.h> -#endif - -#include "to_erl_common.h" -#include "run_erl_vsn.h" -#include "safe_string.h" /* strn_cpy, strn_catf, sn_printf, etc. */ - -#if defined(O_NONBLOCK) -# define DONT_BLOCK_PLEASE O_NONBLOCK -#else -# define DONT_BLOCK_PLEASE O_NDELAY -# if !defined(EAGAIN) -# define EAGAIN -3898734 -# endif -#endif - -#ifdef HAVE_STRERROR -# define STRERROR(x) strerror(x) -#else -# define STRERROR(x) "" -#endif - -#define noDEBUG - -#ifdef __OSE__ -#define PIPE_DIR "/pipe/" -#else -#define PIPE_DIR "/tmp/" -#endif -#define PIPE_STUBNAME "erlang.pipe" -#define PIPE_STUBLEN strlen(PIPE_STUBNAME) - -#ifdef DEBUG -#define STATUS(s) { fprintf(stderr, (s)); fflush(stderr); } -#else -#define STATUS(s) -#endif - -#ifndef FILENAME_MAX -#define FILENAME_MAX 250 -#endif - -static int tty_eof = 0; -static int protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */ - -static int write_all(int fd, const char* buf, int len); -static int version_handshake(char* buf, int len, int wfd); - - -#ifdef __OSE__ - -#define SET_AIO(REQ,FD,SIZE,BUFF) \ - /* Make sure to clean data structure of previous request */ \ - memset(&(REQ),0,sizeof(REQ)); \ - (REQ).aio_fildes = FD; \ - (REQ).aio_offset = FM_POSITION_CURRENT; \ - (REQ).aio_nbytes = SIZE; \ - (REQ).aio_buf = BUFF; \ - (REQ).aio_sigevent.sigev_notify = SIGEV_NONE - -#define READ_AIO(REQ,FD,SIZE,BUFF) \ - SET_AIO(REQ,FD,SIZE,BUFF); \ - if (aio_read(&(REQ)) != 0) \ - fprintf(stderr,"aio_read of child_read_req(%d) failed" \ - "with error %d\n",FD,errno) - -union SIGNAL { - SIGSELECT signo; - struct FmReadPtr fm_read_ptr; -}; - -#else /* __UNIX__ */ -static int recv_sig = 0; -static struct termios tty_smode, tty_rmode; -static int window_size_seq(char* buf, size_t bufsz); -#ifdef DEBUG -static void show_terminal_settings(struct termios *); -#endif - -static void handle_ctrlc(int sig) -{ - /* Reinstall the handler, and signal break flag */ - signal(SIGINT,handle_ctrlc); - recv_sig = SIGINT; -} - -static void handle_sigwinch(int sig) -{ - recv_sig = SIGWINCH; -} -#endif - -static void usage(char *pname) -{ - fprintf(stderr, "Usage: "); - fprintf(stderr,TO_ERL_USAGE,pname); -} - -int to_erl(int argc, char **argv) -{ - char FIFO1[FILENAME_MAX], FIFO2[FILENAME_MAX]; - int i, len, wfd, rfd; - char pipename[FILENAME_MAX]; - int pipeIx = 1; - int force_lock = 0; - int got_some = 0; - -#ifdef __OSE__ - struct aiocb stdin_read_req, pipe_read_req; - FmHandle stdin_fh, pipe_fh; - char *stdin_buf, *pipe_buf; - char *buf; - union SIGNAL *sig; -#else /* __UNIX__ */ - char buf[BUFSIZ]; - fd_set readfds; -#endif - - if (argc >= 2 && argv[1][0]=='-') { - switch (argv[1][1]) { - case 'h': - usage(argv[0]); - exit(1); - case 'F': - force_lock = 1; - break; - default: - fprintf(stderr,"Invalid option '%s'\n",argv[1]); - exit(1); - } - pipeIx = 2; - } - -#ifdef DEBUG - fprintf(stderr, "%s: pid is : %d\n", argv[0],(int) -#ifdef __OSE__ - current_process() -#else /* __UNIX__ */ - getpid() -#endif - ); -#endif - - strn_cpy(pipename, sizeof(pipename), - (argv[pipeIx] ? argv[pipeIx] : PIPE_DIR)); - - if(*pipename && pipename[strlen(pipename)-1] == '/') { - /* The user wishes us to find a pipe name in the specified */ - /* directory */ - int highest_pipe_num = 0; - DIR *dirp; - struct dirent *direntp; - - dirp = opendir(pipename); - if(!dirp) { - fprintf(stderr, "Can't access pipe directory %s: %s\n", pipename, strerror(errno)); - exit(1); - } - - /* Check the directory for existing pipes */ - - while((direntp=readdir(dirp)) != NULL) { - if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) { - int num = atoi(direntp->d_name+PIPE_STUBLEN+1); - if(num > highest_pipe_num) - highest_pipe_num = num; - } - } - closedir(dirp); - strn_catf(pipename, sizeof(pipename), (highest_pipe_num?"%s.%d":"%s"), - PIPE_STUBNAME, highest_pipe_num); - } /* if */ - - /* read FIFO */ - sn_printf(FIFO1,sizeof(FIFO1),"%s.r",pipename); - /* write FIFO */ - sn_printf(FIFO2,sizeof(FIFO2),"%s.w",pipename); - -#ifndef __OSE__ - /* Check that nobody is running to_erl on this pipe already */ - if ((wfd = open (FIFO1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) { - /* Open as server succeeded -- to_erl is already running! */ - close(wfd); - fprintf(stderr, "Another to_erl process already attached to pipe " - "%s.\n", pipename); - if (force_lock) { - fprintf(stderr, "But we proceed anyway by force (-F).\n"); - } - else { - exit(1); - } - } -#endif - - if ((rfd = open (FIFO1, O_RDONLY|DONT_BLOCK_PLEASE, 0)) < 0) { -#ifdef DEBUG - fprintf(stderr, "Could not open FIFO %s for reading.\n", FIFO1); -#endif - fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno)); - exit(1); - } -#ifdef DEBUG - fprintf(stderr, "to_erl: %s opened for reading\n", FIFO1); -#endif - - if ((wfd = open (FIFO2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) { -#ifdef DEBUG - fprintf(stderr, "Could not open FIFO %s for writing.\n", FIFO2); -#endif - fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno)); - close(rfd); - exit(1); - } -#ifdef DEBUG - fprintf(stderr, "to_erl: %s opened for writing\n", FIFO2); -#endif - -#ifndef __OSE__ - fprintf(stderr, "Attaching to %s (^D to exit)\n\n", pipename); -#else - fprintf(stderr, "Attaching to %s (^C to exit)\n\n", pipename); -#endif - -#ifndef __OSE__ - /* Set break handler to our handler */ - signal(SIGINT,handle_ctrlc); - - /* - * Save the current state of the terminal, and set raw mode. - */ - if (tcgetattr(0, &tty_rmode) , 0) { - fprintf(stderr, "Cannot get terminals current mode\n"); - exit(-1); - } - tty_smode = tty_rmode; - tty_eof = '\004'; /* Ctrl+D to exit */ -#ifdef DEBUG - show_terminal_settings(&tty_rmode); -#endif - tty_smode.c_iflag = - 1*BRKINT |/*Signal interrupt on break.*/ - 1*IGNPAR |/*Ignore characters with parity errors.*/ - 1*ISTRIP |/*Strip character.*/ - 0; - -#if 0 -0*IGNBRK |/*Ignore break condition.*/ -0*PARMRK |/*Mark parity errors.*/ -0*INPCK |/*Enable input parity check.*/ -0*INLCR |/*Map NL to CR on input.*/ -0*IGNCR |/*Ignore CR.*/ -0*ICRNL |/*Map CR to NL on input.*/ -0*IUCLC |/*Map upper-case to lower-case on input.*/ -0*IXON |/*Enable start/stop output control.*/ -0*IXANY |/*Enable any character to restart output.*/ -0*IXOFF |/*Enable start/stop input control.*/ -0*IMAXBEL|/*Echo BEL on input line too long.*/ -#endif - - tty_smode.c_oflag = - 1*OPOST |/*Post-process output.*/ - 1*ONLCR |/*Map NL to CR-NL on output.*/ -#ifdef XTABS - 1*XTABS |/*Expand tabs to spaces. (Linux)*/ -#endif -#ifdef OXTABS - 1*OXTABS |/*Expand tabs to spaces. (FreeBSD)*/ -#endif -#ifdef NL0 - 1*NL0 |/*Select newline delays*/ -#endif -#ifdef CR0 - 1*CR0 |/*Select carriage-return delays*/ -#endif -#ifdef TAB0 - 1*TAB0 |/*Select horizontal tab delays*/ -#endif -#ifdef BS0 - 1*BS0 |/*Select backspace delays*/ -#endif -#ifdef VT0 - 1*VT0 |/*Select vertical tab delays*/ -#endif -#ifdef FF0 - 1*FF0 |/*Select form feed delays*/ -#endif - 0; - -#if 0 -0*OLCUC |/*Map lower case to upper on output.*/ -0*OCRNL |/*Map CR to NL on output.*/ -0*ONOCR |/*No CR output at column 0.*/ -0*ONLRET |/*NL performs CR function.*/ -0*OFILL |/*Use fill characters for delay.*/ -0*OFDEL |/*Fill is DEL, else NULL.*/ -0*NL1 | -0*CR1 | -0*CR2 | -0*CR3 | -0*TAB1 | -0*TAB2 | -0*TAB3 |/*Expand tabs to spaces.*/ -0*BS1 | -0*VT1 | -0*FF1 | -#endif - - /* JALI: removed setting the tty_smode.c_cflag flags, since this is not */ - /* advisable if this is a *real* terminal, such as the console. In fact */ - /* this may hang the entire machine, deep, deep down (signalling break */ - /* or toggling the abort switch doesn't help) */ - - tty_smode.c_lflag = - 0; - -#if 0 -0*ISIG |/*Enable signals.*/ -0*ICANON |/*Canonical input (erase and kill processing).*/ -0*XCASE |/*Canonical upper/lower presentation.*/ -0*ECHO |/*Enable echo.*/ -0*ECHOE |/*Echo erase character as BS-SP-BS.*/ -0*ECHOK |/*Echo NL after kill character.*/ -0*ECHONL |/*Echo NL.*/ -0*NOFLSH |/*Disable flush after interrupt or quit.*/ -0*TOSTOP |/*Send SIGTTOU for background output.*/ -0*ECHOCTL|/*Echo control characters as ^char, delete as ^?.*/ -0*ECHOPRT|/*Echo erase character as character erased.*/ -0*ECHOKE |/*BS-SP-BS erase entire line on line kill.*/ -0*FLUSHO |/*Output is being flushed.*/ -0*PENDIN |/*Retype pending input at next read or input character.*/ -0*IEXTEN |/*Enable extended (implementation-defined) functions.*/ -#endif - - tty_smode.c_cc[VMIN] =0;/* Note that VMIN is the same as VEOF! */ - tty_smode.c_cc[VTIME] =0;/* Note that VTIME is the same as VEOL! */ - tty_smode.c_cc[VINTR] =3; - - tcsetattr(0, TCSADRAIN, &tty_smode); - -#ifdef DEBUG - show_terminal_settings(&tty_smode); -#endif - -#endif /* !__OSE__ */ - /* - * "Write a ^L to the FIFO which causes the other end to redisplay - * the input line." - * This does not seem to work as was intended in old comment above. - * However, this control character is now (R12B-3) used by run_erl - * to trigger the version handshaking between to_erl and run_erl - * at the start of every new to_erl-session. - */ - - if (write(wfd, "\014", 1) < 0) { - fprintf(stderr, "Error in writing ^L to FIFO.\n"); - } - -#ifdef __OSE__ - /* we have a tiny stack so we malloc the buffers */ - stdin_buf = malloc(sizeof(char) * BUFSIZ); - pipe_buf = malloc(sizeof(char) * BUFSIZ); - - efs_examine_fd(rfd,FLIB_FD_HANDLE,&pipe_fh); - efs_examine_fd(0,FLIB_FD_HANDLE,&stdin_fh); - READ_AIO(stdin_read_req,0,BUFSIZ,stdin_buf); - READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_buf); -#endif - - /* - * read and write - */ - while (1) { -#ifndef __OSE__ - FD_ZERO(&readfds); - FD_SET(0, &readfds); - FD_SET(rfd, &readfds); - if (select(rfd + 1, &readfds, NULL, NULL, NULL) < 0) { - if (recv_sig) { - FD_ZERO(&readfds); - } - else { - fprintf(stderr, "Error in select.\n"); - break; - } - } - len = 0; - - /* - * Read from terminal and write to FIFO - */ - if (recv_sig) { - switch (recv_sig) { - case SIGINT: - fprintf(stderr, "[Break]\n\r"); - buf[0] = '\003'; - len = 1; - break; - case SIGWINCH: - len = window_size_seq(buf,sizeof(buf)); - break; - default: - fprintf(stderr,"Unexpected signal: %u\n",recv_sig); - } - recv_sig = 0; - } - else -#else /* __OSE__ */ - SIGSELECT sigsel[] = {0}; - sig = receive(sigsel); - len = 0; -#endif -#ifndef __OSE__ - if (FD_ISSET(0,&readfds)) { - len = read(0, buf, sizeof(buf)); -#else /* __OSE__ */ - if (sig->signo == FM_READ_PTR_REPLY && - sig->fm_read_ptr.handle == stdin_fh) { - len = sig->fm_read_ptr.status == EFS_SUCCESS ? sig->fm_read_ptr.actual : -1; - buf = sig->fm_read_ptr.buffer; -#endif - if (len <= 0) { - close(rfd); - close(wfd); - if (len < 0) { - fprintf(stderr, "Error in reading from stdin.\n"); - } else { - fprintf(stderr, "[EOF]\n\r"); - } - break; - } - /* check if there is an eof character in input */ - for (i = 0; i < len-1 && buf[i] != tty_eof; i++); - if (buf[i] == tty_eof) { - fprintf(stderr, "[Quit]\n\r"); - break; - } - } - - if (len) { -#ifdef DEBUG - if(write(1, buf, len)); -#endif - if (write_all(wfd, buf, len) != len) { - fprintf(stderr, "Error in writing to FIFO.\n"); - close(rfd); - close(wfd); - break; - } - STATUS("\" OK\r\n"); -#ifdef __OSE__ - aio_dispatch(sig); - READ_AIO(stdin_read_req, 0, BUFSIZ, stdin_buf); -#endif - } - - /* - * Read from FIFO, write to terminal. - */ -#ifndef __OSE__ - if (FD_ISSET(rfd, &readfds)) { - STATUS("FIFO read: "); - len = read(rfd, buf, BUFSIZ); -#else /* __OSE__ */ - if (sig->signo == FM_READ_PTR_REPLY && - sig->fm_read_ptr.handle == pipe_fh) { - len = sig->fm_read_ptr.status == EFS_SUCCESS ? sig->fm_read_ptr.actual : -1; - buf = sig->fm_read_ptr.buffer; -#endif - if (len < 0 && errno == EAGAIN) { - /* - * No data this time, but the writing end of the FIFO is still open. - * Do nothing. - */ - ; - } else if (len <= 0) { - /* - * Either an error or end of file. In either case, break out - * of the loop. - */ - close(rfd); - close(wfd); - if (len < 0) { - fprintf(stderr, "Error in reading from FIFO.\n"); - } else - fprintf(stderr, "[End]\n\r"); - break; - } else { - if (!got_some) { - if ((len=version_handshake(buf,len,wfd)) < 0) { - close(rfd); - close(wfd); - break; - } -#ifndef __OSE__ - if (protocol_ver >= 1) { - /* Tell run_erl size of terminal window */ - signal(SIGWINCH, handle_sigwinch); - raise(SIGWINCH); - } -#endif - got_some = 1; - } - - /* - * We successfully read at least one character. Write what we got. - */ - STATUS("Terminal write: \""); - if (write_all(1, buf, len) != len) { - fprintf(stderr, "Error in writing to terminal.\n"); - close(rfd); - close(wfd); - break; - } - STATUS("\" OK\r\n"); -#ifdef __OSE__ - aio_dispatch(sig); - READ_AIO(pipe_read_req, rfd, BUFSIZ, pipe_buf); -#endif - } - } - } - -#ifndef __OSE__ - /* - * Reset terminal characterstics - * XXX - */ - tcsetattr(0, TCSADRAIN, &tty_rmode); -#endif - return 0; -} - -/* Call write() until entire buffer has been written or error. - * Return len or -1. - */ -static int write_all(int fd, const char* buf, int len) -{ - int left = len; - int written; - while (left) { - written = write(fd,buf,left); - if (written < 0) { - return -1; - } - left -= written; - buf += written; - } - return len; -} - -#ifndef __OSE__ -static int window_size_seq(char* buf, size_t bufsz) -{ -#ifdef TIOCGWINSZ - struct winsize ws; - static const char prefix[] = "\033_"; - static const char suffix[] = "\033\\"; - /* This Esc sequence is called "Application Program Command" - and seems suitable to use for our own customized stuff. */ - - if (ioctl(STDIN_FILENO, TIOCGWINSZ, &ws) == 0) { - int len = sn_printf(buf, bufsz, "%swinsize=%u,%u%s", - prefix, ws.ws_col, ws.ws_row, suffix); - return len; - } -#endif /* TIOCGWINSZ */ - return 0; -} -#endif /* !__OSE__ */ - -/* to_erl run_erl - * | | - * |---------- '\014' -------->| (session start) - * | | - * |<---- "[run_erl v1-0]" ----| (version interval) - * | | - * |--- Esc_"version=1"Esc\ -->| (common version) - * | | - */ -static int version_handshake(char* buf, int len, int wfd) -{ - unsigned re_high=0, re_low; - char *end = find_str(buf,len,"]\n"); - - if (end && sscanf(buf,"[run_erl v%u-%u",&re_high,&re_low)==2) { - char wbuf[30]; - int wlen; - - if (re_low > RUN_ERL_HI_VER || re_high < RUN_ERL_LO_VER) { - fprintf(stderr,"Incompatible versions: to_erl=v%u-%u run_erl=v%u-%u\n", - RUN_ERL_HI_VER, RUN_ERL_LO_VER, re_high, re_low); - return -1; - } - /* Choose highest common version */ - protocol_ver = re_high < RUN_ERL_HI_VER ? re_high : RUN_ERL_HI_VER; - - wlen = sn_printf(wbuf, sizeof(wbuf), "\033_version=%u\033\\", - protocol_ver); - if (write_all(wfd, wbuf, wlen) < 0) { - fprintf(stderr,"Failed to send version handshake\n"); - return -1; - } - end += 2; - len -= (end-buf); - memmove(buf,end,len); - - } - else { /* we assume old run_erl without version handshake */ - protocol_ver = 0; - } - - if (re_high != RUN_ERL_HI_VER) { - fprintf(stderr,"run_erl has different version, " - "using common protocol level %u\n", protocol_ver); - } - - return len; -} - - -#if defined(DEBUG) && !defined(__OSE__) -#define S(x) ((x) > 0 ? 1 : 0) - -static void show_terminal_settings(struct termios *t) -{ - fprintf(stderr,"c_iflag:\n"); - fprintf(stderr,"Signal interrupt on break: BRKINT %d\n", S(t->c_iflag & BRKINT)); - fprintf(stderr,"Map CR to NL on input: ICRNL %d\n", S(t->c_iflag & ICRNL)); - fprintf(stderr,"Ignore break condition: IGNBRK %d\n", S(t->c_iflag & IGNBRK)); - fprintf(stderr,"Ignore CR: IGNCR %d\n", S(t->c_iflag & IGNCR)); - fprintf(stderr,"Ignore char with par. err's: IGNPAR %d\n", S(t->c_iflag & IGNPAR)); - fprintf(stderr,"Map NL to CR on input: INLCR %d\n", S(t->c_iflag & INLCR)); - fprintf(stderr,"Enable input parity check: INPCK %d\n", S(t->c_iflag & INPCK)); - fprintf(stderr,"Strip character ISTRIP %d\n", S(t->c_iflag & ISTRIP)); - fprintf(stderr,"Enable start/stop input ctrl IXOFF %d\n", S(t->c_iflag & IXOFF)); - fprintf(stderr,"ditto output ctrl IXON %d\n", S(t->c_iflag & IXON)); - fprintf(stderr,"Mark parity errors PARMRK %d\n", S(t->c_iflag & PARMRK)); - fprintf(stderr,"\n"); - fprintf(stderr,"c_oflag:\n"); - fprintf(stderr,"Perform output processing OPOST %d\n", S(t->c_oflag & OPOST)); - fprintf(stderr,"\n"); - fprintf(stderr,"c_cflag:\n"); - fprintf(stderr,"Ignore modem status lines CLOCAL %d\n", S(t->c_cflag & CLOCAL)); - fprintf(stderr,"\n"); - fprintf(stderr,"c_local:\n"); - fprintf(stderr,"Enable echo ECHO %d\n", S(t->c_lflag & ECHO)); - fprintf(stderr,"\n"); - fprintf(stderr,"c_cc:\n"); - fprintf(stderr,"c_cc[VEOF] %d\n", t->c_cc[VEOF]); -} -#endif /* DEBUG && !__OSE__ */ diff --git a/erts/etc/common/to_erl_common.h b/erts/etc/common/to_erl_common.h deleted file mode 100644 index a139da418f..0000000000 --- a/erts/etc/common/to_erl_common.h +++ /dev/null @@ -1,29 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifndef ERL_TO_ERL_H -#define ERL_TO_ERL_H - -#define TO_ERL_USAGE "to_erl [-h|-F] %s\n" \ - "\t-h\tThis help text.\n" \ - "\t-f\tForce connection even though pipe is locked by other to_erl process." - -int to_erl(int argc, char **argv); - -#endif diff --git a/erts/etc/common/typer.c b/erts/etc/common/typer.c index 0aa0996808..77a95ccded 100644 --- a/erts/etc/common/typer.c +++ b/erts/etc/common/typer.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2011. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -63,13 +63,14 @@ static int eargc; /* Number of arguments in eargv. */ */ static void error(char* format, ...); -static char* emalloc(size_t size); +static void* emalloc(size_t size); static char* strsave(char* string); static void push_words(char* src); static int run_erlang(char* name, char** argv); static char* get_default_emulator(char* progname); #ifdef __WIN32__ static char* possibly_quote(char* arg); +static void* erealloc(void *p, size_t size); #endif /* @@ -118,10 +119,10 @@ main(int argc, char** argv) int i; int len; /* Convert argv to utf8 */ - argv = malloc((argc+1) * sizeof(char*)); + argv = emalloc((argc+1) * sizeof(char*)); for (i=0; i<argc; i++) { len = WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, NULL, 0, NULL, NULL); - argv[i] = malloc(len*sizeof(char)); + argv[i] = emalloc(len*sizeof(char)); WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, argv[i], len, NULL, NULL); } argv[argc] = NULL; @@ -232,7 +233,7 @@ wchar_t *make_commandline(char **argv) buff = (wchar_t *) emalloc(siz*sizeof(wchar_t)); } else if (siz < num) { siz = num; - buff = (wchar_t *) realloc(buff,siz*sizeof(wchar_t)); + buff = (wchar_t *) erealloc(buff,siz*sizeof(wchar_t)); } p = buff; num=0; @@ -332,15 +333,26 @@ error(char* format, ...) exit(1); } -static char* +static void* emalloc(size_t size) { - char *p = malloc(size); + void *p = malloc(size); if (p == NULL) error("Insufficient memory"); return p; } +#ifdef __WIN32__ +static void * +erealloc(void *p, size_t size) +{ + void *res = realloc(p, size); + if (res == NULL) + error("Insufficient memory"); + return res; +} +#endif + static char* strsave(char* string) { diff --git a/erts/etc/ose/etc.lmconf b/erts/etc/ose/etc.lmconf deleted file mode 100644 index b402b325b1..0000000000 --- a/erts/etc/ose/etc.lmconf +++ /dev/null @@ -1,20 +0,0 @@ -OSE_LM_STACK_SIZES=256,512,1024,2048,4096,8192,16384,65536 -OSE_LM_SIGNAL_SIZES=31,63,127,255,1023,4095,16383,65535 -OSE_LM_POOL_SIZE=0x200000 -OSE_LM_MAIN_NAME=main -OSE_LM_MAIN_STACK_SIZE=0xF000 -OSE_LM_MAIN_PRIORITY=20 -## Has to be of a type that allows MAM -OSE_LM_PROGRAM_TYPE=APP_RAM -OSE_LM_DATA_INIT=YES -OSE_LM_BSS_INIT=YES -OSE_LM_EXEC_MODEL=SHARED -HEAP_MAX_SIZE=1000000000 -HEAP_SMALL_BUF_INIT_SIZE=64000000 -HEAP_LARGE_BUF_THRESHOLD=16000000 -HEAP_LOCK_TYPE=2 - -# Setting the environment variable EFS_RESOLVE_TMO on the block to 0. -# This will eliminiate delays when trying to open files on not mounted -# volumes. -EFS_RESOLVE_TMO=0 diff --git a/erts/etc/ose/run_erl.c b/erts/etc/ose/run_erl.c deleted file mode 100644 index 6775525297..0000000000 --- a/erts/etc/ose/run_erl.c +++ /dev/null @@ -1,664 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Module: run_erl.c - * - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -/* System includes */ -#include <aio.h> -#include <errno.h> -#include <dirent.h> -#include <stdlib.h> -#include <string.h> -#include <stdio.h> -#include <sys/stat.h> -#include <unistd.h> - -/* OSE includes */ -#include "ose.h" -#include "ose_spi/ose_spi.h" -#include "efs.h" -#include "pm.h" -#include "ose_spi/fm.sig" - -/* erts includes */ -#include "run_erl.h" -#include "run_erl_common.h" -#include "safe_string.h" /* sn_printf, strn_cpy, strn_cat, etc */ - -typedef struct RunErlSetup_ { - SIGSELECT signo; - int run_daemon; - char *logdir; - char *command; - char *pipename; - char *blockname; -} RunErlSetup; - -typedef struct ProgramState_ { - /* child process */ - int ifd, ofd; - OSDOMAIN domain; - PROCESS progpid, mainbid; - struct PmProgramInfo *info; - /* to_erl */ - char w_pipe[FILENAME_BUFSIZ], - r_pipe[FILENAME_BUFSIZ]; -} ProgramState; - -union SIGNAL { - SIGSELECT signo; - RunErlSetup setup; - struct FmReadPtr fm_read_ptr; - struct FmWritePtr fm_write_ptr; -}; - -static OSBOOLEAN hunt_in_block(char *block_name, - char *process_name, - PROCESS *pid); -static int create_child_process(char *command_string, char *blockname, - ProgramState *state); - - -static OSBOOLEAN hunt_in_block(char *block_name, - char *process_name, - PROCESS *pid) { - struct OS_pid_list *list; - PROCESS block_id = OSE_ILLEGAL_PROCESS; - int i; - char *name; - - *pid = OSE_ILLEGAL_PROCESS; - - list = get_bid_list(0); - - if (!list) - return 0; - - for (i = 0; i < list->count; i++) { - - if (list->list[i] == get_bid(current_process())) - continue; - - name = (char*)get_pid_info(list->list[i], OSE_PI_NAME); - if (name) { - if (strcmp(name,block_name) == 0) { - block_id = list->list[i]; - free_buf((union SIGNAL**)&name); - break; - } - free_buf((union SIGNAL**)&name); - } - } - - free_buf((union SIGNAL**)&list); - - if (block_id == OSE_ILLEGAL_PROCESS) - return 0; - - list = get_pid_list(block_id); - - if (!list) - return 0; - - for (i = 0; i < list->count; i++) { - name = (char*)get_pid_info(list->list[i], OSE_PI_NAME); - if (name) { - if (strcmp(name,process_name) == 0) { - *pid = list->list[i]; - free_buf((union SIGNAL**)&name); - break; - } - free_buf((union SIGNAL**)&name); - } - } - - free_buf((union SIGNAL**)&list); - - if (*pid == OSE_ILLEGAL_PROCESS) - return 0; - - return 1; - -} - - -static int create_child_process(char *command_string, char *blockname, - ProgramState *state) { - char *command = command_string; - char *argv; - int i = 0; - int ret_status; - PmStatus pm_status; - int tmp_io[2]; - int fd_arr[3]; - int ifd[2], ofd[2]; - char *handle; - struct PmLoadModuleInfoReply *mod_info; - - /* Parse out cmd and argv from the command string */ - while (1) { - if (command[i] == ' ' || command[i] == '\0') { - if (command[i] == '\0') - argv = NULL; - else { - command[i] = '\0'; - argv = command_string + i + 1; - } - break; - } - i++; - } - - if (blockname) - handle = blockname; - else - handle = simple_basename(command); - - if (ose_pm_load_module_info(handle,&mod_info) == PM_SUCCESS) { - /* Already installed */ - free_buf((union SIGNAL**)&mod_info); - } else if ((pm_status = ose_pm_install_load_module(0,"ELF",command,handle,0,0,NULL)) - != PM_SUCCESS) { - ERROR1(LOG_ERR,"ose_pm_install_load_module failed - pmstatus: 0x%08x\n", - pm_status); - return 0; - } - - state->domain = PM_NEW_DOMAIN; - - pm_status = ose_pm_create_program(&state->domain, handle, 0, 0 , NULL, - &state->progpid, &state->mainbid); - - if (pm_status != PM_SUCCESS) { - if (pm_status == PM_EINSTALL_HANDLE_IN_USE) - ERROR1(LOG_ERR,"ose_pm_create_program failed - " - "install handle \"%s\" is in use. You can specify another " - "install handle by using the -block option to run_erl.\n",handle); - else - ERROR1(LOG_ERR,"ose_pm_create_program failed - pmstatus: 0x%08x\n", - pm_status); - return 0; - } - - pm_status = ose_pm_program_info(state->progpid, &state->info); - /* FIXME don't forget to free this ((union SIGNAL **)&info) */ - if (pm_status != PM_SUCCESS) { - ERROR1(LOG_ERR,"ose_pm_program_info failed - pmstatus: 0x%08x\n", - pm_status); - return 0; - } - - /* We only clone stdin+stdout, what about stderr? */ - - /* create pipes */ - if (pipe(ifd) < 0) { - if (errno == ENOENT) - ERRNO_ERR0(LOG_ERR,"The /pipe file system is not available\n"); - else - ERRNO_ERR0(LOG_ERR,"pipe ifd failed\n"); - return 0; - } - - if (pipe(ofd) < 0) { - ERRNO_ERR0(LOG_ERR,"pipe ofd failed\n"); - return 0; - } - - /* FIXME Lock? */ - - /* backup our stdin stdout */ - if ((tmp_io[0] = dup(0)) < 0) { - ERRNO_ERR0(LOG_ERR,"dup 0 failed\n"); - return 0; - } - - if ((tmp_io[1] = dup(1)) < 0) { - ERRNO_ERR0(LOG_ERR,"dup 1 failed\n"); - return 0; - } - - /* set new pipe to fd 0,1 */ - if (dup2(ifd[1], 1) < 0) { - ERRNO_ERR0(LOG_ERR,"dup2 1 failed\n"); - return 0; - } - - if (dup2(ofd[0], 0) < 0) { - ERRNO_ERR0(LOG_ERR,"dup2 0 failed\n"); - return 0; - } - - /* clone array to newly created */ - fd_arr[0] = 2; /* Number of fd's */ - fd_arr[1] = 0; - fd_arr[2] = 1; - - if ((ret_status = efs_clone_array(state->info->main_process, fd_arr)) - != EFS_SUCCESS) { - ERROR1(LOG_ERR,"efs_close_array filed, errcode: %d\n", ret_status); - return 0; - } - - if (dup2(tmp_io[1], 1) < 0) { - ERRNO_ERR0(LOG_ERR,"restoring dup2 1 failed\n"); - return 0; - } - - if (dup2(tmp_io[0], 0) < 0) { - ERRNO_ERR0(LOG_ERR,"restoring dup2 1 failed\n"); - return 0; - } - - /* close loose-ends */ - sf_close(tmp_io[0]); - sf_close(tmp_io[1]); - sf_close(ifd[1]); - sf_close(ofd[0]); - state->ifd = ifd[0]; - state->ofd = ofd[1]; - - if (argv && set_env(state->progpid, "ARGV", argv)) { - ERRNO_ERR0(LOG_ERR,"something went wrong with set_env\n"); - } - - /* - * Start the program. - */ - pm_status = ose_pm_start_program(state->progpid); - if (pm_status != PM_SUCCESS) { - ERROR1(LOG_ERR,"ose_pm_install_load_module failed - pmstatus: 0x%08x\n", - pm_status); - return 0; - } - - return 1; -} - -#define SET_AIO(REQ,FD,SIZE,BUFF) \ - /* Make sure to clean data structure of previous request */ \ - memset(&(REQ),0,sizeof(REQ)); \ - (REQ).aio_fildes = FD; \ - (REQ).aio_offset = FM_POSITION_CURRENT; \ - (REQ).aio_nbytes = SIZE; \ - (REQ).aio_buf = BUFF; \ - (REQ).aio_sigevent.sigev_notify = SIGEV_NONE - -#define READ_AIO(REQ,FD,SIZE,BUFF) do { \ - SET_AIO(REQ,FD,SIZE,BUFF); \ - if (aio_read(&(REQ)) != 0) \ - ERRNO_ERR1(LOG_ERR,"aio_read of child_read_req(%d) failed\n",FD); \ - } while (0) - -#define WRITE_AIO(FD,SIZE,BUFF) do { \ - struct aiocb *write_req = malloc(sizeof(struct aiocb)); \ - char *write_buff = malloc(sizeof(char)*SIZE); \ - memcpy(write_buff,BUFF,SIZE); \ - SET_AIO(*write_req,FD,SIZE,write_buff); \ - if (aio_write(write_req) != 0) \ - ERRNO_ERR1(LOG_ERR,"aio_write of write_req(%d) failed\n",FD); \ - } while(0) - -int pass_on(ProgramState *state); -int pass_on(ProgramState *s) { - SIGSELECT sigsel[] = {0,FM_READ_PTR_REPLY}; - union SIGNAL *sig; - char child_read_buff[BUFSIZ], pipe_read_buff[BUFSIZ]; - struct aiocb child_read_req, pipe_read_req; - int rfd, wfd = 0; - FmHandle rfh, child_rfh; - int outstanding_writes = 0, got_some = 0, child_done = 0; - - if ((rfd = sf_open(s->r_pipe, O_RDONLY, 0)) < 0) { - ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.\n", s->r_pipe); - rfd = 0; - return 1; - } - - attach(NULL,s->progpid); - - /* Open the log file */ - erts_run_erl_log_open(); - - efs_examine_fd(rfd,FLIB_FD_HANDLE,&rfh); - efs_examine_fd(s->ifd,FLIB_FD_HANDLE,&child_rfh); - - READ_AIO(child_read_req,s->ifd,BUFSIZ,child_read_buff); - READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_read_buff); - - while (1) { - time_t now,last_activity; - - time(&last_activity); - sig = receive_w_tmo(erts_run_erl_log_alive_minutes()*60000,sigsel); - - time(&now); - - if (sig) { - erts_run_erl_log_activity(0,now,last_activity); - } else { - /* timeout */ - erts_run_erl_log_activity(1,now,last_activity); - continue; - } - - switch (sig->signo) { - case OS_ATTACH_SIG: { - if (rfd) { sf_close(rfd); rfd = 0; } - free_buf(&sig); - child_done = 1; - /* Make sure to to let all outstanding write request finish */ - if (outstanding_writes) - break; - if (wfd) sf_close(wfd); - return 0; - } - case FM_WRITE_PTR_REPLY: { - if (sig->fm_write_ptr.status == EFS_SUCCESS) { - if (sig->fm_write_ptr.actual < sig->fm_write_ptr.requested) { - WRITE_AIO(wfd, sig->fm_write_ptr.requested-sig->fm_write_ptr.actual, - sig->fm_write_ptr.buffer+sig->fm_write_ptr.actual); - } - } else { - /* Assume to_erl has terminated. */ - sf_close(wfd); - wfd = 0; - } - free((char*)sig->fm_write_ptr.buffer); - aio_dispatch(sig); - if ((--outstanding_writes == 0) && child_done) { - if (wfd) sf_close(wfd); - return 0; - } - break; - } - case FM_READ_PTR_REPLY: { - /* Child fd */ - if (sig->fm_read_ptr.handle == child_rfh) { - - /* Child terminated */ - if (sig->fm_read_ptr.status != EFS_SUCCESS || - sig->fm_read_ptr.actual == 0) { - - if (rfd) { sf_close(rfd); rfd = 0; } - - if (sig->fm_read_ptr.status != EFS_SUCCESS) { - ERROR0(LOG_ERR,"Erlang closed the connection."); - aio_dispatch(sig); - return 1; - } - - /* child closed connection gracefully */ - aio_dispatch(sig); - if (outstanding_writes) { - child_done = 1; - break; - } - - if (wfd) sf_close(wfd); - - return 0; - } else { - erts_run_erl_log_write(sig->fm_read_ptr.buffer, - sig->fm_read_ptr.actual); - if (wfd) { - WRITE_AIO(wfd, sig->fm_read_ptr.actual, sig->fm_read_ptr.buffer); - outstanding_writes++; - } - aio_dispatch(sig); - READ_AIO(child_read_req, s->ifd,BUFSIZ, child_read_buff); - } - /* pipe fd */ - } else if (sig->fm_read_ptr.handle == rfh) { - if (sig->fm_read_ptr.status != EFS_SUCCESS) { - if(rfd) sf_close(rfd); - if(wfd) sf_close(wfd); - aio_dispatch(sig); - ERRNO_ERR0(LOG_ERR,"Error in reading from FIFO."); - return 1; - } - if (sig->fm_read_ptr.actual == 0) { - /* to_erl closed its end of the pipe */ - aio_dispatch(sig); - sf_close(rfd); - rfd = sf_open(s->r_pipe,O_RDONLY|DONT_BLOCK_PLEASE, 0); - if (rfd < 0) { - ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.", - s->r_pipe); - rfd = 0; - } else { - READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_read_buff); - } - got_some = 0; /* reset for next session */ - } else { - int len = sig->fm_read_ptr.actual; - char *buffer = sig->fm_read_ptr.buffer; - if (!wfd) { - /* Try to open the write pipe to to_erl. Now that we got some data - * from to_erl, to_erl should already be reading this pipe - open - * should succeed. But in case of error, we just ignore it. - */ - if ((wfd = sf_open(s->w_pipe, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) { - erts_run_erl_log_status("Client expected on FIFO %s, " - "but can't open (len=%d)\n", - s->w_pipe, sig->fm_read_ptr.actual); - sf_close(rfd); - rfd = sf_open(s->r_pipe, O_RDONLY|DONT_BLOCK_PLEASE, 0); - if (rfd < 0) { - ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.", - s->r_pipe); - return 1; - } - wfd = 0; - } else { -#ifdef DEBUG - erts_run_erl_log_status("run_erl: %s opened for writing\n", - s->w_pipe); -#endif - } - } - - if (!got_some && wfd && buffer[0] == '\014') { - char wbuf[30]; - int wlen = sn_printf(wbuf,sizeof(wbuf),"[run_erl v%u-%u]\n", - RUN_ERL_HI_VER, RUN_ERL_LO_VER); - /* For some reason this, the first write aio seems to - not get an FM_WRITE_PTR_REPLY, so we do not do: - outstanding_writes++; - */ - WRITE_AIO(wfd, wlen, wbuf); - } - got_some = 1; - - /* Write the message */ -#ifdef DEBUG - erts_run_erl_log_status("Pty master write; "); -#endif - len = erts_run_erl_extract_ctrl_seq(buffer,len, s->ofd); - - if (len > 0) { - int wlen = erts_run_erl_write_all(s->ofd, buffer, len); - if (wlen != len) { - aio_dispatch(sig); - ERRNO_ERR0(LOG_ERR,"Error in writing to terminal."); - if(rfd) sf_close(rfd); - if(wfd) sf_close(wfd); - return 1; - } - } -#ifdef DEBUG - erts_run_erl_log_status("OK\n"); -#endif - aio_dispatch(sig); - READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_read_buff); - } - } - break; - } - default: { - free_buf(&sig); - break; - } - } - } -} - -OS_PROCESS(run_erl_process) { - char *logdir, *command, *blockname; - SIGSELECT sigsel[] = {1,ERTS_SIGNAL_RUN_ERL_SETUP}; - union SIGNAL *sig = receive(sigsel); - ProgramState state; - char pipename[FILENAME_BUFSIZ]; - - state.info = NULL; - - logdir = strdup(sig->setup.logdir); - command = strdup(sig->setup.command); - strn_cpy(pipename,sizeof(pipename),sig->setup.pipename); - - if (sig->setup.blockname) - blockname = strdup(sig->setup.blockname); - else - blockname = NULL; - - erts_run_erl_log_init(sig->setup.run_daemon, logdir); - - free_buf(&sig); - - if (erts_run_erl_open_fifo(pipename,state.w_pipe,state.r_pipe)) - kill_proc(current_process()); - - if (create_child_process(command,blockname,&state)) - pass_on(&state); - - free(logdir); - free(command); - if (blockname) - free(blockname); - - if (state.info) - free_buf(((union SIGNAL**)&state.info)); - - sf_close(state.ifd); - sf_close(state.ofd); - - unlink(state.w_pipe); - unlink(state.r_pipe); - - kill_proc(current_process()); -} - -int run_erl(int argc,char **argv) { - char *pipename, *logdir, *command, *blockname = NULL; - int pipename_len, logdir_len, command_len, blockname_len = 0; - int i = 1, run_daemon = 0; - PROCESS pid; - SIGSELECT sigsel[] = {0}; - union SIGNAL *sig; - - if(argc < 4) { - fprintf(stderr,RUN_ERL_USAGE,"run_erl"); - return 1; - } - - while (1) { - if (argv[i][0] != '-') - break; - if (!strcmp(argv[i],"-daemon")) { - run_daemon = 1; - i++; - continue; - } - if (!strcmp(argv[i],"-block")) { - blockname = argv[i+1]; - blockname_len = strlen(argv[i+1]) + 1; - i+=2; - continue; - } - fprintf(stderr,RUN_ERL_USAGE,"run_erl"); - return 1; - } - - pipename = argv[i++]; - logdir = argv[i++]; - command = argv[i++]; - - /* + 1 to include NULL at end */ - logdir_len = strlen(logdir) + 1; - command_len = strlen(command) + 1; - pipename_len = strlen(pipename) + 1; - - if (run_daemon) { - /* We request that the run_erl_process should be started from the - main process so that it does not die when the shell command - returns */ - PROCESS main_pid; - hunt_in_block("run_erl","main",&main_pid); - sig = alloc(sizeof(*sig),ERTS_SIGNAL_RUN_ERL_DAEMON); - send(&sig,main_pid); - sig = receive(sigsel); - pid = sender(&sig); - free_buf(&sig); - } else { - pid = create_process(OS_BG_PROC,"run_erl_process", - run_erl_process, 0x800, - 0, 0, 0, NULL, 0, 0); - } - - sig = alloc(sizeof(RunErlSetup)+ - logdir_len+command_len+pipename_len+blockname_len, - ERTS_SIGNAL_RUN_ERL_SETUP); - sig->setup.run_daemon = run_daemon; - sig->setup.logdir = ((char*)sig)+sizeof(RunErlSetup); - sig->setup.command = ((char*)sig)+sizeof(RunErlSetup)+logdir_len; - sig->setup.pipename = ((char*)sig)+sizeof(RunErlSetup)+logdir_len+command_len; - if (blockname) - sig->setup.blockname = ((char*)sig)+sizeof(RunErlSetup)+ - logdir_len+command_len+pipename_len; - else - sig->setup.blockname = NULL; - - strcpy(sig->setup.logdir,logdir); - strcpy(sig->setup.command,command); - strcpy(sig->setup.pipename,pipename); - if (blockname) strcpy(sig->setup.blockname,blockname); - - send(&sig,pid); - - if (run_daemon) { - /* We are a daemon, error msgs will be sent to ramlog */ - start(pid); - return 1; - } - - /* We are not daemon, error msgs will be sent to stderr and we block here */ - efs_clone(pid); - start(pid); - - attach(NULL,pid); - sig = receive(sigsel); - - return 1; -} diff --git a/erts/etc/ose/run_erl_main.c b/erts/etc/ose/run_erl_main.c deleted file mode 100644 index 8895c773a1..0000000000 --- a/erts/etc/ose/run_erl_main.c +++ /dev/null @@ -1,80 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2013. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Module: run_erl_main.c - * - * Container for load module that installs both run_erl and to_erl command. - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#include <stdio.h> - -#include "ose.h" -#include "shell.h" - -#include "run_erl_common.h" -#include "run_erl.h" -#include "to_erl_common.h" - -union SIGNAL { - SIGSELECT signo; -}; - -int main(int argc, char **argv) -{ - - char run_erl_usage[320], - to_erl_usage[120]; - - (void)stdin;(void)stdout;(void)stderr; - - sprintf(run_erl_usage,RUN_ERL_USAGE,"run_erl [-daemon] [-block blockname]"); - sprintf(to_erl_usage,TO_ERL_USAGE,"pipename"); - - shell_add_cmd_attrs( - "run_erl",run_erl_usage, - "Redirect Erlang input and output streams", - run_erl,DEFAULT_PROC_TYPE,DEFAULT_PRIORITY,DEFAULT_STACK_SIZE); - - shell_add_cmd_attrs( - "to_erl",to_erl_usage, - "Attach to redirected Erlang input and output streams", - to_erl,DEFAULT_PROC_TYPE,DEFAULT_PRIORITY,DEFAULT_STACK_SIZE); - - while (1) { - static const SIGSELECT sigsel[] = {0}; - union SIGNAL *sig = receive(sigsel); - - if (sig->signo == ERTS_SIGNAL_RUN_ERL_DAEMON) { - PROCESS pid = create_process(OS_BG_PROC,"run_erl_daemon", - run_erl_process, 0x800, - 0, 0, 0, NULL, 0, 0); - send_w_s(&sig,pid,sender(&sig)); - } else { - printf("Got unexpected signal!"); - free_buf(&sig); - } - } - - return 1; -} diff --git a/erts/etc/unix/Install.src b/erts/etc/unix/Install.src index 6634ae31d3..e71308edbe 100644 --- a/erts/etc/unix/Install.src +++ b/erts/etc/unix/Install.src @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2013. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/unix/Makefile b/erts/etc/unix/Makefile index 04ae11de3b..2fa9cd047b 100644 --- a/erts/etc/unix/Makefile +++ b/erts/etc/unix/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2013. All Rights Reserved. +# Copyright Ericsson AB 2013-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/unix/README b/erts/etc/unix/README index 6bda610a03..adc6db4300 100644 --- a/erts/etc/unix/README +++ b/erts/etc/unix/README @@ -1,7 +1,7 @@ %CopyrightBegin% - Copyright Ericsson AB 1996-2009. All Rights Reserved. + Copyright Ericsson AB 1996-2016. All Rights Reserved. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. diff --git a/erts/etc/unix/RELNOTES b/erts/etc/unix/RELNOTES index 629867d2ae..7b4a1746fe 100644 --- a/erts/etc/unix/RELNOTES +++ b/erts/etc/unix/RELNOTES @@ -1,7 +1,7 @@ %CopyrightBegin% - Copyright Ericsson AB 1996-2009. All Rights Reserved. + Copyright Ericsson AB 1996-2016. All Rights Reserved. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src index 2a806bb2f1..c5422ab2ed 100644 --- a/erts/etc/unix/cerl.src +++ b/erts/etc/unix/cerl.src @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2013. All Rights Reserved. +# Copyright Ericsson AB 2003-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/unix/dyn_erl.c b/erts/etc/unix/dyn_erl.c index 4eebfae50a..d6d2201648 100644 --- a/erts/etc/unix/dyn_erl.c +++ b/erts/etc/unix/dyn_erl.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/unix/erl.src.src b/erts/etc/unix/erl.src.src index 94c6f9f854..959c099e8f 100644 --- a/erts/etc/unix/erl.src.src +++ b/erts/etc/unix/erl.src.src @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2012. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index 19d67de92f..4dc24d68b4 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2014. All Rights Reserved. +# Copyright Ericsson AB 2005-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -774,9 +774,9 @@ define etp-pid-1 # set $etp_pid_1 = (Eterm)($arg0) if ($etp_pid_1 & 0xF) == 0x3 - if (etp_arch_bits == 64 && etp_halfword == 0) + if (etp_arch_bits == 64) if (etp_big_endian) - set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 36) & 0x0fffffff) + set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 35) & 0x0fffffff) else set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 4) & 0x0fffffff) end @@ -834,7 +834,7 @@ define etp-port-1 # set $etp_port_1 = (Eterm)($arg0) if ($etp_port_1 & 0xF) == 0x7 - if (etp_arch_bits == 64 && etp_halfword == 0) + if (etp_arch_bits == 64) if (etp_big_endian) set $etp_port_data = (unsigned) ((((Uint64) $etp_port_1) >> 36) & 0x0fffffff) else @@ -1577,7 +1577,7 @@ define etp-term-dump-pid # set $etp_pid_1 = (Eterm)($arg0) if ($etp_pid_1 & 0xF) == 0x3 - if (etp_arch_bits == 64 && etp_halfword == 0) + if (etp_arch_bits == 64) if (etp_big_endian) set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 36) & 0x0fffffff) else @@ -1622,7 +1622,7 @@ end define etp-pid2pix-1 # Args: Eterm # - if (etp_arch_bits == 64 && etp_halfword == 0) + if (etp_arch_bits == 64) if (etp_big_endian) set $etp_pix = (int) (((Uint64) $arg0) & 0x0fffffff) else @@ -1965,7 +1965,7 @@ end define etp-port-id2pix-1 # Args: Eterm # - if (etp_arch_bits == 64 && etp_halfword == 0) + if (etp_arch_bits == 64) if (etp_big_endian) set $etp_pix = (int) (((Uint64) $arg0) & 0x0fffffff) elser @@ -2493,12 +2493,6 @@ define etp-system-info printf "Little\n" end printf "Word size: %d-bit\n", etp_arch_bits - printf "Halfword: " - if (etp_halfword) - printf "yes\n" - else - printf "no\n" - end printf "HiPE support: " if (etp_hipe) printf "yes\n" diff --git a/erts/etc/unix/etp-thr.py b/erts/etc/unix/etp-thr.py index 16bc7f4016..fb82dcaf1f 100644 --- a/erts/etc/unix/etp-thr.py +++ b/erts/etc/unix/etp-thr.py @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2013. All Rights Reserved. +# Copyright Ericsson AB 2013-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/unix/etp_commands.erl b/erts/etc/unix/etp_commands.erl index fe16a71876..fe8f2dd556 100644 --- a/erts/etc/unix/etp_commands.erl +++ b/erts/etc/unix/etp_commands.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/etc/unix/etp_commands.mk b/erts/etc/unix/etp_commands.mk index def6f7bda0..983ee9f919 100644 --- a/erts/etc/unix/etp_commands.mk +++ b/erts/etc/unix/etp_commands.mk @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2009. All Rights Reserved. +# Copyright Ericsson AB 2005-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/unix/format_man_pages b/erts/etc/unix/format_man_pages index 7abe65cecb..54f2d90c28 100644 --- a/erts/etc/unix/format_man_pages +++ b/erts/etc/unix/format_man_pages @@ -3,7 +3,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2010. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c index c8414030ca..30210ac172 100644 --- a/erts/etc/unix/run_erl.c +++ b/erts/etc/unix/run_erl.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2015. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -41,13 +41,16 @@ #ifdef HAVE_CONFIG_H # include "config.h" #endif - #ifdef HAVE_WORKING_POSIX_OPENPT -#ifndef _XOPEN_SOURCE -#define _XOPEN_SOURCE 600 -#endif +# ifndef _XOPEN_SOURCE + /* On OS X and BSD, we must leave _XOPEN_SOURCE undefined in order for + * the prototype of vsyslog() to be included. + */ +# if !(defined(__APPLE__) || defined(__FreeBSD__) || defined(__DragonFly__)) +# define _XOPEN_SOURCE 600 +# endif +# endif #endif - #include <sys/types.h> #include <sys/wait.h> #include <sys/stat.h> @@ -65,6 +68,7 @@ #include <dirent.h> #include <termios.h> #include <time.h> + #ifdef HAVE_SYSLOG_H # include <syslog.h> #endif @@ -74,6 +78,9 @@ #ifdef HAVE_UTMP_H # include <utmp.h> #endif +#ifdef HAVE_LIBUTIL_H +# include <libutil.h> +#endif #ifdef HAVE_UTIL_H # include <util.h> #endif @@ -84,25 +91,81 @@ # include <stropts.h> #endif -#include "run_erl_common.h" +#include "run_erl.h" #include "safe_string.h" /* sn_printf, strn_cpy, strn_cat, etc */ +#ifdef O_NONBLOCK +# define DONT_BLOCK_PLEASE O_NONBLOCK +#else +# define DONT_BLOCK_PLEASE O_NDELAY +# ifndef EAGAIN +# define EAGAIN -3898734 +# endif +#endif + +#define noDEBUG + +#define DEFAULT_LOG_GENERATIONS 5 +#define LOG_MAX_GENERATIONS 1000 /* No more than 1000 log files */ +#define LOG_MIN_GENERATIONS 2 /* At least two to switch between */ +#define DEFAULT_LOG_MAXSIZE 100000 +#define LOG_MIN_MAXSIZE 1000 /* Smallast value for changing log file */ +#define LOG_STUBNAME "erlang.log." +#define LOG_PERM 0664 +#define DEFAULT_LOG_ACTIVITY_MINUTES 5 +#define DEFAULT_LOG_ALIVE_MINUTES 15 +#define DEFAULT_LOG_ALIVE_FORMAT "%a %b %e %T %Z %Y" +#define ALIVE_BUFFSIZ 256 + +#define PERM 0600 +#define STATUSFILENAME "/run_erl.log" +#define PIPE_STUBNAME "erlang.pipe" +#define PIPE_STUBLEN strlen(PIPE_STUBNAME) + +#ifndef FILENAME_MAX +#define FILENAME_MAX 250 +#endif + +#ifndef O_SYNC +#define O_SYNC 0 +#define USE_FSYNC 1 +#endif + #define MAX(x,y) ((x) > (y) ? (x) : (y)) +#define FILENAME_BUFSIZ FILENAME_MAX + /* prototypes */ static void usage(char *); +static int create_fifo(char *name, int perm); static int open_pty_master(char **name, int *sfd); static int open_pty_slave(char *name); static void pass_on(pid_t); static void exec_shell(char **); +static void status(const char *format,...); +static void error_logf(int priority, int line, const char *format,...); static void catch_sigchild(int); +static int next_log(int log_num); +static int prev_log(int log_num); +static int find_next_log_num(void); +static int open_log(int log_num, int flags); +static void write_to_log(int* lfd, int* log_num, char* buf, int len); static void daemon_init(void); +static char *simple_basename(char *path); static void init_outbuf(void); static int outbuf_size(void); static void clear_outbuf(void); static char* outbuf_first(void); static void outbuf_delete(int bytes); static void outbuf_append(const char* bytes, int n); +static int write_all(int fd, const char* buf, int len); +static int extract_ctrl_seq(char* buf, int len); +static void set_window_size(unsigned col, unsigned row); + +static ssize_t sf_write(int fd, const void *buffer, size_t len); +static ssize_t sf_read(int fd, void *buffer, size_t len); +static int sf_open(const char *path, int flags, mode_t mode); +static int sf_close(int fd); #ifdef DEBUG static void show_terminal_settings(struct termios *t); @@ -110,11 +173,20 @@ static void show_terminal_settings(struct termios *t); /* static data */ static char fifo1[FILENAME_BUFSIZ], fifo2[FILENAME_BUFSIZ]; +static char statusfile[FILENAME_BUFSIZ]; +static char log_dir[FILENAME_BUFSIZ]; static char pipename[FILENAME_BUFSIZ]; static FILE *stdstatus = NULL; +static int log_generations = DEFAULT_LOG_GENERATIONS; +static int log_maxsize = DEFAULT_LOG_MAXSIZE; +static int log_alive_minutes = DEFAULT_LOG_ALIVE_MINUTES; +static int log_activity_minutes = DEFAULT_LOG_ACTIVITY_MINUTES; +static int log_alive_in_gmt = 0; +static char log_alive_format[ALIVE_BUFFSIZ+1]; static int run_daemon = 0; static char *program_name; static int mfd; /* master pty fd */ +static unsigned protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */ /* * Output buffer. @@ -145,13 +217,29 @@ static char* outbuf_in; LOG_PID|LOG_CONS|LOG_NOWAIT,LOG_USER) #endif +#define ERROR0(Prio,Format) error_logf(Prio,__LINE__,Format"\n") +#define ERROR1(Prio,Format,A1) error_logf(Prio,__LINE__,Format"\n",A1) +#define ERROR2(Prio,Format,A1,A2) error_logf(Prio,__LINE__,Format"\n",A1,A2) + +#ifdef HAVE_STRERROR +# define ADD_ERRNO(Format) "errno=%d '%s'\n"Format"\n",errno,strerror(errno) +#else +# define ADD_ERRNO(Format) "errno=%d\n"Format"\n",errno +#endif +#define ERRNO_ERR0(Prio,Format) error_logf(Prio,__LINE__,ADD_ERRNO(Format)) +#define ERRNO_ERR1(Prio,Format,A1) error_logf(Prio,__LINE__,ADD_ERRNO(Format),A1) + + int main(int argc, char **argv) { int childpid; int sfd = -1; - char *ptyslave=NULL; + int fd; + char *p, *ptyslave=NULL; int i = 1; int off_argv; + int calculated_pipename = 0; + int highest_pipe_num = 0; program_name = argv[0]; @@ -169,16 +257,122 @@ int main(int argc, char **argv) off_argv = i; strn_cpy(pipename, sizeof(pipename), argv[i++]); - - erts_run_erl_log_init(run_daemon,argv[i]); + strn_cpy(log_dir, sizeof(log_dir), argv[i]); + strn_cpy(statusfile, sizeof(statusfile), log_dir); + strn_cat(statusfile, sizeof(statusfile), STATUSFILENAME); #ifdef DEBUG - erts_run_erl_log_status("%s: pid is : %d\n", argv[0], getpid()); + status("%s: pid is : %d\n", argv[0], getpid()); #endif - /* Open read and write fifo */ - if (erts_run_erl_open_fifo(pipename,fifo1,fifo2)) - exit(1); + /* Get values for LOG file handling from the environment */ + if ((p = getenv("RUN_ERL_LOG_ALIVE_MINUTES"))) { + log_alive_minutes = atoi(p); + if (!log_alive_minutes) { + ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ALIVE_MINUTES is 1 " + "(current value is %s)",p); + } + log_activity_minutes = log_alive_minutes / 3; + if (!log_activity_minutes) { + ++log_activity_minutes; + } + } + if ((p = getenv("RUN_ERL_LOG_ACTIVITY_MINUTES"))) { + log_activity_minutes = atoi(p); + if (!log_activity_minutes) { + ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ACTIVITY_MINUTES is 1 " + "(current value is %s)",p); + } + } + if ((p = getenv("RUN_ERL_LOG_ALIVE_FORMAT"))) { + if (strlen(p) > ALIVE_BUFFSIZ) { + ERROR1(LOG_ERR, "RUN_ERL_LOG_ALIVE_FORMAT can contain a maximum of " + "%d characters", ALIVE_BUFFSIZ); + } + strn_cpy(log_alive_format, sizeof(log_alive_format), p); + } else { + strn_cpy(log_alive_format, sizeof(log_alive_format), DEFAULT_LOG_ALIVE_FORMAT); + } + if ((p = getenv("RUN_ERL_LOG_ALIVE_IN_UTC")) && strcmp(p,"0")) { + ++log_alive_in_gmt; + } + if ((p = getenv("RUN_ERL_LOG_GENERATIONS"))) { + log_generations = atoi(p); + if (log_generations < LOG_MIN_GENERATIONS) + ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_GENERATIONS is %d", LOG_MIN_GENERATIONS); + if (log_generations > LOG_MAX_GENERATIONS) + ERROR1(LOG_ERR,"Maximum RUN_ERL_LOG_GENERATIONS is %d", LOG_MAX_GENERATIONS); + } + + if ((p = getenv("RUN_ERL_LOG_MAXSIZE"))) { + log_maxsize = atoi(p); + if (log_maxsize < LOG_MIN_MAXSIZE) + ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_MAXSIZE is %d", LOG_MIN_MAXSIZE); + } + + /* + * Create FIFOs and open them + */ + + if(*pipename && pipename[strlen(pipename)-1] == '/') { + /* The user wishes us to find a unique pipe name in the specified */ + /* directory */ + DIR *dirp; + struct dirent *direntp; + + calculated_pipename = 1; + dirp = opendir(pipename); + if(!dirp) { + ERRNO_ERR1(LOG_ERR,"Can't access pipe directory '%s'.", pipename); + exit(1); + } + + /* Check the directory for existing pipes */ + + while((direntp=readdir(dirp)) != NULL) { + if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) { + int num = atoi(direntp->d_name+PIPE_STUBLEN+1); + if(num > highest_pipe_num) + highest_pipe_num = num; + } + } + closedir(dirp); + strn_catf(pipename, sizeof(pipename), "%s.%d", + PIPE_STUBNAME, highest_pipe_num+1); + } /* if */ + + for(;;) { + /* write FIFO - is read FIFO for `to_erl' program */ + strn_cpy(fifo1, sizeof(fifo1), pipename); + strn_cat(fifo1, sizeof(fifo1), ".r"); + if (create_fifo(fifo1, PERM) < 0) { + ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for writing.", fifo1); + exit(1); + } + + /* read FIFO - is write FIFO for `to_erl' program */ + strn_cpy(fifo2, sizeof(fifo2), pipename); + strn_cat(fifo2, sizeof(fifo2), ".w"); + + /* Check that nobody is running run_erl already */ + if ((fd = sf_open(fifo2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) { + /* Open as client succeeded -- run_erl is already running! */ + sf_close(fd); + if (calculated_pipename) { + ++highest_pipe_num; + strn_catf(pipename, sizeof(pipename), "%s.%d", + PIPE_STUBNAME, highest_pipe_num+1); + continue; + } + fprintf(stderr, "Erlang already running on pipe %s.\n", pipename); + exit(1); + } + if (create_fifo(fifo2, PERM) < 0) { + ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for reading.", fifo2); + exit(1); + } + break; + } /* * Open master pseudo-terminal @@ -250,7 +444,7 @@ int main(int argc, char **argv) sf_close(2); if (dup(sfd) != 0 || dup(sfd) != 1 || dup(sfd) != 2) { - erts_run_erl_log_status("Cannot dup\n"); + status("Cannot dup\n"); } sf_close(sfd); exec_shell(argv+off_argv); /* exec_shell expects argv[2] to be */ @@ -293,7 +487,9 @@ static void pass_on(pid_t childpid) struct timeval timeout; time_t last_activity; char buf[BUFSIZ]; - int rfd, wfd=0; + char log_alive_buffer[ALIVE_BUFFSIZ+1]; + int lognum; + int rfd, wfd=0, lfd=0; int maxfd; int ready; int got_some = 0; /* from to_erl */ @@ -308,12 +504,13 @@ static void pass_on(pid_t childpid) } #ifdef DEBUG - erts_run_erl_log_status("run_erl: %s opened for reading\n", fifo2); + status("run_erl: %s opened for reading\n", fifo2); #endif /* Open the log file */ - erts_run_erl_log_open(); + lognum = find_next_log_num(); + lfd = open_log(lognum, O_RDWR|O_APPEND|O_CREAT|O_SYNC); /* Enter the work loop */ @@ -332,8 +529,7 @@ static void pass_on(pid_t childpid) writefds_ptr = &writefds; } time(&last_activity); - /* don't assume old BSD bug */ - timeout.tv_sec = erts_run_erl_log_alive_minutes()*60; + timeout.tv_sec = log_alive_minutes*60; /* don't assume old BSD bug */ timeout.tv_usec = 0; ready = select(maxfd + 1, &readfds, writefds_ptr, NULL, &timeout); if (ready < 0) { @@ -363,7 +559,28 @@ static void pass_on(pid_t childpid) /* Check how long time we've been inactive */ time(&now); - erts_run_erl_log_activity(!ready,now,last_activity); + if(!ready || now - last_activity > log_activity_minutes*60) { + /* Either a time out: 15 minutes without action, */ + /* or something is coming in right now, but it's a long time */ + /* since last time, so let's write a time stamp this message */ + struct tm *tmptr; + if (log_alive_in_gmt) { + tmptr = gmtime(&now); + } else { + tmptr = localtime(&now); + } + if (!strftime(log_alive_buffer, ALIVE_BUFFSIZ, log_alive_format, + tmptr)) { + strn_cpy(log_alive_buffer, sizeof(log_alive_buffer), + "(could not format time in 256 positions " + "with current format string.)"); + } + log_alive_buffer[ALIVE_BUFFSIZ] = '\0'; + + sn_printf(buf, sizeof(buf), "\n===== %s%s\n", + ready?"":"ALIVE ", log_alive_buffer); + write_to_log(&lfd, &lognum, buf, strlen(buf)); + } } /* @@ -398,7 +615,7 @@ static void pass_on(pid_t childpid) */ if (FD_ISSET(mfd, &readfds)) { #ifdef DEBUG - erts_run_erl_log_status("Pty master read; "); + status("Pty master read; "); #endif if ((len = sf_read(mfd, buf, BUFSIZ)) <= 0) { sf_close(rfd); @@ -416,7 +633,7 @@ static void pass_on(pid_t childpid) exit(0); } - erts_run_erl_log_write(buf, len); + write_to_log(&lfd, &lognum, buf, len); /* * Save in the output queue. @@ -432,7 +649,7 @@ static void pass_on(pid_t childpid) */ if (FD_ISSET(rfd, &readfds)) { #ifdef DEBUG - erts_run_erl_log_status("FIFO read; "); + status("FIFO read; "); #endif if ((len = sf_read(rfd, buf, BUFSIZ)) < 0) { sf_close(rfd); @@ -461,7 +678,7 @@ static void pass_on(pid_t childpid) * should succeed. But in case of error, we just ignore it. */ if ((wfd = sf_open(fifo1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) { - erts_run_erl_log_status("Client expected on FIFO %s, but can't open (len=%d)\n", + status("Client expected on FIFO %s, but can't open (len=%d)\n", fifo1, len); sf_close(rfd); rfd = sf_open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0); @@ -473,7 +690,7 @@ static void pass_on(pid_t childpid) } else { #ifdef DEBUG - erts_run_erl_log_status("run_erl: %s opened for writing\n", fifo1); + status("run_erl: %s opened for writing\n", fifo1); #endif } } @@ -489,15 +706,14 @@ static void pass_on(pid_t childpid) /* Write the message */ #ifdef DEBUG - erts_run_erl_log_status("Pty master write; "); + status("Pty master write; "); #endif - len = erts_run_erl_extract_ctrl_seq(buf, len, mfd); + len = extract_ctrl_seq(buf, len); if(len==1 && buf[0] == '\003') { kill(childpid,SIGINT); - } - else if (len>0 && erts_run_erl_write_all(mfd, buf, len) != len) - { + } + else if (len>0 && write_all(mfd, buf, len) != len) { ERRNO_ERR0(LOG_ERR,"Error in writing to terminal."); sf_close(rfd); if(wfd) sf_close(wfd); @@ -506,7 +722,7 @@ static void pass_on(pid_t childpid) } } #ifdef DEBUG - erts_run_erl_log_status("OK\n"); + status("OK\n"); #endif } } @@ -516,6 +732,173 @@ static void catch_sigchild(int sig) { } +/* + * next_log: + * Returns the index number that follows the given index number. + * (Wrapping after log_generations) + */ +static int next_log(int log_num) { + return log_num>=log_generations?1:log_num+1; +} + +/* + * prev_log: + * Returns the index number that precedes the given index number. + * (Wrapping after log_generations) + */ +static int prev_log(int log_num) { + return log_num<=1?log_generations:log_num-1; +} + +/* + * find_next_log_num() + * Searches through the log directory to check which logs that already + * exist. It finds the "hole" in the sequence, and returns the index + * number for the last log in the log sequence. If there is no hole, index + * 1 is returned. + */ +static int find_next_log_num(void) { + int i, next_gen, log_gen; + DIR *dirp; + struct dirent *direntp; + int log_exists[LOG_MAX_GENERATIONS+1]; + int stub_len = strlen(LOG_STUBNAME); + + /* Initialize exiting log table */ + + for(i=log_generations; i>=0; i--) + log_exists[i] = 0; + dirp = opendir(log_dir); + if(!dirp) { + ERRNO_ERR1(LOG_ERR,"Can't access log directory '%s'", log_dir); + exit(1); + } + + /* Check the directory for existing logs */ + + while((direntp=readdir(dirp)) != NULL) { + if(strncmp(direntp->d_name,LOG_STUBNAME,stub_len)==0) { + int num = atoi(direntp->d_name+stub_len); + if(num < 1 || num > log_generations) + continue; + log_exists[num] = 1; + } + } + closedir(dirp); + + /* Find out the next available log file number */ + + next_gen = 0; + for(i=log_generations; i>=0; i--) { + if(log_exists[i]) + if(next_gen) + break; + else + ; + else + next_gen = i; + } + + /* Find out the current log file number */ + + if(next_gen) + log_gen = prev_log(next_gen); + else + log_gen = 1; + + return log_gen; +} /* find_next_log_num() */ + +/* open_log() + * Opens a log file (with given index) for writing. Writing may be + * at the end or a trucnating write, according to flags. + * A LOGGING STARTED and time stamp message is inserted into the log file + */ +static int open_log(int log_num, int flags) +{ + char buf[FILENAME_MAX]; + time_t now; + struct tm *tmptr; + char log_buffer[ALIVE_BUFFSIZ+1]; + int lfd; + + /* Remove the next log (to keep a "hole" in the log sequence) */ + sn_printf(buf, sizeof(buf), "%s/%s%d", + log_dir, LOG_STUBNAME, next_log(log_num)); + unlink(buf); + + /* Create or continue on the current log file */ + sn_printf(buf, sizeof(buf), "%s/%s%d", log_dir, LOG_STUBNAME, log_num); + if((lfd = sf_open(buf, flags, LOG_PERM))<0){ + ERRNO_ERR1(LOG_ERR,"Can't open log file '%s'.", buf); + exit(1); + } + + /* Write a LOGGING STARTED and time stamp into the log file */ + time(&now); + if (log_alive_in_gmt) { + tmptr = gmtime(&now); + } else { + tmptr = localtime(&now); + } + if (!strftime(log_buffer, ALIVE_BUFFSIZ, log_alive_format, + tmptr)) { + strn_cpy(log_buffer, sizeof(log_buffer), + "(could not format time in 256 positions " + "with current format string.)"); + } + log_buffer[ALIVE_BUFFSIZ] = '\0'; + + sn_printf(buf, sizeof(buf), "\n=====\n===== LOGGING STARTED %s\n=====\n", + log_buffer); + if (write_all(lfd, buf, strlen(buf)) < 0) + status("Error in writing to log.\n"); + +#if USE_FSYNC + fsync(lfd); +#endif + + return lfd; +} + +/* write_to_log() + * Writes a message to a log file. If the current log file is full, + * a new log file is opened. + */ +static void write_to_log(int* lfd, int* log_num, char* buf, int len) +{ + int size; + + /* Decide if new logfile needed, and open if so */ + + size = lseek(*lfd,0,SEEK_END); + if(size+len > log_maxsize) { + sf_close(*lfd); + *log_num = next_log(*log_num); + *lfd = open_log(*log_num, O_RDWR|O_CREAT|O_TRUNC|O_SYNC); + } + + /* Write to log file */ + + if (write_all(*lfd, buf, len) < 0) { + status("Error in writing to log.\n"); + } + +#if USE_FSYNC + fsync(*lfd); +#endif +} + +/* create_fifo() + * Creates a new fifo with the given name and permission. + */ +static int create_fifo(char *name, int perm) +{ + if ((mkfifo(name, perm) < 0) && (errno != EEXIST)) + return -1; + return 0; +} + /* open_pty_master() * Find a master device, open and return fd and slave device name. @@ -712,9 +1095,9 @@ static void exec_shell(char **argv) else argv[0] = sh; argv[1] = "-c"; - erts_run_erl_log_status("Args before exec of shell:\n"); + status("Args before exec of shell:\n"); for (vp = argv, i = 0; *vp; vp++, i++) - erts_run_erl_log_status("argv[%d] = %s\n", i, *vp); + status("argv[%d] = %s\n", i, *vp); if (stdstatus) { fclose(stdstatus); } @@ -725,6 +1108,26 @@ static void exec_shell(char **argv) ERRNO_ERR0(LOG_ERR,"Could not execv"); } +/* status() + * Prints the arguments to a status file + * Works like printf (see vfrpintf) + */ +static void status(const char *format,...) +{ + va_list args; + time_t now; + + if (stdstatus == NULL) + stdstatus = fopen(statusfile, "w"); + if (stdstatus == NULL) + return; + now = time(NULL); + fprintf(stdstatus, "run_erl [%d] %s", (int)getpid(), ctime(&now)); + va_start(args, format); + vfprintf(stdstatus, format, args); + va_end(args); + fflush(stdstatus); +} static void daemon_init(void) /* As R Stevens wants it, to a certain extent anyway... */ @@ -764,10 +1167,47 @@ static void daemon_init(void) run_daemon = 1; } +/* error_logf() + * Prints the arguments to stderr or syslog + * Works like printf (see vfprintf) + */ +static void error_logf(int priority, int line, const char *format, ...) +{ + va_list args; + va_start(args, format); + +#ifdef HAVE_SYSLOG_H + if (run_daemon) { + vsyslog(priority,format,args); + } + else +#endif + { + time_t now = time(NULL); + fprintf(stderr, "run_erl:%d [%d] %s", line, (int)getpid(), ctime(&now)); + vfprintf(stderr, format, args); + } + va_end(args); +} + static void usage(char *pname) { - fprintf(stderr, "Usage: "); - fprintf(stderr, RUN_ERL_USAGE, pname); + fprintf(stderr, "Usage: %s (pipe_name|pipe_dir/) log_dir \"command [parameters ...]\"\n", pname); + fprintf(stderr, "\nYou may also set the environment variables RUN_ERL_LOG_GENERATIONS\n"); + fprintf(stderr, "and RUN_ERL_LOG_MAXSIZE to the number of log files to use and the\n"); + fprintf(stderr, "size of the log file when to switch to the next log file\n"); +} + +/* Instead of making sure basename exists, we do our own */ +static char *simple_basename(char *path) +{ + char *ptr; + for (ptr = path; *ptr != '\0'; ++ptr) { + if (*ptr == '/') { + path = ptr + 1; + } + } + return path; } static void init_outbuf(void) @@ -838,6 +1278,114 @@ static void outbuf_append(const char* buf, int n) outbuf_in += n; } +/* Call write() until entire buffer has been written or error. + * Return len or -1. + */ +static int write_all(int fd, const char* buf, int len) +{ + int left = len; + int written; + for (;;) { + written = sf_write(fd,buf,left); + if (written == left) { + return len; + } + if (written < 0) { + return -1; + } + left -= written; + buf += written; + } +} + +static ssize_t sf_read(int fd, void *buffer, size_t len) { + ssize_t n = 0; + + do { n = read(fd, buffer, len); } while (n < 0 && errno == EINTR); + + return n; +} + +static ssize_t sf_write(int fd, const void *buffer, size_t len) { + ssize_t n = 0; + + do { n = write(fd, buffer, len); } while (n < 0 && errno == EINTR); + + return n; +} + +static int sf_open(const char *path, int type, mode_t mode) { + int fd = 0; + + do { fd = open(path, type, mode); } while(fd < 0 && errno == EINTR); + + return fd; +} +static int sf_close(int fd) { + int res = 0; + + do { res = close(fd); } while(fd < 0 && errno == EINTR); + + return res; +} +/* Extract any control sequences that are ment only for run_erl + * and should not be forwarded to the pty. + */ +static int extract_ctrl_seq(char* buf, int len) +{ + static const char prefix[] = "\033_"; + static const char suffix[] = "\033\\"; + char* bufend = buf + len; + char* start = buf; + char* command; + char* end; + + for (;;) { + start = find_str(start, bufend-start, prefix); + if (!start) break; + + command = start + strlen(prefix); + end = find_str(command, bufend-command, suffix); + if (end) { + unsigned col, row; + if (sscanf(command,"version=%u", &protocol_ver)==1) { + /*fprintf(stderr,"to_erl v%u\n", protocol_ver);*/ + } + else if (sscanf(command,"winsize=%u,%u", &col, &row)==2) { + set_window_size(col,row); + } + else { + ERROR2(LOG_ERR, "Ignoring unknown ctrl command '%.*s'\n", + (int)(end-command), command); + } + + /* Remove ctrl sequence from buf */ + end += strlen(suffix); + memmove(start, end, bufend-end); + bufend -= end - start; + } + else { + ERROR2(LOG_ERR, "Missing suffix in ctrl sequence '%.*s'\n", + (int)(bufend-start), start); + break; + } + } + return bufend - buf; +} + +static void set_window_size(unsigned col, unsigned row) +{ +#ifdef TIOCSWINSZ + struct winsize ws; + ws.ws_col = col; + ws.ws_row = row; + if (ioctl(mfd, TIOCSWINSZ, &ws) < 0) { + ERRNO_ERR0(LOG_ERR,"Failed to set window size"); + } +#endif +} + + #ifdef DEBUG #define S(x) ((x) > 0 ? 1 : 0) diff --git a/erts/etc/common/run_erl_vsn.h b/erts/etc/unix/run_erl.h index 2c3e67e81c..83bdfdfb19 100644 --- a/erts/etc/common/run_erl_vsn.h +++ b/erts/etc/unix/run_erl.h @@ -1,8 +1,8 @@ /* * %CopyrightBegin% - * - * Copyright Ericsson AB 2008-2009. All Rights Reserved. - * + * + * Copyright Ericsson AB 2008-2016. All Rights Reserved. + * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. * You may obtain a copy of the License at @@ -14,7 +14,7 @@ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. * See the License for the specific language governing permissions and * limitations under the License. - * + * * %CopyrightEnd% */ @@ -28,3 +28,4 @@ * 0: Older, without version handshake * 1: R12B-3, version handshake + window size ctrl */ + diff --git a/erts/etc/common/safe_string.c b/erts/etc/unix/safe_string.c index cdcdbf16f0..666022dc61 100644 --- a/erts/etc/common/safe_string.c +++ b/erts/etc/unix/safe_string.c @@ -1,8 +1,8 @@ /* * %CopyrightBegin% - * - * Copyright Ericsson AB 2008-2009. All Rights Reserved. - * + * + * Copyright Ericsson AB 2008-2016. All Rights Reserved. + * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. * You may obtain a copy of the License at @@ -14,12 +14,12 @@ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. * See the License for the specific language governing permissions and * limitations under the License. - * + * * %CopyrightEnd% */ -/* +/* * Module: safe_string.c - * + * * This is a bunch of generic string operation * that are safe regarding buffer overflow. * @@ -121,3 +121,4 @@ void* memmove(void *dest, const void *src, size_t n) return dest; } #endif /* HAVE_MEMMOVE */ + diff --git a/erts/etc/common/safe_string.h b/erts/etc/unix/safe_string.h index f9d2b2023a..cafd3fc71a 100644 --- a/erts/etc/common/safe_string.h +++ b/erts/etc/unix/safe_string.h @@ -1,8 +1,8 @@ /* * %CopyrightBegin% - * - * Copyright Ericsson AB 2008-2009. All Rights Reserved. - * + * + * Copyright Ericsson AB 2008-2016. All Rights Reserved. + * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. * You may obtain a copy of the License at @@ -14,12 +14,12 @@ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. * See the License for the specific language governing permissions and * limitations under the License. - * + * * %CopyrightEnd% */ -/* +/* * Module: safe_string.h - * + * * This is an interface to a bunch of generic string operation * that are safe regarding buffer overflow. * @@ -63,3 +63,4 @@ char* find_str(const char* haystack, int size, const char* needle); #ifndef HAVE_MEMMOVE void* memmove(void *dest, const void *src, size_t n); #endif + diff --git a/erts/etc/unix/setuid_socket_wrap.c b/erts/etc/unix/setuid_socket_wrap.c index 59ed8eae6f..461c69ee3e 100644 --- a/erts/etc/unix/setuid_socket_wrap.c +++ b/erts/etc/unix/setuid_socket_wrap.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/unix/start.src b/erts/etc/unix/start.src index 377f5e85c8..bdd146951f 100644 --- a/erts/etc/unix/start.src +++ b/erts/etc/unix/start.src @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/unix/start_erl.src b/erts/etc/unix/start_erl.src index b889101783..34e0369710 100644 --- a/erts/etc/unix/start_erl.src +++ b/erts/etc/unix/start_erl.src @@ -3,7 +3,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/unix/to_erl.c b/erts/etc/unix/to_erl.c index 82d3218964..0bd469727c 100644 --- a/erts/etc/unix/to_erl.c +++ b/erts/etc/unix/to_erl.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2015. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -17,9 +17,592 @@ * * %CopyrightEnd% */ +/* + * Module: to_erl.c + * + * This module implements a process that opens two specified FIFOs, one + * for reading and one for writing; reads from its stdin, and writes what + * it has read to the write FIF0; reads from the read FIFO, and writes to + * its stdout. + * + ________ _________ + | |--<-- pipe.r (fifo1) --<--| | + | to_erl | | run_erl | (parent) + |________|-->-- pipe.w (fifo2) -->--|_________| + ^ master pty + | + | slave pty + ____V____ + | | + | "erl" | (child) + |_________| + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include <sys/types.h> +#include <sys/stat.h> +#include <sys/time.h> +#include <sys/types.h> +#include <fcntl.h> +#include <unistd.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <termios.h> +#include <dirent.h> +#include <signal.h> +#include <errno.h> +#ifdef HAVE_SYS_IOCTL_H +# include <sys/ioctl.h> +#endif + +#include "run_erl.h" +#include "safe_string.h" /* strn_cpy, strn_catf, sn_printf, etc. */ + +#if defined(O_NONBLOCK) +# define DONT_BLOCK_PLEASE O_NONBLOCK +#else +# define DONT_BLOCK_PLEASE O_NDELAY +# if !defined(EAGAIN) +# define EAGAIN -3898734 +# endif +#endif + +#ifdef HAVE_STRERROR +# define STRERROR(x) strerror(x) +#else +# define STRERROR(x) "" +#endif + +#define noDEBUG + +#define PIPE_DIR "/tmp/" +#define PIPE_STUBNAME "erlang.pipe" +#define PIPE_STUBLEN strlen(PIPE_STUBNAME) + +#ifdef DEBUG +#define STATUS(s) { fprintf(stderr, (s)); fflush(stderr); } +#else +#define STATUS(s) +#endif + +#ifndef FILENAME_MAX +#define FILENAME_MAX 250 +#endif + +static struct termios tty_smode, tty_rmode; +static int tty_eof = 0; +static int recv_sig = 0; +static int protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */ + +static int write_all(int fd, const char* buf, int len); +static int window_size_seq(char* buf, size_t bufsz); +static int version_handshake(char* buf, int len, int wfd); +#ifdef DEBUG +static void show_terminal_settings(struct termios *); +#endif + +static void handle_ctrlc(int sig) +{ + /* Reinstall the handler, and signal break flag */ + signal(SIGINT,handle_ctrlc); + recv_sig = SIGINT; +} + +static void handle_sigwinch(int sig) +{ + recv_sig = SIGWINCH; +} + +static void usage(char *pname) +{ + fprintf(stderr, "Usage: %s [-h|-F] [pipe_name|pipe_dir/]\n", pname); + fprintf(stderr, "\t-h\tThis help text.\n"); + fprintf(stderr, "\t-F\tForce connection even though pipe is locked by other to_erl process.\n"); +} + +int main(int argc, char **argv) +{ + char FIFO1[FILENAME_MAX], FIFO2[FILENAME_MAX]; + int i, len, wfd, rfd; + fd_set readfds; + char buf[BUFSIZ]; + char pipename[FILENAME_MAX]; + int pipeIx = 1; + int force_lock = 0; + int got_some = 0; + + if (argc >= 2 && argv[1][0]=='-') { + switch (argv[1][1]) { + case 'h': + usage(argv[0]); + exit(1); + case 'F': + force_lock = 1; + break; + default: + fprintf(stderr,"Invalid option '%s'\n",argv[1]); + exit(1); + } + pipeIx = 2; + } + +#ifdef DEBUG + fprintf(stderr, "%s: pid is : %d\n", argv[0], (int)getpid()); +#endif + + strn_cpy(pipename, sizeof(pipename), + (argv[pipeIx] ? argv[pipeIx] : PIPE_DIR)); + + if(*pipename && pipename[strlen(pipename)-1] == '/') { + /* The user wishes us to find a pipe name in the specified */ + /* directory */ + int highest_pipe_num = 0; + DIR *dirp; + struct dirent *direntp; + + dirp = opendir(pipename); + if(!dirp) { + fprintf(stderr, "Can't access pipe directory %s: %s\n", pipename, strerror(errno)); + exit(1); + } + + /* Check the directory for existing pipes */ + + while((direntp=readdir(dirp)) != NULL) { + if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) { + int num = atoi(direntp->d_name+PIPE_STUBLEN+1); + if(num > highest_pipe_num) + highest_pipe_num = num; + } + } + closedir(dirp); + strn_catf(pipename, sizeof(pipename), (highest_pipe_num?"%s.%d":"%s"), + PIPE_STUBNAME, highest_pipe_num); + } /* if */ + + /* read FIFO */ + sn_printf(FIFO1,sizeof(FIFO1),"%s.r",pipename); + /* write FIFO */ + sn_printf(FIFO2,sizeof(FIFO2),"%s.w",pipename); + + /* Check that nobody is running to_erl on this pipe already */ + if ((wfd = open (FIFO1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) { + /* Open as server succeeded -- to_erl is already running! */ + close(wfd); + fprintf(stderr, "Another to_erl process already attached to pipe " + "%s.\n", pipename); + if (force_lock) { + fprintf(stderr, "But we proceed anyway by force (-F).\n"); + } + else { + exit(1); + } + } + + if ((rfd = open (FIFO1, O_RDONLY|DONT_BLOCK_PLEASE, 0)) < 0) { +#ifdef DEBUG + fprintf(stderr, "Could not open FIFO %s for reading.\n", FIFO1); +#endif + fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno)); + exit(1); + } +#ifdef DEBUG + fprintf(stderr, "to_erl: %s opened for reading\n", FIFO1); +#endif + + if ((wfd = open (FIFO2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) { +#ifdef DEBUG + fprintf(stderr, "Could not open FIFO %s for writing.\n", FIFO2); +#endif + fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno)); + close(rfd); + exit(1); + } +#ifdef DEBUG + fprintf(stderr, "to_erl: %s opened for writing\n", FIFO2); +#endif + + fprintf(stderr, "Attaching to %s (^D to exit)\n\n", pipename); + + /* Set break handler to our handler */ + signal(SIGINT,handle_ctrlc); + + /* + * Save the current state of the terminal, and set raw mode. + */ + if (tcgetattr(0, &tty_rmode) , 0) { + fprintf(stderr, "Cannot get terminals current mode\n"); + exit(-1); + } + tty_smode = tty_rmode; + tty_eof = '\004'; /* Ctrl+D to exit */ +#ifdef DEBUG + show_terminal_settings(&tty_rmode); +#endif + tty_smode.c_iflag = + 1*BRKINT |/*Signal interrupt on break.*/ + 1*IGNPAR |/*Ignore characters with parity errors.*/ + 1*ISTRIP |/*Strip character.*/ + 0; + +#if 0 +0*IGNBRK |/*Ignore break condition.*/ +0*PARMRK |/*Mark parity errors.*/ +0*INPCK |/*Enable input parity check.*/ +0*INLCR |/*Map NL to CR on input.*/ +0*IGNCR |/*Ignore CR.*/ +0*ICRNL |/*Map CR to NL on input.*/ +0*IUCLC |/*Map upper-case to lower-case on input.*/ +0*IXON |/*Enable start/stop output control.*/ +0*IXANY |/*Enable any character to restart output.*/ +0*IXOFF |/*Enable start/stop input control.*/ +0*IMAXBEL|/*Echo BEL on input line too long.*/ +#endif + + tty_smode.c_oflag = + 1*OPOST |/*Post-process output.*/ + 1*ONLCR |/*Map NL to CR-NL on output.*/ +#ifdef XTABS + 1*XTABS |/*Expand tabs to spaces. (Linux)*/ +#endif +#ifdef OXTABS + 1*OXTABS |/*Expand tabs to spaces. (FreeBSD)*/ +#endif +#ifdef NL0 + 1*NL0 |/*Select newline delays*/ +#endif +#ifdef CR0 + 1*CR0 |/*Select carriage-return delays*/ +#endif +#ifdef TAB0 + 1*TAB0 |/*Select horizontal tab delays*/ +#endif +#ifdef BS0 + 1*BS0 |/*Select backspace delays*/ +#endif +#ifdef VT0 + 1*VT0 |/*Select vertical tab delays*/ +#endif +#ifdef FF0 + 1*FF0 |/*Select form feed delays*/ +#endif + 0; + +#if 0 +0*OLCUC |/*Map lower case to upper on output.*/ +0*OCRNL |/*Map CR to NL on output.*/ +0*ONOCR |/*No CR output at column 0.*/ +0*ONLRET |/*NL performs CR function.*/ +0*OFILL |/*Use fill characters for delay.*/ +0*OFDEL |/*Fill is DEL, else NULL.*/ +0*NL1 | +0*CR1 | +0*CR2 | +0*CR3 | +0*TAB1 | +0*TAB2 | +0*TAB3 |/*Expand tabs to spaces.*/ +0*BS1 | +0*VT1 | +0*FF1 | +#endif + + /* JALI: removed setting the tty_smode.c_cflag flags, since this is not */ + /* advisable if this is a *real* terminal, such as the console. In fact */ + /* this may hang the entire machine, deep, deep down (signalling break */ + /* or toggling the abort switch doesn't help) */ + + tty_smode.c_lflag = + 0; + +#if 0 +0*ISIG |/*Enable signals.*/ +0*ICANON |/*Canonical input (erase and kill processing).*/ +0*XCASE |/*Canonical upper/lower presentation.*/ +0*ECHO |/*Enable echo.*/ +0*ECHOE |/*Echo erase character as BS-SP-BS.*/ +0*ECHOK |/*Echo NL after kill character.*/ +0*ECHONL |/*Echo NL.*/ +0*NOFLSH |/*Disable flush after interrupt or quit.*/ +0*TOSTOP |/*Send SIGTTOU for background output.*/ +0*ECHOCTL|/*Echo control characters as ^char, delete as ^?.*/ +0*ECHOPRT|/*Echo erase character as character erased.*/ +0*ECHOKE |/*BS-SP-BS erase entire line on line kill.*/ +0*FLUSHO |/*Output is being flushed.*/ +0*PENDIN |/*Retype pending input at next read or input character.*/ +0*IEXTEN |/*Enable extended (implementation-defined) functions.*/ +#endif + + tty_smode.c_cc[VMIN] =0;/* Note that VMIN is the same as VEOF! */ + tty_smode.c_cc[VTIME] =0;/* Note that VTIME is the same as VEOL! */ + tty_smode.c_cc[VINTR] =3; + + tcsetattr(0, TCSADRAIN, &tty_smode); + +#ifdef DEBUG + show_terminal_settings(&tty_smode); +#endif + /* + * "Write a ^L to the FIFO which causes the other end to redisplay + * the input line." + * This does not seem to work as was intended in old comment above. + * However, this control character is now (R12B-3) used by run_erl + * to trigger the version handshaking between to_erl and run_erl + * at the start of every new to_erl-session. + */ + + if (write(wfd, "\014", 1) < 0) { + fprintf(stderr, "Error in writing ^L to FIFO.\n"); + } + + /* + * read and write + */ + while (1) { + FD_ZERO(&readfds); + FD_SET(0, &readfds); + FD_SET(rfd, &readfds); + if (select(rfd + 1, &readfds, NULL, NULL, NULL) < 0) { + if (recv_sig) { + FD_ZERO(&readfds); + } + else { + fprintf(stderr, "Error in select.\n"); + break; + } + } + len = 0; + + /* + * Read from terminal and write to FIFO + */ + if (recv_sig) { + switch (recv_sig) { + case SIGINT: + fprintf(stderr, "[Break]\n\r"); + buf[0] = '\003'; + len = 1; + break; + case SIGWINCH: + len = window_size_seq(buf,sizeof(buf)); + break; + default: + fprintf(stderr,"Unexpected signal: %u\n",recv_sig); + } + recv_sig = 0; + } + else if (FD_ISSET(0, &readfds)) { + len = read(0, buf, sizeof(buf)); + if (len <= 0) { + close(rfd); + close(wfd); + if (len < 0) { + fprintf(stderr, "Error in reading from stdin.\n"); + } else { + fprintf(stderr, "[EOF]\n\r"); + } + break; + } + /* check if there is an eof character in input */ + for (i = 0; i < len && buf[i] != tty_eof; i++); + if (buf[i] == tty_eof) { + fprintf(stderr, "[Quit]\n\r"); + break; + } + } + + if (len) { +#ifdef DEBUG + if(write(1, buf, len)); +#endif + if (write_all(wfd, buf, len) != len) { + fprintf(stderr, "Error in writing to FIFO.\n"); + close(rfd); + close(wfd); + break; + } + STATUS("\" OK\r\n"); + } + + /* + * Read from FIFO, write to terminal. + */ + if (FD_ISSET(rfd, &readfds)) { + STATUS("FIFO read: "); + len = read(rfd, buf, BUFSIZ); + if (len < 0 && errno == EAGAIN) { + /* + * No data this time, but the writing end of the FIFO is still open. + * Do nothing. + */ + ; + } else if (len <= 0) { + /* + * Either an error or end of file. In either case, break out + * of the loop. + */ + close(rfd); + close(wfd); + if (len < 0) { + fprintf(stderr, "Error in reading from FIFO.\n"); + } else + fprintf(stderr, "[End]\n\r"); + break; + } else { + if (!got_some) { + if ((len=version_handshake(buf,len,wfd)) < 0) { + close(rfd); + close(wfd); + break; + } + if (protocol_ver >= 1) { + /* Tell run_erl size of terminal window */ + signal(SIGWINCH, handle_sigwinch); + raise(SIGWINCH); + } + got_some = 1; + } + + /* + * We successfully read at least one character. Write what we got. + */ + STATUS("Terminal write: \""); + if (write_all(1, buf, len) != len) { + fprintf(stderr, "Error in writing to terminal.\n"); + close(rfd); + close(wfd); + break; + } + STATUS("\" OK\r\n"); + } + } + } + + /* + * Reset terminal characterstics + * XXX + */ + tcsetattr(0, TCSADRAIN, &tty_rmode); + return 0; +} + +/* Call write() until entire buffer has been written or error. + * Return len or -1. + */ +static int write_all(int fd, const char* buf, int len) +{ + int left = len; + int written; + while (left) { + written = write(fd,buf,left); + if (written < 0) { + return -1; + } + left -= written; + buf += written; + } + return len; +} + +static int window_size_seq(char* buf, size_t bufsz) +{ +#ifdef TIOCGWINSZ + struct winsize ws; + static const char prefix[] = "\033_"; + static const char suffix[] = "\033\\"; + /* This Esc sequence is called "Application Program Command" + and seems suitable to use for our own customized stuff. */ + + if (ioctl(STDIN_FILENO, TIOCGWINSZ, &ws) == 0) { + int len = sn_printf(buf, bufsz, "%swinsize=%u,%u%s", + prefix, ws.ws_col, ws.ws_row, suffix); + return len; + } +#endif /* TIOCGWINSZ */ + return 0; +} + +/* to_erl run_erl + * | | + * |---------- '\014' -------->| (session start) + * | | + * |<---- "[run_erl v1-0]" ----| (version interval) + * | | + * |--- Esc_"version=1"Esc\ -->| (common version) + * | | + */ +static int version_handshake(char* buf, int len, int wfd) +{ + unsigned re_high=0, re_low; + char *end = find_str(buf,len,"]\n"); + + if (end && sscanf(buf,"[run_erl v%u-%u",&re_high,&re_low)==2) { + char wbuf[30]; + int wlen; + + if (re_low > RUN_ERL_HI_VER || re_high < RUN_ERL_LO_VER) { + fprintf(stderr,"Incompatible versions: to_erl=v%u-%u run_erl=v%u-%u\n", + RUN_ERL_HI_VER, RUN_ERL_LO_VER, re_high, re_low); + return -1; + } + /* Choose highest common version */ + protocol_ver = re_high < RUN_ERL_HI_VER ? re_high : RUN_ERL_HI_VER; + + wlen = sn_printf(wbuf, sizeof(wbuf), "\033_version=%u\033\\", + protocol_ver); + if (write_all(wfd, wbuf, wlen) < 0) { + fprintf(stderr,"Failed to send version handshake\n"); + return -1; + } + end += 2; + len -= (end-buf); + memmove(buf,end,len); + + } + else { /* we assume old run_erl without version handshake */ + protocol_ver = 0; + } + + if (re_high != RUN_ERL_HI_VER) { + fprintf(stderr,"run_erl has different version, " + "using common protocol level %u\n", protocol_ver); + } + + return len; +} + -#include "to_erl_common.h" +#ifdef DEBUG +#define S(x) ((x) > 0 ? 1 : 0) -int main(int argc,char **argv) { - return to_erl(argc,argv); +static void show_terminal_settings(struct termios *t) +{ + fprintf(stderr,"c_iflag:\n"); + fprintf(stderr,"Signal interrupt on break: BRKINT %d\n", S(t->c_iflag & BRKINT)); + fprintf(stderr,"Map CR to NL on input: ICRNL %d\n", S(t->c_iflag & ICRNL)); + fprintf(stderr,"Ignore break condition: IGNBRK %d\n", S(t->c_iflag & IGNBRK)); + fprintf(stderr,"Ignore CR: IGNCR %d\n", S(t->c_iflag & IGNCR)); + fprintf(stderr,"Ignore char with par. err's: IGNPAR %d\n", S(t->c_iflag & IGNPAR)); + fprintf(stderr,"Map NL to CR on input: INLCR %d\n", S(t->c_iflag & INLCR)); + fprintf(stderr,"Enable input parity check: INPCK %d\n", S(t->c_iflag & INPCK)); + fprintf(stderr,"Strip character ISTRIP %d\n", S(t->c_iflag & ISTRIP)); + fprintf(stderr,"Enable start/stop input ctrl IXOFF %d\n", S(t->c_iflag & IXOFF)); + fprintf(stderr,"ditto output ctrl IXON %d\n", S(t->c_iflag & IXON)); + fprintf(stderr,"Mark parity errors PARMRK %d\n", S(t->c_iflag & PARMRK)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_oflag:\n"); + fprintf(stderr,"Perform output processing OPOST %d\n", S(t->c_oflag & OPOST)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_cflag:\n"); + fprintf(stderr,"Ignore modem status lines CLOCAL %d\n", S(t->c_cflag & CLOCAL)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_local:\n"); + fprintf(stderr,"Enable echo ECHO %d\n", S(t->c_lflag & ECHO)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_cc:\n"); + fprintf(stderr,"c_cc[VEOF] %d\n", t->c_cc[VEOF]); } +#endif diff --git a/erts/etc/win32/Install.c b/erts/etc/win32/Install.c index 82bae947d4..43930ff284 100644 --- a/erts/etc/win32/Install.c +++ b/erts/etc/win32/Install.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2013. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/Makefile b/erts/etc/win32/Makefile index 12c04fc9a5..c6376ebe74 100644 --- a/erts/etc/win32/Makefile +++ b/erts/etc/win32/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2012. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/Nmakefile.start_erl b/erts/etc/win32/Nmakefile.start_erl index cf83713bab..00d22461fb 100644 --- a/erts/etc/win32/Nmakefile.start_erl +++ b/erts/etc/win32/Nmakefile.start_erl @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# Copyright Ericsson AB 1998-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/beam.rc b/erts/etc/win32/beam.rc index 9e137ecd62..0aaabf1097 100644 --- a/erts/etc/win32/beam.rc +++ b/erts/etc/win32/beam.rc @@ -1,7 +1,7 @@ // // %CopyrightBegin% // -// Copyright Ericsson AB 1997-2009. All Rights Reserved. +// Copyright Ericsson AB 1997-2016. All Rights Reserved. // // Licensed under the Apache License, Version 2.0 (the "License"); // you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/erl b/erts/etc/win32/cygwin_tools/erl index 51a7be5584..897bbfac87 100755 --- a/erts/etc/win32/cygwin_tools/erl +++ b/erts/etc/win32/cygwin_tools/erl @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/erlc b/erts/etc/win32/cygwin_tools/erlc index 588b53b1be..eda9fdb7fc 100755 --- a/erts/etc/win32/cygwin_tools/erlc +++ b/erts/etc/win32/cygwin_tools/erlc @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/javac.sh b/erts/etc/win32/cygwin_tools/javac.sh index f2f97ef152..f53e5a3cc6 100755 --- a/erts/etc/win32/cygwin_tools/javac.sh +++ b/erts/etc/win32/cygwin_tools/javac.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/make_bootstrap_ini.sh b/erts/etc/win32/cygwin_tools/make_bootstrap_ini.sh index 0f87f3d077..377c0dda6c 100755 --- a/erts/etc/win32/cygwin_tools/make_bootstrap_ini.sh +++ b/erts/etc/win32/cygwin_tools/make_bootstrap_ini.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2009. All Rights Reserved. +# Copyright Ericsson AB 2003-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/make_local_ini.sh b/erts/etc/win32/cygwin_tools/make_local_ini.sh index 0bcb362ffe..e5db98468b 100755 --- a/erts/etc/win32/cygwin_tools/make_local_ini.sh +++ b/erts/etc/win32/cygwin_tools/make_local_ini.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2009. All Rights Reserved. +# Copyright Ericsson AB 2003-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/mingw/ar.sh b/erts/etc/win32/cygwin_tools/mingw/ar.sh index 2ebfe4e435..de166284d8 100755 --- a/erts/etc/win32/cygwin_tools/mingw/ar.sh +++ b/erts/etc/win32/cygwin_tools/mingw/ar.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# Copyright Ericsson AB 2006-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/mingw/cc.sh b/erts/etc/win32/cygwin_tools/mingw/cc.sh index 5993f70686..0b321a5099 100755 --- a/erts/etc/win32/cygwin_tools/mingw/cc.sh +++ b/erts/etc/win32/cygwin_tools/mingw/cc.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# Copyright Ericsson AB 2006-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/mingw/coffix.c b/erts/etc/win32/cygwin_tools/mingw/coffix.c index 383c422008..ff3f3de3d1 100644 --- a/erts/etc/win32/cygwin_tools/mingw/coffix.c +++ b/erts/etc/win32/cygwin_tools/mingw/coffix.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/mingw/emu_cc.sh b/erts/etc/win32/cygwin_tools/mingw/emu_cc.sh index 8da91dd0ef..5f510467fe 100755 --- a/erts/etc/win32/cygwin_tools/mingw/emu_cc.sh +++ b/erts/etc/win32/cygwin_tools/mingw/emu_cc.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# Copyright Ericsson AB 2006-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/mingw/ld.sh b/erts/etc/win32/cygwin_tools/mingw/ld.sh index 16caf0b6d2..8b7e1a54c4 100755 --- a/erts/etc/win32/cygwin_tools/mingw/ld.sh +++ b/erts/etc/win32/cygwin_tools/mingw/ld.sh @@ -3,7 +3,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# Copyright Ericsson AB 2006-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/mingw/mc.sh b/erts/etc/win32/cygwin_tools/mingw/mc.sh index 4462bfc5d3..8228f8699e 100755 --- a/erts/etc/win32/cygwin_tools/mingw/mc.sh +++ b/erts/etc/win32/cygwin_tools/mingw/mc.sh @@ -3,7 +3,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# Copyright Ericsson AB 2006-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/mingw/rc.sh b/erts/etc/win32/cygwin_tools/mingw/rc.sh index b8a2d2fbcf..de1b15a432 100755 --- a/erts/etc/win32/cygwin_tools/mingw/rc.sh +++ b/erts/etc/win32/cygwin_tools/mingw/rc.sh @@ -3,7 +3,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# Copyright Ericsson AB 2006-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/vc/ar.sh b/erts/etc/win32/cygwin_tools/vc/ar.sh index e0bd1bd5ca..0989cc878b 100755 --- a/erts/etc/win32/cygwin_tools/vc/ar.sh +++ b/erts/etc/win32/cygwin_tools/vc/ar.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/vc/cc.sh b/erts/etc/win32/cygwin_tools/vc/cc.sh index 651b6e098d..9eeb004f0e 100755 --- a/erts/etc/win32/cygwin_tools/vc/cc.sh +++ b/erts/etc/win32/cygwin_tools/vc/cc.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/vc/cc_wrap.c b/erts/etc/win32/cygwin_tools/vc/cc_wrap.c index b42e0e1037..198f3b5649 100644 --- a/erts/etc/win32/cygwin_tools/vc/cc_wrap.c +++ b/erts/etc/win32/cygwin_tools/vc/cc_wrap.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/vc/coffix.c b/erts/etc/win32/cygwin_tools/vc/coffix.c index 0633c6ddea..bf1096c425 100644 --- a/erts/etc/win32/cygwin_tools/vc/coffix.c +++ b/erts/etc/win32/cygwin_tools/vc/coffix.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/vc/emu_cc.sh b/erts/etc/win32/cygwin_tools/vc/emu_cc.sh index fb6ee2d7a2..343cd366a6 100755 --- a/erts/etc/win32/cygwin_tools/vc/emu_cc.sh +++ b/erts/etc/win32/cygwin_tools/vc/emu_cc.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2011. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/vc/ld.sh b/erts/etc/win32/cygwin_tools/vc/ld.sh index ff538122b2..2b7d7c6694 100755 --- a/erts/etc/win32/cygwin_tools/vc/ld.sh +++ b/erts/etc/win32/cygwin_tools/vc/ld.sh @@ -3,7 +3,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2010. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/vc/ld_wrap.c b/erts/etc/win32/cygwin_tools/vc/ld_wrap.c index 000c13befd..94b5c38751 100644 --- a/erts/etc/win32/cygwin_tools/vc/ld_wrap.c +++ b/erts/etc/win32/cygwin_tools/vc/ld_wrap.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/vc/mc.sh b/erts/etc/win32/cygwin_tools/vc/mc.sh index 2de5cbba9b..c88f2ff1a7 100755 --- a/erts/etc/win32/cygwin_tools/vc/mc.sh +++ b/erts/etc/win32/cygwin_tools/vc/mc.sh @@ -3,7 +3,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/cygwin_tools/vc/rc.sh b/erts/etc/win32/cygwin_tools/vc/rc.sh index 414ffa0448..286ebb03f0 100755 --- a/erts/etc/win32/cygwin_tools/vc/rc.sh +++ b/erts/etc/win32/cygwin_tools/vc/rc.sh @@ -3,7 +3,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2010. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/erl.c b/erts/etc/win32/erl.c index 59693955a5..b230aa6a40 100644 --- a/erts/etc/win32/erl.c +++ b/erts/etc/win32/erl.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/erl.rc b/erts/etc/win32/erl.rc index e8848e7969..772213ac86 100644 --- a/erts/etc/win32/erl.rc +++ b/erts/etc/win32/erl.rc @@ -1,7 +1,7 @@ // // %CopyrightBegin% // -// Copyright Ericsson AB 1998-2009. All Rights Reserved. +// Copyright Ericsson AB 1998-2016. All Rights Reserved. // // Licensed under the Apache License, Version 2.0 (the "License"); // you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/erl_log.c b/erts/etc/win32/erl_log.c index 2a873dffac..de0d8e39f0 100644 --- a/erts/etc/win32/erl_log.c +++ b/erts/etc/win32/erl_log.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * Copyright Ericsson AB 1996-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/erlsrv/erlsrv_global.h b/erts/etc/win32/erlsrv/erlsrv_global.h index f535599cf1..fc6166fc7c 100644 --- a/erts/etc/win32/erlsrv/erlsrv_global.h +++ b/erts/etc/win32/erlsrv/erlsrv_global.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/erlsrv/erlsrv_interactive.c b/erts/etc/win32/erlsrv/erlsrv_interactive.c index d2236ac9f7..c616ef86e3 100644 --- a/erts/etc/win32/erlsrv/erlsrv_interactive.c +++ b/erts/etc/win32/erlsrv/erlsrv_interactive.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2013. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/erlsrv/erlsrv_interactive.h b/erts/etc/win32/erlsrv/erlsrv_interactive.h index a83f5a4b85..03cf4b3339 100644 --- a/erts/etc/win32/erlsrv/erlsrv_interactive.h +++ b/erts/etc/win32/erlsrv/erlsrv_interactive.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2011. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/erlsrv/erlsrv_main.c b/erts/etc/win32/erlsrv/erlsrv_main.c index caca18de00..521e7687f4 100644 --- a/erts/etc/win32/erlsrv/erlsrv_main.c +++ b/erts/etc/win32/erlsrv/erlsrv_main.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/erlsrv/erlsrv_registry.c b/erts/etc/win32/erlsrv/erlsrv_registry.c index f95f4ef074..eb2a8c567c 100644 --- a/erts/etc/win32/erlsrv/erlsrv_registry.c +++ b/erts/etc/win32/erlsrv/erlsrv_registry.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/erlsrv/erlsrv_registry.h b/erts/etc/win32/erlsrv/erlsrv_registry.h index 3aa265686a..885d021497 100644 --- a/erts/etc/win32/erlsrv/erlsrv_registry.h +++ b/erts/etc/win32/erlsrv/erlsrv_registry.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/erlsrv/erlsrv_service.c b/erts/etc/win32/erlsrv/erlsrv_service.c index d9fa165355..f5d5c0b174 100644 --- a/erts/etc/win32/erlsrv/erlsrv_service.c +++ b/erts/etc/win32/erlsrv/erlsrv_service.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2013. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/erlsrv/erlsrv_service.h b/erts/etc/win32/erlsrv/erlsrv_service.h index c87292325c..4e1148cac2 100644 --- a/erts/etc/win32/erlsrv/erlsrv_service.h +++ b/erts/etc/win32/erlsrv/erlsrv_service.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/erlsrv/erlsrv_util.c b/erts/etc/win32/erlsrv/erlsrv_util.c index 800395ff12..f719082d37 100644 --- a/erts/etc/win32/erlsrv/erlsrv_util.c +++ b/erts/etc/win32/erlsrv/erlsrv_util.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/erlsrv/erlsrv_util.h b/erts/etc/win32/erlsrv/erlsrv_util.h index 1afcd1dd7e..97cc91834f 100644 --- a/erts/etc/win32/erlsrv/erlsrv_util.h +++ b/erts/etc/win32/erlsrv/erlsrv_util.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/init_file.c b/erts/etc/win32/init_file.c index 93d82b1823..147e299798 100644 --- a/erts/etc/win32/init_file.c +++ b/erts/etc/win32/init_file.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/init_file.h b/erts/etc/win32/init_file.h index 404b5fd03b..df33d23a35 100644 --- a/erts/etc/win32/init_file.h +++ b/erts/etc/win32/init_file.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * Copyright Ericsson AB 2003-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/msys_tools/erl b/erts/etc/win32/msys_tools/erl index 110d48c769..a2fe924e78 100644 --- a/erts/etc/win32/msys_tools/erl +++ b/erts/etc/win32/msys_tools/erl @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2011. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/msys_tools/erlc b/erts/etc/win32/msys_tools/erlc index b50090b6de..45d466743e 100644 --- a/erts/etc/win32/msys_tools/erlc +++ b/erts/etc/win32/msys_tools/erlc @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2011. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/msys_tools/javac.sh b/erts/etc/win32/msys_tools/javac.sh index 5b51648a19..6a8b245601 100644 --- a/erts/etc/win32/msys_tools/javac.sh +++ b/erts/etc/win32/msys_tools/javac.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2011. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/msys_tools/make_bootstrap_ini.sh b/erts/etc/win32/msys_tools/make_bootstrap_ini.sh index 1797f67c78..59fc6fc09a 100644 --- a/erts/etc/win32/msys_tools/make_bootstrap_ini.sh +++ b/erts/etc/win32/msys_tools/make_bootstrap_ini.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2011. All Rights Reserved. +# Copyright Ericsson AB 2003-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/msys_tools/make_local_ini.sh b/erts/etc/win32/msys_tools/make_local_ini.sh index 11f722e7f8..046b3e9d00 100644 --- a/erts/etc/win32/msys_tools/make_local_ini.sh +++ b/erts/etc/win32/msys_tools/make_local_ini.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2011. All Rights Reserved. +# Copyright Ericsson AB 2003-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/msys_tools/vc/ar.sh b/erts/etc/win32/msys_tools/vc/ar.sh index 4c98e3cc29..a33c954c0f 100644 --- a/erts/etc/win32/msys_tools/vc/ar.sh +++ b/erts/etc/win32/msys_tools/vc/ar.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2011. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/msys_tools/vc/cc.sh b/erts/etc/win32/msys_tools/vc/cc.sh index 72005862ed..2b0482e876 100644 --- a/erts/etc/win32/msys_tools/vc/cc.sh +++ b/erts/etc/win32/msys_tools/vc/cc.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2011. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/msys_tools/vc/coffix.c b/erts/etc/win32/msys_tools/vc/coffix.c index 4f21cfc389..bf1096c425 100644 --- a/erts/etc/win32/msys_tools/vc/coffix.c +++ b/erts/etc/win32/msys_tools/vc/coffix.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2011. All Rights Reserved. + * Copyright Ericsson AB 1999-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/msys_tools/vc/emu_cc.sh b/erts/etc/win32/msys_tools/vc/emu_cc.sh index 10d59214ea..2de3a07aca 100644 --- a/erts/etc/win32/msys_tools/vc/emu_cc.sh +++ b/erts/etc/win32/msys_tools/vc/emu_cc.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2011. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/msys_tools/vc/ld.sh b/erts/etc/win32/msys_tools/vc/ld.sh index 11b2fc077b..8917251f51 100644 --- a/erts/etc/win32/msys_tools/vc/ld.sh +++ b/erts/etc/win32/msys_tools/vc/ld.sh @@ -3,7 +3,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2011. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/msys_tools/vc/mc.sh b/erts/etc/win32/msys_tools/vc/mc.sh index 14b5ebaa8f..a074a1a89f 100644 --- a/erts/etc/win32/msys_tools/vc/mc.sh +++ b/erts/etc/win32/msys_tools/vc/mc.sh @@ -3,7 +3,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2011. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/msys_tools/vc/rc.sh b/erts/etc/win32/msys_tools/vc/rc.sh index 1f8ade17cb..3d1186ca91 100644 --- a/erts/etc/win32/msys_tools/vc/rc.sh +++ b/erts/etc/win32/msys_tools/vc/rc.sh @@ -3,7 +3,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2011. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/nsis/Makefile b/erts/etc/win32/nsis/Makefile index 64f44ff86d..0b4e0d0359 100644 --- a/erts/etc/win32/nsis/Makefile +++ b/erts/etc/win32/nsis/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2012. All Rights Reserved. +# Copyright Ericsson AB 2003-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/nsis/dll_version_helper.sh b/erts/etc/win32/nsis/dll_version_helper.sh index 86e36f62c9..9eafb6ce0e 100755 --- a/erts/etc/win32/nsis/dll_version_helper.sh +++ b/erts/etc/win32/nsis/dll_version_helper.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2007-2013. All Rights Reserved. +# Copyright Ericsson AB 2007-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/nsis/erlang20.nsi b/erts/etc/win32/nsis/erlang20.nsi index bf6ba0b9a6..66746b684d 100644 --- a/erts/etc/win32/nsis/erlang20.nsi +++ b/erts/etc/win32/nsis/erlang20.nsi @@ -7,7 +7,7 @@ ;
; %CopyrightBegin%
;
-; Copyright Ericsson AB 2012. All Rights Reserved.
+; Copyright Ericsson AB 2012-2016. All Rights Reserved.
;
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
diff --git a/erts/etc/win32/nsis/find_redist.sh b/erts/etc/win32/nsis/find_redist.sh index 03e92b21c7..c070ad469a 100755 --- a/erts/etc/win32/nsis/find_redist.sh +++ b/erts/etc/win32/nsis/find_redist.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2007-2011. All Rights Reserved. +# Copyright Ericsson AB 2007-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/port_entry.c b/erts/etc/win32/port_entry.c index 5681a2a548..8b1d3a44b8 100644 --- a/erts/etc/win32/port_entry.c +++ b/erts/etc/win32/port_entry.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2012. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/resource.h b/erts/etc/win32/resource.h index 32d8b8885d..e59baadb50 100644 --- a/erts/etc/win32/resource.h +++ b/erts/etc/win32/resource.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/start_erl.c b/erts/etc/win32/start_erl.c index a4437c2f6b..07bcd19b81 100644 --- a/erts/etc/win32/start_erl.c +++ b/erts/etc/win32/start_erl.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2012. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/etc/win32/win_erlexec.c b/erts/etc/win32/win_erlexec.c index f2460197e6..39dac358e9 100644 --- a/erts/etc/win32/win_erlexec.c +++ b/erts/etc/win32/win_erlexec.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2011. All Rights Reserved. + * Copyright Ericsson AB 1997-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/example/Makefile b/erts/example/Makefile index cc5bcce191..f00321ac45 100644 --- a/erts/example/Makefile +++ b/erts/example/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# Copyright Ericsson AB 2006-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/example/matrix_nif.c b/erts/example/matrix_nif.c index dfe446e879..6452084eb7 100644 --- a/erts/example/matrix_nif.c +++ b/erts/example/matrix_nif.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2011. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/example/matrix_nif.erl b/erts/example/matrix_nif.erl index d56b358247..bdc7228ac0 100644 --- a/erts/example/matrix_nif.erl +++ b/erts/example/matrix_nif.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010. All Rights Reserved. +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/example/next_perm.cc b/erts/example/next_perm.cc index c7b7096e7b..882af4cd1e 100644 --- a/erts/example/next_perm.cc +++ b/erts/example/next_perm.cc @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2011. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/example/next_perm.erl b/erts/example/next_perm.erl index d414470f3a..b6f47b975c 100644 --- a/erts/example/next_perm.erl +++ b/erts/example/next_perm.erl @@ -1,7 +1,7 @@ %%
%% %CopyrightBegin%
%% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/example/pg_async.c b/erts/example/pg_async.c index cd6bc9e0c2..3167ce5227 100644 --- a/erts/example/pg_async.c +++ b/erts/example/pg_async.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/example/pg_async.erl b/erts/example/pg_async.erl index 20ee94f61a..d34d03cf09 100644 --- a/erts/example/pg_async.erl +++ b/erts/example/pg_async.erl @@ -1,7 +1,7 @@ %%
%% %CopyrightBegin%
%% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/example/pg_async2.c b/erts/example/pg_async2.c index 9eb3ec9d54..ee772f4447 100644 --- a/erts/example/pg_async2.c +++ b/erts/example/pg_async2.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/example/pg_async2.erl b/erts/example/pg_async2.erl index 082852f617..9398f4ccbe 100644 --- a/erts/example/pg_async2.erl +++ b/erts/example/pg_async2.erl @@ -1,7 +1,7 @@ %%
%% %CopyrightBegin%
%% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/example/pg_encode.c b/erts/example/pg_encode.c index e1ec4abb1d..1efc4c1eaf 100644 --- a/erts/example/pg_encode.c +++ b/erts/example/pg_encode.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/example/pg_encode.h b/erts/example/pg_encode.h index df3f8fcaaa..213e20198e 100644 --- a/erts/example/pg_encode.h +++ b/erts/example/pg_encode.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/example/pg_encode2.c b/erts/example/pg_encode2.c index cdf8e71e44..df5ec9771b 100644 --- a/erts/example/pg_encode2.c +++ b/erts/example/pg_encode2.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/example/pg_encode2.h b/erts/example/pg_encode2.h index df3f8fcaaa..213e20198e 100644 --- a/erts/example/pg_encode2.h +++ b/erts/example/pg_encode2.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/example/pg_sync.c b/erts/example/pg_sync.c index 88096671a5..81b99f98d3 100644 --- a/erts/example/pg_sync.c +++ b/erts/example/pg_sync.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/example/pg_sync.erl b/erts/example/pg_sync.erl index 76fb27332e..29a975727a 100644 --- a/erts/example/pg_sync.erl +++ b/erts/example/pg_sync.erl @@ -1,7 +1,7 @@ %%
%% %CopyrightBegin%
%% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/include/erl_fixed_size_int_types.h b/erts/include/erl_fixed_size_int_types.h index dfaea5650b..9f47bdd797 100644 --- a/erts/include/erl_fixed_size_int_types.h +++ b/erts/include/erl_fixed_size_int_types.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/erl_int_sizes_config.h.in b/erts/include/erl_int_sizes_config.h.in index b18f5ebc00..e0e60f0e2f 100644 --- a/erts/include/erl_int_sizes_config.h.in +++ b/erts/include/erl_int_sizes_config.h.in @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -35,6 +35,3 @@ /* The size of a pointer. */ #undef SIZEOF_VOID_P - -/* Define if building a halfword-heap 64bit emulator (needed for NIF's) */ -#undef HALFWORD_HEAP_EMULATOR diff --git a/erts/include/erl_memory_trace_parser.h b/erts/include/erl_memory_trace_parser.h index 426ff05061..3170ebc0d0 100644 --- a/erts/include/erl_memory_trace_parser.h +++ b/erts/include/erl_memory_trace_parser.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/erl_native_features_config.h.in b/erts/include/erl_native_features_config.h.in index 2bd1d96229..59a5dde09e 100644 --- a/erts/include/erl_native_features_config.h.in +++ b/erts/include/erl_native_features_config.h.in @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/README b/erts/include/internal/README index fca0c5e489..a79b241556 100644 --- a/erts/include/internal/README +++ b/erts/include/internal/README @@ -1,7 +1,7 @@ %CopyrightBegin% - Copyright Ericsson AB 2004-2009. All Rights Reserved. + Copyright Ericsson AB 2004-2016. All Rights Reserved. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. diff --git a/erts/include/internal/erl_errno.h b/erts/include/internal/erl_errno.h index 33bfbe3d51..1ae045805e 100644 --- a/erts/include/internal/erl_errno.h +++ b/erts/include/internal/erl_errno.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/erl_memory_trace_protocol.h b/erts/include/internal/erl_memory_trace_protocol.h index b86e2de278..d3e0bcc1f4 100644 --- a/erts/include/internal/erl_memory_trace_protocol.h +++ b/erts/include/internal/erl_memory_trace_protocol.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/erl_misc_utils.h b/erts/include/internal/erl_misc_utils.h index 7ab7a26838..a4a5d1d510 100644 --- a/erts/include/internal/erl_misc_utils.h +++ b/erts/include/internal/erl_misc_utils.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2010. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/erl_printf.h b/erts/include/internal/erl_printf.h index 3846828fb9..c4565dfafc 100644 --- a/erts/include/internal/erl_printf.h +++ b/erts/include/internal/erl_printf.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/erl_printf_format.h b/erts/include/internal/erl_printf_format.h index efd926be99..4f969bdbcb 100644 --- a/erts/include/internal/erl_printf_format.h +++ b/erts/include/internal/erl_printf_format.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2013. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -44,7 +44,6 @@ typedef long long ErlPfSWord; #error Found no appropriate type to use for 'Eterm', 'Uint' and 'Sint' #endif - typedef int (*fmtfn_t)(void*, char*, size_t); extern int erts_printf_format(fmtfn_t, void*, char*, va_list); @@ -57,17 +56,9 @@ extern int erts_printf_uword(fmtfn_t, void*, char, int, int, ErlPfUWord); extern int erts_printf_sword(fmtfn_t, void*, char, int, int, ErlPfSWord); extern int erts_printf_double(fmtfn_t, void *, char, int, int, double); -#ifdef HALFWORD_HEAP_EMULATOR -# if SIZEOF_INT != 4 -# error Unsupported integer size for HALFWORD_HEAP_EMULATOR -# endif -typedef unsigned int ErlPfEterm; -#else typedef ErlPfUWord ErlPfEterm; -#endif - -extern int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long, ErlPfEterm*); +extern int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long); #endif /* ERL_PRINTF_FORMAT_H__ */ diff --git a/erts/include/internal/erts_internal.mk.in b/erts/include/internal/erts_internal.mk.in index 76aab59c38..8faa33135e 100644 --- a/erts/include/internal/erts_internal.mk.in +++ b/erts/include/internal/erts_internal.mk.in @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2009. All Rights Reserved. +# Copyright Ericsson AB 2009-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/include/internal/ethr_atomics.h b/erts/include/internal/ethr_atomics.h index f366c2d0ad..06568201ad 100644 --- a/erts/include/internal/ethr_atomics.h +++ b/erts/include/internal/ethr_atomics.h @@ -10,7 +10,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011-2012. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/ethr_internal.h b/erts/include/internal/ethr_internal.h index d4ded6ff05..6657c8affc 100644 --- a/erts/include/internal/ethr_internal.h +++ b/erts/include/internal/ethr_internal.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2011. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -92,7 +92,6 @@ void ethr_run_exit_handlers__(void); void ethr_ts_event_destructor__(void *vtsep); #if defined(ETHR_X86_RUNTIME_CONF__) -int ethr_x86_have_cpuid__(void); void ethr_x86_cpuid__(int *eax, int *ebx, int *ecx, int *edx); #endif diff --git a/erts/include/internal/ethr_mutex.h b/erts/include/internal/ethr_mutex.h index f76c4262ca..a510a2c97f 100644 --- a/erts/include/internal/ethr_mutex.h +++ b/erts/include/internal/ethr_mutex.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2011. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -98,7 +98,7 @@ void LeaveCriticalSection(CRITICAL_SECTION *); #if 0 # define ETHR_MTX_Q_LOCK_SPINLOCK__ # define ETHR_MTX_QLOCK_TYPE__ ethr_spinlock_t -#elif defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS) +#elif defined(ETHR_PTHREADS) # define ETHR_MTX_Q_LOCK_PTHREAD_MUTEX__ # define ETHR_MTX_QLOCK_TYPE__ pthread_mutex_t #elif defined(ETHR_WIN32_THREADS) @@ -211,7 +211,7 @@ struct ethr_cond_ { #endif }; -#elif (defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) +#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) typedef struct ethr_mutex_ ethr_mutex; struct ethr_mutex_ { @@ -355,7 +355,7 @@ void ethr_rwmutex_rwunlock(ethr_rwmutex *); #ifdef ETHR_MTX_HARD_DEBUG #define ETHR_MTX_HARD_ASSERT(A) \ - ((void) ((A) ? 1 : ethr_assert_failed(__FILE__, __LINE__, __func__,#A))) + ((void) ((A) ? 1 : ethr_assert_failed(__FILE__, __LINE__, __func__, #A))) #else #define ETHR_MTX_HARD_ASSERT(A) ((void) 1) #endif @@ -634,7 +634,7 @@ ETHR_INLINE_MTX_FUNC_NAME_(ethr_mutex_unlock)(ethr_mutex *mtx) #endif /* ETHR_TRY_INLINE_FUNCS */ -#elif (defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) +#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) #if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_MUTEX_IMPL__) diff --git a/erts/include/internal/ethr_optimized_fallbacks.h b/erts/include/internal/ethr_optimized_fallbacks.h index 6ef4e2bace..8c27a9ba5b 100644 --- a/erts/include/internal/ethr_optimized_fallbacks.h +++ b/erts/include/internal/ethr_optimized_fallbacks.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2011. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h index 8964f95652..b23644d361 100644 --- a/erts/include/internal/ethread.h +++ b/erts/include/internal/ethread.h @@ -112,6 +112,10 @@ int ethr_assert_failed(const char *file, int line, const char *func, char *a); #error "_GNU_SOURCE not defined. Please, compile all files with -D_GNU_SOURCE." #endif +#ifdef ETHR_HAVE_PTHREAD_SETNAME_NP_1 +#define _DARWIN_C_SOURCE +#endif + #if defined(ETHR_NEED_NPTL_PTHREAD_H) #include <nptl/pthread.h> #elif defined(ETHR_HAVE_MIT_PTHREAD_H) @@ -194,28 +198,6 @@ typedef DWORD ethr_tsd_key; #define ETHR_YIELD() (Sleep(0), 0) -#elif defined(ETHR_OSE_THREADS) - -#include "ose.h" -#undef NIL - -#if defined(ETHR_HAVE_PTHREAD_H) -#include <pthread.h> -#endif - -typedef struct { - PROCESS id; - unsigned int tsd_key_index; - void *res; -} ethr_tid; - -typedef OSPPDKEY ethr_tsd_key; - -#undef ETHR_HAVE_ETHR_SIG_FUNCS - -/* Out own RW mutexes are probably faster, but use OSEs mutexes */ -#define ETHR_USE_OWN_RWMTX_IMPL__ - #else /* No supported thread lib found */ #ifdef ETHR_NO_SUPP_THR_LIB_NOT_FATAL @@ -296,14 +278,40 @@ ETHR_PROTO_NORETURN__ ethr_fatal_error__(const char *file, || (defined(_MSC_VER) && (defined(_M_IX86) || defined(_M_AMD64)))) # define ETHR_X86_RUNTIME_CONF__ -# define ETHR_X86_RUNTIME_CONF_HAVE_DW_CMPXCHG__ \ - (__builtin_expect(ethr_runtime__.conf.have_dw_cmpxchg != 0, 1)) -# define ETHR_X86_RUNTIME_CONF_HAVE_NO_DW_CMPXCHG__ \ - (__builtin_expect(ethr_runtime__.conf.have_dw_cmpxchg == 0, 0)) -# define ETHR_X86_RUNTIME_CONF_HAVE_SSE2__ \ - (__builtin_expect(ethr_runtime__.conf.have_sse2 != 0, 1)) -# define ETHR_X86_RUNTIME_CONF_HAVE_NO_SSE2__ \ - (__builtin_expect(ethr_runtime__.conf.have_sse2 == 0, 0)) +# define ETHR_X86_RUNTIME_CONF_HAVE_META(feature) \ + (__builtin_expect(ethr_runtime__.conf.have_##feature != 0, 1)) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_META(feature) \ + (__builtin_expect(ethr_runtime__.conf.have_##feature == 0, 0)) + +# define ETHR_X86_RUNTIME_CONF_HAVE_DW_CMPXCHG__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(dw_cmpxchg) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_DW_CMPXCHG__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(dw_cmpxchg) +# define ETHR_X86_RUNTIME_CONF_HAVE_SSE2__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(sse2) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_SSE2__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(sse2) +# define ETHR_X86_RUNTIME_CONF_HAVE_RDTSCP__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(rdtscp) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_RDTSCP__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(rdtscp) +# define ETHR_X86_RUNTIME_CONF_HAVE_CONSTANT_TSC__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(constant_tsc) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_CONSTANT_TSC__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(nonstop_tsc) +# define ETHR_X86_RUNTIME_CONF_HAVE_NONSTOP_TSC__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(nonstop_tsc) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_NONSTOP_TSC__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(nonstop_tsc) +# define ETHR_X86_RUNTIME_CONF_HAVE_TSC_RELIABLE__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(tsc_reliable) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_TSC_RELIABLE_TSC__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(tsc_reliable) +# define ETHR_X86_RUNTIME_CONF_HAVE_NONSTOP_TSC_S3__ \ + ETHR_X86_RUNTIME_CONF_HAVE_META(nonstop_tsc_s3) +# define ETHR_X86_RUNTIME_CONF_HAVE_NO_NONSTOP_TSC_S3__ \ + ETHR_X86_RUNTIME_CONF_HAVE_NO_META(nonstop_tsc_s3) + #endif #if (defined(__GNUC__) \ @@ -322,6 +330,11 @@ typedef struct { #if defined(ETHR_X86_RUNTIME_CONF__) int have_dw_cmpxchg; int have_sse2; + int have_rdtscp; + int have_constant_tsc; + int have_tsc_reliable; + int have_nonstop_tsc; + int have_nonstop_tsc_s3; #endif #if defined(ETHR_PPC_RUNTIME_CONF__) int have_lwsync; @@ -383,19 +396,7 @@ extern ethr_runtime_t ethr_runtime__; #include "ethr_atomics.h" /* The atomics API */ -#if defined (ETHR_OSE_THREADS) -static ETHR_INLINE void -ose_yield(void) -{ - if (get_ptype(current_process()) == OS_PRI_PROC) { - set_pri(get_pri(current_process())); - } else { - delay(1); - } -} -#endif - -#if defined(__GNUC__) && !defined(ETHR_OSE_THREADS) +#if defined(__GNUC__) # ifndef ETHR_SPIN_BODY # if defined(__i386__) || defined(__x86_64__) # define ETHR_SPIN_BODY __asm__ __volatile__("rep;nop" : : : "memory") @@ -411,20 +412,9 @@ ose_yield(void) # ifndef ETHR_SPIN_BODY # define ETHR_SPIN_BODY do {YieldProcessor();ETHR_COMPILER_BARRIER;} while(0) # endif -#elif defined(ETHR_OSE_THREADS) -# ifndef ETHR_SPIN_BODY -# define ETHR_SPIN_BODY ose_yield() -# else -# error "OSE should use ose_yield()" -# endif #endif -#ifndef ETHR_OSE_THREADS #define ETHR_YIELD_AFTER_BUSY_LOOPS 50 -#else -#define ETHR_YIELD_AFTER_BUSY_LOOPS 0 -#endif - #ifndef ETHR_SPIN_BODY # define ETHR_SPIN_BODY ETHR_COMPILER_BARRIER @@ -447,18 +437,13 @@ ose_yield(void) # else # define ETHR_YIELD() (pthread_yield(), 0) # endif -# elif defined(ETHR_OSE_THREADS) -# define ETHR_YIELD() (ose_yield(), 0) # else # define ETHR_YIELD() (ethr_compiler_barrier(), 0) # endif #endif -#if defined(VALGRIND) || defined(ETHR_OSE_THREADS) -/* mutex as fallback for spinlock for VALGRIND and OSE. - OSE cannot use spinlocks as processes working on the - same execution unit have a tendency to deadlock. - */ +#if defined(VALGRIND) +/* mutex as fallback for spinlock for VALGRIND. */ # undef ETHR_HAVE_NATIVE_SPINLOCKS # undef ETHR_HAVE_NATIVE_RWSPINLOCKS #else @@ -505,16 +490,9 @@ 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 - U32 coreNo; -#endif } ethr_thr_opts; -#if defined(ETHR_OSE_THREADS) -#define ETHR_THR_OPTS_DEFAULT_INITER {0, -1, NULL, 0} -#else #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__ @@ -628,8 +606,6 @@ typedef struct ethr_ts_event_ ethr_ts_event; /* Needed by ethr_mutex.h */ # include "win/ethr_event.h" #elif defined(ETHR_PTHREADS) # include "pthread/ethr_event.h" -#elif defined(ETHR_OSE_THREADS) -# include "ose/ethr_event.h" #endif int ethr_set_main_thr_status(int, int); @@ -719,37 +695,6 @@ ETHR_INLINE_FUNC_NAME_(ethr_leave_ts_event)(ethr_ts_event *tsep) #endif -#elif defined (ETHR_OSE_THREADS) - -#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHREAD_IMPL__) - -extern ethr_tsd_key ethr_ts_event_key__; - -static ETHR_INLINE ethr_ts_event * -ETHR_INLINE_FUNC_NAME_(ethr_get_ts_event)(void) -{ - ethr_ts_event *tsep = *(ethr_ts_event**)ose_get_ppdata(ethr_ts_event_key__); - if (!tsep) { - int res = ethr_get_tmp_ts_event__(&tsep); - if (res != 0) - ETHR_FATAL_ERROR__(res); - ETHR_ASSERT(tsep); - } - return tsep; -} - -static ETHR_INLINE void -ETHR_INLINE_FUNC_NAME_(ethr_leave_ts_event)(ethr_ts_event *tsep) -{ - if (tsep->iflgs & ETHR_TS_EV_TMP) { - int res = ethr_free_ts_event__(tsep); - if (res != 0) - ETHR_FATAL_ERROR__(res); - } -} - -#endif - #endif #include "ethr_mutex.h" /* Need atomic declarations and tse */ diff --git a/erts/include/internal/ethread.mk.in b/erts/include/internal/ethread.mk.in index 89924a3215..486a7a9401 100644 --- a/erts/include/internal/ethread.mk.in +++ b/erts/include/internal/ethread.mk.in @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2009. All Rights Reserved. +# Copyright Ericsson AB 2004-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/include/internal/ethread_header_config.h.in b/erts/include/internal/ethread_header_config.h.in index f4b08cfced..6309f10439 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-2015. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/ethread_inline.h b/erts/include/internal/ethread_inline.h index 3ba910d993..8e6bcfc4a8 100644 --- a/erts/include/internal/ethread_inline.h +++ b/erts/include/internal/ethread_inline.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2014. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/i386/atomic.h b/erts/include/internal/i386/atomic.h index 6a6435e58d..52ef1762d5 100644 --- a/erts/include/internal/i386/atomic.h +++ b/erts/include/internal/i386/atomic.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/i386/ethr_dw_atomic.h b/erts/include/internal/i386/ethr_dw_atomic.h index 5444a6345c..91acdb0483 100644 --- a/erts/include/internal/i386/ethr_dw_atomic.h +++ b/erts/include/internal/i386/ethr_dw_atomic.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/i386/ethr_membar.h b/erts/include/internal/i386/ethr_membar.h index 97ae5eda2c..d1b72cd538 100644 --- a/erts/include/internal/i386/ethr_membar.h +++ b/erts/include/internal/i386/ethr_membar.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/i386/ethread.h b/erts/include/internal/i386/ethread.h index 23dcd1dc19..fef1674c7e 100644 --- a/erts/include/internal/i386/ethread.h +++ b/erts/include/internal/i386/ethread.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/i386/rwlock.h b/erts/include/internal/i386/rwlock.h index 9859338eab..8d22bac7e9 100644 --- a/erts/include/internal/i386/rwlock.h +++ b/erts/include/internal/i386/rwlock.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/i386/spinlock.h b/erts/include/internal/i386/spinlock.h index e010684d14..1a8e359981 100644 --- a/erts/include/internal/i386/spinlock.h +++ b/erts/include/internal/i386/spinlock.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/libatomic_ops/ethr_atomic.h b/erts/include/internal/libatomic_ops/ethr_atomic.h index 828210036c..da3b15a878 100644 --- a/erts/include/internal/libatomic_ops/ethr_atomic.h +++ b/erts/include/internal/libatomic_ops/ethr_atomic.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2014. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/libatomic_ops/ethr_dw_atomic.h b/erts/include/internal/libatomic_ops/ethr_dw_atomic.h index ce9b251cbe..8643600fa5 100644 --- a/erts/include/internal/libatomic_ops/ethr_dw_atomic.h +++ b/erts/include/internal/libatomic_ops/ethr_dw_atomic.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2014. All Rights Reserved. + * Copyright Ericsson AB 2014-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/libatomic_ops/ethr_membar.h b/erts/include/internal/libatomic_ops/ethr_membar.h index 7d2b807586..1d3d332c90 100644 --- a/erts/include/internal/libatomic_ops/ethr_membar.h +++ b/erts/include/internal/libatomic_ops/ethr_membar.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/libatomic_ops/ethread.h b/erts/include/internal/libatomic_ops/ethread.h index e34f43bb46..4adc31ed2a 100644 --- a/erts/include/internal/libatomic_ops/ethread.h +++ b/erts/include/internal/libatomic_ops/ethread.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2011. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/ose/ethr_event.h b/erts/include/internal/ose/ethr_event.h deleted file mode 100644 index c18f30aa4a..0000000000 --- a/erts/include/internal/ose/ethr_event.h +++ /dev/null @@ -1,114 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2009-2011. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * Author: Rickard Green - */ - -//#define USE_PTHREAD_API - -#define ETHR_EVENT_OFF_WAITER__ -1L -#define ETHR_EVENT_OFF__ 1L -#define ETHR_EVENT_ON__ 0L - -#ifdef USE_PTHREAD_API - -typedef struct { - ethr_atomic32_t state; - pthread_mutex_t mtx; - pthread_cond_t cnd; -} ethr_event; - -#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_EVENT_IMPL__) - -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); - } -} - -static void ETHR_INLINE -ETHR_INLINE_FUNC_NAME_(ethr_event_reset)(ethr_event *e) -{ - ethr_atomic32_set(&e->state, ETHR_EVENT_OFF__); - ETHR_MEMORY_BARRIER; -} - -#endif - -#else - -typedef struct { - ethr_atomic32_t state; - PROCESS proc; -} ethr_event; - -#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_EVENT_IMPL__) - -static void ETHR_INLINE -ETHR_INLINE_FUNC_NAME_(ethr_event_set)(ethr_event *e) -{ - ethr_sint32_t val = ethr_atomic32_xchg_mb(&e->state, ETHR_EVENT_ON__); - if (val == ETHR_EVENT_OFF_WAITER__) { -#ifdef DEBUG - OSFSEMVAL fsem_val = get_fsem(e->proc); - - /* There is a race in this assert. - This is because the state is set before the wait call in wait__. - We hope that a delay of 10 ms is enough */ - if (fsem_val == 0) - delay(10); - ETHR_ASSERT(get_fsem(e->proc) == -1); -#endif - signal_fsem(e->proc); - } -} - -static void ETHR_INLINE -ETHR_INLINE_FUNC_NAME_(ethr_event_reset)(ethr_event *e) -{ - ethr_atomic32_set(&e->state, ETHR_EVENT_OFF__); - ETHR_MEMORY_BARRIER; -} - -#endif - -#endif - -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); -#if !defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_EVENT_IMPL__) -void ethr_event_set(ethr_event *e); -void ethr_event_reset(ethr_event *e); -#endif diff --git a/erts/include/internal/ppc32/atomic.h b/erts/include/internal/ppc32/atomic.h index 572b0e5191..198f057b3f 100644 --- a/erts/include/internal/ppc32/atomic.h +++ b/erts/include/internal/ppc32/atomic.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/ppc32/ethr_membar.h b/erts/include/internal/ppc32/ethr_membar.h index fe77721cd9..88ba4a2ea5 100644 --- a/erts/include/internal/ppc32/ethr_membar.h +++ b/erts/include/internal/ppc32/ethr_membar.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/ppc32/ethread.h b/erts/include/internal/ppc32/ethread.h index 25e85c58bd..bead019f41 100644 --- a/erts/include/internal/ppc32/ethread.h +++ b/erts/include/internal/ppc32/ethread.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/ppc32/rwlock.h b/erts/include/internal/ppc32/rwlock.h index aee232f79d..6493629e49 100644 --- a/erts/include/internal/ppc32/rwlock.h +++ b/erts/include/internal/ppc32/rwlock.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/ppc32/spinlock.h b/erts/include/internal/ppc32/spinlock.h index 829db6a135..3b35cafcb2 100644 --- a/erts/include/internal/ppc32/spinlock.h +++ b/erts/include/internal/ppc32/spinlock.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/pthread/ethr_event.h b/erts/include/internal/pthread/ethr_event.h index deb4b29686..6e470bf6cf 100644 --- a/erts/include/internal/pthread/ethr_event.h +++ b/erts/include/internal/pthread/ethr_event.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2011. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/sparc32/atomic.h b/erts/include/internal/sparc32/atomic.h index 0b535242ad..032943817d 100644 --- a/erts/include/internal/sparc32/atomic.h +++ b/erts/include/internal/sparc32/atomic.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/sparc32/ethr_membar.h b/erts/include/internal/sparc32/ethr_membar.h index 6133de5eb7..fb8ceef12b 100644 --- a/erts/include/internal/sparc32/ethr_membar.h +++ b/erts/include/internal/sparc32/ethr_membar.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/sparc32/ethread.h b/erts/include/internal/sparc32/ethread.h index 513d9f8773..8d49465008 100644 --- a/erts/include/internal/sparc32/ethread.h +++ b/erts/include/internal/sparc32/ethread.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/sparc32/rwlock.h b/erts/include/internal/sparc32/rwlock.h index 44de6113b7..1cc516cdad 100644 --- a/erts/include/internal/sparc32/rwlock.h +++ b/erts/include/internal/sparc32/rwlock.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/sparc32/spinlock.h b/erts/include/internal/sparc32/spinlock.h index 695fa112b6..ae3b1c9dee 100644 --- a/erts/include/internal/sparc32/spinlock.h +++ b/erts/include/internal/sparc32/spinlock.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/sparc64/ethread.h b/erts/include/internal/sparc64/ethread.h index 5f518e5596..6018e738b5 100644 --- a/erts/include/internal/sparc64/ethread.h +++ b/erts/include/internal/sparc64/ethread.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2007-2009. All Rights Reserved. + * Copyright Ericsson AB 2007-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/tile/atomic.h b/erts/include/internal/tile/atomic.h index 1a2881442e..7f5f83bcc7 100644 --- a/erts/include/internal/tile/atomic.h +++ b/erts/include/internal/tile/atomic.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2011. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/tile/ethr_membar.h b/erts/include/internal/tile/ethr_membar.h index ccb420d558..50ea2c0265 100644 --- a/erts/include/internal/tile/ethr_membar.h +++ b/erts/include/internal/tile/ethr_membar.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/tile/ethread.h b/erts/include/internal/tile/ethread.h index 577d275965..0d69673a1c 100644 --- a/erts/include/internal/tile/ethread.h +++ b/erts/include/internal/tile/ethread.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2011. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/win/ethr_atomic.h b/erts/include/internal/win/ethr_atomic.h index f17526a94d..32c28f692d 100644 --- a/erts/include/internal/win/ethr_atomic.h +++ b/erts/include/internal/win/ethr_atomic.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2011. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/win/ethr_dw_atomic.h b/erts/include/internal/win/ethr_dw_atomic.h index 8bed4fb26e..a6b26ab7bb 100644 --- a/erts/include/internal/win/ethr_dw_atomic.h +++ b/erts/include/internal/win/ethr_dw_atomic.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/win/ethr_event.h b/erts/include/internal/win/ethr_event.h index 458565b9ea..9ee78183ab 100644 --- a/erts/include/internal/win/ethr_event.h +++ b/erts/include/internal/win/ethr_event.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2011. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/win/ethr_membar.h b/erts/include/internal/win/ethr_membar.h index 9cba6b605d..c018f6d869 100644 --- a/erts/include/internal/win/ethr_membar.h +++ b/erts/include/internal/win/ethr_membar.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/win/ethread.h b/erts/include/internal/win/ethread.h index 2fda028825..773be08a9b 100644 --- a/erts/include/internal/win/ethread.h +++ b/erts/include/internal/win/ethread.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2011. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/include/internal/x86_64/ethread.h b/erts/include/internal/x86_64/ethread.h index 8887b8d77f..7fc5481629 100644 --- a/erts/include/internal/x86_64/ethread.h +++ b/erts/include/internal/x86_64/ethread.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/lib/internal/README b/erts/lib/internal/README index 9beba10bc2..9e5cab26d3 100644 --- a/erts/lib/internal/README +++ b/erts/lib/internal/README @@ -1,7 +1,7 @@ %CopyrightBegin% - Copyright Ericsson AB 2004-2009. All Rights Reserved. + Copyright Ericsson AB 2004-2016. All Rights Reserved. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. diff --git a/erts/lib_src/Makefile b/erts/lib_src/Makefile index 632b8a0b09..882a050ffd 100644 --- a/erts/lib_src/Makefile +++ b/erts/lib_src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2009. All Rights Reserved. +# Copyright Ericsson AB 2004-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/lib_src/Makefile.in b/erts/lib_src/Makefile.in index 74e32ccdce..6e2f236bdf 100644 --- a/erts/lib_src/Makefile.in +++ b/erts/lib_src/Makefile.in @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2013. All Rights Reserved. +# Copyright Ericsson AB 2004-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/lib_src/common/erl_memory_trace_parser.c b/erts/lib_src/common/erl_memory_trace_parser.c index a81068089e..0232708ad1 100644 --- a/erts/lib_src/common/erl_memory_trace_parser.c +++ b/erts/lib_src/common/erl_memory_trace_parser.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/lib_src/common/erl_misc_utils.c b/erts/lib_src/common/erl_misc_utils.c index 1262c50718..8186463b9c 100644 --- a/erts/lib_src/common/erl_misc_utils.c +++ b/erts/lib_src/common/erl_misc_utils.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2013. All Rights Reserved. + * Copyright Ericsson AB 2006-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -160,8 +160,6 @@ erts_milli_sleep(long ms) if (ms > 0) { #ifdef __WIN32__ Sleep((DWORD) ms); -#elif defined(__OSE__) - delay(ms); #else struct timeval tv; tv.tv_sec = ms / 1000; @@ -320,10 +318,6 @@ erts_cpu_info_update(erts_cpu_info_t *cpuinfo) online = 0; #endif } -#elif defined(__OSE__) - online = ose_num_cpus(); - configured = ose_num_cpus(); - available = ose_num_cpus(); #endif if (online > configured) diff --git a/erts/lib_src/common/erl_printf.c b/erts/lib_src/common/erl_printf.c index 387a104a7a..b5e90dfeef 100644 --- a/erts/lib_src/common/erl_printf.c +++ b/erts/lib_src/common/erl_printf.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2012. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/lib_src/common/erl_printf_format.c b/erts/lib_src/common/erl_printf_format.c index 307680505c..3daa066fd3 100644 --- a/erts/lib_src/common/erl_printf_format.c +++ b/erts/lib_src/common/erl_printf_format.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2013. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -78,15 +78,7 @@ #endif #ifndef ERTS_SIZEOF_ETERM -# ifdef HALFWORD_HEAP_EMULATOR -# if SIZEOF_VOID_P == 8 -# define ERTS_SIZEOF_ETERM 4 -# else -# error "HALFWORD_HEAP_EMULATOR only allowed on 64-bit architecture" -# endif -# else -# define ERTS_SIZEOF_ETERM SIZEOF_VOID_P -# endif +#define ERTS_SIZEOF_ETERM SIZEOF_VOID_P #endif #if defined(__GNUC__) @@ -102,7 +94,7 @@ #endif #define FMTC_d 0x0000 -#define FMTC_R 0x0001 +/*empty 0x0001 was RELATIVE */ #define FMTC_o 0x0002 #define FMTC_u 0x0003 #define FMTC_x 0x0004 @@ -166,7 +158,7 @@ static char heX[] = "0123456789ABCDEF"; #define SIGN(X) ((X) > 0 ? 1 : ((X) < 0 ? -1 : 0)) #define USIGN(X) ((X) == 0 ? 0 : 1) -int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long, ErlPfEterm*) = NULL; +int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long) = NULL; static int noop_fn(void *vfp, char* buf, size_t len) @@ -645,7 +637,6 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap) case 'p': ptr++; fmt |= FMTC_p; break; case 'n': ptr++; fmt |= FMTC_n; break; case 'T': ptr++; fmt |= FMTC_T; break; - case 'R': ptr++; fmt |= FMTC_R; break; case '%': FMT(fn,arg,ptr,1,count); ptr++; @@ -820,11 +811,9 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap) default: *va_arg(ap,int*) = count; break; } break; - case FMTC_T: /* Eterm */ - case FMTC_R: { /* Eterm, Eterm* base (base ignored if !HALFWORD_HEAP) */ + case FMTC_T: { /* Eterm */ long prec; ErlPfEterm eterm; - ErlPfEterm* eterm_base; if (!erts_printf_eterm_func) return -EINVAL; @@ -835,16 +824,14 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap) else prec = (long) precision; eterm = va_arg(ap, ErlPfEterm); - eterm_base = ((fmt & FMTC_MASK) == FMTC_R) ? - va_arg(ap, ErlPfEterm*) : NULL; if (width > 0 && !(fmt & FMTF_adj)) { - res = (*erts_printf_eterm_func)(noop_fn, NULL, eterm, prec, eterm_base); + res = (*erts_printf_eterm_func)(noop_fn, NULL, eterm, prec); if (res < 0) return res; if (width > res) BLANKS(fn, arg, width - res, count); } - res = (*erts_printf_eterm_func)(fn, arg, eterm, prec, eterm_base); + res = (*erts_printf_eterm_func)(fn, arg, eterm, prec); if (res < 0) return res; count += res; diff --git a/erts/lib_src/common/ethr_atomics.c b/erts/lib_src/common/ethr_atomics.c index 42c078377d..1594d78f5e 100644 --- a/erts/lib_src/common/ethr_atomics.c +++ b/erts/lib_src/common/ethr_atomics.c @@ -10,7 +10,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011-2012. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/lib_src/common/ethr_aux.c b/erts/lib_src/common/ethr_aux.c index 0cbb1b2fb8..420efd725f 100644 --- a/erts/lib_src/common/ethr_aux.c +++ b/erts/lib_src/common/ethr_aux.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2014. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -139,6 +139,38 @@ x86_init(void) #endif /* bit 26 of edx is set if we have sse2 */ ethr_runtime__.conf.have_sse2 = (edx & (1 << 26)); + + /* check if we have extended feature set */ + eax = 0x80000000; + ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx); + + if (eax < 0x80000001) + return; + + if (eax >= 0x80000007) { + /* Advanced Power Management Information */ + eax = 0x80000007; + ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx); + + /* I got the values below from: + http://lxr.free-electrons.com/source/arch/x86/include/asm/cpufeature.h + They can be gotten from the intel/amd manual as well. + */ + + ethr_runtime__.conf.have_constant_tsc = (edx & (1 << 8)); + ethr_runtime__.conf.have_tsc_reliable = (edx & (1 << 23)); + ethr_runtime__.conf.have_nonstop_tsc = (edx & (1 << 24)); + ethr_runtime__.conf.have_nonstop_tsc_s3 = (edx & (1 << 30)); + + } + + /* Extended Processor Info and Feature Bits */ + eax = 0x80000001; + ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx); + + /* bit 27 of edx is set if we have rdtscp */ + ethr_runtime__.conf.have_rdtscp = (edx & (1 << 27)); + } #endif /* ETHR_X86_RUNTIME_CONF__ */ @@ -207,18 +239,7 @@ ethr_init_common__(ethr_init_data *id) ethr_min_stack_size__ = ETHR_B2KW(ethr_min_stack_size__); -#ifdef __OSE__ - /* For supervisor processes, OSE adds a number of bytes to the requested stack. With this - * addition, the resulting size must not exceed the largest available stack size. The number - * of bytes that will be added is configured in the monolith and can therefore not be - * specified here. We simply assume that it is less than 0x1000. The available stack sizes - * are configured in the .lmconf file and the largest one is usually 65536 bytes. - * Consequently, the requested stack size is limited to 0xF000. - */ - ethr_max_stack_size__ = 0xF000; -#else ethr_max_stack_size__ = 32*1024*1024; -#endif #if SIZEOF_VOID_P == 8 ethr_max_stack_size__ *= 2; #endif @@ -664,10 +685,6 @@ ETHR_IMPL_NORETURN__ ethr_fatal_error__(const char *file, int ethr_assert_failed(const char *file, int line, const char *func, char *a) { fprintf(stderr, "%s:%d: %s(): Assertion failed: %s\n", file, line, func, a); -#ifdef __OSE__ - ramlog_printf("%d: %s:%d: %s(): Assertion failed: %s\n", - current_process(),file, line, func, a); -#endif ethr_abort__(); return 0; } diff --git a/erts/lib_src/common/ethr_cbf.c b/erts/lib_src/common/ethr_cbf.c index e79ec2b40c..037559be22 100644 --- a/erts/lib_src/common/ethr_cbf.c +++ b/erts/lib_src/common/ethr_cbf.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/lib_src/common/ethr_mutex.c b/erts/lib_src/common/ethr_mutex.c index 72aa34ec1c..5e7e7b2f32 100644 --- a/erts/lib_src/common/ethr_mutex.c +++ b/erts/lib_src/common/ethr_mutex.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2013. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -1250,7 +1250,7 @@ ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx) return 0; } -#elif (defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) +#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS) /* -- pthread mutex and condition variables -------------------------------- */ int diff --git a/erts/lib_src/ose/ethr_event.c b/erts/lib_src/ose/ethr_event.c deleted file mode 100644 index 24ea191c4b..0000000000 --- a/erts/lib_src/ose/ethr_event.c +++ /dev/null @@ -1,220 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2009-2010. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * Author: Rickard Green - */ - -#define ETHR_INLINE_FUNC_NAME_(X) X ## __ -#define ETHR_EVENT_IMPL__ - -#ifdef HAVE_CONFIG_H -#include "config.h" -#endif - -#include "ethread.h" - -#ifdef USE_PTHREAD_API - -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); - if (res != 0) { - pthread_mutex_destroy(&e->mtx); - return res; - } - return 0; -} - -int -ethr_event_destroy(ethr_event *e) -{ - int res; - res = pthread_mutex_destroy(&e->mtx); - if (res != 0) - return res; - res = pthread_cond_destroy(&e->cnd); - if (res != 0) - return res; - return 0; -} - -static ETHR_INLINE int -wait__(ethr_event *e, int spincount) -{ - int sc = spincount; - ethr_sint32_t val; - int res, ulres; - int until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS; - - if (spincount < 0) - ETHR_FATAL_ERROR__(EINVAL); - - while (1) { - val = ethr_atomic32_read(&e->state); - if (val == ETHR_EVENT_ON__) - return 0; - if (sc == 0) - break; - sc--; - ETHR_SPIN_BODY; - if (--until_yield == 0) { - until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS; - res = ETHR_YIELD(); - if (res != 0) - ETHR_FATAL_ERROR__(res); - } - } - - 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__); - } - - ETHR_ASSERT(val == ETHR_EVENT_OFF_WAITER__ - || val == ETHR_EVENT_OFF__); - - 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__) - break; - - 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; /* 0 || EINTR */ -} - -#else -/* --- OSE implementation of events ---------------------------- */ - -#ifdef DEBUG -union SIGNAL { - SIGSELECT signo; -}; -#endif - -int -ethr_event_init(ethr_event *e) -{ - ethr_atomic32_init(&e->state, ETHR_EVENT_OFF__); - e->proc = current_process(); - return 0; -} - -int -ethr_event_destroy(ethr_event *e) -{ - return 0; -} - -static ETHR_INLINE int -wait__(ethr_event *e, int spincount) -{ - int sc = spincount; - int res; - int until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS; - - if (spincount < 0) - ETHR_FATAL_ERROR__(EINVAL); - - ETHR_ASSERT(e->proc == current_process()); - ETHR_ASSERT(get_fsem(current_process()) == 0); - - while (1) { - ethr_sint32_t val; - while (1) { - val = ethr_atomic32_read(&e->state); - if (val == ETHR_EVENT_ON__) - return 0; - if (sc == 0) - break; - sc--; - ETHR_SPIN_BODY; - if (--until_yield == 0) { - until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS; - res = ETHR_YIELD(); - if (res != 0) - ETHR_FATAL_ERROR__(res); - } - } - 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__); - } - - wait_fsem(1); - - ETHR_ASSERT(get_fsem(current_process()) == 0); - } -} - -#endif - -void -ethr_event_reset(ethr_event *e) -{ - ethr_event_reset__(e); -} - -void -ethr_event_set(ethr_event *e) -{ - ethr_event_set__(e); -} - -int -ethr_event_wait(ethr_event *e) -{ - return wait__(e, 0); -} - -int -ethr_event_swait(ethr_event *e, int spincount) -{ - return wait__(e, spincount); -} diff --git a/erts/lib_src/ose/ethread.c b/erts/lib_src/ose/ethread.c deleted file mode 100644 index dc16acdd08..0000000000 --- a/erts/lib_src/ose/ethread.c +++ /dev/null @@ -1,833 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2010-2011. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * Description: OSE implementation of the ethread library - * Author: Lukas Larsson - */ - - -#ifdef HAVE_CONFIG_H -#include "config.h" -#endif - -#include "stdio.h" -#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 -#include "sys/types.h" -#include "unistd.h" - -#include "limits.h" - -#define ETHR_INLINE_FUNC_NAME_(X) X ## __ -#define ETHREAD_IMPL__ - -#include "ethread.h" -#include "ethr_internal.h" - -#include "erl_printf.h" -#include "efs.h" -#include "ose.h" - -#include "ose_spi.h" - -#include "string.h" -#include "ctype.h" -#include "stdlib.h" - -#ifndef ETHR_HAVE_ETHREAD_DEFINES -#error Missing configure defines -#endif - -#define ETHR_INVALID_TID_ID -1 - -#define DEFAULT_PRIO_NAME "ERTS_ETHR_DEFAULT_PRIO" - -/* Set the define to 1 to get some logging */ -#if 0 -#include "ramlog.h" -#define LOG(output) ramlog_printf output -#else -#define LOG(output) -#endif - -static ethr_tid main_thr_tid; -static const char* own_tid_key = "ethread_own_tid"; -ethr_tsd_key ethr_ts_event_key__; - -#define ETHREADWRAPDATASIG 1 - -/* Init data sent to thr_wrapper() */ -typedef struct { - SIGSELECT sig_no; - ethr_ts_event *tse; - ethr_tid *tid; - ethr_sint32_t result; - void *(*thr_func)(void *); - void *arg; - void *prep_func_res; - const char *name; -} ethr_thr_wrap_data__; - -union SIGNAL { - SIGSELECT sig_no; - ethr_thr_wrap_data__ data; -}; - -#define ETHR_GET_OWN_TID__ ((ethr_tid *) get_envp(current_process(),\ - own_tid_key)) - -/* - * -------------------------------------------------------------------------- - * Static functions - * -------------------------------------------------------------------------- - */ - -/* Will retrive the instrinsic name by removing the 'prefix' and the - * suffix from 'name'. - * The 'prefix' is given as an inparameter. If NULL or an empty string no - * prefix will be removed. - * If 'strip_suffix' is 1 suffixes in the form of '_123' will be removed. - * Will return a pointer to a newly allocated buffer containing the intrinsic - * name in uppercase characters. - * The caller must remember to free this buffer when no lnger needed. - */ -static char * -ethr_intrinsic_name(const char *name, const char *prefix, int strip_suffix) -{ - const char *start = name; - const char *end = name + strlen(name); - char *intrinsic_name = NULL; - int i; - - if (name == NULL) { - LOG(("ERTS - ethr_intrinsic_namNo input name.\n")); - return NULL; - } - - /* take care of the prefix */ - if ((prefix != NULL) && (*prefix != '\0')) { - const char *found = strstr(name, prefix); - - if (found == name) { - /* found the prefix at the beginning */ - start += strlen(prefix); - } - } - - /* take care of the suffix */ - if (strip_suffix) { - const char *suffix_start = strrchr(start, '_'); - - if (suffix_start != NULL) { - const char *ch; - int only_numbers = 1; - - for (ch = suffix_start + 1; *ch != '\0'; ch++) { - if (strchr("0123456789", *ch) == NULL) { - only_numbers = 0; - break; - } - } - - if (only_numbers) { - end = suffix_start; - } - } - } - - intrinsic_name = malloc(end - start + 1); - for (i = 0; (start + i) < end; i++) { - intrinsic_name[i] = toupper(start[i]); - } - intrinsic_name[i] = '\0'; - - return intrinsic_name; -} - -static char * -ethr_get_amended_env(const char *name, const char *prefix, const char *suffix) -{ - unsigned len; - char *env_name = NULL; - char *env_value = NULL; - - if (name == NULL) { - return NULL; - } - - len = strlen(name); - - if (prefix != NULL) { - len += strlen(prefix); - } - - if (suffix != NULL) { - len += strlen(suffix); - } - - env_name = malloc(len + 1); - sprintf(env_name, "%s%s%s", (prefix != NULL) ? prefix : "", - name, - (suffix != NULL) ? suffix : ""); - env_value = get_env(get_bid(current_process()), env_name); - - if (env_value == NULL) { - LOG(("ERTS - ethr_get_amended_env(): %s environment variable not present\n", env_name)); - } else { - LOG(("ERTS - ethr_get_amended_env(): Found %s environment variable: %s.\n", env_name, env_value)); - } - free(env_name); - - return env_value; -} - -/* Reads the environment variable derived from 'name' and interprets it as as an - * OSE priority. If successfull it will update 'out_prio'. - * Returns: 0 if successfull - * -1 orherwise. - */ -static int -ethr_get_prio(const char *name, OSPRIORITY *out_prio) -{ - int rc = -1; - char *intrinsic_name = NULL; - char *prio_env = NULL; - long prio; - char *endptr = NULL; - - LOG(("ERTS - ethr_get_prio(): name: %s.\n", name)); - - intrinsic_name = ethr_intrinsic_name(name, NULL, 1); - LOG(("ERTS - ethr_get_prio(): Intrinsic name: %s.\n", intrinsic_name)); - - prio_env = ethr_get_amended_env(intrinsic_name, "ERTS_", "_PRIO"); - if (prio_env == NULL) { - goto fini; - } - - prio = efs_str_to_long(prio_env, (const char **)&endptr); - if (endptr != NULL) { - LOG(("ERTS - ethr_get_prio(): Environment varible for '%s' includes " - "non-numerical characters: '%s'.\n", intrinsic_name, prio_env)); - goto fini; - } - - if ((prio < 0) || (prio > 32)) { - LOG(("ERTS - ethr_get_prio(): prio for '%s' (%d) is out of bounds (0-32).\n", - intrinsic_name, prio)); - goto fini; - } - - /* Success */ - *out_prio = (OSPRIORITY)prio; - rc = 0; - -fini: - if (intrinsic_name != NULL) { - free(intrinsic_name); - } - if (prio_env != NULL) { - free_buf((union SIGNAL **) &prio_env); - } - - return rc; -} - -static PROCESS blockId(void) { - static PROCESS bid = (PROCESS)0; - - /* For now we only use the same block. */ - /* if (bid == 0) { - bid = create_block("Erlang-VM", 0, 0, 0, 0); - } - return bid; */ - return 0; -} - -static void thr_exit_cleanup(ethr_tid *tid, void *res) -{ - - ETHR_ASSERT(tid == ETHR_GET_OWN_TID__); - - tid->res = res; - - ethr_run_exit_handlers__(); - ethr_ts_event_destructor__((void *) ethr_get_tse__()); -} - -//static OS_PROCESS(thr_wrapper); -static OS_PROCESS(thr_wrapper) -{ - ethr_tid my_tid; - ethr_sint32_t result; - void *res; - void *(*thr_func)(void *); - void *arg; - ethr_ts_event *tsep = NULL; - -#ifdef DEBUG - { - PROCESS pid = current_process(); - - const char *execMode; - - PROCESS bid = get_bid(pid); - - /* In the call below, 16 is a secret number provided by frbr that makes - * the function return current domain. */ - OSADDRESS domain = get_pid_info(current_process(), 16); - -#ifdef HAVE_OSE_SPI_H - execMode = get_pid_info(pid, OSE_PI_SUPERVISOR) - ? "Supervisor" - : "User"; -#else - execMode = "unknown"; -#endif - - fprintf(stderr,"[0x%x] New process. Bid:0x%x, domain:%d, exec mode:%s\n", - current_process(), bid, domain, execMode); - } -#endif - - { - SIGSELECT sigsel[] = {1,ETHREADWRAPDATASIG}; - union SIGNAL *init_msg = receive(sigsel); - - thr_func = init_msg->data.thr_func; - arg = init_msg->data.arg; - - result = (ethr_sint32_t) ethr_make_ts_event__(&tsep); - - if (result == 0) { - tsep->iflgs |= ETHR_TS_EV_ETHREAD; - my_tid = *init_msg->data.tid; - set_envp(current_process(), own_tid_key, (OSADDRESS)&my_tid); - if (ethr_thr_child_func__) - ethr_thr_child_func__(init_msg->data.prep_func_res); - } - - init_msg->data.result = result; - - send(&init_msg,sender(&init_msg)); - } - - /* pthread mutex api says we have to do this */ - signal_fsem(current_process()); - ETHR_ASSERT(get_fsem(current_process()) == 0); - - res = result == 0 ? (*thr_func)(arg) : NULL; - - ethr_thr_exit(&res); -} - -/* internal exports */ - -int ethr_set_tse__(ethr_ts_event *tsep) -{ - return ethr_tsd_set(ethr_ts_event_key__,(void *) tsep); -} - -ethr_ts_event *ethr_get_tse__(void) -{ - return (ethr_ts_event *) ethr_tsd_get(ethr_ts_event_key__); -} - -#if defined(ETHR_PPC_RUNTIME_CONF__) - -static int -ppc_init__(void) -{ - int pid; - - - ethr_runtime__.conf.have_lwsync = 0; - - return 0; -} - -#endif - -#if defined(ETHR_X86_RUNTIME_CONF__) - -void -ethr_x86_cpuid__(int *eax, int *ebx, int *ecx, int *edx) -{ -#if ETHR_SIZEOF_PTR == 4 - int have_cpuid; - /* - * If it is possible to toggle eflags bit 21, - * we have the cpuid instruction. - */ - __asm__ ("pushf\n\t" - "popl %%eax\n\t" - "movl %%eax, %%ecx\n\t" - "xorl $0x200000, %%eax\n\t" - "pushl %%eax\n\t" - "popf\n\t" - "pushf\n\t" - "popl %%eax\n\t" - "movl $0x0, %0\n\t" - "xorl %%ecx, %%eax\n\t" - "jz no_cpuid\n\t" - "movl $0x1, %0\n\t" - "no_cpuid:\n\t" - : "=r"(have_cpuid) - : - : "%eax", "%ecx", "cc"); - if (!have_cpuid) { - *eax = *ebx = *ecx = *edx = 0; - return; - } -#endif -#if ETHR_SIZEOF_PTR == 4 && defined(__PIC__) && __PIC__ - /* - * When position independet code is used in 32-bit mode, the B register - * is used for storage of global offset table address, and we may not - * use it as input or output in an asm. We need to save and restore the - * B register explicitly (for some reason gcc doesn't provide this - * service to us). - */ - __asm__ ("pushl %%ebx\n\t" - "cpuid\n\t" - "movl %%ebx, %1\n\t" - "popl %%ebx\n\t" - : "=a"(*eax), "=r"(*ebx), "=c"(*ecx), "=d"(*edx) - : "0"(*eax) - : "cc"); -#else - __asm__ ("cpuid\n\t" - : "=a"(*eax), "=b"(*ebx), "=c"(*ecx), "=d"(*edx) - : "0"(*eax) - : "cc"); -#endif -} - -#endif /* ETHR_X86_RUNTIME_CONF__ */ - -/* - * -------------------------------------------------------------------------- - * Exported functions - * -------------------------------------------------------------------------- - */ - -int -ethr_init(ethr_init_data *id) -{ - int res; - - if (!ethr_not_inited__) - return EINVAL; - - -#if defined(ETHR_PPC_RUNTIME_CONF__) - res = ppc_init__(); - if (res != 0) - goto error; -#endif - - res = ethr_init_common__(id); - if (res != 0) - goto error; - - main_thr_tid.id = current_process(); - main_thr_tid.tsd_key_index = 0; - - set_envp(current_process(),own_tid_key,(OSADDRESS)&main_thr_tid); - signal_fsem(current_process()); - - - ETHR_ASSERT(&main_thr_tid == ETHR_GET_OWN_TID__); - - ethr_not_inited__ = 0; - - ethr_tsd_key_create(ðr_ts_event_key__,"ethread_tse"); - - return 0; - error: - ethr_not_inited__ = 1; - return res; - -} - -int -ethr_late_init(ethr_late_init_data *id) -{ - int res = ethr_late_init_common__(id); - if (res != 0) - return res; - ethr_not_completely_inited__ = 0; - return res; -} - -int -ethr_thr_create(ethr_tid *tid, void * (*func)(void *), void *arg, - ethr_thr_opts *opts) -{ - int res; - int use_stack_size = (opts && opts->suggested_stack_size >= 0 - ? opts->suggested_stack_size - : 0x200 /* Use system default */); - OSPRIORITY use_prio; - char *use_name; - char default_thr_name[20]; - static int no_of_thr = 0; - cpuid_t use_core; - - union SIGNAL *init_msg; - SIGSELECT sigsel[] = {1,ETHREADWRAPDATASIG}; - void *prep_func_res; - - - if (opts != NULL) { - LOG(("ERTS - ethr_thr_create(): opts supplied: name: %s, coreNo: %u.\n", - opts->name, opts->coreNo)); - use_name = opts->name; - use_core = opts->coreNo; - if (0 != ethr_get_prio(use_name, &use_prio)) { - if (0 != ethr_get_prio("DEFAULT", &use_prio)) { - use_prio = get_pri(current_process()); - LOG(("ERTS - ethr_thr_create(): Using current process' prio: %d.\n", use_prio)); - } else { - LOG(("ERTS - ethr_thr_create(): Using default prio: %d.\n", use_prio)); - } - } else { - LOG(("ERTS - ethr_thr_create(): Using configured prio: %d.\n", use_prio)); - } - } else { - LOG(("ERTS - ethr_thr_create(): opts not supplied. Using defaults.\n")); - no_of_thr++; - sprintf(default_thr_name, "ethread_%d", no_of_thr); - use_name = default_thr_name; - use_core = ose_cpu_id(); - - if (0 != ethr_get_prio("DEFAULT", &use_prio)) { - use_prio = get_pri(current_process()); - LOG(("ERTS - ethr_thr_create(): Using current process' prio: %d.\n", use_prio)); - } - } - -#ifdef ETHR_MODIFIED_DEFAULT_STACK_SIZE - if (use_stack_size < 0) - use_stack_size = ETHR_MODIFIED_DEFAULT_STACK_SIZE; -#endif - -#if ETHR_XCHK - if (ethr_not_completely_inited__) { - ETHR_ASSERT(0); - return EACCES; - } - if (!tid || !func) { - ETHR_ASSERT(0); - return EINVAL; - } -#endif - - if (use_stack_size >= 0) { - size_t suggested_stack_size = (size_t) use_stack_size; - size_t stack_size; -#ifdef ETHR_DEBUG - suggested_stack_size /= 2; /* Make sure we got margin */ -#endif -#ifdef ETHR_STACK_GUARD_SIZE - /* The guard is at least on some platforms included in the stack size - passed when creating threads */ - suggested_stack_size += ETHR_B2KW(ETHR_STACK_GUARD_SIZE); -#endif - - if (suggested_stack_size < ethr_min_stack_size__) - stack_size = ETHR_KW2B(ethr_min_stack_size__); - else if (suggested_stack_size > ethr_max_stack_size__) - stack_size = ETHR_KW2B(ethr_max_stack_size__); - else - stack_size = ETHR_PAGE_ALIGN(ETHR_KW2B(suggested_stack_size)); - use_stack_size = stack_size; - } - - init_msg = alloc(sizeof(ethr_thr_wrap_data__), ETHREADWRAPDATASIG); - - /* Call prepare func if it exist */ - if (ethr_thr_prepare_func__) - init_msg->data.prep_func_res = ethr_thr_prepare_func__(); - else - init_msg->data.prep_func_res = NULL; - - LOG(("ERTS - ethr_thr_create(): Process [0x%x] is creating '%s', coreNo = %u, prio:%u\n", - current_process(), use_name, use_core, use_prio)); - - tid->id = create_process(OS_PRI_PROC, use_name, thr_wrapper, - use_stack_size, use_prio, 0, - get_bid(current_process()), NULL, 0, 0); - if (ose_bind_process(tid->id, use_core)) { - LOG(("ERTS - ethr_thr_create(): Bound pid 0x%x (%s) to core no %u.\n", - tid->id, use_name, use_core)); - } else { - LOG(("ERTS - ethr_thr_create(): Failed binding pid 0x%x (%s) to core no %u.\n", - tid->id, use_name, use_core)); - } - - /*FIXME!!! Normally this shouldn't be used in shared mode. Still there is - * a problem with stdin fd in fd_ processes which should be further - * investigated */ - efs_clone(tid->id); - - tid->tsd_key_index = 0; - tid->res = NULL; - - init_msg->data.tse = ethr_get_ts_event(); - init_msg->data.thr_func = func; - init_msg->data.arg = arg; - init_msg->data.tid = tid; - init_msg->data.name = opts->name; - - send(&init_msg, tid->id); - - start(tid->id); - init_msg = receive(sigsel); - - res = init_msg->data.result; - prep_func_res = init_msg->data.prep_func_res; - - free_buf(&init_msg); - /* Cleanup... */ - - if (ethr_thr_parent_func__) - ethr_thr_parent_func__(prep_func_res); - - LOG(("ERTS - ethr_thr_create(): Exiting.\n")); - return res; -} - -int -ethr_thr_join(ethr_tid tid, void **res) -{ - SIGSELECT sigsel[] = {1,OS_ATTACH_SIG}; -#if ETHR_XCHK - if (ethr_not_inited__) { - ETHR_ASSERT(0); - return EACCES; - } -#endif - - if (tid.id == ETHR_INVALID_TID_ID) - return EINVAL; - - attach(NULL,tid.id); - receive(sigsel); - - if (res) - *res = tid.res; - - return 0; -} - -int -ethr_thr_detach(ethr_tid tid) -{ -#if ETHR_XCHK - if (ethr_not_inited__) { - ETHR_ASSERT(0); - return EACCES; - } -#endif - return 0; -} - -void -ethr_thr_exit(void *res) -{ - ethr_tid *tid; -#if ETHR_XCHK - if (ethr_not_inited__) { - ETHR_ASSERT(0); - return; - } -#endif - tid = ETHR_GET_OWN_TID__; - if (!tid) { - ETHR_ASSERT(0); - kill_proc(current_process()); - } - thr_exit_cleanup(tid, res); - /* Harakiri possible? */ - kill_proc(current_process()); -} - -ethr_tid -ethr_self(void) -{ - ethr_tid *tid; -#if ETHR_XCHK - if (ethr_not_inited__) { - ethr_tid dummy_tid = {ETHR_INVALID_TID_ID, 0, NULL}; - ETHR_ASSERT(0); - return dummy_tid; - } -#endif - tid = ETHR_GET_OWN_TID__; - if (!tid) { - ethr_tid dummy_tid = {ETHR_INVALID_TID_ID, 0, NULL}; - return dummy_tid; - } - return *tid; -} - -int -ethr_equal_tids(ethr_tid tid1, ethr_tid tid2) -{ - return tid1.id == tid2.id && tid1.id != ETHR_INVALID_TID_ID; -} - - -/* - * Thread specific events - */ - -ethr_ts_event * -ethr_get_ts_event(void) -{ - return ethr_get_ts_event__(); -} - -void -ethr_leave_ts_event(ethr_ts_event *tsep) -{ - ethr_leave_ts_event__(tsep); -} - -/* - * Thread specific data - */ - -int -ethr_tsd_key_create(ethr_tsd_key *keyp, char *keyname) -{ - -#if ETHR_XCHK - if (ethr_not_inited__) { - ETHR_ASSERT(0); - return EACCES; - } - if (!keyp) { - ETHR_ASSERT(0); - return EINVAL; - } -#endif - - ose_create_ppdata(keyname,keyp); - - return 0; -} - -int -ethr_tsd_key_delete(ethr_tsd_key key) -{ -#if ETHR_XCHK - if (ethr_not_inited__) { - ETHR_ASSERT(0); - return EACCES; - } -#endif - /* Not possible to delete ppdata */ - - return 0; -} - -int -ethr_tsd_set(ethr_tsd_key key, void *value) -{ - void **ppdp; -#if ETHR_XCHK - if (ethr_not_inited__) { - ETHR_ASSERT(0); - return EACCES; - } -#endif - ppdp = (void **)ose_get_ppdata(key); - *ppdp = value; - return 0; -} - -void * -ethr_tsd_get(ethr_tsd_key key) -{ -#if ETHR_XCHK - if (ethr_not_inited__) { - ETHR_ASSERT(0); - return NULL; - } -#endif - return *(void**)ose_get_ppdata(key); -} - -/* - * Signal functions - */ - -#if ETHR_HAVE_ETHR_SIG_FUNCS - -int ethr_sigmask(int how, const sigset_t *set, sigset_t *oset) -{ -#if ETHR_XCHK - if (ethr_not_inited__) { - ETHR_ASSERT(0); - return EACCES; - } - if (!set && !oset) { - ETHR_ASSERT(0); - return EINVAL; - } -#endif - return pthread_sigmask(how, set, oset); -} - -int ethr_sigwait(const sigset_t *set, int *sig) -{ -#if ETHR_XCHK - if (ethr_not_inited__) { - ETHR_ASSERT(0); - return EACCES; - } - if (!set || !sig) { - ETHR_ASSERT(0); - return EINVAL; - } -#endif - if (sigwait(set, sig) < 0) - return errno; - return 0; -} - -#endif /* #if ETHR_HAVE_ETHR_SIG_FUNCS */ - -ETHR_IMPL_NORETURN__ -ethr_abort__(void) -{ - abort(); -} diff --git a/erts/lib_src/pthread/ethr_event.c b/erts/lib_src/pthread/ethr_event.c index 69e7be342c..eef88d5002 100644 --- a/erts/lib_src/pthread/ethr_event.c +++ b/erts/lib_src/pthread/ethr_event.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2010. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/lib_src/pthread/ethr_x86_sse2_asm.c b/erts/lib_src/pthread/ethr_x86_sse2_asm.c index 7ce5a6d98a..bdcf3ac1c3 100644 --- a/erts/lib_src/pthread/ethr_x86_sse2_asm.c +++ b/erts/lib_src/pthread/ethr_x86_sse2_asm.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/lib_src/pthread/ethread.c b/erts/lib_src/pthread/ethread.c index ef11559654..29bffa7e12 100644 --- a/erts/lib_src/pthread/ethread.c +++ b/erts/lib_src/pthread/ethread.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2011. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/lib_src/utils/make_atomics_api b/erts/lib_src/utils/make_atomics_api index 4b37e3fa74..f960b97c87 100755 --- a/erts/lib_src/utils/make_atomics_api +++ b/erts/lib_src/utils/make_atomics_api @@ -4,7 +4,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2012. All Rights Reserved. +%% Copyright Ericsson AB 2011-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/lib_src/win/ethr_event.c b/erts/lib_src/win/ethr_event.c index 6951a216c5..383f7c876e 100644 --- a/erts/lib_src/win/ethr_event.c +++ b/erts/lib_src/win/ethr_event.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2011. All Rights Reserved. + * Copyright Ericsson AB 2009-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/lib_src/win/ethread.c b/erts/lib_src/win/ethread.c index 22b0b4040c..e0f19f7ba1 100644 --- a/erts/lib_src/win/ethread.c +++ b/erts/lib_src/win/ethread.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2011. All Rights Reserved. + * Copyright Ericsson AB 2010-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/preloaded/Makefile b/erts/preloaded/Makefile index fbe62d57bb..e8935d4410 100644 --- a/erts/preloaded/Makefile +++ b/erts/preloaded/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2008-2009. All Rights Reserved. +# Copyright Ericsson AB 2008-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex f1ae49150b..3e82b8e20e 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erl_tracer.beam b/erts/preloaded/ebin/erl_tracer.beam Binary files differnew file mode 100644 index 0000000000..67d96d0f0d --- /dev/null +++ b/erts/preloaded/ebin/erl_tracer.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 990973c57d..321e4e7e1b 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam Binary files differnew file mode 100644 index 0000000000..0c667663fd --- /dev/null +++ b/erts/preloaded/ebin/erts_code_purger.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex 7461e3bc5b..ed2e328f5b 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 0060a2cf42..23ebd2cad9 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 b1868d7e10..b63fa24848 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 dc16909d26..7c8fdc82c0 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 f6e15ba499..d4559bc9ed 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 673627498e..5a0678632e 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 813060c41d..3d32dd8449 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 5ce932aeec..ced9f9c952 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/Makefile b/erts/preloaded/src/Makefile index 52034a0881..4a447d3a09 100644 --- a/erts/preloaded/src/Makefile +++ b/erts/preloaded/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2008-2013. All Rights Reserved. +# Copyright Ericsson AB 2008-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -41,8 +41,10 @@ PRE_LOADED_ERL_MODULES = \ zlib \ prim_zip \ otp_ring0 \ + erts_code_purger \ erlang \ - erts_internal + erts_internal \ + erl_tracer PRE_LOADED_BEAM_MODULES = \ prim_eval diff --git a/erts/preloaded/src/add_abstract_code b/erts/preloaded/src/add_abstract_code index 4f479db2e8..943987872e 100644 --- a/erts/preloaded/src/add_abstract_code +++ b/erts/preloaded/src/add_abstract_code @@ -4,7 +4,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl index 9f6cba33bd..e18e187cb7 100644 --- a/erts/preloaded/src/erl_prim_loader.erl +++ b/erts/preloaded/src/erl_prim_loader.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -42,7 +42,7 @@ -include("inet_boot.hrl"). %% Public --export([start/3, set_path/1, get_path/0, get_file/1, get_files/2, +-export([start/0, set_path/1, get_path/0, get_file/1, list_dir/1, read_file_info/1, read_link_info/1, get_cwd/0, get_cwd/1]). %% Used by erl_boot_server @@ -50,30 +50,31 @@ prim_read_file_info/3, prim_get_cwd/2]). %% Used by escript and code --export([set_primary_archive/4, release_archives/0]). +-export([set_primary_archive/4]). + +%% Used by test suites +-export([purge_archive_cache/0]). + +%% Used by init and the code server. +-export([get_modules/2,get_modules/3]). -include_lib("kernel/include/file.hrl"). -type host() :: atom(). -record(prim_state, {debug :: boolean(), - cache, primary_archive}). -type prim_state() :: #prim_state{}. -record(state, {loader :: 'efile' | 'inet', hosts = [] :: [host()], % hosts list (to boot from) - id, % not used any more? data :: 'noport' | port(), % data port etc - timeout :: timeout(), % idle timeout - %% Number of timeouts before archives are released - n_timeouts :: non_neg_integer(), - multi_get = false :: boolean(), + timeout :: timeout(), % idle timeout prim_state :: prim_state()}). % state for efile code loader --define(IDLE_TIMEOUT, 60000). %% tear inet connection after 1 minutes --define(N_TIMEOUTS, 6). %% release efile archive after 6 minutes +-define(EFILE_IDLE_TIMEOUT, (6*60*1000)). %purge archives +-define(INET_IDLE_TIMEOUT, (60*1000)). %tear down connection timeout %% Defines for inet as prim_loader -define(INET_FAMILY, inet). @@ -103,26 +104,13 @@ debug(#prim_state{debug = Deb}, Term) -> %%% Interface Functions. %%% -------------------------------------------------------- --spec start(Id, Loader, Hosts) -> +-spec start() -> {'ok', Pid} | {'error', What} when - Id :: term(), - Loader :: atom() | string(), - Hosts :: Host | [Host], - Host :: host(), Pid :: pid(), What :: term(). -start(Id, Pgm, Hosts) when is_atom(Hosts) -> - start(Id, Pgm, [Hosts]); -start(Id, Pgm0, Hosts) -> - Pgm = if - is_atom(Pgm0) -> - atom_to_list(Pgm0); - true -> - Pgm0 - end, +start() -> Self = self(), - Pid = spawn_link(fun() -> start_it(Pgm, Id, Self, Hosts) end), - register(erl_prim_loader, Pid), + Pid = spawn_link(fun() -> start_it(Self) end), receive {Pid,ok} -> {ok,Pid}; @@ -130,26 +118,39 @@ start(Id, Pgm0, Hosts) -> {error,Reason} end. -%% Hosts must be a list of form ['1.2.3.4' ...] -start_it("inet", Id, Pid, Hosts) -> +start_it(Parent) -> process_flag(trap_exit, true), - ?dbg(inet, {Id,Pid,Hosts}), + register(erl_prim_loader, self()), + Loader = case init:get_argument(loader) of + {ok,[[Loader0]]} -> + Loader0; + error -> + "efile" + end, + case Loader of + "efile" -> start_efile(Parent); + "inet" -> start_inet(Parent) + end. + +%% Hosts must be a list of form ['1.2.3.4' ...] +start_inet(Parent) -> + Hosts = case init:get_argument(hosts) of + {ok,[Hosts0]} -> Hosts0; + _ -> [] + end, AL = ipv4_list(Hosts), ?dbg(addresses, AL), {ok,Tcp} = find_master(AL), - init_ack(Pid), + init_ack(Parent), PS = prim_init(), State = #state {loader = inet, hosts = AL, - id = Id, data = Tcp, - timeout = ?IDLE_TIMEOUT, - n_timeouts = ?N_TIMEOUTS, + timeout = ?INET_IDLE_TIMEOUT, prim_state = PS}, - loop(State, Pid, []); + loop(State, Parent, []). -start_it("efile", Id, Pid, _Hosts) -> - process_flag(trap_exit, true), +start_efile(Parent) -> {ok, Port} = prim_file:start(), %% Check that we started in a valid directory. case prim_file:get_cwd(Port) of @@ -160,20 +161,14 @@ start_it("efile", Id, Pid, _Hosts) -> erlang:display(Report), exit({error, invalid_current_directory}); _ -> - init_ack(Pid) + init_ack(Parent) end, - MultiGet = case erlang:system_info(thread_pool_size) of - 0 -> false; - _ -> true - end, PS = prim_init(), State = #state {loader = efile, - id = Id, data = Port, - timeout = infinity, - multi_get = MultiGet, + timeout = ?EFILE_IDLE_TIMEOUT, prim_state = PS}, - loop(State, Pid, []). + loop(State, Parent, []). init_ack(Pid) -> Pid ! {self(),ok}, @@ -198,20 +193,6 @@ get_file(File) when is_atom(File) -> get_file(File) -> check_file_result(get_file, File, request({get_file,File})). --spec get_files([{atom(), string()}], - fun((atom(),binary(),string()) -> 'ok' | {'error', atom()})) -> - 'ok' | {'error', atom()}. -get_files(ModFiles, Fun) -> - case request({get_files,{ModFiles,Fun}}) of - E = {error,_M} -> - E; - {error,Reason,M} -> - check_file_result(get_files, M, {error,Reason}), - {error,M}; - ok -> - ok - end. - -spec list_dir(Dir) -> {'ok', Filenames} | 'error' when Dir :: string(), Filenames :: [Filename :: string()]. @@ -250,10 +231,30 @@ set_primary_archive(File, ArchiveBin, FileInfo, ParserFun) when is_list(File), is_binary(ArchiveBin), is_record(FileInfo, file_info) -> request({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}). --spec release_archives() -> 'ok' | {'error', _}. +%% NOTE: Does not close the primary archive. Only closes all +%% open zip files kept in the cache. Should be called before an archive +%% file is to be removed (for example in the test suites). -release_archives() -> - request(release_archives). +-spec purge_archive_cache() -> 'ok' | {'error', _}. +purge_archive_cache() -> + request(purge_archive_cache). + +-spec get_modules([module()], + fun((atom(), string(), binary()) -> + {'ok',any()} | {'error',any()})) -> + {'ok',{[any()],[any()]}}. + +get_modules(Modules, Fun) -> + request({get_modules,{Modules,Fun}}). + +-spec get_modules([module()], + fun((atom(), string(), binary()) -> + {'ok',any()} | {'error',any()}), + [string()]) -> + {'ok',{[any()],[any()]}}. + +get_modules(Modules, Fun, Path) -> + request({get_modules,{Modules,Fun,Path}}). request(Req) -> Loader = whereis(erl_prim_loader), @@ -310,76 +311,63 @@ check_file_result(_, _, Other) -> %%% The main loop. %%% -------------------------------------------------------- -loop(State, Parent, Paths) -> +loop(St0, Parent, Paths) -> receive + {Pid,{set_path,NewPaths}} when is_pid(Pid) -> + Pid ! {self(),ok}, + loop(St0, Parent, to_strs(NewPaths)); {Pid,Req} when is_pid(Pid) -> - %% erlang:display(Req), - {Resp,State2,Paths2} = - case Req of - {set_path,NewPaths} -> - {ok,State,to_strs(NewPaths)}; - {get_path,_} -> - {{ok,Paths},State,Paths}; - {get_file,File} -> - {Res,State1} = handle_get_file(State, Paths, File), - {Res,State1,Paths}; - {get_files,{ModFiles,Fun}} -> - {Res,State1} = handle_get_files(State, ModFiles, Paths, Fun), - {Res,State1,Paths}; - {list_dir,Dir} -> - {Res,State1} = handle_list_dir(State, Dir), - {Res,State1,Paths}; - {read_file_info,File} -> - {Res,State1} = handle_read_file_info(State, File), - {Res,State1,Paths}; - {read_link_info,File} -> - {Res,State1} = handle_read_link_info(State, File), - {Res,State1,Paths}; - {get_cwd,[]} -> - {Res,State1} = handle_get_cwd(State, []), - {Res,State1,Paths}; - {get_cwd,[_]=Args} -> - {Res,State1} = handle_get_cwd(State, Args), - {Res,State1,Paths}; - {set_primary_archive,File,ArchiveBin,FileInfo,ParserFun} -> - {Res,State1} = - handle_set_primary_archive(State, File, - ArchiveBin, FileInfo, - ParserFun), - {Res,State1,Paths}; - release_archives -> - {Res,State1} = handle_release_archives(State), - {Res,State1,Paths}; - _Other -> - {ignore,State,Paths} - end, - if Resp =:= ignore -> ok; - true -> Pid ! {self(),Resp}, ok - end, - if - is_record(State2, state) -> - loop(State2, Parent, Paths2); - true -> - exit({bad_state, Req, State2}) + case handle_request(Req, Paths, St0) of + ignore -> + ok; + {Resp,#state{}=St1} -> + Pid ! {self(),Resp}, + loop(St1, Parent, Paths); + {_,State2,_} -> + exit({bad_state,Req,State2}) end; {'EXIT',Parent,W} -> - _State1 = handle_stop(State), + _ = handle_stop(St0), exit(W); {'EXIT',P,W} -> - State1 = handle_exit(State, P, W), - loop(State1, Parent, Paths); + St1 = handle_exit(St0, P, W), + loop(St1, Parent, Paths); _Message -> - loop(State, Parent, Paths) - after State#state.timeout -> - State1 = handle_timeout(State, Parent), - loop(State1, Parent, Paths) + loop(St0, Parent, Paths) + after St0#state.timeout -> + St1 = handle_timeout(St0, Parent), + loop(St1, Parent, Paths) + end. + +handle_request(Req, Paths, St0) -> + case Req of + {get_path,_} -> + {{ok,Paths},St0}; + {get_file,File} -> + handle_get_file(St0, Paths, File); + {get_modules,{Modules,Fun}} -> + handle_get_modules(St0, Modules, Fun, Paths); + {get_modules,{Modules,Fun,ModPaths}} -> + handle_get_modules(St0, Modules, Fun, ModPaths); + {list_dir,Dir} -> + handle_list_dir(St0, Dir); + {read_file_info,File} -> + handle_read_file_info(St0, File); + {read_link_info,File} -> + handle_read_link_info(St0, File); + {get_cwd,[]} -> + handle_get_cwd(St0, []); + {get_cwd,[_]=Args} -> + handle_get_cwd(St0, Args); + {set_primary_archive,File,ArchiveBin,FileInfo,ParserFun} -> + handle_set_primary_archive(St0, File, ArchiveBin, + FileInfo, ParserFun); + purge_archive_cache -> + handle_purge_archive_cache(St0); + _ -> + ignore end. -handle_get_files(State = #state{multi_get = true}, ModFiles, Paths, Fun) -> - ?SAFE2(efile_multi_get_file_from_port(State, ModFiles, Paths, Fun), State); -handle_get_files(State, _ModFiles, _Paths, _Fun) -> % no multi get - {{error,no_multi_get},State}. - handle_get_file(State = #state{loader = efile}, Paths, File) -> ?SAFE2(efile_get_file_from_port(State, File, Paths), State); handle_get_file(State = #state{loader = inet}, Paths, File) -> @@ -388,8 +376,9 @@ handle_get_file(State = #state{loader = inet}, Paths, File) -> handle_set_primary_archive(State= #state{loader = efile}, File, ArchiveBin, FileInfo, ParserFun) -> ?SAFE2(efile_set_primary_archive(State, File, ArchiveBin, FileInfo, ParserFun), State). -handle_release_archives(State= #state{loader = efile}) -> - ?SAFE2(efile_release_archives(State), State). +handle_purge_archive_cache(#state{loader = efile}=State) -> + prim_purge_cache(), + {ok,State}. handle_list_dir(State = #state{loader = efile}, Dir) -> ?SAFE2(efile_list_dir(State, Dir), State); @@ -430,53 +419,6 @@ handle_timeout(State = #state{loader = inet}, Parent) -> %%% Functions which handle efile as prim_loader (default). %%% -------------------------------------------------------- -%%% Reading many files in parallel is an optimization. -%%% See also comment in init.erl. - -%% -> {ok,State} | {{error,Module},State} | {{error,Reason,Module},State} -efile_multi_get_file_from_port(State, ModFiles, Paths, Fun) -> - Ref = make_ref(), - %% More than 200 processes is no gain. - Max = erlang:min(200, erlang:system_info(thread_pool_size)), - efile_multi_get_file_from_port2(ModFiles, 0, Max, State, Paths, Fun, Ref, ok). - -efile_multi_get_file_from_port2([MF | MFs], Out, Max, State, Paths, Fun, Ref, Ret) when Out < Max -> - Self = self(), - _Pid = spawn(fun() -> efile_par_get_file(Ref, State, MF, Paths, Self, Fun) end), - efile_multi_get_file_from_port2(MFs, Out+1, Max, State, Paths, Fun, Ref, Ret); -efile_multi_get_file_from_port2(MFs, Out, Max, _State, Paths, Fun, Ref, Ret) when Out > 0 -> - receive - {Ref, ok, State1} -> - efile_multi_get_file_from_port2(MFs, Out-1, Max, State1, Paths, Fun, Ref, Ret); - {Ref, {error,_Mod} = Error, State1} -> - efile_multi_get_file_from_port2(MFs, Out-1, Max, State1, Paths, Fun, Ref, Error); - {Ref, MF, {error,emfile,State1}} -> - %% Max can take negative values. Out cannot. - efile_multi_get_file_from_port2([MF | MFs], Out-1, Max-1, State1, Paths, Fun, Ref, Ret); - {Ref, {M,_F}, {error,Error,State1}} -> - efile_multi_get_file_from_port2(MFs, Out-1, 0, State1, Paths, Fun, Ref, {error,Error,M}) - end; -efile_multi_get_file_from_port2(_MFs, 0, _Max, State, _Paths, _Fun, _Ref, Ret) -> - {Ret,State}. - -efile_par_get_file(Ref, State, {Mod,File} = MF, Paths, Pid, Fun) -> - %% One port for each file read in "parallel": - case prim_file:start() of - {ok, Port} -> - Port0 = State#state.data, - State1 = State#state{data = Port}, - R = case efile_get_file_from_port(State1, File, Paths) of - {{error,Reason},State2} -> - {Ref,MF,{error,Reason,State2}}; - {{ok,BinFile,Full},State2} -> - %% Fun(...) -> ok | {error,Mod} - {Ref,Fun(Mod, BinFile, Full),State2#state{data=Port0}} - end, - prim_file:close(Port), - Pid ! R; - {error, Error} -> - Pid ! {Ref,MF,{error,Error,State}} - end. %% -> {{ok,BinFile,File},State} | {{error,Reason},State} efile_get_file_from_port(State, File, Paths) -> @@ -521,10 +463,6 @@ efile_set_primary_archive(#state{prim_state = PS} = State, File, FileInfo, ParserFun), {Res,State#state{prim_state = PS2}}. -efile_release_archives(#state{prim_state = PS} = State) -> - {Res, PS2} = prim_release_archives(PS), - {Res,State#state{prim_state = PS2}}. - efile_list_dir(#state{prim_state = PS} = State, Dir) -> {Res, PS2} = prim_list_dir(PS, Dir), {Res, State#state{prim_state = PS2}}. @@ -546,15 +484,128 @@ efile_exit_port(State, Port, Reason) when State#state.data =:= Port -> efile_exit_port(State, _Port, _Reason) -> State. -efile_timeout_handler(#state{n_timeouts = N} = State, _Parent) -> - if - N =< 0 -> - {_Res, State2} = efile_release_archives(State), - State2#state{n_timeouts = ?N_TIMEOUTS}; - true -> - State#state{n_timeouts = N - 1} +efile_timeout_handler(State, _Parent) -> + prim_purge_cache(), + State. + +%%% -------------------------------------------------------- +%%% Read and process severals modules in parallel. +%%% -------------------------------------------------------- + +handle_get_modules(#state{loader=efile}=St, Ms, Process, Paths) -> + Primary = (St#state.prim_state)#prim_state.primary_archive, + Res = case efile_any_archives(Paths, Primary) of + false -> + efile_get_mods_par(Ms, Process, Paths); + true -> + Get = fun efile_get_file_from_port/3, + gm_get_mods(St, Get, Ms, Process, Paths) + end, + {Res,St}; +handle_get_modules(#state{loader=inet}=St, Ms, Process, Paths) -> + Get = fun inet_get_file_from_port/3, + {gm_get_mods(St, Get, Ms, Process, Paths),St}. + +efile_get_mods_par(Ms, Process, Paths) -> + Self = self(), + Ref = make_ref(), + GmSpawn = fun() -> + efile_gm_spawn({Self,Ref}, Ms, Process, Paths) + end, + _ = spawn_link(GmSpawn), + N = length(Ms), + efile_gm_recv(N, Ref, [], []). + +efile_any_archives([H|T], Primary) -> + case name_split(Primary, H) of + {file,_} -> efile_any_archives(T, Primary); + {archive,_,_} -> true + end; +efile_any_archives([], _) -> + false. + +efile_gm_recv(0, _Ref, Succ, Fail) -> + {ok,{Succ,Fail}}; +efile_gm_recv(N, Ref, Succ, Fail) -> + receive + {Ref,Mod,{ok,Res}} -> + efile_gm_recv(N-1, Ref, [{Mod,Res}|Succ], Fail); + {Ref,Mod,{error,Res}} -> + efile_gm_recv(N-1, Ref, Succ, [{Mod,Res}|Fail]) end. +efile_gm_spawn(ParentRef, Ms, Process, Paths) -> + efile_gm_spawn_1(0, Ms, ParentRef, Process, Paths). + +efile_gm_spawn_1(N, Ms, ParentRef, Process, Paths) when N >= 32 -> + receive + {'DOWN',_,process,_,_} -> + efile_gm_spawn_1(N-1, Ms, ParentRef, Process, Paths) + end; +efile_gm_spawn_1(N, [M|Ms], ParentRef, Process, Paths) -> + Get = fun() -> efile_gm_get(Paths, M, ParentRef, Process) end, + _ = spawn_monitor(Get), + efile_gm_spawn_1(N+1, Ms, ParentRef, Process, Paths); +efile_gm_spawn_1(_, [], _, _, _) -> + ok. + +efile_gm_get(Paths, Mod, ParentRef, Process) -> + File = atom_to_list(Mod) ++ init:objfile_extension(), + efile_gm_get_1(Paths, File, Mod, ParentRef, Process). + +efile_gm_get_1([P|Ps], File0, Mod, {Parent,Ref}=PR, Process) -> + File = join(P, File0), + Res = try prim_file:read_file(File) of + {ok,Bin} -> + gm_process(Mod, File, Bin, Process); + {error,enoent} -> + efile_gm_get_1(Ps, File0, Mod, PR, Process); + Error -> + check_file_result(get_modules, File, Error), + Error + catch + _:Reason -> + {error,{crash,Reason}} + end, + Parent ! {Ref,Mod,Res}; +efile_gm_get_1([], _, Mod, {Parent,Ref}, _Process) -> + Parent ! {Ref,Mod,{error,enoent}}. + +gm_get_mods(St, Get, Ms, Process, Paths) -> + gm_get_mods(St, Get, Ms, Process, Paths, [], []). + +gm_get_mods(St, Get, [M|Ms], Process, Paths, Succ, Fail) -> + File = atom_to_list(M) ++ init:objfile_extension(), + case gm_arch_get(St, Get, M, File, Paths, Process) of + {ok,Res} -> + gm_get_mods(St, Get, Ms, Process, Paths, + [{M,Res}|Succ], Fail); + {error,Res} -> + gm_get_mods(St, Get, Ms, Process, Paths, + Succ, [{M,Res}|Fail]) + end; +gm_get_mods(_St, _Get, [], _, _, Succ, Fail) -> + {ok,{Succ,Fail}}. + +gm_arch_get(St, Get, Mod, File, Paths, Process) -> + case Get(St, File, Paths) of + {{error,_}=E,_} -> + E; + {{ok,Bin,Full},_} -> + gm_process(Mod, Full, Bin, Process) + end. + +gm_process(Mod, File, Bin, Process) -> + try Process(Mod, File, Bin) of + {ok,_}=Res -> Res; + {error,_}=Res -> Res; + Other -> {error,{bad_return,Other}} + catch + _:Error -> + {error,{crash,Error}} + end. + + %%% -------------------------------------------------------- %%% Functions which handle inet prim_loader %%% -------------------------------------------------------- @@ -694,7 +745,7 @@ inet_get_file_from_port1(_File, [], State) -> inet_send_and_rcv(Msg, Tag, State) when State#state.data =:= noport -> {ok,Tcp} = find_master(State#state.hosts), %% reconnect inet_send_and_rcv(Msg, Tag, State#state{data = Tcp, - timeout = ?IDLE_TIMEOUT}); + timeout = ?INET_IDLE_TIMEOUT}); inet_send_and_rcv(Msg, Tag, #state{data = Tcp, timeout = Timeout} = State) -> prim_inet:send(Tcp, term_to_binary(Msg)), receive @@ -819,32 +870,19 @@ prim_init() -> end, cache_new(#prim_state{debug = Deb}). -prim_release_archives(PS) -> - debug(PS, release_archives), - {Res, PS2} = prim_do_release_archives(PS, get(), []), - debug(PS2, {return, Res}), - {Res, PS2}. - -prim_do_release_archives(PS, [{ArchiveFile, DictVal} | KeyVals], Acc) -> - Res = - case DictVal of - {primary, _PrimZip, _FI, _ParserFun} -> - ok; % Keep primary archive - {Cache, _FI} -> - debug(PS, {release, cache, ArchiveFile}), - erase(ArchiveFile), - clear_cache(ArchiveFile, Cache) - end, - case Res of - ok -> - prim_do_release_archives(PS, KeyVals, Acc); - {error, Reason} -> - prim_do_release_archives(PS, KeyVals, [{ArchiveFile, Reason} | Acc]) - end; -prim_do_release_archives(PS, [], []) -> - {ok, PS#prim_state{primary_archive = undefined}}; -prim_do_release_archives(PS, [], Errors) -> - {{error, Errors}, PS#prim_state{primary_archive = undefined}}. +prim_purge_cache() -> + do_prim_purge_cache(get()). + +do_prim_purge_cache([{Key,Val}|T]) -> + case Val of + {Cache,_FI} -> + catch clear_cache(Key, Cache); + _ -> + ok + end, + do_prim_purge_cache(T); +do_prim_purge_cache([]) -> + ok. prim_set_primary_archive(PS, undefined, undefined, undefined, _ParserFun) -> debug(PS, {set_primary_archive, clean}), @@ -1287,70 +1325,62 @@ path_join([Path],Acc) -> path_join([Path|Paths],Acc) -> path_join(Paths,"/" ++ reverse(Path) ++ Acc). -name_split(ArchiveFile, File0) -> - File = absname(File0), - do_name_split(ArchiveFile, File). - -do_name_split(undefined, File) -> +name_split(undefined, File) -> %% Ignore primary archive - case string_split(File, init:archive_extension(), []) of + RevExt = reverse(init:archive_extension()), + case archive_split(File, RevExt, []) of no_split -> - %% Plain file {file, File}; - {split, _RevArchiveBase, RevArchiveFile, []} -> - %% Top dir in archive - ArchiveFile = reverse(RevArchiveFile), - {archive, ArchiveFile, []}; - {split, _RevArchiveBase, RevArchiveFile, [$/ | FileInArchive]} -> - %% File in archive - ArchiveFile = reverse(RevArchiveFile), - {archive, ArchiveFile, FileInArchive}; - {split, _RevArchiveBase, _RevArchiveFile, _FileInArchive} -> - %% False match. Assume plain file - {file, File} + Archive -> + Archive end; -do_name_split(ArchiveFile, File) -> +name_split(ArchiveFile, File0) -> %% Look first in primary archive - case string_match(real_path(File), ArchiveFile, []) of + File = absname(File0), + case string_match(real_path(File), ArchiveFile) of no_match -> %% Archive or plain file - do_name_split(undefined, File); - {match, _RevPrimArchiveFile, FileInArchive} -> + name_split(undefined, File); + {match, FileInArchive} -> %% Primary archive {archive, ArchiveFile, FileInArchive} end. -string_match([Char | File], [Char | Archive], RevTop) -> - string_match(File, Archive, [Char | RevTop]); -string_match([] = File, [], RevTop) -> - {match, RevTop, File}; -string_match([$/ | File], [], RevTop) -> - {match, RevTop, File}; -string_match(_File, _Archive, _RevTop) -> +string_match([Char | File], [Char | Archive]) -> + string_match(File, Archive); +string_match([] = File, []) -> + {match, File}; +string_match([$/ | File], []) -> + {match, File}; +string_match(_File, _Archive) -> no_match. -string_split([Char | File], [Char | Ext] = FullExt, RevTop) -> - RevTop2 = [Char | RevTop], - string_split2(File, Ext, RevTop, RevTop2, File, FullExt, RevTop2); -string_split([Char | File], Ext, RevTop) -> - string_split(File, Ext, [Char | RevTop]); -string_split([], _Ext, _RevTop) -> - no_split. - -string_split2([Char | File], [Char | Ext], RevBase, RevTop, SaveFile, SaveExt, SaveTop) -> - string_split2(File, Ext, RevBase, [Char | RevTop], SaveFile, SaveExt, SaveTop); -string_split2(File, [], RevBase, RevTop, _SaveFile, _SaveExt, _SaveTop) -> - {split, RevBase, RevTop, File}; -string_split2(_, _Ext, _RevBase, _RevTop, SaveFile, SaveExt, SaveTop) -> - string_split(SaveFile, SaveExt, SaveTop). +archive_split("/"++File, RevExt, Acc) -> + case is_prefix(RevExt, Acc) of + false -> + archive_split(File, RevExt, [$/|Acc]); + true -> + ArchiveFile = absname(reverse(Acc)), + {archive, ArchiveFile, File} + end; +archive_split([H|T], RevExt, Acc) -> + archive_split(T, RevExt, [H|Acc]); +archive_split([], RevExt, Acc) -> + case is_prefix(RevExt, Acc) of + false -> + no_split; + true -> + ArchiveFile = absname(reverse(Acc)), + {archive, ArchiveFile, []} + end. + +is_prefix([H|T1], [H|T2]) -> is_prefix(T1, T2); +is_prefix([_|_], _) -> false; +is_prefix([], _ ) -> true. %% Parse list of ipv4 addresses ipv4_list([H | T]) -> - IPV = if is_atom(H) -> ipv4_address(atom_to_list(H)); - is_list(H) -> ipv4_address(H); - true -> {error,einal} - end, - case IPV of + case ipv4_address(H) of {ok,IP} -> [IP | ipv4_list(T)]; _ -> ipv4_list(T) end; @@ -1415,8 +1445,6 @@ absname_vr([Drive, $\: | NameRest], _) -> %% Assumes normalized name pathtype(Name) when is_list(Name) -> case erlang:system_info(os_type) of - {ose, _} -> - unix_pathtype(Name); {unix, _} -> unix_pathtype(Name); {win32, _} -> diff --git a/erts/preloaded/src/erl_tracer.erl b/erts/preloaded/src/erl_tracer.erl new file mode 100644 index 0000000000..de1e9ca01e --- /dev/null +++ b/erts/preloaded/src/erl_tracer.erl @@ -0,0 +1,59 @@ +-module(erl_tracer). + +-export([enabled/3, trace/6, on_load/0]). + +-type tracee() :: port() | pid() | undefined. + +-type trace_tag_running_ports() :: in | out | in_exiting | out_exiting | out_exited. +-type trace_tag_running_procs() :: in | out | in_exiting | out_exiting | out_exited. +-type trace_tag_send() :: send | send_to_non_existing_process. +-type trace_tag_receive() :: 'receive'. +-type trace_tag_call() :: call | return_to | return_from | exception_from. +-type trace_tag_procs() :: spawn | spawned | exit | link | unlink + | getting_linked | getting_unlinked + | register | unregister. +-type trace_tag_ports() :: open | closed | link | unlink + | getting_linked | getting_unlinked. +-type trace_tag_gc() :: gc_minor_start | gc_minor_end + | gc_major_start | gc_major_end. + +-type trace_tag() :: trace_tag_send() + | trace_tag_receive() + | trace_tag_call() + | trace_tag_procs() + | trace_tag_ports() + | trace_tag_running_procs() + | trace_tag_running_ports() + | trace_tag_gc(). + +-type trace_opts() :: #{ match_spec_result => true | term(), + scheduler_id => undefined | non_neg_integer(), + timestamp => undefined | timestamp | cpu_timestamp | + monotonic | strict_monotonic }. +-type tracer_state() :: term(). + +on_load() -> + case erlang:load_nif(atom_to_list(?MODULE), 0) of + ok -> ok + end. + +%%% +%%% NIF placeholders +%%% + +-spec enabled(Tag :: trace_tag() | seq_trace | trace_status, + TracerState :: tracer_state(), + Tracee :: tracee()) -> + trace | discard | remove. +enabled(_, _, _) -> + erlang:nif_error(nif_not_loaded). + +-spec trace(Tag :: trace_tag() | seq_trace, + TracerState :: tracer_state(), + Tracee :: tracee(), + Msg :: term(), + Extra :: term(), + Opts :: trace_opts()) -> any(). + +trace(_, _, _, _, _, _) -> + erlang:nif_error(nif_not_loaded). diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 063b9a1f26..20a64e81b4 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -71,7 +71,8 @@ | 'milli_seconds' | 'micro_seconds' | 'nano_seconds' - | 'native'. + | 'native' + | 'perf_counter'. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Native code BIF stubs and their types @@ -104,7 +105,9 @@ -export([garbage_collect/0, garbage_collect/1, garbage_collect/2]). -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([group_leader/2]). +-export([halt/0, halt/1, halt/2, hash/2, + has_prepared_code_on_load/1, hibernate/3]). -export([insert_element/3]). -export([integer_to_binary/1, integer_to_list/1]). -export([iolist_size/1, iolist_to_binary/1]). @@ -227,27 +230,32 @@ send | 'receive' | procs | + ports | call | - silent | + arity | return_to | + silent | running | exiting | + running_procs | + running_ports | garbage_collection | timestamp | cpu_timestamp | monotonic_timestamp | strict_monotonic_timestamp | - arity | set_on_spawn | set_on_first_spawn | set_on_link | set_on_first_link | - {tracer, pid() | port()}. + {tracer, pid() | port()} | + {tracer, module(), term()}. -type trace_info_item_result() :: {traced, global | local | false | undefined} | {match_spec, trace_match_spec() | false | undefined} | {meta, pid() | port() | false | undefined | []} | + {meta, module(), term() } | {meta_match_spec, trace_match_spec() | false | undefined} | {call_count, non_neg_integer() | boolean() | undefined} | {call_time, [{pid(), non_neg_integer(), @@ -273,6 +281,7 @@ undefined | {flags, [trace_info_flag()]} | {tracer, pid() | port() | []} | + {tracer, module(), term()} | trace_info_item_result() | {all, [ trace_info_item_result() ] | false | undefined}. @@ -469,7 +478,7 @@ check_old_code(_Module) -> CheckResult :: boolean(). check_process_code(Pid, Module) -> try - erlang:check_process_code(Pid, Module, [{allow_gc, true}]) + erts_internal:check_process_code(Pid, Module, [{allow_gc, true}]) catch error:Error -> erlang:error(Error, [Pid, Module]) end. @@ -484,51 +493,11 @@ check_process_code(Pid, Module) -> CheckResult :: boolean() | aborted. check_process_code(Pid, Module, OptionList) -> try - {Async, AllowGC} = get_cpc_opts(OptionList, sync, true), - case Async of - {async, ReqId} -> - {priority, Prio} = erlang:process_info(erlang:self(), - priority), - erts_internal:request_system_task(Pid, - Prio, - {check_process_code, - ReqId, - Module, - AllowGC}), - async; - sync -> - case Pid == erlang:self() of - true -> - erts_internal:check_process_code(Module, - [{allow_gc, AllowGC}]); - false -> - {priority, Prio} = erlang:process_info(erlang:self(), - priority), - ReqId = erlang:make_ref(), - erts_internal:request_system_task(Pid, - Prio, - {check_process_code, - ReqId, - Module, - AllowGC}), - receive - {check_process_code, ReqId, CheckResult} -> - CheckResult - end - end - end + erts_internal:check_process_code(Pid, Module, OptionList) catch error:Error -> erlang:error(Error, [Pid, Module, OptionList]) end. -% gets async and allow_gc opts and verify valid option list -get_cpc_opts([{async, _ReqId} = AsyncTuple | Options], _OldAsync, AllowGC) -> - get_cpc_opts(Options, AsyncTuple, AllowGC); -get_cpc_opts([{allow_gc, AllowGC} | Options], Async, _OldAllowGC) -> - get_cpc_opts(Options, Async, AllowGC); -get_cpc_opts([], Async, AllowGC) -> - {Async, AllowGC}. - %% crc32/1 -spec erlang:crc32(Data) -> non_neg_integer() when Data :: iodata(). @@ -1036,6 +1005,12 @@ halt(_Status, _Options) -> hash(_Term, _Range) -> erlang:nif_error(undefined). +%% has_prepared_code_on_load/1 +-spec erlang:has_prepared_code_on_load(PreparedCode) -> boolean() when + PreparedCode :: binary(). +has_prepared_code_on_load(_PreparedCode) -> + erlang:nif_error(undefined). + %% hibernate/3 -spec erlang:hibernate(Module, Function, Args) -> no_return() when Module :: module(), @@ -1188,10 +1163,10 @@ map_size(_Map) -> erlang:nif_error(undefined). %% match_spec_test/3 --spec erlang:match_spec_test(P1, P2, P3) -> TestResult when - P1 :: [term()] | tuple(), - P2 :: term(), - P3 :: table | trace, +-spec erlang:match_spec_test(MatchAgainst, MatchSpec, Type) -> TestResult when + MatchAgainst :: [term()] | tuple(), + MatchSpec :: term(), + Type :: table | trace, TestResult :: {ok, term(), [return_trace], [ {error | warning, string()} ]} | {error, [ {error | warning, string()} ]}. match_spec_test(_P1, _P2, _P3) -> erlang:nif_error(undefined). @@ -1387,6 +1362,7 @@ convert_time_unit(Time, FromUnit, ToUnit) -> try FU = case FromUnit of native -> erts_internal:time_unit(); + perf_counter -> erts_internal:perf_counter_unit(); nano_seconds -> 1000*1000*1000; micro_seconds -> 1000*1000; milli_seconds -> 1000; @@ -1395,6 +1371,7 @@ convert_time_unit(Time, FromUnit, ToUnit) -> end, TU = case ToUnit of native -> erts_internal:time_unit(); + perf_counter -> erts_internal:perf_counter_unit(); nano_seconds -> 1000*1000*1000; micro_seconds -> 1000*1000; milli_seconds -> 1000; @@ -1473,8 +1450,16 @@ processes() -> %% purge_module/1 -spec purge_module(Module) -> true when Module :: atom(). -purge_module(_Module) -> - erlang:nif_error(undefined). +purge_module(Module) when erlang:is_atom(Module) -> + case erts_code_purger:purge(Module) of + {false, _} -> + erlang:error(badarg, [Module]); + {true, _} -> + true + end; +purge_module(Arg) -> + erlang:error(badarg, [Arg]). + %% put/2 -spec put(Key, Val) -> term() when @@ -1726,12 +1711,35 @@ time() -> erlang:nif_error(undefined). %% trace/3 --spec erlang:trace(PidSpec, How, FlagList) -> integer() when - PidSpec :: pid() | existing | new | all, +-spec erlang:trace(PidPortSpec, How, FlagList) -> integer() when + PidPortSpec :: pid() | port() + | all | processes | ports + | existing | existing_processes | existing_ports + | new | new_processes | new_ports, How :: boolean(), FlagList :: [trace_flag()]. -trace(_PidSpec, _How, _FlagList) -> - erlang:nif_error(undefined). +trace(PidPortSpec, How, FlagList) -> + %% Make sure that we have loaded the tracer module + case lists:keyfind(tracer, 1, FlagList) of + {tracer, Module, State} when erlang:is_atom(Module) -> + case erlang:module_loaded(Module) of + false -> + Module:enabled(trace_status, erlang:self(), State); + true -> + ok + end; + _ -> + ignore + end, + + try erts_internal:trace(PidPortSpec, How, FlagList) of + Res -> Res + catch E:R -> + {_, [_ | CST]} = erlang:process_info( + erlang:self(), current_stacktrace), + erlang:raise( + E, R, [{?MODULE, trace, [PidPortSpec, How, FlagList], []} | CST]) + end. %% trace_delivered/1 -spec erlang:trace_delivered(Tracee) -> Ref when @@ -1741,14 +1749,16 @@ trace_delivered(_Tracee) -> erlang:nif_error(undefined). %% trace_info/2 --spec erlang:trace_info(PidOrFunc, Item) -> Res when - PidOrFunc :: pid() | new | {Module, Function, Arity} | on_load, +-spec erlang:trace_info(PidPortOrFunc, Item) -> Res when + PidPortOrFunc :: pid() | port() | new | new_processes | new_ports + | {Module, Function, Arity} | on_load, Module :: module(), Function :: atom(), Arity :: arity(), - Item :: flags | tracer | traced | match_spec | meta | meta_match_spec | call_count | call_time | all, + Item :: flags | tracer | traced | match_spec + | meta | meta_match_spec | call_count | call_time | all, Res :: trace_info_return(). -trace_info(_PidOrFunc, _Item) -> +trace_info(_PidPortOrFunc, _Item) -> erlang:nif_error(undefined). %% trunc/1 @@ -2036,12 +2046,21 @@ nodes(_Arg) -> | eof | {parallelism, Boolean :: boolean()} | hide. -open_port(_PortName,_PortSettings) -> - erlang:nif_error(undefined). +open_port(PortName, PortSettings) -> + case case erts_internal:open_port(PortName, PortSettings) of + Ref when erlang:is_reference(Ref) -> receive {Ref, Res} -> Res end; + Res -> Res + end of + Port when erlang:is_port(Port) -> Port; + Error -> erlang:error(Error, [PortName, PortSettings]) + end. -type priority_level() :: low | normal | high | max. +-type message_queue_data() :: + off_heap | on_heap | mixed. + -spec process_flag(trap_exit, Boolean) -> OldBoolean when Boolean :: boolean(), OldBoolean :: boolean(); @@ -2054,6 +2073,9 @@ open_port(_PortName,_PortSettings) -> (min_bin_vheap_size, MinBinVHeapSize) -> OldMinBinVHeapSize when MinBinVHeapSize :: non_neg_integer(), OldMinBinVHeapSize :: non_neg_integer(); + (message_queue_data, MQD) -> OldMQD when + MQD :: message_queue_data(), + OldMQD :: message_queue_data(); (priority, Level) -> OldLevel when Level :: priority_level(), OldLevel :: priority_level(); @@ -2080,6 +2102,7 @@ process_flag(_Flag, _Value) -> dictionary | error_handler | garbage_collection | + garbage_collection_info | group_leader | heap_size | initial_call | @@ -2092,6 +2115,7 @@ process_flag(_Flag, _Value) -> min_bin_vheap_size | monitored_by | monitors | + message_queue_data | priority | reductions | registered_name | @@ -2119,6 +2143,7 @@ process_flag(_Flag, _Value) -> {dictionary, Dictionary :: [{Key :: term(), Value :: term()}]} | {error_handler, Module :: module()} | {garbage_collection, GCInfo :: [{atom(),non_neg_integer()}]} | + {garbage_collection_info, GCInfo :: [{atom(),non_neg_integer()}]} | {group_leader, GroupLeader :: pid()} | {heap_size, Size :: non_neg_integer()} | {initial_call, mfa()} | @@ -2133,9 +2158,10 @@ process_flag(_Flag, _Value) -> {monitors, Monitors :: [{process, Pid :: pid() | {RegName :: atom(), Node :: node()}}]} | + {message_queue_data, MQD :: message_queue_data()} | {priority, Level :: priority_level()} | {reductions, Number :: non_neg_integer()} | - {registered_name, Atom :: atom()} | + {registered_name, [] | (Atom :: atom())} | {sequential_trace_token, [] | (SequentialTraceToken :: term())} | {stack_size, Size :: non_neg_integer()} | {status, Status :: exiting | garbage_collecting | waiting | running | runnable | suspended} | @@ -2230,6 +2256,16 @@ spawn_opt(_Tuple) -> (io) -> {{input, Input}, {output, Output}} when Input :: non_neg_integer(), Output :: non_neg_integer(); + (microstate_accounting) -> [MSAcc_Thread] | undefined when + MSAcc_Thread :: #{ type := MSAcc_Thread_Type, + id := MSAcc_Thread_Id, + counters := MSAcc_Counters}, + MSAcc_Thread_Type :: scheduler | async | aux, + MSAcc_Thread_Id :: non_neg_integer(), + MSAcc_Counters :: #{ MSAcc_Thread_State => non_neg_integer() }, + MSAcc_Thread_State :: alloc | aux | bif | busy_wait | check_io | + emulator | ets | gc | gc_fullsweep | nif | + other | port | send | sleep | timers; (reductions) -> {Total_Reductions, Reductions_Since_Last_Call} when Total_Reductions :: non_neg_integer(), @@ -2284,6 +2320,9 @@ subtract(_,_) -> (fullsweep_after, Number) -> OldNumber when Number :: non_neg_integer(), OldNumber :: non_neg_integer(); + (microstate_accounting, Action) -> OldState when + Action :: true | false | reset, + OldState :: true | false; (min_heap_size, MinHeapSize) -> OldMinHeapSize when MinHeapSize :: non_neg_integer(), OldMinHeapSize :: non_neg_integer(); @@ -2292,8 +2331,8 @@ subtract(_,_) -> MinBinVHeapSize :: non_neg_integer(), OldMinBinVHeapSize :: non_neg_integer(); (multi_scheduling, BlockState) -> OldBlockState when - BlockState :: block | unblock, - OldBlockState :: block | unblock | enabled; + BlockState :: block | unblock | block_normal | unblock_normal, + OldBlockState :: blocked | disabled | enabled; (scheduler_bind_type, How) -> OldBindType when How :: scheduler_bind_type() | default_bind, OldBindType :: scheduler_bind_type(); @@ -2311,7 +2350,7 @@ subtract(_,_) -> OldState :: preliminary | final | volatile; %% These are deliberately not documented (internal_cpu_topology, term()) -> term(); - (sequential_tracer, pid() | port() | false) -> pid() | port() | false; + (sequential_tracer, pid() | port() | {module(), term()} | false) -> pid() | port() | false; (1,0) -> true. system_flag(_Flag, _Value) -> @@ -2347,12 +2386,20 @@ tl(_List) -> | boolean() | restart | pause. -trace_pattern(_MFA, _MatchSpec) -> - erlang:nif_error(undefined). +trace_pattern(MFA, MatchSpec) -> + try erts_internal:trace_pattern(MFA, MatchSpec, []) of + Res -> Res + catch E:R -> + {_, [_ | CST]} = erlang:process_info( + erlang:self(), current_stacktrace), + erlang:raise( + E, R, [{?MODULE, trace_pattern, [MFA, MatchSpec], []} | CST]) + end. -type trace_pattern_flag() :: global | local | meta | {meta, Pid :: pid()} | + {meta, TracerModule :: module(), TracerState :: term()} | call_count | call_time. @@ -2363,8 +2410,28 @@ trace_pattern(_MFA, _MatchSpec) -> | restart | pause, FlagList :: [ trace_pattern_flag() ]. -trace_pattern(_MFA, _MatchSpec, _FlagList) -> - erlang:nif_error(undefined). +trace_pattern(MFA, MatchSpec, FlagList) -> + %% Make sure that we have loaded the tracer module + case lists:keyfind(meta, 1, FlagList) of + {meta, Module, State} when erlang:is_atom(Module) -> + case erlang:module_loaded(Module) of + false -> + Module:enabled(trace_status, erlang:self(), State); + true -> + ok + end; + _ -> + ignore + end, + + try erts_internal:trace_pattern(MFA, MatchSpec, FlagList) of + Res -> Res + catch E:R -> + {_, [_ | CST]} = erlang:process_info( + erlang:self(), current_stacktrace), + erlang:raise( + E, R, [{?MODULE, trace_pattern, [MFA, MatchSpec, FlagList], []} | CST]) + end. %% Shadowed by erl_bif_types: erlang:tuple_to_list/1 -spec tuple_to_list(Tuple) -> [term()] when @@ -2438,13 +2505,15 @@ tuple_to_list(_Tuple) -> logical_processors_available | logical_processors_online) -> unknown | pos_integer(); (machine) -> string(); + (message_queue_data) -> message_queue_data(); (min_heap_size) -> {min_heap_size, MinHeapSize :: pos_integer()}; (min_bin_vheap_size) -> {min_bin_vheap_size, MinBinVHeapSize :: pos_integer()}; (modified_timing_level) -> integer() | undefined; - (multi_scheduling) -> disabled | blocked | enabled; + (multi_scheduling) -> disabled | blocked | blocked_normal | enabled; (multi_scheduling_blockers) -> [Pid :: pid()]; (nif_version) -> string(); + (normal_multi_scheduling_blockers) -> [Pid :: pid()]; (otp_release) -> string(); (os_monotonic_time_source) -> [{atom(),term()}]; (os_system_time_source) -> [{atom(),term()}]; @@ -2572,14 +2641,19 @@ spawn_monitor(M, F, A) when erlang:is_atom(M), spawn_monitor(M, F, A) -> erlang:error(badarg, [M,F,A]). + +-type spawn_opt_option() :: + link + | monitor + | {priority, Level :: priority_level()} + | {fullsweep_after, Number :: non_neg_integer()} + | {min_heap_size, Size :: non_neg_integer()} + | {min_bin_vheap_size, VSize :: non_neg_integer()} + | {message_queue_data, MQD :: message_queue_data()}. + -spec spawn_opt(Fun, Options) -> pid() | {pid(), reference()} when Fun :: function(), - Options :: [Option], - Option :: link | monitor - | {priority, Level :: priority_level()} - | {fullsweep_after, Number :: non_neg_integer()} - | {min_heap_size, Size :: non_neg_integer()} - | {min_bin_vheap_size, VSize :: non_neg_integer()}. + Options :: [spawn_opt_option()]. spawn_opt(F, O) when erlang:is_function(F) -> spawn_opt(erlang, apply, [F, []], O); spawn_opt({M,F}=MF, O) when erlang:is_atom(M), erlang:is_atom(F) -> @@ -2592,12 +2666,7 @@ spawn_opt(F, O) -> -spec spawn_opt(Node, Fun, Options) -> pid() | {pid(), reference()} when Node :: node(), Fun :: function(), - Options :: [Option], - Option :: link | monitor - | {priority, Level :: priority_level()} - | {fullsweep_after, Number :: non_neg_integer()} - | {min_heap_size, Size :: non_neg_integer()} - | {min_bin_vheap_size, VSize :: non_neg_integer()}. + Options :: [spawn_opt_option()]. spawn_opt(N, F, O) when N =:= erlang:node() -> spawn_opt(F, O); spawn_opt(N, F, O) when erlang:is_function(F) -> @@ -2684,12 +2753,7 @@ spawn_link(N,M,F,A) -> Module :: module(), Function :: atom(), Args :: [term()], - Options :: [Option], - Option :: link | monitor - | {priority, Level :: priority_level()} - | {fullsweep_after, Number :: non_neg_integer()} - | {min_heap_size, Size :: non_neg_integer()} - | {min_bin_vheap_size, VSize :: non_neg_integer()}. + Options :: [spawn_opt_option()]. spawn_opt(M, F, A, Opts) -> case catch erlang:spawn_opt({M,F,A,Opts}) of {'EXIT',{Reason,_}} -> @@ -2704,12 +2768,7 @@ spawn_opt(M, F, A, Opts) -> Module :: module(), Function :: atom(), Args :: [term()], - Options :: [Option], - Option :: link | monitor - | {priority, Level :: priority_level()} - | {fullsweep_after, Number :: non_neg_integer()} - | {min_heap_size, Size :: non_neg_integer()} - | {min_bin_vheap_size, VSize :: non_neg_integer()}. + Options :: [spawn_opt_option()]. spawn_opt(N, M, F, A, O) when N =:= erlang:node(), erlang:is_atom(M), erlang:is_atom(F), erlang:is_list(A), erlang:is_list(O) -> diff --git a/erts/preloaded/src/erts.app.src b/erts/preloaded/src/erts.app.src index 8442aaf7e8..98e0224a5f 100644 --- a/erts/preloaded/src/erts.app.src +++ b/erts/preloaded/src/erts.app.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -27,6 +27,7 @@ erts_internal, init, otp_ring0, + erts_code_purger, prim_eval, prim_file, prim_inet, diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl new file mode 100644 index 0000000000..d1e64342e0 --- /dev/null +++ b/erts/preloaded/src/erts_code_purger.erl @@ -0,0 +1,299 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(erts_code_purger). + +%% Purpose : Implement system process erts_code_purger +%% to handle code module purging. + +-export([start/0, purge/1, soft_purge/1]). + +-spec start() -> term(). +start() -> + register(erts_code_purger, self()), + process_flag(trap_exit, true), + loop(). + +loop() -> + _ = receive + {purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) -> + Res = do_purge(Mod), + From ! {reply, purge, Res, Ref}; + + {soft_purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) -> + Res = do_soft_purge(Mod), + From ! {reply, soft_purge, Res, Ref}; + + _Other -> ignore + end, + loop(). + + +%% purge(Module) +%% Kill all processes running code from *old* Module, and then purge the +%% module. Return {WasOld, DidKill}: +%% {false, false} there was no old module to purge +%% {true, false} module purged, no process killed +%% {true, true} module purged, at least one process killed + +purge(Mod) when is_atom(Mod) -> + Ref = make_ref(), + erts_code_purger ! {purge, Mod, self(), Ref}, + receive + {reply, purge, Result, Ref} -> + Result + end. + + +do_purge(Mod) -> + case erts_internal:copy_literals(Mod, true) of + false -> + {false, false}; + true -> + DidKill = check_proc_code(erlang:processes(), Mod, true), + true = erts_internal:copy_literals(Mod, false), + WasPurged = erts_internal:purge_module(Mod), + {WasPurged, DidKill} + end. + +%% soft_purge(Module) +%% Purge old code only if no procs remain that run old code. +%% Return true in that case, false if procs remain (in this +%% case old code is not purged) + +soft_purge(Mod) -> + Ref = make_ref(), + erts_code_purger ! {soft_purge, Mod, self(), Ref}, + receive + {reply, soft_purge, Result, Ref} -> + Result + end. + + +do_soft_purge(Mod) -> + case erts_internal:copy_literals(Mod, true) of + false -> + true; + true -> + DoPurge = check_proc_code(erlang:processes(), Mod, false), + true = erts_internal:copy_literals(Mod, false), + case DoPurge of + false -> + false; + true -> + erts_internal:purge_module(Mod), + true + end + end. + +%% +%% check_proc_code(Pids, Mod, Hard) - Send asynchronous +%% requests to all processes to perform a check_process_code +%% operation. Each process will check their own state and +%% reply with the result. If 'Hard' equals +%% - true, processes that refer 'Mod' will be killed. If +%% any processes were killed true is returned; otherwise, +%% false. +%% - false, and any processes refer 'Mod', false will +%% returned; otherwise, true. +%% +%% Requests will be sent to all processes identified by +%% Pids at once, but without allowing GC to be performed. +%% Check process code operations that are aborted due to +%% GC need, will be restarted allowing GC. However, only +%% ?MAX_CPC_GC_PROCS outstanding operation allowing GC at +%% a time will be allowed. This in order not to blow up +%% memory wise. +%% +%% We also only allow ?MAX_CPC_NO_OUTSTANDING_KILLS +%% outstanding kills. This both in order to avoid flooding +%% our message queue with 'DOWN' messages and limiting the +%% amount of memory used to keep references to all +%% outstanding kills. +%% + +%% We maybe should allow more than two outstanding +%% GC requests, but for now we play it safe... +-define(MAX_CPC_GC_PROCS, 2). +-define(MAX_CPC_NO_OUTSTANDING_KILLS, 10). + +-record(cpc_static, {hard, module, tag}). + +-record(cpc_kill, {outstanding = [], + no_outstanding = 0, + waiting = [], + killed = false}). + +check_proc_code(Pids, Mod, Hard) -> + Tag = erlang:make_ref(), + CpcS = #cpc_static{hard = Hard, + module = Mod, + tag = Tag}, + check_proc_code(CpcS, cpc_init(CpcS, Pids, 0), 0, [], #cpc_kill{}, true). + +check_proc_code(#cpc_static{hard = true}, 0, 0, [], + #cpc_kill{outstanding = [], waiting = [], killed = Killed}, + true) -> + %% No outstanding requests. We did a hard check, so result is whether or + %% not we killed any processes... + Killed; +check_proc_code(#cpc_static{hard = false}, 0, 0, [], _KillState, Success) -> + %% No outstanding requests and we did a soft check... + Success; +check_proc_code(#cpc_static{hard = false, tag = Tag} = CpcS, NoReq0, NoGcReq0, + [], _KillState, false) -> + %% Failed soft check; just cleanup the remaining replies corresponding + %% to the requests we've sent... + {NoReq1, NoGcReq1} = receive + {check_process_code, {Tag, _P, GC}, _Res} -> + case GC of + false -> {NoReq0-1, NoGcReq0}; + true -> {NoReq0, NoGcReq0-1} + end + end, + check_proc_code(CpcS, NoReq1, NoGcReq1, [], _KillState, false); +check_proc_code(#cpc_static{tag = Tag} = CpcS, NoReq0, NoGcReq0, NeedGC0, + KillState0, Success) -> + + %% Check if we should request a GC operation + {NoGcReq1, NeedGC1} = case NoGcReq0 < ?MAX_CPC_GC_PROCS of + GcOpAllowed when GcOpAllowed == false; + NeedGC0 == [] -> + {NoGcReq0, NeedGC0}; + _ -> + {NoGcReq0+1, cpc_request_gc(CpcS,NeedGC0)} + end, + + %% Wait for a cpc reply or 'DOWN' message + {NoReq1, NoGcReq2, Pid, Result, KillState1} = cpc_recv(Tag, + NoReq0, + NoGcReq1, + KillState0), + + %% Check the result of the reply + case Result of + aborted -> + %% Operation aborted due to the need to GC in order to + %% determine if the process is referring the module. + %% Schedule the operation for restart allowing GC... + check_proc_code(CpcS, NoReq1, NoGcReq2, [Pid|NeedGC1], KillState1, + Success); + false -> + %% Process not referring the module; done with this process... + check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, KillState1, + Success); + true -> + %% Process referring the module... + case CpcS#cpc_static.hard of + false -> + %% ... and soft check. The whole operation failed so + %% no point continuing; clean up and fail... + check_proc_code(CpcS, NoReq1, NoGcReq2, [], KillState1, + false); + true -> + %% ... and hard check; schedule kill of it... + check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, + cpc_sched_kill(Pid, KillState1), Success) + end; + 'DOWN' -> + %% Handled 'DOWN' message + check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, + KillState1, Success) + end. + +cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = []} = KillState) -> + receive + {check_process_code, {Tag, Pid, GC}, Res} -> + cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState) + end; +cpc_recv(Tag, NoReq, NoGcReq, + #cpc_kill{outstanding = [R0, R1, R2, R3, R4 | _]} = KillState) -> + receive + {'DOWN', R, process, _, _} when R == R0; + R == R1; + R == R2; + R == R3; + R == R4 -> + cpc_handle_down(NoReq, NoGcReq, R, KillState); + {check_process_code, {Tag, Pid, GC}, Res} -> + cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState) + end; +cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = [R|_]} = KillState) -> + receive + {'DOWN', R, process, _, _} -> + cpc_handle_down(NoReq, NoGcReq, R, KillState); + {check_process_code, {Tag, Pid, GC}, Res} -> + cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState) + end. + +cpc_handle_down(NoReq, NoGcReq, R, #cpc_kill{outstanding = Rs, + no_outstanding = N} = KillState) -> + {NoReq, NoGcReq, undefined, 'DOWN', + cpc_sched_kill_waiting(KillState#cpc_kill{outstanding = cpc_list_rm(R, Rs), + no_outstanding = N-1})}. + +cpc_list_rm(R, [R|Rs]) -> + Rs; +cpc_list_rm(R0, [R1|Rs]) -> + [R1|cpc_list_rm(R0, Rs)]. + +cpc_handle_cpc(NoReq, NoGcReq, false, Pid, Res, KillState) -> + {NoReq-1, NoGcReq, Pid, Res, KillState}; +cpc_handle_cpc(NoReq, NoGcReq, true, Pid, Res, KillState) -> + {NoReq, NoGcReq-1, Pid, Res, KillState}. + +cpc_sched_kill_waiting(#cpc_kill{waiting = []} = KillState) -> + KillState; +cpc_sched_kill_waiting(#cpc_kill{outstanding = Rs, + no_outstanding = N, + waiting = [P|Ps]} = KillState) -> + R = erlang:monitor(process, P), + exit(P, kill), + KillState#cpc_kill{outstanding = [R|Rs], + no_outstanding = N+1, + waiting = Ps, + killed = true}. + +cpc_sched_kill(Pid, #cpc_kill{no_outstanding = N, waiting = Pids} = KillState) + when N >= ?MAX_CPC_NO_OUTSTANDING_KILLS -> + KillState#cpc_kill{waiting = [Pid|Pids]}; +cpc_sched_kill(Pid, + #cpc_kill{outstanding = Rs, no_outstanding = N} = KillState) -> + R = erlang:monitor(process, Pid), + exit(Pid, kill), + KillState#cpc_kill{outstanding = [R|Rs], + no_outstanding = N+1, + killed = true}. + +cpc_request(#cpc_static{tag = Tag, module = Mod}, Pid, AllowGc) -> + erts_internal:check_process_code(Pid, Mod, [{async, {Tag, Pid, AllowGc}}, + {allow_gc, AllowGc}, + {copy_literals, true}]). + +cpc_request_gc(CpcS, [Pid|Pids]) -> + cpc_request(CpcS, Pid, true), + Pids. + +cpc_init(_CpcS, [], NoReqs) -> + NoReqs; +cpc_init(CpcS, [Pid|Pids], NoReqs) -> + cpc_request(CpcS, Pid, false), + cpc_init(CpcS, Pids, NoReqs+1). + +% end of check_proc_code() implementation. diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 6db77a8482..2459ea2a2c 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% Copyright Ericsson AB 2012-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -31,8 +31,8 @@ -export([await_port_send_result/3]). -export([cmp_term/2]). --export([map_to_tuple_keys/1, map_type/1, map_hashmap_children/1]). --export([port_command/3, port_connect/2, port_close/1, +-export([map_to_tuple_keys/1, term_type/1, map_hashmap_children/1]). +-export([open_port/2, port_command/3, port_connect/2, port_close/1, port_control/3, port_call/3, port_info/1, port_info/2]). -export([system_check/1, @@ -40,16 +40,26 @@ -export([request_system_task/3]). --export([check_process_code/2]). +-export([check_process_code/3]). +-export([copy_literals/2]). +-export([purge_module/1]). -export([flush_monitor_messages/3]). -export([await_result/1, gather_io_bytes/2]). --export([time_unit/0]). +-export([time_unit/0, perf_counter_unit/0]). -export([is_system_process/1]). +-export([await_microstate_accounting_modifications/3, + gather_microstate_accounting_result/2]). + +-export([trace/3, trace_pattern/3]). + +%% Auto import name clash +-export([check_process_code/2]). + %% %% Await result of send to port %% @@ -91,6 +101,13 @@ gather_io_bytes(Ref, No, InAcc, OutAcc) -> %% Statically linked port NIFs %% +-spec erts_internal:open_port(PortName, PortSettings) -> Result when + PortName :: tuple(), + PortSettings :: term(), + Result :: port() | reference() | atom(). +open_port(_PortName, _PortSettings) -> + erlang:nif_error(undefined). + -spec erts_internal:port_command(Port, Data, OptionList) -> Result when Port :: port() | atom(), Data :: iodata(), @@ -187,17 +204,86 @@ port_info(_Result, _Item) -> -spec request_system_task(Pid, Prio, Request) -> 'ok' when Prio :: 'max' | 'high' | 'normal' | 'low', Request :: {'garbage_collect', term()} - | {'check_process_code', term(), module(), boolean()}, + | {'check_process_code', term(), module(), non_neg_integer()}, Pid :: pid(). request_system_task(_Pid, _Prio, _Request) -> erlang:nif_error(undefined). --spec check_process_code(Module, OptionList) -> boolean() when +-define(ERTS_CPC_ALLOW_GC, (1 bsl 0)). +-define(ERTS_CPC_COPY_LITERALS, (1 bsl 1)). + +-spec check_process_code(Module, Flags) -> boolean() when Module :: module(), - Option :: {allow_gc, boolean()}, - OptionList :: [Option]. -check_process_code(_Module, _OptionList) -> + Flags :: non_neg_integer(). +check_process_code(_Module, _Flags) -> + erlang:nif_error(undefined). + +-spec check_process_code(Pid, Module, OptionList) -> CheckResult | async when + Pid :: pid(), + Module :: module(), + RequestId :: term(), + Option :: {async, RequestId} | {allow_gc, boolean()} | {copy_literals, boolean()}, + OptionList :: [Option], + CheckResult :: boolean() | aborted. +check_process_code(Pid, Module, OptionList) -> + {Async, Flags} = get_cpc_opts(OptionList, sync, ?ERTS_CPC_ALLOW_GC), + case Async of + {async, ReqId} -> + {priority, Prio} = erlang:process_info(erlang:self(), + priority), + erts_internal:request_system_task(Pid, + Prio, + {check_process_code, + ReqId, + Module, + Flags}), + async; + sync -> + case Pid == erlang:self() of + true -> + erts_internal:check_process_code(Module, Flags); + false -> + {priority, Prio} = erlang:process_info(erlang:self(), + priority), + ReqId = erlang:make_ref(), + erts_internal:request_system_task(Pid, + Prio, + {check_process_code, + ReqId, + Module, + Flags}), + receive + {check_process_code, ReqId, CheckResult} -> + CheckResult + end + end + end. + +% gets async and flag opts and verify valid option list +get_cpc_opts([{async, _ReqId} = AsyncTuple | Options], _OldAsync, Flags) -> + get_cpc_opts(Options, AsyncTuple, Flags); +get_cpc_opts([{allow_gc, AllowGC} | Options], Async, Flags) -> + get_cpc_opts(Options, Async, cpc_flags(Flags, ?ERTS_CPC_ALLOW_GC, AllowGC)); +get_cpc_opts([{copy_literals, CopyLit} | Options], Async, Flags) -> + get_cpc_opts(Options, Async, cpc_flags(Flags, ?ERTS_CPC_COPY_LITERALS, CopyLit)); +get_cpc_opts([], Async, Flags) -> + {Async, Flags}. + +cpc_flags(OldFlags, Bit, true) -> + OldFlags bor Bit; +cpc_flags(OldFlags, Bit, false) -> + OldFlags band (bnot Bit). + +-spec copy_literals(Module,Bool) -> 'true' | 'false' | 'aborted' when + Module :: module(), + Bool :: boolean(). +copy_literals(_Mod, _Bool) -> + erlang:nif_error(undefined). + +-spec purge_module(Module) -> boolean() when + Module :: module(). +purge_module(_Module) -> erlang:nif_error(undefined). -spec system_check(Type) -> 'ok' when @@ -235,12 +321,18 @@ 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) -> +%% return the internal term type +-spec term_type(T) -> Type when + T :: term(), + Type :: 'flatmap' | 'hashmap' | 'hashmap_node' + | 'fixnum' | 'bignum' | 'hfloat' + | 'list' | 'tuple' | 'export' | 'fun' + | 'refc_binary' | 'heap_binary' | 'sub_binary' + | 'reference' | 'external_reference' + | 'pid' | 'external_pid' | 'port' | 'external_port' + | 'atom' | 'catch' | 'nil'. + +term_type(_T) -> erlang:nif_error(undefined). %% return the internal hashmap sub-nodes from @@ -278,8 +370,63 @@ flush_monitor_messages(Ref, Multi, Res) when is_reference(Ref) -> time_unit() -> erlang:nif_error(undefined). +-spec erts_internal:perf_counter_unit() -> pos_integer(). + +perf_counter_unit() -> + erlang:nif_error(undefined). + -spec erts_internal:is_system_process(Pid) -> boolean() when Pid :: pid(). is_system_process(_Pid) -> erlang:nif_error(undefined). + +-spec await_microstate_accounting_modifications(Ref, Result, Threads) -> boolean() when + Ref :: reference(), + Result :: boolean(), + Threads :: pos_integer(). + +await_microstate_accounting_modifications(Ref, Result, Threads) -> + _ = microstate_accounting(Ref,Threads), + Result. + +-spec gather_microstate_accounting_result(Ref, Threads) -> [#{}] when + Ref :: reference(), + Threads :: pos_integer(). + +gather_microstate_accounting_result(Ref, Threads) -> + microstate_accounting(Ref, Threads). + +microstate_accounting(_Ref, 0) -> + []; +microstate_accounting(Ref, Threads) -> + receive + Ref -> microstate_accounting(Ref, Threads - 1); + {Ref, Res} -> + [Res | microstate_accounting(Ref, Threads - 1)] + end. + +-spec trace(PidPortSpec, How, FlagList) -> integer() when + PidPortSpec :: pid() | port() + | all | processes | ports + | existing | existing_processes | existing_ports + | new | new_processes | new_ports, + How :: boolean(), + FlagList :: []. +trace(_PidSpec, _How, _FlagList) -> + erlang:nif_error(undefined). + +-type trace_pattern_mfa() :: + {atom(),atom(),arity() | '_'} | on_load. +-type trace_match_spec() :: + [{[term()] | '_' ,[term()],[term()]}]. + +-spec trace_pattern(MFA, MatchSpec, FlagList) -> non_neg_integer() when + MFA :: trace_pattern_mfa(), + MatchSpec :: (MatchSpecList :: trace_match_spec()) + | boolean() + | restart + | pause, + FlagList :: [ ]. +trace_pattern(_MFA, _MatchSpec, _FlagList) -> + erlang:nif_error(undefined). diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index 0ad5824ad1..618b53f6bb 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,7 +23,6 @@ %% a local file or distributed from another erlang node. %% %% Flags: -%% -id Identity : identity of the system. %% -boot File : Absolute file name of the boot script. %% -boot_var Var Value %% : $Var in the boot script is expanded to @@ -42,6 +41,7 @@ %% -s : Start own processes. %% %% Experimental flags: +%% -profile_boot : Use an 'eprof light' to profile boot sequence %% -init_debug : Activate debug printouts in init %% -loader_debug : Activate debug printouts in erl_prim_loader %% -code_path_choice : strict | relaxed @@ -75,6 +75,19 @@ subscribed = []}). -type state() :: #state{}. +%% Data for eval_script/2. +-record(es, + {init, + debug, + path, + pa, + pz, + path_choice, + prim_load, + load_mode, + vars + }). + -define(ON_LOAD_HANDLER, init__boot__on_load_handler). debug(false, _) -> ok; @@ -117,7 +130,7 @@ bs2ss(L) -> get_status() -> request(get_status). --spec fetch_loaded() -> [atom()]. +-spec fetch_loaded() -> [{module(),file:filename()}]. fetch_loaded() -> request(fetch_loaded). @@ -167,10 +180,18 @@ stop(Status) -> init ! {stop,{stop,Status}}, ok. boot(BootArgs) -> register(init, self()), process_flag(trap_exit, true), + + %% Load the tracer nif + erl_tracer:on_load(), + {Start0,Flags,Args} = parse_boot_args(BootArgs), + %% We don't get to profile parsing of BootArgs + case get_flag(profile_boot, Flags, false) of + false -> ok; + true -> debug_profile_start() + end, Start = map(fun prepare_run_args/1, Start0), - Flags0 = flags_to_atoms_again(Flags), - boot(Start,Flags0,Args). + boot(Start, Flags, Args). prepare_run_args({eval, [Expr]}) -> {eval,Expr}; @@ -202,16 +223,6 @@ map(_F, []) -> map(F, [X|Rest]) -> [F(X) | map(F, Rest)]. -flags_to_atoms_again([]) -> - []; -flags_to_atoms_again([{F0,L0}|Rest]) -> - L = L0, - F = b2a(F0), - [{F,L}|flags_to_atoms_again(Rest)]; -flags_to_atoms_again([{F0}|Rest]) -> - F = b2a(F0), - [{F}|flags_to_atoms_again(Rest)]. - -spec code_path_choice() -> 'relaxed' | 'strict'. code_path_choice() -> case get_argument(code_path_choice) of @@ -296,9 +307,9 @@ crash(String, List) -> -spec boot_loop(pid(), state()) -> no_return(). boot_loop(BootPid, State) -> receive - {BootPid,loaded,ModLoaded} -> - Loaded = State#state.loaded, - boot_loop(BootPid,State#state{loaded = [ModLoaded|Loaded]}); + {BootPid,loaded,NewlyLoaded} -> + Loaded = NewlyLoaded ++ State#state.loaded, + boot_loop(BootPid, State#state{loaded = Loaded}); {BootPid,started,KernelPid} -> boot_loop(BootPid, new_kernelpid(KernelPid, BootPid, State)); {BootPid,progress,started} -> @@ -337,12 +348,25 @@ boot_loop(BootPid, State) -> end. ensure_loaded(Module, Loaded) -> - File = concat([Module,objfile_extension()]), - case catch load_mod(Module,File) of - {ok, FullName} -> - {{module, Module}, [{Module, FullName}|Loaded]}; - Res -> - {Res, Loaded} + case erlang:module_loaded(Module) of + true -> + {{module, Module}, Loaded}; + false -> + do_ensure_loaded(Module, Loaded) + end. + +do_ensure_loaded(Module, Loaded) -> + File = atom_to_list(Module) ++ objfile_extension(), + case erl_prim_loader:get_file(File) of + {ok,BinCode,FullName} -> + case do_load_module(Module, BinCode) of + ok -> + {{module, Module}, [{Module, FullName}|Loaded]}; + error -> + {error, [{Module, FullName}|Loaded]} + end; + Error -> + {Error, Loaded} end. %% Tell subscribed processes the system has started. @@ -451,9 +475,9 @@ do_handle_msg(Msg,State) -> %%% ------------------------------------------------- make_permanent(Boot,Config,Flags0,State) -> - case set_flag('-boot',Boot,Flags0) of + case set_flag(boot, Boot, Flags0) of {ok,Flags1} -> - case set_flag('-config',Config,Flags1) of + case set_flag(config, Config, Flags1) of {ok,Flags} -> {ok,State#state{flags = Flags}}; Error -> @@ -635,9 +659,9 @@ unload(_) -> do_unload(sub([heart|erlang:pre_loaded()],erlang:loaded())). do_unload([M|Mods]) -> - catch erlang:purge_module(M), + catch erts_internal:purge_module(M), catch erlang:delete_module(M), - catch erlang:purge_module(M), + catch erts_internal:purge_module(M), do_unload(Mods); do_unload([]) -> purge_all_hipe_refs(), @@ -691,17 +715,15 @@ sleep(T) -> receive after T -> ok end. %%% The loader shall run for ever! %%% ------------------------------------------------- -start_prim_loader(Init,Id,Pgm,Nodes,Path,{Pa,Pz}) -> - case erl_prim_loader:start(Id,Pgm,Nodes) of - {ok,Pid} when Path =:= false -> - InitPath = append(Pa,["."|Pz]), - erl_prim_loader:set_path(InitPath), - add_to_kernel(Init,Pid), - Pid; +start_prim_loader(Init, Path0, {Pa,Pz}) -> + Path = case Path0 of + false -> Pa ++ ["."|Pz]; + _ -> Path0 + end, + case erl_prim_loader:start() of {ok,Pid} -> erl_prim_loader:set_path(Path), - add_to_kernel(Init,Pid), - Pid; + add_to_kernel(Init, Pid); {error,Reason} -> erlang:display({"cannot start loader",Reason}), exit(Reason) @@ -715,13 +737,6 @@ add_to_kernel(Init,Pid) -> ok end. -prim_load_flags(Flags) -> - PortPgm = get_flag('-loader',Flags,<<"efile">>), - Hosts = get_flag_list('-hosts', Flags, []), - Id = get_flag('-id',Flags,none), - Path = get_flag_list('-path',Flags,false), - {PortPgm, Hosts, Id, Path}. - %%% ------------------------------------------------- %%% The boot process fetches a boot script and loads %%% all modules specified and starts spec. processes. @@ -734,46 +749,74 @@ do_boot(Flags,Start) -> do_boot(Init,Flags,Start) -> process_flag(trap_exit,true), - {Pgm0,Nodes,Id,Path} = prim_load_flags(Flags), - Root = b2s(get_flag('-root',Flags)), - PathFls = path_flags(Flags), - Pgm = b2s(Pgm0), - _Pid = start_prim_loader(Init,b2a(Id),Pgm,bs2as(Nodes), - bs2ss(Path),PathFls), + Root = get_root(Flags), + Path = get_flag_list(path, Flags, false), + {Pa,Pz} = PathFls = path_flags(Flags), + start_prim_loader(Init, bs2ss(Path), PathFls), BootFile = bootfile(Flags,Root), BootList = get_boot(BootFile,Root), - LoadMode = b2a(get_flag('-mode',Flags,false)), - Deb = b2a(get_flag('-init_debug',Flags,false)), + LoadMode = b2a(get_flag(mode, Flags, false)), + Deb = b2a(get_flag(init_debug, Flags, false)), catch ?ON_LOAD_HANDLER ! {init_debug_flag,Deb}, - BootVars = get_flag_args('-boot_var',Flags), - ParallelLoad = - (Pgm =:= "efile") and (erlang:system_info(thread_pool_size) > 0), + BootVars = get_boot_vars(Root, Flags), PathChoice = code_path_choice(), - eval_script(BootList,Init,PathFls,{Root,BootVars},Path, - {true,LoadMode,ParallelLoad},Deb,PathChoice), + Es = #es{init=Init,debug=Deb,path=Path,pa=Pa,pz=Pz, + path_choice=PathChoice, + prim_load=true,load_mode=LoadMode, + vars=BootVars}, + eval_script(BootList, Es), %% To help identifying Purify windows that pop up, %% print the node name into the Purify log. (catch erlang:system_info({purify, "Node: " ++ atom_to_list(node())})), - start_em(Start). + start_em(Start), + case get_flag(profile_boot,Flags,false) of + false -> ok; + true -> + debug_profile_format_mfas(debug_profile_mfas()), + debug_profile_stop() + end, + ok. + +get_root(Flags) -> + case get_argument(root, Flags) of + {ok,[[Root]]} -> + Root; + _ -> + exit(no_or_multiple_root_variables) + end. + +get_boot_vars(Root, Flags) -> + BootVars = get_boot_vars_1(#{}, Flags), + RootKey = <<"ROOT">>, + BootVars#{RootKey=>Root}. + +get_boot_vars_1(Vars, [{boot_var,[Key,Value]}|T]) -> + get_boot_vars_1(Vars#{Key=>Value}, T); +get_boot_vars_1(_, [{boot_var,_}|_]) -> + exit(invalid_boot_var_argument); +get_boot_vars_1(Vars, [_|T]) -> + get_boot_vars_1(Vars, T); +get_boot_vars_1(Vars, []) -> + Vars. bootfile(Flags,Root) -> - b2s(get_flag('-boot',Flags,concat([Root,"/bin/start"]))). + b2s(get_flag(boot, Flags, Root++"/bin/start")). path_flags(Flags) -> - Pa = append(reverse(get_flag_args('-pa',Flags))), - Pz = append(get_flag_args('-pz',Flags)), + Pa = append(reverse(get_flag_args(pa, Flags))), + Pz = append(get_flag_args(pz, Flags)), {bs2ss(Pa),bs2ss(Pz)}. get_boot(BootFile0,Root) -> - BootFile = concat([BootFile0,".boot"]), + BootFile = BootFile0 ++ ".boot", case get_boot(BootFile) of {ok, CmdList} -> CmdList; not_found -> %% Check for default. - BootF = concat([Root,"/bin/",BootFile]), + BootF = Root ++ "/bin/" ++ BootFile, case get_boot(BootF) of {ok, CmdList} -> CmdList; @@ -807,91 +850,88 @@ get_boot(BootFile) -> %% boot process hangs (we want to ensure syncronicity). %% -eval_script([{progress,Info}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> - debug(Deb,{progress,Info}), +eval_script([{progress,Info}=Progress|T], #es{debug=Deb}=Es) -> + debug(Deb, Progress), init ! {self(),progress,Info}, - eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); -eval_script([{preLoaded,_}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> - eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); -eval_script([{path,Path}|CfgL],Init,{Pa,Pz},Vars,false,Ph,Deb,PathChoice) -> + eval_script(T, Es); +eval_script([{preLoaded,_}|T], #es{}=Es) -> + eval_script(T, Es); +eval_script([{path,Path}|T], #es{path=false,pa=Pa,pz=Pz, + path_choice=PathChoice, + vars=Vars}=Es) -> RealPath0 = make_path(Pa, Pz, Path, Vars), RealPath = patch_path(RealPath0, PathChoice), erl_prim_loader:set_path(RealPath), - eval_script(CfgL,Init,{Pa,Pz},Vars,false,Ph,Deb,PathChoice); -eval_script([{path,_}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> + eval_script(T, Es); +eval_script([{path,_}|T], #es{}=Es) -> %% Ignore, use the command line -path flag. - eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); -eval_script([{kernel_load_completed}|CfgL],Init,PathFs,Vars,P,{_,embedded,Par},Deb,PathChoice) -> - eval_script(CfgL,Init,PathFs,Vars,P,{true,embedded,Par},Deb,PathChoice); -eval_script([{kernel_load_completed}|CfgL],Init,PathFs,Vars,P,{_,E,Par},Deb,PathChoice) -> - eval_script(CfgL,Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice); -eval_script([{primLoad,Mods}|CfgL],Init,PathFs,Vars,P,{true,E,Par},Deb,PathChoice) + eval_script(T, Es); +eval_script([{kernel_load_completed}|T], #es{load_mode=Mode}=Es0) -> + Es = case Mode of + embedded -> Es0; + _ -> Es0#es{prim_load=false} + end, + eval_script(T, Es); +eval_script([{primLoad,Mods}|T], #es{init=Init,prim_load=PrimLoad}=Es) when is_list(Mods) -> - if - Par =:= true -> - par_load_modules(Mods,Init); + case PrimLoad of true -> - load_modules(Mods) + load_modules(Mods, Init); + false -> + %% Do not load now, code_server does that dynamically! + ok end, - eval_script(CfgL,Init,PathFs,Vars,P,{true,E,Par},Deb,PathChoice); -eval_script([{primLoad,_Mods}|CfgL],Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice) -> - %% Do not load now, code_server does that dynamically! - eval_script(CfgL,Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice); -eval_script([{kernelProcess,Server,{Mod,Fun,Args}}|CfgL],Init, - PathFs,Vars,P,Ph,Deb,PathChoice) -> - debug(Deb,{start,Server}), - start_in_kernel(Server,Mod,Fun,Args,Init), - eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); -eval_script([{apply,{Mod,Fun,Args}}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> - debug(Deb,{apply,{Mod,Fun,Args}}), - apply(Mod,Fun,Args), - eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); -eval_script([],_,_,_,_,_,_,_) -> + eval_script(T, Es); +eval_script([{kernelProcess,Server,{Mod,Fun,Args}}|T], + #es{init=Init,debug=Deb}=Es) -> + debug(Deb, {start,Server}), + start_in_kernel(Server, Mod, Fun, Args, Init), + eval_script(T, Es); +eval_script([{apply,{Mod,Fun,Args}}=Apply|T], #es{debug=Deb}=Es) -> + debug(Deb, Apply), + apply(Mod, Fun, Args), + eval_script(T, Es); +eval_script([], #es{}) -> ok; -eval_script(What,_,_,_,_,_,_,_) -> +eval_script(What, #es{}) -> exit({'unexpected command in bootfile',What}). -load_modules([Mod|Mods]) -> - File = concat([Mod,objfile_extension()]), - {ok,Full} = load_mod(Mod,File), - init ! {self(),loaded,{Mod,Full}}, %% Tell init about loaded module - load_modules(Mods); -load_modules([]) -> +load_modules(Mods0, Init) -> + Mods = [M || M <- Mods0, not erlang:module_loaded(M)], + F = prepare_loading_fun(), + case erl_prim_loader:get_modules(Mods, F) of + {ok,{Prep0,[]}} -> + Prep = [Code || {_,{prepared,Code,_}} <- Prep0], + ok = erlang:finish_loading(Prep), + Loaded = [{Mod,Full} || {Mod,{_,_,Full}} <- Prep0], + Init ! {self(),loaded,Loaded}, + Beams = [{M,Beam,Full} || {M,{on_load,Beam,Full}} <- Prep0], + load_rest(Beams, Init); + {ok,{_,[_|_]=Errors}} -> + Ms = [M || {M,_} <- Errors], + exit({load_failed,Ms}) + end. + +load_rest([{Mod,Beam,Full}|T], Init) -> + do_load_module(Mod, Beam), + Init ! {self(),loaded,[{Mod,Full}]}, + load_rest(T, Init); +load_rest([], _) -> ok. -%%% An optimization: erl_prim_loader gets the chance of loading many -%%% files in parallel, using threads. This will reduce the seek times, -%%% and loaded code can be processed while other threads are waiting -%%% for the disk. The optimization is not tried unless the loader is -%%% "efile" and there is a non-empty pool of threads. -%%% -%%% Many threads are needed to get a good result, so it would be -%%% beneficial to load several applications in parallel. However, -%%% measurements show that the file system handles one directory at a -%%% time, regardless if parallel threads are created for files on -%%% several directories (a guess: writing the meta information when -%%% the file was last read ('mtime'), forces the file system to sync -%%% between directories). - -par_load_modules(Mods,Init) -> - Ext = objfile_extension(), - ModFiles = [{Mod,concat([Mod,Ext])} || Mod <- Mods, - not erlang:module_loaded(Mod)], - Self = self(), - Fun = fun(Mod, BinCode, FullName) -> - case catch load_mod_code(Mod, BinCode, FullName) of - {ok, _} -> - Init ! {Self,loaded,{Mod,FullName}}, - ok; - _EXIT -> - {error, Mod} - end - end, - case erl_prim_loader:get_files(ModFiles, Fun) of - ok -> - ok; - {error,Mod} -> - exit({'cannot load',Mod,get_files}) +prepare_loading_fun() -> + fun(Mod, FullName, Beam) -> + case erlang:prepare_loading(Mod, Beam) of + Prepared when is_binary(Prepared) -> + case erlang:has_prepared_code_on_load(Prepared) of + true -> + {ok,{on_load,Beam,FullName}}; + false -> + {ok,{prepared,Prepared,FullName}} + end; + {error,_}=Error -> + Error + end end. make_path(Pa, Pz, Path, Vars) -> @@ -908,34 +948,25 @@ fix_path([Path|Ps], Vars) -> fix_path(_, _) -> []. -add_var("$ROOT/" ++ Path, {Root,_}) -> - concat([Root, "/", Path]); -add_var([$$|Path0], {_,VarList}) -> - {Var,Path} = extract_var(Path0,[]), - Value = b2s(get_var_value(list_to_binary(Var),VarList)), - concat([Value, "/", Path]); -add_var(Path, _) -> +add_var("$"++Path0, Vars) -> + {Var,Path} = extract_var(Path0, []), + Key = list_to_binary(Var), + case Vars of + #{Key:=Value0} -> + Value = b2s(Value0), + Value ++ "/" ++ Path; + _ -> + Error0 = "cannot expand $" ++ Var ++ " in bootfile", + Error = list_to_atom(Error0), + exit(Error) + end; +add_var(Path, _) -> Path. extract_var([$/|Path],Var) -> {reverse(Var),Path}; extract_var([H|T],Var) -> extract_var(T,[H|Var]); extract_var([],Var) -> {reverse(Var),[]}. -%% get_var_value(Var, [Vars]) where Vars == [atom()] -get_var_value(Var,[Vars|VarList]) -> - case get_var_val(Var,Vars) of - {ok, Value} -> - Value; - _ -> - get_var_value(Var,VarList) - end; -get_var_value(Var,[]) -> - exit(list_to_atom(concat(["cannot expand \$", Var, " in bootfile"]))). - -get_var_val(Var,[Var,Value|_]) -> {ok, Value}; -get_var_val(Var,[_,_|Vars]) -> get_var_val(Var,Vars); -get_var_val(_,_) -> false. - patch_path(Dirs, strict) -> Dirs; patch_path(Dirs, relaxed) -> @@ -1049,49 +1080,23 @@ start_it({eval,Bin}) -> {value, _Value, _Bs} = erl_eval:exprs(Expr, erl_eval:new_bindings()), ok; start_it([_|_]=MFA) -> - Ref = make_ref(), - case catch {Ref,case MFA of - [M] -> M:start(); - [M,F] -> M:F(); - [M,F|Args] -> M:F(Args) % Args is a list - end} of - {Ref,R} -> - R; - {'EXIT',Reason} -> - exit(Reason); - Other -> - throw(Other) + case MFA of + [M] -> M:start(); + [M,F] -> M:F(); + [M,F|Args] -> M:F(Args) % Args is a list end. -%% -%% Fetch a module and load it into the system. -%% -load_mod(Mod, File) -> - case erlang:module_loaded(Mod) of - false -> - case erl_prim_loader:get_file(File) of - {ok,BinCode,FullName} -> - load_mod_code(Mod, BinCode, FullName); - _ -> - exit({'cannot load',Mod,get_file}) - end; - _ -> % Already loaded. - {ok,File} - end. +%% Load a module. -load_mod_code(Mod, BinCode, FullName) -> - case erlang:module_loaded(Mod) of - false -> - case erlang:load_module(Mod, BinCode) of - {module,Mod} -> {ok,FullName}; - {error,on_load} -> - ?ON_LOAD_HANDLER ! {loaded,Mod}, - {ok,FullName}; - Other -> - exit({'cannot load',Mod,Other}) - end; - _ -> % Already loaded. - {ok,FullName} +do_load_module(Mod, BinCode) -> + case erlang:load_module(Mod, BinCode) of + {module,Mod} -> + ok; + {error,on_load} -> + ?ON_LOAD_HANDLER ! {loaded,Mod}, + ok; + _ -> + error end. %% -------------------------------------------------------- @@ -1102,7 +1107,7 @@ load_mod_code(Mod, BinCode, FullName) -> %% -------------------------------------------------------- shutdown_timer(Flags) -> - case get_flag('-shutdown_time',Flags,infinity) of + case get_flag(shutdown_time, Flags, infinity) of infinity -> self(); Time -> @@ -1152,14 +1157,10 @@ parse_boot_args([B|Bs], Ss, Fs, As) -> eval_arg -> {Expr,Rest} = get_args(Bs, []), parse_boot_args(Rest, [{eval, Expr}|Ss], Fs, As); - flag -> + {flag,A} -> {F,Rest} = get_args(Bs, []), - Fl = case F of - [] -> [B]; - FF -> [B,FF] - end, - parse_boot_args(Rest, Ss, - [list_to_tuple(Fl)|Fs], As); + Fl = {A,F}, + parse_boot_args(Rest, Ss, [Fl|Fs], As); arg -> parse_boot_args(Bs, Ss, Fs, [B|As]); end_args -> @@ -1173,12 +1174,8 @@ check(<<"-s">>) -> start_arg; check(<<"-run">>) -> start_arg2; check(<<"-eval">>) -> eval_arg; check(<<"--">>) -> end_args; -check(X) when is_binary(X) -> - case binary_to_list(X) of - [$-|_Rest] -> flag; - _Chars -> arg %Even empty atoms - end; -check(_X) -> arg. %This should never occur +check(<<"-",Flag/binary>>) -> {flag,b2a(Flag)}; +check(_) -> arg. get_args([B|Bs], As) -> case check(B) of @@ -1187,7 +1184,7 @@ get_args([B|Bs], As) -> start_arg2 -> {reverse(As), [B|Bs]}; eval_arg -> {reverse(As), [B|Bs]}; end_args -> {reverse(As), Bs}; - flag -> {reverse(As), [B|Bs]}; + {flag,_} -> {reverse(As), [B|Bs]}; arg -> get_args(Bs, [B|As]) end; @@ -1199,44 +1196,28 @@ get_args([], As) -> {reverse(As),[]}. %% atom() if a single arg was given. %% list(atom()) if several args were given. %% -get_flag(F,Flags,Default) -> - case catch get_flag(F,Flags) of - {'EXIT',_} -> - Default; - Value -> - Value - end. - -get_flag(F,Flags) -> - case search(F,Flags) of - {value,{F,[V]}} -> +get_flag(F, Flags, Default) -> + case lists:keyfind(F, 1, Flags) of + {F,[]} -> + true; + {F,[V]} -> V; - {value,{F,V}} -> + {F,V} -> V; - {value,{F}} -> % Flag given! - true; _ -> - exit(list_to_atom(concat(["no ",F," flag"]))) + Default end. %% %% Internal get_flag function, with default value. %% Return: list(atom()) %% -get_flag_list(F,Flags,Default) -> - case catch get_flag_list(F,Flags) of - {'EXIT',_} -> - Default; - Value -> - Value - end. - -get_flag_list(F,Flags) -> - case search(F,Flags) of - {value,{F,V}} -> +get_flag_list(F, Flags, Default) -> + case lists:keyfind(F, 1, Flags) of + {F,[_|_]=V} -> V; _ -> - exit(list_to_atom(concat(["no ",F," flag"]))) + Default end. %% @@ -1246,21 +1227,15 @@ get_flag_list(F,Flags) -> %% get_flag_args(F,Flags) -> get_flag_args(F,Flags,[]). -get_flag_args(F,[{F,V}|Flags],Acc) when is_list(V) -> - get_flag_args(F,Flags,[V|Acc]); get_flag_args(F,[{F,V}|Flags],Acc) -> - get_flag_args(F,Flags,[[V]|Acc]); + get_flag_args(F,Flags,[V|Acc]); get_flag_args(F,[_|Flags],Acc) -> get_flag_args(F,Flags,Acc); get_flag_args(_,[],Acc) -> reverse(Acc). get_arguments([{F,V}|Flags]) -> - [$-|Fl] = atom_to_list(F), - [{list_to_atom(Fl),to_strings(V)}|get_arguments(Flags)]; -get_arguments([{F}|Flags]) -> - [$-|Fl] = atom_to_list(F), - [{list_to_atom(Fl),[]}|get_arguments(Flags)]; + [{F,to_strings(V)}|get_arguments(Flags)]; get_arguments([]) -> []. @@ -1268,44 +1243,26 @@ to_strings([H|T]) when is_atom(H) -> [atom_to_list(H)|to_strings(T)]; to_strings([H|T]) when is_binary(H) -> [b2s(H)|to_strings(T)]; to_strings([]) -> []. -get_argument(Arg,Flags) -> - Args = get_arguments(Flags), - case get_argument1(Arg,Args) of - [] -> - error; - Value -> - {ok,Value} +get_argument(Arg, Flags) -> + case get_argument1(Arg, Flags) of + [] -> error; + Value -> {ok,Value} end. -get_argument1(Arg,[{Arg,V}|Args]) -> - [V|get_argument1(Arg,Args)]; -get_argument1(Arg,[_|Args]) -> - get_argument1(Arg,Args); -get_argument1(_,[]) -> +get_argument1(Arg, [{Arg,V}|Args]) -> + [to_strings(V)|get_argument1(Arg, Args)]; +get_argument1(Arg, [_|Args]) -> + get_argument1(Arg, Args); +get_argument1(_, []) -> []. set_argument([{Flag,_}|Flags],Flag,Value) -> [{Flag,[Value]}|Flags]; -set_argument([{Flag}|Flags],Flag,Value) -> - [{Flag,[Value]}|Flags]; set_argument([Item|Flags],Flag,Value) -> [Item|set_argument(Flags,Flag,Value)]; set_argument([],Flag,Value) -> [{Flag,[Value]}]. -concat([A|T]) when is_atom(A) -> - atom_to_list(A) ++ concat(T); -concat([C|T]) when is_integer(C), 0 =< C, C =< 255 -> - [C|concat(T)]; -concat([Bin|T]) when is_binary(Bin) -> - binary_to_list(Bin) ++ concat(T); -concat([S|T]) -> - S ++ concat(T); -concat([]) -> - []. - -append(L, Z) -> L ++ Z. - append([E]) -> E; append([H|T]) -> H ++ append(T); @@ -1320,13 +1277,6 @@ reverse([A, B]) -> reverse([A, B | L]) -> lists:reverse(L, [B, A]). % BIF -search(Key, [H|_T]) when is_tuple(H), element(1, H) =:= Key -> - {value, H}; -search(Key, [_|T]) -> - search(Key, T); -search(_Key, []) -> - false. - -spec objfile_extension() -> nonempty_string(). objfile_extension() -> ".beam". @@ -1402,3 +1352,64 @@ run_on_load_handlers([M|Ms], Debug) -> end end; run_on_load_handlers([], _) -> ok. + + +%% debug profile (light variant of eprof) +debug_profile_start() -> + _ = erlang:trace_pattern({'_','_','_'},true,[call_time]), + _ = erlang:trace_pattern(on_load,true,[call_time]), + _ = erlang:trace(all,true,[call]), + ok. + +debug_profile_stop() -> + _ = erlang:trace_pattern({'_','_','_'},false,[call_time]), + _ = erlang:trace_pattern(on_load,false,[call_time]), + _ = erlang:trace(all,false,[call]), + ok. + +debug_profile_mfas() -> + _ = erlang:trace_pattern({'_','_','_'},pause,[call_time]), + _ = erlang:trace_pattern(on_load,pause,[call_time]), + MFAs = collect_loaded_mfas() ++ erlang:system_info(snifs), + collect_mfas(MFAs,[]). + +%% debug_profile_format_mfas should be called at the end of the boot phase +%% so all pertinent modules should be loaded at that point. +debug_profile_format_mfas(MFAs0) -> + MFAs = lists:sort(MFAs0), + lists:foreach(fun({{Us,C},{M,F,A}}) -> + Str = io_lib:format("~w:~w/~w", [M,F,A]), + io:format(standard_error,"~55s - ~6w : ~w us~n", [Str,C,Us]) + end, MFAs), + ok. + +collect_loaded_mfas() -> + Ms = [M || M <- [element(1, Mi) || Mi <- code:all_loaded()]], + collect_loaded_mfas(Ms,[]). + +collect_loaded_mfas([],MFAs) -> MFAs; +collect_loaded_mfas([M|Ms],MFAs0) -> + MFAs = [{M,F,A} || {F,A} <- M:module_info(functions)], + collect_loaded_mfas(Ms,MFAs ++ MFAs0). + + +collect_mfas([], Info) -> Info; +collect_mfas([MFA|MFAs],Info) -> + case erlang:trace_info(MFA,call_time) of + {call_time, []} -> + collect_mfas(MFAs,Info); + {call_time, false} -> + collect_mfas(MFAs,Info); + {call_time, Data} -> + case collect_mfa(MFA,Data,0,0) of + {{0,_},_} -> + %% ignore mfas with zero time + collect_mfas(MFAs,Info); + MfaData -> + collect_mfas(MFAs,[MfaData|Info]) + end + end. + +collect_mfa(Mfa,[],Count,Time) -> {{Time,Count},Mfa}; +collect_mfa(Mfa,[{_Pid,C,S,Us}|Data],Count,Time) -> + collect_mfa(Mfa,Data,Count + C,Time + S * 1000000 + Us). diff --git a/erts/preloaded/src/otp_ring0.erl b/erts/preloaded/src/otp_ring0.erl index 3158fc7d21..62a60fffe2 100644 --- a/erts/preloaded/src/otp_ring0.erl +++ b/erts/preloaded/src/otp_ring0.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2010. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/preloaded/src/prim_eval.S b/erts/preloaded/src/prim_eval.S index 1b7b00a7c9..e7f09a870c 100644 --- a/erts/preloaded/src/prim_eval.S +++ b/erts/preloaded/src/prim_eval.S @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/preloaded/src/prim_eval.erl b/erts/preloaded/src/prim_eval.erl index 732e22468e..22e924f9e9 100644 --- a/erts/preloaded/src/prim_eval.erl +++ b/erts/preloaded/src/prim_eval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/preloaded/src/prim_inet.erl b/erts/preloaded/src/prim_inet.erl index bd74831bb7..4872ffd00c 100644 --- a/erts/preloaded/src/prim_inet.erl +++ b/erts/preloaded/src/prim_inet.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/preloaded/src/prim_zip.erl b/erts/preloaded/src/prim_zip.erl index c4b949afcb..b1ddbbe173 100644 --- a/erts/preloaded/src/prim_zip.erl +++ b/erts/preloaded/src/prim_zip.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/preloaded/src/zip_internal.hrl b/erts/preloaded/src/zip_internal.hrl index d5cf52fae4..2769ca152d 100644 --- a/erts/preloaded/src/zip_internal.hrl +++ b/erts/preloaded/src/zip_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/preloaded/src/zlib.erl b/erts/preloaded/src/zlib.erl index 473ad649c7..fa0f28c5c3 100644 --- a/erts/preloaded/src/zlib.erl +++ b/erts/preloaded/src/zlib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2013. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/start_scripts/Makefile b/erts/start_scripts/Makefile index 8025681924..dfd8153f32 100644 --- a/erts/start_scripts/Makefile +++ b/erts/start_scripts/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2013. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/start_scripts/no_dot_erlang.rel.src b/erts/start_scripts/no_dot_erlang.rel.src index bcc9fa9e8a..04e5fbf741 100644 --- a/erts/start_scripts/no_dot_erlang.rel.src +++ b/erts/start_scripts/no_dot_erlang.rel.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% Copyright Ericsson AB 2013-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/start_scripts/start_all_example.rel.src b/erts/start_scripts/start_all_example.rel.src index 2c4deb4485..a44f3e2925 100644 --- a/erts/start_scripts/start_all_example.rel.src +++ b/erts/start_scripts/start_all_example.rel.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/start_scripts/start_clean.rel.src b/erts/start_scripts/start_clean.rel.src index 25519deb17..ad468aa9df 100644 --- a/erts/start_scripts/start_clean.rel.src +++ b/erts/start_scripts/start_clean.rel.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/start_scripts/start_sasl.rel.src b/erts/start_scripts/start_sasl.rel.src index 9cf417ade5..23b6a89e1d 100644 --- a/erts/start_scripts/start_sasl.rel.src +++ b/erts/start_scripts/start_sasl.rel.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/test/Makefile b/erts/test/Makefile index 5263d8cd4f..1fe230adaf 100644 --- a/erts/test/Makefile +++ b/erts/test/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2014. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -54,7 +54,7 @@ RELSYSDIR = $(RELEASE_PATH)/system_test # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += # ---------------------------------------------------- # Targets diff --git a/erts/test/erl_print_SUITE.erl b/erts/test/erl_print_SUITE.erl index 3b0c083702..463d890688 100644 --- a/erts/test/erl_print_SUITE.erl +++ b/erts/test/erl_print_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,153 +28,133 @@ -module(erl_print_SUITE). -author('[email protected]'). +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]). -%-define(line_trace, 1). +-export([erlang_display/1, integer/1, float/1, + string/1, character/1, snprintf/1, quote/1]). --define(DEFAULT_TIMEOUT, ?t:minutes(10)). +-include_lib("common_test/include/ct.hrl"). --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([erlang_display/1, integer/1, float/1, - string/1, character/1, snprintf/1, quote/1]). - --include_lib("test_server/include/test_server.hrl"). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 10}}]. all() -> - test_cases(). - -groups() -> - []. + [erlang_display, integer, float, string, character, + snprintf, quote]. -init_per_suite(Config) -> - Config. +init_per_testcase(Case, Config) -> + [{testcase, Case}|Config]. -end_per_suite(_Config) -> +end_per_testcase(_Case, _Config) -> ok. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - %% %% %% Test cases %% %% -test_cases() -> - [erlang_display, integer, float, string, character, - snprintf, quote]. - -erlang_display(doc) -> []; -erlang_display(suite) -> []; erlang_display(Config) when is_list(Config) -> - ?line put(erlang_display_test, ok), + put(erlang_display_test, ok), OAIS = erts_debug:set_internal_state(available_internal_state, true), %% atoms - ?line chk_display(atom, "atom"), - ?line chk_display(true, "true"), - ?line chk_display(false, "false"), - ?line chk_display('DOWN', "'DOWN'"), - ?line chk_display('EXIT', "'EXIT'"), - ?line chk_display('asdDofw $@{}][', "'asdDofw $@{}]['"), + chk_display(atom, "atom"), + chk_display(true, "true"), + chk_display(false, "false"), + chk_display('DOWN', "'DOWN'"), + chk_display('EXIT', "'EXIT'"), + chk_display('asdDofw $@{}][', "'asdDofw $@{}]['"), %% integers - ?line chk_display(0, "0"), - ?line chk_display(1, "1"), - ?line chk_display(4711, "4711"), - ?line chk_display(((1 bsl 27) - 1), "134217727"), - ?line chk_display((1 bsl 27), "134217728"), - ?line chk_display((1 bsl 32), "4294967296"), - ?line chk_display(11111111111, "11111111111"), - ?line chk_display((1 bsl 59) - 1, "576460752303423487"), - ?line chk_display(1 bsl 59, "576460752303423488"), - ?line chk_display(111111111111111111111, "111111111111111111111"), - ?line chk_display(123456789012345678901234567890, - "123456789012345678901234567890"), - ?line chk_display(1 bsl 10000, str_1_bsl_10000()), - ?line chk_display(-1, "-1"), - ?line chk_display(-4711, "-4711"), - ?line chk_display(-(1 bsl 27), "-134217728"), - ?line chk_display(-((1 bsl 27) + 1), "-134217729"), - ?line chk_display(-(1 bsl 32), "-4294967296"), - ?line chk_display(-11111111111, "-11111111111"), - ?line chk_display(-(1 bsl 59), "-576460752303423488"), - ?line chk_display(-((1 bsl 59) + 1), "-576460752303423489"), - ?line chk_display(-111111111111111111111, "-111111111111111111111"), - ?line chk_display(-123456789012345678901234567890, - "-123456789012345678901234567890"), - ?line chk_display(-(1 bsl 10000), [$- | str_1_bsl_10000()]), - - ?line MyCre = my_cre(), + chk_display(0, "0"), + chk_display(1, "1"), + chk_display(4711, "4711"), + chk_display(((1 bsl 27) - 1), "134217727"), + chk_display((1 bsl 27), "134217728"), + chk_display((1 bsl 32), "4294967296"), + chk_display(11111111111, "11111111111"), + chk_display((1 bsl 59) - 1, "576460752303423487"), + chk_display(1 bsl 59, "576460752303423488"), + chk_display(111111111111111111111, "111111111111111111111"), + chk_display(123456789012345678901234567890, + "123456789012345678901234567890"), + chk_display(1 bsl 10000, str_1_bsl_10000()), + chk_display(-1, "-1"), + chk_display(-4711, "-4711"), + chk_display(-(1 bsl 27), "-134217728"), + chk_display(-((1 bsl 27) + 1), "-134217729"), + chk_display(-(1 bsl 32), "-4294967296"), + chk_display(-11111111111, "-11111111111"), + chk_display(-(1 bsl 59), "-576460752303423488"), + chk_display(-((1 bsl 59) + 1), "-576460752303423489"), + chk_display(-111111111111111111111, "-111111111111111111111"), + chk_display(-123456789012345678901234567890, + "-123456789012345678901234567890"), + chk_display(-(1 bsl 10000), [$- | str_1_bsl_10000()]), + + MyCre = my_cre(), %% pids - ?line chk_display(mk_pid_xstr({node(), MyCre}, 4711, 42)), - ?line chk_display(mk_pid_xstr({node(), oth_cre(MyCre)}, 4711, 42)), - ?line chk_display(mk_pid_xstr({node(), oth_cre(oth_cre(MyCre))}, 4711, 42)), + chk_display(mk_pid_xstr({node(), MyCre}, 4711, 42)), + chk_display(mk_pid_xstr({node(), oth_cre(MyCre)}, 4711, 42)), + chk_display(mk_pid_xstr({node(), oth_cre(oth_cre(MyCre))}, 4711, 42)), - ?line chk_display(mk_pid_xstr({a@b, MyCre}, 4711, 42)), - ?line chk_display(mk_pid_xstr({a@b, oth_cre(MyCre)}, 4711, 42)), - ?line chk_display(mk_pid_xstr({a@b, oth_cre(oth_cre(MyCre))}, 4711, 42)), + chk_display(mk_pid_xstr({a@b, MyCre}, 4711, 42)), + chk_display(mk_pid_xstr({a@b, oth_cre(MyCre)}, 4711, 42)), + chk_display(mk_pid_xstr({a@b, oth_cre(oth_cre(MyCre))}, 4711, 42)), %% ports - ?line chk_display(mk_port_xstr({node(), MyCre}, 4711)), - ?line chk_display(mk_port_xstr({node(), oth_cre(MyCre)}, 4711)), - ?line chk_display(mk_port_xstr({node(), oth_cre(oth_cre(MyCre))}, 4711)), + chk_display(mk_port_xstr({node(), MyCre}, 4711)), + chk_display(mk_port_xstr({node(), oth_cre(MyCre)}, 4711)), + chk_display(mk_port_xstr({node(), oth_cre(oth_cre(MyCre))}, 4711)), - ?line chk_display(mk_port_xstr({c@d, MyCre}, 4711)), - ?line chk_display(mk_port_xstr({c@d, oth_cre(MyCre)}, 4711)), - ?line chk_display(mk_port_xstr({c@d, oth_cre(oth_cre(MyCre))}, 4711)), + chk_display(mk_port_xstr({c@d, MyCre}, 4711)), + chk_display(mk_port_xstr({c@d, oth_cre(MyCre)}, 4711)), + chk_display(mk_port_xstr({c@d, oth_cre(oth_cre(MyCre))}, 4711)), %% refs - ?line chk_display(mk_ref_xstr({node(), MyCre}, [1,2,3])), - ?line chk_display(mk_ref_xstr({node(), oth_cre(MyCre)}, [1,2,3])), - ?line chk_display(mk_ref_xstr({node(), oth_cre(oth_cre(MyCre))}, [1,2,3])), + chk_display(mk_ref_xstr({node(), MyCre}, [1,2,3])), + chk_display(mk_ref_xstr({node(), oth_cre(MyCre)}, [1,2,3])), + chk_display(mk_ref_xstr({node(), oth_cre(oth_cre(MyCre))}, [1,2,3])), - ?line chk_display(mk_ref_xstr({e@f, MyCre},[1,2,3] )), - ?line chk_display(mk_ref_xstr({e@f, oth_cre(MyCre)}, [1,2,3])), - ?line chk_display(mk_ref_xstr({e@f, oth_cre(oth_cre(MyCre))}, [1,2,3])), + chk_display(mk_ref_xstr({e@f, MyCre},[1,2,3] )), + chk_display(mk_ref_xstr({e@f, oth_cre(MyCre)}, [1,2,3])), + chk_display(mk_ref_xstr({e@f, oth_cre(oth_cre(MyCre))}, [1,2,3])), %% Compund terms - ?line {Pid, PidStr} = mk_pid_xstr({x@y, oth_cre(MyCre)}, 4712, 41), - ?line {Port, PortStr} = mk_port_xstr({x@y, oth_cre(MyCre)}, 4712), - ?line {Ref, RefStr} = mk_ref_xstr({e@f, oth_cre(MyCre)}, [11,12,13]), - - ?line chk_display({atom,-4711,Ref,{"hej",[Pid,222222222222222222222222,Port,4711]}}, - "{atom,-4711,"++RefStr++",{\"hej\",["++PidStr++",222222222222222222222222,"++PortStr++",4711]}}"), - ?line chk_display({{{{{{{{{{{{{{{{{{{{{{{hi}}}}}}}}}}}}}}}}}}}}}}}, - "{{{{{{{{{{{{{{{{{{{{{{{hi}}}}}}}}}}}}}}}}}}}}}}}"), - ?line chk_display([[[[[[[[[[[[[[[[[[[[[[[yo]]]]]]]]]]]]]]]]]]]]]]], - "[[[[[[[[[[[[[[[[[[[[[[[yo]]]]]]]]]]]]]]]]]]]]]]]"), - ?line chk_display({[{[{[{[{[{[{[{[{[{[{[{[ii]}]}]}]}]}]}]}]}]}]}]}]}, - "{[{[{[{[{[{[{[{[{[{[{[{[ii]}]}]}]}]}]}]}]}]}]}]}]}"), - ?line chk_display([], "[]"), % Not really a compound term :) - ?line chk_display([a|b], "[a|b]"), - ?line chk_display([a,b,c|z], "[a,b,c|z]"), - ?line chk_display([a,b,c], "[a,b,c]"), - ?line chk_display([Pid,Port,Ref], - "["++PidStr++","++PortStr++","++RefStr++"]"), - ?line chk_display("abcdefghijklmnopqrstuvwxyz", - "\"abcdefghijklmnopqrstuvwxyz\""), - ?line chk_display("ABCDEFGHIJKLMNOPQRSTUVWXYZ", - "\"ABCDEFGHIJKLMNOPQRSTUVWXYZ\""), - ?line chk_display("H E J", "\"H E J\""), - ?line chk_display("asdDofw $@{}][", "\"asdDofw $@{}][\""), - + {Pid, PidStr} = mk_pid_xstr({x@y, oth_cre(MyCre)}, 4712, 41), + {Port, PortStr} = mk_port_xstr({x@y, oth_cre(MyCre)}, 4712), + {Ref, RefStr} = mk_ref_xstr({e@f, oth_cre(MyCre)}, [11,12,13]), + + chk_display({atom,-4711,Ref,{"hej",[Pid,222222222222222222222222,Port,4711]}}, + "{atom,-4711,"++RefStr++",{\"hej\",["++PidStr++",222222222222222222222222,"++PortStr++",4711]}}"), + chk_display({{{{{{{{{{{{{{{{{{{{{{{hi}}}}}}}}}}}}}}}}}}}}}}}, + "{{{{{{{{{{{{{{{{{{{{{{{hi}}}}}}}}}}}}}}}}}}}}}}}"), + chk_display([[[[[[[[[[[[[[[[[[[[[[[yo]]]]]]]]]]]]]]]]]]]]]]], + "[[[[[[[[[[[[[[[[[[[[[[[yo]]]]]]]]]]]]]]]]]]]]]]]"), + chk_display({[{[{[{[{[{[{[{[{[{[{[{[ii]}]}]}]}]}]}]}]}]}]}]}]}, + "{[{[{[{[{[{[{[{[{[{[{[{[ii]}]}]}]}]}]}]}]}]}]}]}]}"), + chk_display([], "[]"), % Not really a compound term :) + chk_display([a|b], "[a|b]"), + chk_display([a,b,c|z], "[a,b,c|z]"), + chk_display([a,b,c], "[a,b,c]"), + chk_display([Pid,Port,Ref], + "["++PidStr++","++PortStr++","++RefStr++"]"), + chk_display("abcdefghijklmnopqrstuvwxyz", + "\"abcdefghijklmnopqrstuvwxyz\""), + chk_display("ABCDEFGHIJKLMNOPQRSTUVWXYZ", + "\"ABCDEFGHIJKLMNOPQRSTUVWXYZ\""), + chk_display("H E J", "\"H E J\""), + chk_display("asdDofw $@{}][", "\"asdDofw $@{}][\""), + %% %% TODO: Check binaries, fun and floats... %% erts_debug:set_internal_state(available_internal_state, OAIS), - ?line ok = get(erlang_display_test). + ok = get(erlang_display_test). get_chnl_no(NodeName) when is_atom(NodeName) -> erts_debug:get_internal_state({channel_number, NodeName}). @@ -182,20 +162,20 @@ get_chnl_no(NodeName) when is_atom(NodeName) -> chk_display(Term, Expect) when is_list(Expect) -> Dstr = erts_debug:display(Term), case Expect ++ io_lib:nl() of - Dstr -> - ?t:format("Test of \"~p\" succeeded.~n" - " Expected and got: ~s~n", - [Term, io_lib:write_string(Dstr)]); - DoExpect -> - ?t:format("***~n" - "*** Test of \"~p\" failed!~n" - "*** Expected: ~s~n" - "*** Got: ~s~n" - "***~n", - [Term, - io_lib:write_string(DoExpect), - io_lib:write_string(Dstr)]), - put(erlang_display_test, failed) + Dstr -> + io:format("Test of \"~p\" succeeded.~n" + " Expected and got: ~s~n", + [Term, io_lib:write_string(Dstr)]); + DoExpect -> + io:format("***~n" + "*** Test of \"~p\" failed!~n" + "*** Expected: ~s~n" + "*** Got: ~s~n" + "***~n", + [Term, + io_lib:write_string(DoExpect), + io_lib:write_string(Dstr)]), + put(erlang_display_test, failed) end. chk_display({Term, Expect}) -> @@ -204,20 +184,20 @@ chk_display({Term, Expect}) -> mk_pid_xstr({NodeName, Creation}, Number, Serial) -> Pid = mk_pid({NodeName, Creation}, Number, Serial), XStr = "<" ++ integer_to_list(get_chnl_no(NodeName)) - ++ "." ++ integer_to_list(Number) - ++ "." ++ integer_to_list(Serial) ++ ">", + ++ "." ++ integer_to_list(Number) + ++ "." ++ integer_to_list(Serial) ++ ">", {Pid, XStr}. mk_port_xstr({NodeName, Creation}, Number) -> Port = mk_port({NodeName, Creation}, Number), XStr = "#Port<" ++ integer_to_list(get_chnl_no(NodeName)) - ++ "." ++ integer_to_list(Number) ++ ">", + ++ "." ++ integer_to_list(Number) ++ ">", {Port, XStr}. mk_ref_xstr({NodeName, Creation}, Numbers) -> Ref = mk_ref({NodeName, Creation}, Numbers), XStr = "#Ref<" ++ integer_to_list(get_chnl_no(NodeName)) - ++ ref_numbers_xstr(Numbers) ++ ">", + ++ ref_numbers_xstr(Numbers) ++ ">", {Ref, XStr}. ref_numbers_xstr([]) -> @@ -240,18 +220,7 @@ ref_numbers_xstr([N | Ns]) -> %% %% -default_testcase_impl(doc) -> []; -default_testcase_impl(suite) -> []; -default_testcase_impl(Config) when is_list(Config) -> ?line run_case(Config). - -init_per_testcase(Case, Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{testcase, Case}, {watchdog, Dog} |Config]. - -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. +default_testcase_impl(Config) when is_list(Config) -> run_case(Config). -define(TESTPROG, "erl_print_tests"). -define(FAILED_MARKER, $E,$P,$-,$T,$E,$S,$T,$-,$F,$A,$I,$L,$U,$R,$E). @@ -260,62 +229,62 @@ end_per_testcase(_Case, Config) -> -define(PID_MARKER, $E,$P,$-,$T,$E,$S,$T,$-,$P,$I,$D). port_prog_killer(EProc, OSProc) when is_pid(EProc), is_list(OSProc) -> - ?line process_flag(trap_exit, true), - ?line Ref = erlang:monitor(process, EProc), - ?line receive - {'DOWN', Ref, _, _, Reason} when is_tuple(Reason), - element(1, Reason) - == timetrap_timeout -> - ?line Cmd = "kill -9 " ++ OSProc, - ?line ?t:format("Test case timed out. " - "Trying to kill port program.~n" - " Executing: ~p~n", [Cmd]), - ?line case os:cmd(Cmd) of - [] -> - ok; - OsCmdRes -> - ?line ?t:format(" ~s", [OsCmdRes]) - end; - {'DOWN', Ref, _, _, _} -> - %% OSProc is assumed to have terminated by itself - ?line ok - end. + process_flag(trap_exit, true), + Ref = erlang:monitor(process, EProc), + receive + {'DOWN', Ref, _, _, Reason} when is_tuple(Reason), + element(1, Reason) + == timetrap_timeout -> + Cmd = "kill -9 " ++ OSProc, + io:format("Test case timed out. " + "Trying to kill port program.~n" + " Executing: ~p~n", [Cmd]), + case os:cmd(Cmd) of + [] -> + ok; + OsCmdRes -> + io:format(" ~s", [OsCmdRes]) + end; + {'DOWN', Ref, _, _, _} -> + %% OSProc is assumed to have terminated by itself + ok + end. get_line(_Port, eol, Data) -> - ?line Data; + Data; get_line(Port, noeol, Data) -> - ?line receive - {Port, {data, {Flag, NextData}}} -> - ?line get_line(Port, Flag, Data ++ NextData); - {Port, eof} -> - ?line ?t:fail(port_prog_unexpectedly_closed) - end. + receive + {Port, {data, {Flag, NextData}}} -> + get_line(Port, Flag, Data ++ NextData); + {Port, eof} -> + ct:fail(port_prog_unexpectedly_closed) + end. read_case_data(Port, TestCase) -> - ?line receive - {Port, {data, {eol, [?SUCCESS_MARKER]}}} -> - ?line ok; - {Port, {data, {Flag, [?SUCCESS_MARKER | CommentStart]}}} -> - ?line {comment, get_line(Port, Flag, CommentStart)}; - {Port, {data, {Flag, [?SKIPPED_MARKER | CommentStart]}}} -> - ?line {skipped, get_line(Port, Flag, CommentStart)}; - {Port, {data, {Flag, [?FAILED_MARKER | ReasonStart]}}} -> - ?line ?t:fail(get_line(Port, Flag, ReasonStart)); - {Port, {data, {eol, [?PID_MARKER | PidStr]}}} -> - ?line ?t:format("Port program pid: ~s~n", [PidStr]), - ?line CaseProc = self(), - ?line _ = list_to_integer(PidStr), % Sanity check - spawn_opt(fun () -> - port_prog_killer(CaseProc, PidStr) - end, - [{priority, max}, link]), - read_case_data(Port, TestCase); - {Port, {data, {Flag, LineStart}}} -> - ?line ?t:format("~s~n", [get_line(Port, Flag, LineStart)]), - read_case_data(Port, TestCase); - {Port, eof} -> - ?line ?t:fail(port_prog_unexpectedly_closed) - end. + receive + {Port, {data, {eol, [?SUCCESS_MARKER]}}} -> + ok; + {Port, {data, {Flag, [?SUCCESS_MARKER | CommentStart]}}} -> + {comment, get_line(Port, Flag, CommentStart)}; + {Port, {data, {Flag, [?SKIPPED_MARKER | CommentStart]}}} -> + {skipped, get_line(Port, Flag, CommentStart)}; + {Port, {data, {Flag, [?FAILED_MARKER | ReasonStart]}}} -> + ct:fail(get_line(Port, Flag, ReasonStart)); + {Port, {data, {eol, [?PID_MARKER | PidStr]}}} -> + io:format("Port program pid: ~s~n", [PidStr]), + CaseProc = self(), + _ = list_to_integer(PidStr), % Sanity check + spawn_opt(fun () -> + port_prog_killer(CaseProc, PidStr) + end, + [{priority, max}, link]), + read_case_data(Port, TestCase); + {Port, {data, {Flag, LineStart}}} -> + io:format("~s~n", [get_line(Port, Flag, LineStart)]), + read_case_data(Port, TestCase); + {Port, eof} -> + ct:fail(port_prog_unexpectedly_closed) + end. run_case(Config) -> run_case(Config, ""). @@ -324,27 +293,27 @@ run_case(Config, TestArgs) -> run_case(Config, TestArgs, fun (_Port) -> ok end). run_case(Config, TestArgs, Fun) -> - Test = atom_to_list(?config(testcase, Config)), - TestProg = filename:join([?config(data_dir, Config), - ?TESTPROG - ++ "." - ++ atom_to_list(erlang:system_info(threads))]), + Test = atom_to_list(proplists:get_value(testcase, Config)), + TestProg = filename:join([proplists:get_value(data_dir, Config), + ?TESTPROG + ++ "." + ++ atom_to_list(erlang:system_info(threads))]), Cmd = TestProg ++ " " ++ Test ++ " " ++ TestArgs, case catch open_port({spawn, Cmd}, [stream, - use_stdio, - stderr_to_stdout, - eof, - {line, 1024}]) of - Port when is_port(Port) -> - ?line Fun(Port), - ?line CaseResult = read_case_data(Port, Test), - ?line receive - {Port, eof} -> - ?line ok - end, - ?line CaseResult; - Error -> - ?line ?t:fail({open_port_failed, Error}) + use_stdio, + stderr_to_stdout, + eof, + {line, 1024}]) of + Port when is_port(Port) -> + Fun(Port), + CaseResult = read_case_data(Port, Test), + receive + {Port, eof} -> + ok + end, + CaseResult; + Error -> + ct:fail({open_port_failed, Error}) end. @@ -382,80 +351,80 @@ mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) -> mk_pid({atom_to_list(NodeName), Creation}, Number, Serial); mk_pid({NodeName, Creation}, Number, Serial) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PID_EXT, - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint32_be(Number), - uint32_be(Serial), - uint8(Creation)])) of - Pid when is_pid(Pid) -> - Pid; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_pid, [{NodeName, Creation}, Number, Serial]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?PID_EXT, + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint32_be(Serial), + uint8(Creation)])) of + Pid when is_pid(Pid) -> + Pid; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_pid, [{NodeName, Creation}, Number, Serial]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end. mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> mk_port({atom_to_list(NodeName), Creation}, Number); mk_port({NodeName, Creation}, Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PORT_EXT, - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint32_be(Number), - uint8(Creation)])) of - Port when is_port(Port) -> - Port; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_port, [{NodeName, Creation}, Number]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?PORT_EXT, + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint8(Creation)])) of + Port when is_port(Port) -> + Port; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_port, [{NodeName, Creation}, Number]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end. mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName), - is_integer(Creation), - is_list(Numbers) -> + is_integer(Creation), + is_list(Numbers) -> mk_ref({atom_to_list(NodeName), Creation}, Numbers); mk_ref({NodeName, Creation}, [Number]) when is_list(NodeName), - is_integer(Creation), - is_integer(Number) -> + is_integer(Creation), + is_integer(Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?REFERENCE_EXT, - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint32_be(Number), - uint8(Creation)])) of - Ref when is_reference(Ref) -> - Ref; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_ref, [{NodeName, Creation}, [Number]]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?REFERENCE_EXT, + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint8(Creation)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeName, Creation}, [Number]]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end; mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName), - is_integer(Creation), - is_list(Numbers) -> + is_integer(Creation), + is_list(Numbers) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?NEW_REFERENCE_EXT, - uint16_be(length(Numbers)), - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint8(Creation), - lists:map(fun (N) -> - uint32_be(N) - end, - Numbers)])) of - Ref when is_reference(Ref) -> - Ref; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_ref, [{NodeName, Creation}, Numbers]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?NEW_REFERENCE_EXT, + uint16_be(length(Numbers)), + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint8(Creation), + lists:map(fun (N) -> + uint32_be(N) + end, + Numbers)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeName, Creation}, Numbers]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end. my_cre() -> erlang:system_info(creation). diff --git a/erts/test/erl_print_SUITE_data/Makefile.src b/erts/test/erl_print_SUITE_data/Makefile.src index e6ea5cc6b9..69ff434c56 100644 --- a/erts/test/erl_print_SUITE_data/Makefile.src +++ b/erts/test/erl_print_SUITE_data/Makefile.src @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2012. All Rights Reserved. +# Copyright Ericsson AB 2005-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/test/erl_print_SUITE_data/character_test.h b/erts/test/erl_print_SUITE_data/character_test.h index 9ff032cb07..82310ee8e7 100644 --- a/erts/test/erl_print_SUITE_data/character_test.h +++ b/erts/test/erl_print_SUITE_data/character_test.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/test/erl_print_SUITE_data/erl_print_tests.c b/erts/test/erl_print_SUITE_data/erl_print_tests.c index fb23dc35a6..2fb7d1ff25 100644 --- a/erts/test/erl_print_SUITE_data/erl_print_tests.c +++ b/erts/test/erl_print_SUITE_data/erl_print_tests.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2012. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/test/erl_print_SUITE_data/integer_64_test.h b/erts/test/erl_print_SUITE_data/integer_64_test.h index 0c3e7b98a8..4bfc91334d 100644 --- a/erts/test/erl_print_SUITE_data/integer_64_test.h +++ b/erts/test/erl_print_SUITE_data/integer_64_test.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/test/erl_print_SUITE_data/integer_test.h b/erts/test/erl_print_SUITE_data/integer_test.h index b91f3622d6..b3744928b7 100644 --- a/erts/test/erl_print_SUITE_data/integer_test.h +++ b/erts/test/erl_print_SUITE_data/integer_test.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/test/erl_print_SUITE_data/snprintf_test.h b/erts/test/erl_print_SUITE_data/snprintf_test.h index c612a65521..77692304a3 100644 --- a/erts/test/erl_print_SUITE_data/snprintf_test.h +++ b/erts/test/erl_print_SUITE_data/snprintf_test.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/test/erl_print_SUITE_data/string_test.h b/erts/test/erl_print_SUITE_data/string_test.h index 0e257888e6..bfe4215d8a 100644 --- a/erts/test/erl_print_SUITE_data/string_test.h +++ b/erts/test/erl_print_SUITE_data/string_test.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * Copyright Ericsson AB 2005-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/test/erlc_SUITE.erl b/erts/test/erlc_SUITE.erl index c21064fd3f..237558a129 100644 --- a/erts/test/erlc_SUITE.erl +++ b/erts/test/erlc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,12 +22,12 @@ %% Tests the erlc command by compiling various types of files. -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, compile_erl/1, - compile_yecc/1, compile_script/1, - compile_mib/1, good_citizen/1, deep_cwd/1, arg_overflow/1, - make_dep_options/1]). + init_per_group/2,end_per_group/2, compile_erl/1, + compile_yecc/1, compile_script/1, + compile_mib/1, good_citizen/1, deep_cwd/1, arg_overflow/1, + make_dep_options/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -57,113 +57,109 @@ end_per_group(_GroupName, Config) -> %% Tests that compiling Erlang source code works. compile_erl(Config) when is_list(Config) -> - ?line {SrcDir, OutDir, Cmd} = get_cmd(Config), - ?line FileName = filename:join(SrcDir, "erl_test_ok.erl"), + {SrcDir, OutDir, Cmd} = get_cmd(Config), + FileName = filename:join(SrcDir, "erl_test_ok.erl"), %% By default, warnings are now turned on. - ?line run(Config, Cmd, FileName, "", - ["Warning: function foo/0 is unused\$", - "_OK_"]), + run(Config, Cmd, FileName, "", + ["Warning: function foo/0 is unused\$", "_OK_"]), %% Test that the compiled file is where it should be, %% and that it is runnable. - ?line {module, erl_test_ok} = code:load_abs(filename:join(OutDir, - "erl_test_ok")), - ?line 42 = erl_test_ok:shoe_size(#person{shoe_size=42}), - ?line code:purge(erl_test_ok), + {module, erl_test_ok} = code:load_abs(filename:join(OutDir, "erl_test_ok")), + 42 = erl_test_ok:shoe_size(#person{shoe_size=42}), + code:purge(erl_test_ok), %% Try disabling warnings. - ?line run(Config, Cmd, FileName, "-W0", ["_OK_"]), + run(Config, Cmd, FileName, "-W0", ["_OK_"]), %% Try treating warnings as errors. - ?line run(Config, Cmd, FileName, "-Werror", - ["compile: warnings being treated as errors\$", - "function foo/0 is unused\$", - "_ERROR_"]), + run(Config, Cmd, FileName, "-Werror", + ["compile: warnings being treated as errors\$", + "function foo/0 is unused\$", "_ERROR_"]), %% Check a bad file. - ?line BadFile = filename:join(SrcDir, "erl_test_bad.erl"), - ?line run(Config, Cmd, BadFile, "", ["function non_existing/1 undefined\$", - "_ERROR_"]), + BadFile = filename:join(SrcDir, "erl_test_bad.erl"), + run(Config, Cmd, BadFile, "", ["function non_existing/1 undefined\$", + "_ERROR_"]), ok. %% Test that compiling yecc source code works. compile_yecc(Config) when is_list(Config) -> - ?line {SrcDir, _, OutDir} = get_dirs(Config), - ?line Cmd = erlc() ++ " -o" ++ OutDir ++ " ", - ?line FileName = filename:join(SrcDir, "yecc_test_ok.yrl"), - ?line run(Config, Cmd, FileName, "-W0", ["_OK_"]), - ?line true = exists(filename:join(OutDir, "yecc_test_ok.erl")), - - ?line BadFile = filename:join(SrcDir, "yecc_test_bad.yrl"), - ?line run(Config, Cmd, BadFile, "-W0", - ["rootsymbol form is not a nonterminal\$", - "undefined nonterminal: form\$", - "Nonterminals is missing\$", - "_ERROR_"]), - ?line exists(filename:join(OutDir, "yecc_test_ok.erl")), - + {SrcDir, _, OutDir} = get_dirs(Config), + Cmd = erlc() ++ " -o" ++ OutDir ++ " ", + FileName = filename:join(SrcDir, "yecc_test_ok.yrl"), + run(Config, Cmd, FileName, "-W0", ["_OK_"]), + true = exists(filename:join(OutDir, "yecc_test_ok.erl")), + + BadFile = filename:join(SrcDir, "yecc_test_bad.yrl"), + run(Config, Cmd, BadFile, "-W0", + ["rootsymbol form is not a nonterminal\$", + "undefined nonterminal: form\$", + "Nonterminals is missing\$", + "_ERROR_"]), + exists(filename:join(OutDir, "yecc_test_ok.erl")), ok. %% Test that compiling start scripts works. compile_script(Config) when is_list(Config) -> - ?line {SrcDir, OutDir, Cmd} = get_cmd(Config), - ?line FileName = filename:join(SrcDir, "start_ok.script"), - ?line run(Config, Cmd, FileName, "", ["_OK_"]), - ?line true = exists(filename:join(OutDir, "start_ok.boot")), + {SrcDir, OutDir, Cmd} = get_cmd(Config), + FileName = filename:join(SrcDir, "start_ok.script"), + run(Config, Cmd, FileName, "", ["_OK_"]), + true = exists(filename:join(OutDir, "start_ok.boot")), - ?line BadFile = filename:join(SrcDir, "start_bad.script"), - ?line run(Config, Cmd, BadFile, "", ["syntax error before:", "_ERROR_"]), + BadFile = filename:join(SrcDir, "start_bad.script"), + run(Config, Cmd, BadFile, "", ["syntax error before:", "_ERROR_"]), ok. %% Test that compiling SNMP mibs works. compile_mib(Config) when is_list(Config) -> - ?line {SrcDir, OutDir, Cmd} = get_cmd(Config), - ?line FileName = filename:join(SrcDir, "GOOD-MIB.mib"), - ?line run(Config, Cmd, FileName, "", ["_OK_"]), - ?line Output = filename:join(OutDir, "GOOD-MIB.bin"), - ?line true = exists(Output), + {SrcDir, OutDir, Cmd} = get_cmd(Config), + FileName = filename:join(SrcDir, "GOOD-MIB.mib"), + run(Config, Cmd, FileName, "", ["_OK_"]), + Output = filename:join(OutDir, "GOOD-MIB.bin"), + true = exists(Output), %% Try -W option. - ?line ok = file:delete(Output), - ?line run(Config, Cmd, FileName, "-W", - ["_OK_"]), - ?line true = exists(Output), + ok = file:delete(Output), + run(Config, Cmd, FileName, "-W", + ["_OK_"]), + true = exists(Output), %% Try -W option and more verbose. - ?line ok = file:delete(Output), - ?line case test_server:os_type() of - {unix,_} -> - ?line run(Config, Cmd, FileName, "-W +'{verbosity,info}'", - ["\\[GOOD-MIB[.]mib\\]\\[INF\\]: No accessfunction for 'sysDescr' => using default", - "_OK_"]), - ?line true = exists(Output), - ?line ok = file:delete(Output); - _ -> ok %Don't bother -- too much work. - end, + ok = file:delete(Output), + case test_server:os_type() of + {unix,_} -> + run(Config, Cmd, FileName, "-W +'{verbosity,info}'", + ["\\[GOOD-MIB[.]mib\\]\\[INF\\]: No accessfunction for 'sysDescr' => using default", + "_OK_"]), + true = exists(Output), + ok = file:delete(Output); + _ -> ok %Don't bother -- too much work. + end, %% Try a bad file. - ?line BadFile = filename:join(SrcDir, "BAD-MIB.mib"), - ?line run(Config, Cmd, BadFile, "", - ["BAD-MIB.mib: 1: syntax error before: mibs\$", - "compilation_failed_ERROR_"]), + BadFile = filename:join(SrcDir, "BAD-MIB.mib"), + run(Config, Cmd, BadFile, "", + ["BAD-MIB.mib: 1: syntax error before: mibs\$", + "compilation_failed_ERROR_"]), %% Make sure that no -I option works. - ?line NewCmd = erlc() ++ " -o" ++ OutDir ++ " ", - ?line run(Config, NewCmd, FileName, "", ["_OK_"]), - ?line true = exists(Output), + NewCmd = erlc() ++ " -o" ++ OutDir ++ " ", + run(Config, NewCmd, FileName, "", ["_OK_"]), + true = exists(Output), ok. @@ -171,91 +167,91 @@ compile_mib(Config) when is_list(Config) -> %% shell script with redirected input). good_citizen(Config) when is_list(Config) -> case os:type() of - {unix, _} -> - ?line PrivDir = ?config(priv_dir, Config), - ?line Answer = filename:join(PrivDir, "answer"), - ?line Script = filename:join(PrivDir, "test_script"), - ?line Test = filename:join(PrivDir, "test.erl"), - ?line S = ["#! /bin/sh\n", "erlc ", Test, "\n", - "read reply\n", "echo $reply\n"], - ?line ok = file:write_file(Script, S), - ?line ok = file:write_file(Test, "-module(test).\n"), - ?line Cmd = "echo y | sh " ++ Script ++ " > " ++ Answer, - ?line os:cmd(Cmd), - ?line {ok, Answer0} = file:read_file(Answer), - ?line [$y|_] = binary_to_list(Answer0), - ok; - _ -> - {skip, "Unix specific"} + {unix, _} -> + PrivDir = proplists:get_value(priv_dir, Config), + Answer = filename:join(PrivDir, "answer"), + Script = filename:join(PrivDir, "test_script"), + Test = filename:join(PrivDir, "test.erl"), + S = ["#! /bin/sh\n", "erlc ", Test, "\n", + "read reply\n", "echo $reply\n"], + ok = file:write_file(Script, S), + ok = file:write_file(Test, "-module(test).\n"), + Cmd = "echo y | sh " ++ Script ++ " > " ++ Answer, + os:cmd(Cmd), + {ok, Answer0} = file:read_file(Answer), + [$y|_] = binary_to_list(Answer0), + ok; + _ -> + {skip, "Unix specific"} end. %% Make sure that compiling an Erlang module deep down in %% in a directory with more than 255 characters works. deep_cwd(Config) when is_list(Config) -> case os:type() of - {unix, _} -> - PrivDir = ?config(priv_dir, Config), - deep_cwd_1(PrivDir); - _ -> - {skip, "Only a problem on Unix"} + {unix, _} -> + PrivDir = proplists:get_value(priv_dir, Config), + deep_cwd_1(PrivDir); + _ -> + {skip, "Only a problem on Unix"} end. deep_cwd_1(PrivDir) -> - ?line DeepDir0 = filename:join(PrivDir, lists:duplicate(128, $a)), - ?line DeepDir = filename:join(DeepDir0, lists:duplicate(128, $b)), - ?line ok = file:make_dir(DeepDir0), - ?line ok = file:make_dir(DeepDir), - ?line ok = file:set_cwd(DeepDir), - ?line ok = file:write_file("test.erl", "-module(test).\n\n"), - ?line io:format("~s\n", [os:cmd("erlc test.erl")]), - ?line true = filelib:is_file("test.beam"), + DeepDir0 = filename:join(PrivDir, lists:duplicate(128, $a)), + DeepDir = filename:join(DeepDir0, lists:duplicate(128, $b)), + ok = file:make_dir(DeepDir0), + ok = file:make_dir(DeepDir), + ok = file:set_cwd(DeepDir), + ok = file:write_file("test.erl", "-module(test).\n\n"), + io:format("~s\n", [os:cmd("erlc test.erl")]), + true = filelib:is_file("test.beam"), ok. %% Test that a large number of command line switches does not %% overflow the argument buffer arg_overflow(Config) when is_list(Config) -> - ?line {SrcDir, _OutDir, Cmd} = get_cmd(Config), - ?line FileName = filename:join(SrcDir, "erl_test_ok.erl"), + {SrcDir, _OutDir, Cmd} = get_cmd(Config), + FileName = filename:join(SrcDir, "erl_test_ok.erl"), %% Each -D option will be expanded to three arguments when %% invoking 'erl'. - ?line NumDOptions = num_d_options(), - ?line Args = lists:flatten([ ["-D", integer_to_list(N, 36), "=1 "] || - N <- lists:seq(1, NumDOptions) ]), - ?line run(Config, Cmd, FileName, Args, - ["Warning: function foo/0 is unused\$", - "_OK_"]), + NumDOptions = num_d_options(), + Args = lists:flatten([ ["-D", integer_to_list(N, 36), "=1 "] || + N <- lists:seq(1, NumDOptions) ]), + run(Config, Cmd, FileName, Args, + ["Warning: function foo/0 is unused\$", + "_OK_"]), ok. num_d_options() -> case {os:type(),os:version()} of - {{win32,_},_} -> - %% The maximum size of a command line in the command - %% shell on Windows is 8191 characters. - %% Each -D option is expanded to "@dv NN 1", i.e. - %% 8 characters. (Numbers up to 1295 can be expressed - %% as two 36-base digits.) - 1000; - {{unix,linux},Version} when Version < {2,6,23} -> - %% On some older 64-bit versions of Linux, the maximum number - %% of arguments is 16383. - %% See: http://www.in-ulm.de/~mascheck/various/argmax/ - 5440; - {{unix,darwin},{Major,_,_}} when Major >= 11 -> - %% "getconf ARG_MAX" still reports 262144 (as in previous - %% version of MacOS X), but the useful space seem to have - %% shrunk significantly (or possibly the number of arguments). - %% 7673 - 7500; - {_,_} -> - 12000 + {{win32,_},_} -> + %% The maximum size of a command line in the command + %% shell on Windows is 8191 characters. + %% Each -D option is expanded to "@dv NN 1", i.e. + %% 8 characters. (Numbers up to 1295 can be expressed + %% as two 36-base digits.) + 1000; + {{unix,linux},Version} when Version < {2,6,23} -> + %% On some older 64-bit versions of Linux, the maximum number + %% of arguments is 16383. + %% See: http://www.in-ulm.de/~mascheck/various/argmax/ + 5440; + {{unix,darwin},{Major,_,_}} when Major >= 11 -> + %% "getconf ARG_MAX" still reports 262144 (as in previous + %% version of MacOS X), but the useful space seem to have + %% shrunk significantly (or possibly the number of arguments). + %% 7673 + 7500; + {_,_} -> + 12000 end. erlc() -> case os:find_executable("erlc") of - false -> - test_server:fail("Can't find erlc"); - Erlc -> - "\"" ++ Erlc ++ "\"" + false -> + ct:fail("Can't find erlc"); + Erlc -> + "\"" ++ Erlc ++ "\"" end. make_dep_options(Config) -> @@ -264,30 +260,30 @@ make_dep_options(Config) -> DepRE = ["/erl_test_ok[.]beam: \\\\$", - "/system_test/erlc_SUITE_data/src/erl_test_ok[.]erl \\\\$", - "/system_test/erlc_SUITE_data/include/erl_test[.]hrl$", - "_OK_"], + "/system_test/erlc_SUITE_data/src/erl_test_ok[.]erl \\\\$", + "/system_test/erlc_SUITE_data/include/erl_test[.]hrl$", + "_OK_"], DepRETarget = - ["^target: \\\\$", - "/system_test/erlc_SUITE_data/src/erl_test_ok[.]erl \\\\$", - "/system_test/erlc_SUITE_data/include/erl_test[.]hrl$", - "_OK_"], + ["^target: \\\\$", + "/system_test/erlc_SUITE_data/src/erl_test_ok[.]erl \\\\$", + "/system_test/erlc_SUITE_data/include/erl_test[.]hrl$", + "_OK_"], DepREMP = - ["/erl_test_ok[.]beam: \\\\$", - "/system_test/erlc_SUITE_data/src/erl_test_ok[.]erl \\\\$", - "/system_test/erlc_SUITE_data/include/erl_test[.]hrl$", - [], - "/system_test/erlc_SUITE_data/include/erl_test.hrl:$", - "_OK_"], + ["/erl_test_ok[.]beam: \\\\$", + "/system_test/erlc_SUITE_data/src/erl_test_ok[.]erl \\\\$", + "/system_test/erlc_SUITE_data/include/erl_test[.]hrl$", + [], + "/system_test/erlc_SUITE_data/include/erl_test.hrl:$", + "_OK_"], DepREMissing = - ["/erl_test_missing_header[.]beam: \\\\$", - "/system_test/erlc_SUITE_data/src/erl_test_missing_header[.]erl \\\\$", - "/system_test/erlc_SUITE_data/include/erl_test[.]hrl \\\\$", - "missing.hrl$", - "_OK_"], + ["/erl_test_missing_header[.]beam: \\\\$", + "/system_test/erlc_SUITE_data/src/erl_test_missing_header[.]erl \\\\$", + "/system_test/erlc_SUITE_data/include/erl_test[.]hrl \\\\$", + "missing.hrl$", + "_OK_"], %% Test plain -M run(Config, Cmd, FileName, "-M", DepRE), @@ -309,7 +305,7 @@ make_dep_options(Config) -> %% Test -MF File -MT Target TargetDepFile = filename:join(OutDir, "target.deps"), run(Config, Cmd, FileName, "-MF "++TargetDepFile++" -MT target", - ["_OK_"]), + ["_OK_"]), {ok,TargetBin} = file:read_file(TargetDepFile), verify_result(binary_to_list(TargetBin)++["_OK_"], DepRETarget), @@ -358,33 +354,33 @@ split([], Current, Lines) -> match_messages([Msg|Rest1], [Regexp|Rest2]) -> case re:run(Msg, Regexp, [{capture,none}, unicode]) of - match -> - ok; - nomatch -> - io:format("Not matching: ~s\n", [Msg]), - io:format("Regexp : ~s\n", [Regexp]), - test_server:fail(message_mismatch) + match -> + ok; + nomatch -> + io:format("Not matching: ~s\n", [Msg]), + io:format("Regexp : ~s\n", [Regexp]), + ct:fail(message_mismatch) end, match_messages(Rest1, Rest2); match_messages([], [Expect|Rest]) -> - test_server:fail({too_few_messages, [Expect|Rest]}); + ct:fail({too_few_messages, [Expect|Rest]}); match_messages([Msg|Rest], []) -> - test_server:fail({too_many_messages, [Msg|Rest]}); + ct:fail({too_many_messages, [Msg|Rest]}); match_messages([], []) -> ok. get_cmd(Cfg) -> - ?line {SrcDir, IncDir, OutDir} = get_dirs(Cfg), - ?line Cmd = erlc() ++ " -I" ++ IncDir ++ " -o" ++ OutDir ++ " ", + {SrcDir, IncDir, OutDir} = get_dirs(Cfg), + Cmd = erlc() ++ " -I" ++ IncDir ++ " -o" ++ OutDir ++ " ", {SrcDir, OutDir, Cmd}. get_dirs(Cfg) -> - ?line DataDir = ?config(data_dir, Cfg), - ?line PrivDir = ?config(priv_dir, Cfg), - ?line SrcDir = filename:join(DataDir, "src"), - ?line IncDir = filename:join(DataDir, "include"), + DataDir = proplists:get_value(data_dir, Cfg), + PrivDir = proplists:get_value(priv_dir, Cfg), + SrcDir = filename:join(DataDir, "src"), + IncDir = filename:join(DataDir, "include"), {SrcDir, IncDir, PrivDir}. - + exists(Name) -> filelib:is_file(Name). @@ -396,7 +392,7 @@ exists(Name) -> %% a non-zero exit status. run_command(Config, Cmd) -> - TmpDir = filename:join(?config(priv_dir, Config), "tmp"), + TmpDir = filename:join(proplists:get_value(priv_dir, Config), "tmp"), file:make_dir(TmpDir), {RunFile, Run, Script} = run_command(TmpDir, os:type(), Cmd), ok = file:write_file(filename:join(TmpDir, RunFile), unicode:characters_to_binary(Script)), @@ -405,7 +401,7 @@ run_command(Config, Cmd) -> run_command(Dir, {win32, _}, Cmd) -> BatchFile = filename:join(Dir, "run.bat"), Run = re:replace(filename:rootname(BatchFile), "/", "\\", - [global,{return,list}]), + [global,{return,list}]), {BatchFile, Run, ["@echo off\r\n", @@ -426,5 +422,4 @@ run_command(Dir, {unix, _}, Cmd) -> " *) echo '_ERROR_';;\n", "esac\n"]}; run_command(_Dir, Other, _Cmd) -> - M = io_lib:format("Don't know how to test exit code for ~p", [Other]), - test_server:fail(lists:flatten(M)). + ct:fail("Don't know how to test exit code for ~p", [Other]). diff --git a/erts/test/erlc_SUITE_data/include/erl_test.hrl b/erts/test/erlc_SUITE_data/include/erl_test.hrl index e7d096d2c1..70aecc4762 100644 --- a/erts/test/erlc_SUITE_data/include/erl_test.hrl +++ b/erts/test/erlc_SUITE_data/include/erl_test.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/test/erlc_SUITE_data/src/erl_test_bad.erl b/erts/test/erlc_SUITE_data/src/erl_test_bad.erl index b8c4ee2786..cbfe81705f 100644 --- a/erts/test/erlc_SUITE_data/src/erl_test_bad.erl +++ b/erts/test/erlc_SUITE_data/src/erl_test_bad.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/test/erlc_SUITE_data/src/erl_test_missing_header.erl b/erts/test/erlc_SUITE_data/src/erl_test_missing_header.erl index f043fbebc4..604bb16bd6 100644 --- a/erts/test/erlc_SUITE_data/src/erl_test_missing_header.erl +++ b/erts/test/erlc_SUITE_data/src/erl_test_missing_header.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/test/erlc_SUITE_data/src/erl_test_ok.erl b/erts/test/erlc_SUITE_data/src/erl_test_ok.erl index a82eda95b3..f1a48cbf18 100644 --- a/erts/test/erlc_SUITE_data/src/erl_test_ok.erl +++ b/erts/test/erlc_SUITE_data/src/erl_test_ok.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/test/erlc_SUITE_data/src/yecc_test_bad.yrl b/erts/test/erlc_SUITE_data/src/yecc_test_bad.yrl index de17b903d6..da488b7232 100644 --- a/erts/test/erlc_SUITE_data/src/yecc_test_bad.yrl +++ b/erts/test/erlc_SUITE_data/src/yecc_test_bad.yrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/test/erlc_SUITE_data/src/yecc_test_ok.yrl b/erts/test/erlc_SUITE_data/src/yecc_test_ok.yrl index 9433dcb90d..feb067e34b 100644 --- a/erts/test/erlc_SUITE_data/src/yecc_test_ok.yrl +++ b/erts/test/erlc_SUITE_data/src/yecc_test_ok.yrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/test/erlexec_SUITE.erl b/erts/test/erlexec_SUITE.erl index 9279872d25..44d7f63387 100644 --- a/erts/test/erlexec_SUITE.erl +++ b/erts/test/erlexec_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -27,71 +27,46 @@ %%%------------------------------------------------------------------- -module(erlexec_SUITE). +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]). -%-define(line_trace, 1). +-export([args_file/1, evil_args_file/1, env/1, args_file_env/1, + otp_7461/1, otp_7461_remote/1, otp_8209/1, + zdbbl_dist_buf_busy_limit/1]). --define(DEFAULT_TIMEOUT, ?t:minutes(1)). - --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([args_file/1, evil_args_file/1, env/1, args_file_env/1, otp_7461/1, otp_7461_remote/1, otp_8209/1, zdbbl_dist_buf_busy_limit/1]). - --include_lib("test_server/include/test_server.hrl"). - +-include_lib("common_test/include/ct.hrl"). init_per_testcase(Case, Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), SavedEnv = save_env(), - [{testcase, Case}, {watchdog, Dog}, {erl_flags_env, SavedEnv} |Config]. + [{testcase, Case},{erl_flags_env, SavedEnv}|Config]. end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - SavedEnv = ?config(erl_flags_env, Config), + SavedEnv = proplists:get_value(erl_flags_env, Config), restore_env(SavedEnv), cleanup_nodes(), - ?t:timetrap_cancel(Dog), ok. -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [args_file, evil_args_file, env, args_file_env, otp_7461, otp_8209, zdbbl_dist_buf_busy_limit]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -otp_8209(doc) -> - ["Test that plain first argument does not " - "destroy -home switch [OTP-8209]"]; -otp_8209(suite) -> - []; +%% Test that plain first argument does not +%% destroy -home switch [OTP-8209] otp_8209(Config) when is_list(Config) -> - ?line {ok,[[PName]]} = init:get_argument(progname), - ?line SNameS = "erlexec_test_01", - ?line SName = list_to_atom(SNameS++"@"++ + {ok,[[PName]]} = init:get_argument(progname), + SNameS = "erlexec_test_01", + SName = list_to_atom(SNameS++"@"++ hd(tl(string:tokens(atom_to_list(node()),"@")))), - ?line Cmd = PName ++ " dummy_param -sname "++SNameS++" -setcookie "++ + Cmd = PName ++ " dummy_param -sname "++SNameS++" -setcookie "++ atom_to_list(erlang:get_cookie()), - ?line open_port({spawn,Cmd},[]), - ?line pong = loop_ping(SName,40), - ?line {ok,[[_]]} = rpc:call(SName,init,get_argument,[home]), - ?line ["dummy_param"] = rpc:call(SName,init,get_plain_arguments,[]), - ?line ok = cleanup_nodes(), + open_port({spawn,Cmd},[]), + pong = loop_ping(SName,40), + {ok,[[_]]} = rpc:call(SName,init,get_argument,[home]), + ["dummy_param"] = rpc:call(SName,init,get_plain_arguments,[]), + ok = cleanup_nodes(), ok. cleanup_nodes() -> @@ -123,17 +98,14 @@ loop_ping(Node,N) -> pong end. -args_file(doc) -> []; -args_file(suite) -> []; args_file(Config) when is_list(Config) -> - ?line AFN1 = privfile("1", Config), - ?line AFN2 = privfile("2", Config), - ?line AFN3 = privfile("3", Config), - ?line AFN4 = privfile("4", Config), - ?line AFN5 = privfile("5", Config), - ?line AFN6 = privfile("6", Config), - ?line write_file(AFN1, - "-MiscArg2~n" + AFN1 = privfile("1", Config), + AFN2 = privfile("2", Config), + AFN3 = privfile("3", Config), + AFN4 = privfile("4", Config), + AFN5 = privfile("5", Config), + AFN6 = privfile("6", Config), + write_file(AFN1, "-MiscArg2~n" "# a comment +\\#1000~n" "+\\#200 # another comment~n" "~n" @@ -145,7 +117,7 @@ args_file(Config) when is_list(Config) -> "+\\#700~n" "-extra +XtraArg6~n", [AFN2]), - ?line write_file(AFN2, + write_file(AFN2, "-MiscArg3~n" "+\\#300~n" "-args_file ~s~n" @@ -156,61 +128,59 @@ args_file(Config) when is_list(Config) -> "-args_file ~s~n" "-extra +XtraArg5~n", [AFN3, AFN4, AFN5, AFN6]), - ?line write_file(AFN3, + write_file(AFN3, "# comment again~n" " -MiscArg4 +\\#400 -extra +XtraArg1"), - ?line write_file(AFN4, + write_file(AFN4, " -MiscArg6 +\\#600 -extra +XtraArg2~n" "+XtraArg3~n" "+XtraArg4~n" "# comment again~n"), - ?line write_file(AFN5, ""), - ?line write_file(AFN6, "-extra # +XtraArg10~n"), - ?line CmdLine = "+#100 -MiscArg1 " + write_file(AFN5, ""), + write_file(AFN6, "-extra # +XtraArg10~n"), + CmdLine = "+#100 -MiscArg1 " ++ "-args_file " ++ AFN1 ++ " +#800 -MiscArg8 -extra +XtraArg7 +XtraArg8", - ?line {Emu, Misc, Extra} = emu_args(CmdLine), - ?line verify_args(["-#100", "-#200", "-#300", "-#400", + {Emu, Misc, Extra} = emu_args(CmdLine), + verify_args(["-#100", "-#200", "-#300", "-#400", "-#500", "-#600", "-#700", "-#800"], Emu), - ?line verify_args(["-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", + verify_args(["-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", "-MiscArg5", "-MiscArg6", "-MiscArg7", "-MiscArg8"], Misc), - ?line verify_args(["+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", + verify_args(["+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", "+XtraArg5", "+XtraArg6", "+XtraArg7", "+XtraArg8"], Extra), - ?line verify_not_args(["-MiscArg10", "-#1000", "+XtraArg10", + verify_not_args(["-MiscArg10", "-#1000", "+XtraArg10", "-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", "-MiscArg5", "-MiscArg6", "-MiscArg7", "-MiscArg8", "+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", "+XtraArg5", "+XtraArg6", "+XtraArg7", "+XtraArg8"], Emu), - ?line verify_not_args(["-MiscArg10", "-#1000", "+XtraArg10", + verify_not_args(["-MiscArg10", "-#1000", "+XtraArg10", "-#100", "-#200", "-#300", "-#400", "-#500", "-#600", "-#700", "-#800", "+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", "+XtraArg5", "+XtraArg6", "+XtraArg7", "+XtraArg8"], Misc), - ?line verify_not_args(["-MiscArg10", "-#1000", "+XtraArg10", + verify_not_args(["-MiscArg10", "-#1000", "+XtraArg10", "-#100", "-#200", "-#300", "-#400", "-#500", "-#600", "-#700", "-#800", "-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", "-MiscArg5", "-MiscArg6", "-MiscArg7", "-MiscArg8"], Extra), - ?line ok. + ok. -evil_args_file(doc) -> []; -evil_args_file(suite) -> []; evil_args_file(Config) when is_list(Config) -> - ?line Lim = 300, - ?line FNums = lists:seq(1, Lim), + Lim = 300, + FNums = lists:seq(1, Lim), lists:foreach(fun (End) when End == Lim -> - ?line AFN = privfile(integer_to_list(End), Config), - ?line write_file(AFN, + AFN = privfile(integer_to_list(End), Config), + write_file(AFN, "-MiscArg~p ", [End]); (I) -> - ?line AFNX = privfile(integer_to_list(I), Config), - ?line AFNY = privfile(integer_to_list(I+1), Config), + AFNX = privfile(integer_to_list(I), Config), + AFNY = privfile(integer_to_list(I+1), Config), {Frmt, Args} = case I rem 2 of 0 -> @@ -220,65 +190,59 @@ evil_args_file(Config) when is_list(Config) -> {"-MiscArg~p -args_file ~s", [I, AFNY]} end, - ?line write_file(AFNX, Frmt, Args) + write_file(AFNX, Frmt, Args) end, FNums), - ?line {_Emu, Misc, _Extra} = emu_args("-args_file " + {_Emu, Misc, _Extra} = emu_args("-args_file " ++ privfile("1", Config)), - ?line ANums = FNums + ANums = FNums ++ lists:reverse(lists:filter(fun (I) when I == Lim -> false; (I) when I rem 2 == 0 -> true; (_) -> false end, FNums)), - ?line verify_args(lists:map(fun (I) -> "-MiscArg"++integer_to_list(I) end, + verify_args(lists:map(fun (I) -> "-MiscArg"++integer_to_list(I) end, ANums), Misc), - ?line ok. + ok. -env(doc) -> []; -env(suite) -> []; env(Config) when is_list(Config) -> - ?line os:putenv("ERL_AFLAGS", "-MiscArg1 +#100 -extra +XtraArg1 +XtraArg2"), - ?line CmdLine = "+#200 -MiscArg2 -extra +XtraArg3 +XtraArg4", - ?line os:putenv("ERL_FLAGS", "-MiscArg3 +#300 -extra +XtraArg5"), - ?line os:putenv("ERL_ZFLAGS", "-MiscArg4 +#400 -extra +XtraArg6"), - ?line {Emu, Misc, Extra} = emu_args(CmdLine), - ?line verify_args(["-#100", "-#200", "-#300", "-#400"], Emu), - ?line verify_args(["-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4"], + os:putenv("ERL_AFLAGS", "-MiscArg1 +#100 -extra +XtraArg1 +XtraArg2"), + CmdLine = "+#200 -MiscArg2 -extra +XtraArg3 +XtraArg4", + os:putenv("ERL_FLAGS", "-MiscArg3 +#300 -extra +XtraArg5"), + os:putenv("ERL_ZFLAGS", "-MiscArg4 +#400 -extra +XtraArg6"), + {Emu, Misc, Extra} = emu_args(CmdLine), + verify_args(["-#100", "-#200", "-#300", "-#400"], Emu), + verify_args(["-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4"], Misc), - ?line verify_args(["+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", + verify_args(["+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", "+XtraArg5", "+XtraArg6"], Extra), - ?line ok. + ok. -args_file_env(doc) -> []; -args_file_env(suite) -> []; args_file_env(Config) when is_list(Config) -> - ?line AFN1 = privfile("1", Config), - ?line AFN2 = privfile("2", Config), - ?line write_file(AFN1, "-MiscArg2 +\\#200 -extra +XtraArg1"), - ?line write_file(AFN2, "-MiscArg3 +\\#400 -extra +XtraArg3"), - ?line os:putenv("ERL_AFLAGS", + AFN1 = privfile("1", Config), + AFN2 = privfile("2", Config), + write_file(AFN1, "-MiscArg2 +\\#200 -extra +XtraArg1"), + write_file(AFN2, "-MiscArg3 +\\#400 -extra +XtraArg3"), + os:putenv("ERL_AFLAGS", "-MiscArg1 +#100 -args_file "++AFN1++ " -extra +XtraArg2"), - ?line CmdLine = "+#300 -args_file "++AFN2++" -MiscArg4 -extra +XtraArg4", - ?line os:putenv("ERL_FLAGS", "-MiscArg5 +#500 -extra +XtraArg5"), - ?line os:putenv("ERL_ZFLAGS", "-MiscArg6 +#600 -extra +XtraArg6"), - ?line {Emu, Misc, Extra} = emu_args(CmdLine), - ?line verify_args(["-#100", "-#200", "-#300", "-#400", + CmdLine = "+#300 -args_file "++AFN2++" -MiscArg4 -extra +XtraArg4", + os:putenv("ERL_FLAGS", "-MiscArg5 +#500 -extra +XtraArg5"), + os:putenv("ERL_ZFLAGS", "-MiscArg6 +#600 -extra +XtraArg6"), + {Emu, Misc, Extra} = emu_args(CmdLine), + verify_args(["-#100", "-#200", "-#300", "-#400", "-#500", "-#600"], Emu), - ?line verify_args(["-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", + verify_args(["-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", "-MiscArg5", "-MiscArg6"], Misc), - ?line verify_args(["+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", + verify_args(["+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", "+XtraArg5", "+XtraArg6"], Extra), - ?line ok. + ok. %% Make sure "erl -detached" survives when parent process group gets killed -otp_7461(doc) -> []; -otp_7461(suite) -> []; otp_7461(Config) when is_list(Config) -> case os:type() of {unix,_} -> @@ -302,9 +266,9 @@ otp_7461(Config) when is_list(Config) -> otp_7461_do(Config) -> io:format("alive=~p node=~p\n",[is_alive(), node()]), - TestProg = filename:join([?config(data_dir, Config), "erlexec_tests"]), + TestProg = filename:join([proplists:get_value(data_dir, Config), "erlexec_tests"]), {ok, [[ErlProg]]} = init:get_argument(progname), - ?line Cmd = TestProg ++ " " ++ ErlProg ++ + Cmd = TestProg ++ " " ++ ErlProg ++ " -detached -sname " ++ get_nodename(otp_7461) ++ " -setcookie " ++ atom_to_list(erlang:get_cookie()) ++ " -pa " ++ filename:dirname(code:which(?MODULE)) ++ @@ -314,29 +278,31 @@ otp_7461_do(Config) -> %% open_port fork+exec io:format("spawn port prog ~p\n",[Cmd]), - ?line Port = open_port({spawn, Cmd}, [eof]), + Port = open_port({spawn, Cmd}, [eof]), io:format("Wait for node to connect...\n",[]), - ?line {nodeup, Slave} = receive Msg -> Msg + {nodeup, Slave} = receive Msg -> Msg after 20*1000 -> timeout end, io:format("Node alive: ~p\n", [Slave]), - ?line pong = net_adm:ping(Slave), + pong = net_adm:ping(Slave), io:format("Ping ok towards ~p\n", [Slave]), - ?line Port ! { self(), {command, "K"}}, % Kill child process group - ?line {Port, {data, "K"}} = receive Msg2 -> Msg2 end, - ?line port_close(Port), + Port ! { self(), {command, "K"}}, % Kill child process group + {Port, {data, "K"}} = receive Msg2 -> Msg2 end, + port_close(Port), %% Now the actual test. Detached node should still be alive. - ?line pong = net_adm:ping(Slave), + pong = net_adm:ping(Slave), io:format("Ping still ok towards ~p\n", [Slave]), %% Halt node - ?line rpc:cast(Slave, ?MODULE, otp_7461_remote, [[halt, self()]]), + rpc:cast(Slave, ?MODULE, otp_7461_remote, [[halt, self()]]), - ?line {nodedown, Slave} = receive Msg3 -> Msg3 - after 20*1000 -> timeout end, + {nodedown, Slave} = receive + Msg3 -> Msg3 + after 20*1000 -> timeout + end, io:format("Node dead: ~p\n", [Slave]), ok. @@ -349,24 +315,21 @@ otp_7461_remote([halt, Pid]) -> io:format("halt order from ~p to node ~p\n",[Pid,node()]), halt(). -zdbbl_dist_buf_busy_limit(doc) -> - ["Check +zdbbl flag"]; -zdbbl_dist_buf_busy_limit(suite) -> - []; +%% Check +zdbbl flag zdbbl_dist_buf_busy_limit(Config) when is_list(Config) -> LimKB = 1122233, LimB = LimKB*1024, - ?line {ok,[[PName]]} = init:get_argument(progname), - ?line SNameS = "erlexec_test_02", - ?line SName = list_to_atom(SNameS++"@"++ + {ok,[[PName]]} = init:get_argument(progname), + SNameS = "erlexec_test_02", + SName = list_to_atom(SNameS++"@"++ hd(tl(string:tokens(atom_to_list(node()),"@")))), - ?line Cmd = PName ++ " -sname "++SNameS++" -setcookie "++ + Cmd = PName ++ " -sname "++SNameS++" -setcookie "++ atom_to_list(erlang:get_cookie()) ++ " +zdbbl " ++ integer_to_list(LimKB), - ?line open_port({spawn,Cmd},[]), - ?line pong = loop_ping(SName,40), - ?line LimB = rpc:call(SName,erlang,system_info,[dist_buf_busy_limit]), - ?line ok = cleanup_node(SNameS, 10), + open_port({spawn,Cmd},[]), + pong = loop_ping(SName,40), + LimB = rpc:call(SName,erlang,system_info,[dist_buf_busy_limit]), + ok = cleanup_node(SNameS, 10), ok. @@ -404,8 +367,8 @@ restore_env({erl_flags, AFlgs, Flgs, RFlgs, ZFlgs}) -> ok. privfile(Name, Config) -> - filename:join([?config(priv_dir, Config), - atom_to_list(?config(testcase, Config)) ++ "." ++ Name]). + filename:join([proplists:get_value(priv_dir, Config), + atom_to_list(proplists:get_value(testcase, Config)) ++ "." ++ Name]). write_file(FileName, Frmt) -> write_file(FileName, Frmt, []). @@ -430,8 +393,7 @@ verify_not_args(Xs, Ys) -> true -> exit({arg_present, X}); false -> ok end - end, - Xs). + end, Xs). emu_args(CmdLineArgs) -> io:format("CmdLineArgs = ~ts~n", [CmdLineArgs]), diff --git a/erts/test/erlexec_SUITE_data/Makefile.src b/erts/test/erlexec_SUITE_data/Makefile.src index 145aaedd64..641dff1e30 100644 --- a/erts/test/erlexec_SUITE_data/Makefile.src +++ b/erts/test/erlexec_SUITE_data/Makefile.src @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2008-2012. All Rights Reserved. +# Copyright Ericsson AB 2008-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/test/erlexec_SUITE_data/erlexec_tests.c b/erts/test/erlexec_SUITE_data/erlexec_tests.c index 569bf7bcc4..bd28d2900c 100644 --- a/erts/test/erlexec_SUITE_data/erlexec_tests.c +++ b/erts/test/erlexec_SUITE_data/erlexec_tests.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2010. All Rights Reserved. + * Copyright Ericsson AB 2008-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/test/ethread_SUITE.erl b/erts/test/ethread_SUITE.erl index 4a40dbb11e..19f738c572 100644 --- a/erts/test/ethread_SUITE.erl +++ b/erts/test/ethread_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2012. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,13 +28,7 @@ -module(ethread_SUITE). -author('[email protected]'). -%-define(line_trace, 1). - --define(DEFAULT_TIMEOUT, ?t:minutes(10)). - --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([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]). -export([create_join_thread/1, equal_tids/1, @@ -51,9 +45,13 @@ atomic/1, dw_atomic_massage/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 10}}]. -tests() -> +all() -> [create_join_thread, equal_tids, mutex, @@ -69,110 +67,50 @@ tests() -> atomic, dw_atomic_massage]. -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - tests(). - -groups() -> - []. - -init_per_suite(Config) -> - Config. +init_per_testcase(Case, Config) -> + case inet:gethostname() of + {ok,"fenris"} when Case == max_threads -> + %% Cannot use os:type+os:version as not all + %% solaris10 machines are buggy. + {skip, "This machine is buggy"}; + _Else -> + Config + end. -end_per_suite(_Config) -> +end_per_testcase(_Case, _Config) -> ok. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - %% %% %% The test-cases %% %% -create_join_thread(doc) -> - ["Tests ethr_thr_create and ethr_thr_join."]; -create_join_thread(suite) -> - []; +%% Tests ethr_thr_create and ethr_thr_join. create_join_thread(Config) -> run_case(Config, "create_join_thread", ""). -equal_tids(doc) -> - ["Tests ethr_equal_tids."]; -equal_tids(suite) -> - []; +%% Tests ethr_equal_tids. equal_tids(Config) -> run_case(Config, "equal_tids", ""). -mutex(doc) -> - ["Tests mutexes."]; -mutex(suite) -> - []; +%% Tests mutexes. mutex(Config) -> run_case(Config, "mutex", ""). -try_lock_mutex(doc) -> - ["Tests try lock on mutex."]; -try_lock_mutex(suite) -> - []; +%% Tests try lock on mutex. try_lock_mutex(Config) -> run_case(Config, "try_lock_mutex", ""). -%% Remove dead code? - -% wd_dispatch(P) -> -% receive -% bye -> -% ?line true = port_command(P, "-1 "), -% ?line bye; -% L when is_list(L) -> -% ?line true = port_command(P, L), -% ?line wd_dispatch(P) -% end. -% -% watchdog(Port) -> -% ?line process_flag(priority, max), -% ?line receive after 500 -> ok end, -% -% ?line random:seed(), -% ?line true = port_command(Port, "0 "), -% ?line lists:foreach(fun (T) -> -% erlang:send_after(T, -% self(), -% integer_to_list(T) -% ++ " ") -% end, -% lists:usort(lists:map(fun (_) -> -% random:uniform(4500)+500 -% end, -% lists:duplicate(50,0)))), -% ?line erlang:send_after(5100, self(), bye), -% -% wd_dispatch(Port). - -cond_wait(doc) -> - ["Tests ethr_cond_wait with ethr_cond_signal and ethr_cond_broadcast."]; -cond_wait(suite) -> - []; +%% Tests ethr_cond_wait with ethr_cond_signal and ethr_cond_broadcast. cond_wait(Config) -> run_case(Config, "cond_wait", ""). -broadcast(doc) -> - ["Tests that a ethr_cond_broadcast really wakes up all waiting threads"]; -broadcast(suite) -> - []; +%% Tests that a ethr_cond_broadcast really wakes up all waiting threads broadcast(Config) -> run_case(Config, "broadcast", ""). -detached_thread(doc) -> - ["Tests detached threads."]; -detached_thread(suite) -> - []; +%% Tests detached threads. detached_thread(Config) -> case {os:type(), os:version()} of {{unix,darwin}, {9, _, _}} -> @@ -184,10 +122,7 @@ detached_thread(Config) -> run_case(Config, "detached_thread", "") end. -max_threads(doc) -> - ["Tests maximum number of threads."]; -max_threads(suite) -> - []; +%% Tests maximum number of threads. max_threads(Config) -> case {os:type(), os:version()} of {{unix,darwin}, {9, _, _}} -> @@ -199,45 +134,27 @@ max_threads(Config) -> run_case(Config, "max_threads", "") end. -tsd(doc) -> - ["Tests thread specific data."]; -tsd(suite) -> - []; +%% Tests thread specific data. tsd(Config) -> run_case(Config, "tsd", ""). -spinlock(doc) -> - ["Tests spinlocks."]; -spinlock(suite) -> - []; +%% Tests spinlocks. spinlock(Config) -> run_case(Config, "spinlock", ""). -rwspinlock(doc) -> - ["Tests rwspinlocks."]; -rwspinlock(suite) -> - []; +%% Tests rwspinlocks. rwspinlock(Config) -> run_case(Config, "rwspinlock", ""). -rwmutex(doc) -> - ["Tests rwmutexes."]; -rwmutex(suite) -> - []; +%% Tests rwmutexes. rwmutex(Config) -> run_case(Config, "rwmutex", ""). -atomic(doc) -> - ["Tests atomics."]; -atomic(suite) -> - []; +%% Tests atomics. atomic(Config) -> run_case(Config, "atomic", ""). -dw_atomic_massage(doc) -> - ["Massage double word atomics"]; -dw_atomic_massage(suite) -> - []; +%% Massage double word atomics dw_atomic_massage(Config) -> run_case(Config, "dw_atomic_massage", ""). @@ -247,22 +164,6 @@ dw_atomic_massage(Config) -> %% %% -init_per_testcase(Case, Config) -> - case inet:gethostname() of - {ok,"fenris"} when Case == max_threads -> - %% Cannot use os:type+os:version as not all - %% solaris10 machines are buggy. - {skip, "This machine is buggy"}; - _Else -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, Dog}|Config] - end. - -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -define(TESTPROG, "ethread_tests"). -define(FAILED_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$F,$A,$I,$L,$U,$R,$E). -define(SKIPPED_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$S,$K,$I,$P). @@ -270,68 +171,68 @@ end_per_testcase(_Case, Config) -> -define(PID_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$P,$I,$D). port_prog_killer(EProc, OSProc) when is_pid(EProc), is_list(OSProc) -> - ?line process_flag(trap_exit, true), - ?line Ref = erlang:monitor(process, EProc), - ?line receive - {'DOWN', Ref, _, _, Reason} when is_tuple(Reason), - element(1, Reason) - == timetrap_timeout -> - ?line Cmd = "kill -9 " ++ OSProc, - ?line ?t:format("Test case timed out. " - "Trying to kill port program.~n" - " Executing: ~p~n", [Cmd]), - ?line case os:cmd(Cmd) of - [] -> - ok; - OsCmdRes -> - ?line ?t:format(" ~s", [OsCmdRes]) - end; - {'DOWN', Ref, _, _, _} -> - %% OSProc is assumed to have terminated by itself - ?line ok - end. + process_flag(trap_exit, true), + Ref = erlang:monitor(process, EProc), + receive + {'DOWN', Ref, _, _, Reason} when is_tuple(Reason), + element(1, Reason) + == timetrap_timeout -> + Cmd = "kill -9 " ++ OSProc, + io:format("Test case timed out. " + "Trying to kill port program.~n" + " Executing: ~p~n", [Cmd]), + case os:cmd(Cmd) of + [] -> + ok; + OsCmdRes -> + io:format(" ~s", [OsCmdRes]) + end; + %% OSProc is assumed to have terminated by itself + {'DOWN', Ref, _, _, _} -> + ok + end. get_line(_Port, eol, Data) -> - ?line Data; + Data; get_line(Port, noeol, Data) -> - ?line receive + receive {Port, {data, {Flag, NextData}}} -> - ?line get_line(Port, Flag, Data ++ NextData); + get_line(Port, Flag, Data ++ NextData); {Port, eof} -> - ?line ?t:fail(port_prog_unexpectedly_closed) + ct:fail(port_prog_unexpectedly_closed) end. read_case_data(Port, TestCase) -> - ?line receive - {Port, {data, {eol, [?SUCCESS_MARKER]}}} -> - ?line ok; - {Port, {data, {Flag, [?SUCCESS_MARKER | CommentStart]}}} -> - ?line {comment, get_line(Port, Flag, CommentStart)}; - {Port, {data, {Flag, [?SKIPPED_MARKER | CommentStart]}}} -> - ?line {skipped, get_line(Port, Flag, CommentStart)}; - {Port, {data, {Flag, [?FAILED_MARKER | ReasonStart]}}} -> - ?line ?t:fail(get_line(Port, Flag, ReasonStart)); - {Port, {data, {eol, [?PID_MARKER | PidStr]}}} -> - ?line ?t:format("Port program pid: ~s~n", [PidStr]), - ?line CaseProc = self(), - ?line _ = list_to_integer(PidStr), % Sanity check - spawn_opt(fun () -> - port_prog_killer(CaseProc, PidStr) - end, - [{priority, max}, link]), - read_case_data(Port, TestCase); - {Port, {data, {Flag, LineStart}}} -> - ?line ?t:format("~s~n", [get_line(Port, Flag, LineStart)]), - read_case_data(Port, TestCase); - {Port, eof} -> - ?line ?t:fail(port_prog_unexpectedly_closed) - end. + receive + {Port, {data, {eol, [?SUCCESS_MARKER]}}} -> + ok; + {Port, {data, {Flag, [?SUCCESS_MARKER | CommentStart]}}} -> + {comment, get_line(Port, Flag, CommentStart)}; + {Port, {data, {Flag, [?SKIPPED_MARKER | CommentStart]}}} -> + {skipped, get_line(Port, Flag, CommentStart)}; + {Port, {data, {Flag, [?FAILED_MARKER | ReasonStart]}}} -> + ct:fail(get_line(Port, Flag, ReasonStart)); + {Port, {data, {eol, [?PID_MARKER | PidStr]}}} -> + io:format("Port program pid: ~s~n", [PidStr]), + CaseProc = self(), + _ = list_to_integer(PidStr), % Sanity check + spawn_opt(fun () -> + port_prog_killer(CaseProc, PidStr) + end, + [{priority, max}, link]), + read_case_data(Port, TestCase); + {Port, {data, {Flag, LineStart}}} -> + io:format("~s~n", [get_line(Port, Flag, LineStart)]), + read_case_data(Port, TestCase); + {Port, eof} -> + ct:fail(port_prog_unexpectedly_closed) + end. run_case(Config, Test, TestArgs) -> run_case(Config, Test, TestArgs, fun (_Port) -> ok end). run_case(Config, Test, TestArgs, Fun) -> - TestProg = filename:join([?config(data_dir, Config), ?TESTPROG]), + TestProg = filename:join([proplists:get_value(data_dir, Config), ?TESTPROG]), Cmd = TestProg ++ " " ++ Test ++ " " ++ TestArgs, case catch open_port({spawn, Cmd}, [stream, use_stdio, @@ -339,17 +240,13 @@ run_case(Config, Test, TestArgs, Fun) -> eof, {line, 1024}]) of Port when is_port(Port) -> - ?line Fun(Port), - ?line CaseResult = read_case_data(Port, Test), - ?line receive - {Port, eof} -> - ?line ok - end, - ?line CaseResult; + Fun(Port), + CaseResult = read_case_data(Port, Test), + receive + {Port, eof} -> + ok + end, + CaseResult; Error -> - ?line ?t:fail({open_port_failed, Error}) + ct:fail({open_port_failed, Error}) end. - - - - diff --git a/erts/test/ethread_SUITE_data/Makefile.src b/erts/test/ethread_SUITE_data/Makefile.src index e8b9c79576..cf675b92a3 100644 --- a/erts/test/ethread_SUITE_data/Makefile.src +++ b/erts/test/ethread_SUITE_data/Makefile.src @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2012. All Rights Reserved. +# Copyright Ericsson AB 2004-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/test/ethread_SUITE_data/ethread_tests.c b/erts/test/ethread_SUITE_data/ethread_tests.c index b51771c736..fe7f92b012 100644 --- a/erts/test/ethread_SUITE_data/ethread_tests.c +++ b/erts/test/ethread_SUITE_data/ethread_tests.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2011. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/test/ignore_cores.erl b/erts/test/ignore_cores.erl index 13f34cd10f..25dce346b9 100644 --- a/erts/test/ignore_cores.erl +++ b/erts/test/ignore_cores.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,7 +28,7 @@ -module(ignore_cores). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]). @@ -53,7 +53,7 @@ init(Config) -> fini(Config) -> #ignore_cores{org_cwd = OrgCWD, org_path = OrgPath, - org_pwd_env = OrgPWD} = ?config(ignore_cores, Config), + org_pwd_env = OrgPWD} = proplists:get_value(ignore_cores, Config), ok = file:set_cwd(OrgCWD), true = code:set_path(OrgPath), case OrgPWD of @@ -70,10 +70,10 @@ setup(Suite, Testcase, Config, SetCwd) when is_atom(Suite), is_list(Config) -> #ignore_cores{org_cwd = OrgCWD, org_path = OrgPath, - org_pwd_env = OrgPWD} = ?config(ignore_cores, Config), + org_pwd_env = OrgPWD} = proplists:get_value(ignore_cores, Config), Path = lists:map(fun (".") -> OrgCWD; (Dir) -> Dir end, OrgPath), true = code:set_path(Path), - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), IgnDir = filename:join([PrivDir, atom_to_list(Suite) ++ "_" @@ -94,7 +94,7 @@ setup(Suite, Testcase, Config, SetCwd) when is_atom(Suite), end, ok = file:write_file(filename:join([IgnDir, "ignore_core_files"]), <<>>), %% cores are dumped in /cores on MacOS X - CoresDir = case {?t:os_type(), filelib:is_dir("/cores")} of + CoresDir = case {os:type(), filelib:is_dir("/cores")} of {{unix,darwin}, true} -> filelib:fold_files("/cores", "^core.*$", @@ -119,7 +119,7 @@ restore(Config) -> org_path = OrgPath, org_pwd_env = OrgPWD, ign_dir = IgnDir, - cores_dir = CoresDir} = ?config(ignore_cores, Config), + cores_dir = CoresDir} = proplists:get_value(ignore_cores, Config), try case CoresDir of false -> @@ -155,5 +155,5 @@ restore(Config) -> dir(Config) -> - #ignore_cores{ign_dir = Dir} = ?config(ignore_cores, Config), + #ignore_cores{ign_dir = Dir} = proplists:get_value(ignore_cores, Config), Dir. diff --git a/erts/test/install_SUITE.erl b/erts/test/install_SUITE.erl index b380b064bd..2c7e8972f6 100644 --- a/erts/test/install_SUITE.erl +++ b/erts/test/install_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,11 +28,9 @@ %%%------------------------------------------------------------------- -module(install_SUITE). -%-define(line_trace, 1). - --export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, - init_per_suite/1, end_per_suite/1, - init_per_testcase/2, end_per_testcase/2]). +-export([all/0, suite/0, + init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2]). -export([bin_default/1, bin_default_dirty/1, @@ -49,10 +47,9 @@ bin_dirname_fail/1, bin_no_use_dirname_fail/1]). --define(DEFAULT_TIMEOUT, ?t:minutes(1)). -define(JOIN(A,B,C), filename:join(A, B, C)). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -record(inst, {mkdirs = true, symlinks = true, @@ -77,49 +74,42 @@ dont_need_symlink_cases() -> bin_unreasonable_path, 'bin white space', bin_no_srcfile]. -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> dont_need_symlink_cases() ++ need_symlink_cases(). -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - %% %% The test cases %% bin_default(Config) when is_list(Config) -> - ?line E = "/usr/local", - ?line Bs = "/usr/local/bin", - ?line Be = Bs, - ?line EBs = "/usr/local/lib/erlang/bin", - ?line EBe = EBs, - ?line RP = "../lib/erlang/bin", + E = "/usr/local", + Bs = "/usr/local/bin", + Be = Bs, + EBs = "/usr/local/lib/erlang/bin", + EBe = EBs, + RP = "../lib/erlang/bin", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "absolute"} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}}; + {ok,{absolute,B,join([TP,EP,EBe])}}; {true, _} -> - ?line {ok,{relative,B,RP}} + {ok,{relative,B,RP}} end, expect(Expct, Res) end, @@ -128,30 +118,30 @@ bin_default(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_default_dirty(Config) when is_list(Config) -> - ?line E = "/usr/./local/lib/..", - ?line Bs = "/usr/local//lib/../lib/erlang/../../bin", - ?line Be = "/usr/local/lib/../lib/erlang/../../bin", - ?line EBs = "/usr/local/lib/../lib/erlang/../erlang/bin/x/y/../..//", - ?line EBe = "/usr/local/lib/../lib/erlang/../erlang/bin/x/y/../..", - ?line RP = "../lib/erlang/bin", + E = "/usr/./local/lib/..", + Bs = "/usr/local//lib/../lib/erlang/../../bin", + Be = "/usr/local/lib/../lib/erlang/../../bin", + EBs = "/usr/local/lib/../lib/erlang/../erlang/bin/x/y/../..//", + EBe = "/usr/local/lib/../lib/erlang/../erlang/bin/x/y/../..", + RP = "../lib/erlang/bin", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "absolute"} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,EP,EBe])}}; {true, _} -> - ?line {ok,{relative,B,RP}} + {ok,{relative,B,RP}} end, expect(Expct, Res) end, @@ -161,29 +151,29 @@ bin_default_dirty(Config) when is_list(Config) -> bin_outside_eprfx(Config) when is_list(Config) -> - ?line E = "/usr/local", - ?line Bs = "/usr/bin", - ?line Be = Bs, - ?line EBs = "/usr/local/lib/erlang/bin", - ?line EBe = EBs, - ?line RP = "../local/lib/erlang/bin", + E = "/usr/local", + Bs = "/usr/bin", + Be = Bs, + EBs = "/usr/local/lib/erlang/bin", + EBe = EBs, + RP = "../local/lib/erlang/bin", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "relative"} -> - ?line {ok,{relative,B,RP}}; + {ok,{relative,B,RP}}; {true, _} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}} + {ok,{absolute,B,join([TP,EP,EBe])}} end, expect(Expct, Res) end, @@ -193,29 +183,29 @@ bin_outside_eprfx(Config) when is_list(Config) -> bin_outside_eprfx_dirty(Config) when is_list(Config) -> - ?line E = "/usr/local/lib/..", - ?line Bs = "/usr/local/lib/../../bin", - ?line Be = Bs, - ?line EBs = "/usr/local/lib/erlang/bin", - ?line EBe = EBs, - ?line RP = "../local/lib/erlang/bin", + E = "/usr/local/lib/..", + Bs = "/usr/local/lib/../../bin", + Be = Bs, + EBs = "/usr/local/lib/erlang/bin", + EBe = EBs, + RP = "../local/lib/erlang/bin", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "relative"} -> - ?line {ok,{relative,B,RP}}; + {ok,{relative,B,RP}}; {true, _} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}} + {ok,{absolute,B,join([TP,EP,EBe])}} end, expect(Expct, Res) end, @@ -224,33 +214,33 @@ bin_outside_eprfx_dirty(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_unreasonable_path(Config) when is_list(Config) -> - ?line E = "/usr/local/../../..", - ?line Bs = "/usr/local/../../../bin", - ?line Be = Bs, - ?line EBs = "/usr/local/../../../bin_unreasonable_path/usr/local/lib/erlang/bin", - ?line EBe = EBs, - ?line RP = "../bin_unreasonable_path/usr/local/lib/erlang/bin", + E = "/usr/local/../../..", + Bs = "/usr/local/../../../bin", + Be = Bs, + EBs = "/usr/local/../../../bin_unreasonable_path/usr/local/lib/erlang/bin", + EBe = EBs, + RP = "../bin_unreasonable_path/usr/local/lib/erlang/bin", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {TP, SL, BSL} of {_, false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {_, false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {"", true, "relative"} -> {error, unreasonable_path}; {"", true, _} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}}; + {ok,{absolute,B,join([TP,EP,EBe])}}; {_, true, "absolute"} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}}; + {ok,{absolute,B,join([TP,EP,EBe])}}; _ -> - ?line {ok,{relative,B,RP}} + {ok,{relative,B,RP}} end, expect(Expct, Res) end, @@ -259,7 +249,7 @@ bin_unreasonable_path(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_unreachable_absolute(Config) when is_list(Config) -> - TDir = ?config(test_dir, Config), + TDir = proplists:get_value(test_dir, Config), make_dirs(TDir, "/opt/local/lib/erlang/usr/bin"), make_dirs(TDir, "/opt/local/lib/erlang/bin"), Erl = join([TDir, "/opt/local/lib/erlang/bin/erl"]), @@ -270,28 +260,28 @@ bin_unreachable_absolute(Config) when is_list(Config) -> ok = file:write_file(Erlc, "erlc"), ok = file:make_symlink("../../../opt/local/lib/erlang/usr", join([TDir, "/usr/local/lib/erlang"])), - ?line E = "/usr/local", - ?line Bs = "/usr/local/bin", - ?line Be = Bs, - ?line EBs = "/usr/local/lib/erlang/../bin", - ?line EBe = EBs, + E = "/usr/local", + Bs = "/usr/local/bin", + Be = Bs, + EBs = "/usr/local/lib/erlang/../bin", + EBe = EBs, ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "relative"} -> {error, unreachable_absolute}; {true, _} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}} + {ok,{absolute,B,join([TP,EP,EBe])}} end, expect(Expct, Res) end, @@ -300,7 +290,7 @@ bin_unreachable_absolute(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_unreachable_relative(Config) when is_list(Config) -> - TDir = ?config(test_dir, Config), + TDir = proplists:get_value(test_dir, Config), make_dirs(TDir, "/opt/local/lib/erlang/bin"), make_dirs(TDir, "/opt/local/bin"), make_dirs(TDir, "/usr/local/lib/erlang/bin"), @@ -311,28 +301,28 @@ bin_unreachable_relative(Config) when is_list(Config) -> ok = file:make_symlink("../../opt/local/bin", join([TDir, "/usr/local/bin"])), - ?line E = "/usr/local", - ?line Bs = "/usr/local/bin", - ?line Be = Bs, - ?line EBs = "/usr/local/lib/erlang/bin", - ?line EBe = EBs, + E = "/usr/local", + Bs = "/usr/local/bin", + Be = Bs, + EBs = "/usr/local/lib/erlang/bin", + EBe = EBs, ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "relative"} -> {error, unreachable_relative}; {true, _} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}} + {ok,{absolute,B,join([TP,EP,EBe])}} end, expect(Expct, Res) end, @@ -341,7 +331,7 @@ bin_unreachable_relative(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_ok_symlink(Config) when is_list(Config) -> - TDir = ?config(test_dir, Config), + TDir = proplists:get_value(test_dir, Config), make_dirs(TDir, "/usr/local/bin"), make_dirs(TDir, "/opt/local/lib/erlang/bin"), Erl = join([TDir, "/opt/local/lib/erlang/bin/erl"]), @@ -350,29 +340,29 @@ bin_ok_symlink(Config) when is_list(Config) -> ok = file:write_file(Erlc, "erlc"), ok = file:make_symlink("../../opt/local/lib", join([TDir, "/usr/local/lib"])), - ?line E = "/usr/local", - ?line Bs = "/usr/local/bin", - ?line Be = Bs, - ?line EBs = "/usr/local/lib/erlang/bin", - ?line EBe = EBs, - ?line RP = "../lib/erlang/bin", + E = "/usr/local", + Bs = "/usr/local/bin", + Be = Bs, + EBs = "/usr/local/lib/erlang/bin", + EBe = EBs, + RP = "../lib/erlang/bin", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "absolute"} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}}; + {ok,{absolute,B,join([TP,EP,EBe])}}; {true, _} -> - ?line {ok,{relative,B,RP}} + {ok,{relative,B,RP}} end, expect(Expct, Res) end, @@ -381,7 +371,7 @@ bin_ok_symlink(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_same_dir(Config) when is_list(Config) -> - TDir = ?config(test_dir, Config), + TDir = proplists:get_value(test_dir, Config), make_dirs(TDir, "/usr/local/bin"), make_dirs(TDir, "/usr/local/lib"), ok = file:make_symlink("..", join([TDir, "/usr/local/lib/erlang"])), @@ -417,29 +407,29 @@ bin_not_abs(Config) when is_list(Config) -> 'bin white space'(Config) when is_list(Config) -> - ?line E = "/u s r/local", - ?line Bs = "/u s r/local/b i n", - ?line Be = Bs, - ?line EBs = "/u s r/local/lib/erl ang/bin", - ?line EBe = EBs, - ?line RP = "../lib/erl ang/bin", + E = "/u s r/local", + Bs = "/u s r/local/b i n", + Be = Bs, + EBs = "/u s r/local/lib/erl ang/bin", + EBe = EBs, + RP = "../lib/erl ang/bin", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "absolute"} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}}; + {ok,{absolute,B,join([TP,EP,EBe])}}; {true, _} -> - ?line {ok,{relative,B,RP}} + {ok,{relative,B,RP}} end, expect(Expct, Res) end, @@ -448,29 +438,29 @@ bin_not_abs(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_dirname_fail(Config) when is_list(Config) -> - ?line E = "/opt", - ?line Bs = "/opt/lib/../bin", - ?line Be = Bs, - ?line EBs = "/opt/lib/erlang/otp/bin", - ?line EBe = EBs, - ?line CMDPRFX = "PATH=\""++?config(data_dir,Config)++":"++os:getenv("PATH")++"\"", + E = "/opt", + Bs = "/opt/lib/../bin", + Be = Bs, + EBs = "/opt/lib/erlang/otp/bin", + EBe = EBs, + CMDPRFX = "PATH=\""++proplists:get_value(data_dir,Config)++":"++os:getenv("PATH")++"\"", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "relative"} -> - ?line {error, dirname_failed}; + {error, dirname_failed}; {true, _} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}} + {ok,{absolute,B,join([TP,EP,EBe])}} end, expect(Expct, Res) end, @@ -480,30 +470,30 @@ bin_dirname_fail(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_no_use_dirname_fail(Config) when is_list(Config) -> - ?line E = "/opt", - ?line Bs = "/opt/bin", - ?line Be = Bs, - ?line EBs = "/opt/lib/erlang/otp/bin", - ?line EBe = EBs, - ?line RP = "../lib/erlang/otp/bin", - ?line CMDPRFX = "PATH=\""++?config(data_dir,Config)++":"++os:getenv("PATH")++"\"", + E = "/opt", + Bs = "/opt/bin", + Be = Bs, + EBs = "/opt/lib/erlang/otp/bin", + EBe = EBs, + RP = "../lib/erlang/otp/bin", + CMDPRFX = "PATH=\""++proplists:get_value(data_dir,Config)++":"++os:getenv("PATH")++"\"", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "absolute"} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}}; + {ok,{absolute,B,join([TP,EP,EBe])}}; {true, _} -> - ?line {ok,{relative,B,RP}} + {ok,{relative,B,RP}} end, expect(Expct, Res) end, @@ -513,7 +503,7 @@ bin_no_use_dirname_fail(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_no_srcfile(Config) when is_list(Config) -> - TDir = ?config(test_dir, Config), + TDir = proplists:get_value(test_dir, Config), make_dirs(TDir, "/opt/local/bin"), make_dirs(TDir, "/opt/local/lib/erlang/bin"), Erl = join([TDir, "/opt/local/lib/erlang/bin/erl"]), @@ -525,13 +515,13 @@ bin_no_srcfile(Config) when is_list(Config) -> Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false,_} -> - ?line {error,{no_srcfile, Erlc}}; + {error,{no_srcfile, Erlc}}; {true, "absolute"} -> - ?line {error,{no_srcfile, Erlc}}; + {error,{no_srcfile, Erlc}}; {true, _} -> - ?line {error,{no_srcfile, RP_Erlc}} + {error,{no_srcfile, RP_Erlc}} end, expect(Expct, Res) end, @@ -549,34 +539,34 @@ bin_no_srcfile(Config) when is_list(Config) -> %% expect(X, X) -> - ?t:format("result: ~p~n", [X]), - ?t:format("-----------------------------------------------~n", []), + io:format("result: ~p~n", [X]), + io:format("-----------------------------------------------~n", []), ok; expect(X, Y) -> - ?t:format("expected: ~p~n", [X]), - ?t:format("got : ~p~n", [Y]), - ?t:format("-----------------------------------------------~n", []), - ?t:fail({X,Y}). + io:format("expected: ~p~n", [X]), + io:format("got : ~p~n", [Y]), + io:format("-----------------------------------------------~n", []), + ct:fail({X,Y}). init_per_suite(Config) -> - PD = ?config(priv_dir, Config), - SymLinks = case ?t:os_type() of - {win32, _} -> false; - _ -> - case file:make_symlink("nothing", - filename:join(PD, - "symlink_test")) of - ok -> true; - _ -> false - end - end, + PD = proplists:get_value(priv_dir, Config), + SymLinks = case os:type() of + {win32, _} -> false; + _ -> + case file:make_symlink("nothing", + filename:join(PD, "symlink_test")) of + ok -> true; + _ -> false + end + end, [{symlinks, SymLinks} | Config]. end_per_suite(_Config) -> ok. init_per_testcase(Case, Config) -> - init_per_testcase_aux(?config(symlinks,Config),?t:os_type(),Case,Config). + init_per_testcase_aux(proplists:get_value(symlinks,Config), + os:type(),Case,Config). init_per_testcase_aux(_, {win32, _}, _Case, _Config) -> {skip, "Not on windows"}; @@ -586,18 +576,13 @@ init_per_testcase_aux(false, OsType, Case, Config) -> true -> {skip, "Cannot create symbolic links"} end; init_per_testcase_aux(true, _OsType, Case, Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, Dog}, - {testcase, Case}, - {test_dir, make_dirs(?config(priv_dir, Config), atom_to_list(Case))} + [{testcase, Case}, + {test_dir, make_dirs(proplists:get_value(priv_dir, Config), atom_to_list(Case))} | Config]. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. - make_dirs(Root, Suffix) -> do_make_dirs(Root, string:tokens(Suffix, [$/])). @@ -616,9 +601,9 @@ install_bin(Config, #inst{mkdirs = MkDirs, exec_prefix = EXEC_PREFIX, bindir = BINDIR, erlang_bindir = ERLANG_BINDIR} = Inst, ChkRes) -> - PDir = ?config(priv_dir, Config), - TDir = ?config(test_dir, Config), - TD = atom_to_list(?config(testcase, Config)), + PDir = proplists:get_value(priv_dir, Config), + TDir = proplists:get_value(test_dir, Config), + TD = atom_to_list(proplists:get_value(testcase, Config)), case MkDirs of false -> ok; true -> @@ -641,7 +626,7 @@ install_bin(Config, #inst{mkdirs = MkDirs, bindir = join([TDir, BINDIR]), erlang_bindir = join([TDir, ERLANG_BINDIR])}, ChkRes), - case ?config(symlinks, Config) of + case proplists:get_value(symlinks, Config) of true -> ok; false -> {comment, "No symlink tests run, since symlinks not working"} end. @@ -664,7 +649,7 @@ install_bin2(Config, Inst, ChkRes) -> install_bin3(Config, Inst#inst{symlinks = false, ln_s = "cp -p", bindir_symlinks = "absolute"}, ChkRes), - case ?config(symlinks, Config) of + case proplists:get_value(symlinks, Config) of true -> install_bin3(Config, Inst#inst{symlinks = true, ln_s = "ln -s"}, ChkRes), @@ -690,9 +675,9 @@ install_bin3(Config, erlang_bindir = ERLANG_BINDIR, bindir_symlinks = BINDIR_SYMLINKS} = Inst, ChkRes) -> - Test = ?config(testcase, Config), - DDir = ?config(data_dir, Config), - TDir = ?config(test_dir, Config), + Test = proplists:get_value(testcase, Config), + DDir = proplists:get_value(data_dir, Config), + TDir = proplists:get_value(test_dir, Config), InstallBin = filename:join(DDir, "install_bin"), ResFile = filename:join(TDir, atom_to_list(Test) ++ "-result.txt"), Cmd = CMD_PRFX ++ " " @@ -705,7 +690,7 @@ install_bin3(Config, ++ "\" --exec-prefix \"" ++ EXEC_PREFIX ++ "\" --test-file \"" ++ ResFile ++ "\" erl erlc", - ?t:format("CMD_PRFX = \"~s\"~n" + io:format("CMD_PRFX = \"~s\"~n" "LN_S = \"~s\"~n" "BINDIR_SYMLINKS = \"~s\"~n" "exec_prefix = \"~s\"~n" @@ -716,9 +701,9 @@ install_bin3(Config, [CMD_PRFX, LN_S, BINDIR_SYMLINKS, EXEC_PREFIX, BINDIR, ERLANG_BINDIR, EXTRA_PREFIX, DESTDIR]), - ?t:format("$ ~s~n", [Cmd]), + io:format("$ ~s~n", [Cmd]), CmdOutput = os:cmd(Cmd), - ?t:format("~s~n", [CmdOutput]), + io:format("~s~n", [CmdOutput]), ChkRes(case file:consult(ResFile) of {ok, [Res]} -> Res; Err -> exit({result, Err}) @@ -731,4 +716,3 @@ join([""|Ds]) -> join(Ds); join([D|Ds]) -> "/" ++ string:strip(D, both, $/) ++ join(Ds). - diff --git a/erts/test/nt_SUITE.erl b/erts/test/nt_SUITE.erl index dbae8df7fe..624e5484ba 100644 --- a/erts/test/nt_SUITE.erl +++ b/erts/test/nt_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,58 +20,39 @@ %%% Purpose: Test NT specific utilities -module(nt_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.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,init_per_testcase/2, - end_per_testcase/2,nt/1,handle_eventlog/2, - middleman/1,service_basic/1, service_env/1, user_env/1, synced/1, - service_prio/1, - logout/1, debug/1, restart/1, restart_always/1,stopaction/1, - shutdown_io/0,do_shutdown_io/0]). --define(TEST_TIMEOUT, ?t:seconds(180)). +-export([all/0, suite/0, + init_per_testcase/2, end_per_testcase/2, + nt/1,handle_eventlog/2, + middleman/1,service_basic/1, service_env/1, user_env/1, synced/1, + service_prio/1, + logout/1, debug/1, restart/1, restart_always/1,stopaction/1, + shutdown_io/0,do_shutdown_io/0]). -define(TEST_SERVICES, [1,2,3,4,5,6,7,8,9,10,11]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. -all() -> - case os:type() of - {win32, nt} -> +all() -> + case {os:type(), os:version()} of + {{win32, nt}, Vsn} when Vsn =< {6,1,999999} -> [nt, service_basic, service_env, user_env, synced, service_prio, logout, debug, restart, restart_always, stopaction]; _ -> [nt] end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - init_per_testcase(_Func, Config) -> - Dog = test_server:timetrap(?TEST_TIMEOUT), - [{watchdog, Dog} | Config]. + Config. -end_per_testcase(_Func, Config) -> +end_per_testcase(_Func, _Config) -> lists:foreach(fun(X) -> - catch remove_service("test_service_" ++ - integer_to_list(X)) end, - ?TEST_SERVICES), - Dog = ?config(watchdog, Config), - catch test_server:timetrap_cancel(Dog), + catch remove_service("test_service_" ++ integer_to_list(X)) + end, ?TEST_SERVICES), ok. erlsrv() -> @@ -80,19 +61,18 @@ erlsrv() -> recv_prog_output(Port) -> receive - {Port, {data, {eol,Data}}} -> - %%io:format("Got data: ~s~n", [Data]), - [ Data | recv_prog_output(Port)]; - _X -> - %%io:format("Got data: ~p~n", [_X]), - Port ! {self(), close}, - receive - _ -> - [] - end + {Port, {data, {eol,Data}}} -> + %%io:format("Got data: ~s~n", [Data]), + [ Data | recv_prog_output(Port)]; + _X -> + %%io:format("Got data: ~p~n", [_X]), + Port ! {self(), close}, + receive + _ -> + [] + end end. - %%% X == parameters to erlsrv %%% returns command output without stderr do_command(X) -> @@ -100,11 +80,11 @@ do_command(X) -> Port = open_port({spawn, erlsrv() ++ " " ++ X}, [stream, {line, 100}, eof, in]), Res = recv_prog_output(Port), case Res of - [] -> - failed; - _Y -> - %%io:format("~p~n",[_Y]), - ok + [] -> + failed; + _Y -> + %%io:format("~p~n",[_Y]), + ok end. @@ -123,13 +103,13 @@ do_wait_for_it(_,0) -> false; do_wait_for_it(FullName,N) -> case net_adm:ping(FullName) of - pong -> - true; - _ -> - receive - after 1000 -> - do_wait_for_it(FullName,N-1) - end + pong -> + true; + _ -> + receive + after 1000 -> + do_wait_for_it(FullName,N-1) + end end. wait_for_node(Name) -> @@ -139,309 +119,282 @@ wait_for_node(Name) -> make_full_name(Name) -> [_,Suffix] = string:tokens(atom_to_list(node()),"@"), list_to_atom(Name ++ "@" ++ Suffix). - + %%% The following tests are only run on NT: -service_basic(doc) -> - ["Check some basic (cosmetic) service parameters"]; -service_basic(suite) -> []; +%% Check some basic (cosmetic) service parameters service_basic(Config) when is_list(Config) -> - ?line Name = "test_service_20", - ?line IntName = Name++"_internal", - ?line Service = [{servicename,Name}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}, - {internalservicename,IntName}, - {comment,"Epic comment"}], - ?line ok = erlsrv:store_service(Service), - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line S2 = erlsrv:get_service(Name), - ?line {value,{comment,"Epic comment"}} = lists:keysearch(comment,1,S2), - ?line {value,{internalservicename,IntName}} = - lists:keysearch(internalservicename,1,S2), - ?line S3 = lists:keyreplace(comment,1,S2,{comment,"Basic comment"}), - ?line S4 = lists:keyreplace(internalservicename,1,S3, - {internalservicename,"WillNotHappen"}), - ?line ok = erlsrv:store_service(S4), - ?line S5 = erlsrv:get_service(Name), - ?line {value,{comment,"Basic comment"}} = lists:keysearch(comment,1,S5), - ?line {value,{internalservicename,IntName}} = - lists:keysearch(internalservicename,1,S5), - ?line NewName = "test_service_21", - ?line S6 = erlsrv:new_service(NewName,S5,[]), % should remove - % internalservicename - ?line ok = erlsrv:store_service(S6), - ?line S7 = erlsrv:get_service(NewName), - ?line {value,{comment,"Basic comment"}} = lists:keysearch(comment,1,S7), - ?line {value,{internalservicename,[$t,$e,$s,$t | _]}} = - lists:keysearch(internalservicename,1,S7), - ?line remove_service(Name), - ?line remove_service(NewName), + Name = "test_service_20", + IntName = Name++"_internal", + Service = [{servicename,Name}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}, + {internalservicename,IntName}, + {comment,"Epic comment"}], + ok = erlsrv:store_service(Service), + start_service(Name), + true = wait_for_node(Name), + S2 = erlsrv:get_service(Name), + {value,{comment,"Epic comment"}} = lists:keysearch(comment,1,S2), + {value,{internalservicename,IntName}} = + lists:keysearch(internalservicename,1,S2), + S3 = lists:keyreplace(comment,1,S2,{comment,"Basic comment"}), + S4 = lists:keyreplace(internalservicename,1,S3, + {internalservicename,"WillNotHappen"}), + ok = erlsrv:store_service(S4), + S5 = erlsrv:get_service(Name), + {value,{comment,"Basic comment"}} = lists:keysearch(comment,1,S5), + {value,{internalservicename,IntName}} = + lists:keysearch(internalservicename,1,S5), + NewName = "test_service_21", + S6 = erlsrv:new_service(NewName,S5,[]), % should remove + % internalservicename + ok = erlsrv:store_service(S6), + S7 = erlsrv:get_service(NewName), + {value,{comment,"Basic comment"}} = lists:keysearch(comment,1,S7), + {value,{internalservicename,[$t,$e,$s,$t | _]}} = + lists:keysearch(internalservicename,1,S7), + remove_service(Name), + remove_service(NewName), ok. -service_env(doc) -> - ["Check that service name and executable is in the environment of the " ++ - "erlang process created by erlsrv."]; -service_env(suite) -> []; +%% Check that service name and executable is in the environment of the +%% erlang process created by erlsrv. service_env(Config) when is_list(Config) -> - ?line Name = "test_service_2", - ?line Service = [{servicename,Name}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}], - ?line ok = erlsrv:store_service(Service), - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line Name = rpc:call(make_full_name(Name),os,getenv, - ["ERLSRV_SERVICE_NAME"]), - ?line "erlsrv.exe" = filename:basename( - hd( - string:tokens( - rpc:call(make_full_name(Name), - os, - getenv, - ["ERLSRV_EXECUTABLE"]), - "\""))), - ?line remove_service(Name), + Name = "test_service_2", + Service = [{servicename,Name}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}], + ok = erlsrv:store_service(Service), + start_service(Name), + true = wait_for_node(Name), + Name = rpc:call(make_full_name(Name),os,getenv, + ["ERLSRV_SERVICE_NAME"]), + "erlsrv.exe" = filename:basename( + hd( + string:tokens( + rpc:call(make_full_name(Name), + os, + getenv, + ["ERLSRV_EXECUTABLE"]), + "\""))), + remove_service(Name), ok. -user_env(doc) -> - ["Check that the user defined environment is ADDED to the service's"++ - " normal dito."]; -user_env(suite) -> []; + +%% Check that the user defined environment is ADDED to the service's +%% normal dito. user_env(Config) when is_list(Config) -> - ?line Name = "test_service_3", - ?line Service = [{servicename,Name},{env,[{"HUBBA","BUBBA"}]}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}], - ?line ok = erlsrv:store_service(Service), - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line true = rpc:call(make_full_name(Name),os,getenv, - ["SystemDrive"]) =/= false, - ?line "BUBBA" = rpc:call(make_full_name(Name),os,getenv,["HUBBA"]), - ?line remove_service(Name), + Name = "test_service_3", + Service = [{servicename,Name},{env,[{"HUBBA","BUBBA"}]}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}], + ok = erlsrv:store_service(Service), + start_service(Name), + true = wait_for_node(Name), + true = rpc:call(make_full_name(Name),os,getenv, + ["SystemDrive"]) =/= false, + "BUBBA" = rpc:call(make_full_name(Name),os,getenv,["HUBBA"]), + remove_service(Name), ok. -synced(doc) -> - ["Check that services are stopped and started syncronous and that"++ - " failed stopactions kill the erlang machine anyway."]; -synced(suite) -> []; + +%% Check that services are stopped and started syncronous and that +%% failed stopactions kill the erlang machine anyway. synced(Config) when is_list(Config) -> - ?line Name0 = "test_service_4", - ?line Service0 = [{servicename,Name0}, - {machine, "N:\\nickeNyfikenPaSjukhus"}], - ?line ok = erlsrv:store_service(Service0), - ?line true = (catch start_service(Name0)) =/= ok, - ?line remove_service(Name0), - ?line Name = "test_service_5", - ?line Service = [{servicename,Name}, - {stopaction,"erlang:info(garbage_collection)."}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}], - ?line ok = erlsrv:store_service(Service), - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line T1 = calendar:datetime_to_gregorian_seconds( - calendar:universal_time()), - ?line stop_service(Name), - ?line Diff1 = calendar:datetime_to_gregorian_seconds( - calendar:universal_time()) - T1, - ?line true = Diff1 > 30, - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line T2 = calendar:datetime_to_gregorian_seconds( - calendar:universal_time()), - ?line remove_service(Name), - ?line Diff2 = calendar:datetime_to_gregorian_seconds( - calendar:universal_time()) - T2, - ?line true = Diff2 > 30, + Name0 = "test_service_4", + Service0 = [{servicename,Name0}, + {machine, "N:\\nickeNyfikenPaSjukhus"}], + ok = erlsrv:store_service(Service0), + true = (catch start_service(Name0)) =/= ok, + remove_service(Name0), + Name = "test_service_5", + Service = [{servicename,Name}, + {stopaction,"erlang:info(garbage_collection)."}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}], + ok = erlsrv:store_service(Service), + start_service(Name), + true = wait_for_node(Name), + T1 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()), + stop_service(Name), + Diff1 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()) - T1, + true = Diff1 > 30, + start_service(Name), + true = wait_for_node(Name), + T2 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()), + remove_service(Name), + Diff2 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()) - T2, + true = Diff2 > 30, ok. -service_prio(doc) -> - ["Check that a service with higher prio create port programs with " - "higher prio."]; -service_prio(suite) -> []; + +%% Check that a service with higher prio create port programs with +%% higher prio. service_prio(Config) when is_list(Config) -> - ?line Name = "test_service_6", - ?line Service = [{servicename,Name},{prio,"high"}, - {env, [{"HEART_COMMAND","echo off"}]}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie()), - "-heart"]}], - ?line ok = erlsrv:store_service(Service), - ?line {ok, OldProcs} = get_current_procs(Config), - ?line start_service(Name), - ?line {ok, NewProcs} = get_current_procs(Config), + Name = "test_service_6", + Service = [{servicename,Name},{prio,"high"}, + {env, [{"HEART_COMMAND","echo off"}]}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie()), + "-heart"]}], + ok = erlsrv:store_service(Service), + {ok, OldProcs} = get_current_procs(Config), + start_service(Name), + {ok, NewProcs} = get_current_procs(Config), timer:sleep(2000), - ?line {ok, NewProcs2} = get_current_procs(Config), - ?line remove_service(Name), - ?line Diff = arrived_procs(OldProcs,NewProcs), + {ok, NewProcs2} = get_current_procs(Config), + remove_service(Name), + Diff = arrived_procs(OldProcs,NewProcs), io:format("NewProcs ~p~n after sleep~n ~p~n",[Diff, arrived_procs(OldProcs,NewProcs2)]), %% Not really correct, could fail if another heart is %% started at the same time... - ?line {value, {"heart.exe",_,"high"}} = - lists:keysearch("heart.exe",1,Diff), + {value, {"heart.exe",_,"high"}} = lists:keysearch("heart.exe",1,Diff), ok. -logout(doc) -> - ["Check that logout does not kill services"]; -logout(suite) -> []; + +%% Check that logout does not kill services logout(Config) when is_list(Config) -> - ?line {comment, "Have to be run manually by registering a service with " ++ - "heart, logout and log in again and then examine that the heart " ++ - "process id is not changed."}. -debug(doc) -> - ["Check the debug options to erlsrv."]; -debug(suite) -> []; + {comment, "Have to be run manually by registering a service with " ++ + "heart, logout and log in again and then examine that the heart " ++ + "process id is not changed."}. + +%% Check the debug options to erlsrv. debug(Config) when is_list(Config) -> - ?line Name0 = "test_service_7", + Name0 = "test_service_7", %% We used to set the privdir as temporary directory, but for some %% reason we don't seem to have write access to that directory, %% so we'll use the directory specified in the next line. - ?line TempDir = "C:/TEMP", - ?line Service0 = [{servicename,Name0}, - {workdir,filename:nativename(TempDir)}, - {debugtype,"reuse"}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}], - ?line ok = erlsrv:store_service(Service0), - ?line T1 = calendar:datetime_to_gregorian_seconds( - calendar:local_time()), + TempDir = "C:/TEMP", + Service0 = [{servicename,Name0}, + {workdir,filename:nativename(TempDir)}, + {debugtype,"reuse"}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}], + ok = erlsrv:store_service(Service0), + T1 = calendar:datetime_to_gregorian_seconds( + calendar:local_time()), %% sleep a little - ?line receive after 2000 -> ok end, - ?line start_service(Name0), - ?line true = wait_for_node(Name0), - ?line LF = filename:join(TempDir, Name0++".debug"), - ?line {ok,Info0} = file:read_file_info(LF), - ?line T2 = calendar:datetime_to_gregorian_seconds( - Info0#file_info.mtime), - ?line true = T2 > T1, - ?line remove_service(Name0), - ?line file:delete(LF), - ?line Name1 = "test_service_8", - ?line Service1 = [{servicename,Name1}, - {workdir, filename:nativename(TempDir)}, - {debugtype,"new"}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}], - ?line ok = erlsrv:store_service(Service1), - ?line T3 = calendar:datetime_to_gregorian_seconds( - calendar:local_time()), + receive after 2000 -> ok end, + start_service(Name0), + true = wait_for_node(Name0), + LF = filename:join(TempDir, Name0++".debug"), + {ok,Info0} = file:read_file_info(LF), + T2 = calendar:datetime_to_gregorian_seconds( + Info0#file_info.mtime), + true = T2 > T1, + remove_service(Name0), + file:delete(LF), + Name1 = "test_service_8", + Service1 = [{servicename,Name1}, + {workdir, filename:nativename(TempDir)}, + {debugtype,"new"}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}], + ok = erlsrv:store_service(Service1), + T3 = calendar:datetime_to_gregorian_seconds( + calendar:local_time()), %% sleep a little - ?line receive after 2000 -> ok end, - ?line NF = next_logfile(TempDir, Name1), - ?line start_service(Name1), - ?line true = wait_for_node(Name1), - ?line {ok,Info1} = file:read_file_info(NF), - ?line T4 = calendar:datetime_to_gregorian_seconds( - Info1#file_info.mtime), - ?line true = T4 > T3, - ?line remove_service(Name1), - ?line file:delete(NF), + receive after 2000 -> ok end, + NF = next_logfile(TempDir, Name1), + start_service(Name1), + true = wait_for_node(Name1), + {ok,Info1} = file:read_file_info(NF), + T4 = calendar:datetime_to_gregorian_seconds( + Info1#file_info.mtime), + true = T4 > T3, + remove_service(Name1), + file:delete(NF), ok. -restart(doc) -> - ["Check the restart options to erlsrv"]; -restart(suite) -> []; +%% Check the restart options to erlsrv restart(Config) when is_list(Config) -> - ?line Name = "test_service_9", - ?line Service = [{servicename,Name}, - {workdir, filename:nativename(logdir(Config))}, - {onfail,"restart"}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}], - ?line ok = erlsrv:store_service(Service), - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line receive after 20000 -> ok end, - ?line rpc:call(make_full_name(Name),erlang,halt,[]), - ?line receive after 1000 -> ok end, - ?line true = wait_for_node(Name), - ?line rpc:call(make_full_name(Name),erlang,halt,[]), - ?line receive after 1000 -> ok end, - ?line false = wait_for_node(Name), - ?line remove_service(Name), + Name = "test_service_9", + Service = [{servicename,Name}, + {workdir, filename:nativename(logdir(Config))}, + {onfail,"restart"}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}], + ok = erlsrv:store_service(Service), + start_service(Name), + true = wait_for_node(Name), + receive after 20000 -> ok end, + rpc:call(make_full_name(Name),erlang,halt,[]), + receive after 1000 -> ok end, + true = wait_for_node(Name), + rpc:call(make_full_name(Name),erlang,halt,[]), + receive after 1000 -> ok end, + false = wait_for_node(Name), + remove_service(Name), ok. -restart_always(doc) -> - ["Check the restart options to erlsrv"]; -restart_always(suite) -> []; +%% Check the restart options to erlsrv restart_always(Config) when is_list(Config) -> - ?line Name = "test_service_10", - ?line Service = [{servicename,Name}, - {workdir, filename:nativename(logdir(Config))}, - {onfail,"restart_always"}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}], - ?line ok = erlsrv:store_service(Service), - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line rpc:call(make_full_name(Name),erlang,halt,[]), - ?line receive after 1000 -> ok end, - ?line true = wait_for_node(Name), - ?line rpc:call(make_full_name(Name),erlang,halt,[]), - ?line receive after 1000 -> ok end, - ?line true = wait_for_node(Name), - ?line remove_service(Name), + Name = "test_service_10", + Service = [{servicename,Name}, + {workdir, filename:nativename(logdir(Config))}, + {onfail,"restart_always"}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}], + ok = erlsrv:store_service(Service), + start_service(Name), + true = wait_for_node(Name), + rpc:call(make_full_name(Name),erlang,halt,[]), + receive after 1000 -> ok end, + true = wait_for_node(Name), + rpc:call(make_full_name(Name),erlang,halt,[]), + receive after 1000 -> ok end, + true = wait_for_node(Name), + remove_service(Name), ok. -stopaction(doc) -> - ["Check that stopaction does not hang output while shutting down"]; -stopaction(suite) -> []; + +%% Check that stopaction does not hang output while shutting down stopaction(Config) when is_list(Config) -> - ?line Name = "test_service_11", + Name = "test_service_11", %% Icky, I prepend the first element in the codepath, cause %% I "suppose" it's the one to where I am. - ?line Service = [{servicename,Name}, - {stopaction,atom_to_list(?MODULE) ++ ":shutdown_io()."}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie()), - "-pa", hd(code:get_path())]}], - ?line ok = erlsrv:store_service(Service), - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line T1 = calendar:datetime_to_gregorian_seconds( - calendar:universal_time()), - ?line stop_service(Name), - ?line Diff1 = calendar:datetime_to_gregorian_seconds( - calendar:universal_time()) - T1, - ?line true = Diff1 < 30, - ?line remove_service(Name), + Service = [{servicename,Name}, + {stopaction,atom_to_list(?MODULE) ++ ":shutdown_io()."}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie()), + "-pa", hd(code:get_path())]}], + ok = erlsrv:store_service(Service), + start_service(Name), + true = wait_for_node(Name), + T1 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()), + stop_service(Name), + Diff1 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()) - T1, + true = Diff1 < 30, + remove_service(Name), ok. %%% This test is run on all platforms, but just gives a comment on %%% other platforms than NT. -nt(doc) -> - ["Run NT specific tests."]; -nt(suite) -> - []; nt(Config) when is_list(Config) -> - case os:type() of - {win32,nt} -> + case {os:type(), os:version()} of + {{win32, nt}, Vsn} when Vsn =< {6,1,999999} -> nt_run(); + {{win32, nt}, _} -> + {skipped, "This test case requires admin privileges on Win 8 and later."}; _ -> {skipped, "This test case is intended for Win NT only."} end. nt_run() -> - ?line start_all(), - ?line create_service("test_service_1"), - ?line R = start_look_for_single("System","ErlSrv","Informational", - ".*test_service_1.*started.*"), - ?line start_service("test_service_1"), - ?line Res = look_for_single(R), - ?line io:format("Result from eventlog: ~p~n", - [Res]), - ?line remove_service("test_service_1"), - ?line stop_all(), + start_all(), + create_service("test_service_1"), + R = start_look_for_single("System","ErlSrv","Informational", + ".*test_service_1.*started.*"), + start_service("test_service_1"), + Res = look_for_single(R), + io:format("Result from eventlog: ~p~n", + [Res]), + remove_service("test_service_1"), + stop_all(), ok. start_all() -> Pid1 = spawn_link(?MODULE,middleman,[[]]), register(?MODULE,Pid1), _Pid2 = nteventlog:start("log_testing", - {?MODULE,handle_eventlog,[Pid1]}). + {?MODULE,handle_eventlog,[Pid1]}). stop_all() -> ?MODULE ! stop, @@ -454,10 +407,10 @@ start_look_for_single(Cat,Fac,Sev,MessRE) -> look_for_single(Ref) -> receive - {Ref,Time,Mes} -> - {Time,Mes} + {Ref,Time,Mes} -> + {Time,Mes} after 60000 -> - timeout + timeout end. @@ -468,25 +421,25 @@ handle_eventlog(Mes,Pid) -> %%% Waitfor = [{Pid, Ref, {Category,Facility,Severity,MessageRE}} ...] middleman(Waitfor) -> receive - {Time,Category,Facility,Severity,Message} -> - io:format("Middleman got ~s...", [Message]), - case match_event({Time,Category,Facility,Severity,Message}, - Waitfor) of - {ok, {Pid,Ref,Time,Mes}, Rest} -> - io:format("matched~n"), - Pid ! {Ref,Time,Mes}, - middleman(Rest); - _ -> - io:format("no match~n"), - middleman(Waitfor) - end; - {lookfor, X} -> - io:format("Middleman told to look for ~p~n", [X]), - middleman([X|Waitfor]); - stop -> - stopped; - _ -> - middleman(Waitfor) + {Time,Category,Facility,Severity,Message} -> + io:format("Middleman got ~s...", [Message]), + case match_event({Time,Category,Facility,Severity,Message}, + Waitfor) of + {ok, {Pid,Ref,Time,Mes}, Rest} -> + io:format("matched~n"), + Pid ! {Ref,Time,Mes}, + middleman(Rest); + _ -> + io:format("no match~n"), + middleman(Waitfor) + end; + {lookfor, X} -> + io:format("Middleman told to look for ~p~n", [X]), + middleman([X|Waitfor]); + stop -> + stopped; + _ -> + middleman(Waitfor) end. @@ -495,81 +448,81 @@ match_event(_X, []) -> nomatch; match_event({Time,Cat,Fac,Sev,Mes},[{Pid,Ref,{Cat,Fac,Sev,MesRE}} | Tail]) -> case re:run(Mes,MesRE,[{capture,none}]) of - match -> - %%io:format("Match!~n"), - {ok,{Pid,Ref,Time,Mes},Tail}; - nomatch -> - %%io:format("No match~n"), - case match_event({Time,Cat,Fac,Sev,Mes},Tail) of - {ok,X,Rest} -> - {ok,X,[{Pid,Ref,{Cat,Fac,Sev,MesRE}} | Rest]}; - X -> - X - end + match -> + %%io:format("Match!~n"), + {ok,{Pid,Ref,Time,Mes},Tail}; + nomatch -> + %%io:format("No match~n"), + case match_event({Time,Cat,Fac,Sev,Mes},Tail) of + {ok,X,Rest} -> + {ok,X,[{Pid,Ref,{Cat,Fac,Sev,MesRE}} | Rest]}; + X -> + X + end end; match_event(X,[Y | T]) -> %%io:format("X == ~p, Y == ~p~n",[X,Y]), case match_event(X,T) of - {ok,Z,R} -> - {ok,Z,[Y|R]}; - XX -> - XX + {ok,Z,R} -> + {ok,Z,[Y|R]}; + XX -> + XX end. arrived_procs(_,[]) -> []; arrived_procs(OldProcs,[{Executable, Pid, Priority} | TNewProcs]) -> case lists:keysearch(Pid,2,OldProcs) of - {value, _} -> - arrived_procs(OldProcs, TNewProcs); - false -> - [{Executable, Pid, Priority} | arrived_procs(OldProcs, TNewProcs)] + {value, _} -> + arrived_procs(OldProcs, TNewProcs); + false -> + [{Executable, Pid, Priority} | arrived_procs(OldProcs, TNewProcs)] end. - + get_current_procs(Config) -> - ?line P = open_port({spawn,nt_info(Config) ++ " -E"}, - [{line,10000}]), - ?line L = receive - {P,{data,{eol,D}}} -> - D; - _ -> "error. " - end, - ?line P ! {self(), close}, - ?line receive - {P, closed} -> ok - end, - ?line {done,{ok,Tok,_},_} = erl_scan:tokens([],L,0), - ?line erl_parse:parse_term(Tok). + P = open_port({spawn,nt_info(Config) ++ " -E"}, + [{line,10000}]), + L = receive + {P,{data,{eol,D}}} -> + D; + _ -> "error. " + end, + P ! {self(), close}, + receive + {P, closed} -> ok + end, + {done,{ok,Tok,_},_} = erl_scan:tokens([],L,0), + erl_parse:parse_term(Tok). nt_info(Config) when is_list(Config) -> - ?line "\"" ++ filename:join(?config(data_dir, Config), "nt_info") ++ "\"". + "\"" ++ filename:join(proplists:get_value(data_dir, Config), "nt_info") ++ "\"". logdir(Config) -> - ?line ?config(priv_dir, Config). + proplists:get_value(priv_dir, Config). look_for_next(Template,L,N) -> - ?line FN = Template ++ integer_to_list(N), - ?line case lists:member(FN,L) of - true -> - ?line look_for_next(Template,L,N+1); - false -> - ?line FN + FN = Template ++ integer_to_list(N), + case lists:member(FN,L) of + true -> + look_for_next(Template,L,N+1); + false -> + FN end. next_logfile(LD, Servicename) -> - ?line {ok, Files} = file:list_dir(LD), - ?line Ftmpl = Servicename ++ ".debug.", - ?line filename:join(LD,look_for_next(Ftmpl,Files,1)). + {ok, Files} = file:list_dir(LD), + Ftmpl = Servicename ++ ".debug.", + filename:join(LD,look_for_next(Ftmpl,Files,1)). %%% Functions run by the service do_shutdown_io() -> receive after 2000 -> - io:format("IO in shutting down...~n"), - erlang:halt() + io:format("IO in shutting down...~n"), + erlang:halt() end. shutdown_io() -> diff --git a/erts/test/nt_SUITE_data/Makefile.src b/erts/test/nt_SUITE_data/Makefile.src index 26da26b195..2317828337 100644 --- a/erts/test/nt_SUITE_data/Makefile.src +++ b/erts/test/nt_SUITE_data/Makefile.src @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# Copyright Ericsson AB 1998-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/test/nt_SUITE_data/nt_info.c b/erts/test/nt_SUITE_data/nt_info.c index 41d9a44c18..8ef52cad2d 100644 --- a/erts/test/nt_SUITE_data/nt_info.c +++ b/erts/test/nt_SUITE_data/nt_info.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * Copyright Ericsson AB 1998-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl index 69a0d19719..54fcfd935f 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2015. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,18 +20,20 @@ -module(otp_SUITE). --export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, - init_per_suite/1,end_per_suite/1]). +-export([all/0, suite/0, + 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, + obsolete_but_not_deprecated/1,call_to_deprecated/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]). + erl_file_encoding/1,xml_file_encoding/1,runtime_dependencies/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -import(lists, [filter/2,foldl/3,foreach/2]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 10}}]. all() -> [undefined_functions, deprecated_not_in_obsolete, @@ -40,54 +42,41 @@ all() -> erl_file_encoding, xml_file_encoding, runtime_dependencies]. -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - init_per_suite(Config) -> - Dog = test_server:timetrap(?t:minutes(10)), Root = code:root_dir(), Server = daily_xref, - ?line xref:start(Server), - ?line xref:set_default(Server, [{verbose,false}, - {warnings,false}, - {builtins,true}]), - ?line {ok,_Relname} = xref:add_release(Server, Root, {name,otp}), + xref:start(Server), + xref:set_default(Server, [{verbose,false}, + {warnings,false}, + {builtins,true}]), + {ok,_Relname} = xref:add_release(Server, Root, {name,otp}), %% If we are running the tests in the source tree, the ERTS application %% is not in the code path. We must add it explicitly. case code:lib_dir(erts) of - {error,bad_name} -> - Erts = filename:join([code:root_dir(),"erts","preloaded","ebin"]), - ?line {ok,_} = xref:add_directory(Server, Erts, []); - _ -> - ok + {error,bad_name} -> + Erts = filename:join([code:root_dir(),"erts","preloaded","ebin"]), + {ok,_} = xref:add_directory(Server, Erts, []); + _ -> + ok end, - - ?line ?t:timetrap_cancel(Dog), [{xref_server,Server}|Config]. end_per_suite(Config) -> - Server = ?config(xref_server, Config), + Server = proplists:get_value(xref_server, Config), catch xref:stop(Server), Config. undefined_functions(Config) when is_list(Config) -> - Server = ?config(xref_server, Config), + Server = proplists:get_value(xref_server, Config), %% Exclude calls from generated modules in the SSL application. ExcludeFrom = "SSL-PKIX|PKIX.*|ssl_pkix_oid", - ?line UndefS = xref_base:analysis(undefined_function_calls), - ?line Q = io_lib:format("Undef = ~s," - "ExcludedFrom = ~p:_/_," - "Undef - Undef | ExcludedFrom", - [UndefS,ExcludeFrom]), + UndefS = xref_base:analysis(undefined_function_calls), + Q = io_lib:format("Undef = ~s," + "ExcludedFrom = ~p:_/_," + "Undef - Undef | ExcludedFrom", + [UndefS,ExcludeFrom]), {ok,Undef0} = xref:q(Server, lists:flatten(Q)), Undef1 = hipe_filter(Undef0), Undef2 = ssl_crypto_filter(Undef1), @@ -99,124 +88,124 @@ undefined_functions(Config) when is_list(Config) -> Undef = diameter_filter(Undef7), case Undef of - [] -> ok; - _ -> - Fd = open_log(Config, "undefined_functions"), - foreach(fun ({MFA1,MFA2}) -> - io:format("~s calls undefined ~s", - [format_mfa(Server, MFA1), - format_mfa(MFA2)]), - io:format(Fd, "~s ~s\n", - [format_mfa(Server, MFA1), - format_mfa(MFA2)]) - end, Undef), - close_log(Fd), - ?line ?t:fail({length(Undef),undefined_functions_in_otp}) + [] -> ok; + _ -> + Fd = open_log(Config, "undefined_functions"), + foreach(fun ({MFA1,MFA2}) -> + io:format("~s calls undefined ~s", + [format_mfa(Server, MFA1), + format_mfa(MFA2)]), + io:format(Fd, "~s ~s\n", + [format_mfa(Server, MFA1), + format_mfa(MFA2)]) + end, Undef), + close_log(Fd), + ct:fail({length(Undef),undefined_functions_in_otp}) end. hipe_filter(Undef) -> case erlang:system_info(hipe_architecture) of - undefined -> - filter(fun ({_,{hipe_bifs,_,_}}) -> false; - ({_,{hipe,_,_}}) -> false; - ({_,{hipe_consttab,_,_}}) -> false; - ({_,{hipe_converters,_,_}}) -> false; - ({{code,_,_},{Mod,_,_}}) -> - not is_hipe_module(Mod); - ({{code_server,_,_},{Mod,_,_}}) -> - not is_hipe_module(Mod); - ({{compile,_,_},{Mod,_,_}}) -> - not is_hipe_module(Mod); - ({{hipe,_,_},{Mod,_,_}}) -> - %% See comment for the next clause. - not is_hipe_module(Mod); - ({{cerl_to_icode,translate_flags1,2}, - {hipe_rtl_arch,endianess,0}}) -> - false; - ({{Caller,_,_},{Callee,_,_}}) -> - %% Part of the hipe application is here - %% for the sake of Dialyzer. There are many - %% undefined calls within the hipe application. - not is_hipe_module(Caller) orelse - not is_hipe_module(Callee); - (_) -> true - end, Undef); - _Arch -> - filter(fun ({{Mod,_,_},{hipe_bifs,write_u64,2}}) -> - %% Unavailable except in 64 bit AMD. Ignore it. - not is_hipe_module(Mod); - (_) -> true - end, Undef) + undefined -> + filter(fun ({_,{hipe_bifs,_,_}}) -> false; + ({_,{hipe,_,_}}) -> false; + ({_,{hipe_consttab,_,_}}) -> false; + ({_,{hipe_converters,_,_}}) -> false; + ({{code,_,_},{Mod,_,_}}) -> + not is_hipe_module(Mod); + ({{code_server,_,_},{Mod,_,_}}) -> + not is_hipe_module(Mod); + ({{compile,_,_},{Mod,_,_}}) -> + not is_hipe_module(Mod); + ({{hipe,_,_},{Mod,_,_}}) -> + %% See comment for the next clause. + not is_hipe_module(Mod); + ({{cerl_to_icode,translate_flags1,2}, + {hipe_rtl_arch,endianess,0}}) -> + false; + ({{Caller,_,_},{Callee,_,_}}) -> + %% Part of the hipe application is here + %% for the sake of Dialyzer. There are many + %% undefined calls within the hipe application. + not is_hipe_module(Caller) orelse + not is_hipe_module(Callee); + (_) -> true + end, Undef); + _Arch -> + filter(fun ({{Mod,_,_},{hipe_bifs,write_u64,2}}) -> + %% Unavailable except in 64 bit AMD. Ignore it. + not is_hipe_module(Mod); + (_) -> true + end, Undef) end. is_hipe_module(Mod) -> case atom_to_list(Mod) of - "hipe_"++_ -> true; - _ -> false + "hipe_"++_ -> true; + _ -> false end. ssl_crypto_filter(Undef) -> case {app_exists(crypto),app_exists(ssl)} of - {false,false} -> - filter(fun({_,{ssl,_,_}}) -> false; - ({_,{crypto,_,_}}) -> false; - ({_,{ssh,_,_}}) -> false; - ({_,{ssh_connection,_,_}}) -> false; - ({_,{ssh_sftp,_,_}}) -> false; - (_) -> true - end, Undef); - {_,_} -> Undef + {false,false} -> + filter(fun({_,{ssl,_,_}}) -> false; + ({_,{crypto,_,_}}) -> false; + ({_,{ssh,_,_}}) -> false; + ({_,{ssh_connection,_,_}}) -> false; + ({_,{ssh_sftp,_,_}}) -> false; + (_) -> true + end, Undef); + {_,_} -> Undef end. edoc_filter(Undef) -> %% Filter away function call that is catched. filter(fun({{edoc_lib,uri_get_http,1},{http,request_sync,2}}) -> false; - (_) -> true - end, Undef). + (_) -> true + end, Undef). eunit_filter(Undef) -> filter(fun({{eunit_test,wrapper_test_exported_,0}, - {eunit_test,nonexisting_function,0}}) -> false; - (_) -> true - end, Undef). + {eunit_test,nonexisting_function,0}}) -> false; + (_) -> true + end, Undef). dialyzer_filter(Undef) -> case app_exists(dialyzer) of - false -> - filter(fun({_,{dialyzer_callgraph,_,_}}) -> false; - ({_,{dialyzer_codeserver,_,_}}) -> false; - ({_,{dialyzer_contracts,_,_}}) -> false; - ({_,{dialyzer_cl_parse,_,_}}) -> false; - ({_,{dialyzer_timing,_,_}}) -> false; - ({_,{dialyzer_plt,_,_}}) -> false; - ({_,{dialyzer_succ_typings,_,_}}) -> false; - ({_,{dialyzer_utils,_,_}}) -> false; - (_) -> true - end, Undef); - _ -> Undef + false -> + filter(fun({_,{dialyzer_callgraph,_,_}}) -> false; + ({_,{dialyzer_codeserver,_,_}}) -> false; + ({_,{dialyzer_contracts,_,_}}) -> false; + ({_,{dialyzer_cl_parse,_,_}}) -> false; + ({_,{dialyzer_timing,_,_}}) -> false; + ({_,{dialyzer_plt,_,_}}) -> false; + ({_,{dialyzer_succ_typings,_,_}}) -> false; + ({_,{dialyzer_utils,_,_}}) -> false; + (_) -> true + end, Undef); + _ -> Undef end. wx_filter(Undef) -> case app_exists(wx) of - false -> - filter(fun({_,{MaybeWxModule,_,_}}) -> - case atom_to_list(MaybeWxModule) of - "wx"++_ -> false; - _ -> true - end - end, Undef); - _ -> Undef + false -> + filter(fun({_,{MaybeWxModule,_,_}}) -> + case atom_to_list(MaybeWxModule) of + "wx"++_ -> false; + _ -> true + end + end, Undef); + _ -> Undef end. - + gs_filter(Undef) -> case code:lib_dir(gs) of - {error,bad_name} -> - filter(fun({_,{gs,_,_}}) -> false; - ({_,{gse,_,_}}) -> false; + {error,bad_name} -> + filter(fun({_,{gs,_,_}}) -> false; + ({_,{gse,_,_}}) -> false; ({_,{tool_utils,_,_}}) -> false; - (_) -> true - end, Undef); - _ -> Undef + (_) -> true + end, Undef); + _ -> Undef end. diameter_filter(Undef) -> @@ -229,80 +218,82 @@ diameter_filter(Undef) -> false; ({{diameter_lib,_,_},{erlang,time_offset,0}}) -> false; - (_) -> true - end, Undef). + (_) -> true + end, Undef). deprecated_not_in_obsolete(Config) when is_list(Config) -> - ?line Server = ?config(xref_server, Config), - ?line {ok,DeprecatedFunctions} = xref:q(Server, "DF"), - - ?line L = foldl(fun({M,F,A}=MFA, Acc) -> - case otp_internal:obsolete(M, F, A) of - no -> [MFA|Acc]; - _ -> Acc - end - end, [], DeprecatedFunctions), + Server = proplists:get_value(xref_server, Config), + {ok,DeprecatedFunctions} = xref:q(Server, "DF"), + + L = foldl(fun({M,F,A}=MFA, Acc) -> + case otp_internal:obsolete(M, F, A) of + no -> [MFA|Acc]; + _ -> Acc + end + end, [], DeprecatedFunctions), case L of - [] -> ok; - _ -> - io:put_chars("The following functions have -deprecated() attributes,\n" - "but are not listed in otp_internal:obsolete/3.\n"), - print_mfas(group_leader(), Server, L), - Fd = open_log(Config, "deprecated_not_obsolete"), - print_mfas(Fd, Server, L), - close_log(Fd), - ?line ?t:fail({length(L),deprecated_but_not_obsolete}) + [] -> ok; + _ -> + io:put_chars("The following functions have -deprecated() attributes,\n" + "but are not listed in otp_internal:obsolete/3.\n"), + print_mfas(group_leader(), Server, L), + Fd = open_log(Config, "deprecated_not_obsolete"), + print_mfas(Fd, Server, L), + close_log(Fd), + ct:fail({length(L),deprecated_but_not_obsolete}) end. obsolete_but_not_deprecated(Config) when is_list(Config) -> - ?line Server = ?config(xref_server, Config), - ?line {ok,NotDeprecated} = xref:q(Server, "X - DF"), + Server = proplists:get_value(xref_server, Config), + {ok,NotDeprecated} = xref:q(Server, "X - DF"), - ?line L = foldl(fun({M,F,A}=MFA, Acc) -> - case otp_internal:obsolete(M, F, A) of - no -> Acc; - _ -> [MFA|Acc] - end - end, [], NotDeprecated), + L = foldl(fun({M,F,A}=MFA, Acc) -> + case otp_internal:obsolete(M, F, A) of + no -> Acc; + _ -> [MFA|Acc] + end + end, [], NotDeprecated), case L of - [] -> ok; - _ -> - io:put_chars("The following functions are listed " - "in otp_internal:obsolete/3,\n" - "but don't have -deprecated() attributes.\n"), - print_mfas(group_leader(), Server, L), - Fd = open_log(Config, "obsolete_not_deprecated"), - print_mfas(Fd, Server, L), - close_log(Fd), - ?line ?t:fail({length(L),obsolete_but_not_deprecated}) + [] -> ok; + _ -> + io:put_chars("The following functions are listed " + "in otp_internal:obsolete/3,\n" + "but don't have -deprecated() attributes.\n"), + print_mfas(group_leader(), Server, L), + Fd = open_log(Config, "obsolete_not_deprecated"), + print_mfas(Fd, Server, L), + close_log(Fd), + ct:fail({length(L),obsolete_but_not_deprecated}) end. - + call_to_deprecated(Config) when is_list(Config) -> - Server = ?config(xref_server, Config), - ?line {ok,DeprecatedCalls} = xref:q(Server, "strict(E || DF)"), + Server = proplists:get_value(xref_server, Config), + {ok,DeprecatedCalls} = xref:q(Server, "strict(E || DF)"), foreach(fun ({MFA1,MFA2}) -> - io:format("~s calls deprecated ~s", - [format_mfa(MFA1),format_mfa(MFA2)]) - end, DeprecatedCalls), + io:format("~s calls deprecated ~s", + [format_mfa(MFA1),format_mfa(MFA2)]) + end, DeprecatedCalls), {comment,integer_to_list(length(DeprecatedCalls))++" calls to deprecated functions"}. call_to_size_1(Config) when is_list(Config) -> %% Applications that do not call erlang:size/1: Apps = [asn1,compiler,debugger,kernel,observer,parsetools, - runtime_tools,stdlib,tools,webtool], + runtime_tools,stdlib,tools], 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], + gs,kernel,mnesia,observer,parsetools,reltool, + runtime_tools,sasl,stdlib,syntax_tools, + tools], not_recommended_calls(Config, Apps, {erlang,now,0}). -not_recommended_calls(Config, Apps, MFA) -> - Server = ?config(xref_server, Config), +not_recommended_calls(Config, Apps0, MFA) -> + Server = proplists:get_value(xref_server, Config), + + Apps = [App || App <- Apps0, is_present_application(App, Server)], Fs = [MFA], @@ -313,14 +304,14 @@ not_recommended_calls(Config, Apps, MFA) -> {ok,CallsToMFA} = xref:q(Server, lists:flatten(Q2)), case CallsToMFA of - [] -> + [] -> ok; - _ -> + _ -> io:format("These calls are not allowed:\n"), - foreach(fun ({MFA1,MFA2}) -> - io:format("~s calls non-recommended ~s", - [format_mfa(MFA1),format_mfa(MFA2)]) - end, CallsToMFA) + foreach(fun ({MFA1,MFA2}) -> + io:format("~s calls non-recommended ~s", + [format_mfa(MFA1),format_mfa(MFA2)]) + end, CallsToMFA) end, %% Enumerate calls to MFA from other applications than @@ -336,15 +327,32 @@ not_recommended_calls(Config, Apps, MFA) -> end, Calls) end, case CallsToMFA of - [] -> - ok; - _ -> - ?t:fail({length(CallsToMFA),calls_to_size_1}) + [] -> + SkippedApps = ordsets:subtract(ordsets:from_list(Apps0), + ordsets:from_list(Apps)), + case SkippedApps of + [] -> + ok; + _ -> + AppStrings = [atom_to_list(A) || A <- SkippedApps], + Mess = io_lib:format("Application(s) not present: ~s\n", + [string:join(AppStrings, ", ")]), + {comment, Mess} + end; + _ -> + ct:fail({length(CallsToMFA),calls_to_size_1}) + end. + +is_present_application(Name, Server) -> + Q = io_lib:format("~w : App", [Name]), + case xref:q(Server, lists:flatten(Q)) of + {ok,[Name]} -> true; + {error,_,_} -> false end. strong_components(Config) when is_list(Config) -> - Server = ?config(xref_server, Config), - ?line {ok,Cs} = xref:q(Server, "components AE"), + Server = proplists:get_value(xref_server, Config), + {ok,Cs} = xref:q(Server, "components AE"), io:format("\n\nStrong components:\n\n~p\n", [Cs]), ok. @@ -352,41 +360,41 @@ erl_file_encoding(_Config) -> Root = code:root_dir(), Wc = filename:join([Root,"**","*.erl"]), ErlFiles = ordsets:subtract(ordsets:from_list(filelib:wildcard(Wc)), - release_files(Root, "*.erl")), + release_files(Root, "*.erl")), {ok, MP} = re:compile(".*lib/(ic)|(orber)|(cos).*", [unicode]), Fs = [F || F <- ErlFiles, - filter_use_latin1_coding(F, MP), - case epp:read_encoding(F) of - none -> false; - _ -> true - end], + filter_use_latin1_coding(F, MP), + case epp:read_encoding(F) of + none -> false; + _ -> true + end], case Fs of - [] -> - ok; - [_|_] -> - io:put_chars("Files with \"coding:\":\n"), - [io:put_chars(F) || F <- Fs], - ?t:fail() + [] -> + ok; + [_|_] -> + io:put_chars("Files with \"coding:\":\n"), + [io:put_chars(F) || F <- Fs], + ct:fail(failed) end. filter_use_latin1_coding(F, MP) -> case re:run(F, MP) of - nomatch -> - true; + nomatch -> + true; {match, _} -> - false + false end. xml_file_encoding(_Config) -> XmlFiles = xml_files(), Fs = [F || F <- XmlFiles, is_bad_encoding(F)], case Fs of - [] -> - ok; - [_|_] -> - io:put_chars("Encoding should be \"utf-8\" or \"UTF-8\":\n"), - [io:put_chars(F) || F <- Fs], - ?t:fail() + [] -> + ok; + [_|_] -> + io:put_chars("Encoding should be \"utf-8\" or \"UTF-8\":\n"), + [io:put_chars(F) || F <- Fs], + ct:fail(failed) end. xml_files() -> @@ -398,7 +406,7 @@ xml_files() -> XmerlWc = filename:join([Root,"lib","xmerl","**","*.xml"]), XmerlXmlFiles = ordsets:from_list(filelib:wildcard(XmerlWc)), Ignore = ordsets:union([TestXmlFiles,XmerlXmlFiles, - release_files(Root, "*.xml")]), + release_files(Root, "*.xml")]), ordsets:subtract(AllXmlFiles, Ignore). release_files(Root, Ext) -> @@ -408,12 +416,12 @@ release_files(Root, Ext) -> is_bad_encoding(File) -> {ok,Bin} = file:read_file(File), case Bin of - <<"<?xml version=\"1.0\" encoding=\"utf-8\"",_/binary>> -> - false; - <<"<?xml version=\"1.0\" encoding=\"UTF-8\"",_/binary>> -> - false; - _ -> - true + <<"<?xml version=\"1.0\" encoding=\"utf-8\"",_/binary>> -> + false; + <<"<?xml version=\"1.0\" encoding=\"UTF-8\"",_/binary>> -> + false; + _ -> + true end. runtime_dependencies(Config) -> @@ -425,59 +433,31 @@ runtime_dependencies(Config) -> %% Verify that (at least) OTP application runtime dependencies found %% by xref are listed in the runtime_dependencies field of the .app file %% of each application. - Server = ?config(xref_server, Config), + Server = proplists:get_value(xref_server, Config), {ok, AE} = xref:q(Server, "AE"), SAE = lists:keysort(1, AE), put(ignored_failures, []), {AppDep, AppDeps} = lists:foldl(fun ({App, App}, Acc) -> - Acc; - ({App, Dep}, {undefined, []}) -> - {{App, [Dep]}, []}; - ({App, Dep}, {{App, Deps}, AppDeps}) -> - {{App, [Dep|Deps]}, AppDeps}; - ({App, Dep}, {AppDep, AppDeps}) -> - {{App, [Dep]}, [AppDep | AppDeps]} - end, - {undefined, []}, - SAE), - [] = lists:filter(fun ({missing_runtime_dependency, - AppFile, - common_test}) -> - %% The test_server app is contaminated by - %% common_test when run in a source tree. It - %% should however *not* be contaminated - %% when run in an installation. - case {filename:basename(AppFile), - is_run_in_src_tree()} of - {"test_server.app", true} -> - false; - _ -> - true - end; - (_) -> - true - end, - check_apps_deps([AppDep|AppDeps], IgnoreApps)), + Acc; + ({App, Dep}, {undefined, []}) -> + {{App, [Dep]}, []}; + ({App, Dep}, {{App, Deps}, AppDeps}) -> + {{App, [Dep|Deps]}, AppDeps}; + ({App, Dep}, {AppDep, AppDeps}) -> + {{App, [Dep]}, [AppDep | AppDeps]} + end, + {undefined, []}, + SAE), + check_apps_deps([AppDep|AppDeps], IgnoreApps), case IgnoreApps of - [] -> - ok; - _ -> - Comment = lists:flatten(io_lib:format("Ignored applications: ~p " - "Ignored failures: ~p", - [IgnoreApps, - get(ignored_failures)])), - {comment, Comment} - end. - -is_run_in_src_tree() -> - %% At least currently run_erl is not present in <code-root>/bin - %% in the source tree, but present in <code-root>/bin of an - %% ordinary installation. - case file:read_file_info(filename:join([code:root_dir(), - "bin", - "run_erl"])) of - {ok, _} -> false; - {error, _} -> true + [] -> + ok; + _ -> + Comment = lists:flatten(io_lib:format("Ignored applications: ~p " + "Ignored failures: ~p", + [IgnoreApps, + get(ignored_failures)])), + {comment, Comment} end. have_rdep(_App, [], _Dep) -> @@ -485,11 +465,11 @@ have_rdep(_App, [], _Dep) -> have_rdep(App, [RDep | RDeps], Dep) -> [AppStr, _VsnStr] = string:tokens(RDep, "-"), case Dep == list_to_atom(AppStr) of - true -> - io:format("~p -> ~s~n", [App, RDep]), - true; - false -> - have_rdep(App, RDeps, Dep) + true -> + io:format("~p -> ~s~n", [App, RDep]), + true; + false -> + have_rdep(App, RDeps, Dep) end. check_app_deps(_App, _AppFile, _AFDeps, [], _IgnoreApps) -> @@ -497,17 +477,17 @@ check_app_deps(_App, _AppFile, _AFDeps, [], _IgnoreApps) -> check_app_deps(App, AppFile, AFDeps, [XRDep | XRDeps], IgnoreApps) -> ResOtherDeps = check_app_deps(App, AppFile, AFDeps, XRDeps, IgnoreApps), case have_rdep(App, AFDeps, XRDep) of - true -> - ResOtherDeps; - false -> - Failure = {missing_runtime_dependency, AppFile, XRDep}, - case lists:member(App, IgnoreApps) of - true -> - put(ignored_failures, [Failure | get(ignored_failures)]), - ResOtherDeps; - false -> - [Failure | ResOtherDeps] - end + true -> + ResOtherDeps; + false -> + Failure = {missing_runtime_dependency, AppFile, XRDep}, + case lists:member(App, IgnoreApps) of + true -> + put(ignored_failures, [Failure | get(ignored_failures)]), + ResOtherDeps; + false -> + [Failure | ResOtherDeps] + end end. check_apps_deps([], _IgnoreApps) -> @@ -517,24 +497,24 @@ check_apps_deps([{App, Deps}|AppDeps], IgnoreApps) -> AppFile = code:where_is_file(atom_to_list(App) ++ ".app"), {ok,[{application, App, Info}]} = file:consult(AppFile), case lists:keyfind(runtime_dependencies, 1, Info) of - {runtime_dependencies, RDeps} -> - check_app_deps(App, AppFile, RDeps, Deps, IgnoreApps) - ++ ResOtherApps; - false -> - Failure = {missing_runtime_dependencies_key, AppFile}, - case lists:member(App, IgnoreApps) of - true -> - put(ignored_failures, [Failure | get(ignored_failures)]), - ResOtherApps; - false -> - [Failure | ResOtherApps] - end + {runtime_dependencies, RDeps} -> + check_app_deps(App, AppFile, RDeps, Deps, IgnoreApps) + ++ ResOtherApps; + false -> + Failure = {missing_runtime_dependencies_key, AppFile}, + case lists:member(App, IgnoreApps) of + true -> + put(ignored_failures, [Failure | get(ignored_failures)]), + ResOtherApps; + false -> + [Failure | ResOtherApps] + end end. %%% %%% Common help functions. %%% - + print_mfas(Fd, Server, MFAs) -> [io:format(Fd, "~s\n", [format_mfa(Server, MFA)]) || MFA <- MFAs], ok. @@ -546,13 +526,13 @@ format_mfa(Server, MFA) -> MFAString = format_mfa(MFA), AQ = "(App)" ++ MFAString, AppPrefix = case xref:q(Server, AQ) of - {ok,[App]} -> "[" ++ atom_to_list(App) ++ "]"; - _ -> "" - end, + {ok,[App]} -> "[" ++ atom_to_list(App) ++ "]"; + _ -> "" + end, AppPrefix ++ MFAString. open_log(Config, Name) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), RunDir = filename:dirname(filename:dirname(PrivDir)), Path = filename:join(RunDir, "system_"++Name++".log"), {ok,Fd} = file:open(Path, [write]), @@ -563,13 +543,13 @@ close_log(Fd) -> app_exists(AppAtom) -> case code:lib_dir(AppAtom) of - {error,bad_name} -> - false; - Path -> - case file:read_file_info(filename:join(Path,"ebin")) of - {ok,_} -> - true; - _ -> - false - end + {error,bad_name} -> + false; + Path -> + case file:read_file_info(filename:join(Path,"ebin")) of + {ok,_} -> + true; + _ -> + false + end end. diff --git a/erts/test/run_erl_SUITE.erl b/erts/test/run_erl_SUITE.erl index 328477d870..47d38bde7c 100644 --- a/erts/test/run_erl_SUITE.erl +++ b/erts/test/run_erl_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,43 +20,19 @@ -module(run_erl_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, - basic/1,heavy/1,heavier/1,defunct/1]). +-export([all/0, suite/0]). +-export([basic/1,heavy/1,heavier/1,defunct/1]). -export([ping_me_back/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -init_per_testcase(_Case, Config) -> - Dog = ?t:timetrap(?t:minutes(2)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> [basic, heavy, heavier, defunct]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - basic(Config) when is_list(Config) -> case os:type() of @@ -65,16 +41,16 @@ basic(Config) when is_list(Config) -> end. basic_1(Config) -> - ?line {Node,Pipe} = do_run_erl(Config, "basic"), + {Node,Pipe} = do_run_erl(Config, "basic"), - ?line ToErl = open_port({spawn,"to_erl "++Pipe}, []), - ?line erlang:port_command(ToErl, "halt().\r\n"), + ToErl = open_port({spawn,"to_erl "++Pipe}, []), + erlang:port_command(ToErl, "halt().\r\n"), receive {nodedown,Node} -> - ?line io:format("Down: ~p\n", [Node]) + io:format("Down: ~p\n", [Node]) after 10000 -> - ?line ?t:fail() + ct:fail(timeout) end, ok. @@ -86,29 +62,28 @@ heavy(Config) when is_list(Config) -> end. heavy_1(Config) -> - ?line {Node,Pipe} = do_run_erl(Config, "heavy"), + {Node,Pipe} = do_run_erl(Config, "heavy"), - ?line ToErl = open_port({spawn,"to_erl "++Pipe}, []), + ToErl = open_port({spawn,"to_erl "++Pipe}, []), IoFormat = "io:format(\"~s\n\", [lists:duplicate(10000, 10)]).\r\n", - ?line erlang:port_command(ToErl, IoFormat), - ?line erlang:port_command(ToErl, IoFormat), - ?line erlang:port_command(ToErl, IoFormat), - ?line erlang:port_command(ToErl, "init:stop().\r\n"), + erlang:port_command(ToErl, IoFormat), + erlang:port_command(ToErl, IoFormat), + erlang:port_command(ToErl, IoFormat), + erlang:port_command(ToErl, "init:stop().\r\n"), receive {nodedown,Node} -> - ?line io:format("Down: ~p\n", [Node]) + io:format("Down: ~p\n", [Node]) after 10000 -> - ?line ?t:fail() + ct:fail(timeout) end, - ?line case count_new_lines(ToErl, 0) of - Nls when Nls > 30000 -> - ok; - Nls -> - ?line io:format("new_lines: ~p\n", [Nls]), - ?line ?t:fail() - end. + case count_new_lines(ToErl, 0) of + Nls when Nls > 30000 -> + ok; + Nls -> + ct:fail("new_lines: ~p\n", [Nls]) + end. ping_me_back([Node]) when is_atom(Node) -> @@ -137,18 +112,16 @@ heavier(Config) when is_list(Config) -> end. heavier_1(Config) -> - ?line {Node,Pipe} = do_run_erl(Config, "heavier"), + {Node,Pipe} = do_run_erl(Config, "heavier"), - ?line ToErl = open_port({spawn,"to_erl "++Pipe}, []), + ToErl = open_port({spawn,"to_erl "++Pipe}, []), io:format("ToErl = ~p\n", [ToErl]), - X = 1, - Y = 555, - Z = 42, - ?line random:seed(X, Y, Z), - SeedCmd = lists:flatten(io_lib:format("random:seed(~p, ~p, ~p). \r\n", - [X,Y,Z])), - ?line io:format("~p\n", [SeedCmd]), - ?line erlang:port_command(ToErl, SeedCmd), + Seed = {1,555,42}, + rand:seed(exsplus, Seed), + SeedCmd = lists:flatten(io_lib:format("rand:seed(exsplus, ~p). \r\n", + [Seed])), + io:format("~p\n", [SeedCmd]), + erlang:port_command(ToErl, SeedCmd), Iter = 1000, MaxLen = 2048, @@ -157,9 +130,9 @@ heavier_1(Config) -> "F = fun(F,0) -> ok; "++ "(F,N) -> " ++ "io:format(\"\\\"~s\\\"~n\","++ - "[[35|[random:uniform(25)+65 || " ++ + "[[35|[rand:uniform(25)+65 || " ++ "_ <- lists:seq(1, "++ - "random:uniform("++ + "rand:uniform("++ integer_to_list(MaxLen)++ "))]]]), "++ "F(F,N-1) "++ @@ -167,19 +140,19 @@ heavier_1(Config) -> "F(F,"++integer_to_list(Iter)++")."++" \r\n", - ?line io:format("~p\n", [Random]), - ?line erlang:port_command(ToErl, Random), + io:format("~p\n", [Random]), + erlang:port_command(ToErl, Random), %% Finish. - ?line erlang:port_command(ToErl, "init:stop().\r\n"), - ?line receive_all(Iter, ToErl, MaxLen), + erlang:port_command(ToErl, "init:stop().\r\n"), + receive_all(Iter, ToErl, MaxLen), receive {nodedown,Node} -> - ?line io:format("Down: ~p\n", [Node]) + io:format("Down: ~p\n", [Node]) after 10000 -> - ?line c:flush(), - ?line ?t:fail() + c:flush(), + ct:fail(timeout) end, ok. @@ -189,8 +162,8 @@ receive_all(Iter, ToErl, MaxLen) -> receive_all_1(0, _, _, _) -> ok; receive_all_1(Iter, Line, ToErl, MaxLen) -> - NumChars = random:uniform(MaxLen), - Pattern = [random:uniform(25)+65 || _ <- lists:seq(1, NumChars)], + NumChars = rand:uniform(MaxLen), + Pattern = [rand:uniform(25)+65 || _ <- lists:seq(1, NumChars)], receive_all_2(Iter, {NumChars,Pattern}, Line, ToErl, MaxLen). @@ -206,9 +179,7 @@ receive_all_2(Iter, {NumChars,Pattern}, Line0, ToErl, MaxLen) -> %%io:format("Recv: ~p\n", [S]), receive_all_2(Iter, {NumChars,Pattern}, Line++S, ToErl, MaxLen) after 10000 -> - io:format("Timeout waiting for\n~p\ngot\n~p\n", - [Pattern, Line]), - ?line ?t:fail() + ct:fail("Timeout waiting for\n~p\ngot\n~p\n", [Pattern, Line]) end end. @@ -243,49 +214,47 @@ defunct_1(Config) -> end. defunct_2(Config, Perl) -> - ?line Data = ?config(data_dir, Config), - ?line RunErlTest = filename:join(Data, "run_erl_test.pl"), - ?line Defuncter = filename:join(Data, "defuncter.pl"), - ?line Priv = ?config(priv_dir, Config), - ?line LogDir = filename:join(Priv, "defunct"), - ?line ok = file:make_dir(LogDir), - ?line Pipe = LogDir ++ "/", - ?line RunErl = os:find_executable(run_erl), - ?line Cmd = Perl ++ " " ++ RunErlTest ++ " \"" ++ RunErl ++ "\" " ++ + Data = proplists:get_value(data_dir, Config), + RunErlTest = filename:join(Data, "run_erl_test.pl"), + Defuncter = filename:join(Data, "defuncter.pl"), + Priv = proplists:get_value(priv_dir, Config), + LogDir = filename:join(Priv, "defunct"), + ok = file:make_dir(LogDir), + Pipe = LogDir ++ "/", + RunErl = os:find_executable(run_erl), + Cmd = Perl ++ " " ++ RunErlTest ++ " \"" ++ RunErl ++ "\" " ++ Defuncter ++ " " ++ Pipe ++ " " ++ LogDir, - ?line io:format("~p", [Cmd]), - ?line Res = os:cmd(Cmd), - ?line io:format("~p\n", [Res]), + io:format("~p", [Cmd]), + Res = os:cmd(Cmd), + io:format("~p\n", [Res]), "OK"++_ = Res, ok. %%% Utilities. do_run_erl(Config, Case) -> - ?line Priv = ?config(priv_dir, Config), - ?line LogDir = filename:join(Priv, Case), - ?line ok = file:make_dir(LogDir), - ?line Pipe = LogDir ++ "/", - ?line NodeName = "run_erl_node_" ++ Case, - ?line Cmd = "run_erl "++Pipe++" "++LogDir++" \"erl -sname " ++ NodeName ++ + Priv = proplists:get_value(priv_dir, Config), + LogDir = filename:join(Priv, Case), + ok = file:make_dir(LogDir), + Pipe = LogDir ++ "/", + NodeName = "run_erl_node_" ++ Case, + Cmd = "run_erl "++Pipe++" "++LogDir++" \"erl -sname " ++ NodeName ++ " -pa " ++ filename:dirname(code:which(?MODULE)) ++ " -s " ++ ?MODULE_STRING ++ " ping_me_back " ++ atom_to_list(node()) ++ "\"", - ?line io:format("~p\n", [Cmd]), + io:format("~p\n", [Cmd]), - ?line net_kernel:monitor_nodes(true), - ?line open_port({spawn,Cmd}, []), - ?line [_,Host] = string:tokens(atom_to_list(node()), "@"), - ?line Node = list_to_atom(NodeName++"@"++Host), + net_kernel:monitor_nodes(true), + open_port({spawn,Cmd}, []), + [_,Host] = string:tokens(atom_to_list(node()), "@"), + Node = list_to_atom(NodeName++"@"++Host), receive {nodeup,Node} -> - ?line io:format("Up: ~p\n", [Node]); + io:format("Up: ~p\n", [Node]); Other -> - ?line io:format("Unexpected: ~p\n", [Other]), - ?line ?t:fail() + ct:fail("Unexpected: ~p\n", [Other]) after 10000 -> - ?line ?t:fail() + ct:fail(timeout) end, - {Node,Pipe}. diff --git a/erts/test/run_erl_SUITE_data/defuncter.pl b/erts/test/run_erl_SUITE_data/defuncter.pl index 666d4cca41..0b6771a8bb 100644 --- a/erts/test/run_erl_SUITE_data/defuncter.pl +++ b/erts/test/run_erl_SUITE_data/defuncter.pl @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# Copyright Ericsson AB 2006-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/test/run_erl_SUITE_data/run_erl_test.pl b/erts/test/run_erl_SUITE_data/run_erl_test.pl index b9e3f0a363..9560fa3c14 100644 --- a/erts/test/run_erl_SUITE_data/run_erl_test.pl +++ b/erts/test/run_erl_SUITE_data/run_erl_test.pl @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# Copyright Ericsson AB 2006-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/test/upgrade_SUITE.erl b/erts/test/upgrade_SUITE.erl index 83cd2359d8..174c028ac7 100644 --- a/erts/test/upgrade_SUITE.erl +++ b/erts/test/upgrade_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2014. All Rights Reserved. +%% Copyright Ericsson AB 2014-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -50,12 +50,12 @@ init_per_suite(Config) -> %% Fake release, no applications {skip, "Need a real release running to create other releases"}; _ -> - rm_rf(filename:join([?config(data_dir,Config),priv_dir])), + rm_rf(filename:join([proplists:get_value(data_dir,Config),priv_dir])), Config end. init_per_testcase(Case,Config) -> - PrivDir = filename:join([?config(data_dir,Config),priv_dir,Case]), + PrivDir = filename:join([proplists:get_value(data_dir,Config),priv_dir,Case]), CreateDir = filename:join([PrivDir,create]), InstallDir = filename:join([PrivDir,install]), ok = filelib:ensure_dir(filename:join(CreateDir,"*")), @@ -66,10 +66,10 @@ init_per_testcase(Case,Config) -> end_per_testcase(_Case,Config) -> Nodes = nodes(), [test_server:stop_node(Node) || Node <- Nodes], - case ?config(tc_status,Config) of + case proplists:get_value(tc_status,Config) of ok -> %% Note that priv_dir here is per test case! - rm_rf(?config(priv_dir,Config)); + rm_rf(proplists:get_value(priv_dir,Config)); _fail -> %% Test case data can be found under DataDir/priv_dir/Case ok @@ -115,15 +115,15 @@ upgrade_test(FromVsn,ToVsn,Config) -> case OldRel of false -> %% Note that priv_dir here is per test case! - rm_rf(?config(priv_dir,Config)), + rm_rf(proplists:get_value(priv_dir,Config)), {skip, "no previous release available"}; _ -> upgrade_test1(FromVsn,ToVsn,[{old_rel,OldRel}|Config]) end. upgrade_test1(FromVsn,ToVsn,Config) -> - CreateDir = ?config(create_dir,Config), - InstallDir = ?config(install_dir,Config), + CreateDir = proplists:get_value(create_dir,Config), + InstallDir = proplists:get_value(install_dir,Config), FromRelName = "otp-"++FromVsn, ToRelName = "otp-"++ToVsn, @@ -141,7 +141,7 @@ upgrade_test1(FromVsn,ToVsn,Config) -> %%% - chmod 'start' and 'start_erl' target_system(RelName0,RelVsn,CreateDir,InstallDir,Config) -> {ok,Node} = test_server:start_node(list_to_atom(RelName0),peer, - [{erl,[?config(old_rel,Config)]}]), + [{erl,[proplists:get_value(old_rel,Config)]}]), {RelName,Apps,ErtsVsn} = create_relfile(Node,CreateDir,RelName0,RelVsn), @@ -184,7 +184,7 @@ target_system(RelName0,RelVsn,CreateDir,InstallDir,Config) -> write_file(SysConfig, "[]."), %% Insert 'start' script from data_dir - modified to add sname and heart - copy_file(filename:join(?config(data_dir,Config),"start.src"), + copy_file(filename:join(proplists:get_value(data_dir,Config),"start.src"), filename:join(ErtsBinDir,"start.src")), ok = file:change_mode(filename:join(ErtsBinDir,"start.src"),8#0755), diff --git a/erts/test/upgrade_SUITE_data/start.src b/erts/test/upgrade_SUITE_data/start.src index 7098a6919a..67d8de8c9e 100644 --- a/erts/test/upgrade_SUITE_data/start.src +++ b/erts/test/upgrade_SUITE_data/start.src @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2014. All Rights Reserved. +# Copyright Ericsson AB 2014-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/test/utils/gccifier.c b/erts/test/utils/gccifier.c index ca022eb390..0c3ef915fb 100644 --- a/erts/test/utils/gccifier.c +++ b/erts/test/utils/gccifier.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2012. All Rights Reserved. + * Copyright Ericsson AB 2004-2016. All Rights Reserved. * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. diff --git a/erts/test/utils/gccifier.sh b/erts/test/utils/gccifier.sh index 24b4d2f335..9311e34300 100755 --- a/erts/test/utils/gccifier.sh +++ b/erts/test/utils/gccifier.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2012. All Rights Reserved. +# Copyright Ericsson AB 2005-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/erts/test/z_SUITE.erl b/erts/test/z_SUITE.erl index 7f3260e4cb..281a47134f 100644 --- a/erts/test/z_SUITE.erl +++ b/erts/test/z_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -24,8 +24,6 @@ %% This suite expects to be run as the last suite of all suites. %% -%-define(line_trace, 1). - -include_lib("kernel/include/file.hrl"). -record(core_search_conf, {search_dir, @@ -34,52 +32,19 @@ file, run_by_ts}). --define(DEFAULT_TIMEOUT, ?t:minutes(5)). - --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([all/0, suite/0]). -export([search_for_core_files/1, core_files/1]). -include_lib("common_test/include/ct.hrl"). - -init_per_testcase(Case, Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{testcase, Case}, {watchdog, Dog} |Config]. - -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 5}}]. all() -> [core_files]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - - -core_files(doc) -> - []; -core_files(suite) -> - []; core_files(Config) when is_list(Config) -> case os:type() of {win32, _} -> @@ -354,7 +319,7 @@ core_file_search(#core_search_conf{search_dir = Base, case {RunByTS, ICores, FCores} of {true, [], []} -> ok; {true, _, []} -> {comment, Res}; - {true, _, _} -> ?t:fail(Res); + {true, _, _} -> ct:fail(Res); _ -> Res end end. diff --git a/erts/vsn.mk b/erts/vsn.mk index 89c3ab8edb..6ad3680213 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2013. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 7.3.1 +VSN = 8.0 # Port number 4365 in 4.2 # Port number 4366 in 4.3 |