diff options
241 files changed, 6584 insertions, 6722 deletions
diff --git a/.travis.yml b/.travis.yml index 88a4c46f77..5499eb22c4 100644 --- a/.travis.yml +++ b/.travis.yml @@ -19,6 +19,7 @@ addons: - default-jdk - g++ - xsltproc + - libxml2-utils matrix: include: @@ -39,6 +40,7 @@ matrix: - ./scripts/build-otp - ./otp_build tests - make release_docs + - make xmllint - ./scripts/run-smoke-tests before_script: diff --git a/Makefile.in b/Makefile.in index 6803e4b77e..e75bcf7f10 100644 --- a/Makefile.in +++ b/Makefile.in @@ -125,7 +125,7 @@ BINDIR = $(DESTDIR)$(EXTRA_PREFIX)$(bindir) # # Erlang base public files # -ERL_BASE_PUB_FILES=erl erlc epmd run_erl to_erl dialyzer escript ct_run +ERL_BASE_PUB_FILES=erl erlc epmd run_erl to_erl dialyzer typer escript ct_run # ERLANG_INST_LIBDIR is the top directory where the Erlang installation # will be located when running. diff --git a/OTP_VERSION b/OTP_VERSION index 2f45cf5f2f..2acad36e08 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1,2 +1 @@ 21.0-rc1 - diff --git a/bootstrap/bin/no_dot_erlang.boot b/bootstrap/bin/no_dot_erlang.boot Binary files differindex fe11c1d256..f6e9160a83 100644 --- a/bootstrap/bin/no_dot_erlang.boot +++ b/bootstrap/bin/no_dot_erlang.boot diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex fe11c1d256..f6e9160a83 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex fe11c1d256..f6e9160a83 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_dead.beam b/bootstrap/lib/compiler/ebin/beam_dead.beam Binary files differindex af2f76c6ee..8934cb5d11 100644 --- a/bootstrap/lib/compiler/ebin/beam_dead.beam +++ b/bootstrap/lib/compiler/ebin/beam_dead.beam diff --git a/bootstrap/lib/compiler/ebin/beam_peep.beam b/bootstrap/lib/compiler/ebin/beam_peep.beam Binary files differindex 67d1f808b6..1bf1e5a79f 100644 --- a/bootstrap/lib/compiler/ebin/beam_peep.beam +++ b/bootstrap/lib/compiler/ebin/beam_peep.beam diff --git a/bootstrap/lib/compiler/ebin/beam_type.beam b/bootstrap/lib/compiler/ebin/beam_type.beam Binary files differindex dab30b21eb..f21ede5043 100644 --- a/bootstrap/lib/compiler/ebin/beam_type.beam +++ b/bootstrap/lib/compiler/ebin/beam_type.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex 99a6c5d7f0..5772dd173b 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/compiler/ebin/erl_bifs.beam b/bootstrap/lib/compiler/ebin/erl_bifs.beam Binary files differindex feb60041bf..be3dc425f4 100644 --- a/bootstrap/lib/compiler/ebin/erl_bifs.beam +++ b/bootstrap/lib/compiler/ebin/erl_bifs.beam diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differindex 833ddf86bb..5aeca65888 100644 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam diff --git a/bootstrap/lib/kernel/ebin/application_controller.beam b/bootstrap/lib/kernel/ebin/application_controller.beam Binary files differindex 869c46939b..e57be279d5 100644 --- a/bootstrap/lib/kernel/ebin/application_controller.beam +++ b/bootstrap/lib/kernel/ebin/application_controller.beam diff --git a/bootstrap/lib/kernel/ebin/erl_epmd.beam b/bootstrap/lib/kernel/ebin/erl_epmd.beam Binary files differindex d06aa1add3..449fd8dff1 100644 --- a/bootstrap/lib/kernel/ebin/erl_epmd.beam +++ b/bootstrap/lib/kernel/ebin/erl_epmd.beam diff --git a/bootstrap/lib/kernel/ebin/erl_signal_handler.beam b/bootstrap/lib/kernel/ebin/erl_signal_handler.beam Binary files differindex 881e36e6fb..1a1d9d28ee 100644 --- a/bootstrap/lib/kernel/ebin/erl_signal_handler.beam +++ b/bootstrap/lib/kernel/ebin/erl_signal_handler.beam diff --git a/bootstrap/lib/kernel/ebin/error_logger.beam b/bootstrap/lib/kernel/ebin/error_logger.beam Binary files differindex 752c0f2bb1..706c2910db 100644 --- a/bootstrap/lib/kernel/ebin/error_logger.beam +++ b/bootstrap/lib/kernel/ebin/error_logger.beam diff --git a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam Binary files differindex 9a7e36791e..c33a9e7f3a 100644 --- a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam +++ b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam Binary files differindex 15dfd19ff8..fb64b7a0e1 100644 --- a/bootstrap/lib/kernel/ebin/kernel.beam +++ b/bootstrap/lib/kernel/ebin/kernel.beam diff --git a/bootstrap/lib/kernel/ebin/logger.beam b/bootstrap/lib/kernel/ebin/logger.beam Binary files differindex 8b57370f82..2bf5ca53b2 100644 --- a/bootstrap/lib/kernel/ebin/logger.beam +++ b/bootstrap/lib/kernel/ebin/logger.beam diff --git a/bootstrap/lib/kernel/ebin/logger_disk_log_h.beam b/bootstrap/lib/kernel/ebin/logger_disk_log_h.beam Binary files differindex 7a21b07c2d..5f4719ee8d 100644 --- a/bootstrap/lib/kernel/ebin/logger_disk_log_h.beam +++ b/bootstrap/lib/kernel/ebin/logger_disk_log_h.beam diff --git a/bootstrap/lib/kernel/ebin/logger_formatter.beam b/bootstrap/lib/kernel/ebin/logger_formatter.beam Binary files differindex 2f225b0295..1ccdfbfe69 100644 --- a/bootstrap/lib/kernel/ebin/logger_formatter.beam +++ b/bootstrap/lib/kernel/ebin/logger_formatter.beam diff --git a/bootstrap/lib/kernel/ebin/logger_h_common.beam b/bootstrap/lib/kernel/ebin/logger_h_common.beam Binary files differindex 528261f4e3..e9a9d3d7c4 100644 --- a/bootstrap/lib/kernel/ebin/logger_h_common.beam +++ b/bootstrap/lib/kernel/ebin/logger_h_common.beam diff --git a/bootstrap/lib/kernel/ebin/logger_server.beam b/bootstrap/lib/kernel/ebin/logger_server.beam Binary files differindex 2bf304e044..c8aee9e323 100644 --- a/bootstrap/lib/kernel/ebin/logger_server.beam +++ b/bootstrap/lib/kernel/ebin/logger_server.beam diff --git a/bootstrap/lib/kernel/ebin/logger_simple.beam b/bootstrap/lib/kernel/ebin/logger_simple.beam Binary files differindex be8017391f..702b03dd65 100644 --- a/bootstrap/lib/kernel/ebin/logger_simple.beam +++ b/bootstrap/lib/kernel/ebin/logger_simple.beam diff --git a/bootstrap/lib/kernel/ebin/logger_std_h.beam b/bootstrap/lib/kernel/ebin/logger_std_h.beam Binary files differindex 7483dee399..fe9b192c15 100644 --- a/bootstrap/lib/kernel/ebin/logger_std_h.beam +++ b/bootstrap/lib/kernel/ebin/logger_std_h.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex 9695be2c1a..c87665ff86 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_error.beam b/bootstrap/lib/stdlib/ebin/erl_error.beam Binary files differnew file mode 100644 index 0000000000..dc9d0a8d39 --- /dev/null +++ b/bootstrap/lib/stdlib/ebin/erl_error.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex f3fc64ee32..a6dc4e0d68 100644 --- a/bootstrap/lib/stdlib/ebin/erl_eval.beam +++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam Binary files differindex 522230cf51..c635408fde 100644 --- a/bootstrap/lib/stdlib/ebin/erl_internal.beam +++ b/bootstrap/lib/stdlib/ebin/erl_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/escript.beam b/bootstrap/lib/stdlib/ebin/escript.beam Binary files differindex 79ed0a3876..781484fe0b 100644 --- a/bootstrap/lib/stdlib/ebin/escript.beam +++ b/bootstrap/lib/stdlib/ebin/escript.beam diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam Binary files differindex 3d103b1624..ab4996ef4e 100644 --- a/bootstrap/lib/stdlib/ebin/ets.beam +++ b/bootstrap/lib/stdlib/ebin/ets.beam diff --git a/bootstrap/lib/stdlib/ebin/lib.beam b/bootstrap/lib/stdlib/ebin/lib.beam Binary files differdeleted file mode 100644 index 2cc777b388..0000000000 --- a/bootstrap/lib/stdlib/ebin/lib.beam +++ /dev/null diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex ace2e0c2f4..03b4b75bb6 100644 --- a/bootstrap/lib/stdlib/ebin/ms_transform.beam +++ b/bootstrap/lib/stdlib/ebin/ms_transform.beam diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam Binary files differindex 9025f68b68..f475eff9b0 100644 --- a/bootstrap/lib/stdlib/ebin/proc_lib.beam +++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam Binary files differindex 523f93a848..5d4375adca 100644 --- a/bootstrap/lib/stdlib/ebin/qlc.beam +++ b/bootstrap/lib/stdlib/ebin/qlc.beam diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam Binary files differindex abbe513b39..36a9c27c35 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/bootstrap/lib/stdlib/ebin/slave.beam b/bootstrap/lib/stdlib/ebin/slave.beam Binary files differindex 596dda4ed5..e832637c7c 100644 --- a/bootstrap/lib/stdlib/ebin/slave.beam +++ b/bootstrap/lib/stdlib/ebin/slave.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index c24ca46516..20c978670e 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All 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 @@ erl_anno, erl_bits, erl_compile, + erl_error, erl_eval, erl_expand_records, erl_internal, @@ -71,7 +72,6 @@ io_lib_format, io_lib_fread, io_lib_pretty, - lib, lists, log_mf_h, maps, diff --git a/bootstrap/lib/stdlib/ebin/string.beam b/bootstrap/lib/stdlib/ebin/string.beam Binary files differindex 39ec49672a..678fead549 100644 --- a/bootstrap/lib/stdlib/ebin/string.beam +++ b/bootstrap/lib/stdlib/ebin/string.beam diff --git a/erts/configure.in b/erts/configure.in index d1c5fe324b..f66445ec25 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -2701,570 +2701,13 @@ if test X${enable_hipe} = Xyes; then fi AC_SUBST(HIPEBEAMLDFLAGS) -if test X${enable_fp_exceptions} = Xauto ; then - case $host_os in - *linux*) - enable_fp_exceptions=no - AC_MSG_NOTICE([Floating point exceptions disabled by default on Linux]) ;; - darwin*) - enable_fp_exceptions=no - AC_MSG_NOTICE([Floating point exceptions disabled by default on MacOS X]) ;; - *) - ;; - esac -fi - -if test X${enable_fp_exceptions} = Xauto ; then - if test X${enable_hipe} = Xyes; then - enable_fp_exceptions=yes - else - enable_fp_exceptions=no - AC_MSG_NOTICE([Floating point exceptions disabled by default in this configuration]) - fi -fi - -if test X${enable_fp_exceptions} != Xyes ; then - AC_DEFINE(NO_FPE_SIGNALS,[],[Define if floating points exceptions are non-existing/not reliable]) - FPE=unreliable -else - - AC_MSG_CHECKING([for unreliable floating point exceptions]) - - - AC_TRY_RUN([ -/* fpe-test.c */ -#include <stdio.h> -#include <signal.h> -#include <stdlib.h> - -#if defined(__clang__) || defined(__llvm__) -#error "Clang/LLVM generates broken code for FP exceptions" -#endif - -volatile int erl_fp_exception; - -/* - * We expect a single SIGFPE in this test program. - * Getting many more indicates an inadequate SIGFPE handler, - * e.g. using the generic handler on x86. - */ -static void new_fp_exception(void) -{ - if (++erl_fp_exception > 50) { - fprintf(stderr, "SIGFPE loop detected, bailing out\n"); - exit(1); - } -} - -/* Is there no standard identifier for Darwin/MacOSX ? */ -#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) -#define __DARWIN__ 1 -#endif - -/* - * Implement unmask_fpe() and check_fpe() based on CPU/OS combination - */ - -#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__) && !defined(__CYGWIN__) && !defined(__MINGW32__) - -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)); -} - -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)); -} - -#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) -{ - unmask_x87(); - if (cpu_has_sse2()) - unmask_sse2(); -} - -static __inline__ int check_fpe(double f) -{ - __asm__ __volatile__("fwait" : "=m"(erl_fp_exception) : "m"(f)); - if (!erl_fp_exception) - return 0; - __asm__ __volatile__("fninit"); - unmask_fpe(); - return 1; -} - -#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 __inline__ int check_fpe(double f) -{ - __asm__ __volatile__("" : "=m"(erl_fp_exception) : "em"(f)); - return erl_fp_exception; -} - -#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 0 - /* 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 void unmask_fpe(void) -{ - set_fpexc_precise(); - set_fpscr(0x80|0x40|0x10); /* VE, OE, ZE; not UE or XE */ -} - -static __inline__ int check_fpe(double f) -{ - __asm__ __volatile__("" : "=m"(erl_fp_exception) : "fm"(f)); - return erl_fp_exception; -} - -#else - -#include <ieeefp.h> - -#define unmask_fpe() fpsetmask(FP_X_INV | FP_X_OFL | FP_X_DZ) - -static __inline__ int check_fpe(double f) -{ - __asm__ __volatile__("" : "=m"(erl_fp_exception) : "g"(f)); - return erl_fp_exception; -} - -#endif - -/* - * Implement SIGFPE handler based on CPU/OS combination - */ - -#if (defined(__linux__) && (defined(__i386__) || defined(__x86_64__) || defined(__sparc__) || defined(__powerpc__))) || (defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__) || defined(__ppc__))) || (defined(__FreeBSD__) && (defined(__i386__) || defined(__x86_64__))) || ((defined(__OpenBSD__) || defined(__NetBSD__)) && 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(__i386__) -#include <sys/types.h> -#include <machine/npx.h> -#elif defined(__FreeBSD__) && defined(__x86_64__) -#include <sys/types.h> -#include <machine/fpu.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> - -static void fpe_sig_action(int sig, siginfo_t *si, void *puc) -{ - ucontext_t *uc = puc; -#if defined(__linux__) -#if defined(__x86_64__) - mcontext_t *mc = &uc->uc_mcontext; - fpregset_t fpstate = mc->fpregs; - fpstate->mxcsr = 0x1F80; - fpstate->swd &= ~0xFF; -#elif defined(__i386__) - mcontext_t *mc = &uc->uc_mcontext; - fpregset_t fpstate = mc->fpregs; - 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; - 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; - 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 - regs[PT_NIP] += 4; - regs[PT_FPSCR] = 0x80|0x40|0x10; /* VE, OE, ZE; not UE or XE */ -#endif -#elif defined(__DARWIN__) -#if defined(DARWIN_MODERN_MCONTEXT) -#if defined(__x86_64__) - mcontext_t mc = uc->uc_mcontext; - struct __darwin_x86_float_state64 *fpstate = &mc->__fs; - fpstate->__fpu_mxcsr = 0x1F80; - *(unsigned short *)&fpstate->__fpu_fsw &= ~0xFF; -#elif defined(__i386__) - mcontext_t mc = uc->uc_mcontext; - struct __darwin_i386_float_state *fpstate = &mc->__fs; - fpstate->__fpu_mxcsr = 0x1F80; - *(unsigned short *)&fpstate->__fpu_fsw &= ~0xFF; -#elif defined(__ppc__) - mcontext_t mc = uc->uc_mcontext; - mc->ss.srr0 += 4; - mc->fs.fpscr = 0x80|0x40|0x10; -#endif -#else -#if defined(__x86_64__) - mcontext_t mc = uc->uc_mcontext; - struct x86_float_state64_t *fpstate = &mc->fs; - fpstate->fpu_mxcsr = 0x1F80; - *(unsigned short *)&fpstate->fpu_fsw &= ~0xFF; -#elif defined(__i386__) - mcontext_t mc = uc->uc_mcontext; - x86_float_state32_t *fpstate = &mc->fs; - fpstate->fpu_mxcsr = 0x1F80; - *(unsigned short *)&fpstate->fpu_fsw &= ~0xFF; -#elif defined(__ppc__) - mcontext_t mc = uc->uc_mcontext; - mc->ss.srr0 += 4; - mc->fs.fpscr = 0x80|0x40|0x10; -#endif -#endif -#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; - 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; - 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(__OpenBSD__) && defined(__x86_64__) - struct fxsave64 *fxsave = uc->sc_fpstate; - fxsave->fx_mxcsr = 0x1F80; - fxsave->fx_fsw &= ~0xFF; -#elif defined(__NetBSD__) && defined(__x86_64__) - mcontext_t *mc = &uc->uc_mcontext; - struct fxsave64 *fxsave = (struct fxsave64 *)&mc->__fpregs; - 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; - fpstate->mxcsr = 0x1F80; - fpstate->sw &= ~0xFF; -#endif - new_fp_exception(); -} - -static void catch_sigfpe(void) -{ - struct sigaction act; - - memset(&act, 0, sizeof act); - act.sa_sigaction = fpe_sig_action; - act.sa_flags = SA_SIGINFO; - sigaction(SIGFPE, &act, NULL); -} - -#else - -static void fpe_sig_handler(int sig) -{ - new_fp_exception(); -} - -static void catch_sigfpe(void) -{ - signal(SIGFPE, fpe_sig_handler); -} - -#endif - -/* - * Generic test code - */ - -static void do_init(void) -{ - catch_sigfpe(); - unmask_fpe(); -} - -double a = 3.23e133; -double b = 3.57e257; -double res; - -void do_fmul(void) -{ - res = a * b; -} - -int do_check(void) -{ - if (check_fpe(res)) { - fprintf(stderr, "res = %g, FPE worked\n", res); - return 0; - } else { - fprintf(stderr, "res = %g, FPE failed\n", res); - return 1; - } -} - -int main(int argc, const char **argv) -{ - if (argc == 3) { - a = atof(argv[1]); - b = atof(argv[2]); - } - do_init(); - do_fmul(); - return do_check(); -} -], -erl_ok=yes, -erl_ok=no, -[ -case X$erl_xcomp_reliable_fpe in - X) erl_ok=cross;; - Xyes|Xno) erl_ok=$erl_xcomp_reliable_fpe;; - *) AC_MSG_ERROR([Bad erl_xcomp_reliable_fpe value: $erl_xcomp_reliable_fpe]);; -esac -]) - - if test $erl_ok = yes; then - FPE=reliable - AC_MSG_RESULT(reliable) - else - FPE=unreliable - AC_MSG_RESULT([unreliable; testing in software instead]) - AC_DEFINE(NO_FPE_SIGNALS,[],[Define if floating points exceptions are non-existing/not reliable]) - if test $erl_ok = cross; then - AC_MSG_WARN([result unreliable guessed because of cross compilation]) - fi - fi -fi - -AC_SUBST(FPE) - +dnl Permanently disable floating point exceptions. +dnl On x86/amd64, floating points exceptions have +dnl unresolved stability issues. +AC_MSG_CHECKING([for unreliable floating point exceptions]) +FPE=unreliable +AC_MSG_RESULT([unreliable]) +AC_DEFINE(NO_FPE_SIGNALS,[],[Define if floating points exceptions are non-existing/not reliable]) dnl dnl Some operating systems allow you to redefine FD_SETSIZE to be able diff --git a/erts/doc/src/Makefile b/erts/doc/src/Makefile index 5fa8b0673a..96cc4413a9 100644 --- a/erts/doc/src/Makefile +++ b/erts/doc/src/Makefile @@ -74,6 +74,7 @@ XML_CHAPTER_FILES = \ match_spec.xml \ crash_dump.xml \ alt_dist.xml \ + alt_disco.xml \ driver.xml \ absform.xml \ inet_cfg.xml \ diff --git a/erts/doc/src/alt_disco.xml b/erts/doc/src/alt_disco.xml new file mode 100644 index 0000000000..d04221b9b3 --- /dev/null +++ b/erts/doc/src/alt_disco.xml @@ -0,0 +1,93 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2018</year><year>2018</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>How to Implement an Alternative Service Discovery for Erlang Distribution + </title> + <prepared>Timmo Verlaan</prepared> + <responsible></responsible> + <docno></docno> + <approved></approved> + <checked></checked> + <date>2018-04-25</date> + <rev>PA1</rev> + <file>alt_disco.xml</file> + </header> + <p> + This section describes how to implement an alternative discovery mechanism + for Erlang distribution. Discovery is normally done using DNS and the + Erlang Port Mapper Daemon (EPMD) for port discovery. + </p> + + <note><p> + Support for alternative service discovery mechanisms was added in Erlang/OTP + 21. + </p></note> + + + <section> + <title>Introduction</title> + <p>To implement your own service discovery module you have to write your own + EPMD module. The <seealso marker="kernel:erl_epmd">EPMD module</seealso> is + responsible for providing the location of another node. The distribution + modules (<c>inet_tcp_dist</c>/<c>inet_tls_dist</c>) call the EPMD module to + get the IP address and port of the other node. The EPMD module that is part + of Erlang/OTP will resolve the hostname using DNS and uses the EPMD unix + process to get the port of another node. The EPMD unix process does this by + connecting to the other node on a well-known port, port 4369.</p> + </section> + + <section> + <title>Discovery module</title> + <p>The discovery module needs to implement the same API as the regular + <seealso marker="kernel:erl_epmd">EPMD module</seealso>. However, instead of + communicating with EPMD you can connect to any service to find out + connection details of other nodes. A discovery module is enabled + by setting <seealso marker="erts:erl#epmd_module">-epmd_module</seealso> + when starting erlang. The discovery module must implement the following + callbacks:</p> + + <taglist> + <tag><seealso marker="kernel:erl_epmd#start_link/0">start_link/0</seealso></tag> + <item>Start any processes needed by the discovery module.</item> + <tag><seealso marker="kernel:erl_epmd#names/1">names/1</seealso></tag> + <item>Return node names held by the registrar for the given host.</item> + <tag><seealso marker="kernel:erl_epmd#register_node/2">register_node/2</seealso></tag> + <item>Register the given node name with the registrar.</item> + <tag><seealso marker="kernel:erl_epmd#port_please/3">port_please/3</seealso></tag> + <item>Return the distribution port used by the given node.</item> + </taglist> + + <p>The discovery module may implement the following callback:</p> + + <taglist> + <tag><seealso marker="kernel:erl_epmd#address_please/3">address_please/3</seealso></tag> + <item><p>Return the address of the given node. + If not implemented, <seealso marker="kernel:inet#gethostbyname/1"> + inet:gethostbyname/1</seealso> will be used instead</p> + <p>This callback may also return the port of the given node. In that case + <seealso marker="kernel:erl_epmd#port_please/3">port_please/3</seealso> + may be omitted.</p></item> + </taglist> + </section> +</chapter> diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index c790872fe4..e6c9905039 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -429,7 +429,7 @@ <taglist> <tag>Return types for driver callbacks</tag> <item> - <p>Rrewrite driver callback + <p>Rewrite driver callback <seealso marker="driver_entry#control"><c>control</c></seealso> to use return type <c>ErlDrvSSizeT</c> instead of <c>int</c>.</p> <p>Rewrite driver callback @@ -841,7 +841,7 @@ int suggested_stack_size;</code> <p>Thread options structure passed to <seealso marker="#erl_drv_thread_create"> <c>erl_drv_thread_create</c></seealso>. - The following fields exists:</p> + The following field exists:</p> <taglist> <tag><c>suggested_stack_size</c></tag> <item>A suggestion, in kilowords, on how large a stack to use. @@ -3220,6 +3220,6 @@ erl_drv_output_term(driver_mk_port(drvport), spec, sizeof(spec) / sizeof(spec[0] <seealso marker="erlang"><c>erlang(3)</c></seealso>, <seealso marker="kernel:erl_ddll"><c>erl_ddll(3)</c></seealso>, section <seealso marker="alt_dist">How to Implement an Alternative - Carrier for the Erlang Distribution></seealso> in the User's Guide</p> + Carrier for the Erlang Distribution</seealso> in the User's Guide</p> </section> </cref> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index f561413fab..cff56b9cb8 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -2432,6 +2432,26 @@ os_prompt%</pre> </func> <func> + <name name="is_map_key" arity="2"/> + <fsummary></fsummary> + <desc> + <p>Returns <c>true</c> if map <c><anno>Map</anno></c> contains + <c><anno>Key</anno></c> and returns <c>false</c> if it does not + contain the <c><anno>Key</anno></c>.</p> + <p>The call fails with a <c>{badmap,Map}</c> exception if + <c><anno>Map</anno></c> is not a map.</p> + <p><em>Example:</em></p> + <code type="none"> +> Map = #{"42" => value}. +#{"42" => value} +> is_map_key("42",Map). +true +> is_map_key(value,Map). +false</code> + </desc> + </func> + + <func> <name name="is_number" arity="1"/> <fsummary>Check whether a term is a number.</fsummary> <desc> @@ -6985,10 +7005,47 @@ ok from other events in the system. It is only guaranteed that <c><anno>Suspendee</anno></c> <em>eventually</em> suspends (unless it - is resumed). If option <c>asynchronous</c> has <em>not</em> + is resumed). If no <c>asynchronous</c> options has been passed, the caller of <c>erlang:suspend_process/2</c> is blocked until <c><anno>Suspendee</anno></c> has suspended.</p> </item> + <tag><c>{asynchronous, ReplyTag}</c></tag> + <item> + <p>A suspend request is sent to the process identified by + <c><anno>Suspendee</anno></c>. When the suspend request + has been processed, a reply message is sent to the caller + of this function. The reply is on the form <c>{ReplyTag, + State}</c> where <c>State</c> is either:</p> + <taglist> + <tag><c>exited</c></tag> + <item> + <p> + <c><anno>Suspendee</anno></c> has exited. + </p> + </item> + <tag><c>suspended</c></tag> + <item> + <p> + <c><anno>Suspendee</anno></c> is now suspended. + </p> + </item> + <tag><c>not_suspended</c></tag> + <item> + <p> + <c><anno>Suspendee</anno></c> is not suspended. + This can only happen when the process that + issued this request, have called + <c>resume_process(<anno>Suspendee</anno>)</c> + before getting the reply. + </p> + </item> + </taglist> + <p> + Appart from the reply message, the <c>{asynchronous, + ReplyTag}</c> option behaves exactly the same as the + <c>asynchronous</c> option without reply tag. + </p> + </item> <tag><c>unless_suspending</c></tag> <item> <p>The process identified by <c><anno>Suspendee</anno></c> is @@ -7012,6 +7069,13 @@ ok <warning> <p>This BIF is intended for debugging only.</p> </warning> + <warning> + <p>You can easily create deadlocks if processes suspends + each other (directly or in circles). In ERTS versions prior + to ERTS version 10.0, the runtime system prevented such + deadlocks, but this prevention has now been removed due + to performance reasons.</p> + </warning> <p>Failures:</p> <taglist> <tag><c>badarg</c></tag> diff --git a/erts/doc/src/match_spec.xml b/erts/doc/src/match_spec.xml index 888366b239..46a3daebe8 100644 --- a/erts/doc/src/match_spec.xml +++ b/erts/doc/src/match_spec.xml @@ -86,12 +86,12 @@ <c><![CDATA[is_list]]></c> | <c><![CDATA[is_number]]></c> | <c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> | <c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> | - <c><![CDATA[is_map]]></c> | <c><![CDATA[is_binary]]></c> | - <c><![CDATA[is_function]]></c> | <c><![CDATA[is_record]]></c> | - <c><![CDATA[is_seq_trace]]></c> | <c><![CDATA['and']]></c> | - <c><![CDATA['or']]></c> | <c><![CDATA['not']]></c> | - <c><![CDATA['xor']]></c> | <c><![CDATA['andalso']]></c> | - <c><![CDATA['orelse']]></c> + <c><![CDATA[is_map]]></c> | <c><![CDATA[is_map_key]]></c> | + <c><![CDATA[is_binary]]></c> | <c><![CDATA[is_function]]></c> | + <c><![CDATA[is_record]]></c> | <c><![CDATA[is_seq_trace]]></c> | + <c><![CDATA['and']]></c> | <c><![CDATA['or']]></c> | + <c><![CDATA['not']]></c> | <c><![CDATA['xor']]></c> | + <c><![CDATA['andalso']]></c> | <c><![CDATA['orelse']]></c> </item> <item>ConditionExpression ::= ExprMatchVariable | { GuardFunction } | { GuardFunction, ConditionExpression, ... } | TermConstruct @@ -168,11 +168,12 @@ <c><![CDATA[is_list]]></c> | <c><![CDATA[is_number]]></c> | <c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> | <c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> | - <c><![CDATA[is_map]]></c> | <c><![CDATA[is_binary]]></c> | - <c><![CDATA[is_function]]></c> | <c><![CDATA[is_record]]></c> | - <c><![CDATA['and']]></c> | <c><![CDATA['or']]></c> | - <c><![CDATA['not']]></c> | <c><![CDATA['xor']]></c> | - <c><![CDATA['andalso']]></c> | <c><![CDATA['orelse']]></c> + <c><![CDATA[is_map]]></c> | <c><![CDATA[map_is_key]]></c> | + <c><![CDATA[is_binary]]></c> | <c><![CDATA[is_function]]></c> | + <c><![CDATA[is_record]]></c> | <c><![CDATA['and']]></c> | + <c><![CDATA['or']]></c> | <c><![CDATA['not']]></c> | + <c><![CDATA['xor']]></c> | <c><![CDATA['andalso']]></c> | + <c><![CDATA['orelse']]></c> </item> <item>ConditionExpression ::= ExprMatchVariable | { GuardFunction } | { GuardFunction, ConditionExpression, ... } | TermConstruct diff --git a/erts/doc/src/part.xml b/erts/doc/src/part.xml index d583b873a0..fc39cb30e6 100644 --- a/erts/doc/src/part.xml +++ b/erts/doc/src/part.xml @@ -37,6 +37,7 @@ <xi:include href="match_spec.xml"/> <xi:include href="crash_dump.xml"/> <xi:include href="alt_dist.xml"/> + <xi:include href="alt_disco.xml"/> <xi:include href="absform.xml"/> <xi:include href="tty.xml"/> <xi:include href="driver.xml"/> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 5dfa60ee74..221cf84622 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -570,7 +570,7 @@ $(TTF_DIR)/OPCODES-GENERATED: $(OPCODE_TABLES) utils/beam_makeops -code-model @CODE_MODEL@ \ -outdir $(TTF_DIR) \ -DUSE_VM_PROBES=$(if $(USE_VM_PROBES),1,0) \ - -DNO_FPE_SIGNALS=$(if $filter(unreliable,$(FPE)),1,0) \ + -DNO_FPE_SIGNALS=$(if $(filter unreliable,$(FPE)),1,0) \ -emulator $(OPCODE_TABLES) && echo $? >$(TTF_DIR)/OPCODES-GENERATED GENERATE += $(TTF_DIR)/OPCODES-GENERATED diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index fba0611042..45b7540aeb 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -142,6 +142,7 @@ atom bsr atom bsr_anycrlf atom bsr_unicode atom build_type +atom busy atom busy_dist_port atom busy_port atom call @@ -252,6 +253,7 @@ atom exception_from atom exception_trace atom exclusive atom exit_status +atom exited atom existing atom existing_processes atom existing_ports @@ -445,6 +447,7 @@ atom no_float atom no_integer atom no_network atom no_start_optimize +atom not_suspended atom not atom not_a_list atom not_loaded diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index d9312f4df8..a0dbd9ec7b 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -603,8 +603,9 @@ badarg: BIF_RETTYPE erts_internal_check_dirty_process_code_2(BIF_ALIST_2) { + erts_aint32_t state; Process *rp; - int reds = 0; + int dirty, busy, reds = 0; Eterm res; if (BIF_P != erts_dirty_process_signal_handler @@ -618,20 +619,29 @@ BIF_RETTYPE erts_internal_check_dirty_process_code_2(BIF_ALIST_2) if (is_not_atom(BIF_ARG_2)) BIF_ERROR(BIF_P, BADARG); - rp = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN, - BIF_ARG_1, ERTS_PROC_LOCK_MAIN); - if (rp == ERTS_PROC_LOCK_BUSY) - ERTS_BIF_YIELD2(bif_export[BIF_erts_internal_check_dirty_process_code_2], - BIF_P, BIF_ARG_1, BIF_ARG_2); + if (BIF_ARG_1 == BIF_P->common.id) + BIF_RET(am_normal); + + rp = erts_proc_lookup_raw(BIF_ARG_1); if (!rp) - BIF_RET(am_false); - + BIF_RET(am_false); + + state = erts_atomic32_read_nob(&rp->state); + dirty = (state & (ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_DIRTY_RUNNING_SYS)); + if (!dirty) + BIF_RET(am_normal); + + busy = erts_proc_trylock(rp, ERTS_PROC_LOCK_MAIN) == EBUSY; + + if (busy) + BIF_RET(am_busy); + res = erts_check_process_code(rp, BIF_ARG_2, &reds, BIF_P->fcalls); - if (BIF_P != rp) - erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); + erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); - ASSERT(is_value(res)); + ASSERT(res == am_true || res == am_false); BIF_RET2(res, reds); } diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index ee287243a4..ab5920a67e 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1166,6 +1166,9 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp) reds_used = treds > INT_MAX ? INT_MAX : (int) treds; } + if (c_p && ERTS_PROC_GET_PENDING_SUSPEND(c_p)) + erts_proc_sig_handle_pending_suspend(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_UNREQ_PROC_MAIN_LOCK(c_p); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 79244b8544..97e1ee1286 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1364,13 +1364,14 @@ BIF_RETTYPE exit_signal_2(BIF_ALIST_2) /* Handle flags common to both process_flag_2 and process_flag_3. */ -static BIF_RETTYPE process_flag_aux(Process *BIF_P, - Process *rp, - Eterm flag, - Eterm val) +static Eterm process_flag_aux(Process *c_p, int *redsp, Eterm flag, Eterm val) { Eterm old_value = NIL; /* shut up warning about use before set */ Sint i; + + if (redsp) + *redsp = 1; + if (flag == am_save_calls) { struct saved_calls *scb; if (!is_small(val)) @@ -1390,30 +1391,89 @@ static BIF_RETTYPE process_flag_aux(Process *BIF_P, } #ifdef HIPE - if (rp->flags & F_HIPE_MODE) { - ASSERT(!ERTS_PROC_GET_SAVED_CALLS_BUF(rp)); - scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(rp, scb); + if (c_p->flags & F_HIPE_MODE) { + ASSERT(!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)); + scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(c_p, scb); } else #endif { #ifdef HIPE - ASSERT(!ERTS_PROC_GET_SUSPENDED_SAVED_CALLS_BUF(rp)); + ASSERT(!ERTS_PROC_GET_SUSPENDED_SAVED_CALLS_BUF(c_p)); #endif - scb = ERTS_PROC_SET_SAVED_CALLS_BUF(rp, scb); - if (rp == BIF_P && ((scb && i == 0) || (!scb && i != 0))) { - /* Adjust fcalls to match save calls setting... */ - if (i == 0) - BIF_P->fcalls += CONTEXT_REDS; /* disabled it */ - else - BIF_P->fcalls -= CONTEXT_REDS; /* enabled it */ - - /* - * Make sure we reschedule immediately so the - * change take effect at once. - */ - ERTS_VBUMP_ALL_REDS(BIF_P); - } + scb = ERTS_PROC_SET_SAVED_CALLS_BUF(c_p, scb); + + if (((scb && i == 0) || (!scb && i != 0))) { + + /* + * Make sure we reschedule immediately so the + * change take effect at once. + */ + if (!redsp) { + /* Executed via BIF call.. */ + via_bif: + + /* Adjust fcalls to match save calls setting... */ + if (i == 0) + c_p->fcalls += CONTEXT_REDS; /* disabled it */ + else + c_p->fcalls -= CONTEXT_REDS; /* enabled it */ + + ERTS_VBUMP_ALL_REDS(c_p); + } + else { + erts_aint32_t state; + /* + * Executed via signal handler. Try to figure + * out in what context we are executing... + */ + + state = erts_atomic32_read_nob(&c_p->state); + if (state & (ERTS_PSFLG_RUNNING_SYS + | ERTS_PSFLG_DIRTY_RUNNING_SYS + | ERTS_PSFLG_DIRTY_RUNNING)) { + /* + * We are either processing signals before + * being executed or executing dirty. That + * is, no need to adjust anything... + */ + *redsp = 1; + } + else { + ErtsSchedulerData *esdp; + ASSERT(state & ERTS_PSFLG_RUNNING); + + /* + * F_DELAY_GC is currently only set when + * we handle signals in state running via + * receive helper... + */ + + if (!(c_p->flags & F_DELAY_GC)) { + *redsp = 1; + goto via_bif; + } + + /* + * Executing via receive helper... + * + * We utilize the virtual reds counter + * in order to get correct calculation + * of reductions consumed when scheduling + * out the process... + */ + + esdp = erts_get_scheduler_data(); + + if (i == 0) + esdp->virtual_reds += CONTEXT_REDS; /* disabled it */ + else + esdp->virtual_reds -= CONTEXT_REDS; /* enabled it */ + + *redsp = -1; + } + } + } } if (!scb) @@ -1423,11 +1483,12 @@ static BIF_RETTYPE process_flag_aux(Process *BIF_P, erts_free(ERTS_ALC_T_CALLS_BUF, (void *) scb); } - BIF_RET(old_value); + ASSERT(is_immed(old_value)); + return old_value; } error: - BIF_ERROR(BIF_P, BADARG); + return am_badarg; } BIF_RETTYPE process_flag_2(BIF_ALIST_2) @@ -1596,29 +1657,73 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2) /* Fall through and try process_flag_aux() ... */ } - BIF_RET(process_flag_aux(BIF_P, BIF_P, BIF_ARG_1, BIF_ARG_2)); + old_value = process_flag_aux(BIF_P, NULL, BIF_ARG_1, BIF_ARG_2); + if (old_value != am_badarg) + BIF_RET(old_value); error: BIF_ERROR(BIF_P, BADARG); } -BIF_RETTYPE process_flag_3(BIF_ALIST_3) +typedef struct { + Eterm flag; + Eterm value; + ErlOffHeap oh; + Eterm heap[1]; +} ErtsProcessFlag3Args; + +static Eterm +exec_process_flag_3(Process *c_p, void *arg, int *redsp, ErlHeapFragment **bpp) { - Process *rp; - Eterm res; + ErtsProcessFlag3Args *pf3a = arg; + Eterm res; + + if (ERTS_PROC_IS_EXITING(c_p)) + res = am_badarg; + else + res = process_flag_aux(c_p, redsp, pf3a->flag, pf3a->value); + erts_cleanup_offheap(&pf3a->oh); + erts_free(ERTS_ALC_T_PF3_ARGS, arg); + return res; +} + + +BIF_RETTYPE erts_internal_process_flag_3(BIF_ALIST_3) +{ + Eterm res, *hp; + ErlOffHeap *ohp; + ErtsProcessFlag3Args *pf3a; + Uint flag_sz, value_sz; + + if (BIF_P->common.id == BIF_ARG_1) { + res = process_flag_aux(BIF_P, NULL, BIF_ARG_2, BIF_ARG_3); + BIF_RET(res); + } + + if (is_not_internal_pid(BIF_ARG_1)) + BIF_RET(am_badarg); + + flag_sz = is_immed(BIF_ARG_2) ? 0 : size_object(BIF_ARG_2); + value_sz = is_immed(BIF_ARG_3) ? 0 : size_object(BIF_ARG_3); + + pf3a = erts_alloc(ERTS_ALC_T_PF3_ARGS, + sizeof(ErtsProcessFlag3Args) + + sizeof(Eterm)*(flag_sz+value_sz-1)); + + ohp = &pf3a->oh; + ERTS_INIT_OFF_HEAP(&pf3a->oh); - rp = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN, - BIF_ARG_1, ERTS_PROC_LOCK_MAIN); - if (rp == ERTS_PROC_LOCK_BUSY) - ERTS_BIF_YIELD3(bif_export[BIF_process_flag_3], BIF_P, - BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + hp = &pf3a->heap[0]; - if (!rp) - BIF_ERROR(BIF_P, BADARG); + pf3a->flag = copy_struct(BIF_ARG_2, flag_sz, &hp, ohp); + pf3a->value = copy_struct(BIF_ARG_3, value_sz, &hp, ohp); - res = process_flag_aux(BIF_P, rp, BIF_ARG_2, BIF_ARG_3); + res = erts_proc_sig_send_rpc_request(BIF_P, BIF_ARG_1, + !0, + exec_process_flag_3, + (void *) pf3a); - if (rp != BIF_P) - erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); + if (is_non_value(res)) + BIF_RET(am_badarg); return res; } diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index a47339253e..cf9f61c0b8 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -295,6 +295,19 @@ do { \ (Ret) = THE_NON_VALUE; \ } while (0) +#define ERTS_BIF_PREP_TRAP4(Ret, Trap, Proc, A0, A1, A2, A3) \ +do { \ + Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \ + (Proc)->arity = 4; \ + reg[0] = (Eterm) (A0); \ + reg[1] = (Eterm) (A1); \ + reg[2] = (Eterm) (A2); \ + reg[3] = (Eterm) (A3); \ + (Proc)->i = (BeamInstr*) ((Trap)->addressv[erts_active_code_ix()]); \ + (Proc)->freason = TRAP; \ + (Ret) = THE_NON_VALUE; \ +} while (0) + #define ERTS_BIF_PREP_TRAP3_NO_RET(Trap, Proc, A0, A1, A2)\ do { \ Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \ @@ -343,6 +356,18 @@ do { \ return THE_NON_VALUE; \ } while(0) +#define BIF_TRAP4(Trap_, p, A0, A1, A2, A3) do { \ + Eterm* reg = erts_proc_sched_data((p))->x_reg_array; \ + (p)->arity = 4; \ + reg[0] = (A0); \ + reg[1] = (A1); \ + reg[2] = (A2); \ + reg[3] = (A3); \ + (p)->i = (BeamInstr*) ((Trap_)->addressv[erts_active_code_ix()]); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ + } while(0) + #define BIF_TRAP_CODE_PTR_0(p, Code_) do { \ (p)->arity = 0; \ (p)->i = (BeamInstr*) (Code_); \ @@ -401,6 +426,12 @@ do { \ ERTS_BIF_PREP_TRAP3(RET, (TRP), (P), (A0), (A1), (A2)); \ } while (0) +#define ERTS_BIF_PREP_YIELD4(RET, TRP, P, A0, A1, A2, A3) \ +do { \ + ERTS_VBUMP_ALL_REDS((P)); \ + ERTS_BIF_PREP_TRAP4(RET, (TRP), (P), (A0), (A1), (A2), (A3)); \ +} while (0) + #define ERTS_BIF_YIELD0(TRP, P) \ do { \ ERTS_VBUMP_ALL_REDS((P)); \ @@ -425,6 +456,12 @@ do { \ BIF_TRAP3((TRP), (P), (A0), (A1), (A2)); \ } while (0) +#define ERTS_BIF_YIELD4(TRP, P, A0, A1, A2, A3) \ +do { \ + ERTS_VBUMP_ALL_REDS((P)); \ + BIF_TRAP4((TRP), (P), (A0), (A1), (A2), (A3)); \ +} while (0) + #define ERTS_BIF_PREP_EXITED(RET, PROC) \ do { \ KILL_CATCHES((PROC)); \ diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 276bef2bbb..7548924178 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -125,7 +125,7 @@ bif erlang:pid_to_list/1 bif erlang:ports/0 bif erlang:pre_loaded/0 bif erlang:process_flag/2 -bif erlang:process_flag/3 +bif erts_internal:process_flag/3 bif erlang:process_info/1 bif erlang:process_info/2 bif erlang:processes/0 @@ -154,7 +154,6 @@ bif erlang:unregister/1 bif erlang:whereis/1 bif erlang:spawn_opt/1 bif erlang:setnode/2 -bif erlang:setnode/3 bif erlang:dist_get_stat/1 bif erlang:dist_ctrl_input_handler/2 bif erlang:dist_ctrl_put_data/2 @@ -191,6 +190,8 @@ bif erts_internal:scheduler_wall_time/1 bif erts_internal:dirty_process_handle_signals/1 +bif erts_internal:create_dist_channel/4 + # inet_db support bif erlang:port_set_data/2 bif erlang:port_get_data/1 @@ -204,9 +205,9 @@ bif erlang:seq_trace/2 bif erlang:seq_trace_info/1 bif erlang:seq_trace_print/1 bif erlang:seq_trace_print/2 -bif erlang:suspend_process/2 +bif erts_internal:suspend_process/2 bif erlang:resume_process/1 -bif erlang:process_display/2 +bif erts_internal:process_display/2 bif erlang:bump_reductions/1 @@ -341,7 +342,6 @@ bif ets:internal_request_all/0 bif ets:new/2 bif ets:delete/1 bif ets:delete/2 -bif ets:delete_all_objects/1 bif ets:delete_object/2 bif ets:first/1 bif ets:is_compiled_ms/1 @@ -372,7 +372,6 @@ bif ets:select_count/2 bif ets:select_reverse/1 bif ets:select_reverse/2 bif ets:select_reverse/3 -bif ets:select_delete/2 bif ets:select_replace/2 bif ets:match_spec_compile/1 bif ets:match_spec_run_r/3 @@ -696,3 +695,6 @@ bif ets:whereis/1 bif erts_internal:gather_alloc_histograms/1 bif erts_internal:gather_carrier_info/1 ubif erlang:map_get/2 +ubif erlang:is_map_key/2 +bif ets:internal_delete_all/2 +bif ets:internal_select_delete/2 diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 026f0a62d4..70474898b2 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -3138,60 +3138,60 @@ BIF_RETTYPE setnode_2(BIF_ALIST_2) BIF_ERROR(BIF_P, BADARG); } -/********************************************************************** - ** Allocate a dist entry, set node name install the connection handler - ** setnode_3({name@host, Creation}, Cid, {Type, Version, Initial, IC, OC}) - ** Type = flag field, where the flags are specified in dist.h - ** Version = distribution version, >= 1 - ** IC = in_cookie (ignored) - ** OC = out_cookie (ignored) - ** - ** Note that in distribution protocols above 1, the Initial parameter - ** is always NIL and the cookies are always the atom '', cookies are not - ** sent in the distribution messages but are only used in - ** the handshake. - ** - ***********************************************************************/ +/* + * erts_internal:create_dist_channel/4 is used by + * erlang:setnode/3. + */ + +typedef struct { + DistEntry *dep; + Uint flags; + Uint version; +} ErtsSetupConnDistCtrl; + +static void +setup_connection_epiloge_rwunlock(Process *c_p, DistEntry *dep, + Eterm ctrlr, Uint flags, + Uint version); -BIF_RETTYPE setnode_3(BIF_ALIST_3) +static Eterm +setup_connection_distctrl(Process *c_p, void *arg, + int *redsp, ErlHeapFragment **bpp); + +BIF_RETTYPE erts_internal_create_dist_channel_4(BIF_ALIST_4) { BIF_RETTYPE ret; Uint flags; - unsigned long version; - Eterm ic, oc; - Eterm *tp; + Uint version; + Eterm *hp, res_tag = THE_NON_VALUE, res = THE_NON_VALUE; DistEntry *dep = NULL; - ErtsProcLocks proc_unlock = 0; - Process *proc; + int de_locked = 0; Port *pp = NULL; - Eterm notify_proc; - erts_aint32_t qflgs; /* * Check and pick out arguments */ - if (!is_node_name_atom(BIF_ARG_1) || - !(is_internal_port(BIF_ARG_2) - || is_internal_pid(BIF_ARG_2)) - || (erts_this_node->sysname == am_Noname)) { - goto badarg; - } + /* Node name... */ + if (!is_node_name_atom(BIF_ARG_1)) + goto badarg; - if (!is_tuple(BIF_ARG_3)) - goto badarg; - tp = tuple_val(BIF_ARG_3); - if (*tp++ != make_arityval(4)) - goto badarg; - if (!is_small(*tp)) - goto badarg; - flags = unsigned_val(*tp++); - if (!is_small(*tp) || (version = unsigned_val(*tp)) == 0) - goto badarg; - ic = *(++tp); - oc = *(++tp); - if (!is_atom(ic) || !is_atom(oc)) - goto badarg; + /* Distribution controller... */ + if (!is_internal_port(BIF_ARG_2) && !is_internal_pid(BIF_ARG_2)) + goto badarg; + + /* Dist flags... */ + if (!is_small(BIF_ARG_3)) + goto badarg; + flags = unsigned_val(BIF_ARG_3); + + /* Version... */ + if (!is_small(BIF_ARG_4)) + goto badarg; + version = unsigned_val(BIF_ARG_4); + + if (version == 0) + goto badarg; if (~flags & DFLAG_DIST_MANDATORY) { erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); @@ -3222,74 +3222,79 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) else if (!dep) goto system_limit; /* Should never happen!!! */ + erts_de_rlock(dep); + de_locked = -1; + + if (dep->state == ERTS_DE_STATE_EXITING) { + /* Suspend on dist entry waiting for the exit to finish */ + ErtsProcList *plp = erts_proclist_create(BIF_P); + plp->next = NULL; + erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL); + erts_mtx_lock(&dep->qlock); + erts_proclist_store_last(&dep->suspended, plp); + erts_mtx_unlock(&dep->qlock); + goto yield; + } + + erts_de_runlock(dep); + de_locked = 0; + if (is_internal_pid(BIF_ARG_2)) { if (BIF_P->common.id == BIF_ARG_2) { - proc_unlock = 0; - proc = BIF_P; - } - else { - proc_unlock = ERTS_PROC_LOCK_MAIN; - proc = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN, - BIF_ARG_2, proc_unlock); - } - erts_de_rwlock(dep); - - if (!proc) - goto badarg; - else if (proc == ERTS_PROC_LOCK_BUSY) { - proc_unlock = 0; - goto yield; - } + ErtsSetupConnDistCtrl scdc; - erts_proc_lock(proc, ERTS_PROC_LOCK_STATUS); - proc_unlock |= ERTS_PROC_LOCK_STATUS; + scdc.dep = dep; + scdc.flags = flags; + scdc.version = version; - if (ERTS_PROC_GET_DIST_ENTRY(proc)) { - if (dep == ERTS_PROC_GET_DIST_ENTRY(proc) - && (proc->flags & F_DISTRIBUTION) - && dep->cid == BIF_ARG_2) { - ERTS_BIF_PREP_RET(ret, erts_make_dhandle(BIF_P, dep)); - goto done; - } - goto badarg; - } + res = setup_connection_distctrl(BIF_P, &scdc, NULL, NULL); + BUMP_REDS(BIF_P, 5); + dep = NULL; - if (dep->state == ERTS_DE_STATE_EXITING) { - /* Suspend on dist entry waiting for the exit to finish */ - ErtsProcList *plp = erts_proclist_create(BIF_P); - plp->next = NULL; - erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL); - erts_mtx_lock(&dep->qlock); - erts_proclist_store_last(&dep->suspended, plp); - erts_mtx_unlock(&dep->qlock); - goto yield; - } - if (dep->state != ERTS_DE_STATE_PENDING) { - if (dep->state == ERTS_DE_STATE_IDLE) - erts_set_dist_entry_pending(dep); - else + if (res == am_badarg) goto badarg; + + ASSERT(is_internal_magic_ref(res)); + res_tag = am_ok; /* Connection up */ } + else { + ErtsSetupConnDistCtrl *scdcp; - if (is_not_nil(dep->cid)) - goto badarg; + scdcp = erts_alloc(ERTS_ALC_T_SETUP_CONN_ARG, + sizeof(ErtsSetupConnDistCtrl)); - proc->flags |= F_DISTRIBUTION; - ERTS_PROC_SET_DIST_ENTRY(proc, dep); + scdcp->dep = dep; + scdcp->flags = flags; + scdcp->version = version; - proc_unlock &= ~ERTS_PROC_LOCK_STATUS; - erts_proc_unlock(proc, ERTS_PROC_LOCK_STATUS); + res = erts_proc_sig_send_rpc_request(BIF_P, + BIF_ARG_2, + !0, + setup_connection_distctrl, + (void *) scdcp); + if (is_non_value(res)) + goto badarg; - dep->send = NULL; /* Only for distr ports... */ + dep = NULL; + ASSERT(is_internal_ordinary_ref(res)); + + res_tag = am_message; /* Caller need to wait for dhandle in message */ + } + hp = HAlloc(BIF_P, 3); } else { + int new; pp = erts_id2port_sflgs(BIF_ARG_2, BIF_P, ERTS_PROC_LOCK_MAIN, ERTS_PORT_SFLGS_INVALID_LOOKUP); erts_de_rwlock(dep); + de_locked = 1; + + if (dep->state == ERTS_DE_STATE_EXITING) + goto badarg; if (!pp || (erts_atomic32_read_nob(&pp->state) & ERTS_PORT_SFLG_EXITING)) @@ -3298,65 +3303,108 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) if ((pp->drv_ptr->flags & ERL_DRV_FLAG_SOFT_BUSY) == 0) goto badarg; - if (dep->cid == BIF_ARG_2 && pp->dist_entry == dep) { - ERTS_BIF_PREP_RET(ret, erts_make_dhandle(BIF_P, dep)); - goto done; /* Already set */ - } + if (dep->cid == BIF_ARG_2 && pp->dist_entry == dep) + new = 0; + else { + if (dep->state != ERTS_DE_STATE_PENDING) { + if (dep->state == ERTS_DE_STATE_IDLE) + erts_set_dist_entry_pending(dep); + else + goto badarg; + } - if (dep->state == ERTS_DE_STATE_EXITING) { - /* Suspend on dist entry waiting for the exit to finish */ - ErtsProcList *plp = erts_proclist_create(BIF_P); - plp->next = NULL; - erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL); - erts_mtx_lock(&dep->qlock); - erts_proclist_store_last(&dep->suspended, plp); - erts_mtx_unlock(&dep->qlock); - goto yield; - } - if (dep->state != ERTS_DE_STATE_PENDING) { - if (dep->state == ERTS_DE_STATE_IDLE) - erts_set_dist_entry_pending(dep); - else + if (pp->dist_entry || is_not_nil(dep->cid)) goto badarg; - } - if (pp->dist_entry || is_not_nil(dep->cid)) - goto badarg; + erts_atomic32_read_bor_nob(&pp->state, ERTS_PORT_SFLG_DISTRIBUTION); - erts_atomic32_read_bor_nob(&pp->state, ERTS_PORT_SFLG_DISTRIBUTION); + pp->dist_entry = dep; - pp->dist_entry = dep; + ASSERT(pp->drv_ptr->outputv || pp->drv_ptr->output); - ASSERT(pp->drv_ptr->outputv || pp->drv_ptr->output); + dep->send = (pp->drv_ptr->outputv + ? dist_port_commandv + : dist_port_command); + ASSERT(dep->send); - dep->send = (pp->drv_ptr->outputv - ? dist_port_commandv - : dist_port_command); - ASSERT(dep->send); + /* + * Dist-ports do not use the "busy port message queue" functionality, but + * instead use "busy dist entry" functionality. + */ + { + ErlDrvSizeT disable = ERL_DRV_BUSY_MSGQ_DISABLED; + erl_drv_busy_msgq_limits(ERTS_Port2ErlDrvPort(pp), &disable, NULL); + } - /* - * Dist-ports do not use the "busy port message queue" functionality, but - * instead use "busy dist entry" functionality. - */ - { - ErlDrvSizeT disable = ERL_DRV_BUSY_MSGQ_DISABLED; - erl_drv_busy_msgq_limits(ERTS_Port2ErlDrvPort(pp), &disable, NULL); + setup_connection_epiloge_rwunlock(BIF_P, dep, BIF_ARG_2, flags, version); + de_locked = 0; + new = !0; } + hp = HAlloc(BIF_P, 3 + ERTS_MAGIC_REF_THING_SIZE); + res = erts_build_dhandle(&hp, &BIF_P->off_heap, dep); + res_tag = am_ok; /* Connection up */ + if (new) + dep = NULL; /* inc of refc transferred to port (dist_entry field) */ + } + + ASSERT(is_value(res) && is_value(res_tag)); + + res = TUPLE2(hp, res_tag, res); + + ERTS_BIF_PREP_RET(ret, res); + + done: + + if (dep && dep != erts_this_dist_entry) { + if (de_locked) { + if (de_locked > 0) + erts_de_rwunlock(dep); + else + erts_de_runlock(dep); + } + erts_deref_dist_entry(dep); } + if (pp) + erts_port_release(pp); + + return ret; + + yield: + ERTS_BIF_PREP_YIELD4(ret, + bif_export[BIF_erts_internal_create_dist_channel_4], + BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, BIF_ARG_4); + goto done; + + badarg: + ERTS_BIF_PREP_RET(ret, am_badarg); + goto done; + + system_limit: + ERTS_BIF_PREP_RET(ret, am_system_limit); + goto done; +} + +static void +setup_connection_epiloge_rwunlock(Process *c_p, DistEntry *dep, + Eterm ctrlr, Uint flags, + Uint version) +{ + Eterm notify_proc = NIL; + erts_aint32_t qflgs; + dep->version = version; dep->creation = 0; -#ifdef DEBUG + ASSERT(is_internal_port(ctrlr) || is_internal_pid(ctrlr)); ASSERT(erts_atomic_read_nob(&dep->qsize) == 0 || (dep->state == ERTS_DE_STATE_PENDING)); -#endif if (flags & DFLAG_DIST_HDR_ATOM_CACHE) create_cache(dep); - erts_set_dist_entry_connected(dep, BIF_ARG_2, flags); + erts_set_dist_entry_connected(dep, ctrlr, flags); notify_proc = NIL; if (erts_atomic_read_nob(&dep->qsize)) { @@ -3375,50 +3423,100 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) } } } - erts_de_rwunlock(dep); - if (is_internal_pid(notify_proc)) - notify_dist_data(BIF_P, notify_proc); - ERTS_BIF_PREP_RET(ret, erts_make_dhandle(BIF_P, dep)); + erts_de_rwunlock(dep); - dep = NULL; /* inc of refc transferred to port (dist_entry field) */ + if (is_internal_pid(notify_proc)) + notify_dist_data(c_p, notify_proc); inc_no_nodes(); - send_nodes_mon_msgs(BIF_P, + send_nodes_mon_msgs(c_p, am_nodeup, - BIF_ARG_1, + dep->sysname, flags & DFLAG_PUBLISHED ? am_visible : am_hidden, NIL); - done: +} - if (dep && dep != erts_this_dist_entry) { - erts_de_rwunlock(dep); - erts_deref_dist_entry(dep); +static Eterm +setup_connection_distctrl(Process *c_p, void *arg, int *redsp, ErlHeapFragment **bpp) +{ + ErtsSetupConnDistCtrl *scdcp = (ErtsSetupConnDistCtrl *) arg; + DistEntry *dep = scdcp->dep; + int dep_locked = 0; + Eterm *hp; + erts_aint32_t state; + + if (redsp) + *redsp = 1; + + state = erts_atomic32_read_nob(&c_p->state); + + if (state & ERTS_PSFLG_EXITING) + goto badarg; + + erts_de_rwlock(dep); + dep_locked = !0; + + if (dep->state == ERTS_DE_STATE_EXITING) + goto badarg; + + if (ERTS_PROC_GET_DIST_ENTRY(c_p)) { + if (dep == ERTS_PROC_GET_DIST_ENTRY(c_p) + && (c_p->flags & F_DISTRIBUTION) + && dep->cid == c_p->common.id) { + goto connected; + } + goto badarg; } - if (pp) - erts_port_release(pp); + if (dep->state != ERTS_DE_STATE_PENDING) { + if (dep->state == ERTS_DE_STATE_IDLE) + erts_set_dist_entry_pending(dep); + else + goto badarg; + } - if (proc_unlock) - erts_proc_unlock(proc, proc_unlock); + if (is_not_nil(dep->cid)) + goto badarg; - return ret; + c_p->flags |= F_DISTRIBUTION; + ERTS_PROC_SET_DIST_ENTRY(c_p, dep); - yield: - ERTS_BIF_PREP_YIELD3(ret, bif_export[BIF_setnode_3], BIF_P, - BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); - goto done; + dep->send = NULL; /* Only for distr ports... */ - badarg: - ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); - goto done; + if (redsp) + *redsp = 5; - system_limit: - ERTS_BIF_PREP_ERROR(ret, BIF_P, SYSTEM_LIMIT); - goto done; + setup_connection_epiloge_rwunlock(c_p, dep, c_p->common.id, + scdcp->flags, scdcp->version); +connected: + + /* we take over previous inc in refc of dep */ + + if (!bpp) /* called directly... */ + return erts_make_dhandle(c_p, dep); + + erts_free(ERTS_ALC_T_SETUP_CONN_ARG, arg); + + *bpp = new_message_buffer(ERTS_MAGIC_REF_THING_SIZE); + hp = (*bpp)->mem; + return erts_build_dhandle(&hp, &(*bpp)->off_heap, dep); + +badarg: + + if (bpp) /* not called directly */ + erts_free(ERTS_ALC_T_SETUP_CONN_ARG, arg); + + if (dep_locked) + erts_de_rwunlock(dep); + + erts_deref_dist_entry(dep); + + return am_badarg; } + BIF_RETTYPE erts_internal_get_dflags_0(BIF_ALIST_0) { return erts_dflags_record; diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 4a6a19b210..9db600dce0 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -287,6 +287,8 @@ type DIST_DEMONITOR SHORT_LIVED PROCESSES dist_demonitor type CML_CLEANUP SHORT_LIVED SYSTEM connection_ml_cleanup type ML_YIELD_STATE SHORT_LIVED SYSTEM monitor_link_yield_state type ML_DIST STANDARD SYSTEM monitor_link_dist +type PF3_ARGS SHORT_LIVED PROCESSES process_flag_3_arguments +type SETUP_CONN_ARG SHORT_LIVED PROCESSES setup_connection_argument type ENVIRONMENT SYSTEM SYSTEM environment @@ -346,6 +348,7 @@ type NIF_TRAP_EXPORT STANDARD PROCESSES nif_trap_export_entry type NIF_EXP_TRACE FIXED_SIZE PROCESSES nif_export_trace type EXPORT LONG_LIVED CODE export_entry type MONITOR FIXED_SIZE PROCESSES monitor +type MONITOR_SUSPEND STANDARD PROCESSES monitor_suspend type LINK FIXED_SIZE PROCESSES link type AINFO_REQ SHORT_LIVED SYSTEM alloc_info_request type SCHED_WTIME_REQ SHORT_LIVED SYSTEM sched_wall_time_request diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 6f9e507228..8b2b1a58c7 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -617,17 +617,13 @@ static void collect_one_target_monitor(ErtsMonitor *mon, void *vmicp) } typedef struct { - Process *c_p; - ErtsProcLocks c_p_locks; ErtsMonitorSuspend **smi; Uint smi_i; Uint smi_max; - int sz; + Uint sz; } ErtsSuspendMonitorInfoCollection; -#define ERTS_INIT_SUSPEND_MONITOR_INFOS(SMIC, CP, CPL) do { \ - (SMIC).c_p = (CP); \ - (SMIC).c_p_locks = (CPL); \ +#define ERTS_INIT_SUSPEND_MONITOR_INFOS(SMIC) do { \ (SMIC).smi = NULL; \ (SMIC).smi_i = (SMIC).smi_max = 0; \ (SMIC).sz = 0; \ @@ -660,34 +656,26 @@ do { \ static void collect_one_suspend_monitor(ErtsMonitor *mon, void *vsmicp) { - ErtsMonitorSuspend *smon = erts_monitor_suspend(mon); - ErtsSuspendMonitorInfoCollection *smicp = vsmicp; - Process *suspendee = erts_pid2proc(smicp->c_p, - smicp->c_p_locks, - mon->other.item, - 0); - if (suspendee) { /* suspendee is alive */ - Sint a, p; - if (smon->active) { - smon->active += smon->pending; - smon->pending = 0; - } + if (mon->type == ERTS_MON_TYPE_SUSPEND) { + Sint count; + erts_aint_t mstate; + ErtsMonitorSuspend *msp; + ErtsSuspendMonitorInfoCollection *smicp; - ASSERT((smon->active && !smon->pending) - || (smon->pending && !smon->active)); + msp = (ErtsMonitorSuspend *) erts_monitor_to_data(mon); + smicp = vsmicp; ERTS_EXTEND_SUSPEND_MONITOR_INFOS(smicp); - smicp->smi[smicp->smi_i] = smon; + smicp->smi[smicp->smi_i] = msp; smicp->sz += 2 /* cons */ + 4 /* 3-tuple */; - a = (Sint) smon->active; /* quiet compiler warnings */ - p = (Sint) smon->pending; /* on 64-bit machines */ + mstate = erts_atomic_read_nob(&msp->state); - if (!IS_SSMALL(a)) - smicp->sz += BIG_UINT_HEAP_SIZE; - if (!IS_SSMALL(p)) + count = (Sint) (mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK); + if (!IS_SSMALL(count)) smicp->sz += BIG_UINT_HEAP_SIZE; + smicp->smi_i++; } } @@ -1075,8 +1063,10 @@ process_info_bif(Process *c_p, Eterm pid, Eterm opt, int always_wrap, int pi2) if (c_p->common.id == pid) { int local_only = c_p->flags & F_LOCAL_SIGS_ONLY; - int sreds = ERTS_BIF_REDS_LEFT(c_p); - int sres; + int sres, sreds, reds_left; + + reds_left = ERTS_BIF_REDS_LEFT(c_p); + sreds = reds_left; if (!local_only) { erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ); @@ -1085,15 +1075,19 @@ process_info_bif(Process *c_p, Eterm pid, Eterm opt, int always_wrap, int pi2) } sres = erts_proc_sig_handle_incoming(c_p, &state, &sreds, sreds, !0); + + BUMP_REDS(c_p, (int) sreds); + reds_left -= sreds; + if (state & ERTS_PSFLG_EXITING) { c_p->flags &= ~F_LOCAL_SIGS_ONLY; goto exited; } - if (!sres) { + if (!sres | (reds_left <= 0)) { /* - * More signals to handle; need to yield and continue. - * Prevent fetching of more signals by setting - * local-sigs-only flag. + * More signals to handle or out of reds; need + * to yield and continue. Prevent fetching of + * more signals by setting local-sigs-only flag. */ c_p->flags |= F_LOCAL_SIGS_ONLY; goto yield; @@ -1166,6 +1160,7 @@ process_info_bif(Process *c_p, Eterm pid, Eterm opt, int always_wrap, int pi2) else { if (flags & ERTS_PI_FLAG_FORCE_SIG_SEND) goto send_signal; + state = ERTS_PSFLG_RUNNING; /* fail state... */ rp = erts_try_lock_sig_free_proc(pid, locks, &state); if (!rp) goto undefined; @@ -1627,56 +1622,56 @@ process_info_aux(Process *c_p, case ERTS_PI_IX_SUSPENDING: { ErtsSuspendMonitorInfoCollection smic; int i; - Eterm item; - erts_proc_lock(rp, ERTS_PROC_LOCK_STATUS); + ERTS_INIT_SUSPEND_MONITOR_INFOS(smic); - ERTS_INIT_SUSPEND_MONITOR_INFOS(smic, - c_p, - (c_p == rp - ? ERTS_PROC_LOCK_MAIN - : 0) | ERTS_PROC_LOCK_STATUS); - - erts_monitor_tree_foreach(rp->suspend_monitors, - &collect_one_suspend_monitor, - &smic); + erts_monitor_tree_foreach(ERTS_P_MONITORS(rp), + collect_one_suspend_monitor, + (void *) &smic); reserve_size += smic.sz; res = NIL; for (i = 0; i < smic.smi_i; i++) { - Sint a = (Sint) smic.smi[i]->active; /* quiet compiler warnings */ - Sint p = (Sint) smic.smi[i]->pending; /* on 64-bit machines... */ - Eterm active; - Eterm pending; + ErtsMonitorSuspend *msp; + erts_aint_t mstate; + Sint ci; + Eterm ct, active, pending, item; Uint sz = 4 + 2; - if (!IS_SSMALL(a)) - sz += BIG_UINT_HEAP_SIZE; - if (!IS_SSMALL(p)) - sz += BIG_UINT_HEAP_SIZE; + + msp = smic.smi[i]; + mstate = erts_atomic_read_nob(&msp->state); + + ci = (Sint) (mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK); + if (!IS_SSMALL(ci)) + sz += BIG_UINT_HEAP_SIZE; ERTS_PI_UNRESERVE(reserve_size, sz); hp = erts_produce_heap(hfact, sz, reserve_size); - if (IS_SSMALL(a)) - active = make_small(a); - else { - active = small_to_big(a, hp); - hp += BIG_UINT_HEAP_SIZE; - } - if (IS_SSMALL(p)) - pending = make_small(p); - else { - pending = small_to_big(p, hp); - hp += BIG_UINT_HEAP_SIZE; - } - item = TUPLE3(hp, smic.smi[i]->mon.other.item, active, pending); + if (IS_SSMALL(ci)) + ct = make_small(ci); + else { + ct = small_to_big(ci, hp); + hp += BIG_UINT_HEAP_SIZE; + } + + if (mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE) { + active = ct; + pending = make_small(0); + } + else { + active = make_small(0); + pending = ct; + } + + ASSERT(is_internal_pid(msp->md.origin.other.item)); + + item = TUPLE3(hp, msp->md.origin.other.item, active, pending); hp += 4; res = CONS(hp, item, res); } - erts_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); - *reds += (Uint) smic.smi_i / 4; ERTS_DESTROY_SUSPEND_MONITOR_INFOS(smic); @@ -3637,26 +3632,46 @@ BIF_RETTYPE is_process_alive_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } -BIF_RETTYPE process_display_2(BIF_ALIST_2) +static Eterm +process_display(Process *c_p, void *arg, int *redsp, ErlHeapFragment **bpp) +{ + if (redsp) + *redsp = 1; + + if (ERTS_PROC_IS_EXITING(c_p)) + return am_badarg; + + erts_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + erts_stack_dump(ERTS_PRINT_STDERR, NULL, c_p); + erts_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + + return am_true; +} + + +BIF_RETTYPE erts_internal_process_display_2(BIF_ALIST_2) { - Process *rp; + Eterm res; - if (BIF_ARG_2 != am_backtrace) - BIF_ERROR(BIF_P, BADARG); + if (BIF_ARG_2 != am_backtrace) + BIF_RET(am_badarg); - rp = erts_pid2proc_nropt(BIF_P, ERTS_PROC_LOCK_MAIN, - BIF_ARG_1, ERTS_PROC_LOCKS_ALL); - if(!rp) { - BIF_ERROR(BIF_P, BADARG); - } - if (rp == ERTS_PROC_LOCK_BUSY) - ERTS_BIF_YIELD2(bif_export[BIF_process_display_2], BIF_P, - BIF_ARG_1, BIF_ARG_2); - erts_stack_dump(ERTS_PRINT_STDERR, NULL, rp); - erts_proc_unlock(rp, (BIF_P == rp - ? ERTS_PROC_LOCKS_ALL_MINOR - : ERTS_PROC_LOCKS_ALL)); - BIF_RET(am_true); + if (BIF_P->common.id == BIF_ARG_1) { + res = process_display(BIF_P, NULL, NULL, NULL); + BIF_RET(res); + } + + if (is_not_internal_pid(BIF_ARG_1)) + BIF_RET(am_badarg); + + res = erts_proc_sig_send_rpc_request(BIF_P, BIF_ARG_1, + !0, + process_display, + NULL); + if (is_non_value(res)) + BIF_RET(am_badarg); + + BIF_RET(res); } /* this is a general call which return some possibly useful information */ @@ -4597,27 +4612,6 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) BIF_RET(am_true); } } - else if (ERTS_IS_ATOM_STR("not_running_optimization", BIF_ARG_1)) { - int old_use_opt, use_opt; - switch (BIF_ARG_2) { - case am_true: - use_opt = 1; - break; - case am_false: - use_opt = 0; - break; - default: - BIF_ERROR(BIF_P, BADARG); - } - - erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); - erts_thr_progress_block(); - old_use_opt = !erts_disable_proc_not_running_opt; - erts_disable_proc_not_running_opt = !use_opt; - erts_thr_progress_unblock(); - erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); - BIF_RET(old_use_opt ? am_true : am_false); - } else if (ERTS_IS_ATOM_STR("wait", BIF_ARG_1)) { if (ERTS_IS_ATOM_STR("deallocations", BIF_ARG_2)) { int flag = ERTS_DEBUG_WAIT_COMPLETED_DEALLOCATIONS; @@ -4688,7 +4682,14 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) refbin)); } } - + else if (ERTS_IS_ATOM_STR("ets_force_trap", BIF_ARG_1)) { +#ifdef ETS_DBG_FORCE_TRAP + erts_ets_dbg_force_trap = (BIF_ARG_2 == am_true) ? 1 : 0; + BIF_RET(am_ok); +#else + BIF_RET(am_notsup); +#endif + } } BIF_ERROR(BIF_P, BADARG); diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index 1953f79d79..f9d351e69e 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -809,10 +809,129 @@ Eterm trace_info_2(BIF_ALIST_2) BIF_ERROR(p, BADARG); } erts_release_code_write_permission(); + + if (is_internal_ref(res)) + BIF_TRAP1(erts_await_result, BIF_P, res); + BIF_RET(res); } static Eterm +build_trace_flags_term(Eterm **hpp, Uint *szp, Uint trace_flags) +{ + +#define ERTS_TFLAG__(F, FN) \ + if (trace_flags & F) { \ + if (szp) \ + sz += 2; \ + if (hp) { \ + res = CONS(hp, FN, res); \ + hp += 2; \ + } \ + } + + Eterm res; + Uint sz = 0; + Eterm *hp; + + if (hpp) { + hp = *hpp; + res = NIL; + } + else { + hp = NULL; + res = THE_NON_VALUE; + } + + ERTS_TFLAG__(F_NOW_TS, am_timestamp); + ERTS_TFLAG__(F_STRICT_MON_TS, am_strict_monotonic_timestamp); + ERTS_TFLAG__(F_MON_TS, am_monotonic_timestamp); + ERTS_TFLAG__(F_TRACE_SEND, am_send); + ERTS_TFLAG__(F_TRACE_RECEIVE, am_receive); + ERTS_TFLAG__(F_TRACE_SOS, am_set_on_spawn); + ERTS_TFLAG__(F_TRACE_CALLS, am_call); + ERTS_TFLAG__(F_TRACE_PROCS, am_procs); + ERTS_TFLAG__(F_TRACE_SOS1, am_set_on_first_spawn); + ERTS_TFLAG__(F_TRACE_SOL, am_set_on_link); + ERTS_TFLAG__(F_TRACE_SOL1, am_set_on_first_link); + ERTS_TFLAG__(F_TRACE_SCHED, am_running); + ERTS_TFLAG__(F_TRACE_SCHED_EXIT, am_exiting); + ERTS_TFLAG__(F_TRACE_GC, am_garbage_collection); + ERTS_TFLAG__(F_TRACE_ARITY_ONLY, am_arity); + ERTS_TFLAG__(F_TRACE_RETURN_TO, am_return_to); + ERTS_TFLAG__(F_TRACE_SILENT, am_silent); + ERTS_TFLAG__(F_TRACE_SCHED_NO, am_scheduler_id); + ERTS_TFLAG__(F_TRACE_PORTS, am_ports); + ERTS_TFLAG__(F_TRACE_SCHED_PORTS, am_running_ports); + ERTS_TFLAG__(F_TRACE_SCHED_PROCS, am_running_procs); + + if (szp) + *szp += sz; + + if (hpp) + *hpp = hp; + + return res; + +#undef ERTS_TFLAG__ +} + +static Eterm +trace_info_tracee(Process *c_p, void *arg, int *redsp, ErlHeapFragment **bpp) +{ + ErlHeapFragment *bp; + Eterm *hp, res, key; + Uint sz; + + *redsp = 1; + + if (ERTS_PROC_IS_EXITING(c_p)) + return am_undefined; + + key = (Eterm) arg; + sz = 3; + + if (!ERTS_TRACER_IS_NIL(ERTS_TRACER(c_p))) + erts_is_tracer_proc_enabled(c_p, ERTS_PROC_LOCK_MAIN, + &c_p->common); + + switch (key) { + case am_tracer: + + erts_build_tracer_to_term(NULL, NULL, &sz, ERTS_TRACER(c_p)); + bp = new_message_buffer(sz); + hp = bp->mem; + res = erts_build_tracer_to_term(&hp, &bp->off_heap, + NULL, ERTS_TRACER(c_p)); + if (res == am_false) + res = NIL; + break; + + case am_flags: + + build_trace_flags_term(NULL, &sz, ERTS_TRACE_FLAGS(c_p)); + bp = new_message_buffer(sz); + hp = bp->mem; + res = build_trace_flags_term(&hp, NULL, ERTS_TRACE_FLAGS(c_p)); + break; + + default: + + ERTS_INTERNAL_ERROR("Key not supported"); + res = NIL; + bp = NULL; + hp = NULL; + break; + } + + *redsp += 2; + + res = TUPLE2(hp, key, res); + *bpp = bp; + return res; +} + +static Eterm trace_info_pid(Process* p, Eterm pid_spec, Eterm key) { Eterm tracer; @@ -846,24 +965,19 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key) erts_port_release(tracee); } else if (is_internal_pid(pid_spec)) { - Process *tracee = erts_pid2proc_not_running(p, ERTS_PROC_LOCK_MAIN, - pid_spec, ERTS_PROC_LOCK_MAIN); - - if (tracee == ERTS_PROC_LOCK_BUSY) - ERTS_BIF_YIELD2(bif_export[BIF_trace_info_2], p, pid_spec, key); + Eterm ref; - if (!tracee) - return am_undefined; + if (key != am_flags && key != am_tracer) + goto error; - if (!ERTS_TRACER_IS_NIL(ERTS_TRACER(tracee))) - erts_is_tracer_proc_enabled(tracee, ERTS_PROC_LOCK_MAIN, - &tracee->common); + ref = erts_proc_sig_send_rpc_request(p, pid_spec, !0, + trace_info_tracee, + (void *) key); - tracer = erts_tracer_to_term(p, ERTS_TRACER(tracee)); - trace_flags = ERTS_TRACE_FLAGS(tracee); + if (is_non_value(ref)) + return am_undefined; - if (tracee != p) - erts_proc_unlock(tracee, ERTS_PROC_LOCK_MAIN); + return ref; } else if (is_external_pid(pid_spec) && external_pid_dist_entry(pid_spec) == erts_this_dist_entry) { return am_undefined; @@ -873,48 +987,16 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key) } if (key == am_flags) { - int num_flags = 21; /* MAXIMUM number of flags. */ - Uint needed = 3+2*num_flags; - Eterm flag_list = NIL; - Eterm* limit; + Eterm flag_list; + Uint sz = 3; + Eterm *hp; -#define FLAG0(flag_mask,flag) \ - if (trace_flags & (flag_mask)) { flag_list = CONS(hp, flag, flag_list); hp += 2; } else {} + build_trace_flags_term(NULL, &sz, trace_flags); + + hp = HAlloc(p, sz); + + flag_list = build_trace_flags_term(&hp, NULL, trace_flags); -#if defined(DEBUG) - /* - * Check num_flags if this assertion fires. - */ -# define FLAG ASSERT(num_flags-- > 0); FLAG0 -#else -# define FLAG FLAG0 -#endif - hp = HAlloc(p, needed); - limit = hp+needed; - FLAG(F_NOW_TS, am_timestamp); - FLAG(F_STRICT_MON_TS, am_strict_monotonic_timestamp); - FLAG(F_MON_TS, am_monotonic_timestamp); - FLAG(F_TRACE_SEND, am_send); - FLAG(F_TRACE_RECEIVE, am_receive); - FLAG(F_TRACE_SOS, am_set_on_spawn); - FLAG(F_TRACE_CALLS, am_call); - FLAG(F_TRACE_PROCS, am_procs); - FLAG(F_TRACE_SOS1, am_set_on_first_spawn); - FLAG(F_TRACE_SOL, am_set_on_link); - FLAG(F_TRACE_SOL1, am_set_on_first_link); - FLAG(F_TRACE_SCHED, am_running); - FLAG(F_TRACE_SCHED_EXIT, am_exiting); - FLAG(F_TRACE_GC, am_garbage_collection); - FLAG(F_TRACE_ARITY_ONLY, am_arity); - FLAG(F_TRACE_RETURN_TO, am_return_to); - FLAG(F_TRACE_SILENT, am_silent); - FLAG(F_TRACE_SCHED_NO, am_scheduler_id); - FLAG(F_TRACE_PORTS, am_ports); - FLAG(F_TRACE_SCHED_PORTS, am_running_ports); - FLAG(F_TRACE_SCHED_PROCS, am_running_procs); -#undef FLAG0 -#undef FLAG - HRelease(p,limit,hp+3); return TUPLE2(hp, key, flag_list); } else if (key == am_tracer) { if (tracer == am_false) diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index 46653a8580..7dfd0c273a 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -146,9 +146,7 @@ typedef union { /* A "magic" binary flag */ #define BIN_FLAG_MAGIC 1 -#define BIN_FLAG_USR1 2 /* Reserved for use by different modules too mark */ -#define BIN_FLAG_USR2 4 /* certain binaries as special (used by ets) */ -#define BIN_FLAG_DRV 8 +#define BIN_FLAG_DRV 2 #endif /* ERL_BINARY_H__TYPES__ */ diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index ca2ebb7c27..3a29f8cf56 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -50,6 +50,34 @@ erts_atomic_t erts_ets_misc_mem_size; ** Utility macros */ +#define DB_BIF_GET_TABLE(TB, WHAT, KIND, BIF_IX) \ + DB_GET_TABLE(TB, BIF_ARG_1, WHAT, KIND, BIF_IX, NULL, BIF_P) + +#define DB_TRAP_GET_TABLE(TB, TID, WHAT, KIND, BIF_EXP) \ + DB_GET_TABLE(TB, TID, WHAT, KIND, 0, BIF_EXP, BIF_P) + +#define DB_GET_TABLE(TB, TID, WHAT, KIND, BIF_IX, BIF_EXP, PROC) \ +do { \ + Uint freason__; \ + if (!(TB = db_get_table(PROC, TID, WHAT, KIND, &freason__))) { \ + return db_bif_fail(PROC, freason__, BIF_IX, BIF_EXP); \ + } \ +}while(0) + +static BIF_RETTYPE db_bif_fail(Process* p, Uint freason, + Uint bif_ix, Export* bif_exp) +{ + if (freason == TRAP) { + if (!bif_exp) + bif_exp = bif_export[bif_ix]; + p->arity = bif_exp->info.mfa.arity; + p->i = (BeamInstr*) bif_exp->addressv[erts_active_code_ix()]; + } + p->freason = freason; + return THE_NON_VALUE; +} + + /* Get a key from any table structure and a tagged object */ #define TERM_GETKEY(tb, obj) db_getkey((tb)->common.keypos, (obj)) @@ -326,8 +354,7 @@ struct meta_name_tab_entry* meta_name_tab_bucket(Eterm name, typedef enum { LCK_READ=1, /* read only access */ LCK_WRITE=2, /* exclusive table write access */ - LCK_WRITE_REC=3, /* record write access */ - LCK_NONE=4 + LCK_WRITE_REC=3 /* record write access */ } db_lock_kind_t; extern DbTableMethod db_hash; @@ -337,9 +364,6 @@ int user_requested_db_max_tabs; int erts_ets_realloc_always_moves; int erts_ets_always_compress; static int db_max_tabs; -static Eterm ms_delete_all; -static Eterm ms_delete_all_buff[8]; /* To compare with for deletion - of all objects */ /* ** Forward decls, static functions @@ -351,18 +375,19 @@ static void set_heir(Process* me, DbTable* tb, Eterm heir, UWord heir_data); static void free_heir_data(DbTable*); static SWord free_fixations_locked(Process* p, DbTable *tb); +static void delete_all_objects_continue(Process* p, DbTable* tb); static SWord free_table_continue(Process *p, DbTable *tb, SWord reds); static void print_table(fmtfn_t to, void *to_arg, int show, DbTable* tb); -static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1); +static BIF_RETTYPE ets_select_delete_trap_1(BIF_ALIST_1); static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1); static BIF_RETTYPE ets_select_replace_1(BIF_ALIST_1); static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1); static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1); static Eterm table_info(Process* p, DbTable* tb, Eterm What); -static BIF_RETTYPE ets_select1(Process* p, Eterm arg1); -static BIF_RETTYPE ets_select2(Process* p, Eterm arg1, Eterm arg2); -static BIF_RETTYPE ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3); +static BIF_RETTYPE ets_select1(Process* p, int bif_ix, Eterm arg1); +static BIF_RETTYPE ets_select2(Process* p, DbTable*, Eterm tid, Eterm ms); +static BIF_RETTYPE ets_select3(Process* p, DbTable*, Eterm tid, Eterm ms, Sint chunk_size); /* @@ -636,15 +661,42 @@ static ERTS_INLINE void db_unlock(DbTable* tb, db_lock_kind_t kind) } } +static ERTS_INLINE int db_is_exclusive(DbTable* tb, db_lock_kind_t kind) +{ + return kind != LCK_READ && tb->common.is_thread_safe; +} + +static DbTable* handle_lacking_permission(Process* p, DbTable* tb, + db_lock_kind_t kind, + Uint* freason_p) +{ + if (tb->common.status & DB_BUSY) { + if (!db_is_exclusive(tb, kind)) { + db_unlock(tb, kind); + db_lock(tb, LCK_WRITE); + } + delete_all_objects_continue(p, tb); + db_unlock(tb, LCK_WRITE); + tb = NULL; + *freason_p = TRAP; + } + else if (p->common.id != tb->common.owner) { + db_unlock(tb, kind); + tb = NULL; + *freason_p = BADARG; + } + return tb; +} + static ERTS_INLINE DbTable* db_get_table_aux(Process *p, Eterm id, int what, db_lock_kind_t kind, - int meta_already_locked) + int meta_already_locked, + Uint* freason_p) { DbTable *tb; - erts_rwmtx_t *mtl = NULL; /* * IMPORTANT: Only scheduler threads are allowed @@ -654,13 +706,13 @@ DbTable* db_get_table_aux(Process *p, ASSERT(erts_get_scheduler_data()); if (is_atom(id)) { + erts_rwmtx_t *mtl; struct meta_name_tab_entry* bucket = meta_name_tab_bucket(id,&mtl); if (!meta_already_locked) erts_rwmtx_rlock(mtl); else{ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rlocked(mtl) || erts_lc_rwmtx_is_rwlocked(mtl)); - mtl = NULL; } tb = NULL; if (bucket->pu.tb != NULL) { @@ -679,20 +731,29 @@ DbTable* db_get_table_aux(Process *p, } } } + if (!meta_already_locked) + erts_rwmtx_runlock(mtl); } else tb = tid2tab(id); if (tb) { db_lock(tb, kind); - if ((tb->common.status & what) == 0 - && p->common.id != tb->common.owner) { - db_unlock(tb, kind); - tb = NULL; - } +#ifdef ETS_DBG_FORCE_TRAP + if (erts_atomic_read_nob(&tb->common.dbg_force_trap) && + erts_atomic_add_read_nob(&tb->common.dbg_force_trap, 2) & 2) { + db_unlock(tb, kind); + tb = NULL; + *freason_p = TRAP; + } + else +#endif + if (ERTS_UNLIKELY(!(tb->common.status & what))) + tb = handle_lacking_permission(p, tb, kind, freason_p); } - if (mtl) - erts_rwmtx_runlock(mtl); + else + *freason_p = BADARG; + return tb; } @@ -700,9 +761,10 @@ static ERTS_INLINE DbTable* db_get_table(Process *p, Eterm id, int what, - db_lock_kind_t kind) + db_lock_kind_t kind, + Uint* freason_p) { - return db_get_table_aux(p, id, what, kind, 0); + return db_get_table_aux(p, id, what, kind, 0, freason_p); } static int insert_named_tab(Eterm name_atom, DbTable* tb, int have_lock) @@ -868,9 +930,7 @@ BIF_RETTYPE ets_safe_fixtable_2(BIF_ALIST_2) #endif kind = (BIF_ARG_2 == am_true) ? LCK_READ : LCK_WRITE_REC; - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, kind)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_READ, kind, BIF_ets_safe_fixtable_2); if (BIF_ARG_2 == am_true) { fix_table_locked(BIF_P, tb); @@ -900,11 +960,7 @@ BIF_RETTYPE ets_first_1(BIF_ALIST_1) CHECK_TABLES(); - tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ); - - if (!tb) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_first_1); cret = tb->common.meth->db_first(BIF_P, tb, &ret); @@ -927,11 +983,7 @@ BIF_RETTYPE ets_next_2(BIF_ALIST_2) CHECK_TABLES(); - tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ); - - if (!tb) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_next_2); cret = tb->common.meth->db_next(BIF_P, tb, BIF_ARG_2, &ret); @@ -954,11 +1006,7 @@ BIF_RETTYPE ets_last_1(BIF_ALIST_1) CHECK_TABLES(); - tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ); - - if (!tb) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_last_1); cret = tb->common.meth->db_last(BIF_P, tb, &ret); @@ -981,11 +1029,7 @@ BIF_RETTYPE ets_prev_2(BIF_ALIST_2) CHECK_TABLES(); - tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ); - - if (!tb) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_prev_2); cret = tb->common.meth->db_prev(BIF_P,tb,BIF_ARG_2,&ret); @@ -1003,21 +1047,15 @@ BIF_RETTYPE ets_prev_2(BIF_ALIST_2) BIF_RETTYPE ets_take_2(BIF_ALIST_2) { DbTable* tb; -#ifdef DEBUG int cret; -#endif Eterm ret; CHECK_TABLES(); - tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC); - if (!tb) { - BIF_ERROR(BIF_P, BADARG); - } -#ifdef DEBUG - cret = -#endif - tb->common.meth->db_take(BIF_P, tb, BIF_ARG_2, &ret); - ASSERT(cret == DB_ERROR_NONE); + DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_take_2); + + cret = tb->common.meth->db_take(BIF_P, tb, BIF_ARG_2, &ret); + + ASSERT(cret == DB_ERROR_NONE); (void)cret; db_unlock(tb, LCK_WRITE_REC); BIF_RET(ret); } @@ -1035,9 +1073,8 @@ BIF_RETTYPE ets_update_element_3(BIF_ALIST_3) DeclareTmpHeap(cell,2,BIF_P); DbUpdateHandle handle; - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_update_element_3); + UseTmpHeap(2,BIF_P); if (!(tb->common.status & (DB_SET | DB_ORDERED_SET))) { goto bail_out; @@ -1108,9 +1145,9 @@ bail_out: } static BIF_RETTYPE -do_update_counter(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Eterm arg4) +do_update_counter(Process *p, DbTable* tb, + Eterm arg2, Eterm arg3, Eterm arg4) { - DbTable* tb; int cret = DB_ERROR_BADITEM; Eterm upop_list; int list_size; @@ -1126,10 +1163,6 @@ do_update_counter(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Eterm arg4) Eterm* hstart; Eterm* hend; - if ((tb = db_get_table(p, arg1, DB_WRITE, LCK_WRITE_REC)) == NULL) { - BIF_ERROR(p, BADARG); - } - UseTmpHeap(5, p); if (!(tb->common.status & (DB_SET | DB_ORDERED_SET))) { @@ -1303,7 +1336,11 @@ bail_out: */ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) { - return do_update_counter(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, THE_NON_VALUE); + DbTable* tb; + + DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_update_counter_3); + + return do_update_counter(BIF_P, tb, BIF_ARG_2, BIF_ARG_3, THE_NON_VALUE); } /* @@ -1315,10 +1352,14 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) */ BIF_RETTYPE ets_update_counter_4(BIF_ALIST_4) { + DbTable* tb; + if (is_not_tuple(BIF_ARG_4)) { BIF_ERROR(BIF_P, BADARG); } - return do_update_counter(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, BIF_ARG_4); + DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_update_counter_4); + + return do_update_counter(BIF_P, tb, BIF_ARG_2, BIF_ARG_3, BIF_ARG_4); } @@ -1339,9 +1380,8 @@ BIF_RETTYPE ets_insert_2(BIF_ALIST_2) kind = ((is_list(BIF_ARG_2) && CDR(list_val(BIF_ARG_2)) != NIL) ? LCK_WRITE : LCK_WRITE_REC); - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, kind)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_WRITE, kind, BIF_ets_insert_2); + if (BIF_ARG_2 == NIL) { db_unlock(tb, kind); BIF_RET(am_true); @@ -1407,11 +1447,9 @@ BIF_RETTYPE ets_insert_new_2(BIF_ALIST_2) /* More than one object, use LCK_WRITE to keep atomicity */ kind = LCK_WRITE; - tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, kind); - if (tb == NULL) { - BIF_ERROR(BIF_P, BADARG); - } - meth = tb->common.meth; + DB_BIF_GET_TABLE(tb, DB_WRITE, kind, BIF_ets_insert_new_2); + + meth = tb->common.meth; for (lst = BIF_ARG_2; is_list(lst); lst = CDR(list_val(lst))) { if (is_not_tuple(CAR(list_val(lst))) || (arityval(*tuple_val(CAR(list_val(lst)))) @@ -1446,9 +1484,8 @@ BIF_RETTYPE ets_insert_new_2(BIF_ALIST_2) /* Only one object (or NIL) */ kind = LCK_WRITE_REC; - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, kind)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_WRITE, kind, BIF_ets_insert_new_2); + if (BIF_ARG_2 == NIL) { db_unlock(tb, kind); BIF_RET(am_true); @@ -1487,6 +1524,7 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2) Eterm ret; Eterm old_name; erts_rwmtx_t *lck1, *lck2; + Uint freason; #ifdef HARDDEBUG erts_fprintf(stderr, @@ -1531,9 +1569,9 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2) if (lck2) erts_rwmtx_rwlock(lck2); - tb = db_get_table_aux(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE, 1); + tb = db_get_table_aux(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE, 1, &freason); if (!tb) - goto badarg; + goto fail; if (is_table_named(tb)) { if (!insert_named_tab(BIF_ARG_2, tb, 1)) @@ -1553,13 +1591,18 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2) if (lck2) erts_rwmtx_rwunlock(lck2); BIF_RET(ret); - badarg: + +badarg: + freason = BADARG; + +fail: if (tb) db_unlock(tb, LCK_WRITE); erts_rwmtx_rwunlock(lck1); if (lck2) erts_rwmtx_rwunlock(lck2); - BIF_ERROR(BIF_P, BADARG); + + return db_bif_fail(BIF_P, freason, BIF_ets_rename_2, NULL); } @@ -1580,9 +1623,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) Sint keypos; int is_named, is_compressed; int is_fine_locked, frequent_read; -#ifdef DEBUG int cret; -#endif DbTableMethod* meth; if (is_not_atom(BIF_ARG_1)) { @@ -1708,7 +1749,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) tb->common.meth = meth; tb->common.the_name = BIF_ARG_1; tb->common.status = status; - tb->common.type = status & ERTS_ETS_TABLE_TYPES; + tb->common.type = status; /* Note, 'type' is *read only* from now on... */ erts_refc_init(&tb->common.fix_count, 0); db_init_lock(tb, status & (DB_FINE_LOCKED|DB_FREQ_READ)); @@ -1720,12 +1761,12 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) tb->common.fixing_procs = NULL; tb->common.compress = is_compressed; - -#ifdef DEBUG - cret = +#ifdef ETS_DBG_FORCE_TRAP + erts_atomic_init_nob(&tb->common.dbg_force_trap, erts_ets_dbg_force_trap); #endif - meth->db_create(BIF_P, tb); - ASSERT(cret == DB_ERROR_NONE); + + cret = meth->db_create(BIF_P, tb); + ASSERT(cret == DB_ERROR_NONE); (void)cret; make_btid(tb); @@ -1741,7 +1782,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) db_lock(tb,LCK_WRITE); free_heir_data(tb); - tb->common.meth->db_free_table(tb); + tb->common.meth->db_free_empty_table(tb); db_unlock(tb,LCK_WRITE); table_dec_refc(tb, 0); BIF_ERROR(BIF_P, BADARG); @@ -1767,13 +1808,19 @@ BIF_RETTYPE ets_whereis_1(BIF_ALIST_1) { DbTable* tb; Eterm res; + Uint freason; if (is_not_atom(BIF_ARG_1)) { BIF_ERROR(BIF_P, BADARG); } - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) { - BIF_RET(am_undefined); + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ, &freason)) == NULL) { + if (freason == BADARG) + BIF_RET(am_undefined); + else { + //ToDo: Could we avoid this + return db_bif_fail(BIF_P, freason, BIF_ets_whereis_1, NULL); + } } res = make_tid(BIF_P, tb); @@ -1793,9 +1840,7 @@ BIF_RETTYPE ets_lookup_2(BIF_ALIST_2) CHECK_TABLES(); - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_lookup_2); cret = tb->common.meth->db_get(BIF_P, tb, BIF_ARG_2, &ret); @@ -1823,9 +1868,7 @@ BIF_RETTYPE ets_member_2(BIF_ALIST_2) CHECK_TABLES(); - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_member_2); cret = tb->common.meth->db_member(tb, BIF_ARG_2, &ret); @@ -1856,9 +1899,7 @@ BIF_RETTYPE ets_lookup_element_3(BIF_ALIST_3) CHECK_TABLES(); - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_lookup_element_3); if (is_not_small(BIF_ARG_3) || ((index = signed_val(BIF_ARG_3)) < 1)) { db_unlock(tb, LCK_READ); @@ -1896,9 +1937,7 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1) CHECK_TABLES(); - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE, BIF_ets_delete_1); /* * Clear all access bits to prevent any ets operation to access the @@ -1941,7 +1980,8 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1) reds -= free_fixations_locked(BIF_P, tb); db_unlock(tb, LCK_WRITE); - if (free_table_continue(BIF_P, tb, reds) < 0) { + reds = free_table_continue(BIF_P, tb, reds); + if (reds < 0) { /* * Package the DbTable* pointer into a bignum so that it can be safely * passed through a trap. We used to pass the DbTable* pointer directly @@ -1970,6 +2010,7 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3) Eterm to_pid = BIF_ARG_2; Eterm from_pid; DbTable* tb = NULL; + Uint freason; if (!is_internal_pid(to_pid)) { goto badarg; @@ -1979,10 +2020,11 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3) goto badarg; } - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL - || tb->common.owner != BIF_P->common.id) { - goto badarg; - } + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE, &freason)) == NULL) + goto fail; + if (tb->common.owner != BIF_P->common.id) + goto badarg; + from_pid = tb->common.owner; if (to_pid == from_pid) { goto badarg; /* or should we be idempotent? return false maybe */ @@ -2001,9 +2043,12 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3) BIF_RET(am_true); badarg: + freason = BADARG; +fail: if (to_proc != NULL && to_proc != BIF_P) erts_proc_unlock(to_proc, to_locks); if (tb != NULL) db_unlock(tb, LCK_WRITE); - BIF_ERROR(BIF_P, BADARG); + + return db_bif_fail(BIF_P, freason, BIF_ets_give_away_3, NULL); } BIF_RETTYPE ets_setopts_2(BIF_ALIST_2) @@ -2054,11 +2099,13 @@ BIF_RETTYPE ets_setopts_2(BIF_ALIST_2) } } - if (tail != NIL - || (tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL - || tb->common.owner != BIF_P->common.id) { + if (tail != NIL) + goto badarg; + + DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE, BIF_ets_setopts_2); + + if (tb->common.owner != BIF_P->common.id) goto badarg; - } if (heir_data != THE_NON_VALUE) { free_heir_data(tb); @@ -2082,23 +2129,84 @@ badarg: } /* -** BIF to erase a whole table and release all memory it holds -*/ -BIF_RETTYPE ets_delete_all_objects_1(BIF_ALIST_1) + * Common for delete_all_objects and select_delete(DeleteAll). + */ +BIF_RETTYPE ets_internal_delete_all_2(BIF_ALIST_2) { + SWord initial_reds = ERTS_BIF_REDS_LEFT(BIF_P); + SWord reds = initial_reds; + Eterm nitems; DbTable* tb; CHECK_TABLES(); - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE, BIF_ets_internal_delete_all_2); - tb->common.meth->db_delete_all_objects(BIF_P, tb); + if (BIF_ARG_2 == am_undefined) { + nitems = erts_make_integer(erts_atomic_read_nob(&tb->common.nitems), + BIF_P); + + reds = tb->common.meth->db_delete_all_objects(BIF_P, tb, reds); + + ASSERT(!(tb->common.status & DB_BUSY)); + + if (reds < 0) { + /* + * Oboy, need to trap AND need to be atomic. + * Solved by cooperative trapping where every process trying to + * access this table (including this process) will "fail" to lookup + * the table and instead pitch in deleting objects + * (in delete_all_objects_continue) and then trap to self. + */ + ASSERT((tb->common.status & (DB_PRIVATE|DB_PROTECTED|DB_PUBLIC)) + == + (tb->common.type & (DB_PRIVATE|DB_PROTECTED|DB_PUBLIC))); + tb->common.status &= ~(DB_PRIVATE|DB_PROTECTED|DB_PUBLIC); + tb->common.status |= DB_BUSY; + db_unlock(tb, LCK_WRITE); + BUMP_ALL_REDS(BIF_P); + BIF_TRAP2(bif_export[BIF_ets_internal_delete_all_2], BIF_P, + BIF_ARG_1, nitems); + } + else { + /* Done, no trapping needed */ + BUMP_REDS(BIF_P, (initial_reds - reds)); + } + + } + else { + /* + * The table lookup succeeded and second argument is nitems + * and not 'undefined', which means we have trapped at least once + * and are now done. + */ + nitems = BIF_ARG_2; + } db_unlock(tb, LCK_WRITE); + BIF_RET(nitems); +} - BIF_RET(am_true); +static void delete_all_objects_continue(Process* p, DbTable* tb) +{ + SWord initial_reds = ERTS_BIF_REDS_LEFT(p); + SWord reds = initial_reds; + + ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&tb->common.rwlock)); + + if ((tb->common.status & (DB_DELETE|DB_BUSY)) != DB_BUSY) + return; + + reds = tb->common.meth->db_delete_all_objects(p, tb, reds); + + if (reds < 0) { + BUMP_ALL_REDS(p); + } + else { + tb->common.status |= tb->common.type & (DB_PRIVATE|DB_PROTECTED|DB_PUBLIC); + tb->common.status &= ~DB_BUSY; + BUMP_REDS(p, (initial_reds - reds)); + } } /* @@ -2114,9 +2222,7 @@ BIF_RETTYPE ets_delete_2(BIF_ALIST_2) CHECK_TABLES(); - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_delete_2); cret = tb->common.meth->db_erase(tb,BIF_ARG_2,&ret); @@ -2143,9 +2249,8 @@ BIF_RETTYPE ets_delete_object_2(BIF_ALIST_2) CHECK_TABLES(); - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_delete_object_2); + if (is_not_tuple(BIF_ARG_2) || (arityval(*tuple_val(BIF_ARG_2)) < tb->common.keypos)) { db_unlock(tb, LCK_WRITE_REC); @@ -2168,7 +2273,7 @@ BIF_RETTYPE ets_delete_object_2(BIF_ALIST_2) /* ** This is for trapping, cannot be called directly. */ -static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1) +static BIF_RETTYPE ets_select_delete_trap_1(BIF_ALIST_1) { Process *p = BIF_P; Eterm a1 = BIF_ARG_1; @@ -2178,15 +2283,14 @@ static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1) Eterm ret; Eterm *tptr; db_lock_kind_t kind = LCK_WRITE_REC; - + CHECK_TABLES(); ASSERT(is_tuple(a1)); tptr = tuple_val(a1); ASSERT(arityval(*tptr) >= 1); - if ((tb = db_get_table(p, tptr[1], DB_WRITE, kind)) == NULL) { - BIF_ERROR(p,BADARG); - } + DB_TRAP_GET_TABLE(tb, tptr[1], DB_WRITE, kind, + &ets_select_delete_continue_exp); cret = tb->common.meth->db_select_delete_continue(p,tb,a1,&ret); @@ -2210,7 +2314,10 @@ static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1) } -BIF_RETTYPE ets_select_delete_2(BIF_ALIST_2) +/* + * ets:select_delete/2 without special case for "delete-all". + */ +BIF_RETTYPE ets_internal_select_delete_2(BIF_ALIST_2) { BIF_RETTYPE result; DbTable* tb; @@ -2220,20 +2327,8 @@ BIF_RETTYPE ets_select_delete_2(BIF_ALIST_2) CHECK_TABLES(); - if(eq(BIF_ARG_2, ms_delete_all)) { - int nitems; - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } - nitems = erts_atomic_read_nob(&tb->common.nitems); - tb->common.meth->db_delete_all_objects(BIF_P, tb); - db_unlock(tb, LCK_WRITE); - BIF_RET(erts_make_integer(nitems,BIF_P)); - } + DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_internal_select_delete_2); - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } safety = ITERATION_SAFETY(BIF_P,tb); if (safety == ITER_UNSAFE) { local_fix_table(tb); @@ -2525,9 +2620,8 @@ BIF_RETTYPE ets_slot_2(BIF_ALIST_2) CHECK_TABLES(); - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_slot_2); + /* The slot number is checked in table specific code. */ cret = tb->common.meth->db_slot(BIF_P, tb, BIF_ARG_2, &ret); db_unlock(tb, LCK_READ); @@ -2547,41 +2641,53 @@ BIF_RETTYPE ets_slot_2(BIF_ALIST_2) BIF_RETTYPE ets_match_1(BIF_ALIST_1) { - return ets_select1(BIF_P, BIF_ARG_1); + return ets_select1(BIF_P, BIF_ets_match_1, BIF_ARG_1); } BIF_RETTYPE ets_match_2(BIF_ALIST_2) { + DbTable* tb; Eterm ms; DeclareTmpHeap(buff,8,BIF_P); Eterm *hp = buff; Eterm res; + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_match_2); + UseTmpHeap(8,BIF_P); ms = CONS(hp, am_DollarDollar, NIL); hp += 2; ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); hp += 4; ms = CONS(hp, ms, NIL); - res = ets_select2(BIF_P, BIF_ARG_1, ms); + res = ets_select2(BIF_P, tb, BIF_ARG_1, ms); UnUseTmpHeap(8,BIF_P); return res; } BIF_RETTYPE ets_match_3(BIF_ALIST_3) { + DbTable* tb; Eterm ms; + Sint chunk_size; DeclareTmpHeap(buff,8,BIF_P); Eterm *hp = buff; Eterm res; + /* Chunk size strictly greater than 0 */ + if (is_not_small(BIF_ARG_3) || (chunk_size = signed_val(BIF_ARG_3)) <= 0) { + BIF_ERROR(BIF_P, BADARG); + } + + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_match_3); + UseTmpHeap(8,BIF_P); ms = CONS(hp, am_DollarDollar, NIL); hp += 2; ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); hp += 4; ms = CONS(hp, ms, NIL); - res = ets_select3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3); + res = ets_select3(BIF_P, tb, BIF_ARG_1, ms, chunk_size); UnUseTmpHeap(8,BIF_P); return res; } @@ -2589,34 +2695,35 @@ BIF_RETTYPE ets_match_3(BIF_ALIST_3) BIF_RETTYPE ets_select_3(BIF_ALIST_3) { - return ets_select3(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + DbTable* tb; + Sint chunk_size; + + /* Chunk size strictly greater than 0 */ + if (is_not_small(BIF_ARG_3) || (chunk_size = signed_val(BIF_ARG_3)) <= 0) { + BIF_ERROR(BIF_P, BADARG); + } + + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_select_3); + + return ets_select3(BIF_P, tb, BIF_ARG_1, BIF_ARG_2, chunk_size); } static BIF_RETTYPE -ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3) +ets_select3(Process* p, DbTable* tb, Eterm tid, Eterm ms, Sint chunk_size) { BIF_RETTYPE result; - DbTable* tb; int cret; Eterm ret; - Sint chunk_size; enum DbIterSafety safety; CHECK_TABLES(); - /* Chunk size strictly greater than 0 */ - if (is_not_small(arg3) || (chunk_size = signed_val(arg3)) <= 0) { - BIF_ERROR(p, BADARG); - } - if ((tb = db_get_table(p, arg1, DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(p, BADARG); - } safety = ITERATION_SAFETY(p,tb); if (safety == ITER_UNSAFE) { local_fix_table(tb); } - cret = tb->common.meth->db_select_chunk(p, tb, arg1, - arg2, chunk_size, + cret = tb->common.meth->db_select_chunk(p, tb, tid, + ms, chunk_size, 0 /* not reversed */, &ret); if (DID_TRAP(p,ret) && safety != ITER_SAFE) { @@ -2662,9 +2769,8 @@ static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1) tptr = tuple_val(a1); ASSERT(arityval(*tptr) >= 1); - if ((tb = db_get_table(p, tptr[1], DB_READ, kind)) == NULL) { - BIF_ERROR(p, BADARG); - } + DB_TRAP_GET_TABLE(tb, tptr[1], DB_READ, kind, + &ets_select_continue_exp); cret = tb->common.meth->db_select_continue(p, tb, a1, &ret); @@ -2694,10 +2800,10 @@ static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1) BIF_RETTYPE ets_select_1(BIF_ALIST_1) { - return ets_select1(BIF_P, BIF_ARG_1); + return ets_select1(BIF_P, BIF_ets_select_1, BIF_ARG_1); } -static BIF_RETTYPE ets_select1(Process *p, Eterm arg1) +static BIF_RETTYPE ets_select1(Process *p, int bif_ix, Eterm arg1) { BIF_RETTYPE result; DbTable* tb; @@ -2719,10 +2825,10 @@ static BIF_RETTYPE ets_select1(Process *p, Eterm arg1) BIF_ERROR(p, BADARG); } tptr = tuple_val(arg1); - if (arityval(*tptr) < 1 || - (tb = db_get_table(p, tptr[1], DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(p, BADARG); - } + if (arityval(*tptr) < 1) + BIF_ERROR(p, BADARG); + + DB_GET_TABLE(tb, tptr[1], DB_READ, LCK_READ, bif_ix, NULL, p); safety = ITERATION_SAFETY(p,tb); if (safety == ITER_UNSAFE) { @@ -2758,33 +2864,27 @@ static BIF_RETTYPE ets_select1(Process *p, Eterm arg1) BIF_RETTYPE ets_select_2(BIF_ALIST_2) { - return ets_select2(BIF_P, BIF_ARG_1, BIF_ARG_2); + DbTable* tb; + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_select_2); + return ets_select2(BIF_P, tb, BIF_ARG_1, BIF_ARG_2); } static BIF_RETTYPE -ets_select2(Process* p, Eterm arg1, Eterm arg2) +ets_select2(Process* p, DbTable* tb, Eterm tid, Eterm ms) { BIF_RETTYPE result; - DbTable* tb; int cret; enum DbIterSafety safety; Eterm ret; CHECK_TABLES(); - /* - * Make sure that the table exists. - */ - - if ((tb = db_get_table(p, arg1, DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(p, BADARG); - } safety = ITERATION_SAFETY(p,tb); if (safety == ITER_UNSAFE) { local_fix_table(tb); } - cret = tb->common.meth->db_select(p, tb, arg1, arg2, 0, &ret); + cret = tb->common.meth->db_select(p, tb, tid, ms, 0, &ret); if (DID_TRAP(p,ret) && safety != ITER_SAFE) { fix_table_locked(p, tb); @@ -2827,9 +2927,9 @@ static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1) tptr = tuple_val(a1); ASSERT(arityval(*tptr) >= 1); - if ((tb = db_get_table(p, tptr[1], DB_READ, kind)) == NULL) { - BIF_ERROR(p, BADARG); - } + + DB_TRAP_GET_TABLE(tb, tptr[1], DB_READ, kind, + &ets_select_count_continue_exp); cret = tb->common.meth->db_select_count_continue(p, tb, a1, &ret); @@ -2864,13 +2964,9 @@ BIF_RETTYPE ets_select_count_2(BIF_ALIST_2) Eterm ret; CHECK_TABLES(); - /* - * Make sure that the table exists. - */ - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_select_count_2); + safety = ITERATION_SAFETY(BIF_P,tb); if (safety == ITER_UNSAFE) { local_fix_table(tb); @@ -2920,9 +3016,8 @@ static BIF_RETTYPE ets_select_replace_1(BIF_ALIST_1) tptr = tuple_val(a1); ASSERT(arityval(*tptr) >= 1); - if ((tb = db_get_table(p, tptr[1], DB_WRITE, kind)) == NULL) { - BIF_ERROR(p,BADARG); - } + DB_TRAP_GET_TABLE(tb, tptr[1], DB_WRITE, kind, + &ets_select_replace_continue_exp); cret = tb->common.meth->db_select_replace_continue(p,tb,a1,&ret); @@ -2956,9 +3051,7 @@ BIF_RETTYPE ets_select_replace_2(BIF_ALIST_2) CHECK_TABLES(); - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE_REC, BIF_ets_select_replace_2); if (tb->common.status & DB_BAG) { /* Bag implementation presented both semantic consistency @@ -3009,13 +3102,8 @@ BIF_RETTYPE ets_select_reverse_3(BIF_ALIST_3) Sint chunk_size; CHECK_TABLES(); - /* - * Make sure that the table exists. - */ - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_select_reverse_3); /* Chunk size strictly greater than 0 */ if (is_not_small(BIF_ARG_3) || (chunk_size = signed_val(BIF_ARG_3)) <= 0) { @@ -3053,7 +3141,7 @@ BIF_RETTYPE ets_select_reverse_3(BIF_ALIST_3) BIF_RETTYPE ets_select_reverse_1(BIF_ALIST_1) { - return ets_select1(BIF_P, BIF_ARG_1); + return ets_select1(BIF_P, BIF_ets_select_reverse_1, BIF_ARG_1); } BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2) @@ -3065,13 +3153,9 @@ BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2) Eterm ret; CHECK_TABLES(); - /* - * Make sure that the table exists. - */ - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { - BIF_ERROR(BIF_P, BADARG); - } + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_select_reverse_2); + safety = ITERATION_SAFETY(BIF_P,tb); if (safety == ITER_UNSAFE) { local_fix_table(tb); @@ -3103,45 +3187,63 @@ BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2) /* -** ets:match_object(Continuation), ets:match_object(Table, Pattern), ets:match_object(Table,Pattern,ChunkSize) +** ets:match_object(Continuation) */ BIF_RETTYPE ets_match_object_1(BIF_ALIST_1) { - return ets_select1(BIF_P, BIF_ARG_1); + return ets_select1(BIF_P, BIF_ets_match_object_1, BIF_ARG_1); } +/* +** ets:match_object(Table, Pattern) +*/ BIF_RETTYPE ets_match_object_2(BIF_ALIST_2) { + DbTable* tb; Eterm ms; DeclareTmpHeap(buff,8,BIF_P); Eterm *hp = buff; Eterm res; + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_match_object_2); + UseTmpHeap(8,BIF_P); ms = CONS(hp, am_DollarUnderscore, NIL); hp += 2; ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); hp += 4; ms = CONS(hp, ms, NIL); - res = ets_select2(BIF_P, BIF_ARG_1, ms); + res = ets_select2(BIF_P, tb, BIF_ARG_1, ms); UnUseTmpHeap(8,BIF_P); return res; } +/* +** ets:match_object(Table,Pattern,ChunkSize) +*/ BIF_RETTYPE ets_match_object_3(BIF_ALIST_3) { + DbTable* tb; + Sint chunk_size; Eterm ms; DeclareTmpHeap(buff,8,BIF_P); Eterm *hp = buff; Eterm res; + /* Chunk size strictly greater than 0 */ + if (is_not_small(BIF_ARG_3) || (chunk_size = signed_val(BIF_ARG_3)) <= 0) { + BIF_ERROR(BIF_P, BADARG); + } + + DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_match_object_3); + UseTmpHeap(8,BIF_P); ms = CONS(hp, am_DollarUnderscore, NIL); hp += 2; ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); hp += 4; ms = CONS(hp, ms, NIL); - res = ets_select3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3); + res = ets_select3(BIF_P, tb, BIF_ARG_1, ms, chunk_size); UnUseTmpHeap(8,BIF_P); return res; } @@ -3162,16 +3264,17 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1) Eterm res; int i; Eterm* hp; + Uint freason; /*Process* rp = NULL;*/ /* If/when we implement lockless private tables: Eterm owner; */ - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) { - if (is_atom(BIF_ARG_1) || is_ref(BIF_ARG_1)) { + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ, &freason)) == NULL) { + if (freason == BADARG && (is_atom(BIF_ARG_1) || is_ref(BIF_ARG_1))) BIF_RET(am_undefined); - } - BIF_ERROR(BIF_P, BADARG); + else + return db_bif_fail(BIF_P, freason, BIF_ets_info_1, NULL); } /* If/when we implement lockless private tables: @@ -3228,12 +3331,13 @@ BIF_RETTYPE ets_info_2(BIF_ALIST_2) { DbTable* tb; Eterm ret = THE_NON_VALUE; + Uint freason; - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) { - if (is_atom(BIF_ARG_1) || is_ref(BIF_ARG_1)) { + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ, &freason)) == NULL) { + if (freason == BADARG && (is_atom(BIF_ARG_1) || is_ref(BIF_ARG_1))) BIF_RET(am_undefined); - } - BIF_ERROR(BIF_P, BADARG); + else + return db_bif_fail(BIF_P, freason, BIF_ets_info_2, NULL); } ret = table_info(BIF_P, tb, BIF_ARG_2); db_unlock(tb, LCK_READ); @@ -3321,7 +3425,6 @@ int erts_ets_rwmtx_spin_count = -1; void init_db(ErtsDbSpinCount db_spin_count) { int i; - Eterm *hp; unsigned bits; size_t size; @@ -3403,7 +3506,7 @@ void init_db(ErtsDbSpinCount db_spin_count) /* Non visual BIF to trap to. */ erts_init_trap_export(&ets_select_delete_continue_exp, am_ets, am_atom_put("delete_trap",11), 1, - &ets_select_delete_1); + &ets_select_delete_trap_1); /* Non visual BIF to trap to. */ erts_init_trap_export(&ets_select_count_continue_exp, @@ -3424,13 +3527,6 @@ void init_db(ErtsDbSpinCount db_spin_count) erts_init_trap_export(&ets_delete_continue_exp, am_ets, am_atom_put("delete_trap",11), 1, &ets_delete_trap); - - hp = ms_delete_all_buff; - ms_delete_all = CONS(hp, am_true, NIL); - hp += 2; - ms_delete_all = TUPLE3(hp,am_Underscore,NIL,ms_delete_all); - hp +=4; - ms_delete_all = CONS(hp, ms_delete_all,NIL); } void @@ -3792,7 +3888,8 @@ unlocked: erts_rwmtx_runlock(&tb->common.rwlock); erts_rwmtx_rwlock(&tb->common.rwlock); *kind_p = LCK_WRITE; - if (tb->common.status & DB_DELETE) return; + if (tb->common.status & (DB_DELETE|DB_BUSY)) + return; } db_unfix_table_hash(&(tb->hash)); } @@ -3940,7 +4037,8 @@ static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1) ASSERT(*ptr == make_pos_bignum_header(1)); - if (free_table_continue(BIF_P, tb, reds) < 0) { + reds = free_table_continue(BIF_P, tb, reds); + if (reds < 0) { BUMP_ALL_REDS(BIF_P); BIF_TRAP1(&ets_delete_continue_exp, BIF_P, cont); } @@ -4321,5 +4419,8 @@ void erts_lcnt_update_db_locks(int enable) { erts_schedule_multi_misc_aux_work(0, erts_no_schedulers, &lcnt_update_db_locks_per_sched, (void*)(UWord)enable); } - #endif /* ERTS_ENABLE_LOCK_COUNT */ + +#ifdef ETS_DBG_FORCE_TRAP +erts_aint_t erts_ets_dbg_force_trap = 0; +#endif diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h index eb6da2c9fb..db86c81914 100644 --- a/erts/emulator/beam/erl_db.h +++ b/erts/emulator/beam/erl_db.h @@ -135,6 +135,10 @@ void erts_lcnt_enable_db_lock_count(DbTable *tb, int enable); void erts_lcnt_update_db_locks(int enable); #endif +#ifdef ETS_DBG_FORCE_TRAP +extern erts_aint_t erts_ets_dbg_force_trap; +#endif + #endif /* ERL_DB_H__ */ #if defined(ERTS_WANT_DB_INTERNAL__) && !defined(ERTS_HAVE_DB_INTERNAL__) diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index cb5c496e90..74d63325e6 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -21,6 +21,7 @@ /* ** Implementation of unordered ETS tables. ** The tables are implemented as linear dynamic hash tables. +** https://en.wikipedia.org/wiki/Linear_hashing */ /* SMP: @@ -148,20 +149,14 @@ static ERTS_INLINE Uint hash_to_ix(DbTableHash* tb, HashValue hval) return ix; } -/* Remember a slot containing a pseudo-deleted item (INVALID_HASH) - * Return false if we got raced by unfixing thread - * and the object should be deleted for real. - */ -static ERTS_INLINE int add_fixed_deletion(DbTableHash* tb, int ix, - erts_aint_t fixated_by_me) + +static ERTS_INLINE int link_fixdel(DbTableHash* tb, + FixedDeletion* fixd, + erts_aint_t fixated_by_me) { erts_aint_t was_next; erts_aint_t exp_next; - FixedDeletion* fixd = (FixedDeletion*) erts_db_alloc(ERTS_ALC_T_DB_FIX_DEL, - (DbTable *) tb, - sizeof(FixedDeletion)); - ERTS_ETS_MISC_MEM_ADD(sizeof(FixedDeletion)); - fixd->slot = ix; + was_next = erts_atomic_read_acqb(&tb->fixdel); do { /* Lockless atomic insertion in linked list: */ if (NFIXED(tb) <= fixated_by_me) { @@ -178,14 +173,33 @@ static ERTS_INLINE int add_fixed_deletion(DbTableHash* tb, int ix, return 1; } +/* Remember a slot containing a pseudo-deleted item + * Return false if we got raced by unfixing thread + * and the object should be deleted for real. + */ +static int add_fixed_deletion(DbTableHash* tb, int ix, + erts_aint_t fixated_by_me) +{ + FixedDeletion* fixd = (FixedDeletion*) erts_db_alloc(ERTS_ALC_T_DB_FIX_DEL, + (DbTable *) tb, + sizeof(FixedDeletion)); + ERTS_ETS_MISC_MEM_ADD(sizeof(FixedDeletion)); + fixd->slot = ix; + fixd->all = 0; + return link_fixdel(tb, fixd, fixated_by_me); +} + + +static ERTS_INLINE int is_pseudo_deleted(HashDbTerm* p) +{ + return p->pseudo_deleted; +} -#define MAX_HASH 0xEFFFFFFFUL -#define INVALID_HASH 0xFFFFFFFFUL /* optimised version of make_hash (normal case? atomic key) */ #define MAKE_HASH(term) \ ((is_atom(term) ? (atom_tab(atom_val(term))->slot.bucket.hvalue) : \ - make_internal_hash(term, 0)) % MAX_HASH) + make_internal_hash(term, 0)) & MAX_HASH_MASK) # define DB_HASH_LOCK_MASK (DB_HASH_LOCK_CNT-1) # define GET_LOCK(tb,hval) (&(tb)->locks->lck_vec[(hval) & DB_HASH_LOCK_MASK].lck) @@ -270,17 +284,22 @@ static ERTS_INLINE Sint next_slot_w(DbTableHash* tb, Uint ix, } -/* - * Some special binary flags - */ -#define BIN_FLAG_ALL_OBJECTS BIN_FLAG_USR1 - static ERTS_INLINE void free_term(DbTableHash *tb, HashDbTerm* p) { db_free_term((DbTable*)tb, p, offsetof(HashDbTerm, dbterm)); } +static ERTS_INLINE void free_term_list(DbTableHash *tb, HashDbTerm* p) +{ + while (p) { + HashDbTerm* next = p->next; + free_term(tb, p); + p = next; + } +} + + /* * Local types */ @@ -290,9 +309,6 @@ struct mp_prefound { }; struct mp_info { - int all_objects; /* True if complete objects are always - * returned from the match_spec (can use - * copy_shallow on the return value) */ int something_can_match; /* The match_spec is not "impossible" */ int key_given; struct mp_prefound dlists[10]; /* Default list of "pre-found" buckets */ @@ -402,7 +418,7 @@ static void db_print_hash(fmtfn_t to, void *to_arg, int show, DbTable *tbl); -static int db_free_table_hash(DbTable *tbl); +static int db_free_empty_table_hash(DbTable *tbl); static SWord db_free_table_continue_hash(DbTable *tbl, SWord reds); @@ -411,7 +427,7 @@ static void db_foreach_offheap_hash(DbTable *, void (*)(ErlOffHeap *, void *), void *); -static int db_delete_all_objects_hash(Process* p, DbTable* tbl); +static SWord db_delete_all_objects_hash(Process* p, DbTable* tbl, SWord reds); #ifdef HARDDEBUG static void db_check_table_hash(DbTableHash *tb); #endif @@ -436,7 +452,8 @@ static ERTS_INLINE void try_shrink(DbTableHash* tb) static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b, Eterm key, HashValue hval) { - if (b->hvalue != hval) return 0; + if (b->hvalue != hval || is_pseudo_deleted(b)) + return 0; else { Eterm itemKey = GETKEY(tb, b->dbterm.tpl); ASSERT(!is_header(itemKey)); @@ -449,7 +466,8 @@ static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b, static ERTS_INLINE int has_key(DbTableHash* tb, HashDbTerm* b, Eterm key, HashValue hval) { - if (b->hvalue != hval && b->hvalue != INVALID_HASH) return 0; + if (b->hvalue != hval) + return 0; else { Eterm itemKey = GETKEY(tb, b->dbterm.tpl); ASSERT(!is_header(itemKey)); @@ -513,7 +531,7 @@ DbTableMethod db_hash = db_select_replace_continue_hash, db_take_hash, db_delete_all_objects_hash, - db_free_table_hash, + db_free_empty_table_hash, db_free_table_continue_hash, db_print_hash, db_foreach_offheap_hash, @@ -570,51 +588,61 @@ SWord db_unfix_table_hash(DbTableHash *tb) SWord work = 0; ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&tb->common.rwlock) - || (erts_lc_rwmtx_is_rlocked(&tb->common.rwlock) - && !tb->common.is_thread_safe)); + || (erts_lc_rwmtx_is_rlocked(&tb->common.rwlock) + && !tb->common.is_thread_safe)); restart: fixdel = (FixedDeletion*) erts_atomic_xchg_mb(&tb->fixdel, - (erts_aint_t) NULL); - while (fixdel != NULL) { - FixedDeletion *fx = fixdel; - int ix = fx->slot; - HashDbTerm **bp; - HashDbTerm *b; - erts_rwmtx_t* lck = WLOCK_HASH(tb,ix); - - if (IS_FIXED(tb)) { /* interrupted by fixer */ - WUNLOCK_HASH(lck); - restore_fixdel(tb,fixdel); - if (!IS_FIXED(tb)) { - goto restart; /* unfixed again! */ - } - return work; - } - if (ix < NACTIVE(tb)) { - bp = &BUCKET(tb, ix); - b = *bp; - - while (b != NULL) { - if (b->hvalue == INVALID_HASH) { - *bp = b->next; - free_term(tb, b); - work++; - b = *bp; - } else { - bp = &b->next; - b = b->next; - } - } - } - /* else slot has been joined and purged by shrink() */ - WUNLOCK_HASH(lck); - fixdel = fx->next; - erts_db_free(ERTS_ALC_T_DB_FIX_DEL, - (DbTable *) tb, - (void *) fx, - sizeof(FixedDeletion)); - ERTS_ETS_MISC_MEM_ADD(-sizeof(FixedDeletion)); - work++; + (erts_aint_t) NULL); + while (fixdel) { + FixedDeletion *free_me; + + do { + HashDbTerm **bp; + HashDbTerm *b; + HashDbTerm *free_us = NULL; + erts_rwmtx_t* lck; + + lck = WLOCK_HASH(tb, fixdel->slot); + + if (IS_FIXED(tb)) { /* interrupted by fixer */ + WUNLOCK_HASH(lck); + restore_fixdel(tb,fixdel); + if (!IS_FIXED(tb)) { + goto restart; /* unfixed again! */ + } + return work; + } + if (fixdel->slot < NACTIVE(tb)) { + bp = &BUCKET(tb, fixdel->slot); + b = *bp; + + while (b != NULL) { + if (is_pseudo_deleted(b)) { + HashDbTerm* nxt = b->next; + b->next = free_us; + free_us = b; + work++; + b = *bp = nxt; + } else { + bp = &b->next; + b = b->next; + } + } + } + /* else slot has been joined and purged by shrink() */ + WUNLOCK_HASH(lck); + free_term_list(tb, free_us); + + }while (fixdel->all && fixdel->slot-- > 0); + + free_me = fixdel; + fixdel = fixdel->next; + erts_db_free(ERTS_ALC_T_DB_FIX_DEL, + (DbTable *) tb, + (void *) free_me, + sizeof(FixedDeletion)); + ERTS_ETS_MISC_MEM_ADD(-sizeof(FixedDeletion)); + work++; } /* ToDo: Maybe try grow/shrink the table as well */ @@ -764,8 +792,9 @@ int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail) */ if (tb->common.status & DB_SET) { HashDbTerm* bnext = b->next; - if (b->hvalue == INVALID_HASH) { + if (is_pseudo_deleted(b)) { erts_atomic_inc_nob(&tb->common.nitems); + b->pseudo_deleted = 0; } else if (key_clash_fail) { ret = DB_ERROR_BADKEY; @@ -773,14 +802,14 @@ int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail) } q = replace_dbterm(tb, b, obj); q->next = bnext; - q->hvalue = hval; /* In case of INVALID_HASH */ + ASSERT(q->hvalue == hval); *bp = q; goto Ldone; } else if (key_clash_fail) { /* && (DB_BAG || DB_DUPLICATE_BAG) */ q = b; do { - if (q->hvalue != INVALID_HASH) { + if (!is_pseudo_deleted(q)) { ret = DB_ERROR_BADKEY; goto Ldone; } @@ -792,9 +821,10 @@ int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail) q = b; do { if (db_eq(&tb->common,obj,&q->dbterm)) { - if (q->hvalue == INVALID_HASH) { + if (is_pseudo_deleted(q)) { erts_atomic_inc_nob(&tb->common.nitems); - q->hvalue = hval; + q->pseudo_deleted = 0; + ASSERT(q->hvalue == hval); if (q != b) { /* must move to preserve key insertion order */ *qp = q->next; q->next = b; @@ -812,6 +842,7 @@ int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail) Lnew: q = new_dbterm(tb, obj); q->hvalue = hval; + q->pseudo_deleted = 0; q->next = b; *bp = q; nitems = erts_atomic_inc_read_nob(&tb->common.nitems); @@ -839,7 +870,7 @@ get_term_list(Process *p, DbTableHash *tb, Eterm key, HashValue hval, if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) { while (b2 && has_key(tb, b2, key, hval)) { - if (b2->hvalue != INVALID_HASH) + if (!is_pseudo_deleted(b2)) sz += b2->dbterm.size + 2; b2 = b2->next; @@ -935,7 +966,7 @@ static int db_get_element_hash(Process *p, DbTable *tbl, while(b2 != NULL && has_key(tb,b2,key,hval)) { if (ndex > arityval(b2->dbterm.tpl[0]) - && b2->hvalue != INVALID_HASH) { + && !is_pseudo_deleted(b2)) { retval = DB_ERROR_BADITEM; goto done; } @@ -943,7 +974,7 @@ static int db_get_element_hash(Process *p, DbTable *tbl, } b = b1; while(b != b2) { - if (b->hvalue != INVALID_HASH) { + if (!is_pseudo_deleted(b)) { Eterm *hp; Eterm copy = db_copy_element_from_ets(&tb->common, p, &b->dbterm, ndex, &hp, 2); @@ -978,6 +1009,7 @@ int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret) int ix; HashDbTerm** bp; HashDbTerm* b; + HashDbTerm* free_us = NULL; erts_rwmtx_t* lck; int nitems_diff = 0; @@ -993,16 +1025,17 @@ int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret) if (nitems_diff == -1 && IS_FIXED(tb) && add_fixed_deletion(tb, ix, 0)) { /* Pseudo remove (no need to keep several of same key) */ - b->hvalue = INVALID_HASH; + b->pseudo_deleted = 1; } else { - *bp = b->next; - free_term(tb, b); - b = *bp; + HashDbTerm* next = b->next; + b->next = free_us; + free_us = b; + b = *bp = next; continue; } } else { - if (nitems_diff && b->hvalue != INVALID_HASH) + if (nitems_diff && !is_pseudo_deleted(b)) break; } bp = &b->next; @@ -1013,6 +1046,7 @@ int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret) erts_atomic_add_nob(&tb->common.nitems, nitems_diff); try_shrink(tb); } + free_term_list(tb, free_us); *ret = am_true; return DB_ERROR_NONE; } @@ -1027,6 +1061,7 @@ static int db_erase_object_hash(DbTable *tbl, Eterm object, Eterm *ret) int ix; HashDbTerm** bp; HashDbTerm* b; + HashDbTerm* free_us = NULL; erts_rwmtx_t* lck; int nitems_diff = 0; int nkeys = 0; @@ -1045,13 +1080,14 @@ static int db_erase_object_hash(DbTable *tbl, Eterm object, Eterm *ret) if (db_eq(&tb->common,object, &b->dbterm)) { --nitems_diff; if (nkeys==1 && IS_FIXED(tb) && add_fixed_deletion(tb,ix,0)) { - b->hvalue = INVALID_HASH; /* Pseudo remove */ + b->pseudo_deleted = 1; bp = &b->next; b = b->next; } else { - *bp = b->next; - free_term(tb, b); - b = *bp; + HashDbTerm* next = b->next; + b->next = free_us; + free_us = b; + b = *bp = next; } if (tb->common.status & (DB_DUPLICATE_BAG)) { continue; @@ -1060,7 +1096,7 @@ static int db_erase_object_hash(DbTable *tbl, Eterm object, Eterm *ret) } } } - else if (nitems_diff && b->hvalue != INVALID_HASH) { + else if (nitems_diff && !is_pseudo_deleted(b)) { break; } bp = &b->next; @@ -1071,6 +1107,7 @@ static int db_erase_object_hash(DbTable *tbl, Eterm object, Eterm *ret) erts_atomic_add_nob(&tb->common.nitems, nitems_diff); try_shrink(tb); } + free_term_list(tb, free_us); *ret = am_true; return DB_ERROR_NONE; } @@ -1106,28 +1143,19 @@ static int db_slot_hash(Process *p, DbTable *tbl, Eterm slot_term, Eterm *ret) /* - * This is just here so I can take care of the return value - * that is to be sent during a trap (the BIF_TRAP macros explicitly returns) - */ -static BIF_RETTYPE bif_trap1(Export *bif, - Process *p, - Eterm p1) -{ - BIF_TRAP1(bif, p, p1); -} - - -/* * Match traversal callbacks */ +typedef struct match_callbacks_t_ match_callbacks_t; +struct match_callbacks_t_ +{ /* Called when no match is possible. * context_ptr: Pointer to context * ret: Pointer to traversal function term return. * * Both the direct return value and 'ret' are used as the traversal function return values. */ -typedef int (*mtraversal_on_nothing_can_match_t)(void* context_ptr, Eterm* ret); + int (*on_nothing_can_match)(match_callbacks_t* ctx, Eterm* ret); /* Called for each match result. * context_ptr: Pointer to context @@ -1138,8 +1166,8 @@ typedef int (*mtraversal_on_nothing_can_match_t)(void* context_ptr, Eterm* ret); * * Should return 1 for successful match, 0 otherwise. */ -typedef int (*mtraversal_on_match_res_t)(void* context_ptr, Sint slot_ix, HashDbTerm*** current_ptr_ptr, - Eterm match_res); + int (*on_match_res)(match_callbacks_t* ctx, Sint slot_ix, + HashDbTerm*** current_ptr_ptr, Eterm match_res); /* Called when either we've matched enough elements in this cycle or EOT was reached. * context_ptr: Pointer to context @@ -1152,8 +1180,8 @@ typedef int (*mtraversal_on_match_res_t)(void* context_ptr, Sint slot_ix, HashDb * Both the direct return value and 'ret' are used as the traversal function return values. * If *mpp is set to NULL, it won't be deallocated (useful for trapping.) */ -typedef int (*mtraversal_on_loop_ended_t)(void* context_ptr, Sint slot_ix, Sint got, - Sint iterations_left, Binary** mpp, Eterm* ret); + int (*on_loop_ended)(match_callbacks_t* ctx, Sint slot_ix, Sint got, + Sint iterations_left, Binary** mpp, Eterm* ret); /* Called when it's time to trap * context_ptr: Pointer to context @@ -1165,7 +1193,11 @@ typedef int (*mtraversal_on_loop_ended_t)(void* context_ptr, Sint slot_ix, Sint * Both the direct return value and 'ret' are used as the traversal function return values. * If *mpp is set to NULL, it won't be deallocated (useful for trapping.) */ -typedef int (*mtraversal_on_trap_t)(void* context_ptr, Sint slot_ix, Sint got, Binary** mpp, Eterm* ret); + int (*on_trap)(match_callbacks_t* ctx, Sint slot_ix, Sint got, Binary** mpp, + Eterm* ret); + +}; + /* * Begin hash table match traversal @@ -1178,11 +1210,7 @@ static int match_traverse(Process* p, DbTableHash* tb, Eterm** hpp, /* Heap */ int lock_for_write, /* Set to 1 if we're going to delete or modify existing terms */ - mtraversal_on_nothing_can_match_t on_nothing_can_match, - mtraversal_on_match_res_t on_match_res, - mtraversal_on_loop_ended_t on_loop_ended, - mtraversal_on_trap_t on_trap, - void* context_ptr, /* State for callbacks above */ + match_callbacks_t* ctx, Eterm* ret) { Sint slot_ix; /* Slot index */ @@ -1212,14 +1240,10 @@ static int match_traverse(Process* p, DbTableHash* tb, if (!mpi.something_can_match) { /* Can't possibly match anything */ - ret_value = on_nothing_can_match(context_ptr, ret); + ret_value = ctx->on_nothing_can_match(ctx, ret); goto done; } - if (mpi.all_objects) { - mpi.mp->intern.flags |= BIN_FLAG_ALL_OBJECTS; - } - /* * Look for initial slot / bucket */ @@ -1235,7 +1259,8 @@ static int match_traverse(Process* p, DbTableHash* tb, } slot_ix = next_slot_function(tb,slot_ix,&lck); if (slot_ix == 0) { - ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, &mpi.mp, ret); + ret_value = ctx->on_loop_ended(ctx, slot_ix, got, iterations_left, + &mpi.mp, ret); goto done; } } @@ -1253,11 +1278,11 @@ static int match_traverse(Process* p, DbTableHash* tb, */ for(;;) { if (*current_ptr != NULL) { - if ((*current_ptr)->hvalue != INVALID_HASH) { - match_res = db_match_dbterm(&tb->common, p, mpi.mp, 0, + if (!is_pseudo_deleted(*current_ptr)) { + match_res = db_match_dbterm(&tb->common, p, mpi.mp, &(*current_ptr)->dbterm, hpp, 2); saved_current = *current_ptr; - if (on_match_res(context_ptr, slot_ix, ¤t_ptr, match_res)) { + if (ctx->on_match_res(ctx, slot_ix, ¤t_ptr, match_res)) { ++got; } --iterations_left; @@ -1271,7 +1296,7 @@ static int match_traverse(Process* p, DbTableHash* tb, else if (mpi.key_given) { /* Key is bound */ unlock_hash_function(lck); if (current_list_pos == mpi.num_lists) { - ret_value = on_loop_ended(context_ptr, -1, got, iterations_left, &mpi.mp, ret); + ret_value = ctx->on_loop_ended(ctx, -1, got, iterations_left, &mpi.mp, ret); goto done; } else { slot_ix = mpi.lists[current_list_pos].ix; @@ -1296,18 +1321,18 @@ static int match_traverse(Process* p, DbTableHash* tb, * Since many heap fragments will make the GC slower, trap and GC now. */ unlock_hash_function(lck); - ret_value = on_trap(context_ptr, slot_ix, got, &mpi.mp, ret); + ret_value = ctx->on_trap(ctx, slot_ix, got, &mpi.mp, ret); goto done; } current_ptr = &BUCKET(tb,slot_ix); } } - ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, &mpi.mp, ret); + ret_value = ctx->on_loop_ended(ctx, slot_ix, got, iterations_left, &mpi.mp, ret); done: /* We should only jump directly to this label if - * we've already called on_nothing_can_match / on_loop_ended / on_trap + * we've already called ctx->nothing_can_match / loop_ended / trap */ if (mpi.mp != NULL) { erts_bin_free(mpi.mp); @@ -1332,13 +1357,9 @@ static int match_traverse_continue(Process* p, DbTableHash* tb, Binary** mpp, /* Existing match program */ int lock_for_write, /* Set to 1 if we're going to delete or modify existing terms */ - mtraversal_on_match_res_t on_match_res, - mtraversal_on_loop_ended_t on_loop_ended, - mtraversal_on_trap_t on_trap, - void* context_ptr, /* For callbacks */ + match_callbacks_t* ctx, Eterm* ret) { - int all_objects = (*mpp)->intern.flags & BIN_FLAG_ALL_OBJECTS; HashDbTerm** current_ptr; /* Refers to either the bucket pointer or * the 'next' pointer in the previous term */ @@ -1362,7 +1383,7 @@ static int match_traverse_continue(Process* p, DbTableHash* tb, || (chunk_size && got >= chunk_size)) { /* Already got all or enough in the match_list */ - ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, mpp, ret); + ret_value = ctx->on_loop_ended(ctx, slot_ix, got, iterations_left, mpp, ret); goto done; } @@ -1380,11 +1401,11 @@ static int match_traverse_continue(Process* p, DbTableHash* tb, current_ptr = &BUCKET(tb,slot_ix); for(;;) { if (*current_ptr != NULL) { - if ((*current_ptr)->hvalue != INVALID_HASH) { - match_res = db_match_dbterm(&tb->common, p, *mpp, all_objects, + if (!is_pseudo_deleted(*current_ptr)) { + match_res = db_match_dbterm(&tb->common, p, *mpp, &(*current_ptr)->dbterm, hpp, 2); saved_current = *current_ptr; - if (on_match_res(context_ptr, slot_ix, ¤t_ptr, match_res)) { + if (ctx->on_match_res(ctx, slot_ix, ¤t_ptr, match_res)) { ++got; } --iterations_left; @@ -1410,14 +1431,14 @@ static int match_traverse_continue(Process* p, DbTableHash* tb, * Since many heap fragments will make the GC slower, trap and GC now. */ unlock_hash_function(lck); - ret_value = on_trap(context_ptr, slot_ix, got, mpp, ret); + ret_value = ctx->on_trap(ctx, slot_ix, got, mpp, ret); goto done; } current_ptr = &BUCKET(tb,slot_ix); } } - ret_value = on_loop_ended(context_ptr, slot_ix, got, iterations_left, mpp, ret); + ret_value = ctx->on_loop_ended(ctx, slot_ix, got, iterations_left, mpp, ret); done: /* We should only jump directly to this label if @@ -1434,7 +1455,7 @@ done: * as well as their continuation-handling counterparts. */ -static ERTS_INLINE int on_mtraversal_simple_trap(Export* trap_function, +static ERTS_INLINE int on_simple_trap(Export* trap_function, Process* p, DbTableHash* tb, Eterm tid, @@ -1480,16 +1501,16 @@ static ERTS_INLINE int on_mtraversal_simple_trap(Export* trap_function, make_small(slot_ix), mpb, egot); - *ret = bif_trap1(trap_function, p, continuation); + ERTS_BIF_PREP_TRAP1(*ret, trap_function, p, continuation); return DB_ERROR_NONE; } -static ERTS_INLINE int unpack_simple_mtraversal_continuation(Eterm continuation, - Eterm** tptr_ptr, - Eterm* tid_ptr, - Sint* slot_ix_p, - Binary** mpp, - Sint* got_p) +static ERTS_INLINE int unpack_simple_continuation(Eterm continuation, + Eterm** tptr_ptr, + Eterm* tid_ptr, + Sint* slot_ix_p, + Binary** mpp, + Sint* got_p) { Eterm* tptr; ASSERT(is_tuple(continuation)); @@ -1524,6 +1545,7 @@ static ERTS_INLINE int unpack_simple_mtraversal_continuation(Eterm continuation, #define MAX_SELECT_CHUNK_ITERATIONS 1000 typedef struct { + match_callbacks_t base; Process* p; DbTableHash* tb; Eterm tid; @@ -1531,83 +1553,86 @@ typedef struct { Sint chunk_size; Eterm match_list; Eterm* prev_continuation_tptr; -} mtraversal_select_chunk_context_t; +} select_chunk_context_t; -static int mtraversal_select_chunk_on_nothing_can_match(void* context_ptr, Eterm* ret) { - mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr; - *ret = (sc_context_ptr->chunk_size > 0 ? am_EOT : NIL); +static int select_chunk_on_nothing_can_match(match_callbacks_t* ctx_base, Eterm* ret) +{ + select_chunk_context_t* ctx = (select_chunk_context_t*) ctx_base; + *ret = (ctx->chunk_size > 0 ? am_EOT : NIL); return DB_ERROR_NONE; } -static int mtraversal_select_chunk_on_match_res(void* context_ptr, Sint slot_ix, - HashDbTerm*** current_ptr_ptr, - Eterm match_res) +static int select_chunk_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix, + HashDbTerm*** current_ptr_ptr, + Eterm match_res) { - mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr; + select_chunk_context_t* ctx = (select_chunk_context_t*) ctx_base; if (is_value(match_res)) { - sc_context_ptr->match_list = CONS(sc_context_ptr->hp, match_res, sc_context_ptr->match_list); + ctx->match_list = CONS(ctx->hp, match_res, ctx->match_list); return 1; } return 0; } -static int mtraversal_select_chunk_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got, - Sint iterations_left, Binary** mpp, Eterm* ret) +static int select_chunk_on_loop_ended(match_callbacks_t* ctx_base, + Sint slot_ix, Sint got, + Sint iterations_left, Binary** mpp, + Eterm* ret) { - mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr; + select_chunk_context_t* ctx = (select_chunk_context_t*) ctx_base; Eterm mpb; if (iterations_left == MAX_SELECT_CHUNK_ITERATIONS) { /* We didn't get to iterate a single time, which means EOT */ - ASSERT(sc_context_ptr->match_list == NIL); - *ret = (sc_context_ptr->chunk_size > 0 ? am_EOT : NIL); + ASSERT(ctx->match_list == NIL); + *ret = (ctx->chunk_size > 0 ? am_EOT : NIL); return DB_ERROR_NONE; } else { ASSERT(iterations_left < MAX_SELECT_CHUNK_ITERATIONS); - BUMP_REDS(sc_context_ptr->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left); - if (sc_context_ptr->chunk_size) { + BUMP_REDS(ctx->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left); + if (ctx->chunk_size) { Eterm continuation; Eterm rest = NIL; Sint rest_size = 0; - if (got > sc_context_ptr->chunk_size) { /* Split list in return value and 'rest' */ - Eterm tmp = sc_context_ptr->match_list; - rest = sc_context_ptr->match_list; - while (got-- > sc_context_ptr->chunk_size + 1) { + if (got > ctx->chunk_size) { /* Split list in return value and 'rest' */ + Eterm tmp = ctx->match_list; + rest = ctx->match_list; + while (got-- > ctx->chunk_size + 1) { tmp = CDR(list_val(tmp)); ++rest_size; } ++rest_size; - sc_context_ptr->match_list = CDR(list_val(tmp)); + ctx->match_list = CDR(list_val(tmp)); CDR(list_val(tmp)) = NIL; /* Destructive, the list has never been in 'user space' */ } if (rest != NIL || slot_ix >= 0) { /* Need more calls */ - Eterm tid = sc_context_ptr->tid; - sc_context_ptr->hp = HAllocX(sc_context_ptr->p, - 3 + 7 + ERTS_MAGIC_REF_THING_SIZE, - ERTS_MAGIC_REF_THING_SIZE); - mpb = erts_db_make_match_prog_ref(sc_context_ptr->p, *mpp, &sc_context_ptr->hp); + Eterm tid = ctx->tid; + ctx->hp = HAllocX(ctx->p, + 3 + 7 + ERTS_MAGIC_REF_THING_SIZE, + ERTS_MAGIC_REF_THING_SIZE); + mpb = erts_db_make_match_prog_ref(ctx->p, *mpp, &ctx->hp); if (is_atom(tid)) - tid = erts_db_make_tid(sc_context_ptr->p, - &sc_context_ptr->tb->common); + tid = erts_db_make_tid(ctx->p, + &ctx->tb->common); continuation = TUPLE6( - sc_context_ptr->hp, + ctx->hp, tid, make_small(slot_ix), - make_small(sc_context_ptr->chunk_size), + make_small(ctx->chunk_size), mpb, rest, make_small(rest_size)); *mpp = NULL; /* Otherwise the caller will destroy it */ - sc_context_ptr->hp += 7; - *ret = TUPLE2(sc_context_ptr->hp, sc_context_ptr->match_list, continuation); + ctx->hp += 7; + *ret = TUPLE2(ctx->hp, ctx->match_list, continuation); return DB_ERROR_NONE; } else { /* All data is exhausted */ - if (sc_context_ptr->match_list != NIL) { /* No more data to search but still a + if (ctx->match_list != NIL) { /* No more data to search but still a result to return to the caller */ - sc_context_ptr->hp = HAlloc(sc_context_ptr->p, 3); - *ret = TUPLE2(sc_context_ptr->hp, sc_context_ptr->match_list, am_EOT); + ctx->hp = HAlloc(ctx->p, 3); + *ret = TUPLE2(ctx->hp, ctx->match_list, am_EOT); return DB_ERROR_NONE; } else { /* Reached the end of the ttable with no data to return */ *ret = am_EOT; @@ -1615,82 +1640,88 @@ static int mtraversal_select_chunk_on_loop_ended(void* context_ptr, Sint slot_ix } } } - *ret = sc_context_ptr->match_list; + *ret = ctx->match_list; return DB_ERROR_NONE; } } -static int mtraversal_select_chunk_on_trap(void* context_ptr, Sint slot_ix, Sint got, - Binary** mpp, Eterm* ret) +static int select_chunk_on_trap(match_callbacks_t* ctx_base, + Sint slot_ix, Sint got, + Binary** mpp, Eterm* ret) { - mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr; + select_chunk_context_t* ctx = (select_chunk_context_t*) ctx_base; Eterm mpb; Eterm continuation; Eterm* hp; - BUMP_ALL_REDS(sc_context_ptr->p); + BUMP_ALL_REDS(ctx->p); - if (sc_context_ptr->prev_continuation_tptr == NULL) { - Eterm tid = sc_context_ptr->tid; + if (ctx->prev_continuation_tptr == NULL) { + Eterm tid = ctx->tid; /* First time we're trapping */ - hp = HAllocX(sc_context_ptr->p, 7 + ERTS_MAGIC_REF_THING_SIZE, + hp = HAllocX(ctx->p, 7 + ERTS_MAGIC_REF_THING_SIZE, ERTS_MAGIC_REF_THING_SIZE); if (is_atom(tid)) - tid = erts_db_make_tid(sc_context_ptr->p, &sc_context_ptr->tb->common); - mpb = erts_db_make_match_prog_ref(sc_context_ptr->p, *mpp, &hp); + tid = erts_db_make_tid(ctx->p, &ctx->tb->common); + mpb = erts_db_make_match_prog_ref(ctx->p, *mpp, &hp); continuation = TUPLE6( hp, tid, make_small(slot_ix), - make_small(sc_context_ptr->chunk_size), + make_small(ctx->chunk_size), mpb, - sc_context_ptr->match_list, + ctx->match_list, make_small(got)); *mpp = NULL; /* otherwise the caller will destroy it */ } else { /* Not the first time we're trapping; reuse continuation terms */ - hp = HAlloc(sc_context_ptr->p, 7); + hp = HAlloc(ctx->p, 7); continuation = TUPLE6( hp, - sc_context_ptr->prev_continuation_tptr[1], + ctx->prev_continuation_tptr[1], make_small(slot_ix), - sc_context_ptr->prev_continuation_tptr[3], - sc_context_ptr->prev_continuation_tptr[4], - sc_context_ptr->match_list, + ctx->prev_continuation_tptr[3], + ctx->prev_continuation_tptr[4], + ctx->match_list, make_small(got)); } - *ret = bif_trap1(&ets_select_continue_exp, sc_context_ptr->p, continuation); + ERTS_BIF_PREP_TRAP1(*ret, &ets_select_continue_exp, ctx->p, + continuation); return DB_ERROR_NONE; } -static int db_select_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, int reverse, Eterm *ret) { +static int db_select_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, + int reverse, Eterm *ret) +{ return db_select_chunk_hash(p, tbl, tid, pattern, 0, reverse, ret); } -static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Sint chunk_size, +static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid, + Eterm pattern, Sint chunk_size, int reverse, Eterm *ret) { - mtraversal_select_chunk_context_t sc_context; - sc_context.p = p; - sc_context.tb = &tbl->hash; - sc_context.tid = tid; - sc_context.hp = NULL; - sc_context.chunk_size = chunk_size; - sc_context.match_list = NIL; - sc_context.prev_continuation_tptr = NULL; + select_chunk_context_t ctx; + + ctx.base.on_nothing_can_match = select_chunk_on_nothing_can_match; + ctx.base.on_match_res = select_chunk_on_match_res; + ctx.base.on_loop_ended = select_chunk_on_loop_ended; + ctx.base.on_trap = select_chunk_on_trap, + ctx.p = p; + ctx.tb = &tbl->hash; + ctx.tid = tid; + ctx.hp = NULL; + ctx.chunk_size = chunk_size; + ctx.match_list = NIL; + ctx.prev_continuation_tptr = NULL; return match_traverse( - sc_context.p, sc_context.tb, + ctx.p, ctx.tb, pattern, NULL, - sc_context.chunk_size, + ctx.chunk_size, MAX_SELECT_CHUNK_ITERATIONS, - &sc_context.hp, 0, - mtraversal_select_chunk_on_nothing_can_match, - mtraversal_select_chunk_on_match_res, - mtraversal_select_chunk_on_loop_ended, - mtraversal_select_chunk_on_trap, - &sc_context, ret); + &ctx.hp, 0, + &ctx.base, ret); } /* @@ -1699,47 +1730,50 @@ static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid, Eterm patte * */ -static int mtraversal_select_chunk_continue_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got, - Sint iterations_left, Binary** mpp, Eterm* ret) +static +int select_chunk_continue_on_loop_ended(match_callbacks_t* ctx_base, + Sint slot_ix, Sint got, + Sint iterations_left, Binary** mpp, + Eterm* ret) { - mtraversal_select_chunk_context_t* sc_context_ptr = (mtraversal_select_chunk_context_t*) context_ptr; + select_chunk_context_t* ctx = (select_chunk_context_t*) ctx_base; Eterm continuation; Eterm rest = NIL; Eterm* hp; ASSERT(iterations_left <= MAX_SELECT_CHUNK_ITERATIONS); - BUMP_REDS(sc_context_ptr->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left); - if (sc_context_ptr->chunk_size) { + BUMP_REDS(ctx->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left); + if (ctx->chunk_size) { Sint rest_size = 0; - if (got > sc_context_ptr->chunk_size) { + if (got > ctx->chunk_size) { /* Cannot write destructively here, the list may have been in user space */ - hp = HAlloc(sc_context_ptr->p, (got - sc_context_ptr->chunk_size) * 2); - while (got-- > sc_context_ptr->chunk_size) { - rest = CONS(hp, CAR(list_val(sc_context_ptr->match_list)), rest); + hp = HAlloc(ctx->p, (got - ctx->chunk_size) * 2); + while (got-- > ctx->chunk_size) { + rest = CONS(hp, CAR(list_val(ctx->match_list)), rest); hp += 2; - sc_context_ptr->match_list = CDR(list_val(sc_context_ptr->match_list)); + ctx->match_list = CDR(list_val(ctx->match_list)); ++rest_size; } } if (rest != NIL || slot_ix >= 0) { - hp = HAlloc(sc_context_ptr->p, 3 + 7); + hp = HAlloc(ctx->p, 3 + 7); continuation = TUPLE6( hp, - sc_context_ptr->prev_continuation_tptr[1], + ctx->prev_continuation_tptr[1], make_small(slot_ix), - sc_context_ptr->prev_continuation_tptr[3], - sc_context_ptr->prev_continuation_tptr[4], + ctx->prev_continuation_tptr[3], + ctx->prev_continuation_tptr[4], rest, make_small(rest_size)); hp += 7; - *ret = TUPLE2(hp, sc_context_ptr->match_list, continuation); + *ret = TUPLE2(hp, ctx->match_list, continuation); return DB_ERROR_NONE; } else { - if (sc_context_ptr->match_list != NIL) { - hp = HAlloc(sc_context_ptr->p, 3); - *ret = TUPLE2(hp, sc_context_ptr->match_list, am_EOT); + if (ctx->match_list != NIL) { + hp = HAlloc(ctx->p, 3); + *ret = TUPLE2(hp, ctx->match_list, am_EOT); return DB_ERROR_NONE; } else { *ret = am_EOT; @@ -1747,15 +1781,17 @@ static int mtraversal_select_chunk_continue_on_loop_ended(void* context_ptr, Sin } } } - *ret = sc_context_ptr->match_list; + *ret = ctx->match_list; return DB_ERROR_NONE; } /* * This is called when select traps */ -static int db_select_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret) { - mtraversal_select_chunk_context_t sc_context = {0}; +static int db_select_continue_hash(Process* p, DbTable* tbl, Eterm continuation, + Eterm* ret) +{ + select_chunk_context_t ctx; Eterm* tptr; Eterm tid; Binary* mp; @@ -1790,21 +1826,21 @@ static int db_select_continue_hash(Process* p, DbTable* tbl, Eterm continuation, match_list = tptr[5]; /* Proceed */ - sc_context.p = p; - sc_context.tb = &tbl->hash; - sc_context.tid = tid; - sc_context.hp = NULL; - sc_context.chunk_size = chunk_size; - sc_context.match_list = match_list; - sc_context.prev_continuation_tptr = tptr; + ctx.base.on_match_res = select_chunk_on_match_res; + ctx.base.on_loop_ended = select_chunk_continue_on_loop_ended; + ctx.base.on_trap = select_chunk_on_trap; + ctx.p = p; + ctx.tb = &tbl->hash; + ctx.tid = tid; + ctx.hp = NULL; + ctx.chunk_size = chunk_size; + ctx.match_list = match_list; + ctx.prev_continuation_tptr = tptr; return match_traverse_continue( - sc_context.p, sc_context.tb, sc_context.chunk_size, - iterations_left, &sc_context.hp, slot_ix, got, &mp, 0, - mtraversal_select_chunk_on_match_res, /* Reuse callback */ - mtraversal_select_chunk_continue_on_loop_ended, - mtraversal_select_chunk_on_trap, /* Reuse callback */ - &sc_context, ret); + ctx.p, ctx.tb, ctx.chunk_size, + iterations_left, &ctx.hp, slot_ix, got, &mp, 0, + &ctx.base, ret); badparam: *ret = NIL; @@ -1823,75 +1859,83 @@ badparam: #define MAX_SELECT_COUNT_ITERATIONS 1000 typedef struct { + match_callbacks_t base; Process* p; DbTableHash* tb; Eterm tid; - Eterm* hp; Eterm* prev_continuation_tptr; -} mtraversal_select_count_context_t; +} select_count_context_t; -static int mtraversal_select_count_on_nothing_can_match(void* context_ptr, Eterm* ret) { +static int select_count_on_nothing_can_match(match_callbacks_t* ctx_base, + Eterm* ret) +{ *ret = make_small(0); return DB_ERROR_NONE; } -static int mtraversal_select_count_on_match_res(void* context_ptr, Sint slot_ix, - HashDbTerm*** current_ptr_ptr, - Eterm match_res) +static int select_count_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix, + HashDbTerm*** current_ptr_ptr, + Eterm match_res) { return (match_res == am_true); } -static int mtraversal_select_count_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got, - Sint iterations_left, Binary** mpp, Eterm* ret) +static int select_count_on_loop_ended(match_callbacks_t* ctx_base, + Sint slot_ix, Sint got, + Sint iterations_left, Binary** mpp, + Eterm* ret) { - mtraversal_select_count_context_t* scnt_context_ptr = (mtraversal_select_count_context_t*) context_ptr; + select_count_context_t* ctx = (select_count_context_t*) ctx_base; ASSERT(iterations_left <= MAX_SELECT_COUNT_ITERATIONS); - BUMP_REDS(scnt_context_ptr->p, MAX_SELECT_COUNT_ITERATIONS - iterations_left); - *ret = erts_make_integer(got, scnt_context_ptr->p); + BUMP_REDS(ctx->p, MAX_SELECT_COUNT_ITERATIONS - iterations_left); + *ret = erts_make_integer(got, ctx->p); return DB_ERROR_NONE; } -static int mtraversal_select_count_on_trap(void* context_ptr, Sint slot_ix, Sint got, - Binary** mpp, Eterm* ret) +static int select_count_on_trap(match_callbacks_t* ctx_base, + Sint slot_ix, Sint got, + Binary** mpp, Eterm* ret) { - mtraversal_select_count_context_t* scnt_context_ptr = (mtraversal_select_count_context_t*) context_ptr; - return on_mtraversal_simple_trap( + select_count_context_t* ctx = (select_count_context_t*) ctx_base; + return on_simple_trap( &ets_select_count_continue_exp, - scnt_context_ptr->p, - scnt_context_ptr->tb, - scnt_context_ptr->tid, - scnt_context_ptr->prev_continuation_tptr, + ctx->p, + ctx->tb, + ctx->tid, + ctx->prev_continuation_tptr, slot_ix, got, mpp, ret); } -static int db_select_count_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret) { - mtraversal_select_count_context_t scnt_context = {0}; +static int db_select_count_hash(Process *p, DbTable *tbl, Eterm tid, + Eterm pattern, Eterm *ret) +{ + select_count_context_t ctx; Sint iterations_left = MAX_SELECT_COUNT_ITERATIONS; Sint chunk_size = 0; - scnt_context.p = p; - scnt_context.tb = &tbl->hash; - scnt_context.tid = tid; - scnt_context.hp = NULL; - scnt_context.prev_continuation_tptr = NULL; + ctx.base.on_nothing_can_match = select_count_on_nothing_can_match; + ctx.base.on_match_res = select_count_on_match_res; + ctx.base.on_loop_ended = select_count_on_loop_ended; + ctx.base.on_trap = select_count_on_trap; + ctx.p = p; + ctx.tb = &tbl->hash; + ctx.tid = tid; + ctx.prev_continuation_tptr = NULL; return match_traverse( - scnt_context.p, scnt_context.tb, + ctx.p, ctx.tb, pattern, NULL, chunk_size, iterations_left, NULL, 0, - mtraversal_select_count_on_nothing_can_match, - mtraversal_select_count_on_match_res, - mtraversal_select_count_on_loop_ended, - mtraversal_select_count_on_trap, - &scnt_context, ret); + &ctx.base, ret); } /* * This is called when select_count traps */ -static int db_select_count_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret) { - mtraversal_select_count_context_t scnt_context = {0}; +static int db_select_count_continue_hash(Process* p, DbTable* tbl, + Eterm continuation, Eterm* ret) +{ + select_count_context_t ctx; Eterm* tptr; Eterm tid; Binary* mp; @@ -1900,25 +1944,24 @@ static int db_select_count_continue_hash(Process* p, DbTable* tbl, Eterm continu Sint chunk_size = 0; *ret = NIL; - if (unpack_simple_mtraversal_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) { + if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) { *ret = NIL; return DB_ERROR_BADPARAM; } - scnt_context.p = p; - scnt_context.tb = &tbl->hash; - scnt_context.tid = tid; - scnt_context.hp = NULL; - scnt_context.prev_continuation_tptr = tptr; + ctx.base.on_match_res = select_count_on_match_res; + ctx.base.on_loop_ended = select_count_on_loop_ended; + ctx.base.on_trap = select_count_on_trap; + ctx.p = p; + ctx.tb = &tbl->hash; + ctx.tid = tid; + ctx.prev_continuation_tptr = tptr; return match_traverse_continue( - scnt_context.p, scnt_context.tb, chunk_size, + ctx.p, ctx.tb, chunk_size, MAX_SELECT_COUNT_ITERATIONS, NULL, slot_ix, got, &mp, 0, - mtraversal_select_count_on_match_res, /* Reuse callback */ - mtraversal_select_count_on_loop_ended, /* Reuse callback */ - mtraversal_select_count_on_trap, /* Reuse callback */ - &scnt_context, ret); + &ctx.base, ret); } #undef MAX_SELECT_COUNT_ITERATIONS @@ -1933,104 +1976,119 @@ static int db_select_count_continue_hash(Process* p, DbTable* tbl, Eterm continu #define MAX_SELECT_DELETE_ITERATIONS 1000 typedef struct { + match_callbacks_t base; Process* p; DbTableHash* tb; Eterm tid; - Eterm* hp; Eterm* prev_continuation_tptr; erts_aint_t fixated_by_me; Uint last_pseudo_delete; -} mtraversal_select_delete_context_t; + HashDbTerm* free_us; +} select_delete_context_t; -static int mtraversal_select_delete_on_nothing_can_match(void* context_ptr, Eterm* ret) { +static int select_delete_on_nothing_can_match(match_callbacks_t* ctx_base, + Eterm* ret) +{ *ret = make_small(0); return DB_ERROR_NONE; } -static int mtraversal_select_delete_on_match_res(void* context_ptr, Sint slot_ix, - HashDbTerm*** current_ptr_ptr, - Eterm match_res) +static int select_delete_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix, + HashDbTerm*** current_ptr_ptr, + Eterm match_res) { HashDbTerm** current_ptr = *current_ptr_ptr; - mtraversal_select_delete_context_t* sd_context_ptr = (mtraversal_select_delete_context_t*) context_ptr; + select_delete_context_t* ctx = (select_delete_context_t*) ctx_base; HashDbTerm* del; if (match_res != am_true) return 0; - if (NFIXED(sd_context_ptr->tb) > sd_context_ptr->fixated_by_me) { /* fixated by others? */ - if (slot_ix != sd_context_ptr->last_pseudo_delete) { - if (!add_fixed_deletion(sd_context_ptr->tb, slot_ix, sd_context_ptr->fixated_by_me)) + if (NFIXED(ctx->tb) > ctx->fixated_by_me) { /* fixated by others? */ + if (slot_ix != ctx->last_pseudo_delete) { + if (!add_fixed_deletion(ctx->tb, slot_ix, ctx->fixated_by_me)) goto do_erase; - sd_context_ptr->last_pseudo_delete = slot_ix; + ctx->last_pseudo_delete = slot_ix; } - (*current_ptr)->hvalue = INVALID_HASH; + (*current_ptr)->pseudo_deleted = 1; } else { do_erase: del = *current_ptr; *current_ptr = (*current_ptr)->next; // replace pointer to term using next - free_term(sd_context_ptr->tb, del); + del->next = ctx->free_us; + ctx->free_us = del; } - erts_atomic_dec_nob(&sd_context_ptr->tb->common.nitems); + erts_atomic_dec_nob(&ctx->tb->common.nitems); return 1; } -static int mtraversal_select_delete_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got, - Sint iterations_left, Binary** mpp, Eterm* ret) +static int select_delete_on_loop_ended(match_callbacks_t* ctx_base, + Sint slot_ix, Sint got, + Sint iterations_left, Binary** mpp, + Eterm* ret) { - mtraversal_select_delete_context_t* sd_context_ptr = (mtraversal_select_delete_context_t*) context_ptr; + select_delete_context_t* ctx = (select_delete_context_t*) ctx_base; + free_term_list(ctx->tb, ctx->free_us); + ctx->free_us = NULL; ASSERT(iterations_left <= MAX_SELECT_DELETE_ITERATIONS); - BUMP_REDS(sd_context_ptr->p, MAX_SELECT_DELETE_ITERATIONS - iterations_left); + BUMP_REDS(ctx->p, MAX_SELECT_DELETE_ITERATIONS - iterations_left); if (got) { - try_shrink(sd_context_ptr->tb); + try_shrink(ctx->tb); } - *ret = erts_make_integer(got, sd_context_ptr->p); + *ret = erts_make_integer(got, ctx->p); return DB_ERROR_NONE; } -static int mtraversal_select_delete_on_trap(void* context_ptr, Sint slot_ix, Sint got, - Binary** mpp, Eterm* ret) +static int select_delete_on_trap(match_callbacks_t* ctx_base, + Sint slot_ix, Sint got, + Binary** mpp, Eterm* ret) { - mtraversal_select_delete_context_t* sd_context_ptr = (mtraversal_select_delete_context_t*) context_ptr; - return on_mtraversal_simple_trap( + select_delete_context_t* ctx = (select_delete_context_t*) ctx_base; + free_term_list(ctx->tb, ctx->free_us); + ctx->free_us = NULL; + return on_simple_trap( &ets_select_delete_continue_exp, - sd_context_ptr->p, - sd_context_ptr->tb, - sd_context_ptr->tid, - sd_context_ptr->prev_continuation_tptr, + ctx->p, + ctx->tb, + ctx->tid, + ctx->prev_continuation_tptr, slot_ix, got, mpp, ret); } -static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret) { - mtraversal_select_delete_context_t sd_context = {0}; +static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid, + Eterm pattern, Eterm *ret) +{ + select_delete_context_t ctx; Sint chunk_size = 0; - sd_context.p = p; - sd_context.tb = &tbl->hash; - sd_context.tid = tid; - sd_context.hp = NULL; - sd_context.prev_continuation_tptr = NULL; - sd_context.fixated_by_me = sd_context.tb->common.is_thread_safe ? 0 : 1; /* TODO: something nicer */ - sd_context.last_pseudo_delete = (Uint) -1; + ctx.base.on_nothing_can_match = select_delete_on_nothing_can_match; + ctx.base.on_match_res = select_delete_on_match_res; + ctx.base.on_loop_ended = select_delete_on_loop_ended; + ctx.base.on_trap = select_delete_on_trap; + ctx.p = p; + ctx.tb = &tbl->hash; + ctx.tid = tid; + ctx.prev_continuation_tptr = NULL; + ctx.fixated_by_me = ctx.tb->common.is_thread_safe ? 0 : 1; /* TODO: something nicer */ + ctx.last_pseudo_delete = (Uint) -1; + ctx.free_us = NULL; return match_traverse( - sd_context.p, sd_context.tb, + ctx.p, ctx.tb, pattern, NULL, chunk_size, MAX_SELECT_DELETE_ITERATIONS, NULL, 1, - mtraversal_select_delete_on_nothing_can_match, - mtraversal_select_delete_on_match_res, - mtraversal_select_delete_on_loop_ended, - mtraversal_select_delete_on_trap, - &sd_context, ret); + &ctx.base, ret); } /* * This is called when select_delete traps */ -static int db_select_delete_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret) { - mtraversal_select_delete_context_t sd_context = {0}; +static int db_select_delete_continue_hash(Process* p, DbTable* tbl, + Eterm continuation, Eterm* ret) +{ + select_delete_context_t ctx; Eterm* tptr; Eterm tid; Binary* mp; @@ -2038,27 +2096,27 @@ static int db_select_delete_continue_hash(Process* p, DbTable* tbl, Eterm contin Sint slot_ix; Sint chunk_size = 0; - if (unpack_simple_mtraversal_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) { + if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) { *ret = NIL; return DB_ERROR_BADPARAM; } - sd_context.p = p; - sd_context.tb = &tbl->hash; - sd_context.tid = tid; - sd_context.hp = NULL; - sd_context.prev_continuation_tptr = tptr; - sd_context.fixated_by_me = ONLY_WRITER(p, sd_context.tb) ? 0 : 1; /* TODO: something nicer */ - sd_context.last_pseudo_delete = (Uint) -1; + ctx.base.on_match_res = select_delete_on_match_res; + ctx.base.on_loop_ended = select_delete_on_loop_ended; + ctx.base.on_trap = select_delete_on_trap; + ctx.p = p; + ctx.tb = &tbl->hash; + ctx.tid = tid; + ctx.prev_continuation_tptr = tptr; + ctx.fixated_by_me = ONLY_WRITER(p, ctx.tb) ? 0 : 1; /* TODO: something nicer */ + ctx.last_pseudo_delete = (Uint) -1; + ctx.free_us = NULL; return match_traverse_continue( - sd_context.p, sd_context.tb, chunk_size, + ctx.p, ctx.tb, chunk_size, MAX_SELECT_DELETE_ITERATIONS, NULL, slot_ix, got, &mp, 1, - mtraversal_select_delete_on_match_res, /* Reuse callback */ - mtraversal_select_delete_on_loop_ended, /* Reuse callback */ - mtraversal_select_delete_on_trap, /* Reuse callback */ - &sd_context, ret); + &ctx.base, ret); } #undef MAX_SELECT_DELETE_ITERATIONS @@ -2073,24 +2131,26 @@ static int db_select_delete_continue_hash(Process* p, DbTable* tbl, Eterm contin #define MAX_SELECT_REPLACE_ITERATIONS 1000 typedef struct { + match_callbacks_t base; Process* p; DbTableHash* tb; Eterm tid; - Eterm* hp; Eterm* prev_continuation_tptr; -} mtraversal_select_replace_context_t; +} select_replace_context_t; -static int mtraversal_select_replace_on_nothing_can_match(void* context_ptr, Eterm* ret) { +static int select_replace_on_nothing_can_match(match_callbacks_t* ctx_base, + Eterm* ret) +{ *ret = make_small(0); return DB_ERROR_NONE; } -static int mtraversal_select_replace_on_match_res(void* context_ptr, Sint slot_ix, - HashDbTerm*** current_ptr_ptr, - Eterm match_res) +static int select_replace_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix, + HashDbTerm*** current_ptr_ptr, + Eterm match_res) { - mtraversal_select_replace_context_t* sr_context_ptr = (mtraversal_select_replace_context_t*) context_ptr; - DbTableHash* tb = sr_context_ptr->tb; + select_replace_context_t* ctx = (select_replace_context_t*) ctx_base; + DbTableHash* tb = ctx->tb; HashDbTerm* new; HashDbTerm* next; HashValue hval; @@ -2106,6 +2166,7 @@ static int mtraversal_select_replace_on_match_res(void* context_ptr, Sint slot_i new = new_dbterm(tb, match_res); new->next = next; new->hvalue = hval; + new->pseudo_deleted = 0; free_term(tb, **current_ptr_ptr); **current_ptr_ptr = new; /* replace 'next' pointer in previous object */ *current_ptr_ptr = &((**current_ptr_ptr)->next); /* advance to next object */ @@ -2114,35 +2175,37 @@ static int mtraversal_select_replace_on_match_res(void* context_ptr, Sint slot_i return 0; } -static int mtraversal_select_replace_on_loop_ended(void* context_ptr, Sint slot_ix, Sint got, - Sint iterations_left, Binary** mpp, Eterm* ret) +static int select_replace_on_loop_ended(match_callbacks_t* ctx_base, Sint slot_ix, + Sint got, Sint iterations_left, + Binary** mpp, Eterm* ret) { - mtraversal_select_replace_context_t* sr_context_ptr = (mtraversal_select_replace_context_t*) context_ptr; + select_replace_context_t* ctx = (select_replace_context_t*) ctx_base; ASSERT(iterations_left <= MAX_SELECT_REPLACE_ITERATIONS); /* the more objects we've replaced, the more reductions we've consumed */ - BUMP_REDS(sr_context_ptr->p, + BUMP_REDS(ctx->p, MIN(MAX_SELECT_REPLACE_ITERATIONS * 2, (MAX_SELECT_REPLACE_ITERATIONS - iterations_left) + (int)got)); - *ret = erts_make_integer(got, sr_context_ptr->p); + *ret = erts_make_integer(got, ctx->p); return DB_ERROR_NONE; } -static int mtraversal_select_replace_on_trap(void* context_ptr, Sint slot_ix, Sint got, - Binary** mpp, Eterm* ret) +static int select_replace_on_trap(match_callbacks_t* ctx_base, + Sint slot_ix, Sint got, + Binary** mpp, Eterm* ret) { - mtraversal_select_replace_context_t* sr_context_ptr = (mtraversal_select_replace_context_t*) context_ptr; - return on_mtraversal_simple_trap( + select_replace_context_t* ctx = (select_replace_context_t*) ctx_base; + return on_simple_trap( &ets_select_replace_continue_exp, - sr_context_ptr->p, - sr_context_ptr->tb, - sr_context_ptr->tid, - sr_context_ptr->prev_continuation_tptr, + ctx->p, + ctx->tb, + ctx->tid, + ctx->prev_continuation_tptr, slot_ix, got, mpp, ret); } static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret) { - mtraversal_select_replace_context_t sr_context = {0}; + select_replace_context_t ctx; Sint chunk_size = 0; /* Bag implementation presented both semantic consistency and performance issues, @@ -2150,22 +2213,21 @@ static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pat */ ASSERT(!(tbl->hash.common.status & DB_BAG)); - sr_context.p = p; - sr_context.tb = &tbl->hash; - sr_context.tid = tid; - sr_context.hp = NULL; - sr_context.prev_continuation_tptr = NULL; + ctx.base.on_nothing_can_match = select_replace_on_nothing_can_match; + ctx.base.on_match_res = select_replace_on_match_res; + ctx.base.on_loop_ended = select_replace_on_loop_ended; + ctx.base.on_trap = select_replace_on_trap; + ctx.p = p; + ctx.tb = &tbl->hash; + ctx.tid = tid; + ctx.prev_continuation_tptr = NULL; return match_traverse( - sr_context.p, sr_context.tb, + ctx.p, ctx.tb, pattern, db_match_keeps_key, chunk_size, MAX_SELECT_REPLACE_ITERATIONS, NULL, 1, - mtraversal_select_replace_on_nothing_can_match, - mtraversal_select_replace_on_match_res, - mtraversal_select_replace_on_loop_ended, - mtraversal_select_replace_on_trap, - &sr_context, ret); + &ctx.base, ret); } /* @@ -2173,7 +2235,7 @@ static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pat */ static int db_select_replace_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret) { - mtraversal_select_replace_context_t sr_context = {0}; + select_replace_context_t ctx; Eterm* tptr; Eterm tid ; Binary* mp; @@ -2182,26 +2244,25 @@ static int db_select_replace_continue_hash(Process* p, DbTable* tbl, Eterm conti Sint chunk_size = 0; *ret = NIL; - if (unpack_simple_mtraversal_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) { + if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) { *ret = NIL; return DB_ERROR_BADPARAM; } /* Proceed */ - sr_context.p = p; - sr_context.tb = &tbl->hash; - sr_context.tid = tid; - sr_context.hp = NULL; - sr_context.prev_continuation_tptr = tptr; + ctx.base.on_match_res = select_replace_on_match_res; + ctx.base.on_loop_ended = select_replace_on_loop_ended; + ctx.base.on_trap = select_replace_on_trap; + ctx.p = p; + ctx.tb = &tbl->hash; + ctx.tid = tid; + ctx.prev_continuation_tptr = tptr; return match_traverse_continue( - sr_context.p, sr_context.tb, chunk_size, + ctx.p, ctx.tb, chunk_size, MAX_SELECT_REPLACE_ITERATIONS, NULL, slot_ix, got, &mp, 1, - mtraversal_select_replace_on_match_res, /* Reuse callback */ - mtraversal_select_replace_on_loop_ended, /* Reuse callback */ - mtraversal_select_replace_on_trap, /* Reuse callback */ - &sr_context, ret); + &ctx.base, ret); } @@ -2209,6 +2270,7 @@ static int db_take_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) { DbTableHash *tb = &tbl->hash; HashDbTerm **bp, *b; + HashDbTerm *free_us = NULL; HashValue hval = MAKE_HASH(key); erts_rwmtx_t *lck = WLOCK_HASH(tb, hval); int ix = hash_to_ix(tb, hval); @@ -2226,12 +2288,13 @@ static int db_take_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) && add_fixed_deletion(tb, ix, 0)) { /* Pseudo remove (no need to keep several of same key) */ bp = &b->next; - b->hvalue = INVALID_HASH; + b->pseudo_deleted = 1; b = b->next; } else { - *bp = b->next; - free_term(tb, b); - b = *bp; + HashDbTerm* next = b->next; + b->next = free_us; + free_us = b; + b = *bp = next; } } break; @@ -2242,6 +2305,7 @@ static int db_take_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) erts_atomic_add_nob(&tb->common.nitems, nitems_diff); try_shrink(tb); } + free_term_list(tb, free_us); return DB_ERROR_NONE; } @@ -2255,25 +2319,52 @@ void db_initialize_hash(void) } -int db_mark_all_deleted_hash(DbTable *tbl) +static SWord db_mark_all_deleted_hash(DbTable *tbl, SWord reds) { + const int LOOPS_PER_REDUCTION = 8; DbTableHash *tb = &tbl->hash; - HashDbTerm* list; + FixedDeletion* fixdel; + SWord loops = reds * LOOPS_PER_REDUCTION; int i; ERTS_LC_ASSERT(IS_TAB_WLOCKED(tb)); - for (i = 0; i < NACTIVE(tb); i++) { - if ((list = BUCKET(tb,i)) != NULL) { - add_fixed_deletion(tb, i, 0); - do { - list->hvalue = INVALID_HASH; - list = list->next; - }while(list != NULL); - } + fixdel = (FixedDeletion*) erts_atomic_read_nob(&tb->fixdel); + if (fixdel && fixdel->trap) { + /* Continue after trap */ + ASSERT(fixdel->all); + ASSERT(fixdel->slot < NACTIVE(tb)); + i = fixdel->slot; + } + else { + /* First call */ + fixdel = erts_db_alloc(ERTS_ALC_T_DB_FIX_DEL, + (DbTable *) tb, + sizeof(FixedDeletion)); + ERTS_ETS_MISC_MEM_ADD(sizeof(FixedDeletion)); + link_fixdel(tb, fixdel, 0); + i = 0; } + + do { + HashDbTerm* b; + for (b = BUCKET(tb,i); b; b = b->next) + b->pseudo_deleted = 1; + } while (++i < NACTIVE(tb) && --loops > 0); + + if (i < NACTIVE(tb)) { + /* Yield */ + fixdel->slot = i; + fixdel->all = 0; + fixdel->trap = 1; + return -1; + } + + fixdel->slot = NACTIVE(tb) - 1; + fixdel->all = 1; + fixdel->trap = 0; erts_atomic_set_nob(&tb->common.nitems, 0); - return DB_ERROR_NONE; + return loops < 0 ? 0 : loops / LOOPS_PER_REDUCTION; } @@ -2316,7 +2407,7 @@ static void db_print_hash(fmtfn_t to, void *to_arg, int show, DbTable *tbl) continue; erts_print(to, to_arg, "%d: [", i); while(list != 0) { - if (list->hvalue == INVALID_HASH) + if (is_pseudo_deleted(list)) erts_print(to, to_arg, "*"); if (tb->common.compress) { Eterm key = GETKEY(tb, list->dbterm.tpl); @@ -2335,9 +2426,9 @@ static void db_print_hash(fmtfn_t to, void *to_arg, int show, DbTable *tbl) } } -/* release all memory occupied by a single table */ -static int db_free_table_hash(DbTable *tbl) +static int db_free_empty_table_hash(DbTable *tbl) { + ASSERT(NITEMS(tbl) == 0); while (db_free_table_continue_hash(tbl, ERTS_SWORD_MAX) < 0) ; return 0; @@ -2415,7 +2506,6 @@ static int analyze_pattern(DbTableHash *tb, Eterm pattern, mpi->num_lists = 0; mpi->key_given = 1; mpi->something_can_match = 0; - mpi->all_objects = 1; mpi->mp = NULL; for (lst = pattern; is_list(lst); lst = CDR(list_val(lst))) @@ -2468,7 +2558,6 @@ static int analyze_pattern(DbTableHash *tb, Eterm pattern, if (!is_list(body) || CDR(list_val(body)) != NIL || CAR(list_val(body)) != am_DollarUnderscore) { - mpi->all_objects = 0; } ++i; if (!(mpi->key_given)) { @@ -2682,7 +2771,7 @@ static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2, if (!sz) { ptr = ptr1; while(ptr != ptr2) { - if (ptr->hvalue != INVALID_HASH) + if (!is_pseudo_deleted(ptr)) sz += ptr->dbterm.size + 2; ptr = ptr->next; } @@ -2693,7 +2782,7 @@ static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2, ptr = ptr1; while(ptr != ptr2) { - if (ptr->hvalue != INVALID_HASH) { + if (!is_pseudo_deleted(ptr)) { copy = db_copy_object_from_ets(&tb->common, &ptr->dbterm, &hp, &MSO(p)); list = CONS(hp, copy, list); hp += 2; @@ -2786,7 +2875,7 @@ static void grow(DbTableHash* tb, int nitems) p = *pnext; to_pnext = &BUCKET(tb, to_ix); while (p != NULL) { - if (p->hvalue == INVALID_HASH) { /* rare but possible with fine locking */ + if (is_pseudo_deleted(p)) { /* rare but possible with fine locking */ *pnext = p->next; free_term(tb, p); p = *pnext; @@ -2859,7 +2948,7 @@ static void shrink(DbTableHash* tb, int nitems) * as we must step through "src" anyway to purge pseudo deleted. */ while(*bp != NULL) { - if ((*bp)->hvalue == INVALID_HASH) { + if (is_pseudo_deleted(*bp)) { HashDbTerm* deleted = *bp; *bp = deleted->next; free_term(tb, deleted); @@ -2917,7 +3006,7 @@ static HashDbTerm* next_live(DbTableHash *tb, Uint *iptr, erts_rwmtx_t** lck_ptr ERTS_LC_ASSERT(IS_HASH_RLOCKED(tb,*iptr)); for ( ; list != NULL; list = list->next) { - if (list->hvalue != INVALID_HASH) + if (!is_pseudo_deleted(list)) return list; } @@ -2926,7 +3015,7 @@ static HashDbTerm* next_live(DbTableHash *tb, Uint *iptr, erts_rwmtx_t** lck_ptr list = BUCKET(tb,i); while (list != NULL) { - if (list->hvalue != INVALID_HASH) { + if (!is_pseudo_deleted(list)) { *iptr = i; return list; } @@ -2959,7 +3048,7 @@ db_lookup_dbterm_hash(Process *p, DbTable *tbl, Eterm key, Eterm obj, break; } if (has_key(tb, b, key, hval)) { - if (b->hvalue != INVALID_HASH) { + if (!is_pseudo_deleted(b)) { goto Ldone; } break; @@ -2989,16 +3078,18 @@ db_lookup_dbterm_hash(Process *p, DbTable *tbl, Eterm key, Eterm obj, HashDbTerm *q = new_dbterm(tb, obj); q->hvalue = hval; + q->pseudo_deleted = 0; q->next = NULL; *bp = b = q; flags |= DB_INC_TRY_GROW; } else { HashDbTerm *q, *next = b->next; - ASSERT(b->hvalue == INVALID_HASH); + ASSERT(is_pseudo_deleted(b)); q = replace_dbterm(tb, b, obj); q->next = next; - q->hvalue = hval; + ASSERT(q->hvalue == hval); + q->pseudo_deleted = 0; *bp = b = q; erts_atomic_inc_nob(&tb->common.nitems); } @@ -3036,7 +3127,7 @@ db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle) if (handle->flags & DB_NEW_OBJECT && cret != DB_ERROR_NONE) { if (IS_FIXED(tb) && add_fixed_deletion(tb, hash_to_ix(tb, b->hvalue), 0)) { - b->hvalue = INVALID_HASH; + b->pseudo_deleted = 1; } else { *bp = b->next; free_me = b; @@ -3073,16 +3164,19 @@ db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle) return; } -static int db_delete_all_objects_hash(Process* p, DbTable* tbl) +static SWord db_delete_all_objects_hash(Process* p, DbTable* tbl, SWord reds) { if (IS_FIXED(tbl)) { - db_mark_all_deleted_hash(tbl); + reds = db_mark_all_deleted_hash(tbl, reds); } else { - db_free_table_hash(tbl); + reds = db_free_table_continue_hash(tbl, reds); + if (reds < 0) + return reds; + db_create_hash(p, tbl); erts_atomic_set_nob(&tbl->hash.common.nitems, 0); } - return 0; + return reds; } void db_foreach_offheap_hash(DbTable *tbl, @@ -3125,7 +3219,7 @@ void db_calc_stats_hash(DbTableHash* tb, DbHashStats* stats) len = 0; for (b = BUCKET(tb,ix); b!=NULL; b=b->next) { len++; - if (b->hvalue == INVALID_HASH) + if (is_pseudo_deleted(b)) ++kept_items; } sum += len; diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h index 7d27609825..08e5b13db1 100644 --- a/erts/emulator/beam/erl_db_hash.h +++ b/erts/emulator/beam/erl_db_hash.h @@ -24,13 +24,26 @@ #include "erl_db_util.h" /* DbTerm & DbTableCommon */ typedef struct fixed_deletion { - int slot; + UWord slot : sizeof(UWord)*8 - 2; + UWord all : 1; + UWord trap : 1; struct fixed_deletion *next; } FixedDeletion; + +typedef Uint32 HashVal; + typedef struct hash_db_term { struct hash_db_term* next; /* next bucket */ - HashValue hvalue; /* stored hash value */ +#if SIZEOF_VOID_P == 4 + Uint32 hvalue : 31; /* stored hash value */ + Uint32 pseudo_deleted : 1; +# define MAX_HASH_MASK (((Uint32)1 << 31)-1) +#elif SIZEOF_VOID_P == 8 + Uint32 hvalue; + Uint32 pseudo_deleted; +# define MAX_HASH_MASK ((Uint32)(Sint32)-1) +#endif DbTerm dbterm; /* The actual term */ } HashDbTerm; @@ -86,9 +99,6 @@ int db_get_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret); int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret); -/* not yet in method table */ -int db_mark_all_deleted_hash(DbTable *tbl); - typedef struct { float avg_chain_len; float std_dev_chain_len; diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 5a276b9d88..0692583dd4 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -170,11 +170,6 @@ static ERTS_INLINE TreeDbTerm* replace_dbterm(DbTableTree *tb, TreeDbTerm* old, #define DIR_END 2 /* - * Special binary flag - */ -#define BIN_FLAG_ALL_OBJECTS BIN_FLAG_USR1 - -/* * Number of records to delete before trapping. */ #define DELETE_RECORD_LIMIT 12000 @@ -218,9 +213,6 @@ static void do_dump_tree2(DbTableTree*, int to, void *to_arg, int show, * functions. */ struct mp_info { - int all_objects; /* True if complete objects are always - * returned from the match_spec (can use - * copy_shallow on the return value) */ int something_can_match; /* The match_spec is not "impossible" */ int some_limitation; /* There is some limitation on the search * area, i. e. least and/or most is set.*/ @@ -248,7 +240,6 @@ struct select_context { Eterm *lastobj; Sint32 max; int keypos; - int all_objects; Sint got; Sint chunk_size; }; @@ -263,7 +254,6 @@ struct select_count_context { Eterm *lastobj; Sint32 max; int keypos; - int all_objects; Sint got; }; @@ -293,7 +283,6 @@ struct select_replace_context { Eterm *lastobj; Sint32 max; int keypos; - int all_objects; Sint replaced; }; @@ -428,7 +417,7 @@ static int db_select_replace_continue_tree(Process *p, DbTable *tbl, static int db_take_tree(Process *, DbTable *, Eterm, Eterm *); static void db_print_tree(fmtfn_t to, void *to_arg, int show, DbTable *tbl); -static int db_free_table_tree(DbTable *tbl); +static int db_free_empty_table_tree(DbTable *tbl); static SWord db_free_table_continue_tree(DbTable *tbl, SWord); @@ -436,7 +425,7 @@ static void db_foreach_offheap_tree(DbTable *, void (*)(ErlOffHeap *, void *), void *); -static int db_delete_all_objects_tree(Process* p, DbTable* tbl); +static SWord db_delete_all_objects_tree(Process* p, DbTable* tbl, SWord reds); #ifdef HARDDEBUG static void db_check_table_tree(DbTable *tbl); @@ -481,7 +470,7 @@ DbTableMethod db_tree = db_select_replace_continue_tree, db_take_tree, db_delete_all_objects_tree, - db_free_table_tree, + db_free_empty_table_tree, db_free_table_continue_tree, db_print_tree, db_foreach_offheap_tree, @@ -992,7 +981,6 @@ static int db_select_continue_tree(Process *p, sc.lastobj = NULL; sc.max = 1000; sc.keypos = tb->common.keypos; - sc.all_objects = mp->intern.flags & BIN_FLAG_ALL_OBJECTS; sc.chunk_size = chunk_size; reverse = unsigned_val(tptr[7]); sc.got = signed_val(tptr[8]); @@ -1143,7 +1131,6 @@ static int db_select_tree(Process *p, DbTable *tbl, Eterm tid, } sc.mp = mpi.mp; - sc.all_objects = mpi.all_objects; if (!mpi.got_partial && mpi.some_limitation && CMP_EQ(mpi.least,mpi.most)) { @@ -1183,8 +1170,6 @@ static int db_select_tree(Process *p, DbTable *tbl, Eterm tid, sz = size_object(key); hp = HAlloc(p, 9 + sz + ERTS_MAGIC_REF_THING_SIZE); key = copy_struct(key, sz, &hp, &MSO(p)); - if (mpi.all_objects) - (mpi.mp)->intern.flags |= BIN_FLAG_ALL_OBJECTS; mpb= erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE8 @@ -1346,7 +1331,6 @@ static int db_select_count_tree(Process *p, DbTable *tbl, Eterm tid, } sc.mp = mpi.mp; - sc.all_objects = mpi.all_objects; if (!mpi.got_partial && mpi.some_limitation && CMP_EQ(mpi.least,mpi.most)) { @@ -1381,8 +1365,6 @@ static int db_select_count_tree(Process *p, DbTable *tbl, Eterm tid, hp += BIG_UINT_HEAP_SIZE; } key = copy_struct(key, sz, &hp, &MSO(p)); - if (mpi.all_objects) - (mpi.mp)->intern.flags |= BIN_FLAG_ALL_OBJECTS; mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE5 @@ -1449,7 +1431,6 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid, } sc.mp = mpi.mp; - sc.all_objects = mpi.all_objects; if (!mpi.got_partial && mpi.some_limitation && CMP_EQ(mpi.least,mpi.most)) { @@ -1506,8 +1487,6 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid, sz = size_object(key); hp = HAlloc(p, 9 + sz + ERTS_MAGIC_REF_THING_SIZE); key = copy_struct(key, sz, &hp, &MSO(p)); - if (mpi.all_objects) - (mpi.mp)->intern.flags |= BIN_FLAG_ALL_OBJECTS; mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE8 @@ -1532,8 +1511,6 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid, hp = HAlloc(p, 9 + sz + ERTS_MAGIC_REF_THING_SIZE); key = copy_struct(key, sz, &hp, &MSO(p)); - if (mpi.all_objects) - (mpi.mp)->intern.flags |= BIN_FLAG_ALL_OBJECTS; mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE8 (hp, @@ -1882,7 +1859,6 @@ static int db_select_replace_tree(Process *p, DbTable *tbl, Eterm tid, } sc.mp = mpi.mp; - sc.all_objects = mpi.all_objects; stack = get_static_stack(tb); if (!mpi.got_partial && mpi.some_limitation && @@ -1928,8 +1904,6 @@ static int db_select_replace_tree(Process *p, DbTable *tbl, Eterm tid, hp += BIG_UINT_HEAP_SIZE; } key = copy_struct(key, sz, &hp, &MSO(p)); - if (mpi.all_objects) - (mpi.mp)->intern.flags |= BIN_FLAG_ALL_OBJECTS; mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp); continuation = TUPLE5 @@ -1995,8 +1969,9 @@ static void db_print_tree(fmtfn_t to, void *to_arg, } /* release all memory occupied by a single table */ -static int db_free_table_tree(DbTable *tbl) +static int db_free_empty_table_tree(DbTable *tbl) { + ASSERT(tbl->tree.root == NULL); while (db_free_table_continue_tree(tbl, ERTS_SWORD_MAX) < 0) ; return 1; @@ -2023,12 +1998,14 @@ static SWord db_free_table_continue_tree(DbTable *tbl, SWord reds) return reds; } -static int db_delete_all_objects_tree(Process* p, DbTable* tbl) +static SWord db_delete_all_objects_tree(Process* p, DbTable* tbl, SWord reds) { - db_free_table_tree(tbl); + reds = db_free_table_continue_tree(tbl, reds); + if (reds < 0) + return reds; db_create_tree(p, tbl); erts_atomic_set_nob(&tbl->tree.common.nitems, 0); - return 0; + return reds; } static void do_db_tree_foreach_offheap(TreeDbTerm *, @@ -2214,7 +2191,6 @@ static int analyze_pattern(DbTableTree *tb, Eterm pattern, mpi->got_partial = 0; mpi->something_can_match = 0; mpi->mp = NULL; - mpi->all_objects = 1; mpi->save_term = NULL; for (lst = pattern; is_list(lst); lst = CDR(list_val(lst))) @@ -2264,7 +2240,6 @@ static int analyze_pattern(DbTableTree *tb, Eterm pattern, if (!is_list(body) || CDR(list_val(body)) != NIL || CAR(list_val(body)) != am_DollarUnderscore) { - mpi->all_objects = 0; } ++i; @@ -3339,8 +3314,7 @@ static int doit_select(DbTableTree *tb, TreeDbTerm *this, void *ptr, GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0))) { return 0; } - ret = db_match_dbterm(&tb->common,sc->p,sc->mp,sc->all_objects, - &this->dbterm, &hp, 2); + ret = db_match_dbterm(&tb->common, sc->p, sc->mp, &this->dbterm, &hp, 2); if (is_value(ret)) { sc->accum = CONS(hp, ret, sc->accum); } @@ -3371,8 +3345,7 @@ static int doit_select_count(DbTableTree *tb, TreeDbTerm *this, void *ptr, 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); + ret = db_match_dbterm(&tb->common, sc->p, sc->mp, &this->dbterm, NULL, 0); if (ret == am_true) { ++(sc->got); } @@ -3401,8 +3374,7 @@ static int doit_select_chunk(DbTableTree *tb, TreeDbTerm *this, void *ptr, return 0; } - ret = db_match_dbterm(&tb->common, sc->p, sc->mp, sc->all_objects, - &this->dbterm, &hp, 2); + ret = db_match_dbterm(&tb->common, sc->p, sc->mp, &this->dbterm, &hp, 2); if (is_value(ret)) { ++(sc->got); sc->accum = CONS(hp, ret, sc->accum); @@ -3437,8 +3409,7 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr, cmp_partly_bound(sc->end_condition, 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); + ret = db_match_dbterm(&tb->common, sc->p, sc->mp, &this->dbterm, NULL, 0); if (ret == am_true) { key = GETKEY(sc->tb, this->dbterm.tpl); linkout_tree(sc->tb, key); @@ -3465,8 +3436,7 @@ static int doit_select_replace(DbTableTree *tb, TreeDbTerm **this, void *ptr, 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); + ret = db_match_dbterm(&tb->common, sc->p, sc->mp, &(*this)->dbterm, NULL, 0); if (is_value(ret)) { TreeDbTerm* new; diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 6354abfd1f..37d261d0df 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -644,6 +644,12 @@ static DMCGuardBif guard_tab[] = DBIF_ALL }, { + am_is_map_key, + &is_map_key_2, + 2, + DBIF_ALL + }, + { am_bit_size, &bit_size_1, 1, @@ -5327,7 +5333,7 @@ void db_free_tmp_uncompressed(DbTerm* obj) } Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, - int all, DbTerm* obj, Eterm** hpp, Uint extra) + DbTerm* obj, Eterm** hpp, Uint extra) { enum erts_pam_run_flags flags; Uint32 dummy; diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 6b126f35d6..73d242449e 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -32,6 +32,7 @@ ** DMC_DEBUG does NOT need DEBUG, but DEBUG needs DMC_DEBUG */ #define DMC_DEBUG 1 +#define ETS_DBG_FORCE_TRAP 1 #endif /* @@ -180,10 +181,9 @@ typedef struct db_table_method Eterm* ret); int (*db_take)(Process *, DbTable *, Eterm, Eterm *); - int (*db_delete_all_objects)(Process* p, - DbTable* db /* [in out] */ ); + SWord (*db_delete_all_objects)(Process* p, DbTable* db, SWord reds); - int (*db_free_table)(DbTable* db /* [in out] */ ); + int (*db_free_empty_table)(DbTable* db); SWord (*db_free_table_continue)(DbTable* db, SWord reds); void (*db_print)(fmtfn_t to, @@ -267,6 +267,10 @@ typedef struct db_table_common { Uint32 status; /* bit masks defined below */ int keypos; /* defaults to 1 */ int compress; + +#ifdef ETS_DBG_FORCE_TRAP + erts_atomic_t dbg_force_trap; /* &1 force enabled, &2 trap this call */ +#endif } DbTableCommon; /* These are status bit patterns */ @@ -281,9 +285,7 @@ typedef struct db_table_common { #define DB_FINE_LOCKED (1 << 8) /* write_concurrency */ #define DB_FREQ_READ (1 << 9) /* read_concurrency */ #define DB_NAMED_TABLE (1 << 10) - -#define ERTS_ETS_TABLE_TYPES (DB_BAG|DB_SET|DB_DUPLICATE_BAG|DB_ORDERED_SET\ - |DB_FINE_LOCKED|DB_FREQ_READ|DB_NAMED_TABLE) +#define DB_BUSY (1 << 11) #define IS_HASH_TABLE(Status) (!!((Status) & \ (DB_BAG | DB_SET | DB_DUPLICATE_BAG))) @@ -469,7 +471,7 @@ Binary *db_match_compile(Eterm *matchexpr, Eterm *guards, /* Returns newly allocated MatchProg binary with refc == 0*/ Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, - int all, DbTerm* obj, Eterm** hpp, Uint extra); + DbTerm* obj, Eterm** hpp, Uint extra); Eterm db_prog_match(Process *p, Process *self, Binary *prog, Eterm term, diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 0692cea0ee..a65dbbf42b 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -413,21 +413,20 @@ erts_gc_after_bif_call_lhf(Process* p, ErlHeapFragment *live_hf_end, { int cost; - if (p->flags & F_HIBERNATE_SCHED) { + if (p->flags & (F_HIBERNATE_SCHED|F_HIPE_RECV_LOCKED)) { /* * We just hibernated. We do *not* want to mess * up the hibernation by an ordinary GC... + * + * OR + * + * We left a receive in HiPE with message + * queue lock locked, and we do not want to + * do a GC with message queue locked... */ return result; } -#ifdef HIPE - if (p->hipe_smp.have_receive_locks) { - /* Do not want to GC with message queue locked... */ - return result; - } -#endif - if (!p->mbuf) { /* Must have GC:d in BIF call... invalidate live_hf_end */ live_hf_end = ERTS_INVALID_HFRAG_PTR; diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index f577b017c3..48154b5d0f 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -43,6 +43,7 @@ * * DONE: * - erlang:is_map/1 + * - erlang:is_map_key/2 * - erlang:map_size/1 * - erlang:map_get/2 * @@ -919,7 +920,7 @@ static int hxnodecmp(hxnode_t *a, hxnode_t *b) { return -1; } -/* maps:is_key/2 */ +/* maps:is_key/2 and erlang:is_map_key/2 */ BIF_RETTYPE maps_is_key_2(BIF_ALIST_2) { if (is_map(BIF_ARG_2)) { @@ -929,6 +930,10 @@ BIF_RETTYPE maps_is_key_2(BIF_ALIST_2) { BIF_ERROR(BIF_P, BADMAP); } +BIF_RETTYPE is_map_key_2(BIF_ALIST_2) { + BIF_RET(maps_is_key_2(BIF_CALL_ARGS)); +} + /* maps:keys/1 */ BIF_RETTYPE maps_keys_1(BIF_ALIST_1) { @@ -3053,7 +3058,7 @@ BIF_RETTYPE erts_internal_map_next_3(BIF_ALIST_3) { Uint path_length = 0; Uint *path_rest = NULL; int i, elems, orig_elems; - Eterm node = map, res, *path_ptr = NULL, *hp; + Eterm node = map, res, *patch_ptr = NULL, *hp; /* A stack WSTACK is used when traversing the hashmap. * It contains: node, idx, sz, ptr @@ -3112,15 +3117,22 @@ BIF_RETTYPE erts_internal_map_next_3(BIF_ALIST_3) { } if (type == iterator) { - /* iterator uses the format {K, V, {K, V, {K, V, [Path | Map]}}}, - * so each element is 4 words large */ + /* + * Iterator uses the format {K1, V1, {K2, V2, {K3, V3, [Path | Map]}}}, + * so each element is 4 words large. + * To make iteration order independent of input reductions + * the KV-pairs are here built in DESTRUCTIVE non-reverse order. + */ hp = HAlloc(BIF_P, 4 * elems); - res = am_none; } else { - /* list used the format [Path, Map, {K,V}, {K,V} | BIF_ARG_3], - * so each element is 2+3 words large */ + /* + * List used the format [Path, Map, {K3,V3}, {K2,V2}, {K1,V1} | BIF_ARG_3], + * so each element is 2+3 words large. + * To make list order independent of input reductions + * the KV-pairs are here built in FUNCTIONAL reverse order + * as this is how the list as a whole is constructed. + */ hp = HAlloc(BIF_P, (2 + 3) * elems); - res = BIF_ARG_3; } orig_elems = elems; @@ -3144,12 +3156,15 @@ BIF_RETTYPE erts_internal_map_next_3(BIF_ALIST_3) { if (is_list(ptr[PATH_ELEM(curr_path)])) { Eterm *lst = list_val(ptr[PATH_ELEM(curr_path)]); if (type == iterator) { - res = TUPLE3(hp, CAR(lst), CDR(lst), res); hp += 4; - /* Note where we should patch the Iterator is needed */ - path_ptr = hp-1; + res = make_tuple(hp); + hp[0] = make_arityval(3); + hp[1] = CAR(lst); + hp[2] = CDR(lst); + patch_ptr = &hp[3]; + hp += 4; } else { Eterm tup = TUPLE2(hp, CAR(lst), CDR(lst)); hp += 3; - res = CONS(hp, tup, res); hp += 2; + res = CONS(hp, tup, BIF_ARG_3); hp += 2; } elems--; break; @@ -3183,7 +3198,12 @@ BIF_RETTYPE erts_internal_map_next_3(BIF_ALIST_3) { while (idx < sz && elems != 0 && is_list(ptr[idx])) { Eterm *lst = list_val(ptr[idx]); if (type == iterator) { - res = TUPLE3(hp, CAR(lst), CDR(lst), res); hp += 4; + *patch_ptr = make_tuple(hp); + hp[0] = make_arityval(3); + hp[1] = CAR(lst); + hp[2] = CDR(lst); + patch_ptr = &hp[3]; + hp += 4; } else { Eterm tup = TUPLE2(hp, CAR(lst), CDR(lst)); hp += 3; res = CONS(hp, tup, res); hp += 2; @@ -3281,7 +3301,7 @@ BIF_RETTYPE erts_internal_map_next_3(BIF_ALIST_3) { if (type == iterator) { hp = HAlloc(BIF_P, 2); - *path_ptr = CONS(hp, path, map); hp += 2; + *patch_ptr = CONS(hp, path, map); hp += 2; } else { hp = HAlloc(BIF_P, 4); res = CONS(hp, map, res); hp += 2; @@ -3289,6 +3309,7 @@ BIF_RETTYPE erts_internal_map_next_3(BIF_ALIST_3) { } } else { if (type == iterator) { + *patch_ptr = am_none; HRelease(BIF_P, hp + 4 * elems, hp); } else { HRelease(BIF_P, hp + (2+3) * elems, hp); diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index bea7a0fe86..507cc989d2 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -379,7 +379,10 @@ queue_messages(Process* receiver, erts_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ); } - erts_proc_notify_new_message(receiver, receiver_locks); + if (last == &first->next) + erts_proc_notify_new_message(receiver, receiver_locks); + else + erts_proc_notify_new_sig(receiver, state, ERTS_PSFLG_ACTIVE); } static ERTS_INLINE diff --git a/erts/emulator/beam/erl_monitor_link.c b/erts/emulator/beam/erl_monitor_link.c index 70f36fb6b7..48d9bd4ca5 100644 --- a/erts/emulator/beam/erl_monitor_link.c +++ b/erts/emulator/beam/erl_monitor_link.c @@ -630,7 +630,9 @@ erts_monitor_tree_lookup_create(ErtsMonitor **root, int *created, Uint16 type, ErtsMonitor *res; ErtsMonitorCreateCtxt cctxt = {type, origin}; - ERTS_ML_ASSERT(type == ERTS_MON_TYPE_NODE || type == ERTS_MON_TYPE_NODES); + ERTS_ML_ASSERT(type == ERTS_MON_TYPE_NODE + || type == ERTS_MON_TYPE_NODES + || type == ERTS_MON_TYPE_SUSPEND); res = (ErtsMonitor *) ml_rbt_lookup_create((ErtsMonLnkNode **) root, target, create_monitor, @@ -760,11 +762,13 @@ erts_monitor_create(Uint16 type, Eterm ref, Eterm orgn, Eterm trgt, Eterm name) switch (type) { case ERTS_MON_TYPE_PROC: case ERTS_MON_TYPE_PORT: - case ERTS_MON_TYPE_TIME_OFFSET: if (is_nil(name)) { ErtsMonitorDataHeap *mdhp; ErtsORefThing *ortp; + case ERTS_MON_TYPE_TIME_OFFSET: + + ERTS_ML_ASSERT(is_nil(name)); ERTS_ML_ASSERT(is_immed(orgn) && is_immed(trgt)); ERTS_ML_ASSERT(is_internal_ordinary_ref(ref)); @@ -860,10 +864,38 @@ erts_monitor_create(Uint16 type, Eterm ref, Eterm orgn, Eterm trgt, Eterm name) mdep->dist = NULL; break; } - case ERTS_MON_TYPE_SUSPEND: - ERTS_INTERNAL_ERROR("Use erts_monitor_suspend_create() instead..."); - mdp = NULL; + case ERTS_MON_TYPE_SUSPEND: { + ErtsMonitorSuspend *msp; + + ERTS_ML_ASSERT(is_nil(name)); + ERTS_ML_ASSERT(is_nil(ref)); + ERTS_ML_ASSERT(is_internal_pid(orgn) && is_internal_pid(trgt)); + + msp = erts_alloc(ERTS_ALC_T_MONITOR_SUSPEND, + sizeof(ErtsMonitorSuspend)); + mdp = &msp->md; + ERTS_ML_ASSERT(((void *) mdp) == ((void *) msp)); + + mdp->ref = NIL; + + mdp->origin.other.item = trgt; + mdp->origin.offset = (Uint16) offsetof(ErtsMonitorData, origin); + mdp->origin.key_offset = (Uint16) offsetof(ErtsMonitor, other.item); + ERTS_ML_ASSERT(mdp->origin.key_offset >= mdp->origin.offset); + mdp->origin.flags = (Uint16) ERTS_ML_FLG_EXTENDED; + mdp->origin.type = type; + + mdp->target.other.item = orgn; + mdp->target.offset = (Uint16) offsetof(ErtsMonitorData, target); + mdp->target.key_offset = (Uint16) offsetof(ErtsMonitor, other.item); + mdp->target.flags = ERTS_ML_FLG_TARGET|ERTS_ML_FLG_EXTENDED; + mdp->target.type = type; + + msp->next = NULL; + erts_atomic_init_relb(&msp->state, 0); + break; + } default: ERTS_INTERNAL_ERROR("Invalid monitor type"); mdp = NULL; @@ -887,10 +919,11 @@ erts_monitor_destroy__(ErtsMonitorData *mdp) ERTS_ML_ASSERT(!(mdp->target.flags & ERTS_ML_FLG_IN_TABLE)); ERTS_ML_ASSERT((mdp->origin.flags & ERTS_ML_FLGS_SAME) == (mdp->target.flags & ERTS_ML_FLGS_SAME)); - ERTS_ML_ASSERT(mdp->origin.type != ERTS_MON_TYPE_SUSPEND); if (!(mdp->origin.flags & ERTS_ML_FLG_EXTENDED)) erts_free(ERTS_ALC_T_MONITOR, mdp); + else if (mdp->origin.type == ERTS_MON_TYPE_SUSPEND) + erts_free(ERTS_ALC_T_MONITOR_SUSPEND, mdp); else { ErtsMonitorDataExtended *mdep = (ErtsMonitorDataExtended *) mdp; ErlOffHeap oh; @@ -927,10 +960,10 @@ erts_monitor_size(ErtsMonitor *mon) Uint size, refc; ErtsMonitorData *mdp = erts_monitor_to_data(mon); - ERTS_ML_ASSERT(mon->type != ERTS_MON_TYPE_SUSPEND); - if (!(mon->flags & ERTS_ML_FLG_EXTENDED)) size = sizeof(ErtsMonitorDataHeap); + else if (mon->type == ERTS_MON_TYPE_SUSPEND) + size = sizeof(ErtsMonitorSuspend); else { ErtsMonitorDataExtended *mdep; Uint hsz = 0; @@ -957,54 +990,6 @@ erts_monitor_size(ErtsMonitor *mon) return size / refc; } - -/* suspend monitors... */ - -ErtsMonitorSuspend * -erts_monitor_suspend_create(Eterm pid) -{ - ErtsMonitorSuspend *msp; - - ERTS_ML_ASSERT(is_internal_pid(pid)); - - msp = erts_alloc(ERTS_ALC_T_SUSPEND_MON, - sizeof(ErtsMonitorSuspend)); - msp->mon.offset = (Uint16) offsetof(ErtsMonitorSuspend, mon); - msp->mon.key_offset = (Uint16) offsetof(ErtsMonitor, other.item); - msp->mon.other.item = pid; - msp->mon.flags = 0; - msp->mon.type = ERTS_MON_TYPE_SUSPEND; - msp->pending = 0; - msp->active = 0; - return msp; -} - -static ErtsMonLnkNode * -create_monitor_suspend(Eterm pid, void *unused) -{ - ErtsMonitorSuspend *msp = erts_monitor_suspend_create(pid); - return (ErtsMonLnkNode *) &msp->mon; -} - -ErtsMonitorSuspend * -erts_monitor_suspend_tree_lookup_create(ErtsMonitor **root, int *created, - Eterm pid) -{ - ErtsMonitor *mon; - mon = (ErtsMonitor *) ml_rbt_lookup_create((ErtsMonLnkNode **) root, - pid, create_monitor_suspend, - NULL, - created); - return erts_monitor_suspend(mon); -} - -void -erts_monitor_suspend_destroy(ErtsMonitorSuspend *msp) -{ - ERTS_ML_ASSERT(!(msp->mon.flags & ERTS_ML_FLG_IN_TABLE)); - erts_free(ERTS_ALC_T_SUSPEND_MON, msp); -} - /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * Link Operations * * * diff --git a/erts/emulator/beam/erl_monitor_link.h b/erts/emulator/beam/erl_monitor_link.h index 603aead8cc..9ff8aa509a 100644 --- a/erts/emulator/beam/erl_monitor_link.h +++ b/erts/emulator/beam/erl_monitor_link.h @@ -246,15 +246,28 @@ * * --- ERTS_MON_TYPE_SUSPEND ------------------------------------- * - * Suspend monitor. + * Suspend monitor. A local process (origin) suspends another + * local process (target). * - * Other Item: Suspendee process identifier - * Key: Suspendee process identifier - * - * Valid keys are only ordinary internal references. + * Origin: + * Other Item: Process identifier of suspendee + * (target) + * Key: Process identifier of suspendee + * (target) + * Target: + * Other Item: Process identifier of suspender + * (origin) + * Key: Process identifier of suspender + * (origin) + * Shared: + * Next: Pointer to another suspend monitor + * State: Number of suspends and a flag + * indicating if the suspend is + * active or not. * - * This type of monitor is a bit strange and the whole process - * suspend functionality should be improved... + * Origin part of the monitor is stored in the monitor tree of + * origin process and target part of the monitor is stored in + * monitor list for local targets on the target process. * * * @@ -638,11 +651,15 @@ struct ErtsMonitorDataExtended__ { Eterm heap[1]; /* heap start... */ }; -typedef struct { - ErtsMonitor mon; - int pending; - int active; -} ErtsMonitorSuspend; +typedef struct ErtsMonitorSuspend__ ErtsMonitorSuspend; + +struct ErtsMonitorSuspend__ { + ErtsMonitorData md; /* origin = suspender; target = suspendee */ + ErtsMonitorSuspend *next; + erts_atomic_t state; +}; +#define ERTS_MSUSPEND_STATE_FLG_ACTIVE ((erts_aint_t) (((Uint) 1) << (sizeof(Uint)*8 - 1))) +#define ERTS_MSUSPEND_STATE_COUNTER_MASK (~ERTS_MSUSPEND_STATE_FLG_ACTIVE) /* * --- Monitor tree operations --- @@ -1094,24 +1111,25 @@ int erts_monitor_list_foreach_delete_yielding(ErtsMonitor **list, * * @brief Create a monitor * - * Can create all types of monitors exept for suspend monitors + * Can create all types of monitors * * When the funcion is called it is assumed that: * - 'ref' is an internal ordinary reference if type is ERTS_MON_TYPE_PROC, * ERTS_MON_TYPE_PORT, ERTS_MON_TYPE_TIME_OFFSET, or ERTS_MON_TYPE_RESOURCE - * - 'ref' is NIL if type is ERTS_MON_TYPE_NODE or ERTS_MON_TYPE_NODES + * - 'ref' is NIL if type is ERTS_MON_TYPE_NODE, ERTS_MON_TYPE_NODES, or + * ERTS_MON_TYPE_SUSPEND * - 'ref' is and ordinary internal reference or an external reference if * type is ERTS_MON_TYPE_DIST_PROC * - 'name' is an atom or NIL if type is ERTS_MON_TYPE_PROC, * ERTS_MON_TYPE_PORT, or ERTS_MON_TYPE_DIST_PROC * - 'name is NIL if type is ERTS_MON_TYPE_TIME_OFFSET, ERTS_MON_TYPE_RESOURCE, - * ERTS_MON_TYPE_NODE, or ERTS_MON_TYPE_NODES + * ERTS_MON_TYPE_NODE, ERTS_MON_TYPE_NODES, or ERTS_MON_TYPE_SUSPEND * If the above is not true, bad things will happen. * * @param[in] type ERTS_MON_TYPE_PROC, ERTS_MON_TYPE_PORT, * ERTS_MON_TYPE_TIME_OFFSET, ERTS_MON_TYPE_DIST_PROC, * ERTS_MON_TYPE_RESOURCE, ERTS_MON_TYPE_NODE, - * or ERTS_MON_TYPE_NODES + * ERTS_MON_TYPE_NODES, or ERTS_MON_TYPE_SUSPEND * * @param[in] ref A reference or NIL depending on type * @@ -1119,6 +1137,10 @@ int erts_monitor_list_foreach_delete_yielding(ErtsMonitor **list, * * @param[in] target The key of the target * + * @param[in] name An atom (the name) or NIL depending on type + * + * @returns A pointer to monitor data structure + * */ ErtsMonitorData *erts_monitor_create(Uint16 type, Eterm ref, Eterm origin, Eterm target, Eterm name); @@ -1347,7 +1369,8 @@ erts_monitor_to_data(ErtsMonitor *mon) ERTS_ML_ASSERT(erts_monitor_origin_offset == (size_t) mdp->origin.offset); ERTS_ML_ASSERT(!!(mdp->target.flags & ERTS_ML_FLG_TARGET)); ERTS_ML_ASSERT(erts_monitor_target_offset == (size_t) mdp->target.offset); - if (mon->type == ERTS_MON_TYPE_NODE || mon->type == ERTS_MON_TYPE_NODES) { + if (mon->type == ERTS_MON_TYPE_NODE || mon->type == ERTS_MON_TYPE_NODES + || mon->type == ERTS_MON_TYPE_SUSPEND) { ERTS_ML_ASSERT(erts_monitor_node_key_offset == (size_t) mdp->origin.key_offset); ERTS_ML_ASSERT(erts_monitor_node_key_offset == (size_t) mdp->target.key_offset); } diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index e208792868..0fbf0eb03a 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1255,8 +1255,10 @@ size_t enif_binary_to_term(ErlNifEnv *dst_env, if (is_non_value(*term)) { return 0; } - erts_factory_close(&factory); - cache_env(dst_env); + if (size > 0) { + erts_factory_close(&factory); + cache_env(dst_env); + } ASSERT(bp > data); return bp - data; diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c index 5165cd22a5..e9b41ad298 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.c +++ b/erts/emulator/beam/erl_proc_sig_queue.c @@ -39,6 +39,7 @@ #include "big.h" #include "erl_gc.h" #include "bif.h" +#include "erl_bif_unique.h" #include "erl_proc_sig_queue.h" #include "dtrace-wrapper.h" @@ -49,7 +50,7 @@ * Note that not all signal are handled using this functionality! */ -#define ERTS_SIG_Q_OP_MAX 11 +#define ERTS_SIG_Q_OP_MAX 13 #define ERTS_SIG_Q_OP_EXIT 0 #define ERTS_SIG_Q_OP_EXIT_LINKED 1 @@ -62,7 +63,9 @@ #define ERTS_SIG_Q_OP_TRACE_CHANGE_STATE 8 #define ERTS_SIG_Q_OP_PERSISTENT_MON_MSG 9 #define ERTS_SIG_Q_OP_IS_ALIVE 10 -#define ERTS_SIG_Q_OP_PROCESS_INFO ERTS_SIG_Q_OP_MAX +#define ERTS_SIG_Q_OP_PROCESS_INFO 11 +#define ERTS_SIG_Q_OP_SYNC_SUSPEND 12 +#define ERTS_SIG_Q_OP_RPC ERTS_SIG_Q_OP_MAX #define ERTS_SIG_Q_TYPE_MAX (ERTS_MON_LNK_TYPE_MAX + 5) @@ -154,6 +157,17 @@ typedef struct { } ErtsIsAliveRequest; typedef struct { + Eterm message; + Eterm requester; + int async; +} ErtsSyncSuspendRequest; + +typedef struct { + ErtsMonitorSuspend *mon; + ErtsMessage *sync; +} ErtsProcSigPendingSuspend; + +typedef struct { ErtsSignalCommon common; Sint refc; Sint delayed_len; @@ -176,6 +190,15 @@ typedef struct { #define ERTS_PROC_SIG_PI_MSGQ_LEN_IGNORE ((Sint) -1) #define ERTS_PROC_SIG_PI_MSGQ_LEN_SYNC ((Sint) -2) +typedef struct { + ErtsSignalCommon common; + Eterm requester; + Eterm (*func)(Process *, void *, int *, ErlHeapFragment **); + void *arg; + Eterm ref; + ErtsORefThing oref_thing; +} ErtsProcSigRPC; + static int handle_msg_tracing(Process *c_p, ErtsSigRecvTracing *tracing, ErtsMessage ***next_nm_sig); @@ -519,41 +542,42 @@ erts_aint32_t erts_enqueue_signals(Process *rp, ErtsMessage *first, return enqueue_signals(rp, first, last, last_next, num_msgs, in_state); } -static ERTS_INLINE void -ensure_dirty_proc_handled(Eterm pid, - erts_aint32_t state, - erts_aint32_t prio) +void +erts_make_dirty_proc_handled(Eterm pid, + erts_aint32_t state, + erts_aint32_t prio) { - if (state & (ERTS_PSFLG_DIRTY_RUNNING - | ERTS_PSFLG_DIRTY_RUNNING_SYS)) { - Eterm *hp; - ErtsMessage *mp; - Process *sig_handler; + Eterm *hp; + ErtsMessage *mp; + Process *sig_handler; - if (prio < 0) - prio = (int) ERTS_PSFLGS_GET_USR_PRIO(state); + ASSERT(state & (ERTS_PSFLG_DIRTY_RUNNING | + ERTS_PSFLG_DIRTY_RUNNING_SYS)); - switch (prio) { - case PRIORITY_MAX: - sig_handler = erts_dirty_process_signal_handler_max; - break; - case PRIORITY_HIGH: - sig_handler = erts_dirty_process_signal_handler_high; - break; - default: - sig_handler = erts_dirty_process_signal_handler; - break; - } + if (prio < 0) + prio = (int) ERTS_PSFLGS_GET_USR_PRIO(state); - /* Make sure signals are handled... */ - mp = erts_alloc_message(0, &hp); - erts_queue_message(sig_handler, 0, mp, pid, am_system); + switch (prio) { + case PRIORITY_MAX: + sig_handler = erts_dirty_process_signal_handler_max; + break; + case PRIORITY_HIGH: + sig_handler = erts_dirty_process_signal_handler_high; + break; + default: + sig_handler = erts_dirty_process_signal_handler; + break; } + + /* Make sure signals are handled... */ + mp = erts_alloc_message(0, &hp); + erts_queue_message(sig_handler, 0, mp, pid, am_system); } static void check_push_msgq_len_offs_marker(Process *rp, ErtsSignal *sig); + static int proc_queue_signal(Process *c_p, Eterm pid, ErtsSignal *sig, int op) { @@ -679,14 +703,7 @@ first_last_done: sig_enqueue_trace_cleanup(first, sig, last); } - if (!(state & (ERTS_PSFLG_EXITING - | ERTS_PSFLG_ACTIVE_SYS - | ERTS_PSFLG_SIG_IN_Q))) { - /* Schedule process... */ - state = erts_proc_sys_schedule(rp, state, 0); - } - - ensure_dirty_proc_handled(rp->common.id, state, -1); + erts_proc_notify_new_sig(rp, state, 0); if (!is_normal_sched) erts_proc_dec_refc(rp); @@ -742,7 +759,10 @@ maybe_elevate_sig_handling_prio(Process *c_p, Eterm other) if (res) { /* ensure handled if dirty executing... */ state = erts_atomic32_read_nob(&rp->state); - ensure_dirty_proc_handled(other, state, my_prio); + if (state & (ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_DIRTY_RUNNING_SYS)) { + erts_make_dirty_proc_handled(other, state, my_prio); + } } } } @@ -1311,6 +1331,8 @@ erts_proc_sig_send_monitor_down(ErtsMonitor *mon, Eterm reason) /* Pass signal using old monitor structure... */ ErtsSignal *sig; + send_using_monitor_struct: + mon->other.item = reason; /* Pass immed reason via other.item... */ sig = (ErtsSignal *) mon; sig->common.tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_MONITOR_DOWN, @@ -1322,6 +1344,18 @@ erts_proc_sig_send_monitor_down(ErtsMonitor *mon, Eterm reason) ErtsMonitorData *mdp = erts_monitor_to_data(mon); Eterm from_tag, monitored, heap[3]; + if (mon->type == ERTS_MON_TYPE_SUSPEND) { + /* + * Set reason to 'undefined', since exit + * reason is not used for suspend monitors, + * and send using monitor structure. This + * since we don't want to trigger + * unnecessary memory allocation etc... + */ + reason = am_undefined; + goto send_using_monitor_struct; + } + if (!(mon->flags & ERTS_ML_FLG_NAME)) { from_tag = monitored = mdp->origin.other.item; if (is_external_pid(from_tag)) { @@ -1599,7 +1633,173 @@ erts_proc_sig_send_process_info_request(Process *c_p, else erts_free(ERTS_ALC_T_SIG_DATA, pis); return res; -} +} + +void +erts_proc_sig_send_sync_suspend(Process *c_p, Eterm to, Eterm tag, Eterm reply) +{ + ErlHeapFragment *hfrag; + Uint hsz, tag_sz; + Eterm *hp, *start_hp, tag_cpy, msg, default_reply; + ErlOffHeap *ohp; + ErtsMessage *mp; + ErtsSyncSuspendRequest *ssusp; + int async_suspend; + + tag_sz = size_object(tag); + + hsz = 3 + tag_sz + sizeof(ErtsSyncSuspendRequest)/sizeof(Eterm); + + mp = erts_alloc_message(hsz, &hp); + hfrag = &mp->hfrag; + mp->next = NULL; + ohp = &hfrag->off_heap; + start_hp = hp; + + tag_cpy = copy_struct(tag, tag_sz, &hp, ohp); + + async_suspend = is_non_value(reply); + default_reply = async_suspend ? am_suspended : reply; + + msg = TUPLE2(hp, tag_cpy, default_reply); + hp += 3; + + hfrag->used_size = hp - start_hp; + + ssusp = (ErtsSyncSuspendRequest *) (char *) hp; + ssusp->message = msg; + ssusp->requester = c_p->common.id; + ssusp->async = async_suspend; + + ERL_MESSAGE_TERM(mp) = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_SYNC_SUSPEND, + ERTS_SIG_Q_TYPE_UNDEFINED, + 0); + ERL_MESSAGE_TOKEN(mp) = NIL; + ERL_MESSAGE_FROM(mp) = am_system; +#ifdef USE_VM_PROBES + ERL_MESSAGE_DT_UTAG(mp) = NIL; +#endif + + if (proc_queue_signal(c_p, to, (ErtsSignal *) mp, ERTS_SIG_Q_OP_SYNC_SUSPEND)) + (void) maybe_elevate_sig_handling_prio(c_p, to); + else { + Eterm *tp; + /* It wasn't alive; reply to ourselves... */ + mp->next = NULL; + mp->data.attached = ERTS_MSG_COMBINED_HFRAG; + tp = tuple_val(msg); + tp[2] = async_suspend ? am_badarg : am_exited; + erts_queue_message(c_p, ERTS_PROC_LOCK_MAIN, + mp, msg, am_system); + } +} + +Eterm +erts_proc_sig_send_rpc_request(Process *c_p, + Eterm to, + int reply, + Eterm (*func)(Process *, void *, int *, ErlHeapFragment **), + void *arg) +{ + Eterm res; + ErtsProcSigRPC *sig = erts_alloc(ERTS_ALC_T_SIG_DATA, + sizeof(ErtsProcSigRPC)); + sig->common.tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_RPC, + ERTS_SIG_Q_TYPE_UNDEFINED, + 0); + sig->requester = reply ? c_p->common.id : NIL; + sig->func = func; + sig->arg = arg; + + if (!reply) { + res = am_ok; + sig->ref = am_ok; + } + else { + res = erts_make_ref(c_p); + + sys_memcpy((void *) &sig->oref_thing, + (void *) internal_ref_val(res), + sizeof(ErtsORefThing)); + + sig->ref = make_internal_ref(&sig->oref_thing); + + ERTS_RECV_MARK_SAVE(c_p); + ERTS_RECV_MARK_SET(c_p); + } + + if (proc_queue_signal(c_p, to, (ErtsSignal *) sig, ERTS_SIG_Q_OP_RPC)) + (void) maybe_elevate_sig_handling_prio(c_p, to); + else { + erts_free(ERTS_ALC_T_SIG_DATA, sig); + res = THE_NON_VALUE; + if (reply) + JOIN_MESSAGE(c_p); + } + + return res; +} + +static int +handle_rpc(Process *c_p, ErtsProcSigRPC *rpc, int cnt, int limit, int *yieldp) +{ + Process *rp; + ErlHeapFragment *bp = NULL; + Eterm res; + Uint hsz; + int reds, out_cnt; + + /* + * reds in: + * Reductions left. + * + * reds out: + * Absolute value of reds out equals consumed + * amount of reds. If a negative value, force + * a yield. + */ + + reds = (limit - cnt) / ERTS_SIG_REDS_CNT_FACTOR; + if (reds <= 0) + reds = 1; + + res = (*rpc->func)(c_p, rpc->arg, &reds, &bp); + + if (reds < 0) { + /* Force yield... */ + *yieldp = !0; + reds *= -1; + } + + out_cnt = reds*ERTS_SIG_REDS_CNT_FACTOR; + + hsz = 3 + sizeof(ErtsORefThing)/sizeof(Eterm); + + rp = erts_proc_lookup(rpc->requester); + if (!rp) { + if (bp) + free_message_buffer(bp); + } + else { + Eterm *hp, msg, ref; + ErtsMessage *mp = erts_alloc_message(hsz, &hp); + + sys_memcpy((void *) hp, (void *) &rpc->oref_thing, + sizeof(rpc->oref_thing)); + + ref = make_internal_ref(hp); + hp += sizeof(rpc->oref_thing)/sizeof(Eterm); + msg = TUPLE2(hp, ref, res); + + mp->hfrag.next = bp; + + erts_queue_proc_message(c_p, rp, 0, mp, msg); + } + + erts_free(ERTS_ALC_T_SIG_DATA, rpc); + + return out_cnt; +} static void is_alive_response(Process *c_p, ErtsMessage *mp, int is_alive) @@ -2643,6 +2843,155 @@ handle_process_info(Process *c_p, ErtsSigRecvTracing *tracing, return ((int) reds)*4 + 8; } +static void +handle_suspend(Process *c_p, ErtsMonitor *mon, int *yieldp) +{ + erts_aint32_t state = erts_atomic32_read_nob(&c_p->state); + + ASSERT(mon->type == ERTS_MON_TYPE_SUSPEND); + + if (!(state & ERTS_PSFLG_DIRTY_RUNNING)) { + ErtsMonitorSuspend *msp; + erts_aint_t mstate; + + msp = (ErtsMonitorSuspend *) erts_monitor_to_data(mon); + mstate = erts_atomic_read_bor_acqb(&msp->state, + ERTS_MSUSPEND_STATE_FLG_ACTIVE); + ASSERT(!(mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE)); (void) mstate; + erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); + *yieldp = !0; + } + else { + /* Executing dirty; delay suspend... */ + ErtsProcSigPendingSuspend *psusp; + ErtsMonitorSuspend *msp; + + psusp = ERTS_PROC_GET_PENDING_SUSPEND(c_p); + if (!psusp) { + psusp = erts_alloc(ERTS_ALC_T_SIG_DATA, + sizeof(ErtsProcSigPendingSuspend)); + psusp->mon = NULL; + psusp->sync = NULL; + ERTS_PROC_SET_PENDING_SUSPEND(c_p, (void *) psusp); + } + + msp = (ErtsMonitorSuspend *) erts_monitor_to_data(mon); + + msp->next = psusp->mon; + psusp->mon = msp; + + erts_atomic32_inc_nob(&msp->md.refc); + } +} + +static void +sync_suspend_reply(Process *c_p, ErtsMessage *mp, erts_aint32_t state) +{ + /* + * Sender prepared the message for us. Just patch + * the result if necessary. The default prepared + * result is 'false'. + */ + Process *rp; + ErtsSyncSuspendRequest *ssusp; + + ssusp = (ErtsSyncSuspendRequest *) (char *) (&mp->hfrag.mem[0] + + mp->hfrag.used_size); + + ASSERT(ERTS_SIG_IS_NON_MSG(mp)); + ASSERT(ERTS_PROC_SIG_OP(((ErtsSignal *) mp)->common.tag) + == ERTS_SIG_Q_OP_SYNC_SUSPEND); + ASSERT(mp->hfrag.alloc_size > mp->hfrag.used_size); + ASSERT((mp->hfrag.alloc_size - mp->hfrag.used_size)*sizeof(UWord) + >= sizeof(ErtsSyncSuspendRequest)); + ASSERT(is_internal_pid(ssusp->requester)); + ASSERT(ssusp->requester != c_p->common.id); + ASSERT(is_tuple_arity(ssusp->message, 2)); + ASSERT(is_immed(tuple_val(ssusp->message)[2])); + + ERL_MESSAGE_TERM(mp) = ssusp->message; + mp->data.attached = ERTS_MSG_COMBINED_HFRAG; + mp->next = NULL; + + rp = erts_proc_lookup(ssusp->requester); + if (!rp) + erts_cleanup_messages(mp); + else { + if ((state & (ERTS_PSFLG_EXITING + | ERTS_PSFLG_SUSPENDED)) != ERTS_PSFLG_SUSPENDED) { + /* Not suspended -> patch result... */ + if (state & ERTS_PSFLG_EXITING) { + Eterm *tp = tuple_val(ssusp->message); + tp[2] = ssusp->async ? am_exited : am_badarg; + } + else { + Eterm *tp = tuple_val(ssusp->message); + ASSERT(!(state & ERTS_PSFLG_SUSPENDED)); + tp[2] = ssusp->async ? am_not_suspended : am_internal_error; + } + } + erts_queue_proc_message(c_p, rp, 0, mp, ssusp->message); + } +} + +static void +handle_sync_suspend(Process *c_p, ErtsMessage *mp) +{ + ErtsProcSigPendingSuspend *psusp; + + psusp = (ErtsProcSigPendingSuspend *) ERTS_PROC_GET_PENDING_SUSPEND(c_p); + if (!psusp) + sync_suspend_reply(c_p, mp, erts_atomic32_read_nob(&c_p->state)); + else { + mp->next = psusp->sync; + psusp->sync = mp; + } +} + +void +erts_proc_sig_handle_pending_suspend(Process *c_p) +{ + ErtsMonitorSuspend *msp; + ErtsMessage *sync; + ErtsProcSigPendingSuspend *psusp; + erts_aint32_t state = erts_atomic32_read_nob(&c_p->state); + + psusp = (ErtsProcSigPendingSuspend *) ERTS_PROC_GET_PENDING_SUSPEND(c_p); + + msp = psusp->mon; + + while (msp) { + ErtsMonitorSuspend *next_msp = msp->next; + msp->next = NULL; + if (!(state & ERTS_PSFLG_EXITING) + && erts_monitor_is_in_table(&msp->md.target)) { + erts_aint_t mstate; + + mstate = erts_atomic_read_bor_acqb(&msp->state, + ERTS_MSUSPEND_STATE_FLG_ACTIVE); + ASSERT(!(mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE)); (void) mstate; + erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); + } + + erts_monitor_release(&msp->md.target); + + msp = next_msp; + } + + sync = psusp->sync; + + while (sync) { + ErtsMessage *next_sync = sync->next; + sync->next = NULL; + sync_suspend_reply(c_p, sync, state); + sync = next_sync; + } + + erts_free(ERTS_ALC_T_SIG_DATA, psusp); + + ERTS_PROC_SET_PENDING_SUSPEND(c_p, NULL); +} + /* * Called in order to handle incoming signals. */ @@ -2653,7 +3002,7 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep, { Eterm tag; erts_aint32_t state; - int cnt, limit, abs_lim, msg_tracing; + int yield, cnt, limit, abs_lim, msg_tracing; ErtsMessage *sig, ***next_nm_sig; ErtsSigRecvTracing tracing; @@ -2673,6 +3022,7 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep, limit = *redsp; *redsp = 0; + yield = 0; if (!c_p->sig_qs.cont) { if (state == -1) @@ -2786,6 +3136,18 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep, cnt += handle_nodedown(c_p, sig, mdp, next_nm_sig); } break; + case ERTS_MON_TYPE_SUSPEND: + tmon = (ErtsMonitor *) sig; + ASSERT(erts_monitor_is_target(tmon)); + ASSERT(!erts_monitor_is_in_table(tmon)); + mdp = erts_monitor_to_data(tmon); + if (erts_monitor_is_in_table(&mdp->origin)) { + erts_monitor_tree_delete(&ERTS_P_MONITORS(c_p), + &mdp->origin); + omon = &mdp->origin; + } + remove_nm_sig(c_p, sig, next_nm_sig); + break; default: ERTS_INTERNAL_ERROR("invalid monitor type"); break; @@ -2849,9 +3211,13 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep, if (mon->type == ERTS_MON_TYPE_DIST_PROC) erts_monitor_tree_insert(&ERTS_P_MONITORS(c_p), mon); - else + else { erts_monitor_list_insert(&ERTS_P_LT_MONITORS(c_p), mon); + if (mon->type == ERTS_MON_TYPE_SUSPEND) + handle_suspend(c_p, mon, &yield); + } ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig); + cnt += 2; break; } @@ -2895,9 +3261,16 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep, erts_monitor_tree_delete(&ERTS_P_MONITORS(c_p), tmon); else { erts_monitor_list_delete(&ERTS_P_LT_MONITORS(c_p), tmon); - if (type == ERTS_MON_TYPE_RESOURCE) { + switch (type) { + case ERTS_MON_TYPE_RESOURCE: erts_nif_demonitored((ErtsResource *) tmon->other.ptr); cnt++; + break; + case ERTS_MON_TYPE_SUSPEND: + erts_resume(c_p, ERTS_PROC_LOCK_MAIN); + break; + default: + break; } } erts_monitor_release_both(mdp); @@ -3012,6 +3385,21 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep, ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig); break; + case ERTS_SIG_Q_OP_SYNC_SUSPEND: + ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig); + remove_nm_sig(c_p, sig, next_nm_sig); + handle_sync_suspend(c_p, sig); + ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig); + break; + + case ERTS_SIG_Q_OP_RPC: + ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig); + remove_nm_sig(c_p, sig, next_nm_sig); + cnt += handle_rpc(c_p, (ErtsProcSigRPC *) sig, cnt, + limit, &yield); + ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig); + break; + case ERTS_SIG_Q_OP_TRACE_CHANGE_STATE: { Uint16 type = ERTS_PROC_SIG_TYPE(tag); @@ -3169,6 +3557,15 @@ stop: { *redsp = cnt/4 + 1; + if (yield) { + int vreds = max_reds - *redsp; + if (vreds > 0) { + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + esdp->virtual_reds += vreds; + } + *redsp = max_reds; + } + return res; } } @@ -3277,6 +3674,8 @@ erts_proc_sig_handle_exit(Process *c_p, int *redsp) case ERTS_MON_TYPE_PROC: case ERTS_MON_TYPE_DIST_PROC: case ERTS_MON_TYPE_NODE: + case ERTS_MON_TYPE_NODES: + case ERTS_MON_TYPE_SUSPEND: erts_monitor_release((ErtsMonitor *) sig); break; default: @@ -3332,6 +3731,17 @@ erts_proc_sig_handle_exit(Process *c_p, int *redsp) handle_process_info(c_p, NULL, sig, next_nm_sig, 0); break; + case ERTS_SIG_Q_OP_SYNC_SUSPEND: + handle_sync_suspend(c_p, sig); + break; + + case ERTS_SIG_Q_OP_RPC: { + int yield = 0; + handle_rpc(c_p, (ErtsProcSigRPC *) sig, + cnt, limit, &yield); + break; + } + case ERTS_SIG_Q_OP_TRACE_CHANGE_STATE: destroy_trace_info((ErtsSigTraceInfo *) sig); break; @@ -3467,6 +3877,7 @@ erts_proc_sig_signal_size(ErtsSignal *sig) } break; + case ERTS_SIG_Q_OP_SYNC_SUSPEND: case ERTS_SIG_Q_OP_PERSISTENT_MON_MSG: case ERTS_SIG_Q_OP_IS_ALIVE: size = ((ErtsMessage *) sig)->hfrag.alloc_size; @@ -3522,6 +3933,10 @@ erts_proc_sig_signal_size(ErtsSignal *sig) break; } + case ERTS_SIG_Q_OP_RPC: + size = sizeof(ErtsProcSigRPC); + break; + default: ERTS_INTERNAL_ERROR("Unknown signal"); break; @@ -3598,17 +4013,13 @@ erts_proc_sig_receive_helper(Process *c_p, */ *get_outp = 0; *msgpp = NULL; + return consumed_reds; } erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ); - if (left_reds <= 0) { - *get_outp = -1; /* yield */ - *msgpp = NULL; - - ASSERT(consumed_reds >= (fcalls - neg_o_reds)); - return consumed_reds; - } + if (left_reds <= 0) + break; /* Yield */ /* handle newly arrived signals... */ } @@ -3629,19 +4040,27 @@ erts_proc_sig_receive_helper(Process *c_p, max_reds, !0); consumed_reds += reds; left_reds -= reds; - /* we may have exited by an incoming signal... */ - if (state & ERTS_PSFLG_EXITING) { + + /* we may have exited or suspended by an incoming signal... */ + + if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_SUSPENDED)) { + if (state & ERTS_PSFLG_SUSPENDED) + break; /* Yield */ + /* * Process need to schedule out in order * to terminate. Prepare this a bit... */ + ASSERT(state & ERTS_PSFLG_EXITING); ASSERT(c_p->flags & F_DELAY_GC); c_p->flags &= ~F_DELAY_GC; c_p->arity = 0; c_p->current = NULL; + *get_outp = 1; *msgpp = NULL; + return consumed_reds; } @@ -3652,17 +4071,20 @@ erts_proc_sig_receive_helper(Process *c_p, return consumed_reds; } - if (left_reds <= 0) { - *get_outp = -1; /* yield */ - *msgpp = NULL; - - ASSERT(consumed_reds >= (fcalls - neg_o_reds)); - return consumed_reds; - } + if (left_reds <= 0) + break; /* yield */ ASSERT(!c_p->sig_qs.cont); /* Go fetch again... */ } + + /* Yield... */ + + *get_outp = -1; + *msgpp = NULL; + + ASSERT(consumed_reds >= (fcalls - neg_o_reds)); + return consumed_reds; } static int diff --git a/erts/emulator/beam/erl_proc_sig_queue.h b/erts/emulator/beam/erl_proc_sig_queue.h index 8b7cd35f61..3fc2d06b2d 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.h +++ b/erts/emulator/beam/erl_proc_sig_queue.h @@ -33,6 +33,11 @@ * - Group leader * - Is process alive * - Process info request + * - Suspend request (monitor of suspend type) + * - Resume request (demonitor of suspend type) + * - Suspend cleanup (monitor down of suspend type) + * - Sync suspend + * - RPC request * - Trace change * * The signal queue consists of three parts: @@ -557,6 +562,102 @@ erts_proc_sig_send_process_info_request(Process *c_p, Uint reserve_size, Eterm ref); +/** + * + * @brief Send a 'sync suspend' signal to a process. + * + * A response message '{Tag, Reply}' is sent to the + * sender when performed where Tag is the term passed + * as 'tag' argument. Reply is either 'suspended', + * 'not_suspended', 'exited' if the operation is + * asynchronous; otherwise, the 'reply' argument or + * 'badarg' if process terminated. + * + * This signal does *not* change the suspend state, only + * reads and reply the state. This signal is typically + * sent after a suspend request (monitor of suspend type) + * signal has been sent to the process in order to get a + * response when the suspend monitor has been processed. + * + * @param[in] c_p Pointer to process struct of + * currently executing process. + * + * @param[in] to Identifier of receiver. + * + * @param[in] tag Tag to use in response + * message to the sending + * process (i.e., c_p). + * + * @param[in] reply Reply to send if this + * is a synchronous operation; + * otherwise, THE_NON_VALUE. + */ +void +erts_proc_sig_send_sync_suspend(Process *c_p, Eterm to, + Eterm tag, Eterm reply); + +/** + * + * @brief Send an 'rpc' signal to a process. + * + * The function 'func' will be executed in the + * context of the receiving process. A response + * message '{Ref, Result}' is sent to the sender + * when 'func' has been called. 'Ref' is the reference + * returned by this function and 'Result' is the + * term returned by 'func'. If the return value of + * 'func' is not an immediate term, 'func' has to + * allocate a heap fragment where the result is stored + * and update the the heap fragment pointer pointer + * passed as third argument to point to it. + * + * If this function returns a reference, 'func' will + * be called in the context of the receiver. However, + * note that this might happen when the receiver is in + * an exiting state. The caller of this function + * *unconditionally* has to enter a receive that match + * on the returned reference in all clauses as next + * receive; otherwise, bad things will happen! + * + * If THE_NON_VALUE is returned, the receiver did not + * exist. The signal was not sent, and no specific + * receive has to be entered by the caller. + * + * @param[in] c_p Pointer to process struct of + * currently executing process. + * + * @param[in] to Identifier of receiver process. + * + * @param[in] reply Non-zero if a reply is wanted. + * + * @param[in] func Function to execute in the + * context of the receiver. + * First argument will be a + * pointer to the process struct + * of the receiver process. + * Second argument will be 'arg' + * (see below). Third argument + * will be a pointer to a pointer + * to a heap fragment for storage + * of result returned from 'func' + * (i.e. an 'out' parameter). + * + * @param[in] arg Void pointer to argument + * to pass as second argument + * in call of 'func'. + * + * @returns If the request was sent, + * an internal ordinary + * reference; otherwise, + * THE_NON_VALUE (non-existing + * receiver). + */ +Eterm +erts_proc_sig_send_rpc_request(Process *c_p, + Eterm to, + int reply, + Eterm (*func)(Process *, void *, int *, ErlHeapFragment **), + void *arg); /* * End of send operations of currently supported process signals. @@ -733,17 +834,50 @@ Sint erts_proc_sig_privqs_len(Process *c_p); -/* SVERK: Doc me up! */ +/** + * @brief Enqueue list of signals on process. + * + * Message queue must be locked on receiving process. + * + * @param rp Receiving process. + * @param first First signal in list. + * @param last Last signal in list. + * @param last_next Pointer to next-pointer to last non-message signal + * or NULL if no non-message signal after 'first'. + * @param msg_cnt Number of message signals in list. + * @param in_state 'state' of rp. + * + * @return 'state' of rp. + */ erts_aint32_t erts_enqueue_signals(Process *rp, ErtsMessage *first, ErtsMessage **last, ErtsMessage **last_next, Uint msg_cnt, erts_aint32_t in_state); -/* SVERK: Doc me up! */ +/** + * + * @brief Flush pending signal. + * + */ void erts_proc_sig_send_pending(ErtsSchedulerData* esdp); +/** + * + * @brief Schedule process to handle enqueued signal(s). + * + * @param rp Receiving process. + * @param state 'state' of rp. + * @param enable_flag Additional state flags to enable, like + * ERTS_PSFLG_ACTIVE if message has been enqueued. + */ +ERTS_GLB_INLINE void erts_proc_notify_new_sig(Process* rp, erts_aint32_t state, + erts_aint32_t enable_flag); + +void erts_make_dirty_proc_handled(Eterm pid, erts_aint32_t state, + erts_aint32_t prio); + typedef struct { Uint size; @@ -813,6 +947,21 @@ void erts_proc_sig_clear_seq_trace_tokens(Process *c_p); /** + * + * @brief Handle pending suspend requests + * + * Should be called by processes when they stop + * execution on a dirty scheduler if they have + * pending suspend requests (i.e. when + * ERTS_PROC_GET_PENDING_SUSPEND(c_p) != NULL). + * + * @param[in] c_p Pointer to executing + * process + */ +void +erts_proc_sig_handle_pending_suspend(Process *c_p); + +/** * @brief Initialize this functionality */ void erts_proc_sig_queue_init(void); @@ -879,6 +1028,24 @@ erts_proc_sig_fetch(Process *proc) return res; } +ERTS_GLB_INLINE void +erts_proc_notify_new_sig(Process* rp, erts_aint32_t state, + erts_aint32_t enable_flag) +{ + if (~(state & (ERTS_PSFLG_EXITING + | ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_SIG_IN_Q)) + | (~state & enable_flag)) { + /* Schedule process... */ + state = erts_proc_sys_schedule(rp, state, enable_flag); + } + + if (state & (ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_DIRTY_RUNNING_SYS)) { + erts_make_dirty_proc_handled(rp->common.id, state, -1); + } +} + #endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ #endif /* ERTS_PROC_SIG_QUEUE_H__ */ diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index ad7ac27ac3..1478b71195 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -185,8 +185,6 @@ sched_get_busy_wait_params(ErtsSchedulerData *esdp) return &sched_busy_wait_params[esdp->type]; } -int erts_disable_proc_not_running_opt; - static ErtsAuxWorkData *aux_thread_aux_work_data; static ErtsAuxWorkData *poll_thread_aux_work_data; @@ -730,6 +728,11 @@ erts_pre_init_process(void) = ERTS_PSD_DIST_ENTRY_GET_LOCKS; erts_psd_required_locks[ERTS_PSD_DIST_ENTRY].set_locks = ERTS_PSD_DIST_ENTRY_SET_LOCKS; + + erts_psd_required_locks[ERTS_PSD_PENDING_SUSPEND].get_locks + = ERTS_PSD_PENDING_SUSPEND_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_PENDING_SUSPEND].set_locks + = ERTS_PSD_PENDING_SUSPEND_SET_LOCKS; #endif } @@ -744,7 +747,6 @@ void erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab) { - erts_disable_proc_not_running_opt = 0; erts_init_proc_lock(ncpu); init_proclist_alloc(); @@ -6612,13 +6614,13 @@ change_proc_schedule_state(Process *p, if (((n & (ERTS_PSFLG_SUSPENDED | ERTS_PSFLG_ACTIVE)) == ERTS_PSFLG_ACTIVE) - && (!(a & (ERTS_PSFLG_ACTIVE_SYS - | ERTS_PSFLG_RUNNING - | ERTS_PSFLG_RUNNING_SYS - | ERTS_PSFLG_DIRTY_RUNNING - | ERTS_PSFLG_DIRTY_RUNNING_SYS) - && (!(a & ERTS_PSFLG_ACTIVE) - || (a & ERTS_PSFLG_SUSPENDED))))) { + & ((a & (ERTS_PSFLG_SUSPENDED + | ERTS_PSFLG_ACTIVE)) != ERTS_PSFLG_ACTIVE) + & !(a & (ERTS_PSFLG_ACTIVE_SYS + | ERTS_PSFLG_RUNNING + | ERTS_PSFLG_RUNNING_SYS + | ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_DIRTY_RUNNING_SYS))) { /* We activated a prevously inactive process */ profile_runnable_proc(p, am_active); } @@ -8553,427 +8555,22 @@ erts_start_schedulers(void) } } - - -static void -add_pend_suspend(Process *suspendee, - Eterm originator_pid, - void (*handle_func)(Process *, - ErtsProcLocks, - int, - Eterm)) -{ - ErtsPendingSuspend *psp = erts_alloc(ERTS_ALC_T_PEND_SUSPEND, - sizeof(ErtsPendingSuspend)); - psp->next = NULL; -#ifdef DEBUG -#if defined(ARCH_64) - psp->end = (ErtsPendingSuspend *) 0xdeaddeaddeaddead; -#else - psp->end = (ErtsPendingSuspend *) 0xdeaddead; -#endif -#endif - psp->pid = originator_pid; - psp->handle_func = handle_func; - - if (suspendee->pending_suspenders) - suspendee->pending_suspenders->end->next = psp; - else - suspendee->pending_suspenders = psp; - suspendee->pending_suspenders->end = psp; -} - -static void -handle_pending_suspend(Process *p, ErtsProcLocks p_locks) -{ - ErtsPendingSuspend *psp; - int is_alive = !ERTS_PROC_IS_EXITING(p); - - ERTS_LC_ASSERT(p_locks & ERTS_PROC_LOCK_STATUS); - - /* - * New pending suspenders might appear while we are processing - * (since we may release the status lock on p while processing). - */ - while (p->pending_suspenders) { - psp = p->pending_suspenders; - p->pending_suspenders = NULL; - while (psp) { - ErtsPendingSuspend *free_psp; - (*psp->handle_func)(p, p_locks, is_alive, psp->pid); - free_psp = psp; - psp = psp->next; - erts_free(ERTS_ALC_T_PEND_SUSPEND, (void *) free_psp); - } - } - -} - -static ERTS_INLINE void -cancel_suspend_of_suspendee(Process *p, ErtsProcLocks p_locks) -{ - if (is_not_nil(p->suspendee)) { - ErtsMonitor *mon; - Eterm suspendee = p->suspendee; - Process *rp; - if (!(p_locks & ERTS_PROC_LOCK_STATUS)) - erts_proc_lock(p, ERTS_PROC_LOCK_STATUS); - rp = erts_pid2proc(p, p_locks|ERTS_PROC_LOCK_STATUS, - suspendee, ERTS_PROC_LOCK_STATUS); - if (rp) { - erts_resume(rp, ERTS_PROC_LOCK_STATUS); - erts_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); - } - if (!(p_locks & ERTS_PROC_LOCK_STATUS)) - erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - p->suspendee = NIL; - - mon = erts_monitor_tree_lookup(p->suspend_monitors, - suspendee); - if (mon) { - erts_monitor_tree_delete(&p->suspend_monitors, - mon); - erts_monitor_suspend_destroy(erts_monitor_suspend(mon)); - } - } -} - -static void -handle_pend_sync_suspend(Process *suspendee, - ErtsProcLocks suspendee_locks, - int suspendee_alive, - Eterm suspender_pid) -{ - Process *suspender; - - ERTS_LC_ASSERT(suspendee_locks & ERTS_PROC_LOCK_STATUS); - - suspender = erts_pid2proc(suspendee, - suspendee_locks, - suspender_pid, - ERTS_PROC_LOCK_STATUS); - if (suspender) { - ASSERT(is_nil(suspender->suspendee)); - if (suspendee_alive) { - erts_suspend(suspendee, suspendee_locks, NULL); - suspender->suspendee = suspendee->common.id; - } - /* suspender is suspended waiting for suspendee to suspend; - resume suspender */ - ASSERT(suspendee != suspender); - resume_process(suspender, ERTS_PROC_LOCK_STATUS); - erts_proc_unlock(suspender, ERTS_PROC_LOCK_STATUS); - } -} - -static Process * -pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks, - Eterm pid, ErtsProcLocks pid_locks, int suspend) -{ - Process *rp; - int unlock_c_p_status; - - ERTS_LC_ASSERT(c_p_locks == erts_proc_lc_my_proc_locks(c_p)); - - ERTS_LC_ASSERT(c_p_locks & ERTS_PROC_LOCK_MAIN); - ERTS_LC_ASSERT(pid_locks & (ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS)); - - if (c_p->common.id == pid) - return erts_pid2proc(c_p, c_p_locks, pid, pid_locks); - - if (c_p_locks & ERTS_PROC_LOCK_STATUS) - unlock_c_p_status = 0; - else { - unlock_c_p_status = 1; - erts_proc_lock(c_p, ERTS_PROC_LOCK_STATUS); - } - - if (c_p->suspendee == pid) { - /* Process previously suspended by c_p (below)... */ - ErtsProcLocks rp_locks = pid_locks|ERTS_PROC_LOCK_STATUS; - rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS, pid, rp_locks); - c_p->suspendee = NIL; - ASSERT(c_p->flags & F_P2PNR_RESCHED); - c_p->flags &= ~F_P2PNR_RESCHED; - if (!suspend && rp) - resume_process(rp, rp_locks); - } - else { - rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS, - pid, ERTS_PROC_LOCK_STATUS); - - if (!rp) { - c_p->flags &= ~F_P2PNR_RESCHED; - goto done; - } - - ASSERT(!(c_p->flags & F_P2PNR_RESCHED)); - - /* - * Suspend the other process in order to prevent - * it from being selected for normal execution. - * This will however not prevent it from being - * selected for execution of a system task. If - * it is selected for execution of a system task - * we might be blocked for quite a while if the - * try-lock below fails. That is, there is room - * for improvement here... - */ - - if (!suspend_process(c_p, rp)) { - /* Other process running */ - - ASSERT((ERTS_PSFLG_RUNNING | ERTS_PSFLG_DIRTY_RUNNING) - & erts_atomic32_read_nob(&rp->state)); - - if (!suspend - && (erts_atomic32_read_nob(&rp->state) - & ERTS_PSFLG_DIRTY_RUNNING)) { - ErtsProcLocks need_locks = pid_locks & ~ERTS_PROC_LOCK_STATUS; - if (need_locks && erts_proc_trylock(rp, need_locks) == EBUSY) { - erts_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); - rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS, - pid, pid_locks|ERTS_PROC_LOCK_STATUS); - } - goto done; - } - - running: - - /* - * If we got pending suspenders and suspend ourselves waiting - * to suspend another process we might deadlock. - * In this case we have to yield, be suspended by - * someone else and then do it all over again. - */ - if (!c_p->pending_suspenders) { - /* Mark rp pending for suspend by c_p */ - add_pend_suspend(rp, c_p->common.id, handle_pend_sync_suspend); - ASSERT(is_nil(c_p->suspendee)); - - /* Suspend c_p; when rp is suspended c_p will be resumed. */ - suspend_process(c_p, c_p); - c_p->flags |= F_P2PNR_RESCHED; - } - /* Yield (caller is assumed to yield immediately in bif). */ - erts_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); - rp = ERTS_PROC_LOCK_BUSY; - } - else { - ErtsProcLocks need_locks = pid_locks & ~ERTS_PROC_LOCK_STATUS; - if (need_locks && erts_proc_trylock(rp, need_locks) == EBUSY) { - if ((ERTS_PSFLG_RUNNING_SYS|ERTS_PSFLG_DIRTY_RUNNING_SYS) - & erts_atomic32_read_nob(&rp->state)) { - /* Executing system task... */ - resume_process(rp, ERTS_PROC_LOCK_STATUS); - goto running; - } - erts_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); - /* - * If we are unlucky, the process just got selected for - * execution of a system task. In this case we may be - * blocked here for quite a while... Execution of system - * tasks are fortunately quite rare events. We try to - * avoid this by checking if it is in a state executing - * system tasks (above), but it will not prevent all - * scenarios for a long block here... - */ - rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS, - pid, pid_locks|ERTS_PROC_LOCK_STATUS); - if (!rp) - goto done; - } - - /* - * The previous suspend has prevented the process - * from being selected for normal execution regardless - * of locks held or not held on it... - */ -#ifdef DEBUG - { - erts_aint32_t state; - state = erts_atomic32_read_nob(&rp->state); - ASSERT(!(state & ERTS_PSFLG_RUNNING)); - } -#endif - - if (!suspend) - resume_process(rp, pid_locks|ERTS_PROC_LOCK_STATUS); - } - } - - done: - - if (rp && rp != ERTS_PROC_LOCK_BUSY && !(pid_locks & ERTS_PROC_LOCK_STATUS)) - erts_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); - if (unlock_c_p_status) - erts_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS); - return rp; -} - - -/* - * Like erts_pid2proc() but: - * - * * At least ERTS_PROC_LOCK_MAIN have to be held on c_p. - * * At least ERTS_PROC_LOCK_MAIN have to be taken on pid. - * * It also waits for proc to be in a state != running and garbing. - * * If ERTS_PROC_LOCK_BUSY is returned, the calling process has to - * yield (ERTS_BIF_YIELD[0-3]()). c_p might in this case have been - * suspended. - */ -Process * -erts_pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks, - Eterm pid, ErtsProcLocks pid_locks) -{ - return pid2proc_not_running(c_p, c_p_locks, pid, pid_locks, 0); -} - -/* - * erts_pid2proc_nropt() is normally the same as - * erts_pid2proc_not_running(). However it is only - * to be used when 'not running' is a pure optimization, - * not a requirement. - */ - -Process * -erts_pid2proc_nropt(Process *c_p, ErtsProcLocks c_p_locks, - Eterm pid, ErtsProcLocks pid_locks) -{ - if (erts_disable_proc_not_running_opt) - return erts_pid2proc(c_p, c_p_locks, pid, pid_locks); - else - return erts_pid2proc_not_running(c_p, c_p_locks, pid, pid_locks); -} - -static ERTS_INLINE int -do_bif_suspend_process(Process *c_p, - ErtsMonitorSuspend *smon, - Process *suspendee) -{ - ASSERT(suspendee); - ASSERT(!ERTS_PROC_IS_EXITING(suspendee)); - ERTS_LC_ASSERT(ERTS_PROC_LOCK_STATUS - & erts_proc_lc_my_proc_locks(suspendee)); - if (smon) { - if (!smon->active) { - if (!suspend_process(c_p, suspendee)) - return 0; - } - smon->active += smon->pending; - ASSERT(smon->active); - smon->pending = 0; - return 1; - } - return 0; -} - -static void -handle_pend_bif_sync_suspend(Process *suspendee, - ErtsProcLocks suspendee_locks, - int suspendee_alive, - Eterm suspender_pid) -{ - Process *suspender; - - ERTS_LC_ASSERT(suspendee_locks & ERTS_PROC_LOCK_STATUS); - - suspender = erts_pid2proc(suspendee, - suspendee_locks, - suspender_pid, - ERTS_PROC_LOCK_STATUS); - if (suspender) { - ErtsMonitorSuspend *smon; - ErtsMonitor *mon; - mon = erts_monitor_tree_lookup(suspender->suspend_monitors, - suspendee->common.id); - smon = erts_monitor_suspend(mon); - - ASSERT(is_nil(suspender->suspendee)); - if (!suspendee_alive) { - if (mon) { - erts_monitor_tree_delete(&suspender->suspend_monitors, - mon); - erts_monitor_suspend_destroy(smon); - } - } - else { -#ifdef DEBUG - int res = -#endif - do_bif_suspend_process(suspendee, smon, suspendee); - ASSERT(!smon || res != 0); - suspender->suspendee = suspendee->common.id; - } - /* suspender is suspended waiting for suspendee to suspend; - resume suspender */ - ASSERT(suspender != suspendee); - resume_process(suspender, ERTS_PROC_LOCK_STATUS); - erts_proc_unlock(suspender, ERTS_PROC_LOCK_STATUS); - } -} - -static void -handle_pend_bif_async_suspend(Process *suspendee, - ErtsProcLocks suspendee_locks, - int suspendee_alive, - Eterm suspender_pid) -{ - - Process *suspender; - - ERTS_LC_ASSERT(suspendee_locks & ERTS_PROC_LOCK_STATUS); - - suspender = erts_pid2proc(suspendee, - suspendee_locks, - suspender_pid, - ERTS_PROC_LOCK_STATUS); - if (suspender) { - ErtsMonitorSuspend *smon; - ErtsMonitor *mon; - mon = erts_monitor_tree_lookup(suspender->suspend_monitors, - suspendee->common.id); - smon = erts_monitor_suspend(mon); - ASSERT(is_nil(suspender->suspendee)); - if (!suspendee_alive) { - if (mon) { - erts_monitor_tree_delete(&suspender->suspend_monitors, - mon); - erts_monitor_suspend_destroy(smon); - } - } - else { -#ifdef DEBUG - int res = -#endif - do_bif_suspend_process(suspendee, smon, suspendee); - ASSERT(!smon || res != 0); - } - erts_proc_unlock(suspender, ERTS_PROC_LOCK_STATUS); - } -} - - -/* - * The erlang:suspend_process/2 BIF - */ - BIF_RETTYPE -suspend_process_2(BIF_ALIST_2) +erts_internal_suspend_process_2(BIF_ALIST_2) { Eterm res; - Process* suspendee = NULL; - ErtsMonitorSuspend *smon; - ErtsProcLocks xlocks = (ErtsProcLocks) 0; - int created; - - /* Options and default values: */ - int asynchronous = 0; + Eterm reply_tag = THE_NON_VALUE; + Eterm reply_res = THE_NON_VALUE; + int suspend; + int sync = 0; + int async = 0; int unless_suspending = 0; - + erts_aint_t mstate; + ErtsMonitorSuspend *msp; + ErtsMonitorData *mdp; if (BIF_P->common.id == BIF_ARG_1) - goto badarg; /* We are not allowed to suspend ourselves */ + BIF_RET(am_badarg); /* We are not allowed to suspend ourselves */ if (is_not_nil(BIF_ARG_2)) { /* Parse option list */ @@ -8987,191 +8584,127 @@ suspend_process_2(BIF_ALIST_2) unless_suspending = 1; break; case am_asynchronous: - asynchronous = 1; + async = 1; break; - default: - goto badarg; + default: { + if (is_tuple_arity(arg, 2)) { + Eterm *tp = tuple_val(arg); + if (tp[1] == am_asynchronous) { + async = 1; + reply_tag = tp[2]; + break; + } + } + BIF_RET(am_badarg); } + } arg = CDR(lp); - } + } if (is_not_nil(arg)) - goto badarg; - } - - xlocks = ERTS_PROC_LOCK_STATUS; - - erts_proc_lock(BIF_P, xlocks); - - suspendee = erts_pid2proc(BIF_P, - ERTS_PROC_LOCK_MAIN|xlocks, - BIF_ARG_1, - ERTS_PROC_LOCK_STATUS); - if (!suspendee) - goto no_suspendee; - - smon = erts_monitor_suspend_tree_lookup_create(&BIF_P->suspend_monitors, - &created, - BIF_ARG_1); - - if (asynchronous) { - /* --- Asynchronous suspend begin ---------------------------------- */ - - ERTS_LC_ASSERT(ERTS_PROC_LOCK_STATUS - & erts_proc_lc_my_proc_locks(BIF_P)); - ERTS_LC_ASSERT(ERTS_PROC_LOCK_STATUS - == erts_proc_lc_my_proc_locks(suspendee)); - - if (smon->active) { - smon->active += smon->pending; - smon->pending = 0; - if (unless_suspending) - res = am_false; - else if (smon->active == INT_MAX) - goto system_limit; - else { - smon->active++; - res = am_true; - } - /* done */ - } - else { - /* We havn't got any active suspends on the suspendee */ - if (smon->pending && unless_suspending) - res = am_false; - else { - if (smon->pending == INT_MAX) - goto system_limit; - - smon->pending++; - - if (!do_bif_suspend_process(BIF_P, smon, suspendee)) - add_pend_suspend(suspendee, - BIF_P->common.id, - handle_pend_bif_async_suspend); - - res = am_true; - } - /* done */ - } - /* --- Asynchronous suspend end ------------------------------------ */ - } - else /* if (!asynchronous) */ { - /* --- Synchronous suspend begin ----------------------------------- */ - - ERTS_LC_ASSERT(((ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_STATUS) - & erts_proc_lc_my_proc_locks(BIF_P)) - == (ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_STATUS)); - ERTS_LC_ASSERT(ERTS_PROC_LOCK_STATUS - == erts_proc_lc_my_proc_locks(suspendee)); - - if (BIF_P->suspendee == BIF_ARG_1) { - /* We are back after a yield and the suspendee - has been suspended on behalf of us. */ - ASSERT(smon->active >= 1); - BIF_P->suspendee = NIL; - res = (!unless_suspending || smon->active == 1 - ? am_true - : am_false); - /* done */ - } - else if (smon->active) { - if (unless_suspending) - res = am_false; - else { - smon->active++; - res = am_true; - } - /* done */ - } - else { - /* We haven't got any active suspends on the suspendee */ - - /* - * If we have pending suspenders and suspend ourselves waiting - * to suspend another process, or suspend another process - * we might deadlock. In this case we have to yield, - * be suspended by someone else, and then do it all over again. - */ - if (BIF_P->pending_suspenders) - goto yield; - - if (!unless_suspending && smon->pending == INT_MAX) - goto system_limit; - if (!unless_suspending || smon->pending == 0) - smon->pending++; - - if (do_bif_suspend_process(BIF_P, smon, suspendee)) { - res = (!unless_suspending || smon->active == 1 - ? am_true - : am_false); - /* done */ - } - else { - /* Mark suspendee pending for suspend by BIF_P */ - add_pend_suspend(suspendee, - BIF_P->common.id, - handle_pend_bif_sync_suspend); - - ASSERT(is_nil(BIF_P->suspendee)); - - /* - * Suspend BIF_P; when suspendee is suspended, BIF_P - * will be resumed and this BIF will be called again. - * This time with BIF_P->suspendee == BIF_ARG_1 (see - * above). - */ - suspend_process(BIF_P, BIF_P); - goto yield; - } - } - /* --- Synchronous suspend end ------------------------------------- */ + BIF_RET(am_badarg); } -#ifdef DEBUG - { - erts_aint32_t state = erts_atomic32_read_acqb(&suspendee->state); - ASSERT((state & ERTS_PSFLG_SUSPENDED) - || (asynchronous && smon->pending)); - ASSERT((state & ERTS_PSFLG_SUSPENDED) - || !smon->active); + if (!unless_suspending) { + ErtsMonitor *mon; + mon = erts_monitor_tree_lookup_create(&ERTS_P_MONITORS(BIF_P), + &suspend, + ERTS_MON_TYPE_SUSPEND, + BIF_P->common.id, + BIF_ARG_1); + ASSERT(mon->other.item == BIF_ARG_1); + + mdp = erts_monitor_to_data(mon); + msp = (ErtsMonitorSuspend *) mdp; + + mstate = erts_atomic_inc_read_relb(&msp->state); + ASSERT(suspend || (mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK) > 1); + sync = !async & !suspend & !(mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE); + suspend = !!suspend; /* ensure 0|1 */ + res = am_true; } -#endif - - erts_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS); - erts_proc_unlock(BIF_P, xlocks); - BIF_RET(res); - - system_limit: - ERTS_BIF_PREP_ERROR(res, BIF_P, SYSTEM_LIMIT); - goto do_return; - - no_suspendee: { + else { ErtsMonitor *mon; - BIF_P->suspendee = NIL; - mon = erts_monitor_tree_lookup(BIF_P->suspend_monitors, BIF_ARG_1); + mon = erts_monitor_tree_lookup(ERTS_P_MONITORS(BIF_P), + BIF_ARG_1); if (mon) { - erts_monitor_tree_delete(&BIF_P->suspend_monitors, mon); - erts_monitor_suspend_destroy(erts_monitor_suspend(mon)); + ASSERT(mon->type == ERTS_MON_TYPE_SUSPEND); + mdp = erts_monitor_to_data(mon); + msp = (ErtsMonitorSuspend *) mdp; + mstate = erts_atomic_read_nob(&msp->state); + ASSERT((mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK) > 0); + mdp = NULL; + sync = !async & !(mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE); + suspend = 0; + res = am_false; + } + else { + mdp = erts_monitor_create(ERTS_MON_TYPE_SUSPEND, NIL, + BIF_P->common.id, + BIF_ARG_1, NIL); + mon = &mdp->origin; + erts_monitor_tree_insert(&ERTS_P_MONITORS(BIF_P), mon); + msp = (ErtsMonitorSuspend *) mdp; + mstate = erts_atomic_inc_read_relb(&msp->state); + ASSERT(!(mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE)); + suspend = !0; + res = am_true; } } - badarg: - ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); - goto do_return; + if (suspend) { + erts_aint32_t state; + Process *rp; + int send_sig = 0; + + /* fail state... */ + state = (ERTS_PSFLG_EXITING + | ERTS_PSFLG_RUNNING + | ERTS_PSFLG_RUNNING_SYS + | ERTS_PSFLG_DIRTY_RUNNING + | ERTS_PSFLG_DIRTY_RUNNING_SYS); + + rp = erts_try_lock_sig_free_proc(BIF_ARG_1, + ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS, + &state); + if (!rp) + goto noproc; + if (rp == ERTS_PROC_LOCK_BUSY) + send_sig = !0; + else { + send_sig = !suspend_process(BIF_P, rp); + if (!send_sig) { + erts_monitor_list_insert(&ERTS_P_LT_MONITORS(rp), &mdp->target); + erts_atomic_read_bor_relb(&msp->state, + ERTS_MSUSPEND_STATE_FLG_ACTIVE); + } + erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); + } + if (send_sig) { + if (erts_proc_sig_send_monitor(&mdp->target, BIF_ARG_1)) + sync = !async; + else { + noproc: + erts_monitor_tree_delete(&ERTS_P_MONITORS(BIF_P), &mdp->origin); + erts_monitor_release_both(mdp); + if (!async) + res = am_badarg; + } + } + } - yield: - ERTS_BIF_PREP_YIELD2(res, bif_export[BIF_suspend_process_2], - BIF_P, BIF_ARG_1, BIF_ARG_2); - - do_return: - if (suspendee) - erts_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS); - if (xlocks) - erts_proc_unlock(BIF_P, xlocks); - return res; + if (sync) { + ASSERT(is_non_value(reply_tag)); + reply_res = res; + reply_tag = res = erts_make_ref(BIF_P); + ERTS_RECV_MARK_SAVE(BIF_P); + ERTS_RECV_MARK_SET(BIF_P); + } -} + if (is_value(reply_tag)) + erts_proc_sig_send_sync_suspend(BIF_P, BIF_ARG_1, reply_tag, reply_res); + BIF_RET(res); +} /* * The erlang:resume_process/1 BIF @@ -9181,90 +8714,32 @@ BIF_RETTYPE resume_process_1(BIF_ALIST_1) { ErtsMonitor *mon; - ErtsMonitorSuspend *smon; - Process *suspendee; - int is_active; + ErtsMonitorSuspend *msp; + erts_aint_t mstate; if (BIF_P->common.id == BIF_ARG_1) BIF_ERROR(BIF_P, BADARG); - erts_proc_lock(BIF_P, ERTS_PROC_LOCK_STATUS); - mon = erts_monitor_tree_lookup(BIF_P->suspend_monitors, BIF_ARG_1); - smon = erts_monitor_suspend(mon); - - if (!smon) { + mon = erts_monitor_tree_lookup(ERTS_P_MONITORS(BIF_P), + BIF_ARG_1); + if (!mon) { /* No previous suspend or dead suspendee */ - goto error; - } - else if (smon->pending) { - smon->pending--; - ASSERT(smon->pending >= 0); - if (smon->active) { - smon->active += smon->pending; - smon->pending = 0; - } - is_active = smon->active; - } - else if (smon->active) { - smon->active--; - ASSERT(smon->pending == 0); - is_active = 1; - } - else { - /* No previous suspend or dead suspendee */ - goto no_suspendee; + BIF_ERROR(BIF_P, BADARG); } - if (smon->active || smon->pending || !is_active) { - /* Leave the suspendee as it is; just verify that it is still alive */ - suspendee = erts_proc_lookup(BIF_ARG_1); - if (!suspendee) - goto no_suspendee; - - } - else { - /* Resume */ - suspendee = erts_pid2proc(BIF_P, - ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS, - BIF_ARG_1, - ERTS_PROC_LOCK_STATUS); - if (!suspendee) { - mon = erts_monitor_tree_lookup(BIF_P->suspend_monitors, BIF_ARG_1); - smon = erts_monitor_suspend(mon); - if (!mon) - goto error; - goto no_suspendee; - } + ASSERT(mon->type == ERTS_MON_TYPE_SUSPEND); + msp = (ErtsMonitorSuspend *) erts_monitor_to_data(mon); - ASSERT(mon == erts_monitor_tree_lookup(BIF_P->suspend_monitors, BIF_ARG_1)); + mstate = erts_atomic_dec_read_relb(&msp->state); - ASSERT(ERTS_PSFLG_SUSPENDED - & erts_atomic32_read_nob(&suspendee->state)); - ASSERT(BIF_P != suspendee); - resume_process(suspendee, ERTS_PROC_LOCK_STATUS); + ASSERT((mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK) >= 0); - erts_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS); + if ((mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK) == 0) { + erts_monitor_tree_delete(&ERTS_P_MONITORS(BIF_P), mon); + erts_proc_sig_send_demonitor(mon); } - if (!smon->active && !smon->pending) { - ASSERT(mon); - erts_monitor_tree_delete(&BIF_P->suspend_monitors, mon); - erts_monitor_suspend_destroy(smon); - } - - erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_STATUS); - BIF_RET(am_true); - - no_suspendee: - /* cleanup */ - ASSERT(mon); - erts_monitor_tree_delete(&BIF_P->suspend_monitors, mon); - erts_monitor_suspend_destroy(smon); - - error: - erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_STATUS); - BIF_ERROR(BIF_P, BADARG); } BIF_RETTYPE @@ -9610,6 +9085,17 @@ scheduler_gc_proc(Process *c_p, int reds_left) return reds; } +static void +unlock_lock_rq(int pre_free, void *vrq) +{ + ErtsRunQueue *rq = vrq; + if (pre_free) + erts_runq_unlock(rq); + else + erts_runq_lock(rq); +} + + /* * schedule() is called from BEAM (process_main()) or HiPE * (hipe_mode_switch()) when the current process is to be @@ -9694,12 +9180,13 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) ASSERT(esdp->current_process == p || esdp->free_process == p); - sched_out_proc: - - ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); reds = actual_reds = calls - esdp->virtual_reds; + internal_sched_out_proc: + + ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); + ASSERT(actual_reds >= 0); if (reds < ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST) reds = ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST; @@ -9741,11 +9228,6 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) /* have to re-read state after taking lock */ state = erts_atomic32_read_nob(&p->state); - if (p->pending_suspenders) - handle_pending_suspend(p, (ERTS_PROC_LOCK_MAIN - | ERTS_PROC_LOCK_TRACE - | ERTS_PROC_LOCK_STATUS)); - esdp->reductions += reds; { @@ -9782,7 +9264,9 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) } if (dec_refc) - erts_proc_dec_refc(p); + erts_proc_dec_refc_free_func(p, + unlock_lock_rq, + (void *) rq); } ASSERT(!esdp->free_process); @@ -10195,8 +9679,9 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) if (is_normal_sched) { if (state & ERTS_PSFLG_RUNNING_SYS) { if (state & (ERTS_PSFLG_SIG_Q|ERTS_PSFLG_SIG_IN_Q)) { - int local_only = !!(p->flags & F_LOCAL_SIGS_ONLY); - if (!local_only || (state & ERTS_PSFLG_SIG_Q)) { + int local_only = (!!(p->flags & F_LOCAL_SIGS_ONLY) + & !(state & ERTS_PSFLG_SUSPENDED)); + if (!local_only | !!(state & ERTS_PSFLG_SIG_Q)) { int sig_reds; /* * If we have dirty work scheduled we allow @@ -10282,7 +9767,17 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) } p->fcalls = reds; - + if (reds != context_reds) { + actual_reds = context_reds - reds - esdp->virtual_reds; + ASSERT(actual_reds >= 0); + esdp->virtual_reds = 0; + p->reds += actual_reds; + ERTS_PROC_REDUCTIONS_EXECUTED(esdp, rq, + (int) ERTS_PSFLGS_GET_USR_PRIO(state), + reds, + actual_reds); + } + ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); ASSERT(erts_proc_read_refc(p) > 0); @@ -10332,6 +9827,14 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls) #endif return p; + + sched_out_proc: + actual_reds = context_reds; + actual_reds -= reds; + actual_reds -= esdp->virtual_reds; + reds = actual_reds; + goto internal_sched_out_proc; + } } @@ -11844,7 +11347,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). #ifdef HIPE hipe_init_process(&p->hipe); - hipe_init_process_smp(&p->hipe_smp); #endif p->heap = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm)*sz); p->old_hend = p->old_htop = p->old_heap = NULL; @@ -11893,7 +11395,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). ERTS_P_LINKS(p) = NULL; ERTS_P_MONITORS(p) = NULL; ERTS_P_LT_MONITORS(p) = NULL; - p->suspend_monitors = NULL; ASSERT(is_pid(parent->group_leader)); @@ -11950,8 +11451,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->trace_msg_q = NULL; p->scheduler_data = NULL; - p->suspendee = NIL; - p->pending_suspenders = NULL; #if !defined(NO_FPE_SIGNALS) || defined(HIPE) p->fp_exception = 0; @@ -12118,7 +11617,6 @@ void erts_init_empty_process(Process *p) ERTS_P_MONITORS(p) = NULL; ERTS_P_LT_MONITORS(p) = NULL; ERTS_P_LINKS(p) = NULL; /* List of links */ - p->suspend_monitors = NULL; p->sig_qs.first = NULL; p->sig_qs.last = &p->sig_qs.first; p->sig_qs.cont = NULL; @@ -12169,7 +11667,6 @@ void erts_init_empty_process(Process *p) #ifdef HIPE hipe_init_process(&p->hipe); - hipe_init_process_smp(&p->hipe_smp); #endif INIT_HOLE_CHECK(p); @@ -12182,8 +11679,6 @@ void erts_init_empty_process(Process *p) erts_atomic32_init_nob(&p->state, (erts_aint32_t) PRIORITY_NORMAL); p->scheduler_data = NULL; - p->suspendee = NIL; - p->pending_suspenders = NULL; erts_proc_lock_init(p); erts_proc_unlock(p, ERTS_PROC_LOCKS_ALL); erts_init_runq_proc(p, ERTS_RUNQ_IX(0), 0); @@ -12221,7 +11716,6 @@ erts_debug_verify_clean_empty_process(Process* p) ASSERT(ERTS_P_MONITORS(p) == NULL); ASSERT(ERTS_P_LT_MONITORS(p) == NULL); ASSERT(ERTS_P_LINKS(p) == NULL); - ASSERT(p->suspend_monitors == NULL); ASSERT(p->sig_qs.first == NULL); ASSERT(p->sig_qs.len == 0); ASSERT(p->bif_timers == NULL); @@ -12235,8 +11729,6 @@ erts_debug_verify_clean_empty_process(Process* p) ASSERT(p->sig_inq.first == NULL); ASSERT(p->sig_inq.len == 0); - ASSERT(p->suspendee == NIL); - ASSERT(p->pending_suspenders == NULL); /* Thing that erts_cleanup_empty_process() cleans up */ @@ -12342,8 +11834,6 @@ delete_process(Process* p) erts_cleanup_messages(p->sig_qs.cont); p->sig_qs.cont = NULL; - ASSERT(!p->suspend_monitors); - p->fvalue = NIL; } @@ -12423,6 +11913,7 @@ erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt) if (erts_monitor_is_target(mon)) { /* We are being watched... */ switch (mon->type) { + case ERTS_MON_TYPE_SUSPEND: case ERTS_MON_TYPE_PROC: erts_proc_sig_send_monitor_down(mon, reason); mon = NULL; @@ -12494,6 +11985,7 @@ erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt) else { /* Origin monitor */ /* We are watching someone else... */ switch (mon->type) { + case ERTS_MON_TYPE_SUSPEND: case ERTS_MON_TYPE_PROC: erts_proc_sig_send_demonitor(mon); mon = NULL; @@ -12646,21 +12138,6 @@ erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt) erts_link_release(lnk); } -static void -resume_suspend_monitor(ErtsMonitor *mon, void *vc_p) -{ - ErtsMonitorSuspend *smon = erts_monitor_suspend(mon); - Process *suspendee = erts_pid2proc((Process *) vc_p, ERTS_PROC_LOCK_MAIN, - smon->mon.other.item, ERTS_PROC_LOCK_STATUS); - if (suspendee) { - ASSERT(suspendee != vc_p); - if (smon->active) - resume_process(suspendee, ERTS_PROC_LOCK_STATUS); - erts_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS); - } - erts_monitor_suspend_destroy(smon); -} - /* this function fishishes a process and propagates exit messages - called by process_main when a process dies */ void @@ -12692,8 +12169,6 @@ erts_do_exit_process(Process* p, Eterm reason) set_self_exiting(p, reason, NULL, NULL, NULL); - cancel_suspend_of_suspendee(p, ERTS_PROC_LOCKS_ALL); - if (IS_TRACED(p)) { if (IS_TRACED_FL(p, F_TRACE_CALLS)) erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_EXITING); @@ -12826,11 +12301,6 @@ erts_continue_exit_process(Process *p) p->flags &= ~F_USING_DDLL; } - if (p->suspend_monitors) - erts_monitor_tree_foreach_delete(&p->suspend_monitors, - resume_suspend_monitor, - p); - /* * The registered name *should* be the last "erlang resource" to * cleanup. @@ -13038,7 +12508,13 @@ erts_try_lock_sig_free_proc(Eterm pid, ErtsProcLocks locks, erts_aint32_t *statep) { Process *rp = erts_proc_lookup_raw(pid); + erts_aint32_t fail_state = ERTS_PSFLG_SIG_IN_Q|ERTS_PSFLG_SIG_Q; erts_aint32_t state; + ErtsProcLocks tmp_locks = ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_MSGQ; + + tmp_locks |= locks; + if (statep) + fail_state |= *statep; if (!rp) { if (statep) @@ -13055,28 +12531,28 @@ erts_try_lock_sig_free_proc(Eterm pid, ErtsProcLocks locks, if (state & ERTS_PSFLG_FREE) return NULL; - if (state & (ERTS_PSFLG_SIG_IN_Q|ERTS_PSFLG_SIG_Q)) + if (state & fail_state) return ERTS_PROC_LOCK_BUSY; - if (!locks) - return rp; - - if (erts_proc_trylock(rp, locks) == EBUSY) + if (erts_proc_trylock(rp, tmp_locks) == EBUSY) return ERTS_PROC_LOCK_BUSY; state = erts_atomic32_read_nob(&rp->state); if (statep) *statep = state; - if (state & ERTS_PSFLG_FREE) { - erts_proc_unlock(rp, locks); - return NULL; + if ((state & fail_state) + || rp->sig_inq.first + || rp->sig_qs.cont) { + erts_proc_unlock(rp, tmp_locks); + if (state & ERTS_PSFLG_FREE) + return NULL; + else + return ERTS_PROC_LOCK_BUSY; } - if (state & (ERTS_PSFLG_SIG_IN_Q|ERTS_PSFLG_SIG_Q)) { - erts_proc_unlock(rp, locks); - return ERTS_PROC_LOCK_BUSY; - } + if (tmp_locks != locks) + erts_proc_unlock(rp, tmp_locks & ~locks); return rp; } diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index b66272194c..a60e117bab 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -805,14 +805,15 @@ erts_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi) #define ERTS_PSD_ETS_OWNED_TABLES 6 #define ERTS_PSD_ETS_FIXED_TABLES 7 #define ERTS_PSD_DIST_ENTRY 8 -#define ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF 9 /* keep last... */ +#define ERTS_PSD_PENDING_SUSPEND 9 +#define ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF 10 /* keep last... */ -#define ERTS_PSD_SIZE 10 +#define ERTS_PSD_SIZE 11 #if !defined(HIPE) # undef ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF # undef ERTS_PSD_SIZE -# define ERTS_PSD_SIZE 9 +# define ERTS_PSD_SIZE 10 #endif typedef struct { @@ -849,6 +850,9 @@ typedef struct { #define ERTS_PSD_DIST_ENTRY_GET_LOCKS ERTS_PROC_LOCK_MAIN #define ERTS_PSD_DIST_ENTRY_SET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_PENDING_SUSPEND_GET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_PENDING_SUSPEND_SET_LOCKS ERTS_PROC_LOCK_MAIN + typedef struct { ErtsProcLocks get_locks; ErtsProcLocks set_locks; @@ -884,20 +888,6 @@ typedef struct { typedef struct ErtsProcSysTask_ ErtsProcSysTask; typedef struct ErtsProcSysTaskQs_ ErtsProcSysTaskQs; - -typedef struct ErtsPendingSuspend_ ErtsPendingSuspend; -struct ErtsPendingSuspend_ { - ErtsPendingSuspend *next; - ErtsPendingSuspend *end; - Eterm pid; - void (*handle_func)(Process *suspendee, - ErtsProcLocks suspendee_locks, - int suspendee_alive, - Eterm pid); -}; - - - /* Defines to ease the change of memory architecture */ # define HEAP_START(p) (p)->heap # define HEAP_TOP(p) (p)->htop @@ -992,9 +982,6 @@ struct process { Process *next; /* Pointer to next process in run queue */ - ErtsMonitor *suspend_monitors; /* Processes suspended by this process via - erlang:suspend_process/1 */ - ErtsSignalPrivQueues sig_qs; /* Signal queues */ ErtsBifTimers *bif_timers; /* Bif timers aiming at this process */ @@ -1058,12 +1045,7 @@ struct process { ErlTraceMessageQueue *trace_msg_q; erts_proc_lock_t lock; ErtsSchedulerData *scheduler_data; - Eterm suspendee; - ErtsPendingSuspend *pending_suspenders; erts_atomic_t run_queue; -#ifdef HIPE - struct hipe_process_state_smp hipe_smp; -#endif #ifdef CHECK_FOR_HOLES Eterm* last_htop; /* No need to scan the heap below this point. */ @@ -1380,7 +1362,7 @@ extern int erts_system_profile_ts_type; #define F_DISTRIBUTION (1 << 6) /* Process used in distribution */ #define F_USING_DDLL (1 << 7) /* Process has used the DDLL interface */ #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_UNUSED (1 << 9) #define F_FORCE_GC (1 << 10) /* Force gc at process in-scheduling */ #define F_DISABLE_GC (1 << 11) /* Disable GC (see below) */ #define F_OFF_HEAP_MSGQ (1 << 12) /* Off heap msg queue */ @@ -1397,10 +1379,12 @@ extern int erts_system_profile_ts_type; #define F_DIRTY_MAJOR_GC (1 << 23) /* Dirty major GC scheduled */ #define F_DIRTY_MINOR_GC (1 << 24) /* Dirty minor GC scheduled */ #define F_HIBERNATED (1 << 25) /* Hibernated */ -#define F_LOCAL_SIGS_ONLY (1 << 26) +#define F_LOCAL_SIGS_ONLY (1 << 26) /* Handle privq sigs only */ #define F_TRAP_EXIT (1 << 27) /* Trapping exit */ -#define F_DEFERRED_SAVED_LAST (1 << 28) -#define F_DELAYED_PSIGQS_LEN (1 << 29) +#define F_DEFERRED_SAVED_LAST (1 << 28) /* Deferred sig_qs.saved_last */ +#define F_DELAYED_PSIGQS_LEN (1 << 29) /* Delayed update of sig_qs.len */ +#define F_HIPE_RECV_LOCKED (1 << 30) /* HiPE message queue locked */ +#define F_HIPE_RECV_YIELD (1 << 31) /* HiPE receive yield */ /* * F_DISABLE_GC and F_DELAY_GC are similar. Both will prevent @@ -2048,6 +2032,11 @@ erts_psd_set(Process *p, int ix, void *data) #define ERTS_PROC_SET_DIST_ENTRY(P, DE) \ ((DistEntry *) erts_psd_set((P), ERTS_PSD_DIST_ENTRY, (void *) (DE))) +#define ERTS_PROC_GET_PENDING_SUSPEND(P) \ + ((void *) erts_psd_get((P), ERTS_PSD_PENDING_SUSPEND)) +#define ERTS_PROC_SET_PENDING_SUSPEND(P, PS) \ + ((void *) erts_psd_set((P), ERTS_PSD_PENDING_SUSPEND, (void *) (PS))) + #ifdef HIPE #define ERTS_PROC_GET_SUSPENDED_SAVED_CALLS_BUF(P) \ ((struct saved_calls *) erts_psd_get((P), ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF)) @@ -2612,16 +2601,6 @@ Process *erts_try_lock_sig_free_proc(Eterm pid, ErtsProcLocks locks, erts_aint32_t *statep); -Process *erts_pid2proc_not_running(Process *, - ErtsProcLocks, - Eterm, - ErtsProcLocks); -Process *erts_pid2proc_nropt(Process *c_p, - ErtsProcLocks c_p_locks, - Eterm pid, - ErtsProcLocks pid_locks); -extern int erts_disable_proc_not_running_opt; - #ifdef DEBUG #define ERTS_ASSERT_IS_NOT_EXITING(P) \ do { ASSERT(!ERTS_PROC_IS_EXITING((P))); } while (0) diff --git a/erts/emulator/beam/erl_process_lock.h b/erts/emulator/beam/erl_process_lock.h index 43f396c547..bd38eca4dc 100644 --- a/erts/emulator/beam/erl_process_lock.h +++ b/erts/emulator/beam/erl_process_lock.h @@ -921,6 +921,9 @@ ERTS_GLB_INLINE int erts_proc_trylock(Process *, ErtsProcLocks); ERTS_GLB_INLINE void erts_proc_inc_refc(Process *); ERTS_GLB_INLINE void erts_proc_dec_refc(Process *); +ERTS_GLB_INLINE void erts_proc_dec_refc_free_func(Process *p, + void (*func)(int, void *), + void *arg); ERTS_GLB_INLINE void erts_proc_add_refc(Process *, Sint); ERTS_GLB_INLINE Sint erts_proc_read_refc(Process *); @@ -993,6 +996,21 @@ ERTS_GLB_INLINE void erts_proc_dec_refc(Process *p) } } +ERTS_GLB_INLINE void erts_proc_dec_refc_free_func(Process *p, + void (*func)(int, void *), + void *arg) +{ + Sint referred; + ASSERT(!(erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_PROXY)); + referred = erts_ptab_atmc_dec_test_refc(&p->common); + if (!referred) { + ASSERT(ERTS_PROC_IS_EXITING(p)); + (*func)(!0, arg); + erts_free_proc(p); + (*func)(0, arg); + } +} + ERTS_GLB_INLINE void erts_proc_add_refc(Process *p, Sint add_refc) { Sint referred; diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 065a560b52..f074dd8bdb 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -2629,6 +2629,38 @@ erts_tracer_to_term(Process *p, ErtsTracer tracer) } } +Eterm +erts_build_tracer_to_term(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, ErtsTracer tracer) +{ + Eterm res; + Eterm state; + Uint sz; + + if (ERTS_TRACER_IS_NIL(tracer)) + return am_false; + + state = ERTS_TRACER_STATE(tracer); + sz = is_immed(state) ? 0 : size_object(state); + + if (szp) + *szp += sz; + + if (hpp) + res = is_immed(state) ? state : copy_struct(state, sz, hpp, ohp); + else + res = THE_NON_VALUE; + + if (ERTS_TRACER_MODULE(tracer) != am_erl_tracer) { + if (szp) + *szp += 3; + if (hpp) { + res = TUPLE2(*hpp, ERTS_TRACER_MODULE(tracer), res); + *hpp += 3; + } + } + + return res; +} static ERTS_INLINE int send_to_tracer_nif_raw(Process *c_p, Process *tracee, diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h index dbf7ebd2a1..3228e19809 100644 --- a/erts/emulator/beam/erl_trace.h +++ b/erts/emulator/beam/erl_trace.h @@ -198,6 +198,8 @@ int erts_is_tracer_proc_enabled_send(Process* c_p, ErtsProcLocks c_p_locks, ErtsPTabElementCommon *t_p); int erts_is_tracer_enabled(const ErtsTracer tracer, ErtsPTabElementCommon *t_p); Eterm erts_tracer_to_term(Process *p, ErtsTracer tracer); +Eterm erts_build_tracer_to_term(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, ErtsTracer tracer); + ErtsTracer erts_term_to_tracer(Eterm prefix, Eterm term); void erts_tracer_replace(ErtsPTabElementCommon *t_p, const ErtsTracer new_tracer); diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index bc9a700204..0a65e317ed 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -490,16 +490,21 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) /* same semantics, different debug trace messages */ /* XXX: BEAM has different entries for the locked and unlocked cases. HiPE doesn't, so we must check dynamically. */ - if (p->hipe_smp.have_receive_locks) - p->hipe_smp.have_receive_locks = 0; + if (p->flags & F_HIPE_RECV_LOCKED) + p->flags &= ~F_HIPE_RECV_LOCKED; else erts_proc_lock(p, ERTS_PROC_LOCKS_MSG_RECEIVE); p->i = hipe_beam_pc_resume; p->arity = 0; if (erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_EXITING) ASSERT(erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_ACTIVE); - else + else if (!(p->flags & F_HIPE_RECV_YIELD)) erts_atomic32_read_band_relb(&p->state, ~ERTS_PSFLG_ACTIVE); + else { + /* Yielded from receive */ + ERTS_VBUMP_ALL_REDS(p); + p->flags &= ~F_HIPE_RECV_YIELD; + } erts_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE); do_schedule: { @@ -522,7 +527,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) p = erts_schedule(NULL, p, reds_in - p->fcalls); ERTS_REQ_PROC_MAIN_LOCK(p); ASSERT(!(p->flags & F_HIPE_MODE)); - p->hipe_smp.have_receive_locks = 0; + p->flags &= ~F_HIPE_RECV_LOCKED; reg = p->scheduler_data->x_reg_array; } { diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 24078af046..211ce0492a 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -144,8 +144,8 @@ BIF_RETTYPE nbif_impl_hipe_set_timeout(NBIF_ALIST_1) else { int tres = erts_set_proc_timer_term(p, timeout_value); if (tres != 0) { /* Wrong time */ - if (p->hipe_smp.have_receive_locks) { - p->hipe_smp.have_receive_locks = 0; + if (p->flags & F_HIPE_RECV_LOCKED) { + p->flags &= ~F_HIPE_RECV_LOCKED; erts_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE); } BIF_ERROR(p, EXC_TIMEOUT_VALUE); @@ -549,19 +549,14 @@ Eterm hipe_check_get_msg(Process *c_p) c_p->i = NULL; c_p->arity = 0; c_p->current = NULL; - (void) erts_proc_sig_receive_helper(c_p, CONTEXT_REDS, 0, + (void) erts_proc_sig_receive_helper(c_p, CONTEXT_REDS/4, 0, &msgp, &get_out); /* FIXME: Need to bump reductions... */ if (!msgp) { if (get_out) { - if (get_out < 0) { - /* - * FIXME: We should get out yielding - * here... - */ - goto next_message; - } - /* Go exit... */ + if (get_out < 0) + c_p->flags |= F_HIPE_RECV_YIELD; /* yield... */ + /* else: go exit... */ return THE_NON_VALUE; } @@ -573,7 +568,7 @@ Eterm hipe_check_get_msg(Process *c_p) */ /* XXX: BEAM doesn't need this */ - c_p->hipe_smp.have_receive_locks = 1; + c_p->flags |= F_HIPE_RECV_LOCKED; c_p->flags &= ~F_DELAY_GC; return THE_NON_VALUE; } @@ -618,8 +613,8 @@ void hipe_clear_timeout(Process *c_p) */ /* XXX: BEAM has different entries for the locked and unlocked cases. HiPE doesn't, so we must check dynamically. */ - if (c_p->hipe_smp.have_receive_locks) { - c_p->hipe_smp.have_receive_locks = 0; + if (c_p->flags & F_HIPE_RECV_LOCKED) { + c_p->flags &= ~F_HIPE_RECV_LOCKED; erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); } if (IS_TRACED_FL(c_p, F_TRACE_RECEIVE)) { diff --git a/erts/emulator/hipe/hipe_process.h b/erts/emulator/hipe/hipe_process.h index ef14c75f6c..18354ba0a6 100644 --- a/erts/emulator/hipe/hipe_process.h +++ b/erts/emulator/hipe/hipe_process.h @@ -82,13 +82,4 @@ static __inline__ void hipe_delete_process(struct hipe_process_state *p) erts_free(ERTS_ALC_T_HIPE_STK, (void*)p->nstack); } -struct hipe_process_state_smp { - int have_receive_locks; -}; - -static __inline__ void hipe_init_process_smp(struct hipe_process_state_smp *p) -{ - p->have_receive_locks = 0; -} - #endif /* HIPE_PROCESS_H */ diff --git a/erts/emulator/nifs/unix/unix_prim_file.c b/erts/emulator/nifs/unix/unix_prim_file.c index 1637f9cb71..2b112dda76 100644 --- a/erts/emulator/nifs/unix/unix_prim_file.c +++ b/erts/emulator/nifs/unix/unix_prim_file.c @@ -512,8 +512,8 @@ int efile_sync(efile_data_t *d, int data_only) { } int efile_advise(efile_data_t *d, Sint64 offset, Sint64 length, enum efile_advise_t advise) { - efile_unix_t *u = (efile_unix_t*)d; #ifdef HAVE_POSIX_FADVISE + efile_unix_t *u = (efile_unix_t*)d; int p_advise; switch(advise) { diff --git a/erts/emulator/nifs/win32/win_prim_file.c b/erts/emulator/nifs/win32/win_prim_file.c index 8058350b25..044bee62cf 100644 --- a/erts/emulator/nifs/win32/win_prim_file.c +++ b/erts/emulator/nifs/win32/win_prim_file.c @@ -24,6 +24,7 @@ #include "prim_file_nif.h" +#include <winioctl.h> #include <windows.h> #include <strsafe.h> #include <wchar.h> @@ -671,11 +672,48 @@ static int is_executable_file(const efile_path_t *path) { return 0; } +/* Returns whether the path refers to a link-like object, e.g. a junction + * point, symbolic link, or mounted folder. */ +static int is_name_surrogate(const efile_path_t *path) { + HANDLE handle; + int result; + + handle = CreateFileW((const WCHAR*)path->data, GENERIC_READ, + FILE_SHARE_FLAGS, NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT | + FILE_FLAG_BACKUP_SEMANTICS, + NULL); + result = 0; + + if(handle != INVALID_HANDLE_VALUE) { + REPARSE_GUID_DATA_BUFFER reparse_buffer; + LPDWORD unused_length; + BOOL success; + + success = DeviceIoControl(handle, + FSCTL_GET_REPARSE_POINT, NULL, 0, + &reparse_buffer, sizeof(reparse_buffer), + &unused_length, NULL); + + /* ERROR_MORE_DATA is tolerated since we're guaranteed to have filled + * the field we want. */ + if(success || GetLastError() == ERROR_MORE_DATA) { + result = IsReparseTagNameSurrogate(reparse_buffer.ReparseTag); + } + + CloseHandle(handle); + } + + return result; +} + posix_errno_t efile_read_info(const efile_path_t *path, int follow_links, efile_fileinfo_t *result) { BY_HANDLE_FILE_INFORMATION native_file_info; DWORD attributes; + int is_link; sys_memset(&native_file_info, 0, sizeof(native_file_info)); + is_link = 0; attributes = GetFileAttributesW((WCHAR*)path->data); @@ -696,7 +734,11 @@ posix_errno_t efile_read_info(const efile_path_t *path, int follow_links, efile_ } else { HANDLE handle; - if(follow_links && (attributes & FILE_ATTRIBUTE_REPARSE_POINT)) { + if(attributes & FILE_ATTRIBUTE_REPARSE_POINT) { + is_link = is_name_surrogate(path); + } + + if(follow_links && is_link) { posix_errno_t posix_errno; efile_path_t resolved_path; @@ -737,7 +779,7 @@ posix_errno_t efile_read_info(const efile_path_t *path, int follow_links, efile_ } } - if(attributes & FILE_ATTRIBUTE_REPARSE_POINT) { + if(is_link) { result->type = EFILE_FILETYPE_SYMLINK; /* This should be _S_IFLNK, but the old driver always set * non-directories to _S_IFREG. */ @@ -917,6 +959,10 @@ posix_errno_t efile_read_link(ErlNifEnv *env, const efile_path_t *path, ERL_NIF_ return EINVAL; } + if(!is_name_surrogate(path)) { + return EINVAL; + } + posix_errno = internal_read_link(path, &result_bin); if(posix_errno == 0) { diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index e367d565a7..10adf80875 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -264,7 +264,7 @@ erts_os_monotonic_time(void) ERTS_GLB_INLINE void erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep) { - return (*erts_sys_time_data__.r.o.os_times)(mtimep, stimep); + (*erts_sys_time_data__.r.o.os_times)(mtimep, stimep); } #endif /* ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__ */ diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 661a2ee6c9..9c6dc3ff83 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -957,7 +957,7 @@ erl_544(Config) when is_list(Config) -> StackFun = fun(_, _, _) -> false end, FormatFun = fun (Term, _) -> io_lib:format("~tp", [Term]) end, Formated = - lib:format_stacktrace(1, Stack, StackFun, FormatFun), + erl_error:format_stacktrace(1, Stack, StackFun, FormatFun), true = is_list(Formated), ok after diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index e40d346e10..45dd922ff0 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -73,7 +73,7 @@ dist_evil_parallel_receiver/0]). %% epmd_module exports --export([start_link/0, register_node/2, register_node/3, port_please/2]). +-export([start_link/0, register_node/2, register_node/3, port_please/2, address_please/3]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -797,7 +797,7 @@ show_term(Term) -> %% Tests behaviour after net_kernel:stop (OTP-2586). stop_dist(Config) when is_list(Config) -> - Str = os:cmd(atom_to_list(lib:progname()) + Str = os:cmd(ct:get_progname() ++ " -noshell -pa " ++ proplists:get_value(data_dir, Config) ++ " -s run"), @@ -974,9 +974,9 @@ dist_auto_connect_start(Name, Value) when is_list(Name), is_atom(Value) -> ModuleDir = filename:dirname(code:which(?MODULE)), ValueStr = atom_to_list(Value), Cookie = atom_to_list(erlang:get_cookie()), - Cmd = lists:concat( + Cmd = lists:append( [%"xterm -e ", - atom_to_list(lib:progname()), + ct:get_progname(), % " -noinput ", " -detached ", long_or_short(), " ", Name, @@ -2086,6 +2086,11 @@ port_please(_Name, _Ip) -> {port, Port, Version} end. +address_please(_Name, _Address, _AddressFamily) -> + %% Use localhost. + IP = {127,0,0,1}, + {ok, IP}. + %%% Utilities timestamp() -> diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index 43807b4388..f93c637650 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -38,6 +38,7 @@ t_map_size/1, t_map_get/1, t_is_map/1, + t_is_map_key/1, %% Specific Map BIFs t_bif_map_get/1, @@ -718,7 +719,47 @@ t_map_get(Config) when is_list(Config) -> true = if map_get(a, M2) =:= 1 -> true; true -> false end, false = if map_get(x, M2) =:= 1 -> true; true -> false end, do_badmap(fun - (T) when map_get(T, x) =:= 1 -> ok; + (T) when map_get(x, T) =:= 1 -> ok; + (T) -> false = is_map(T) + end), + ok. + +t_is_map_key(Config) when is_list(Config) -> + %% small map + true = is_map_key(a, id(#{a=>1})), + true = is_map_key(b, id(#{a=>1, b=>2})), + true = is_map_key("hello", id(#{a=>1, "hello"=>"hi"})), + true = is_map_key({1,1.0}, id(#{a=>a, {1,1.0}=>"tuple hi"})), + + M0 = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), + true = is_map_key(<<"k2">>, M0#{<<"k2">> => "v4"}), + + %% large map + M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++ + [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"}, + {k1,"v1"},{<<"k2">>,"v3"}]), + true = is_map_key(a, M1), + true = is_map_key(b, M1), + true = is_map_key("hello", M1), + true = is_map_key({1,1.0}, M1), + true = is_map_key(<<"k2">>, M1), + + %% error cases + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{erlang,is_map_key,_,_}|_]}} = + (catch is_map_key(a, T)) + end), + + false = is_map_key({1,1}, id(#{{1,1.0}=>"tuple"})), + false = is_map_key(a, id(#{})), + false = is_map_key(a, id(#{b=>1, c=>2})), + + %% in guards + M2 = id(#{a=>1}), + true = if is_map_key(a, M2) -> true; true -> false end, + false = if is_map_key(x, M2) -> true; true -> false end, + do_badmap(fun + (T) when is_map_key(T, x) =:= 1 -> ok; (T) -> false = is_map(T) end), ok. diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index c1bc01f01e..4415d8d1b9 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -898,6 +898,13 @@ maps(Config) when is_list(Config) -> {ok,false,[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[{map_get,b,'$1'}],['$_']}], table), {ok,true,[],[]} = erlang:match_spec_test(#{a => true}, [{'$1',[{map_get,a,'$1'}],[true]}], table), + {ok,true,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{is_map_key,a,'$1'}]}], table), + {ok,false,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{is_map_key,b,'$1'}]}], table), + {ok,'EXIT',[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[],[{is_map_key,a,'$1'}]}], table), + {ok,false,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[{is_map_key,b,'$1'}],['$_']}], table), + {ok,false,[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[{is_map_key,b,'$1'}],['$_']}], table), + {ok,true,[],[]} = erlang:match_spec_test(#{a => true}, [{'$1',[{is_map_key,a,'$1'}],[true]}], table), + %% large maps Ls0 = [{I,<<I:32>>}||I <- lists:seq(1,415)], diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index df521311e3..100fa006e7 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -2663,16 +2663,23 @@ nif_term_to_binary(Config) -> nif_binary_to_term(Config) -> ensure_lib_loaded(Config), - T = {#{ok => nok}, <<0:8096>>, lists:seq(1,100)}, + BigMap = maps:from_list([{I,-I} || I <- lists:seq(1,100)]), + [nif_binary_to_term_do(T) + || T <- [{#{ok => nok}, <<0:8096>>, lists:seq(1,100)}, + atom, 42, self(), BigMap]], + ok. + +nif_binary_to_term_do(T) -> + Dummy = [true|false], Bin = term_to_binary(T), Len = byte_size(Bin), - {Len,T} = binary_to_term_nif(Bin, undefined, 0), + {Len,T,Dummy} = binary_to_term_nif(Bin, undefined, 0), Len = binary_to_term_nif(Bin, self(), 0), - T = receive M -> M after 1000 -> timeout end, + {T,Dummy} = receive M -> M after 1000 -> timeout end, - {Len, T} = binary_to_term_nif(Bin, undefined, ?ERL_NIF_BIN2TERM_SAFE), + {Len,T,Dummy} = 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), + undefined, ?ERL_NIF_BIN2TERM_SAFE), false = binary_to_term_nif(Bin, undefined, 1), ok. diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index a0aef60cf1..155bda6df0 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -2405,7 +2405,7 @@ static ERL_NIF_TERM term_to_binary(ErlNifEnv* env, int argc, const ERL_NIF_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; + ERL_NIF_TERM term, dummy, ret_term; ErlNifPid pid; ErlNifEnv *msg_env = env; unsigned int opts; @@ -2418,6 +2418,9 @@ static ERL_NIF_TERM binary_to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM || !enif_get_uint(env, argv[2], &opts)) return enif_make_badarg(env); + /* build dummy heap term first to provoke OTP-15080 */ + dummy = enif_make_list_cell(msg_env, atom_true, atom_false); + ret = enif_binary_to_term(msg_env, bin.data, bin.size, &term, (ErlNifBinaryToTerm)opts); if (!ret) @@ -2425,11 +2428,12 @@ static ERL_NIF_TERM binary_to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM ret_term = enif_make_uint64(env, ret); if (msg_env != env) { - enif_send(env, &pid, msg_env, term); + enif_send(env, &pid, msg_env, + enif_make_tuple2(msg_env, term, dummy)); enif_free_env(msg_env); return ret_term; } else { - return enif_make_tuple2(env, ret_term, term); + return enif_make_tuple3(env, ret_term, term, dummy); } } diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index 5b39d05df8..eb9b94a316 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -965,7 +965,7 @@ env_slave(File, Env) -> env_slave(File, Env, Body) -> file:write_file(File, term_to_binary(Body)), - Program = atom_to_list(lib:progname()), + Program = ct:get_progname(), Dir = filename:dirname(code:which(?MODULE)), Cmd = Program ++ " -pz " ++ Dir ++ " -noinput -run " ++ ?MODULE_STRING ++ " env_slave_main " ++ @@ -1129,7 +1129,7 @@ try_bad_args(Args) -> cd(Config) when is_list(Config) -> ct:timetrap({minutes, 1}), - Program = atom_to_list(lib:progname()), + Program = ct:get_progname(), DataDir = proplists:get_value(data_dir, Config), TestDir = filename:join(DataDir, "dir"), Cmd = Program ++ " -pz " ++ DataDir ++ @@ -1191,7 +1191,7 @@ cd(Config) when is_list(Config) -> %% be relative the new cwd and not the original cd_relative(Config) -> - Program = atom_to_list(lib:progname()), + Program = ct:get_progname(), DataDir = proplists:get_value(data_dir, Config), TestDir = filename:join(DataDir, "dir"), @@ -1214,7 +1214,7 @@ cd_relative(Config) -> relative_cd() -> - Program = atom_to_list(lib:progname()), + Program = ct:get_progname(), ok = file:set_cwd(".."), {ok, Cwd} = file:get_cwd(), diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl index c3e303bbd1..9b23a30e88 100644 --- a/erts/emulator/test/sensitive_SUITE.erl +++ b/erts/emulator/test/sensitive_SUITE.erl @@ -413,7 +413,7 @@ my_process_info(Pid, Tag) -> t_process_display(Config) when is_list(Config) -> Dir = filename:dirname(code:which(?MODULE)), - Cmd = atom_to_list(lib:progname()) ++ " -noinput -pa " ++ Dir ++ + Cmd = ct:get_progname() ++ " -noinput -pa " ++ Dir ++ " -run " ++ ?MODULE_STRING ++ " remote_process_display", io:put_chars(Cmd), P = open_port({spawn,Cmd}, [in,stderr_to_stdout,eof]), diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl index c9be54f668..ae27bfe9df 100644 --- a/erts/emulator/test/system_profile_SUITE.erl +++ b/erts/emulator/test/system_profile_SUITE.erl @@ -95,18 +95,20 @@ do_runnable_procs({TsType, TsTypeFlag}) -> % FIXME: Set #laps and #nodes in config file Nodes = 10, Laps = 10, - Master = ring(Nodes), + All = ring(Nodes, [link,monitor]), + [Master | _] = All, undefined = erlang:system_profile(Pid, [runnable_procs]++TsTypeFlag), % loop a message ok = ring_message(Master, message, Laps), + ok = kill_ring(Master), + [receive {'DOWN', _, process, P, _} -> ok end || P <- All], Events = get_profiler_events(), - kill_em_all = kill_ring(Master), erlang:system_profile(undefined, []), put(master, Master), put(laps, Laps), true = has_runnable_event(TsType, Events), Pids = sort_events_by_pid(Events), - ok = check_events(TsType, Pids), + ok = check_events(TsType, Pids, (Laps+1)*2+2, (Laps+1)*2), erase(), exit(Pid,kill), ok. @@ -139,7 +141,7 @@ do_runnable_ports({TsType, TsTypeFlag}, Config) -> erlang:system_profile(undefined, []), true = has_runnable_event(TsType, Events), Pids = sort_events_by_pid(Events), - ok = check_events(TsType, Pids), + ok = check_events(TsType, Pids, Laps*2+2, Laps*2), erase(), exit(Pid,kill), ok. @@ -171,12 +173,12 @@ dont_profile_profiler(Config) when is_list(Config) -> Nodes = 10, Laps = 10, - Master = ring(Nodes), + [Master|_] = ring(Nodes, [link]), undefined = erlang:system_profile(Pid, [runnable_procs]), % loop a message ok = ring_message(Master, message, Laps), erlang:system_profile(undefined, []), - kill_em_all = kill_ring(Master), + ok = kill_ring(Master), Events = get_profiler_events(), false = has_profiler_pid_event(Events, Pid), @@ -248,27 +250,28 @@ check_block_system({TsType, TsTypeFlag}, Nodes) -> %%% Check events -check_events(_TsType, []) -> ok; -check_events(TsType, [Pid | Pids]) -> +check_events(_TsType, [], _, _) -> ok; +check_events(TsType, [Pid | Pids], ExpMaster, ExpMember) -> Master = get(master), - Laps = get(laps), CheckPids = get(pids), {Events, N} = get_pid_events(Pid), ok = check_event_flow(Events), ok = check_event_ts(TsType, Events), IsMember = lists:member(Pid, CheckPids), - case Pid of - Master -> - io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2+2, N, Pid]), - N = Laps*2 + 2, - check_events(TsType, Pids); - Pid when IsMember == true -> - io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2, N, Pid]), - N = Laps*2, - check_events(TsType, Pids); - Pid -> - check_events(TsType, Pids) - end. + {Title,Exp} = case Pid of + Master -> {master,ExpMaster}; + Pid when IsMember == true -> {member,ExpMember}; + _ -> {other,N} + end, + ok = case N of + Exp -> ok; + _ -> + io:format("Expected ~p and got ~p profile events from ~p ~p:~n~p~n", + [Exp, N, Title, Pid, Events]), + error + end, + check_events(TsType, Pids, ExpMaster, ExpMember). + %% timestamp consistency check for descending timestamps @@ -296,7 +299,13 @@ check_event_ts(TsType, [{Pid, _, _, TS1}=Event | Events], {Pid,_,_,TS0}) -> %% consistency check for active vs. inactive activity (runnable) check_event_flow(Events) -> - check_event_flow(Events, undefined). + case check_event_flow(Events, undefined) of + ok -> ok; + Error -> + io:format("Events = ~p\n", [Events]), + Error + end. + check_event_flow([], _) -> ok; check_event_flow([Event | PidEvents], undefined) -> check_event_flow(PidEvents, Event); @@ -336,10 +345,11 @@ sort_events_by_pid([Event | Events],Pids) -> %% API % Returns master pid -ring(N) -> - Pids = build_ring(N, []), +ring(N, SpawnOpt) -> + Pids = build_ring(N, [], SpawnOpt), put(pids, Pids), - setup_ring(Pids). + setup_ring(Pids), + Pids. ring_message(Master, Message, Laps) -> Master ! {message, Master, Laps, Message}, @@ -347,13 +357,19 @@ ring_message(Master, Message, Laps) -> {laps_complete, Master} -> ok end. -kill_ring(Master) -> Master ! kill_em_all. +kill_ring(Master) -> + Master ! kill_em_all, + ok. %% Process ring helpers -build_ring(0, Pids) -> Pids; -build_ring(N, Pids) -> - build_ring(N - 1, [spawn_link(?MODULE, ring_loop, [undefined]) | Pids]). +build_ring(0, Pids, _) -> Pids; +build_ring(N, Pids, SpawnOpt) -> + Pid = case spawn_opt(?MODULE, ring_loop, [undefined], SpawnOpt) of + {P,_} -> P; + P -> P + end, + build_ring(N-1, [Pid | Pids], SpawnOpt). setup_ring([Master | Relayers]) -> % Relayers may not include the master pid @@ -382,15 +398,13 @@ ring_loop(RelayTo) -> {message, Master, Lap, Msg}=Message -> case {self(), Lap} of {Master, 0} -> - get(supervisor) ! {laps_complete, self()}, - ring_loop(RelayTo); + get(supervisor) ! {laps_complete, self()}; {Master, Lap} -> - RelayTo ! {message, Master, Lap - 1, Msg}, - ring_loop(RelayTo); + RelayTo ! {message, Master, Lap - 1, Msg}; _ -> - RelayTo ! Message, - ring_loop(RelayTo) - end + RelayTo ! Message + end, + ring_loop(RelayTo) end. %%% diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index def25dba7d..138aefb29c 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -29,7 +29,7 @@ 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_new_trace/1, - suspend/1, mutual_suspend/1, suspend_exit/1, suspender_exit/1, + suspend/1, suspend_exit/1, suspender_exit/1, suspend_system_limit/1, suspend_opts/1, suspend_waiting/1, new_clear/1, existing_clear/1, tracer_die/1, set_on_spawn/1, set_on_first_spawn/1, cpu_timestamp/1, @@ -53,7 +53,7 @@ all() -> [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_exit, suspender_exit, suspend_system_limit, suspend_opts, suspend_waiting, new_clear, existing_clear, tracer_die, set_on_spawn, set_on_first_spawn, set_on_link, set_on_first_link, @@ -1234,55 +1234,6 @@ do_suspend(Pid, N) -> erlang:yield(), do_suspend(Pid, N-1). - - -mutual_suspend(Config) when is_list(Config) -> - 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) -> - ok; -do_mutual_suspend(Pid, N) -> - %% Suspend a process and test that it is suspended. - true = erlang:suspend_process(Pid), - {status, suspended} = process_info(Pid, status), - %% Unsuspend the process. - true = erlang:resume_process(Pid), - do_mutual_suspend(Pid, N-1). - suspend_exit(Config) when is_list(Config) -> ct:timetrap({minutes, 2}), rand:seed(exsplus, {4711,17,4711}), @@ -1513,7 +1464,8 @@ suspend_opts(Config) when is_list(Config) -> dbl_async = AA, synced = S, async_once = AO} = Acc) -> - erlang:suspend_process(Tok, [asynchronous]), + Tag = {make_ref(), self()}, + erlang:suspend_process(Tok, [{asynchronous, Tag}]), Res = case {suspend_count(Tok), N rem 4} of {0, 2} -> erlang:suspend_process(Tok, @@ -1549,7 +1501,11 @@ suspend_opts(Config) when is_list(Config) -> _ -> Acc end, - erlang:resume_process(Tok), + receive + {Tag, Result} -> + suspended = Result, + erlang:resume_process(Tok) + end, erlang:yield(), Res end, diff --git a/erts/emulator/test/tracer_SUITE.erl b/erts/emulator/test/tracer_SUITE.erl index e1362ef07a..070462b0f1 100644 --- a/erts/emulator/test/tracer_SUITE.erl +++ b/erts/emulator/test/tracer_SUITE.erl @@ -623,7 +623,7 @@ test(Event, TraceFlag, Tc, Expect, _Removes, Dies) -> Expect(Pid1, State1, Opts), receive M11 -> ct:fail({unexpected, M11}) after 0 -> ok end, - if not Dies -> + if not Dies andalso Event /= in -> {flags, [TraceFlag]} = erlang:trace_info(Pid1, flags), {tracer, {tracer_test, State1}} = erlang:trace_info(Pid1, tracer), erlang:trace(Pid1, false, [TraceFlag]); @@ -640,7 +640,7 @@ test(Event, TraceFlag, Tc, Expect, _Removes, Dies) -> Expect(Pid1T, State1, Opts#{ scheduler_id => number, timestamp => timestamp}), receive M11T -> ct:fail({unexpected, M11T}) after 0 -> ok end, - if not Dies -> + if not Dies andalso Event /= in -> {flags, [scheduler_id, TraceFlag, timestamp]} = erlang:trace_info(Pid1T, flags), {tracer, {tracer_test, State1}} = erlang:trace_info(Pid1T, tracer), @@ -655,7 +655,7 @@ test(Event, TraceFlag, Tc, Expect, _Removes, Dies) -> Tc(Pid2), ok = trace_delivered(Pid2), receive M2 -> ct:fail({unexpected, M2}) after 0 -> ok end, - if not Dies -> + if not Dies andalso Event /= in -> {flags, [TraceFlag]} = erlang:trace_info(Pid2, flags), {tracer, {tracer_test, State2}} = erlang:trace_info(Pid2, tracer), erlang:trace(Pid2, false, [TraceFlag]); diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index e5ef819444..39e378193a 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -1232,6 +1232,142 @@ end # Commands for special term bunches. # +define etp-sig-int + set $etp_sig_is_message = 0 + set $etp_sig_tag = ($arg0)->m[0] + if ($etp_sig_tag & 0x3) != 0 || $etp_sig_tag == etp_the_non_value + set $etp_sig_is_message = !0 + # A message + if $etp_sig_tag != etp_the_non_value + etp-1 $etp_sig_tag 0 + else + print "!ENCODED-DIST-MSG" + end + if ($arg0)->m[1] != $etp_nil + printf " @token= " + etp-1 ($arg0)->m[1] 0 + end + printf " @from= " + etp-1 ($arg0)->m[2] 0 + else + if ($etp_sig_tag & 0x3f) != 0x30 + print "!INVALID-SIGNAL" + else + set $etp_sig_op = (($etp_sig_tag >> 6) & 0xff) + set $etp_sig_type = (($etp_sig_tag >> 14) & 0xff) + if $etp_sig_op == 0 + printf "!EXIT[%d]", $etp_sig_type + else + if $etp_sig_op == 1 + printf "!EXIT-LINKED[%d]", $etp_sig_type + else + if $etp_sig_op == 2 + printf "!MONITOR-DOWN[%d]", $etp_sig_type + else + if $etp_sig_op == 3 + printf "!MONITOR[%d]", $etp_sig_type + else + if $etp_sig_op == 4 + printf "!DEMONITOR[%d]", $etp_sig_type + else + if $etp_sig_op == 5 + printf "!LINK[%d]", $etp_sig_type + else + if $etp_sig_op == 6 + printf "!UNLINK[%d]", $etp_sig_type + else + if $etp_sig_op == 7 + printf "!GROUP-LEADER[%d]", $etp_sig_type + else + if $etp_sig_op == 8 + printf "!TRACE-CHANGE-STATE[%d]", $etp_sig_type + else + if $etp_sig_op == 9 + printf "!PERSISTENT-MONITOR-MESSAGE[%d]", $etp_sig_type + else + if $etp_sig_op == 10 + printf "!IS-ALIVE[%d]", $etp_sig_type + else + if $etp_sig_op == 11 + printf "!PROCESS-INFO[%d]", $etp_sig_type + else + if $etp_sig_op == 12 + printf "!SYNC-SUSPEND[%d]", $etp_sig_type + else + if $etp_sig_op == 13 + printf "!RPC[%d]", $etp_sig_type + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end + end +end + + +define etp-sigq-int +# Args: ErlMessageQueue* +# +# Non-reentrant +# + set $etp_sig = ($arg0) + set $etp_sig_save = ($arg1) + set $etp_sig_save_last = ($arg2) + set $etp_sigq_msig_len = 0 + set $etp_sigq_nmsig_len = 0 + + printf " [" + while $etp_sig != (void *) 0 + set $etp_sig_next = $etp_sig->next + if $etp_sig != ($arg0) + printf " " + end + etp-sig-int $etp_sig + if $etp_sig_is_message + set $etp_sigq_msig_len++ + else + set $etp_sigq_nmsig_len++ + end + if $etp_sig_next + printf "," + end + if $etp_sig_save && *$etp_sig_save == $etp_sig + printf " %% <== SAVE" + else + if $etp_sig_save_last && *$etp_sig_save_last == $etp_sig + printf " %% <== SAVED_LAST" + else + end + end + if $etp_sig_next + printf "\n" + end + set $etp_sig = $etp_sig_next + end + printf "]\n\n" + printf " Message signals: %d\n", $etp_sigq_msig_len + printf " Non-message signals: %d\n\n", $etp_sigq_nmsig_len +end + +define etp-sigqs + printf " --- Inner signal queue (message queue) ---\n" + etp-sigq-int ($arg0)->sig_qs.first ($arg0)->sig_qs.save ($arg0)->sig_qs.saved_last + printf " --- Middle signal queue ---\n" + etp-sigq-int ($arg0)->sig_qs.cont ($arg0)->sig_qs.save ($arg0)->sig_qs.saved_last + printf " --- Outer queue ---\n" + etp-sigq-int ($arg0)->sig_inq.first ($arg0)->sig_qs.save ($arg0)->sig_qs.saved_last +end + define etp-msgq # Args: ErlMessageQueue* # @@ -1937,7 +2073,7 @@ document etp-proc-flags %--------------------------------------------------------------------------- end -define etp-process-info +define etp-process-info-int # Args: Process* # printf " Pid: " @@ -2000,6 +2136,17 @@ define etp-process-info etp-1 ((Eterm)($etp_proc->parent)) printf "\n Pointer: (Process *) %p\n", $etp_proc end + if ($arg1) + etp-sigqs $etp_proc + end +end + +define etp-process-info + etp-process-info-int ($arg0) 0 +end + +define etp-process-info-x + etp-process-info-int ($arg0) !0 end document etp-process-info @@ -2010,7 +2157,7 @@ document etp-process-info %--------------------------------------------------------------------------- end -define etp-processes +define etp-processes-int if (!erts_initialized) printf "No processes, since system isn't initialized!\n" else @@ -2026,7 +2173,7 @@ define etp-processes if ($proc != ((Process *) 0) && $proc != $invalid_proc) printf "---\n" printf " Pix: %d\n", $proc_ix - etp-process-info $proc + etp-process-info-int $proc ($arg0) set $proc_cnt-- end if $proc_ix == $proc_printile @@ -2039,6 +2186,14 @@ define etp-processes end end +define etp-processes + etp-processes-int 0 +end + +define etp-processes-x + etp-processes-int !0 +end + document etp-processes %--------------------------------------------------------------------------- % etp-processes diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex 10545086b5..495d306a23 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex d3fbc8eb61..52f4c686a9 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam b/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam Binary files differindex 8d9ca3fcae..1013b8de0c 100644 --- a/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam +++ b/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex cdfdaf9640..73bd730eaa 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 0473eda5fb..1b458fc5da 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex d1b3f5dca4..b11e428229 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 53e90a4f2d..3a42e841e2 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -135,7 +135,7 @@ -export([insert_element/3]). -export([integer_to_binary/1, integer_to_list/1]). -export([iolist_size/1, iolist_to_binary/1, iolist_to_iovec/1]). --export([is_alive/0, is_builtin/3, is_process_alive/1, length/1, link/1]). +-export([is_alive/0, is_builtin/3, is_map_key/2, is_process_alive/1, length/1, link/1]). -export([list_to_atom/1, list_to_binary/1]). -export([list_to_bitstring/1, list_to_existing_atom/1, list_to_float/1]). -export([list_to_integer/1, list_to_integer/2]). @@ -1121,6 +1121,13 @@ is_alive() -> is_builtin(_Module, _Function, _Arity) -> erlang:nif_error(undefined). +%% Shadowed by erl_bif_types: erlang:is_map_key/2 +-spec is_map_key(Key, Map) -> boolean() when + Key :: term(), + Map :: map(). +is_map_key(_,_) -> + erlang:nif_error(undef). + %% is_process_alive/1 -spec is_process_alive(Pid) -> boolean() when Pid :: pid(). @@ -1514,8 +1521,21 @@ pre_loaded() -> -spec erlang:process_display(Pid, Type) -> true when Pid :: pid(), Type :: backtrace. -process_display(_Pid, _Type) -> - erlang:nif_error(undefined). +process_display(Pid, Type) -> + case case erts_internal:process_display(Pid, Type) of + Ref when erlang:is_reference(Ref) -> + receive + {Ref, Res} -> + Res + end; + Res -> + Res + end of + badarg -> + erlang:error(badarg, [Pid, Type]); + Result -> + Result + end. %% process_flag/3 -spec process_flag(Pid, Flag, Value) -> OldValue when @@ -1523,8 +1543,15 @@ process_display(_Pid, _Type) -> Flag :: save_calls, Value :: non_neg_integer(), OldValue :: non_neg_integer(). -process_flag(_Pid, _Flag, _Value) -> - erlang:nif_error(undefined). +process_flag(Pid, Flag, Value) -> + case case erts_internal:process_flag(Pid, Flag, Value) of + Ref when erlang:is_reference(Ref) -> + receive {Ref, Res} -> Res end; + Res -> Res + end of + badarg -> erlang:error(badarg, [Pid, Flag, Value]); + Result -> Result + end. %% process_info/1 -spec process_info(Pid) -> Info when @@ -1678,12 +1705,26 @@ setnode(_P1, _P2) -> erlang:nif_error(undefined). %% setnode/3 --spec erlang:setnode(P1, P2, P3) -> dist_handle() when - P1 :: atom(), - P2 :: port(), - P3 :: {term(), term(), term(), term()}. -setnode(_P1, _P2, _P3) -> - erlang:nif_error(undefined). +-spec erlang:setnode(Node, DistCtrlr, Opts) -> dist_handle() when + Node :: atom(), + DistCtrlr :: port() | pid(), + Opts :: {integer(), integer(), atom(), atom()}. +setnode(Node, DistCtrlr, {Flags, Ver, IC, OC} = Opts) when erlang:is_atom(IC), + erlang:is_atom(OC) -> + case case erts_internal:create_dist_channel(Node, DistCtrlr, + Flags, Ver) of + {ok, DH} -> DH; + {message, Ref} -> receive {Ref, Res} -> Res end; + Err -> Err + end of + Error when erlang:is_atom(Error) -> + erlang:error(Error, [Node, DistCtrlr, Opts]); + DHandle -> + DHandle + end; +setnode(Node, DistCtrlr, Opts) -> + erlang:error(badarg, [Node, DistCtrlr, Opts]). + %% size/1 %% Shadowed by erl_bif_types: erlang:size/1 @@ -1742,9 +1783,32 @@ start_timer(_Time, _Dest, _Msg, _Options) -> -spec erlang:suspend_process(Suspendee, OptList) -> boolean() when Suspendee :: pid(), OptList :: [Opt], - Opt :: unless_suspending | asynchronous. -suspend_process(_Suspendee, _OptList) -> - erlang:nif_error(undefined). + Opt :: unless_suspending | asynchronous | {asynchronous, term()}. +suspend_process(Suspendee, OptList) -> + case case erts_internal:suspend_process(Suspendee, OptList) of + Ref when erlang:is_reference(Ref) -> + receive {Ref, Res} -> Res end; + Res -> + Res + end of + true -> true; + false -> false; + Error -> erlang:error(Error, [Suspendee, OptList]) + end. + +-spec erlang:suspend_process(Suspendee) -> 'true' when + Suspendee :: pid(). +suspend_process(Suspendee) -> + case case erts_internal:suspend_process(Suspendee, []) of + Ref when erlang:is_reference(Ref) -> + receive {Ref, Res} -> Res end; + Res -> + Res + end of + true -> true; + false -> erlang:error(internal_error, [Suspendee]); + Error -> erlang:error(Error, [Suspendee]) + end. %% system_monitor/0 -spec erlang:system_monitor() -> MonSettings when @@ -3038,15 +3102,6 @@ send_nosuspend(Pid, Msg, Opts) -> localtime_to_universaltime(Localtime) -> erlang:localtime_to_universaltime(Localtime, undefined). --spec erlang:suspend_process(Suspendee) -> 'true' when - Suspendee :: pid(). -suspend_process(P) -> - case catch erlang:suspend_process(P, []) of - {'EXIT', {Reason, _}} -> erlang:error(Reason, [P]); - {'EXIT', Reason} -> erlang:error(Reason, [P]); - Res -> Res - end. - %% %% Port BIFs %% diff --git a/erts/preloaded/src/erts_dirty_process_signal_handler.erl b/erts/preloaded/src/erts_dirty_process_signal_handler.erl index ab71790b9d..381f81ef14 100644 --- a/erts/preloaded/src/erts_dirty_process_signal_handler.erl +++ b/erts/preloaded/src/erts_dirty_process_signal_handler.erl @@ -50,10 +50,12 @@ handle_request(Pid) when is_pid(Pid) -> handle_incoming_signals(Pid, 0); handle_request({Requester, Target, Prio, {SysTaskOp, ReqId, Arg} = Op} = Request) -> - case handle_sys_task(Requester, Target, SysTaskOp, ReqId, Arg) of - true -> + case handle_sys_task(Requester, Target, SysTaskOp, ReqId, Arg, 0) of + done -> ok; - false -> + busy -> + self() ! Request; + normal -> %% Target has stopped executing dirty since the %% initial request was made. Dispatch the %% request to target and let it handle it itself... @@ -83,15 +85,19 @@ handle_incoming_signals(Pid, N) -> _Res -> ok end. -handle_sys_task(Requester, Target, check_process_code, ReqId, Module) -> - case erts_internal:is_process_executing_dirty(Target) of - false -> - false; - true -> - _ = check_process(Requester, Target, ReqId, Module), - true +handle_sys_task(Requester, Target, check_process_code, ReqId, Module, N) -> + case erts_internal:check_dirty_process_code(Target, Module) of + Bool when Bool == true; Bool == false -> + Requester ! {check_process_code, ReqId, Bool}, + done; + busy -> + case N > 5 of + true -> + busy; + false -> + handle_sys_task(Requester, Target, check_process_code, + ReqId, Module, N+1) + end; + Res -> + Res end. - -check_process(Requester, Target, ReqId, Module) -> - Result = erts_internal:check_dirty_process_code(Target, Module), - Requester ! {check_process_code, ReqId, Result}. diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 79169b7d23..88f47e917b 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -82,6 +82,14 @@ -export([gather_alloc_histograms/1, gather_carrier_info/1]). +-export([suspend_process/2]). + +-export([process_display/2]). + +-export([process_flag/3]). + +-export([create_dist_channel/4]). + %% %% Await result of send to port %% @@ -303,7 +311,8 @@ get_cpc_opts([{allow_gc, AllowGC} | Options], Async) when AllowGC == true; get_cpc_opts([], Async) -> Async. --spec check_dirty_process_code(Pid,Module) -> 'true' | 'false' when +-spec check_dirty_process_code(Pid, Module) -> Result when + Result :: boolean() | 'normal' | 'busy', Pid :: pid(), Module :: module(). check_dirty_process_code(_Pid,_Module) -> @@ -644,3 +653,41 @@ gather_alloc_histograms(_) -> gather_carrier_info(_) -> erlang:nif_error(undef). + +-spec suspend_process(Suspendee, OptList) -> Result when + Result :: boolean() | 'badarg' | reference(), + Suspendee :: pid(), + OptList :: [Opt], + Opt :: unless_suspending | asynchronous | {asynchronous, term()}. + +suspend_process(_Suspendee, _OptList) -> + erlang:nif_error(undefined). + +%% process_display/2 +-spec process_display(Pid, Type) -> 'true' | 'badarg' | reference() when + Pid :: pid(), + Type :: backtrace. +process_display(_Pid, _Type) -> + erlang:nif_error(undefined). + +%% process_flag/3 +-spec process_flag(Pid, Flag, Value) -> OldValue | 'badarg' | reference() when + Pid :: pid(), + Flag :: save_calls, + Value :: non_neg_integer(), + OldValue :: non_neg_integer(). +process_flag(_Pid, _Flag, _Value) -> + erlang:nif_error(undefined). + +-spec create_dist_channel(Node, DistCtrlr, Flags, Ver) -> Result when + Node :: atom(), + DistCtrlr :: port() | pid(), + Flags :: integer(), + Ver :: integer(), + Result :: {'ok', erlang:dist_handle()} + | {'message', reference()} + | 'badarg' + | 'system_limit'. + +create_dist_channel(_Node, _DistCtrlr, _Flags, _Ver) -> + erlang:nif_error(undefined). diff --git a/erts/test/erlc_SUITE.erl b/erts/test/erlc_SUITE.erl index 394ecc8964..622c4ec06b 100644 --- a/erts/test/erlc_SUITE.erl +++ b/erts/test/erlc_SUITE.erl @@ -505,7 +505,7 @@ run_command(Dir, {win32, _}, Cmd) -> {BatchFile, Run, ["@echo off\r\n", - "set ERLC_EMULATOR=", atom_to_list(lib:progname()), "\r\n", + "set ERLC_EMULATOR=", ct:get_progname(), "\r\n", Cmd, "\r\n", "if errorlevel 1 echo _ERROR_\r\n", "if not errorlevel 1 echo _OK_\r\n"]}; @@ -514,7 +514,7 @@ run_command(Dir, {unix, _}, Cmd) -> {Name, "/bin/sh " ++ Name, ["#!/bin/sh\n", - "ERLC_EMULATOR='", atom_to_list(lib:progname()), "'\n", + "ERLC_EMULATOR='", ct:get_progname(), "'\n", "export ERLC_EMULATOR\n", Cmd, "\n", "case $? in\n", diff --git a/lib/common_test/doc/src/ct.xml b/lib/common_test/doc/src/ct.xml index afd8741cd1..3d35ae4f54 100644 --- a/lib/common_test/doc/src/ct.xml +++ b/lib/common_test/doc/src/ct.xml @@ -572,6 +572,16 @@ </func> <func> + <name>get_progname() -> string()</name> + <fsummary>Returns the command used to start this Erlang instance.</fsummary> + <desc><marker id="get_progname-0"/> + <p>Returns the command used to start this Erlang instance. + If this information could not be found, the string + <c>"no_prog_name"</c> is returned.</p> + </desc> + </func> + + <func> <name>get_status() -> TestStatus | {error, Reason} | no_tests_running</name> <fsummary>Returns status of ongoing test.</fsummary> <type> diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 2a2a9cb5bc..9adcf2f13b 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -166,4 +166,4 @@ release_tests_spec: opt release_docs_spec: docs # Include dependencies -- list below added by Kostis Sagonas -$(EBIN)/cth_log_redirect.beam: ../../kernel/include/logger.hrl +$(EBIN)/cth_log_redirect.beam: ../../kernel/include/logger.hrl ../../kernel/src/logger_internal.hrl diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index fd7fa07b81..14a9ec07cf 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -87,6 +87,7 @@ decrypt_config_file/2, decrypt_config_file/3]). -export([get_target_name/1]). +-export([get_progname/0]). -export([parse_table/1, listenv/1]). -export([remaining_test_procs/0]). @@ -975,7 +976,20 @@ make_priv_dir() -> %%% belongs to. get_target_name(Handle) -> ct_util:get_target_name(Handle). - + +%%%----------------------------------------------------------------- +%%% @doc Return the command used to start (this) erlang + +-spec get_progname() -> string(). + +get_progname() -> + case init:get_argument(progname) of + {ok, [[Prog]]} -> + Prog; + _Other -> + "no_prog_name" + end. + %%%----------------------------------------------------------------- %%% @spec parse_table(Data) -> {Heading,Table} %%% Data = [string()] @@ -1006,7 +1020,6 @@ parse_table(Data) -> listenv(Telnet) -> ct_util:listenv(Telnet). - %%%----------------------------------------------------------------- %%% @spec testcases(TestDir, Suite) -> Testcases | {error,Reason} %%% TestDir = string() diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl index 1ae6c8c7c7..67645cac08 100644 --- a/lib/common_test/src/test_server_ctrl.erl +++ b/lib/common_test/src/test_server_ctrl.erl @@ -4382,7 +4382,7 @@ do_format_exception(Reason={Error,Stack}) -> PF = fun(Term, I) -> io_lib:format("~." ++ integer_to_list(I) ++ "tp", [Term]) end, - case catch lib:format_exception(1, error, Error, Stack, StackFun, PF, utf8) of + case catch erl_error:format_exception(1, error, Error, Stack, StackFun, PF, utf8) of {'EXIT',_R} -> {"~tp",Reason}; Formatted -> diff --git a/lib/common_test/src/test_server_node.erl b/lib/common_test/src/test_server_node.erl index b2d4f199c3..76588e6887 100644 --- a/lib/common_test/src/test_server_node.erl +++ b/lib/common_test/src/test_server_node.erl @@ -591,7 +591,7 @@ cast_to_list(X) -> lists:flatten(io_lib:format("~tw", [X])). %%% this %%% pick_erl_program(default) -> - cast_to_list(lib:progname()); + ct:get_progname(); pick_erl_program(L) -> P = random_element(L), case P of @@ -600,7 +600,7 @@ pick_erl_program(L) -> {release, S} -> find_release(S); this -> - cast_to_list(lib:progname()) + ct:get_progname() end. %% This is an attempt to distinguish between spaces in the program @@ -611,8 +611,8 @@ pick_erl_program(L) -> %% ({prog,String}) or if the -program switch to beam is used and %% includes arguments (typically done by cerl in OTP test environment %% in order to ensure that slave/peer nodes are started with the same -%% emulator and flags as the test node. The return from lib:progname() -%% could then typically be '/<full_path_to>/cerl -gcov'). +%% emulator and flags as the test node. The return from ct:get_progname() +%% could then typically be "/<full_path_to>/cerl -gcov"). quote_progname(Progname) -> do_quote_progname(string:lexemes(Progname," ")). diff --git a/lib/common_test/test_server/ts_erl_config.erl b/lib/common_test/test_server/ts_erl_config.erl index c7fe4ccf83..e37fa844bb 100644 --- a/lib/common_test/test_server/ts_erl_config.erl +++ b/lib/common_test/test_server/ts_erl_config.erl @@ -358,7 +358,15 @@ link_library(_LibName,_Other) -> %% Returns emulator specific variables. emu_vars(Vars) -> [{is_source_build, is_source_build()}, - {erl_name, atom_to_list(lib:progname())}|Vars]. + {erl_name, get_progname()}|Vars]. + +get_progname() -> + case init:get_argument(progname) of + {ok, [[Prog]]} -> + Prog; + _Other -> + "no_prog_name" + end. is_source_build() -> string:find(erlang:system_info(system_version), "source") =/= nomatch. diff --git a/lib/common_test/test_server/ts_run.erl b/lib/common_test/test_server/ts_run.erl index 3f594236bc..5dbbaca916 100644 --- a/lib/common_test/test_server/ts_run.erl +++ b/lib/common_test/test_server/ts_run.erl @@ -199,7 +199,7 @@ make_command(Vars, Spec, State) -> TestPath = filename:nativename(TestDir), Erl = case os:getenv("TS_RUN_VALGRIND") of false -> - atom_to_list(lib:progname()); + ct:get_progname(); _ -> case State#state.file of Dir when is_list(Dir) -> diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index dbbaae05eb..762c7bdf9e 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -392,6 +392,26 @@ backward([{bif,'or',{f,To0},[Dst,{atom,false}],Dst}=I|Is], D, _ -> backward(Is, D, [I|Acc]) end; +backward([{bif,map_get,{f,FF},[Key,Map],_}=I0, + {test,has_map_fields,{f,FT}=F,[Map|Keys0]}=I1|Is], D, Acc) when FF =/= 0 -> + case shortcut_label(FF, D) of + FT -> + case lists:delete(Key, Keys0) of + [] -> + backward([I0|Is], D, Acc); + Keys -> + Test = {test,has_map_fields,F,[Map|Keys]}, + backward([Test|Is], D, [I0|Acc]) + end; + _ -> + backward([I1|Is], D, [I0|Acc]) + end; +backward([{bif,map_get,{f,FF},[_,Map],_}=I0, + {test,is_map,{f,FT},[Map]}=I1|Is], D, Acc) when FF =/= 0 -> + case shortcut_label(FF, D) of + FT -> backward([I0|Is], D, Acc); + _ -> backward([I1|Is], D, [I0|Acc]) + end; backward([I|Is], D, Acc) -> backward(Is, D, [I|Acc]); backward([], _D, Acc) -> Acc. diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index eb3192fe8f..920fb00397 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -77,6 +77,12 @@ peep([{bif,tuple_size,_,[_]=Ops,Dst}=I|Is], SeenTests0, Acc) -> %% Kill all remembered tests that depend on the destination register. SeenTests = kill_seen(Dst, SeenTests1), peep(Is, SeenTests, [I|Acc]); +peep([{bif,map_get,_,[Key,Map],Dst}=I|Is], SeenTests0, Acc) -> + %% Pretend that we have seen {test,has_map_fields,_,[Map,Key]} + SeenTests1 = gb_sets:add({has_map_fields,[Map,Key]}, SeenTests0), + %% Kill all remembered tests that depend on the destination register. + SeenTests = kill_seen(Dst, SeenTests1), + peep(Is, SeenTests, [I|Acc]); peep([{bif,_,_,_,Dst}=I|Is], SeenTests0, Acc) -> %% Kill all remembered tests that depend on the destination register. SeenTests = kill_seen(Dst, SeenTests0), diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 28f36db399..12da8c9446 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -462,6 +462,9 @@ update({set,[D],[Index,Reg],{bif,element,_}}, Ts0) -> end, Ts = tdb_meet(Reg, {tuple,min_size,MinSize,[]}, Ts0), tdb_store(D, any, Ts); +update({set,[D],[_Key,Map],{bif,map_get,_}}, Ts0) -> + Ts = tdb_meet(Map, map, Ts0), + tdb_store(D, any, Ts); update({set,[D],Args,{bif,N,_}}, Ts) -> Ar = length(Args), BoolOp = erl_internal:new_type_test(N, Ar) orelse diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index c7a129b42c..533c984221 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -351,10 +351,9 @@ mapfold(F, S0, T) -> mapfold(fun(T0, A) -> {T0, A} end, F, S0, T). -%% @spec mapfold(Pre, Post, Initial::term(), Tree::cerl()) -> -%% {cerl(), term()} -%% -%% Pre = Post = (cerl(), term()) -> {cerl(), term()} +%% @spec mapfold(Pre, Post, Initial::term(), Tree::cerl()) -> {cerl(), term()} +%% Pre = (cerl(), term()) -> {cerl(), term()} +%% Post = (cerl(), term()) -> {cerl(), term()} %% %% @doc Does a combined map/fold operation on the nodes of the %% tree. It begins by calling <code>Pre</code> on the tree, using the diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index c6a0056a70..a37b2064b2 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -295,7 +295,7 @@ format_error_reason({Reason, Stack}) when is_list(Stack) -> end, FormatFun = fun (Term, _) -> io_lib:format("~tp", [Term]) end, [io_lib:format("~tp", [Reason]),"\n\n", - lib:format_stacktrace(1, Stack, StackFun, FormatFun)]; + erl_error:format_stacktrace(1, Stack, StackFun, FormatFun)]; format_error_reason(Reason) -> io_lib:format("~tp", [Reason]). diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 70b36f029e..a7452aebc8 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -94,6 +94,7 @@ is_pure(erlang, is_function, 1) -> true; is_pure(erlang, is_integer, 1) -> true; is_pure(erlang, is_list, 1) -> true; is_pure(erlang, is_map, 1) -> true; +is_pure(erlang, is_map_key, 2) -> true; is_pure(erlang, is_number, 1) -> true; is_pure(erlang, is_pid, 1) -> true; is_pure(erlang, is_port, 1) -> true; diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 8e73b613a0..9652a8476d 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -589,6 +589,7 @@ is_gc_bif(element, 2) -> false; is_gc_bif(get, 1) -> false; is_gc_bif(tuple_size, 1) -> false; is_gc_bif(map_get, 2) -> false; +is_gc_bif(is_map_key, 2) -> false; is_gc_bif(Bif, Arity) -> not (erl_internal:bool_op(Bif, Arity) orelse erl_internal:new_type_test(Bif, Arity) orelse @@ -1620,6 +1621,11 @@ test_cg(is_boolean, [#k_atom{val=Val}], Fail, I, Vdb, Bef, St) -> false -> [{jump,{f,Fail}}] end, {Is,Aft,St}; +test_cg(is_map_key, As, Fail, I, Vdb, Bef, St) -> + [Key,Map] = cg_reg_args(As, Bef), + Aft = clear_dead(Bef, I, Vdb), + F = {f,Fail}, + {[{test,is_map,F,[Map]},{test,has_map_fields,F,Map,{list,[Key]}}],Aft,St}; test_cg(Test, As, Fail, I, Vdb, Bef, St) -> Args = cg_reg_args(As, Bef), Aft = clear_dead(Bef, I, Vdb), diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 235956a714..3b6ffa8d68 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -330,6 +330,11 @@ save_restore(Config) when is_list(Config) -> {"-",<<"x">>} = nnn(C), {"-",<<"x">>} = ooo(C), + a = multiple_matches(<<777:16>>, <<777:16>>), + b = multiple_matches(<<777:16>>, <<999:16>>), + c = multiple_matches(<<777:16>>, <<57:8>>), + d = multiple_matches(<<17:8>>, <<1111:16>>), + Bin = <<-1:64>>, case bad_float_unpack_match(Bin) of -1 -> ok; @@ -357,6 +362,11 @@ nnn(<<Char, Tail/binary>>) -> {[Char],Tail}. %% Buggy Tail! ooo(<<" - ", Tail/binary>>) -> Tail; ooo(<<Char, Tail/binary>>) -> {[Char],Tail}. +multiple_matches(<<Y:16>>, <<Y:16>>) -> a; +multiple_matches(<<_:16>>, <<_:16>>) -> b; +multiple_matches(<<_:16>>, <<_:8>>) -> c; +multiple_matches(<<_:8>>, <<_:16>>) -> d. + bad_float_unpack_match(<<F:64/float>>) -> F; bad_float_unpack_match(<<I:64/integer-signed>>) -> I. diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index e98c295da6..6badc7a8b8 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -1203,12 +1203,18 @@ t_guard_bifs(Config) when is_list(Config) -> true = map_guard_empty_2(), true = map_guard_head(#{a=>1}), false = map_guard_head([]), + true = map_get_head(#{a=>1}), + false = map_get_head([]), + true = map_is_key_head(#{a=>1}), + false = map_is_key_head(#{}), true = map_guard_body(#{a=>1}), false = map_guard_body({}), true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }), false = map_guard_pattern("list"), true = map_guard_tautology(), true = map_guard_ill_map_size(), + true = map_field_check_sequence(#{a=>1}), + false = map_field_check_sequence(#{}), ok. map_guard_empty() when is_map(#{}); false -> true. @@ -1218,6 +1224,12 @@ map_guard_empty_2() when true; #{} andalso false -> true. map_guard_head(M) when is_map(M) -> true; map_guard_head(_) -> false. +map_get_head(M) when map_get(a, M) =:= 1 -> true; +map_get_head(_) -> false. + +map_is_key_head(M) when is_map_key(a, M) -> true; +map_is_key_head(M) -> false. + map_guard_body(M) -> is_map(M). map_guard_pattern(#{}) -> true; @@ -1227,6 +1239,12 @@ map_guard_tautology() when #{} =:= #{}; true -> true. map_guard_ill_map_size() when true; map_size(0) -> true. +map_field_check_sequence(M) + when is_map(M) andalso is_map_key(a, M) andalso (map_get(a, M) == 1) -> + true; +map_field_check_sequence(_) -> + false. + t_guard_sequence(Config) when is_list(Config) -> {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}), {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}), diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index dbb6bf8135..6e113ef39e 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -60,7 +60,6 @@ #include <openssl/rand.h> #include <openssl/evp.h> #include <openssl/hmac.h> -#include <openssl/engine.h> #include <openssl/err.h> /* Helper macro to construct a OPENSSL_VERSION_NUMBER. @@ -102,8 +101,10 @@ # undef FIPS_SUPPORT # endif +# if LIBRESSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(2,7,0) /* LibreSSL wants the 1.0.1 API */ # define NEED_EVP_COMPATIBILITY_FUNCTIONS +# endif #endif @@ -112,8 +113,10 @@ #endif -#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) -# define HAS_EVP_PKEY_CTX +#ifndef HAS_LIBRESSL +# if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) +# define HAS_EVP_PKEY_CTX +# endif #endif @@ -121,10 +124,6 @@ #include <openssl/modes.h> #endif -#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,8,'h') -#define HAS_ENGINE_SUPPORT -#endif - #include "crypto_callback.h" #if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(0,9,8) \ @@ -185,6 +184,19 @@ # undef HAVE_RSA_SSLV23_PADDING #endif +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,8,'h') \ + && defined(HAVE_EC) +/* If OPENSSL_NO_EC is set, there will be an error in ec.h included from engine.h + So if EC is disabled, you can't use Engine either.... +*/ +# define HAS_ENGINE_SUPPORT +#endif + + +#if defined(HAS_ENGINE_SUPPORT) +# include <openssl/engine.h> +#endif + #if defined(HAVE_CMAC) #include <openssl/cmac.h> #endif @@ -500,7 +512,6 @@ static ERL_NIF_TERM aes_gcm_decrypt_NO_EVP(ErlNifEnv* env, int argc, const ERL_N static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, char **cmds, int i); static ERL_NIF_TERM engine_by_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM engine_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM engine_finish_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -528,10 +539,12 @@ static int term2point(ErlNifEnv* env, ERL_NIF_TERM term, static ERL_NIF_TERM bin_from_bn(ErlNifEnv* env, const BIGNUM *bn); #ifdef HAS_ENGINE_SUPPORT +static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, char **cmds, int i); static int zero_terminate(ErlNifBinary bin, char **buf); #endif static int library_refc = 0; /* number of users of this dynamic library */ +static int library_initialized = 0; static ErlNifFunc nif_funcs[] = { {"info_lib", 0, info_lib}, @@ -993,14 +1006,14 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) PRINTF_ERR0("CRYPTO: Could not open resource type 'ENGINE_CTX'"); return __LINE__; } +#endif - if (library_refc > 0) { + if (library_initialized) { /* Repeated loading of this library (module upgrade). * Atoms and callbacks are already set, we are done. */ return 0; } -#endif atom_true = enif_make_atom(env,"true"); atom_false = enif_make_atom(env,"false"); @@ -1107,10 +1120,6 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_password = enif_make_atom(env,"password"); #endif - init_digest_types(env); - init_cipher_types(env); - init_algorithms_types(env); - #ifdef HAVE_DYNAMIC_CRYPTO_LIB { void* handle; @@ -1156,6 +1165,11 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) } #endif /* OPENSSL_THREADS */ + init_digest_types(env); + init_cipher_types(env); + init_algorithms_types(env); + + library_initialized = 1; return 0; } @@ -5407,9 +5421,9 @@ static ERL_NIF_TERM engine_get_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE #endif } +#ifdef HAS_ENGINE_SUPPORT static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, char **cmds, int i) { -#ifdef HAS_ENGINE_SUPPORT ERL_NIF_TERM head, tail; const ERL_NIF_TERM *tmp_tuple; ErlNifBinary tmpbin; @@ -5454,10 +5468,8 @@ static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, cha cmds[i] = NULL; return 0; } -#else - return atom_notsup; -#endif } +#endif static ERL_NIF_TERM engine_get_all_methods_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* () */ diff --git a/lib/crypto/c_src/otp_test_engine.c b/lib/crypto/c_src/otp_test_engine.c index 5c6122c06a..d0e23a2a3e 100644 --- a/lib/crypto/c_src/otp_test_engine.c +++ b/lib/crypto/c_src/otp_test_engine.c @@ -24,10 +24,8 @@ #include <stdio.h> #include <string.h> -#include <openssl/engine.h> #include <openssl/md5.h> #include <openssl/rsa.h> -#include <openssl/pem.h> #define PACKED_OPENSSL_VERSION(MAJ, MIN, FIX, P) \ ((((((((MAJ << 8) | MIN) << 8 ) | FIX) << 8) | (P-'a'+1)) << 4) | 0xf) @@ -40,6 +38,21 @@ #define OLD #endif +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,8,'o') \ + && !defined(OPENSSL_NO_EC) \ + && !defined(OPENSSL_NO_ECDH) \ + && !defined(OPENSSL_NO_ECDSA) +# define HAVE_EC +#endif + +#if defined(HAVE_EC) +/* If OPENSSL_NO_EC is set, there will be an error in ec.h included from engine.h + So if EC is disabled, you can't use Engine either.... +*/ +#include <openssl/engine.h> +#include <openssl/pem.h> + + static const char *test_engine_id = "MD5"; static const char *test_engine_name = "MD5 test engine"; @@ -262,3 +275,5 @@ int pem_passwd_cb_fun(char *buf, int size, int rwflag, void *password) return 0; } } + +#endif diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml index 1f788a4e35..66619c9e11 100644 --- a/lib/crypto/doc/src/notes.xml +++ b/lib/crypto/doc/src/notes.xml @@ -31,6 +31,28 @@ </header> <p>This document describes the changes made to the Crypto application.</p> +<section><title>Crypto 4.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + If OPENSSL_NO_EC was set, the compilation of the crypto + nifs failed.</p> + <p> + Own Id: OTP-15073</p> + </item> + <item> + <p> + C-compile errors for LibreSSL 2.7.0 - 2.7.2 fixed</p> + <p> + Own Id: OTP-15074 Aux Id: ERL-618 </p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 4.2.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index 3432f00836..778aff9d13 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 4.2.1 +CRYPTO_VSN = 4.2.2 diff --git a/lib/debugger/src/dbg_icmd.erl b/lib/debugger/src/dbg_icmd.erl index 4cd3dce670..55cbada53b 100644 --- a/lib/debugger/src/dbg_icmd.erl +++ b/lib/debugger/src/dbg_icmd.erl @@ -467,7 +467,7 @@ mark_break(Cm, LineNo, Le) -> parse_cmd(Cmd, LineNo) -> {ok,Tokens,_} = erl_scan:string(Cmd, LineNo, [text]), - {ok,Forms,Bs} = lib:extended_parse_exprs(Tokens), + {ok,Forms,Bs} = erl_eval:extended_parse_exprs(Tokens), {Forms, Bs}. %%==================================================================== diff --git a/lib/debugger/src/dbg_wx_win.erl b/lib/debugger/src/dbg_wx_win.erl index f1298154ab..fea94156c1 100644 --- a/lib/debugger/src/dbg_wx_win.erl +++ b/lib/debugger/src/dbg_wx_win.erl @@ -275,7 +275,7 @@ entry(Parent, Title, Prompt, {Type, Value}) -> verify(Type, Str) -> case erl_scan:string(Str, 1, [text]) of {ok, Tokens, _EndLine} when Type==term -> - case lib:extended_parse_term(Tokens++[{dot, erl_anno:new(1)}]) of + case erl_eval:extended_parse_term(Tokens++[{dot, erl_anno:new(1)}]) of {ok, Value} -> {edit, Value}; _Error -> ignore diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index c5f93a3392..45b4abb253 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -102,6 +102,8 @@ | 'undefined', % race fun_homes :: dict:dict(label(), mfa()) | 'undefined', % race + reachable_funs :: sets:set(label()) + | 'undefined', % race plt :: dialyzer_plt:plt() | 'undefined', % race opaques :: [type()] @@ -269,9 +271,11 @@ traverse(Tree, Map, State) -> case state__warning_mode(State) of true -> {State, Map, Type}; false -> - State2 = state__add_work(get_label(Tree), State), + FunLbl = get_label(Tree), + State2 = state__add_work(FunLbl, State), State3 = state__update_fun_env(Tree, Map, State2), - {State3, Map, Type} + State4 = state__add_reachable(FunLbl, State3), + {State4, Map, Type} end; 'let' -> handle_let(Tree, Map, State); @@ -3039,25 +3043,35 @@ state__new(Callgraph, Codeserver, Tree, Plt, Module, Records) -> {TreeMap, FunHomes} = build_tree_map(Tree, Callgraph), Funs = dict:fetch_keys(TreeMap), FunTab = init_fun_tab(Funs, dict:new(), TreeMap, Callgraph, Plt), - ExportedFuns = - [Fun || Fun <- Funs--[top], dialyzer_callgraph:is_escaping(Fun, Callgraph)], - Work = init_work(ExportedFuns), + ExportedFunctions = + [Fun || + Fun <- Funs--[top], + dialyzer_callgraph:is_escaping(Fun, Callgraph), + dialyzer_callgraph:lookup_name(Fun, Callgraph) =/= error + ], + Work = init_work(ExportedFunctions), Env = lists:foldl(fun(Fun, Env) -> dict:store(Fun, map__new(), Env) end, dict:new(), Funs), #state{callgraph = Callgraph, codeserver = Codeserver, envs = Env, fun_tab = FunTab, fun_homes = FunHomes, opaques = Opaques, plt = Plt, races = dialyzer_races:new(), records = Records, warning_mode = false, warnings = [], work = Work, tree_map = TreeMap, - module = Module}. + module = Module, reachable_funs = sets:new()}. state__warning_mode(#state{warning_mode = WM}) -> WM. state__set_warning_mode(#state{tree_map = TreeMap, fun_tab = FunTab, - races = Races} = State) -> + races = Races, callgraph = Callgraph, + reachable_funs = ReachableFuns} = State) -> ?debug("==========\nStarting warning pass\n==========\n", []), Funs = dict:fetch_keys(TreeMap), - State#state{work = init_work([top|Funs--[top]]), + Work = + [Fun || + Fun <- Funs--[top], + dialyzer_callgraph:lookup_name(Fun, Callgraph) =/= error orelse + sets:is_element(Fun, ReachableFuns)], + State#state{work = init_work(Work), fun_tab = FunTab, warning_mode = true, races = dialyzer_races:put_race_analysis(true, Races)}. @@ -3149,7 +3163,8 @@ state__get_race_warnings(#state{races = Races} = State) -> State1#state{races = Races1}. state__get_warnings(#state{tree_map = TreeMap, fun_tab = FunTab, - callgraph = Callgraph, plt = Plt} = State) -> + callgraph = Callgraph, plt = Plt, + reachable_funs = ReachableFuns} = State) -> FoldFun = fun({top, _}, AccState) -> AccState; ({FunLbl, Fun}, AccState) -> @@ -3184,7 +3199,12 @@ state__get_warnings(#state{tree_map = TreeMap, fun_tab = FunTab, GenRet = dialyzer_contracts:get_contract_return(C), not t_is_unit(GenRet) end, - case Warn of + %% Do not output warnings for unreachable funs. + case + Warn andalso + (dialyzer_callgraph:lookup_name(FunLbl, Callgraph) =/= error + orelse sets:is_element(FunLbl, ReachableFuns)) + of true -> case classify_returns(Fun) of no_match -> @@ -3255,6 +3275,10 @@ state__get_args_and_status(Tree, #state{fun_tab = FunTab}) -> {ok, {ArgTypes, _}} -> {ArgTypes, true} end. +state__add_reachable(FunLbl, #state{reachable_funs = ReachableFuns}=State) -> + NewReachableFuns = sets:add_element(FunLbl, ReachableFuns), + State#state{reachable_funs = NewReachableFuns}. + build_tree_map(Tree, Callgraph) -> Fun = fun(T, {Dict, Homes, FunLbls} = Acc) -> diff --git a/lib/dialyzer/test/options1_SUITE_data/results/compiler b/lib/dialyzer/test/options1_SUITE_data/results/compiler index cbb5115c91..e1dc038800 100644 --- a/lib/dialyzer/test/options1_SUITE_data/results/compiler +++ b/lib/dialyzer/test/options1_SUITE_data/results/compiler @@ -28,7 +28,7 @@ cerl_inline.erl:2750: The pattern <{[], L, D}, Vs> can never match the type <[1. cerl_inline.erl:2752: The pattern <{[], _L, D}, Vs> can never match the type <[1..255,...],[any()]> cerl_inline.erl:2754: The pattern <{F, L, D}, Vs> can never match the type <[1..255,...],[any()]> cerl_inline.erl:2756: The pattern <{F, _L, D}, Vs> can never match the type <[1..255,...],[any()]> -compile.erl:788: The pattern {'error', Es} can never match the type {'ok',<<_:64,_:_*8>>} +compile.erl:792: The pattern {'error', Es} can never match the type {'ok',<<_:64,_:_*8>>} core_lint.erl:473: The pattern <{'c_atom', _, 'all'}, 'binary', _Def, St> can never match the type <_,#c_nil{} | {'c_atom' | 'c_char' | 'c_float' | 'c_int' | 'c_string' | 'c_tuple',_,_} | #c_cons{hd::#c_nil{} | {'c_atom' | 'c_char' | 'c_float' | 'c_int' | 'c_string' | 'c_tuple',_,_} | #c_cons{hd::{_,_} | {_,_,_} | {_,_,_,_},tl::{_,_} | {_,_,_} | {_,_,_,_}},tl::#c_nil{} | {'c_atom' | 'c_char' | 'c_float' | 'c_int' | 'c_string' | 'c_tuple',_,_} | #c_cons{hd::{_,_} | {_,_,_} | {_,_,_,_},tl::{_,_} | {_,_,_} | {_,_,_,_}}},[any()],_> core_lint.erl:505: The pattern <_Req, 'unknown', St> can never match the type <non_neg_integer(),non_neg_integer(),_> sys_pre_expand.erl:625: Call to missing or unexported function erlang:hash/2 diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl index 7e5ccde2fd..6838cf6734 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl @@ -228,11 +228,15 @@ os_process_size() -> case os:type() of {unix, sunos} -> Size = os:cmd("ps -o vsz -p " ++ os:getpid() ++ " | tail -1"), - list_to_integer(lib:nonl(Size)); + list_to_integer(nonl(Size)); _ -> 0 end. +nonl([$\n]) -> []; +nonl([]) -> []; +nonl([H|T]) -> [H|nonl(T)]. + run_tc({Name,Fun}, St) -> Before0 = statistics(runtime), Val = (catch Fun(St)), diff --git a/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_esi.erl b/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_esi.erl index a48f73274b..ce144e061f 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_esi.erl +++ b/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_esi.erl @@ -285,7 +285,7 @@ eval(Info,"GET",CGIBody,Modules) -> "~n Modules: ~p",[Modules]), case auth(CGIBody,Modules) of true -> - case lib:eval_str(string:concat(CGIBody,". ")) of + case eval_str(string:concat(CGIBody,". ")) of {error,Reason} -> ?vlog("eval -> error:" "~n Reason: ~p",[Reason]), @@ -318,6 +318,48 @@ auth(CGIBody,Modules) -> false end. +%% eval_str(InStr) -> {ok, OutStr} | {error, ErrStr'} +%% InStr must represent a body +%% Note: If InStr is a binary it has to be a Latin-1 string. +%% If you have a UTF-8 encoded binary you have to call +%% unicode:characters_to_list/1 before the call to eval_str(). + +-define(result(F,D), lists:flatten(io_lib:format(F, D))). + +-spec eval_str(string() | unicode:latin1_binary()) -> + {'ok', string()} | {'error', string()}. + +eval_str(Str) when is_list(Str) -> + case erl_scan:tokens([], Str, 0) of + {more, _} -> + {error, "Incomplete form (missing .<cr>)??"}; + {done, {ok, Toks, _}, Rest} -> + case all_white(Rest) of + true -> + case erl_parse:parse_exprs(Toks) of + {ok, Exprs} -> + case catch erl_eval:exprs(Exprs, erl_eval:new_bindings()) of + {value, Val, _} -> + {ok, Val}; + Other -> + {error, ?result("*** eval: ~p", [Other])} + end; + {error, {_Line, Mod, Args}} -> + Msg = ?result("*** ~ts",[Mod:format_error(Args)]), + {error, Msg} + end; + false -> + {error, ?result("Non-white space found after " + "end-of-form :~ts", [Rest])} + end + end. + +all_white([$\s|T]) -> all_white(T); +all_white([$\n|T]) -> all_white(T); +all_white([$\t|T]) -> all_white(T); +all_white([]) -> true; +all_white(_) -> false. + %%---------------------------------------------------------------------- %%Creates the environment list that will be the first arg to the %%Functions that is called through the ErlScript Schema diff --git a/lib/dialyzer/test/small_SUITE_data/results/unused_funs b/lib/dialyzer/test/small_SUITE_data/results/unused_funs new file mode 100644 index 0000000000..c468457ead --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/unused_funs @@ -0,0 +1,5 @@ + +unused_funs.erl:10: The pattern 'error' can never match the type 'other_error' +unused_funs.erl:15: Function not_used/0 will never be called +unused_funs.erl:19: Function foo/1 will never be called +unused_funs.erl:7: Function test/0 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/src/unused_funs.erl b/lib/dialyzer/test/small_SUITE_data/src/unused_funs.erl new file mode 100644 index 0000000000..c24cf3ea81 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/unused_funs.erl @@ -0,0 +1,21 @@ +%% See also ERL-593. + +-module(unused_funs). + +-export([test/0]). + +test() -> % "has no local return" + Var = outer_scope, + case other_error of + error -> % "can never match" + %% No warnings "no local return" and "_ = 1 can never match 0" (!) + foo(fun() -> {Var, 1 = 0} end) + end. + +not_used() -> % "will never be called" + %% No warnings "no local return" and "1 can never match 0". + foo(fun() -> 1 = 0 end). + +foo(Fun) -> % "will never be called" + 1 = 0, % No pattern match warning (foo/1 is not traversed at all). + Fun(). diff --git a/lib/edoc/src/edoc_doclet.erl b/lib/edoc/src/edoc_doclet.erl index f55cffe158..6cb3095507 100644 --- a/lib/edoc/src/edoc_doclet.erl +++ b/lib/edoc/src/edoc_doclet.erl @@ -40,7 +40,7 @@ -import(edoc_report, [report/2, warning/2]). -%% @headerfile "edoc_doclet.hrl" +%% @headerfile "../include/edoc_doclet.hrl" -include("../include/edoc_doclet.hrl"). -define(EDOC_APP, edoc). diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index fe6ab0659c..48ce641ab9 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -665,6 +665,8 @@ type(erlang, is_map, 1, Xs, Opaques) -> check_guard(X, fun (Y) -> t_is_map(Y, Opaques) end, t_map(), Opaques) end, strict(erlang, is_map, 1, Xs, Fun, Opaques); +type(erlang, is_map_key, 2, Xs, Opaques) -> + type(maps, is_key, 2, Xs, Opaques); type(erlang, is_number, 1, Xs, Opaques) -> Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_number(Y, Opaques) end, @@ -2374,6 +2376,8 @@ arg_types(erlang, is_list, 1) -> [t_any()]; arg_types(erlang, is_map, 1) -> [t_any()]; +arg_types(erlang, is_map_key, 2) -> + [t_any(), t_map()]; arg_types(erlang, is_number, 1) -> [t_any()]; arg_types(erlang, is_pid, 1) -> @@ -2396,7 +2400,7 @@ arg_types(erlang, map_size, 1) -> [t_map()]; %% Guard bif, needs to be here. arg_types(erlang, map_get, 2) -> - [t_map(), t_any()]; + [t_any(), t_map()]; arg_types(erlang, make_fun, 3) -> [t_atom(), t_atom(), t_arity()]; arg_types(erlang, make_tuple, 2) -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index a91da97f93..9abb4d31d9 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -108,13 +108,14 @@ t_is_bitstr/1, t_is_bitstr/2, t_is_bitwidth/1, t_is_boolean/1, t_is_boolean/2, - %% t_is_byte/1, - %% t_is_char/1, + t_is_byte/1, + t_is_char/1, t_is_cons/1, t_is_cons/2, t_is_equal/2, t_is_fixnum/1, t_is_float/1, t_is_float/2, t_is_fun/1, t_is_fun/2, + t_is_identifier/1, t_is_instance/2, t_is_integer/1, t_is_integer/2, t_is_list/1, @@ -216,19 +217,8 @@ cache__new/0 ]). -%%-define(DO_ERL_TYPES_TEST, true). -compile({no_auto_import,[min/2,max/2,map_get/2]}). --ifdef(DO_ERL_TYPES_TEST). --export([test/0]). --else. --define(NO_UNUSED, true). --endif. - --ifndef(NO_UNUSED). --export([t_is_identifier/1]). --endif. - -export_type([erl_type/0, opaques/0, type_table/0, var_table/0, cache/0]). @@ -1190,12 +1180,10 @@ is_fun(_) -> false. t_identifier() -> ?identifier(?any). --ifdef(DO_ERL_TYPES_TEST). --spec t_is_identifier(erl_type()) -> erl_type(). +-spec t_is_identifier(erl_type()) -> boolean(). t_is_identifier(?identifier(_)) -> true; t_is_identifier(_) -> false. --endif. %%------------------------------------ @@ -1366,7 +1354,6 @@ is_integer1(_) -> false. t_byte() -> ?byte. --ifdef(DO_ERL_TYPES_TEST). -spec t_is_byte(erl_type()) -> boolean(). t_is_byte(?int_range(neg_inf, _)) -> false; @@ -1376,7 +1363,6 @@ t_is_byte(?int_range(From, To)) t_is_byte(?int_set(Set)) -> (set_min(Set) >= 0) andalso (set_max(Set) =< ?MAX_BYTE); t_is_byte(_) -> false. --endif. %%------------------------------------ @@ -5693,173 +5679,3 @@ family(L) -> var_table__new() -> maps:new(). - -%%============================================================================= -%% Consistency-testing function(s) below -%%============================================================================= - --ifdef(DO_ERL_TYPES_TEST). - -test() -> - Atom1 = t_atom(), - Atom2 = t_atom(foo), - Atom3 = t_atom(bar), - true = t_is_atom(Atom2), - - True = t_atom(true), - False = t_atom(false), - Bool = t_boolean(), - true = t_is_boolean(True), - true = t_is_boolean(Bool), - false = t_is_boolean(Atom1), - - Binary = t_binary(), - true = t_is_binary(Binary), - - Bitstr = t_bitstr(), - true = t_is_bitstr(Bitstr), - - Bitstr1 = t_bitstr(7, 3), - true = t_is_bitstr(Bitstr1), - false = t_is_binary(Bitstr1), - - Bitstr2 = t_bitstr(16, 8), - true = t_is_bitstr(Bitstr2), - true = t_is_binary(Bitstr2), - - ?bitstr(8, 16) = t_subtract(t_bitstr(4, 12), t_bitstr(8, 12)), - ?bitstr(8, 16) = t_subtract(t_bitstr(4, 12), t_bitstr(8, 12)), - - Int1 = t_integer(), - Int2 = t_integer(1), - Int3 = t_integer(16#ffffffff), - true = t_is_integer(Int2), - true = t_is_byte(Int2), - false = t_is_byte(Int3), - false = t_is_byte(t_from_range(-1, 1)), - true = t_is_byte(t_from_range(1, ?MAX_BYTE)), - - Tuple1 = t_tuple(), - Tuple2 = t_tuple(3), - Tuple3 = t_tuple([Atom1, Int1]), - Tuple4 = t_tuple([Tuple1, Tuple2]), - Tuple5 = t_tuple([Tuple3, Tuple4]), - Tuple6 = t_limit(Tuple5, 2), - Tuple7 = t_limit(Tuple5, 3), - true = t_is_tuple(Tuple1), - - Port = t_port(), - Pid = t_pid(), - Ref = t_reference(), - Identifier = t_identifier(), - false = t_is_reference(Port), - true = t_is_identifier(Port), - - Function1 = t_fun(), - Function2 = t_fun(Pid), - Function3 = t_fun([], Pid), - Function4 = t_fun([Port, Pid], Pid), - Function5 = t_fun([Pid, Atom1], Int2), - true = t_is_fun(Function3), - - List1 = t_list(), - List2 = t_list(t_boolean()), - List3 = t_cons(t_boolean(), List2), - List4 = t_cons(t_boolean(), t_atom()), - List5 = t_cons(t_boolean(), t_nil()), - List6 = t_cons_tl(List5), - List7 = t_sup(List4, List5), - List8 = t_inf(List7, t_list()), - List9 = t_cons(), - List10 = t_cons_tl(List9), - true = t_is_boolean(t_cons_hd(List5)), - true = t_is_list(List5), - false = t_is_list(List4), - - Product1 = t_product([Atom1, Atom2]), - Product2 = t_product([Atom3, Atom1]), - Product3 = t_product([Atom3, Atom2]), - - Union1 = t_sup(Atom2, Atom3), - Union2 = t_sup(Tuple2, Tuple3), - Union3 = t_sup(Int2, Atom3), - Union4 = t_sup(Port, Pid), - Union5 = t_sup(Union4, Int1), - Union6 = t_sup(Function1, Function2), - Union7 = t_sup(Function4, Function5), - Union8 = t_sup(True, False), - true = t_is_boolean(Union8), - Union9 = t_sup(Int2, t_integer(2)), - true = t_is_byte(Union9), - Union10 = t_sup(t_tuple([t_atom(true), ?any]), - t_tuple([t_atom(false), ?any])), - - ?any = t_sup(Product3, Function5), - - Atom3 = t_inf(Union3, Atom1), - Union2 = t_inf(Union2, Tuple1), - Int2 = t_inf(Int1, Union3), - Union4 = t_inf(Union4, Identifier), - Port = t_inf(Union5, Port), - Function4 = t_inf(Union7, Function4), - ?none = t_inf(Product2, Atom1), - Product3 = t_inf(Product1, Product2), - Function5 = t_inf(Union7, Function5), - true = t_is_byte(t_inf(Union9, t_number())), - true = t_is_char(t_inf(Union9, t_number())), - - io:format("3? ~p ~n", [?int_set([3])]), - - RecDict = dict:store({foo, 2}, [bar, baz], dict:new()), - Record1 = t_from_term({foo, [1,2], {1,2,3}}), - - Types = [ - Atom1, - Atom2, - Atom3, - Binary, - Int1, - Int2, - Tuple1, - Tuple2, - Tuple3, - Tuple4, - Tuple5, - Tuple6, - Tuple7, - Ref, - Port, - Pid, - Identifier, - List1, - List2, - List3, - List4, - List5, - List6, - List7, - List8, - List9, - List10, - Function1, - Function2, - Function3, - Function4, - Function5, - Product1, - Product2, - Record1, - Union1, - Union2, - Union3, - Union4, - Union5, - Union6, - Union7, - Union8, - Union10, - t_inf(Union10, t_tuple([t_atom(true), t_integer()])) - ], - io:format("~p\n", [[t_to_string(X, RecDict) || X <- Types]]). - --endif. diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 97814fe217..5e6a60326d 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -852,8 +852,8 @@ finalize_fun_sequential({MFA, Icode}, Opts, Servers) -> print_crash_message(What, Error, StackTrace) -> StackFun = fun(_,_,_) -> false end, FormatFun = fun (Term, _) -> io_lib:format("~p", [Term]) end, - StackTrace = lib:format_stacktrace(1, StackTrace, - StackFun, FormatFun), + StackTrace = erl_error:format_stacktrace(1, StackTrace, + StackFun, FormatFun), WhatS = case What of {M,F,A} -> io_lib:format("~w:~w/~w", [M,F,A]); Mod -> io_lib:format("~w", [Mod]) diff --git a/lib/hipe/opt/hipe_schedule.erl b/lib/hipe/opt/hipe_schedule.erl deleted file mode 100644 index 0f25940e3d..0000000000 --- a/lib/hipe/opt/hipe_schedule.erl +++ /dev/null @@ -1,1483 +0,0 @@ -%% 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. -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% INSTRUCTION SCHEDULER -%% -%% This is a basic ILP cycle scheduler: -%% * set cycle = 0 -%% * while ready[cycle] nonempty do -%% - take x with greatest priority from ready[cycle] -%% - try to schedule x; -%% * if scheduling x was possible, -%% - reserve resources -%% - add x to schedule and delete x from dag -%% - update earliest-time for all successor nodes -%% as max[earliest[y],cycle+latency[x]] -%% - if some node y now has no predecessors, -%% add y to ready[earliest[y]] -%% * if it was impossible, put x in ready[cycle+1] -%% (= try again) -%% -%% We use the following data structures: -%% 1. all nodes are numbered and indices used as array keys -%% 2. priority per node can be computed statically or dynamically -%% * statically: before scheduling, each node gets a priority value -%% * dynamically: at each cycle, compute priorities for all ready nodes -%% 3. earliest: earliest cycle of issue, starts at 0 -%% and is updated as predecessors issue -%% 4. predecessors: number of predecessors (0 = ready to issue) -%% 5. successors: list of {Latency,NodeID} -%% 6. ready: an array indexed by cycle-time (integer), where -%% ready nodes are kept. -%% 7. resources: a resource representation (ADT) that answers -%% certain queries, e.g., "can x be scheduled this cycle" -%% and "reserve resources for x". -%% 8. schedule: list of scheduled instructions {Instr,Cycle} -%% in the order of issue -%% 9. instructions: maps IDs back to instructions -%% -%% Inputs: -%% - a list of {ID,Node} pairs (where ID is a unique key) -%% - a dependence list {ID0,Latency,ID1}, which is used to -%% build the DAG. -%% -%% Note that there is some leeway in how things are represented -%% from here. -%% -%% MODIFICATIONS: -%% - Some basic blocks are not worth scheduling (e.g., GC save/restore code) -%% yet are pretty voluminous. How do we skip them? -%% - Scheduling should be done at finalization time: when basic block is -%% linearized and is definitely at Sparc assembly level, THEN reorder -%% stuff. - --module(hipe_schedule). --export([cfg/1, est_cfg/1, delete_node/5]). - --include("../sparc/hipe_sparc.hrl"). - -%%-define(debug1,true). - --define(debug2(Str,Args),ok). -%%-define(debug2(Str,Args),io:format(Str,Args)). - --define(debug3(Str,Args),ok). -%%-define(debug3(Str,Args),io:format(Str,Args)). - --define(debug4(Str,Args),ok). -%%-define(debug4(Str,Args),io:format(Str,Args)). - --define(debug5(Str,Args),ok). -%%-define(debug5(Str,Args),io:format(Str,Args)). - --define(debug(Str,Args),ok). -%%-define(debug(Str,Args),io:format(Str,Args)). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cfg -%% Argument : CFG - the control flow graph -%% Returns : CFG - A new cfg with scheduled blocks -%% Description : Takes each basic block and schedules them one by one. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cfg(CFG) -> - ?debug3("CFG: ~n~p", [CFG]), - update_all( [ {L, - hipe_bb:mk_bb( - block(L,hipe_bb:code(hipe_sparc_cfg:bb(CFG,L))) )} - || L <- hipe_sparc_cfg:labels(CFG) ], CFG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : update_all -%% Argument : Blocks - [{Label, Block}] , a list with labels and new code -%% used for updating the old CFG. -%% CFG - The old controlflow graph -%% Returns : An updated controlflow graph. -%% Description : Just swappes the basic blocks in the CFG to the scheduled one. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -update_all([],CFG) -> CFG; -update_all([{L,NewB}|Ls],CFG) -> - update_all(Ls,hipe_sparc_cfg:bb_add(CFG,L,NewB)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -est_cfg(CFG) -> - update_all([ {L, hipe_bb:mk_bb(est_block(hipe_bb:code(hipe_sparc_cfg:bb(CFG,L))))} - || L <- hipe_sparc_cfg:labels(CFG) ], CFG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Provides an estimation of how quickly a block will execute. -%% This is done by chaining all instructions in sequential order -%% by 0-cycle dependences (which means they will never be reordered), -%% then scheduling the mess. - -est_block([]) -> []; -est_block([I]) -> [I]; -est_block(Blk) -> - {IxBlk,DAG} = est_deps(Blk), - Sch = bb(IxBlk,DAG), - separate_block(Sch,IxBlk). - -est_deps(Blk) -> - IxBlk = indexed_bb(Blk), - DAG = deps(IxBlk), - {IxBlk, chain_instrs(IxBlk,DAG)}. - -chain_instrs([{N,_}|Xs],DAG) -> - chain_i(N,Xs,DAG). - -chain_i(_,[],DAG) -> DAG; -chain_i(N,[{M,_}|Xs],DAG) -> - NewDAG = dep_arc(N,zero_latency(),M,DAG), - chain_i(M,Xs,NewDAG). - -zero_latency() -> 0. - -lookup_instr([{N,I}|_], N) -> I; -lookup_instr([_|Xs], N) -> lookup_instr(Xs, N). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : block -%% Argument : Instrs - [Instr], list of all the instructions in a basic -%% block. -%% Returns : A new scheduled block -%% Description : Schedule a basic block -%% -%% Note: does not consider delay slots! -%% (another argument for using only annulled delay slots?) -%% * how do we add delay slots? somewhat tricky to -%% reconcile with the sort of scheduling we consider. -%% (as-early-as-possible) -%% => rewrite scheduler into as-late-as-possible? -%% (=> just reverse the dependence arcs??) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% Don't fire up the scheduler if there's no work to do. -block(_, []) -> - []; -block(_L, [I]) -> - case hipe_sparc:is_any_branch(I) of - true -> [hipe_sparc:nop_create(), I]; - false -> [I] - end; -block(_L, Blk) -> - IxBlk = indexed_bb(Blk), - case IxBlk of - [{_N, I}] -> % comments and nops may have been removed. - case hipe_sparc:is_any_branch(I) of - true -> [hipe_sparc:nop_create(), I]; - false -> [I] - end; - _ -> - Sch = bb(IxBlk, {DAG, _Preds} = deps(IxBlk)), - {NewSch, NewIxBlk} = fill_delays(Sch, IxBlk, DAG), - X = finalize_block(NewSch, NewIxBlk), - debug1_stuff(Blk, DAG, IxBlk, Sch, X), - X - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : fill_delays -%% Argument : Sch - List of {{cycle, C}, {node, N}} : C = current cycle -%% N = node index -%% IxBlk - Indexed block [{N, Instr}] -%% DAG - Dependence graph -%% Returns : {NewSch, NewIxBlk} - vector with new schedule and vector -%% with {N, Instr} -%% Description : Goes through the schedule from back to front looking for -%% branches/jumps. If one is found fill_del tries to find -%% an instr to fill the delayslot. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -fill_delays(Sch, IxBlk, DAG) -> - NewIxBlk = hipe_vectors:list_to_vector(IxBlk), - %% NewSch = hipe_vectors:list_to_vector(Sch), - NewSch = fill_del(length(Sch), hipe_vectors:list_to_vector(Sch), - NewIxBlk, DAG), - {NewSch, NewIxBlk}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : fill_del -%% Argument : N - current index in the schedule -%% Sch - schedule -%% IxBlk - indexed block -%% DAG - dependence graph -%% Returns : Sch - New schedule with possibly a delay instr in the last -%% position. -%% Description : If a call/jump is found fill_branch_delay/fill_call_delay -%% is called to find a delay-filler. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -fill_del(N, Sch, _IxBlk, _DAG) when N < 1 -> Sch; -fill_del(N, Sch, IxBlk, DAG) -> - Index = get_index(Sch, N), - ?debug2("Index for ~p: ~p~nInstr: ~p~n", - [N, Index, get_instr(IxBlk, Index)]), - NewSch = - case get_instr(IxBlk, Index) of - #call_link{} -> - fill_branch_delay(N - 1, N, Sch, IxBlk, DAG); - #jmp_link{} -> - fill_call_delay(N - 1, N, Sch, IxBlk, DAG); - #jmp{} -> - fill_call_delay(N - 1, N, Sch, IxBlk, DAG); - #b{} -> - fill_branch_delay(N - 1, N, Sch, IxBlk, DAG); - #br{} -> - fill_branch_delay(N - 1, N, Sch, IxBlk, DAG); - #goto{} -> - fill_branch_delay(N - 1, N, Sch, IxBlk, DAG); - _Other -> - Sch - end, - NewSch. - %% fill_del(N - 1, NewSch, IxBlk, DAG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : fill_call_delay -%% Argument : Cand - index in schedule of delay-candidate -%% Call - index in schedule of call -%% Sch - schedule vector: < {{cycle,Ci},{node,Nj}}, ... > -%% IxBlk - block vector: < {N, Instr1}, {N+1, Instr2} ... > -%% DAG - dependence graph -%% Returns : Sch - new updated schedule. -%% Description : Searches backwards through the schedule trying to find an -%% instr without conflicts with the Call-instr. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -fill_call_delay(Cand, _Call, Sch, _IxBlk, _DAG) when Cand < 1 -> Sch; -fill_call_delay(Cand, Call, Sch, IxBlk, DAG) -> - CandIndex = get_index(Sch, Cand), - CallIndex = get_index(Sch, Call), - CandI = get_instr(IxBlk, CandIndex), - case move_or_alu(CandI) of - true -> - case single_depend(CandIndex, CallIndex, DAG) of - false -> % Other instrs depends on Cand ... - fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG); - - true -> - CallI = get_instr(IxBlk, CallIndex), - - CandDefs = ordsets:from_list(hipe_sparc:defines(CandI)), - %% CandUses = ordsets:from_list(hipe_sparc:uses(CandI)), - %% CallDefs = ordsets:from_list(hipe_sparc:defines(CallI)), - CallUses = ordsets:from_list(hipe_sparc:uses(CallI)), - - Args = case CallI of - #jmp_link{} -> - ordsets:from_list( - hipe_sparc:jmp_link_args(CallI)); - #jmp{} -> - ordsets:from_list(hipe_sparc:jmp_args(CallI)); - #call_link{} -> - ordsets:from_list( - hipe_sparc:call_link_args(CallI)) - end, - CallUses2 = ordsets:subtract(CallUses, Args), - Conflict = ordsets:intersection(CandDefs, CallUses2), - %% io:format("single_depend -> true:~n ~p~n, ~p~n,~p~n",[CandI,CallI,DAG]), - %% io:format("Cand = ~p~nCall = ~p~n",[CandI,CallI]), - %% io:format("CandDefs = ~p~nCallDefs = ~p~n",[CandDefs,CallDefs]), - %% io:format("CandUses = ~p~nCallUses = ~p~n",[CandUses,CallUses]), - %% io:format("Args = ~p~nCallUses2 = ~p~n",[Args,CallUses2]), - %% io:format("Conflict = ~p~n",[Conflict]), - - case Conflict of - [] -> % No conflicts ==> Cand can fill delayslot after Call - update_schedule(Cand, Call, Sch); - _ -> % Conflict: try with preceeding instrs - fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG) - end - end; - false -> - fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : fill_branch_delay -%% Argument : Cand - index in schedule of delay-candidate -%% Branch - index in schedule of branch -%% Sch - schedule -%% IxBlk - indexed block -%% DAG - dependence graph -%% Returns : Sch - new updated schedule. -%% Description : Searches backwards through the schedule trying to find an -%% instr without conflicts with the Branch-instr. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -fill_branch_delay(Cand, _Br, Sch, _IxBlk, _DAG) when Cand < 1 -> Sch; -fill_branch_delay(Cand, Br, Sch, IxBlk, DAG) -> - CandIndex = get_index(Sch, Cand), - BrIndex = get_index(Sch, Br), - CandI = get_instr(IxBlk, CandIndex), - case move_or_alu(CandI) of - true -> - case single_depend(CandIndex, BrIndex, DAG) of - false -> % Other instrs depends on Cand ... - fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG); - - true -> - BrI = get_instr(IxBlk, BrIndex), - CandDefs = ordsets:from_list(hipe_sparc:defines(CandI)), - %% CandUses = ordsets:from_list(hipe_sparc:uses(CandI)), - %% BrDefs = ordsets:from_list(hipe_sparc:defines(BrI)), - BrUses = ordsets:from_list(hipe_sparc:uses(BrI)), - - Conflict = ordsets:intersection(CandDefs, BrUses), - %% io:format("single_depend -> true: ~p~n, ~p~n,~p~n", [CandI, BrI, DAG]), - %% io:format("Cand = ~p~nBr = ~p~n",[CandI,BrI]), - %% io:format("CandDefs = ~p~nBrDefs = ~p~n",[CandDefs,BrDefs]), - %% io:format("CandUses = ~p~nBrUses = ~p~n",[CandUses,BrUses]), - %% io:format("Conflict = ~p~n",[Conflict]); - - case Conflict of - [] -> % No conflicts ==> - % Cand can fill delayslot after Branch - update_schedule(Cand, Br, Sch); - _ -> % Conflict: try with preceeding instrs - fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG) - end - end; - false -> - fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : update_schedule -%% Argument : From - the position from where to switch indexes in Sch -%% To - the position to where to switch indexes in Sch -%% Sch - schedule -%% Returns : Sch - an updated schedule -%% Description : If From is the delay-filler and To is the Call/jump, the -%% schedule is updated so From gets index To, To gets index -%% To - 1, and the nodes between From and To gets old_index - 1. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -update_schedule(To, To, Sch) -> - {{cycle, C}, {node, _N} = Node} = hipe_vectors:get(Sch, To-1), - hipe_vectors:set(Sch, To-1, {{cycle, C+1}, Node}); -update_schedule(From, To, Sch) -> - Temp = hipe_vectors:get(Sch, From-1), - Sch1 = hipe_vectors:set(Sch, From-1, hipe_vectors:get(Sch, From)), - update_schedule(From + 1, To, hipe_vectors:set(Sch1, From, Temp)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : single_depend -%% Argument : N - Index of the delayslot candidate -%% M - Index of the node that N possibly has a single -%% depend to. -%% DAG - The dependence graph -%% Returns : true if no other nodes than N os depending on N -%% Description : Checks that no other nodes than M depends on N and that the -%% latency between them is zero or 1. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -single_depend(N, M, DAG) -> - Deps = hipe_vectors:get(DAG, N-1), - single_depend(M, Deps). - -single_depend(_N, []) -> true; -single_depend(N, [{0, N}]) -> true; -single_depend(N, [{1, N}]) -> true; -single_depend(_N, [{_Lat, _}|_]) -> false. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : get_index -%% Argument : Sch - schedule -%% N - index in schedule -%% Returns : Index - index of the node -%% Description : Returns the index of the node on position N in the schedule. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_index(Sch, N) -> - {{cycle, _C}, {node, Index}} = hipe_vectors:get(Sch,N-1), - Index. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : get_instr -%% Argument : IxBlk - indexed block -%% N - index in block -%% Returns : Instr -%% Description : Returns the instr on position N in the indexed block. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_instr(IxBlk, N) -> - {_, Instr} = hipe_vectors:get(IxBlk, N-1), - Instr. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : get_instr -%% Argument : Sch - schedule -%% IxBlk - indexed block -%% N - index in schedule -%% Returns : Instr -%% Description : Returns the instr on position N in the schedule. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_instr(Sch, IxBlk, N) -> - {{cycle, _C}, {node, Index}} = hipe_vectors:get(Sch, N-1), - {_, Instr} = hipe_vectors:get(IxBlk, Index-1), - Instr. - -separate_block(Sch,IxBlk) -> - sep_comments([{C,lookup_instr(IxBlk,N)} || {{cycle,C},{node,N}} <- Sch]). - -sep_comments([]) -> []; -sep_comments([{C,I}|Xs]) -> - [hipe_sparc:comment_create({cycle,C}), I | sep_comments(Xs,C)]. - -sep_comments([], _) -> []; -sep_comments([{C1,I}|Xs], C0) -> - if - C1 > C0 -> - [hipe_sparc:comment_create({cycle,C1}),I|sep_comments(Xs,C1)]; - true -> - [I|sep_comments(Xs, C0)] - end. - -finalize_block(Sch, IxBlk) -> - ?debug5("Sch: ~p~nIxBlk: ~p~n",[Sch,IxBlk]), - finalize_block(1, hipe_vectors:size(Sch), 1, Sch, IxBlk, []). - -finalize_block(N, End, _C, Sch, IxBlk, _Instrs) when N =:= End - 1 -> - NextLast = get_instr(Sch, IxBlk, N), - Last = get_instr(Sch, IxBlk, End), - ?debug5("NextLast: ~p~nLast: ~p~n",[NextLast,Last]), - case hipe_sparc:is_any_branch(Last) of - true -> % Couldn't fill delayslot ==> add NOP - [NextLast , hipe_sparc:nop_create(), Last]; - false -> % Last is a delayslot-filler ==> change order... - [Last, NextLast] - end; -finalize_block(N, End, C0, Sch, IxBlk, Instrs) -> - {{cycle, _C1}, {node, _M}} = hipe_vectors:get(Sch, N-1), - Instr = get_instr(Sch, IxBlk, N), - ?debug5("Instr: ~p~n~n",[Instr]), - [Instr | finalize_block(N + 1, End, C0, Sch, IxBlk, Instrs)]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : bb -%% Argument : IxBlk - indexed block -%% DAG - {Dag, Preds} where Dag is dependence graph and -%% Preds is number of predecessors for each node. -%% Returns : Sch -%% Description : Initializes earliest-list, ready-list, priorities, resources -%% and so on, and calls the cycle_sched which does the scheduling -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -bb(IxBlk,DAG) -> - bb(length(IxBlk), IxBlk, DAG). - -bb(N,IxBlk,{DAG, Preds}) -> - Earliest = init_earliest(N), - BigArray = N*10, % "nothing" is this big :-) - Ready = hipe_schedule_prio:init_ready(BigArray,Preds), - I_res = init_instr_resources(N, IxBlk), - - Prio = hipe_schedule_prio:init_instr_prio(N,DAG), - Rsrc = init_resources(BigArray), - ?debug4("I_res: ~n~p~nPrio: ~n~p~nRsrc: ~n~p~n", [I_res,Prio,Rsrc]), - ?debug('cycle 1~n',[]), - Sch = empty_schedule(), - cycle_sched(1,Ready,DAG,Preds,Earliest,Rsrc,I_res,Prio,Sch,N,IxBlk). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cycle_sched -%% Argument : - C is current cycle, 1 or more. -%% - Ready is an array (Cycle -> [Node]) -%% yielding the collection of nodes ready to be -%% scheduled in a cycle. -%% - DAG is an array (Instr -> [{Latency,Instr}]) -%% represents the dependence DAG. -%% - Preds is an array (Instr -> NumPreds) -%% counts the number of predecessors -%% (0 preds = ready to be scheduled). -%% - Earl is an array (Instr -> EarliestCycle) -%% holds the earliest cycle an instruction can be scheduled. -%% - Rsrc is a 'resource ADT' that handles scheduler resource -%% management checks whether instruction can be scheduled -%% this cycle without a stall. -%% - I_res is an array (Instr -> Required_resources) -%% holds the resources required to schedule an instruction. -%% - Sch is the representation of the schedule current schedule. -%% - N is the number of nodes remaining to be scheduled -%% tells us when to stop the scheduler. -%% - IxBlk is the indexed block with instrs -%% Returns : present schedule -%% Description : Scheduler main loop. -%% Pick next ready node in priority order for cycle C until -%% none remain. -%% * check each node if it can be scheduled w/o stalling -%% * if so, schedule it -%% * otherwise, bump the node to the next cycle -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cycle_sched(C,Ready,DAG,Preds,Earl,Rsrc,I_res,Prio,Sch,N,IxBlk) -> - case hipe_schedule_prio:next_ready(C,Ready,Prio,IxBlk,DAG,Preds,Earl) of -% case hipe_schedule_prio:next_ready(C,Ready,Prio,IxBlk) of - {next,I,Ready1} -> - ?debug('try ~p~n==> ready = ~p~n',[I, Ready1]), - case resources_available(C,I,Rsrc,I_res) of - {yes,NewRsrc} -> - ?debug(' scheduled~n==> Rscrs = ~p~n',[NewRsrc]), - NewSch = add_to_schedule(I,C,Sch), - {ReadyNs,NewDAG,NewPreds,NewEarl} = - delete_node(C,I,DAG,Preds,Earl), - ?debug("NewPreds : ~p~n",[Preds]), - ?debug(' ReadyNs: ~p~n',[ReadyNs]), - NewReady = hipe_schedule_prio:add_ready_nodes(ReadyNs, - Ready1), - ?debug(' New ready: ~p~n',[NewReady]), - cycle_sched(C,NewReady,NewDAG,NewPreds,NewEarl, - NewRsrc,I_res,Prio,NewSch,N-1, IxBlk); - no -> - ?debug(' resource conflict~n',[]), - NewReady = hipe_schedule_prio:insert_node(C+1,I,Ready1), - cycle_sched(C,NewReady,DAG,Preds,Earl,Rsrc, - I_res,Prio,Sch,N,IxBlk) - end; - none -> % schedule next cycle if some node remains - if - N > 0 -> - ?debug('cycle ~p~n',[C+1]), - cycle_sched(C+1,Ready,DAG,Preds,Earl, - advance_cycle(Rsrc), - I_res,Prio,Sch,N, IxBlk); - true -> - present_schedule(Sch) - end - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : init_earliest -%% Argument : N - number of instrs -%% Returns : -%% Description : -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -init_earliest(N) -> - hipe_vectors:new(N,1). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Schedule is kept reversed until the end. - --define(present_node(I,Cycle),{{cycle,Cycle},{node,I}}). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : empty_schedule -%% Description : Returns an empty schedule. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -empty_schedule() -> []. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_to_schedule -%% Argument : I - instr -%% Cycle - cycle when I was placed -%% Sch - schedule -%% Description : Adds instr to schedule -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -add_to_schedule(I,Cycle,Sch) -> - [?present_node(I,Cycle)|Sch]. - -present_schedule(Sch) -> lists:reverse(Sch). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Interface to resource manager: -%% - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : init_resources -%% Description : Yields a 'big enough' array mapping (Cycle -> Resources); -%% this array is called Rsrc below. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -init_resources(S) -> - hipe_target_machine:init_resources(S). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : init_instr_resources -%% Argument : Nodes - a list of the instructions -%% N - is the number of nodes -%% Description : return a vector (NodeID -> Resource_requirements) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -init_instr_resources(N,Nodes) -> - hipe_target_machine:init_instr_resources(N,Nodes). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : resources_available -%% Argument : Cycle - the current cycle -%% I - the current instruction (index = NodeID) -%% Rsrc - a map (Cycle -> Resources) -%% I_res - maps (NodeID -> Resource_requirements) -%% Description : returns {yes,NewResTab} | no -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -resources_available(Cycle,I,Rsrc,I_res) -> - hipe_target_machine:resources_available(Cycle,I,Rsrc,I_res). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : advance_cycle -%% Argument : Rsrc - resources -%% Description : Returns an empty resources-state -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -advance_cycle(Rsrc) -> - hipe_target_machine:advance_cycle(Rsrc). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : delete_node -%% Argument : Cycle - current cycle -%% I - index of instr -%% DAG - dependence dag -%% Preds - array with number of predecessors for nodes -%% Earl - array with earliest-times for nodes -%% Returns : {ReadyNs,NewDAG,NewPreds,NewEarl} -%% Description : Deletes node I and updates earliest times for the rest. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -delete_node(Cycle,I,DAG,Preds,Earl) -> - Succ = hipe_vectors:get(DAG,I-1), - NewDAG = hipe_vectors:set(DAG,I-1,scheduled), % provides debug 'support' - {ReadyNs,NewPreds,NewEarl} = update_earliest(Succ,Cycle,Preds,Earl,[]), - ?debug('earliest after ~p: ~p~n',[I,[{Ix+1,V} || {Ix,V} <- hipe_vectors:list(NewEarl)]]), - {ReadyNs,NewDAG,NewPreds,NewEarl}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : update_earliest -%% Argument : Succ - successor list -%% Cycle - current cycle -%% Preds - predecessors -%% Earl - earliest times for nodes -%% Ready - array with readynodes for cycles -%% Returns : {Ready,Preds,Earl} -%% Description : Updates the earliest times for nodes and updates number of -%% predecessors for nodes -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -update_earliest([],_Cycle,Preds,Earl,Ready) -> - {Ready,Preds,Earl}; -update_earliest([{Lat,N}|Xs],Cycle,Preds,Earl,Ready) -> - Old_earl = hipe_vectors:get(Earl,N-1), - New_earl = erlang:max(Old_earl,Cycle+Lat), - NewEarl = hipe_vectors:set(Earl,N-1,New_earl), - Num_preds = hipe_vectors:get(Preds,N-1), - NewPreds = hipe_vectors:set(Preds,N-1,Num_preds-1), - if - Num_preds =:= 0 -> - ?debug('inconsistent DAG~n',[]), - exit({update_earliest,N}); - Num_preds =:= 1 -> - NewReady = [{New_earl,N}|Ready], - NewPreds2 = hipe_vectors:set(NewPreds,N-1,0), - update_earliest(Xs,Cycle,NewPreds2,NewEarl,NewReady); - is_integer(Num_preds), Num_preds > 1 -> - update_earliest(Xs,Cycle,NewPreds,NewEarl,Ready) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Collect instruction dependences. -%% -%% Three forms: -%% - data/register -%% * insert RAW, WAR, WAW dependences -%% - memory -%% * stores serialize memory references -%% * alias analysis may allow loads to bypass stores -%% - control -%% * unsafe operations are 'trapped' between branches -%% * branches are ordered -%% -%% returns { [{Index,Instr}], DepDAG } -%% DepDAG is defined below. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : deps -%% Argument : BB - Basic block -%% Returns : {IxBB,DAG} - indexed block and dependence graph. DAG consists -%% of both Dag and Preds, where Preds is number -%% of predecessors for nodes. -%% Description : Collect instruction dependences. -%% -%% Three forms: -%% - data/register -%% * insert RAW, WAR, WAW dependences -%% - memory -%% * stores serialize memory references -%% * alias analysis may allow loads to bypass stores -%% - control -%% * unsafe operations are 'trapped' between branches -%% * branches are ordered -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -deps(IxBB) -> - N = length(IxBB), - DAG = empty_dag(N), % The DAG contains both dependence-arcs and - % number of predeccessors... - {_DepTab,DAG1} = dd(IxBB, DAG), - DAG2 = md(IxBB, DAG1), - cd(IxBB, DAG2). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : empty_dag -%% Argument : N - number of nodes -%% Returns : empty DAG -%% Description : DAG consists of dependence graph and predeccessors -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -empty_dag(N) -> - {hipe_vectors:new(N, []), hipe_vectors:new(N, 0)}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : indexed_bb -%% Argument : BB - basic block -%% Returns : [{N, Instr}] -%% Description : Puts indexes to all instrs of a block, removes comments. -%% NOP's are also removed because if both sparc_schedule and -%% sparc_post_schedule options are used, the first pass will -%% add nop's before the branch if necessary, and these are -%% removed before scheduling the second pass. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -indexed_bb(BB) -> - indexed_bb(BB,1). - -indexed_bb([],_N) -> []; -indexed_bb([X|Xs],N) -> - case X of - #comment{} -> - indexed_bb(Xs,N); - #nop{} -> - indexed_bb(Xs,N); - _Other -> - [{N,X}|indexed_bb(Xs,N+1)] - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : dep_arc -%% Argument : N - Current node -%% Lat - Latency from current node to M -%% M - The dependent node -%% DAG - The dependence graph. Consists of both DAG and -%% predeccessors -%% Returns : A new DAG with the arc added and number of predeccessors for -%% M increased. -%% Description : Adds a new arc to the graph, if an older arc goes from N to M -%% it will be replaced with a new arc {max(OldLat, NewLat), M}. -%% Number of predeccessors for node M is increased. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -dep_arc(N, Lat, M, {Dag,Preds}) -> - OldDeps = hipe_vectors:get(Dag, N-1), - %% io:format("{OldDeps} = {~p}~n",[OldDeps]), - {NewDeps, Status} = add_arc(Lat, M, OldDeps), - %% io:format("{NewDeps, Status} = {~p, ~p}~n",[NewDeps, Status]), - NewDag = hipe_vectors:set(Dag, N-1, NewDeps), - NewPreds = case Status of - added -> % just increase preds if new arc was added - OldPreds = hipe_vectors:get(Preds, M-1), - hipe_vectors:set(Preds, M-1, OldPreds + 1); - non_added -> - Preds - end, - {NewDag, NewPreds}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_arc -%% Argument : Lat - The latency from current node to To. -%% To - The instr-id of the node which the dependence goes to -%% Arcs - The dependecies that are already in the dep-graph -%% Returns : A dependence graph sorted by To. -%% Description : A new arc that is added is sorted in the right place, and if -%% there is already an arc between nodes A and B, the one with -%% the greatest latency is chosen. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -add_arc(Lat,To, []) -> {[{Lat, To}], added}; -add_arc(Lat1, To, [{Lat2, To} | Arcs]) -> - {[{erlang:max(Lat1, Lat2), To} | Arcs], non_added}; -add_arc(Lat1,To1, [{Lat2, To2} | Arcs]) when To1 < To2 -> - {[{Lat1, To1}, {Lat2, To2} | Arcs], added}; -add_arc(Lat1 ,To1, [{Lat2, To2} | Arcs]) -> - {Arcs1, Status} = add_arc(Lat1, To1, Arcs), - {[{Lat2, To2} | Arcs1], Status}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% The register/data dependence DAG of a block is represented -%% as a mapping (Variable -> {NextWriter,NextReaders}) -%% where NextWriter is a pair {Ix,Type} -%% and NextReaders is a list of pairs {Ix,Type}. -%% -%% Type is used to determine latencies of operations; on the UltraSparc, -%% latencies of arcs (n -> m) are determined by both n and m. (E.g., if -%% n is an integer op and m is a store, then latency is 0; if m is an -%% integer op, it's 1.) - -dd([],DAG) -> { empty_deptab(), DAG }; -dd([{N,I}|Is],DAG0) -> - {DepTab,DAG1} = dd(Is,DAG0), - add_deps(N,I,DepTab,DAG1). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_deps -%% Argument : N - current node -%% Instr - current instr -%% DepTab - hashtable with {next-writer, next-readers} for reg -%% DAG - dependence graph -%% Returns : {DepTab, BlockInfo, DAG} - with new values -%% Description : Adds dependencies for node N to the graph. The registers that -%% node N defines and uses are used for computing the -%% dependencies to the following nodes. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -add_deps(N,Instr,DepTab,DAG) -> - {Ds,Us} = def_use(Instr), - Type = dd_type(Instr), - {DepTab1,DAG1} = add_write_deps(Ds,N,Type,DepTab,DAG), - add_read_deps(Us,N,Type,DepTab1,DAG1). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Instructions are classified into symbolic categories, -%% which are subsequently used to determine operation latencies -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -dd_type(Instr) -> - case Instr of - #b{} -> branch; - %% #br{} -> branch; - #call_link{} -> branch; - #jmp_link{} -> branch; - #jmp{} -> branch; - #goto{} -> branch; - #load{} -> load; - #store{} -> store; - #alu{} -> alu; - #move{} -> alu; - #multimove{} -> - Src = hipe_sparc:multimove_src(Instr), - Lat = round(length(Src)/2), - {mmove,Lat}; - #sethi{} -> alu; - #alu_cc{} -> alu_cc; - %% #cmov_cc{} -> cmov_cc; - %% #cmov_r{} -> alu; - #load_atom{} -> alu; - #load_address{} -> alu; - #pseudo_enter{} -> pseudo; - #pseudo_pop{} -> pseudo; - #pseudo_return{} -> pseudo; - #pseudo_spill{} -> pseudo; - #pseudo_unspill{} -> pseudo - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_write_deps -%% Argument : Defs - registers that node N defines. -%% N - current node -%% Ty - the type of current instr -%% DepTab - Dependence-table -%% DAG - The dependence graph. -%% Returns : {DepTab,DAG} - with new values -%% Description : Adds dependencies to the graph for nodes that depends on the -%% registers that N defines. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -add_write_deps([],_N,_Ty,DepTab,DAG) -> {DepTab,DAG}; -add_write_deps([D|Ds],N,Ty,DepTab,DAG) -> - {NewDepTab,NewDAG} = add_write_dep(D,N,Ty,DepTab,DAG), - add_write_deps(Ds,N,Ty,NewDepTab,NewDAG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_write_dep -%% Description : Updates the dependence table with N as next writer, and -%% updates the DAG with the dependencies from N to subsequent -%% nodes. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -add_write_dep(X,N,Ty,DepTab,DAG) -> - {NxtWriter,NxtReaders} = lookup(X,DepTab), - NewDepTab = writer(X,N,Ty,DepTab), - NewDAG = write_deps(N,Ty,NxtWriter,NxtReaders,DAG), - {NewDepTab, NewDAG}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : write_deps -%% Argument : Instr - Current instr -%% Ty - Type of current instr -%% NxtWriter - The node that is the next writer of the ragister -%% that Instr defines. -%% NxtReaders - The nodes that are subsequent readers of the -%% register that N defines. -%% DAG - The dependence graph -%% Returns : Calls raw_deps that finally returns a new DAG with the new -%% dependence arcs added. -%% Description : If a next writer exists a dependence arc for this node is -%% added, and after this raw_deps is called to compute the -%% arcs for read-after-write dependencies. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -write_deps(Instr,Ty,NxtWriter,NxtReaders,DAG) -> - DAG1 = case NxtWriter of - none -> - DAG; - {Instr,_} -> - DAG; - {Wr,WrTy} -> - dep_arc(Instr, - hipe_target_machine:waw_latency(Ty,WrTy), - Wr, DAG) - end, - raw_deps(Instr,Ty,NxtReaders,DAG1). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : raw_deps -%% Argument : Instr - current instr -%% Type - type of instr -%% Readers - subsequent readers -%% DAG - dependence graph -%% Returns : DAG - A new DAG with read-after-write dependencies added -%% Description : Updates the DAG with the dependence-arcs from Instr to the -%% subsequent readers, with the appropriate latencies. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -raw_deps(_Instr,_Type,[],DAG) -> DAG; -raw_deps(Instr,Ty,[{Rd,RdTy}|Xs],DAG) -> - raw_deps(Instr,Ty,Xs, - dep_arc(Instr,hipe_target_machine:raw_latency(Ty,RdTy), - Rd,DAG)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_read_deps -%% Argument : Uses - The registers that node N uses. -%% N - Index of the current node. -%% Ty - Type of current node. -%% DepTab - Dependence table -%% DAG - Dependence graph -%% Returns : {DepTab, DAG} - with updated values. -%% Description : Adds the read dependencies from node N to subsequent ones, -%% according to the registers that N uses. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -add_read_deps([],_N,_Ty,DepTab,DAG) -> {DepTab,DAG}; -add_read_deps([U|Us],N,Ty,DepTab,DAG) -> - {NewDepTab,NewDAG} = add_read_dep(U,N,Ty,DepTab,DAG), - add_read_deps(Us,N,Ty,NewDepTab,NewDAG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_read_dep -%% Argument : X - Used register -%% N - Index of checked instr -%% Ty - Type of checked instr -%% DepTab - Hashtable with {next-writer, next-readers} -%% DAG - Dependence graph -%% Returns : {DepTab, DAG} - with updated values -%% Description : Looks up what the next-writer/next-readers are, and adjusts -%% the table with current node as new reader. Finally -%% read-dependencies are added to the DAG. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -add_read_dep(X,N,Ty,DepTab,DAG) -> - {NxtWriter,_NxtReaders} = lookup(X,DepTab), - NewDepTab = reader(X,N,Ty,DepTab), - NewDAG = read_deps(N,Ty,NxtWriter,DAG), - {NewDepTab, NewDAG}. - -% If NxtWriter is 'none', then this var is not written subsequently -% Add WAR from Instr to NxtWriter (if it exists) -% *** UNFINISHED *** -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : read_deps -%% Argument : N - Index of current node -%% Ty - Type of current node -%% Writer - tuple {NextWriter, WrType} where NextWriter is the -%% subsequent instr that writes this register next time, -%% and WrType is the type of that instr. -%% DAG - The dependence graph -%% Returns : DAG -%% Description : Returns a new DAG if a next-writer exists, otherwise the old -%% DAG is returned. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -read_deps(_Instr,_Ty,none,DAG) -> - DAG; -read_deps(_Instr,_Ty,{_Instr,_},DAG) -> - DAG; -read_deps(Instr,Ty,{NxtWr,NxtWrTy},DAG) -> - dep_arc(Instr,hipe_target_machine:war_latency(Ty,NxtWrTy),NxtWr, - DAG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : empty_deptab -%% Description : Creates an empty dependence table (hash-table) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -empty_deptab() -> - gb_trees:empty(). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : lookup -%% Argument : X - key (register) -%% DepTab - dependence table -%% Returns : {NextWriter, NextReaders} -%% Description : Returns next writer and a list of following readers on -%% register X. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -lookup(X, DepTab) -> - case gb_trees:lookup(X, DepTab) of - none -> - {none, []}; - {value, {W, Rs} = Val} -> - Val - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : writer -%% Argument : X - key (register) -%% N - index of writer -%% Ty - type of writer -%% DepTab - dependence table to be updated -%% Returns : DepTab - new dependence table -%% Description : Sets N tobe next writer on X -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -writer(X, N, Ty, DepTab) -> - gb_trees:enter(X, {{N, Ty}, []}, DepTab). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : reader -%% Argument : X - key (register) -%% N - index of reader -%% Ty - type of reader -%% DepTab - dependence table to be updated -%% Returns : DepTab - new dependence table -%% Description : Adds N to the dependence table as a reader. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -reader(X,N,Ty,DepTab) -> - {W,Rs} = lookup(X,DepTab), - gb_trees:enter(X,{W,[{N,Ty}|Rs]},DepTab). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% The following version of md/2 separates heap- and stack operations, -%% which allows for greater reordering. -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : md -%% Argument : IxBB - indexed block -%% DAG - dependence graph -%% Returns : DAG - new dependence graph -%% Description : Adds arcs for load/store dependencies to the DAG. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -md(IxBB, DAG) -> - md(IxBB,empty_md_state(),DAG). - -md([],_,DAG) -> DAG; -md([{N,I}|Is],St,DAG) -> - case md_type(I) of - other -> - md(Is,St,DAG); - {st,T} -> - { WAW_nodes, WAR_nodes, NewSt } = st_overlap(N,T,St), - md(Is,NewSt, - md_war_deps(WAR_nodes,N,md_waw_deps(WAW_nodes,N,DAG))); - {ld,T} -> - { RAW_nodes, NewSt } = ld_overlap(N,T,St), - md(Is,NewSt, - md_raw_deps(RAW_nodes,N,DAG)) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : md_war_deps -%% Argument : WAR_nodes - write-after-read nodes depending on N -%% N - index of current instr -%% DAG - dependence graph -%% Returns : DAG - updated DAG -%% Description : Adds arcs for write-after-read dependencies for N -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -md_war_deps([],_,DAG) -> DAG; -md_war_deps([M|Ms],N,DAG) -> - md_war_deps(Ms,N,dep_arc(M,hipe_target_machine:m_war_latency(),N,DAG)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : md_waw_deps -%% Argument : WAW_nodes - write-after-write nodes depending on N -%% N - index of current instr -%% DAG - dependence graph -%% Returns : DAG - updated DAG -%% Description : Adds arcs for write-after-write dependencies for N -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -md_waw_deps([],_,DAG) -> DAG; -md_waw_deps([M|Ms],N,DAG) -> - md_waw_deps(Ms,N,dep_arc(M,hipe_target_machine:m_waw_latency(),N,DAG)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : md_raw_deps -%% Argument : RAW_nodes - read-after-write nodes depending on N -%% N - index of current instr -%% DAG - dependence graph -%% Returns : DAG - updated DAG -%% Description : Adds arcs for read-after-write dependencies for N -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -md_raw_deps([],_,DAG) -> DAG; -md_raw_deps([M|Ms],N,DAG) -> - md_raw_deps(Ms,N,dep_arc(M,hipe_target_machine:m_raw_latency(),N,DAG)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : empty_md_state -%% Description : Returns an empty memorydependence state, eg. 4 lists -%% representing {StackStores, HeapStores, StackLoads, HeapLoads} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -empty_md_state() -> {[], [], [], []}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : md_type -%% Argument : I - instr -%% Description : Maps the instr-type to a simplified type, telling if it's -%% store/load resp. heap or stack. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -md_type(I) -> - case I of - #load{} -> - Sp = hipe_sparc_registers:stack_pointer(), - Src = hipe_sparc:load_src(I), - N = hipe_sparc:reg_nr(Src), - Off = hipe_sparc:load_off(I), - if - N =:= Sp -> % operation on stack - {ld,{sp,Off}}; - true -> - {ld,{hp,Src,Off}} - end; - #store{} -> - Sp = hipe_sparc_registers:stack_pointer(), - Dst = hipe_sparc:store_dest(I), - N = hipe_sparc:reg_nr(Dst), - Off = hipe_sparc:store_off(I), - if - N =:= Sp -> - {st,{sp,Off}}; - true -> - {st,{hp,Dst,Off}} - end; - _ -> - other - end. - -%% Given a memory operation and a 'memory op state', -%% overlap(N,MemOp,State) returns { Preceding_Dependent_Ops, NewState }. -%% which are either a tuple { WAW_deps, WAR_deps } or a list RAW_deps. -%% -%% NOTES: -%% Note that Erlang's semantics ("heap stores never overwrite existing data") -%% means we can be quite free in reordering stores to the heap. -%% Ld/St to the stack are simply handled by their offsets; since we do not -%% rename the stack pointer, this is sufficient. -%% *** We assume all memory ops have uniform size = 4 *** -%% -%% NOTES: -%% The method mentioned above has now been changed because the assumption that -%% "heap stores never overwrite existing data" caused a bug when the -%% process-pointer was treated the same way as the heap. We were also told -%% that the semantics can possibly change in the future, so it would be more -%% safe to treat the heap store/loads as the stack. -%% A future improvement can be to do an alias analysis to give more freedom -%% in reordering stuff... -%% -%% Alias state: -%% { [StackOp], [HeapOp], [StackOp], [HeapOp] } -%% where StackOp = {InstrID, Offset} -%% HeapOp = {InstrID, Reg, Offset} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : st_overlap -%% Argument : N - Index of current node -%% Type - {sp,Off} or {hp,Dst,Off}, store on stack or heap -%% State - { [StackStrs], [HeapStrs], [StackLds], [HeapLds] } -%% where StackStrs/StackLds = {InstrID, Offset} -%% and HeapStrs/HeapLds = {InstrID, Reg, Offset} -%% Returns : { DepStrs, DepLds, State } - -%% where DepStrs/DepLds = [NodeId] -%% and State is the new state -%% Description : Adds dependencies for overlapping stores. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -st_overlap(N, {sp, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) -> - {DepSt, IndepSt_Sp} = st_sp_dep(St_Sp, Off), - {DepLd, IndepLd_Sp} = ld_sp_dep(Ld_Sp, Off), - {DepSt, DepLd, {[{N, Off}|IndepSt_Sp], St_Hp, IndepLd_Sp, Ld_Hp}}; -st_overlap(N, {hp, Dst, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) -> - DstOff = {Dst, Off}, - {DepSt,_IndepSt_Hp} = st_hp_dep(St_Hp, DstOff), - {DepLd, IndepLd_Hp} = ld_hp_dep(Ld_Hp, DstOff), - {DepSt, DepLd, {St_Sp, [{N, Dst, Off}|St_Hp], Ld_Sp, IndepLd_Hp}}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : ld_overlap -%% Argument : N - Index of current node -%% Type - {sp,Off} or {hp,Dst,Off}, store on stack or heap -%% State - { [StackStrs], [HeapStrs], [StackLds], [HeapLds] } -%% where StackStrs/StackLds = {InstrID, Offset} -%% and HeapStrs/HeapLds = {InstrID, Reg, Offset} -%% Returns : { DepStrs, State } -%% Description : Adds dependencies for overlapping laods -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -ld_overlap(N, {sp, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) -> - DepSt = sp_dep_only(St_Sp, Off), - {DepSt, {St_Sp, St_Hp, [{N, Off}|Ld_Sp], Ld_Hp}}; -ld_overlap(N, {hp, Src, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) -> - DepSt = hp_dep_only(St_Hp, Src, Off), - {DepSt, {St_Sp, St_Hp, Ld_Sp, [{N, Src, Off}|Ld_Hp]}}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : st_sp_dep -%% Description : Adds dependencies that are depending on a stack store -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -st_sp_dep(Stores, Off) -> - sp_dep(Stores, Off, [], []). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : ld_sp_dep -%% Description : Adds dependencies that are depending on a stack load -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -ld_sp_dep(Loads, Off) -> - sp_dep(Loads, Off, [], []). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : st_hp_dep -%% Description : Adds dependencies that are depending on a heap store -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -st_hp_dep(Stores, {_Reg, _Off} = RegOff) -> - hp_dep(Stores, RegOff, [], []). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : ld_hp_dep -%% Description : Adds dependencies that are depending on a heap load -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -ld_hp_dep(Loads, {_Reg, _Off} = RegOff) -> - hp_dep(Loads, RegOff, [], []). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : sp_dep -%% Description : Returns {Dependent, Independent} which are lists of nodes -%% that depends or not on a stack load/store -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -sp_dep([], _Off, Dep, Indep) -> {Dep, Indep}; -sp_dep([{N,Off}|Xs], Off, Dep, Indep) -> - sp_dep(Xs, Off, [N|Dep], Indep); -sp_dep([X|Xs], Off, Dep, Indep) -> - sp_dep(Xs, Off, Dep, [X|Indep]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : hp_dep -%% Description : Returns {Dependent, Independent} which are lists of nodes -%% that depends or not on a heap load/store -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -hp_dep([], {_Reg,_Off}, Dep, Indep) -> {Dep,Indep}; -hp_dep([{N,Reg,Off1}|Xs], {Reg,Off}, Dep, Indep) when Off1 =/= Off -> - hp_dep(Xs, {Reg,Off}, Dep, [{N,Reg,Off1}|Indep]); -hp_dep([{N,_,_}|Xs], {Reg,Off}, Dep, Indep) -> - hp_dep(Xs, {Reg,Off}, [N|Dep], Indep). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : sp_dep_only -%% Description : Returns a list of nodes that are depending on a stack store -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -sp_dep_only(Stores, Off) -> - [N || {N,Off0} <- Stores, Off =:= Off0]. - -%% Dependences from heap stores to heap loads. -%% *** UNFINISHED *** -%% - but works -%% This is somewhat subtle: -%% - a heap load can only bypass a heap store if we KNOW it won't -%% load the stored value -%% - unfortunately, we do not know the relationships between registers -%% at this point, so we can't say that store(p+4) is independent of -%% load(q+0). -%% (OR CAN WE? A bit closer reasoning might show that it's possible?) -%% - We can ONLY say that st(p+c) and ld(p+c') are independent when c /= c' -%% -%% (As said before, it might be possible to lighten this restriction?) - -hp_dep_only([], _Reg, _Off) -> []; -hp_dep_only([{_N,Reg,Off_1}|Xs], Reg, Off) when Off_1 =/= Off -> - hp_dep_only(Xs, Reg, Off); -hp_dep_only([{N,_,_}|Xs], Reg, Off) -> - [N|hp_dep_only(Xs, Reg, Off)]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Control dependences: -%% - add dependences so that -%% * branches are performed in order -%% * unsafe operations are 'fenced in' by surrounding branches -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cd -%% Argument : IxBB - indexed block -%% DAG - dependence graph -%% Returns : DAG - new dependence graph -%% Description : Adds conditional dependencies to the DAG -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cd(IxBB,DAG) -> - cd(IxBB, DAG, none, [], []). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cd -%% Argument : IxBB - indexed block -%% DAG - dependence graph -%% PrevBr - previous branch -%% PrevUnsafe - previous unsafe instr (mem-op) -%% PrevOthers - previous other instrs, used to "fix" preceeding -%% instrs so they don't bypass a branch. -%% Returns : DAG - new dependence graph -%% Description : Adds conditional dependencies to the graph. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cd([], DAG, _PrevBr, _PrevUnsafe, _PrevOthers) -> - DAG; -cd([{N,I}|Xs], DAG, PrevBr, PrevUnsafe, PrevOthers) -> - case cd_type(I) of - {branch,Ty} -> - DAG1 = cd_branch_to_other_deps(N, PrevOthers, DAG), - NewDAG = cd_branch_deps(PrevBr, PrevUnsafe, N, Ty, DAG1), - cd(Xs,NewDAG,{N,Ty},[],[]); - {unsafe,Ty} -> - NewDAG = cd_unsafe_deps(PrevBr,N,Ty,DAG), - cd(Xs, NewDAG, PrevBr, [{N,Ty}|PrevUnsafe], PrevOthers); - {other,_Ty} -> - cd(Xs, DAG, PrevBr, PrevUnsafe, [N|PrevOthers]) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cd_branch_to_other_deps -%% Argument : N - index of branch -%% Ms - list of indexes of "others" preceding instrs -%% DAG - dependence graph -%% Returns : DAG - new graph -%% Description : Makes preceding instrs fixed so they don't bypass a branch -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cd_branch_to_other_deps(_, [], DAG) -> - DAG; -cd_branch_to_other_deps(N, [M | Ms], DAG) -> - cd_branch_to_other_deps(N, Ms, dep_arc(M, zero_latency(), N, DAG)). - -%% Is the operation a branch, an unspeculable op or something else? - -%% Returns -%% {branch,BranchType} -%% {unsafe,OpType} -%% {other,OpType} - -%% *** UNFINISHED *** -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cd_type -%% Argument : I - instr -%% Description : Maps instrs to a simpler type. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cd_type(I) -> - case I of - #goto{} -> - {branch,uncond}; - #br{} -> - {branch,'cond'}; - #b{} -> - {branch,'cond'}; - #call_link{} -> - {branch,call}; - #jmp_link{} -> - {branch,call}; - #jmp{} -> - {branch,call}; - #load{} -> - {unsafe,load}; - #store{} -> - {unsafe,load}; - T -> - {other,T} - end. - -%% add dependences to keep order of branches + unspeculable ops: -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cd_branch_deps -%% Argument : PrevBr - preceeding branch -%% PrevUnsafe - preceeding unsafe ops, eg, mem-ops -%% N - current id. -%% Ty - type of current instr -%% DAG - dependence graph -%% Returns : DAG - new DAG -%% Description : Adds arcs between branches and calls deps_to_unsafe that adds -%% arcs between branches and unsafe ops. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cd_branch_deps(PrevBr, PrevUnsafe, N, Ty, DAG) -> - DAG1 = case PrevBr of - none -> - DAG; - {Br,BrTy} -> - dep_arc(Br, - hipe_target_machine:br_br_latency(BrTy,Ty), - N, DAG) - end, - deps_to_unsafe(PrevUnsafe, N, Ty, DAG1). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : deps_to_unsafe -%% Description : Adds dependencies between unsafe's and branches -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -deps_to_unsafe([], _, _, DAG) -> DAG; -deps_to_unsafe([{M,UTy}|Us], N, Ty, DAG) -> - deps_to_unsafe(Us,N,Ty, - dep_arc(M, hipe_target_machine:unsafe_to_br_latency(UTy,Ty), - N, DAG)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cd_unsafe_deps -%% Description : Adds dependencies between branches and unsafe's -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -cd_unsafe_deps(none, _, _, DAG) -> - DAG; -cd_unsafe_deps({Br,BrTy}, N, Ty, DAG) -> - dep_arc(Br, hipe_target_machine:br_to_unsafe_latency(BrTy, Ty), N, DAG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : def_use -%% Argument : Instr -%% Description : Returns the registers that Instr defines resp. uses as 2 lists -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -def_use(Instr) -> - {hipe_sparc:defines(Instr), hipe_sparc:uses(Instr)}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : move_or_alu -%% Description : True if the instruction is a move or an alu; false otherwise -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -move_or_alu(#move{}) -> true; -move_or_alu(#alu{}) -> true; -move_or_alu(_) -> false. - -%% Debugging stuff below %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - --ifdef(debug1). -debug1_stuff(Blk, DAG, IxBlk, Sch, X) -> - io:format("Blk: ~p~n",[Blk]), - io:format("DAG: ~n~p~n~p",[DAG,IxBlk]), - io:format("~n"), - print_instrs(IxBlk), - print_sch(Sch, IxBlk), - print_instrs2(X). - -print_instrs([]) -> - io:format("~n"); -print_instrs([{N,Instr} | Instrs]) -> - io:format("(~p): ",[N]), - hipe_sparc_pp:pp_instr(Instr), - io:format("~p~n",[element(1,Instr)]), - print_instrs(Instrs). - -print_instrs2([]) -> - io:format("~n"); -print_instrs2([Instr | Instrs]) -> - hipe_sparc_pp:pp_instr(Instr), - print_instrs2(Instrs). - -print_sch([],_) -> io:format("~n"); -print_sch([{{cycle,Cycle},{node,I}} | Rest], IxBlk) -> - io:format("{C~p, N~p} ",[Cycle,I]), - print_node(I, IxBlk), - print_sch(Rest, IxBlk). - -print_node(_, []) -> - io:format("~n"); -print_node(I, [{I, Instr} | _]) -> - hipe_sparc_pp:pp_instr(Instr); -print_node(I, [_ | IxBlk]) -> - print_node(I, IxBlk). --else. -debug1_stuff(_Blk, _DAG, _IxBlk, _Sch, _X) -> - ok. --endif. diff --git a/lib/hipe/opt/hipe_schedule_prio.erl b/lib/hipe/opt/hipe_schedule_prio.erl deleted file mode 100644 index 339bb82aab..0000000000 --- a/lib/hipe/opt/hipe_schedule_prio.erl +++ /dev/null @@ -1,53 +0,0 @@ -%% -*- erlang-indent-level: 2 -*- -%% -%% 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. -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% PRIORITY HANDLING AND PRIORITY CALCULATION -%% -%% Handling of ready nodes and priorities. -%% - at present, all nodes have the same priority and so on. -%% -%% *** UNFINISHED *** -%% - should compute a static priority estimate -%% - should dynamically modify priorities + possibly insert NOPs -%% (e.g., to separate branches, etc.) -%% - thus, ought to be passed the current schedule and/or resources as well - --module(hipe_schedule_prio). --export([init_ready/2, - init_instr_prio/2, - %% initial_ready_set/4, - next_ready/7, - add_ready_nodes/2, - insert_node/3 - ]). - -init_ready(Size,Preds) -> - hipe_ultra_prio:init_ready(Size,Preds). - -init_instr_prio(N,DAG) -> - hipe_ultra_prio:init_instr_prio(N,DAG). - -%% initial_ready_set(M,N,Preds,Ready) -> -%% hipe_ultra_prio:initial_ready_set(M,N,Preds,Ready). - -next_ready(C,Ready,Prio,Nodes,DAG,Preds,Earl) -> - hipe_ultra_prio:next_ready(C,Ready,Prio,Nodes,DAG,Preds,Earl). - -add_ready_nodes(NodeLst,Ready) -> - hipe_ultra_prio:add_ready_nodes(NodeLst,Ready). - -insert_node(C,I,Ready) -> - hipe_ultra_prio:insert_node(C,I,Ready). diff --git a/lib/hipe/opt/hipe_target_machine.erl b/lib/hipe/opt/hipe_target_machine.erl deleted file mode 100644 index 75993cb95e..0000000000 --- a/lib/hipe/opt/hipe_target_machine.erl +++ /dev/null @@ -1,87 +0,0 @@ -%% 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. -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% INTERFACE TO TARGET MACHINE MODEL -%% -%% Interfaces the instruction scheduler to the (resource) machine model. - --module(hipe_target_machine). --export([init_resources/1, - init_instr_resources/2, - resources_available/4, - advance_cycle/1 - ]). --export([raw_latency/2, - war_latency/2, - waw_latency/2, - %% m_raw_latency/2, - %% m_war_latency/2, - %% m_waw_latency/2, - m_raw_latency/0, - m_war_latency/0, - m_waw_latency/0, - br_to_unsafe_latency/2, - unsafe_to_br_latency/2, - br_br_latency/2 - ]). - --define(target,hipe_ultra_mod2). - -init_resources(X) -> - ?target:init_resources(X). - -init_instr_resources(X,Y) -> - ?target:init_instr_resources(X,Y). - -resources_available(X,Y,Z,W) -> - ?target:resources_available(X,Y,Z,W). - -advance_cycle(X) -> - ?target:advance_cycle(X). - -raw_latency(From,To) -> - ?target:raw_latency(From,To). - -war_latency(From,To) -> - ?target:war_latency(From,To). - -waw_latency(From,To) -> - ?target:waw_latency(From,To). - -%% m_raw_latency(From,To) -> -%% ?target:m_raw_latency(From,To). - -%% m_war_latency(From,To) -> -%% ?target:m_war_latency(From,To). - -%% m_waw_latency(From,To) -> -%% ?target:m_waw_latency(From,To). - -m_raw_latency() -> - ?target:m_raw_latency(). - -m_war_latency() -> - ?target:m_war_latency(). - -m_waw_latency() -> - ?target:m_waw_latency(). - -br_to_unsafe_latency(Br,U) -> - ?target:br_to_unsafe_latency(Br,U). - -unsafe_to_br_latency(U,Br) -> - ?target:unsafe_to_br_latency(U,Br). - -br_br_latency(Br1,Br2) -> - ?target:br_br_latency(Br1,Br2). diff --git a/lib/hipe/opt/hipe_ultra_mod2.erl b/lib/hipe/opt/hipe_ultra_mod2.erl deleted file mode 100644 index cec9c56a1e..0000000000 --- a/lib/hipe/opt/hipe_ultra_mod2.erl +++ /dev/null @@ -1,233 +0,0 @@ -%% 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. -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% ULTRASPARC MACHINE MODEL -%% -%% This module is used by the scheduler. -%% The following interface is used: -%% ... -%% -%% NOTES: -%% - the machine model is simple (on the verge of simplistic) -%% * all FUs are pipelined => model only one cycle at a time -%% * instruction latencies are mostly 1 -%% * floating point is left for later (I _think_ it works, but ...) -%% - conservative: instructions that require multiple resources are -%% modelled as 'single'; instead, they could reserve IEU+BR or whatever -%% - possibly inefficient: I think machine state model could be turned into -%% a bitvector. - --module(hipe_ultra_mod2). --export([init_resources/1, - init_instr_resources/2, - resources_available/4, - advance_cycle/1 - ]). --export([raw_latency/2, - war_latency/2, - waw_latency/2, - %% m_raw_latency/2, - %% m_war_latency/2, - %% m_waw_latency/2, - m_raw_latency/0, - m_war_latency/0, - m_waw_latency/0, - br_to_unsafe_latency/2, - unsafe_to_br_latency/2, - br_br_latency/2 - ]). - --include("../sparc/hipe_sparc.hrl"). - --define(debug(Str,Args),ok). -%-define(debug(Str,Args),io:format(Str,Args)). - --define(debug_ultra(Str,Args),ok). -%-define(debug_ultra(Str,Args),io:format(Str,Args)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Straightforward and somewhat simplistic model for UltraSparc: -%% - only one cycle at a time is modelled -%% - resources are simplified: -%% * ieu0, ieu1, ieu, mem, br, single -%% * per-cycle state = done | { I0, I1, NumI, X, Mem, Br } -%% * unoptimized representation (could be bit vector) - -init_resources(_Size) -> - ?debug_ultra('init res ~p~n',[_Size]), - empty_state(). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -init_instr_resources(N,Nodes) -> - ultra_instr_rsrcs(Nodes,hipe_vectors:new(N, '')). - -ultra_instr_rsrcs([],I_res) -> I_res; -ultra_instr_rsrcs([N|Ns],I_res) -> - ultra_instr_rsrcs(Ns,ultra_instr_type(N,I_res)). - -ultra_instr_type({N,I},I_res) -> - hipe_vectors:set(I_res,N-1,instr_type(I)). - -instr_type(I) -> - case I of - #move{} -> - ieu; - #multimove{} -> %% TODO: expand multimoves before scheduling - ieu; - #alu{} -> - case hipe_sparc:alu_operator(I) of - '>>' -> ieu0; - '<<' -> ieu0; - _ -> ieu - end; - #alu_cc{} -> - ieu1; - #sethi{} -> - ieu; - #load{} -> - mem; - #store{} -> - mem; - #b{} -> - br; - #br{} -> - br; - #goto{} -> - br; - #jmp_link{} -> % imprecise; should be mem+br? - single; - #jmp{} -> % imprecise - br; - #call_link{} -> % imprecise; should be mem+br? - single; - #cmov_cc{} -> % imprecise - single; - #cmov_r{} -> % imprecise - single; - #load_atom{} -> % should be resolved to sethi/or - single; - #load_address{} -> % should be resolved to sethi/or - single; - #load_word_index{} -> % should be resolved to sethi/or - single; - %% uncommon types: - #label{} -> - none; - #nop{} -> - none; - #comment{} -> - none; - _ -> - exit({ultrasparc_instr_type,{cant_schedule,I}}) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -resources_available(_Cycle, I, Rsrc, I_res) -> - res_avail(instruction_resource(I_res, I), Rsrc). - -instruction_resource(I_res, I) -> - hipe_vectors:get(I_res, I-1). - -%% The following function checks resource availability. -%% * all function units are assumed to be fully pipelined, so only -%% one cycle at a time is modelled. -%% * for IEU0 and IEU1, these must precede all generic IEU instructions -%% (handled by X bit) -%% * at most 2 integer instructions can issue in a cycle -%% * mem is straightforward -%% * br closes the cycle (= returns done). -%% * single requires an entirely empty state and closes the cycle - -res_avail(ieu0, { free, I1, NumI, free, Mem, Br }) - when is_integer(NumI), NumI < 2 -> - { yes, { occ, I1, NumI+1, free, Mem, Br }}; -res_avail(ieu1, { _I0, free, NumI, free, Mem, Br }) - when is_integer(NumI), NumI < 2 -> - { yes, { free, occ, NumI+1, free, Mem, Br }}; -res_avail(ieu, { I0, I1, NumI, _X, Mem, Br }) - when is_integer(NumI), NumI < 2 -> - { yes, { I0, I1, NumI+1, occ, Mem, Br }}; -res_avail(mem, { I0, I1, NumI, X, free, Br }) -> - { yes, { I0, I1, NumI, X, occ, Br }}; -res_avail(br, { _I0, _I1, _NumI, _X, _Mem, free }) -> - { yes, done }; -res_avail(single, { free, free, 0, free, free, free }) -> - { yes, done }; -res_avail(_, _) -> - no. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -advance_cycle(_Rsrc) -> - empty_state(). - -empty_state() -> { free, free, 0, free, free, free }. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Latencies are taken from UltraSparc hardware manual -%% -%% *** UNFINISHED *** -%% more precisely, they are taken from my memory of the US-manual -%% at the moment. -%% -%% Note: all ld/st are assumed to hit in the L1 cache (D-cache), -%% which is sort of imprecise. - -raw_latency(alu, store) -> 0; -raw_latency(load, _) -> 2; % only if load is L1 hit -raw_latency(alu_cc, b) -> 0; -raw_latency(_I0, _I1) -> - 1. - -war_latency(_I0, _I1) -> - 0. - -waw_latency(_I0, _I1) -> - 1. - -%% *** UNFINISHED *** -%% At present, all load/stores are assumed to hit in the L1 cache, -%% which isn't really satisfying. - -%% m_raw_latency(_St, _Ld) -> -%% 1. -%% -%% m_war_latency(_Ld, _St) -> -%% 1. -%% -%% m_waw_latency(_St1, _St2) -> -%% 1. - -%% Use these for 'default latencies' = do not permit reordering. - -m_raw_latency() -> - 1. - -m_war_latency() -> - 1. - -m_waw_latency() -> - 1. - -br_to_unsafe_latency(_BrTy, _UTy) -> - 0. - -unsafe_to_br_latency(_UTy, _BrTy) -> - 0. - -br_br_latency(_BrTy1, _BrTy2) -> - 0. diff --git a/lib/hipe/opt/hipe_ultra_prio.erl b/lib/hipe/opt/hipe_ultra_prio.erl deleted file mode 100644 index 6dd240a33a..0000000000 --- a/lib/hipe/opt/hipe_ultra_prio.erl +++ /dev/null @@ -1,298 +0,0 @@ -%% 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. -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% PRIORITY HANDLING AND PRIORITY CALCULATION -%% -%% Handling of ready nodes and priorities. -%% Priorities are mainly from the critical path. More priorities are added. -%% * One version is adding priorities just depending on the instr, so -%% for example loads get higher priority than stores, and ordered -%% after reg's and offset for better cache performance. -%% * The other version gives higher priority to a node that adds more new -%% nodes to the ready list. This one is maybe not so effectively -%% implemented, but was added too late for smarter solutions. -%% One version is commented away - --module(hipe_ultra_prio). --export([init_ready/2, - init_instr_prio/2, - %% initial_ready_set/4, - next_ready/7, - add_ready_nodes/2, - insert_node/3 - ]). - --include("../sparc/hipe_sparc.hrl"). - -% At first, only nodes with no predecessors are selected. -% - if R is empty, there is an error (unless BB itself is empty) - -%% Arguments : Size - size of ready-array -%% Preds - array with number of predecessors for each node -%% Returns : An array with list of ready-nodes for each cycle. - -init_ready(Size, Preds) -> - P = hipe_vectors:size(Preds), - Ready = hipe_vectors:new(Size, []), - R = initial_ready_set(1, P, Preds, []), - hipe_vectors:set(Ready, 0, R). - -init_instr_prio(N, DAG) -> - critical_path(N, DAG). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : initial_ready_set -%% Argument : M - current node-index -%% N - where to stop -%% Preds - array with number of predecessors for each node -%% Ready - list with ready-nodes -%% Returns : Ready - list with ready-nodes -%% Description : Finds all nodes with no predecessors and adds them to ready. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -initial_ready_set(M, N, Preds, Ready) -> - if - M > N -> - Ready; - true -> - case hipe_vectors:get(Preds, M-1) of - 0 -> - initial_ready_set(M+1, N, Preds, [M|Ready]); - V when is_integer(V), V > 0 -> - initial_ready_set(M+1, N, Preds, Ready) - end - end. - -%% The following handles the nodes ready to schedule: -%% 1. select the ready queue of given cycle -%% 2. if queue empty, return none -%% 3. otherwise, remove entry with highest priority -%% and return {next,Highest_Prio,NewReady} - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : next_ready -%% Argument : C - current cycle -%% Ready - array with ready nodes -%% Prio - array with cpath-priorities for all nodes -%% Nodes - indexed list [{N, Instr}] -%% Returns : none / {next,Highest_Prio,NewReady} -%% Description : 1. select the ready queue of given cycle -%% 2. if queue empty, return none -%% 3. otherwise, remove entry with highest priority -%% and return {next,Highest_Prio,NewReady} where Highest_Prio -%% = Id of instr and NewReady = updated ready-array. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -next_ready(C, Ready, Prio, Nodes, DAG, Preds, Earl) -> - Curr = hipe_vectors:get(Ready, C-1), - case Curr of - [] -> - none; - Instrs -> - {BestI,RestIs} = - get_best_instr(Instrs, Prio, Nodes, DAG, Preds, Earl, C), - {next,BestI,hipe_vectors:set(Ready,C-1,RestIs)} - end. - -% next_ready(C,Ready,Prio,Nodes) -> -% Curr = hipe_vectors:get(Ready,C-1), -% case Curr of -% [] -> -% none; -% Instrs -> -% {BestInstr,RestInstrs} = get_best_instr(Instrs, Prio, Nodes), -% {next,BestInstr,hipe_vectors:set(Ready,C-1,RestInstrs)} -% end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : get_best_instr -%% Argument : Instrs - list of node-id's -%% Prio - array with cpath-priorities for the nodes -%% Nodes - indexed list [{Id, Instr}] -%% Returns : {BestSoFar, Rest} - Id of best instr and the rest of id's -%% Description : Returns the id of the instr that is the best choice. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -get_best_instr([Instr|Instrs], Prio, Nodes, DAG, Preds, Earl, C) -> - get_best_instr(Instrs, [], Instr, Prio, Nodes, DAG, Preds, Earl, C). - -get_best_instr([], Rest, BestSoFar, _Prio, _Nodes, _DAG, _Preds, _Earl, _C) -> - {BestSoFar, Rest}; -get_best_instr([Instr|Instrs], PassedInstrs, BestSoFar, Prio, Nodes, - DAG, Preds, Earl, C) -> - case better(Instr, BestSoFar, Prio, Nodes, DAG, Preds, Earl, C) of - true -> - get_best_instr(Instrs, [BestSoFar|PassedInstrs], - Instr, Prio, Nodes, DAG, Preds, Earl, C); - false -> - get_best_instr(Instrs, [Instr|PassedInstrs], BestSoFar, Prio, - Nodes, DAG, Preds, Earl, C) - end. - -% get_best_instr([Instr|Instrs], Prio, Nodes) -> -% get_best_instr(Instrs, [], Instr, Prio, Nodes). - -% get_best_instr([], Rest, BestSoFar, Prio, Nodes) -> {BestSoFar, Rest}; -% get_best_instr([Instr|Instrs], PassedInstrs, BestSoFar, Prio, Nodes) -> -% case better(Instr, BestSoFar, Prio, Nodes) of -% true -> -% get_best_instr(Instrs, [BestSoFar|PassedInstrs], -% Instr, Prio, Nodes); -% false -> -% get_best_instr(Instrs, [Instr|PassedInstrs],BestSoFar, Prio, Nodes) -% end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : better -%% Argument : Instr1 - Id of instr 1 -%% Instr2 - Id of instr 2 -%% Prio - array with cpath-priorities for the nodes -%% Nodes - indexed list [{Id, Instr}] -%% Returns : true if Instr1 has higher priority than Instr2 -%% Description : Checks if Instr1 is a better choice than Instr2 for scheduling -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -better(Instr1, Instr2, Prio, Nodes, DAG, Preds, Earl, C) -> - better_hlp(priority(Instr1, Prio, Nodes, DAG, Preds, Earl, C), - priority(Instr2, Prio, Nodes, DAG, Preds, Earl, C)). - -better_hlp([], []) -> false; -better_hlp([], [_|_]) -> false; -better_hlp([_|_], []) -> true; -better_hlp([X|Xs], [Y|Ys]) -> (X > Y) or ((X =:= Y) and better_hlp(Xs,Ys)). - -%% -%% Returns the instr corresponding to id -%% -get_instr(InstrId, [{InstrId,Instr}|_]) -> Instr; -get_instr(InstrId, [_|Xs]) -> get_instr(InstrId, Xs). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : priority -%% Argument : InstrId - Id -%% Prio - array with cpath-priorities for the nodes -%% Nodes - indexed list [{Id, Instr}] -%% Returns : PrioList - list of priorities [MostSignificant, LessSign, ...] -%% Description : Returns a list of priorities where the first element is the -%% cpath-priority and the rest are added depending on what kind -%% of instr it is. Used to order loads/stores sequentially and -%% there is possibility to add whatever stuff... -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -priority(InstrId, Prio, Nodes, DAG, Preds, Earl, C) -> - {ReadyNodes,_,_,_} = hipe_schedule:delete_node(C,InstrId,DAG,Preds,Earl), - Instr = get_instr(InstrId, Nodes), - Prio1 = hipe_vectors:get(Prio, InstrId-1), - Prio2 = length(ReadyNodes), - PrioRest = - case Instr of - #load_atom{} -> - [3]; - #move{} -> - [3]; - #load{} -> - Src = hipe_sparc:load_src(Instr), - Off = hipe_sparc:load_off(Instr), - case hipe_sparc:is_reg(Off) of - false -> [3, - -(hipe_sparc:reg_nr(Src)), - -(hipe_sparc:imm_value(Off))]; - true -> [1] - end; - #store{} -> - Src = hipe_sparc:store_dest(Instr), - Off = hipe_sparc:store_off(Instr), - case hipe_sparc:is_reg(Off) of - false -> [2, - -(hipe_sparc:reg_nr(Src)), - -(hipe_sparc:imm_value(Off))]; - true -> [1] - end; - _ -> [0] - end, - [Prio1,Prio2|PrioRest]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : add_ready_nodes -%% Argument : Nodes - list of [{Cycle,Id}] -%% Ready - array of ready nodes for all cycles -%% Returns : NewReady - updated ready-array -%% Description : Gets a list of instrs and adds them to the ready-array -%% to the corresponding cycle. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -add_ready_nodes([], Ready) -> Ready; -add_ready_nodes([{C,I}|Xs], Ready) -> - add_ready_nodes(Xs, insert_node(C, I, Ready)). - -insert_node(C, I, Ready) -> - Old = hipe_vectors:get(Ready, C-1), - hipe_vectors:set(Ready, C-1, [I|Old]). - -%% -%% Computes the latency for the "most expensive" way through the graph -%% for all nodes. Returns an array of priorities for all nodes. -%% -critical_path(N, DAG) -> - critical_path(1, N, DAG, hipe_vectors:new(N, -1)). - -critical_path(M, N, DAG, Prio) -> - if - M > N -> - Prio; - true -> - critical_path(M+1, N, DAG, cpath(M, DAG, Prio)) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Function : cpath -%% Argument : M - current node id -%% DAG - the dependence graph -%% Prio - array of priorities for all nodes -%% Returns : Prio - updated prio array -%% Description : If node has prio -1, it has not been visited -%% - otherwise, compute priority as max of priorities of -%% successors (+ latency) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -cpath(M, DAG, Prio) -> - InitPrio = hipe_vectors:get(Prio, M-1), - if - InitPrio =:= -1 -> - cpath_node(M, DAG, Prio); - true -> - Prio - end. - -cpath_node(N, DAG, Prio) -> - SuccL = dag_succ(DAG, N), - {Max, NewPrio} = cpath_succ(SuccL, DAG, Prio), - hipe_vectors:set(NewPrio, N-1, Max). - -cpath_succ(SuccL, DAG, Prio) -> - cpath_succ(SuccL, DAG, Prio, 0). - -%% performs an unnecessary lookup of priority of Succ, but that might -%% not be such a big deal - -cpath_succ([], _DAG, Prio, NodePrio) -> {NodePrio,Prio}; -cpath_succ([{Lat,Succ}|Xs], DAG, Prio, NodePrio) -> - NewPrio = cpath(Succ, DAG, Prio), - NewNodePrio = erlang:max(hipe_vectors:get(NewPrio, Succ - 1) + Lat, NodePrio), - cpath_succ(Xs, DAG, NewPrio, NewNodePrio). - -dag_succ(DAG, N) when is_integer(N) -> - hipe_vectors:get(DAG, N-1). - diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile index 544888719f..efeb0887ab 100644 --- a/lib/hipe/test/Makefile +++ b/lib/hipe/test/Makefile @@ -7,7 +7,8 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES= \ hipe_SUITE \ - opt_verify_SUITE + opt_verify_SUITE \ + erl_types_SUITE # .erl files for these modules are automatically generated GEN_MODULES= \ diff --git a/lib/hipe/test/erl_types_SUITE.erl b/lib/hipe/test/erl_types_SUITE.erl new file mode 100644 index 0000000000..7d7c144b69 --- /dev/null +++ b/lib/hipe/test/erl_types_SUITE.erl @@ -0,0 +1,197 @@ +%% -*- erlang-indent-level: 4 -*- +%% +%% 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. +%% +-module(erl_types_SUITE). + +-export([all/0, + consistency_and_to_string/1]). + +%% Simplify calls into erl_types and avoid importing the entire module. +-define(M, erl_types). + +-include_lib("common_test/include/ct.hrl"). + +all() -> + [consistency_and_to_string]. + +consistency_and_to_string(_Config) -> + %% Check consistency of types + Atom1 = ?M:t_atom(), + Atom2 = ?M:t_atom(foo), + Atom3 = ?M:t_atom(bar), + true = ?M:t_is_atom(Atom2), + + True = ?M:t_atom(true), + False = ?M:t_atom(false), + Bool = ?M:t_boolean(), + true = ?M:t_is_boolean(True), + true = ?M:t_is_boolean(Bool), + false = ?M:t_is_boolean(Atom1), + + Binary = ?M:t_binary(), + true = ?M:t_is_binary(Binary), + + Bitstr = ?M:t_bitstr(), + true = ?M:t_is_bitstr(Bitstr), + + Bitstr1 = ?M:t_bitstr(7, 3), + true = ?M:t_is_bitstr(Bitstr1), + false = ?M:t_is_binary(Bitstr1), + + Bitstr2 = ?M:t_bitstr(16, 8), + true = ?M:t_is_bitstr(Bitstr2), + true = ?M:t_is_binary(Bitstr2), + + BitStr816 = ?M:t_bitstr(8,16), + BitStr816 = ?M:t_subtract(?M:t_bitstr(4, 12), ?M:t_bitstr(8, 12)), + + Int1 = ?M:t_integer(), + Int2 = ?M:t_integer(1), + Int3 = ?M:t_integer(16#ffffffff), + true = ?M:t_is_integer(Int2), + true = ?M:t_is_byte(Int2), + false = ?M:t_is_byte(Int3), + false = ?M:t_is_byte(?M:t_from_range(-1, 1)), + true = ?M:t_is_byte(?M:t_from_range(1, 255)), + + Tuple1 = ?M:t_tuple(), + Tuple2 = ?M:t_tuple(3), + Tuple3 = ?M:t_tuple([Atom1, Int1]), + Tuple4 = ?M:t_tuple([Tuple1, Tuple2]), + Tuple5 = ?M:t_tuple([Tuple3, Tuple4]), + Tuple6 = ?M:t_limit(Tuple5, 2), + Tuple7 = ?M:t_limit(Tuple5, 3), + true = ?M:t_is_tuple(Tuple1), + + Port = ?M:t_port(), + Pid = ?M:t_pid(), + Ref = ?M:t_reference(), + Identifier = ?M:t_identifier(), + false = ?M:t_is_reference(Port), + true = ?M:t_is_identifier(Port), + + Function1 = ?M:t_fun(), + Function2 = ?M:t_fun(Pid), + Function3 = ?M:t_fun([], Pid), + Function4 = ?M:t_fun([Port, Pid], Pid), + Function5 = ?M:t_fun([Pid, Atom1], Int2), + true = ?M:t_is_fun(Function3), + + List1 = ?M:t_list(), + List2 = ?M:t_list(?M:t_boolean()), + List3 = ?M:t_cons(?M:t_boolean(), List2), + List4 = ?M:t_cons(?M:t_boolean(), ?M:t_atom()), + List5 = ?M:t_cons(?M:t_boolean(), ?M:t_nil()), + List6 = ?M:t_cons_tl(List5), + List7 = ?M:t_sup(List4, List5), + List8 = ?M:t_inf(List7, ?M:t_list()), + List9 = ?M:t_cons(), + List10 = ?M:t_cons_tl(List9), + true = ?M:t_is_boolean(?M:t_cons_hd(List5)), + true = ?M:t_is_list(List5), + false = ?M:t_is_list(List4), + + Product1 = ?M:t_product([Atom1, Atom2]), + Product2 = ?M:t_product([Atom3, Atom1]), + Product3 = ?M:t_product([Atom3, Atom2]), + + Union1 = ?M:t_sup(Atom2, Atom3), + Union2 = ?M:t_sup(Tuple2, Tuple3), + Union3 = ?M:t_sup(Int2, Atom3), + Union4 = ?M:t_sup(Port, Pid), + Union5 = ?M:t_sup(Union4, Int1), + Union6 = ?M:t_sup(Function1, Function2), + Union7 = ?M:t_sup(Function4, Function5), + Union8 = ?M:t_sup(True, False), + true = ?M:t_is_boolean(Union8), + Union9 = ?M:t_sup(Int2, ?M:t_integer(2)), + true = ?M:t_is_byte(Union9), + Union10 = ?M:t_sup(?M:t_tuple([?M:t_atom(true), ?M:t_any()]), + ?M:t_tuple([?M:t_atom(false), ?M:t_any()])), + + Any = ?M:t_any(), + Any = ?M:t_sup(Product3, Function5), + + Atom3 = ?M:t_inf(Union3, Atom1), + Union2 = ?M:t_inf(Union2, Tuple1), + Int2 = ?M:t_inf(Int1, Union3), + Union4 = ?M:t_inf(Union4, Identifier), + Port = ?M:t_inf(Union5, Port), + Function4 = ?M:t_inf(Union7, Function4), + None = ?M:t_none(), + None = ?M:t_inf(Product2, Atom1), + Product3 = ?M:t_inf(Product1, Product2), + Function5 = ?M:t_inf(Union7, Function5), + true = ?M:t_is_byte(?M:t_inf(Union9, ?M:t_number())), + true = ?M:t_is_char(?M:t_inf(Union9, ?M:t_number())), + + RecDict = #{{record, foo} => {{?FILE, ?LINE}, [{2, [{bar, [], ?M:t_any()}, + {baz, [], ?M:t_any()}]}]}}, + Record1 = ?M:t_from_term({foo, [1,2], {1,2,3}}), + + %% Check string representations + "atom()" = ?M:t_to_string(Atom1), + "'foo'" = ?M:t_to_string(Atom2), + "'bar'" = ?M:t_to_string(Atom3), + + "binary()" = ?M:t_to_string(Binary), + + "integer()" = ?M:t_to_string(Int1), + "1" = ?M:t_to_string(Int2), + + "tuple()" = ?M:t_to_string(Tuple1), + "{_,_,_}" = ?M:t_to_string(Tuple2), + "{atom(),integer()}" = ?M:t_to_string(Tuple3), + "{tuple(),{_,_,_}}" = ?M:t_to_string(Tuple4), + "{{atom(),integer()},{tuple(),{_,_,_}}}" = ?M:t_to_string(Tuple5), + "{{_,_},{_,_}}" = ?M:t_to_string(Tuple6), + "{{atom(),integer()},{tuple(),{_,_,_}}}" = ?M:t_to_string(Tuple7), + + "reference()" = ?M:t_to_string(Ref), + "port()" = ?M:t_to_string(Port), + "pid()" = ?M:t_to_string(Pid), + "identifier()" = ?M:t_to_string(Identifier), + + "[any()]" = ?M:t_to_string(List1), + "[boolean()]" = ?M:t_to_string(List2), + "[boolean(),...]" = ?M:t_to_string(List3), + "nonempty_improper_list(boolean(),atom())" = ?M:t_to_string(List4), + "[boolean(),...]" = ?M:t_to_string(List5), + "[boolean()]" = ?M:t_to_string(List6), + "nonempty_maybe_improper_list(boolean(),atom() | [])" = ?M:t_to_string(List7), + "[boolean(),...]" = ?M:t_to_string(List8), + "nonempty_maybe_improper_list()" = ?M:t_to_string(List9), + "any()" = ?M:t_to_string(List10), + + "fun()" = ?M:t_to_string(Function1), + "fun((...) -> pid())" = ?M:t_to_string(Function2), + "fun(() -> pid())" = ?M:t_to_string(Function3), + "fun((port(),pid()) -> pid())" = ?M:t_to_string(Function4), + "fun((pid(),atom()) -> 1)" = ?M:t_to_string(Function5), + + "<atom(),'foo'>" = ?M:t_to_string(Product1), + "<'bar',atom()>" = ?M:t_to_string(Product2), + + "#foo{bar::[1 | 2,...],baz::{1,2,3}}" = ?M:t_to_string(Record1, RecDict), + + "'bar' | 'foo'" = ?M:t_to_string(Union1), + "{atom(),integer()} | {_,_,_}" = ?M:t_to_string(Union2), + "'bar' | 1" = ?M:t_to_string(Union3), + "pid() | port()" = ?M:t_to_string(Union4), + "pid() | port() | integer()" = ?M:t_to_string(Union5), + "fun()" = ?M:t_to_string(Union6), + "fun((pid() | port(),atom() | pid()) -> pid() | 1)" = ?M:t_to_string(Union7), + "boolean()" = ?M:t_to_string(Union8), + "{'false',_} | {'true',_}" = ?M:t_to_string(Union10), + "{'true',integer()}" = ?M:t_to_string(?M:t_inf(Union10, ?M:t_tuple([?M:t_atom(true), ?M:t_integer()]))). diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl index 3206d957d9..b49b3a7093 100644 --- a/lib/inets/src/http_server/mod_esi.erl +++ b/lib/inets/src/http_server/mod_esi.erl @@ -561,7 +561,7 @@ eval(#mod{method = Method} = ModData, ESIBody, Modules) end. generate_webpage(ESIBody) -> - (catch lib:eval_str(string:concat(ESIBody,". "))). + (catch eval_str(string:concat(ESIBody,". "))). is_authorized(_ESIBody, [all]) -> true; @@ -573,3 +573,45 @@ is_authorized(ESIBody, Modules) -> nomatch -> false end. + +%% eval_str(InStr) -> {ok, OutStr} | {error, ErrStr'} +%% InStr must represent a body +%% Note: If InStr is a binary it has to be a Latin-1 string. +%% If you have a UTF-8 encoded binary you have to call +%% unicode:characters_to_list/1 before the call to eval_str(). + +-define(result(F,D), lists:flatten(io_lib:format(F, D))). + +-spec eval_str(string()) -> + {'ok', string()} | {'error', string()}. + +eval_str(Str) when is_list(Str) -> + case erl_scan:tokens([], Str, 0) of + {more, _} -> + {error, "Incomplete form (missing .<cr>)??"}; + {done, {ok, Toks, _}, Rest} -> + case all_white(Rest) of + true -> + case erl_parse:parse_exprs(Toks) of + {ok, Exprs} -> + case catch erl_eval:exprs(Exprs, erl_eval:new_bindings()) of + {value, Val, _} -> + {ok, Val}; + Other -> + {error, ?result("*** eval: ~p", [Other])} + end; + {error, {_Line, Mod, Args}} -> + Msg = ?result("*** ~ts",[Mod:format_error(Args)]), + {error, Msg} + end; + false -> + {error, ?result("Non-white space found after " + "end-of-form :~ts", [Rest])} + end + end. + +all_white([$\s|T]) -> all_white(T); +all_white([$\n|T]) -> all_white(T); +all_white([$\t|T]) -> all_white(T); +all_white([]) -> true; +all_white(_) -> false. diff --git a/lib/kernel/doc/src/Makefile b/lib/kernel/doc/src/Makefile index 82869d7b15..29dc73a523 100644 --- a/lib/kernel/doc/src/Makefile +++ b/lib/kernel/doc/src/Makefile @@ -42,6 +42,7 @@ XML_REF3_FILES = application.xml \ disk_log.xml \ erl_boot_server.xml \ erl_ddll.xml \ + erl_epmd.xml \ erl_prim_loader_stub.xml \ erlang_stub.xml \ error_handler.xml \ diff --git a/lib/kernel/doc/src/erl_epmd.xml b/lib/kernel/doc/src/erl_epmd.xml new file mode 100644 index 0000000000..8b076cd2d7 --- /dev/null +++ b/lib/kernel/doc/src/erl_epmd.xml @@ -0,0 +1,104 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2018</year><year>2018</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_epmd</title> + <prepared>Timmo Verlaan</prepared> + <docno>1</docno> + <date>2018-02-19</date> + <rev>A</rev> + </header> + <module>erl_epmd</module> + <modulesummary> + Erlang interface towards epmd + </modulesummary> + <description> + <p>This module communicates with the EPMD daemon, see <seealso + marker="erts:epmd">epmd</seealso>. To implement your own epmd module please + see <seealso marker="erts:alt_disco">ERTS User's Guide: How to Implement an + Alternative Service Discovery for Erlang Distribution</seealso></p> + </description> + + <funcs> + <func> + <name name="start_link" arity="0"/> + <fsummary>Callback for erl_distribution supervisor.</fsummary> + <desc> + <p>This function is invoked as this module is added as a child of the + <c>erl_distribution</c> supervisor.</p> + </desc> + </func> + + <func> + <name name="register_node" arity="2"/> + <name name="register_node" arity="3"/> + <fsummary>Registers the node with <c>epmd</c>.</fsummary> + <desc> + <p>Registers the node with <c>epmd</c> and tells epmd what port will be + used for the current node. It returns a creation number. This number is + incremented on each register to help with identifying if a node is + reconnecting to epmd.</p> + </desc> + </func> + + <func> + <name name="port_please" arity="2"/> + <name name="port_please" arity="3"/> + <fsummary>Returns the port number for a given node.</fsummary> + <desc> + <p>Requests the distribution port for the given node of an EPMD + instance. Together with the port it returns a distribution protocol + version which has been 5 since Erlang/OTP R6.</p> + </desc> + </func> + + <func> + <name name="address_please" arity="3"/> + <fsummary>Returns address and port.</fsummary> + <desc> + <p>Called by the distribution module. Resolves the <c>Host</c> to an IP + address.</p> + <p>Another epmd module may return port and distribution protocol version + as well.</p> + </desc> + </func> + + <func> + <name name="names" arity="1"/> + <fsummary>Names of Erlang nodes at a host.</fsummary> + <desc> + <p>Called by <seealso marker="net_adm"><c>net_adm:names/0</c></seealso>. + <c>Host</c> defaults to the localhost. Returns the names and associated + port numbers of the Erlang nodes that <c>epmd</c> registered at the + specified host. Returns <c>{error, address}</c> if <c>epmd</c> is not + operational.</p> + <p><em>Example:</em></p> + <pre> +(arne@dunn)1> <input>erl_epmd:names(localhost).</input> +{ok,[{"arne",40262}]}</pre> + </desc> + </func> + </funcs> + +</erlref> + diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml index 554d675383..7894600c21 100644 --- a/lib/kernel/doc/src/kernel_app.xml +++ b/lib/kernel/doc/src/kernel_app.xml @@ -122,21 +122,6 @@ application. For more information about configuration parameters, see file <seealso marker="app"><c>app(4)</c></seealso>.</p> <taglist> - <tag><c>browser_cmd = string() | {M,F,A}</c></tag> - <item> - <p>When pressing the <em>Help</em> button in a tool such as Debugger, - the help text (an HTML file <c>File</c>) is by default - displayed in a Netscape browser, which is required to be - operational. This parameter can be used to change the command for - how to display the help text if another browser than Netscape - is preferred, or if another platform than Unix or Windows is - used.</p> - <p>If set to a string <c>Command</c>, the command - <c>"Command File"</c> is evaluated using - <seealso marker="os#cmd/1"><c>os:cmd/1</c></seealso>.</p> - <p>If set to a module-function-args tuple, <c>{M,F,A}</c>, - the call <c>apply(M,F,[File|A])</c> is evaluated.</p> - </item> <tag><c>distributed = [Distrib]</c></tag> <item> <p>Specifies which applications that are distributed and on which @@ -226,7 +211,7 @@ <p>This configuration parameter is used both for the global logger level, and for the standard handler started by the Kernel application (see <c>logger_dest</c> variable above).</p> - <p>The default value is <c>info</c></p> + <p>The default value is <c>info</c>.</p> </item> <tag><marker id="disk_log_vars"/> <c>logger_disk_log_type = halt | wrap</c></tag> @@ -251,14 +236,14 @@ logger_disk_log_maxbytes = 1048576</code> <item> <p>If this parameter is set to true, then the logger handler started by kernel will not log any progress-, crash-, or - supervisor reports. If the SASL application is starated, + supervisor reports. If the SASL application is started, these log events will be sent to a second handler instance - named sasl_h, according to values of the SASL environment - variables <c>sasl_error_logger</c> + named <c>sasl_h</c>, according to values of the SASL + environment variables <c>sasl_error_logger</c> and <c>sasl_errlog_type</c>, see <seealso marker="sasl:sasl_app#configuration">SASL(6) </seealso></p> - <p>The default value is <c>false</c></p> + <p>The default value is <c>false</c>.</p> <p>See chapter <seealso marker="logger_chapter#compatibility">Backwards compatibility with error_logger</seealso> for more information about handling of the so called SASL reports.</p> @@ -271,7 +256,7 @@ logger_disk_log_maxbytes = 1048576</code> reports from <c>supervisor</c> and <c>application_controller</c> shall be logged or not.</p> - <p>If <c>logger_sasl_compatible = false</c>, + <p>If <c>logger_sasl_compatible = true</c>, then <c>logger_log_progress</c> is ignored.</p> </item> <tag><marker id="logger_format_depth"/> @@ -280,14 +265,6 @@ logger_disk_log_maxbytes = 1048576</code> <p>Can be used to limit the size of the formatted output from the logger handlers.</p> - <note><p>This configuration parameter was introduced in OTP 18.1 - and is experimental. Based on user feedback, it - can be changed or improved in future releases, for example, - to gain better control over how to limit the size of the - formatted output. We have no plans to remove this - new feature entirely, unless it turns out to be - useless.</p></note> - <p><c>Depth</c> is a positive integer representing the maximum depth to which terms are printed by the logger handlers included in OTP. This @@ -312,11 +289,11 @@ logger_disk_log_maxbytes = 1048576</code> </item> <tag><c>logger_max_size = integer() | unlimited</c></tag> <item> - <p>This parameter specifies the maximum size (bytes) each - log event can have when printed by the standard logger - handler. If the resulting string after formatting an event - is bigger than this, it will be truncated before printed - to the handler's destination.</p> + <p>This parameter specifies a hard maximum size limit (number + of characters) each log event can have when printed by the + default logger formatter. If the resulting string after + formatting an event is bigger than this, it will be + truncated before printed to the handler's destination.</p> </item> <tag><c>logger_utc = boolean()</c></tag> <item> diff --git a/lib/kernel/doc/src/logger.xml b/lib/kernel/doc/src/logger.xml index 66e6e5c689..d901454e62 100644 --- a/lib/kernel/doc/src/logger.xml +++ b/lib/kernel/doc/src/logger.xml @@ -67,37 +67,86 @@ <datatype> <name name="metadata"/> <desc> - <p>Metadata associated with the message to be logged.</p> + <p>Metadata for the log event.</p> + <p>Logger adds the following metadata to each log event:</p> + <list> + <item><c>pid => self()</c></item> + <item><c>gl => group_leader()</c></item> + <item><c>time => erlang:monotonic_time(microsecond)</c></item> + </list> + <p>When a log macro is used, Logger also inserts location + information:</p> + <list> + <item><c>mfa => {?MODULE,?FUNCTION_NAME,?FUNCTION_ARITY}</c></item> + <item><c>file => ?FILE</c></item> + <item><c>line => ?LINE</c></item> + </list> + <p>You can add custom metadata, either by specifying a map as + the last parameter to any of the log macros or the API + functions, or by setting process metadata + with <seealso marker="#set_process_metadata-1"> + <c>set_process_metadata/1</c></seealso> + or <seealso marker="#update_process_metadata-1"> + <c>update_process_metadata/1</c></seealso>.</p> + <p>Logger merges all the metadata maps before forwarding the + log event to the handlers. If the same keys occur, values + from the log call overwrites process metadata, which in turn + overwrites values set by Logger.</p> </desc> </datatype> <datatype> <name name="config"/> <desc> - <p></p> + <p>Configuration data for the logger part of Logger, or for a handler.</p> + <p>The following default values apply:</p> + <list> + <item><c>level => info</c></item> + <item><c>filter_default => log</c></item> + <item><c>filters => []</c></item> + <item><c>formatter => {logger_formatter,DefaultFormatterConfig</c>}</item> + </list> + <p>See the <seealso marker="logger_formatter#configuration"> + <c>logger_formatter(3)</c></seealso> manual page for + information about the default configuration for this + formatter.</p> </desc> </datatype> <datatype> <name name="handler_id"/> <desc> - <p></p> + <p>A unique identifier for a handler instance.</p> </desc> </datatype> <datatype> <name name="filter_id"/> <desc> - <p></p> + <p>A unique identifier for a filter.</p> </desc> </datatype> <datatype> <name name="filter"/> <desc> - <p></p> + <p>A filter which can be installed for logger or for a handler.</p> + </desc> + </datatype> + <datatype> + <name name="filter_arg"/> + <desc> + <p>The second argument to the filter fun.</p> </desc> </datatype> <datatype> <name name="filter_return"/> <desc> - <p></p> + <p>The return value from the filter fun.</p> + </desc> + </datatype> + <datatype> + <name name="timestamp"/> + <desc> + <p>A timestamp produced + with <seealso marker="erts:erlang#monotonic_time-1"> + <c>erlang:monotonic_time(microsecond)</c></seealso>.</p> </desc> </datatype> </datatypes> @@ -126,14 +175,10 @@ </list> <p>All macros expand to a call to logger, where <c>Level</c> is - taken from the macro name, and the following metadata is added, - or merged with the given <c>Metadata</c>:</p> - - <code> -#{mfa=>{?MODULE,?FUNCTION_NAME,?FUNCTION_ARITY}, - file=>?FILE, - line=>?LINE} - </code> + taken from the macro name, and location data is added. See the + description of + the <seealso marker="#type-metadata"><c>metadata()</c></seealso> + type for more information about the location data.</p> <p>The call is wrapped in a case statement and will be evaluated only if <c>Level</c> is equal to or below the configured log @@ -267,7 +312,7 @@ <func> <name name="i" arity="0"/> - <fsummary>Get information about all logger configurations</fsummary> + <fsummary>Get all logger configurations</fsummary> <desc> <p>Same as <seealso marker="#i/1"><c>logger:i(term)</c></seealso></p> </desc> @@ -277,27 +322,30 @@ <name name="i" arity="1" clause_i="1"/> <name name="i" arity="1" clause_i="2"/> <name name="i" arity="1" clause_i="3"/> - <fsummary>Get information about all logger configurations</fsummary> + <fsummary>Get all logger configurations</fsummary> <desc> - <p>The <c>logger:i/1</c> function can be used to get all - current logger configuration. The way that the information - is returned depends on the <c><anno>Action</anno></c></p> + <p>Display or return all current logger configuration.</p> <taglist> - <tag>string</tag> - <item>Return the pretty printed current logger configuration - as iodata.</item> - <tag>term</tag> - <item>Return the current logger configuration as a term. The - format of this term may change inbetween releases. For a - stable format use <seealso marker="#get_handler_config/1"> + <tag><c><anno>Action</anno> = string</c></tag> + <item> + <p>Return the pretty printed current logger configuration + as iodata.</p> + </item> + <tag><c><anno>Action</anno> = term</c></tag> + <item> + <p>Return the current logger configuration as a term. The + format of this term may change inbetween releases. For a + stable format use <seealso marker="#get_handler_config/1"> <c>logger:get_handler_config/1</c></seealso> - and <seealso marker="#get_logger_config/0"> + and <seealso marker="#get_logger_config/0"> <c>logger:get_logger_config/0</c></seealso>. - The same as calling <c>logger:i()</c>.</item> - <tag>print</tag> - <item>Pretty print all the current logger configuration to - standard out. Example: - <code><![CDATA[1> logger:i(). + The same as calling <c>logger:i()</c>.</p> + </item> + <tag><c><anno>Action</anno> = print</c></tag> + <item> + <p>Pretty print all the current logger configuration to + standard out. Example:</p> + <code><![CDATA[1> logger:i(print). Current logger configuration: Level: info FilterDefault: log @@ -339,6 +387,39 @@ Current logger configuration: <fsummary>Add a filter to the logger.</fsummary> <desc> <p>Add a filter to the logger.</p> + <p>The filter fun is called with the log event as the first + parameter, and the specified <c>filter_args()</c> as the + second parameter.</p> + <p>The return value of the fun specifies if a log event is to + be discarded or forwarded to the handlers:</p> + <taglist> + <tag><c>log()</c></tag> + <item> + <p>The filter <em>passed</em>. The next logger filter, if + any, is applied. If no more logger filters exist, the + log event is forwarded to the handler part of the + logger, where handler filters are applied.</p> + </item> + <tag><c>stop</c></tag> + <item> + <p>The filter <em>did not pass</em>, and the log event is + immediately discarded.</p> + </item> + <tag><c>ignore</c></tag> + <item> + <p>The filter has no knowledge of the log event. The next + logger filter, if any, is applied. If no more logger + filters exist, the value of the <c>filter_default</c> + configuration parameter for the logger specifies if the + log event shall be discarded or forwarded to the handler + part.</p> + </item> + </taglist> + <p>See section <seealso marker="logger_chapter#Filter"> + Filter</seealso> in the User's Guide for more information + about filters.</p> + <p>Some built-in filters exist. These are defined + in <seealso marker="logger_filters"><c>logger_filters</c></seealso>.</p> </desc> </func> @@ -347,6 +428,39 @@ Current logger configuration: <fsummary>Add a filter to the specified handler.</fsummary> <desc> <p>Add a filter to the specified handler.</p> + <p>The filter fun is called with the log event as the first + parameter, and the specified <c>filter_args()</c> as the + second parameter.</p> + <p>The return value of the fun specifies if a log event is to + be discarded or forwarded to the handler callback:</p> + <taglist> + <tag><c>log()</c></tag> + <item> + <p>The filter <em>passed</em>. The next handler filter, if + any, is applied. If no more filters exist for this + handler, the log event is forwarded to the handler + callback.</p> + </item> + <tag><c>stop</c></tag> + <item> + <p>The filter <em>did not pass</em>, and the log event is + immediately discarded.</p> + </item> + <tag><c>ignore</c></tag> + <item> + <p>The filter has no knowledge of the log event. The next + handler filter, if any, is applied. If no more filters + exist for this handler, the value of + the <c>filter_default</c> configuration parameter for + the handler specifies if the log event shall be + discarded or forwarded to the handler callback.</p> + </item> + </taglist> + <p>See + section <seealso marker="logger_chapter#Filter">Filter</seealso> + in the User's Guide for more information about filters.</p> + <p>Some built-in filters exist. These are defined in + <seealso marker="logger_filters"><c>logger_filters</c></seealso>.</p> </desc> </func> @@ -354,7 +468,8 @@ Current logger configuration: <name name="remove_logger_filter" arity="1"/> <fsummary>Remove a filter from the logger.</fsummary> <desc> - <p>Remove the filter with the specified identity from the logger.</p> + <p>Remove the filter identified + by <c><anno>FilterId</anno></c> from the logger.</p> </desc> </func> @@ -362,7 +477,9 @@ Current logger configuration: <name name="remove_handler_filter" arity="2"/> <fsummary>Remove a filter from the specified handler.</fsummary> <desc> - <p>Remove the filter with the specified identity from the given handler.</p> + <p>Remove the filter identified + by <c><anno>FilterId</anno></c> from the handler identified + by <c><anno>HandlerId</anno></c>.</p> </desc> </func> @@ -371,6 +488,9 @@ Current logger configuration: <fsummary>Add a handler with the given configuration.</fsummary> <desc> <p>Add a handler with the given configuration.</p> + <p><c><anno>HandlerId</anno></c> is a unique identifier which + must be used in all subsequent calls reffering to this + handler.</p> </desc> </func> @@ -378,7 +498,7 @@ Current logger configuration: <name name="remove_handler" arity="1"/> <fsummary>Remove the handler with the specified identity.</fsummary> <desc> - <p>Remove the handler with the specified identity.</p> + <p>Remove the handler identified by <c><anno>HandlerId</anno></c>.</p> </desc> </func> @@ -386,10 +506,37 @@ Current logger configuration: <name name="set_module_level" arity="2"/> <fsummary>Set the log level for the specified module.</fsummary> <desc> - <p>Set the log level for the specified module.</p> - <p>To change the logging level globally, use - <seealso marker="#set_logger_config/2"><c>logger:set_logger_config(level, Level)</c></seealso>. - </p> + <p>Set the log level for the + specified <c><anno>Module</anno></c>.</p> + <p>The log level for a module overrides the global log level + of the logger for log event originating from the module in + question. Notice, however, that it does not override the + level configuration for any handler.</p> + <p>For example: Assume that the global log level for the + logger is <c>info</c>, and there is one handler, <c>h1</c>, + with level <c>info</c> and one handler, <c>h2</c>, with + level <c>debug</c>.</p> + <p>With this configuration, no debug messages will be logged, + since they are all stopped by the global log level.</p> + <p>If the level for <c>mymodule</c> is set now set + to <c>debug</c>, then debug events from this module will be + logged by the handler <c>h2</c>, but not by + handler <c>h1</c>.</p> + <p>Debug events from other modules are still not logged.</p> + <p>To change the global log level for the logger, use + <seealso marker="#set_logger_config/2"> + <c>logger:set_logger_config(level,Level)</c></seealso>.</p> + <p>To change the log level for a handler, use + <seealso marker="#set_handler_config/3"> + <c>logger:set_handler_config(HandlerId,level,Level)</c></seealso>.</p> + <note> + <p>The originating module for a log event is only detected + if <c>mfa=>{Module,Function,Arity}</c> exists in the + metadata. When log macros are used, this association is + automatically added to all log events. If the logger API + is called directly, without using a macro, the logging + client must explicitly add this information.</p> + </note> </desc> </func> @@ -404,21 +551,62 @@ Current logger configuration: <func> <name name="set_logger_config" arity="1"/> + <fsummary>Set configuration data for the logger.</fsummary> + <desc> + <p>Set configuration data for the logger. This overwrites the + current logger configuration.</p> + <p>To modify the existing configuration, + use <seealso marker="#set_logger_config-2"><c>set_logger_config/2</c> + </seealso>, or read the current configuration + with <seealso marker="#get_logger_config-0"><c>get_logger_config/0</c> + </seealso>, then merge in your added or updated + associations before writing it back.</p> + <p>If a key is removed compared to the current configuration, + the default value is used.</p> + </desc> + </func> + + <func> <name name="set_logger_config" arity="2"/> <fsummary>Add or update configuration data for the logger.</fsummary> <desc> - <p>Add or update configuration data for the logger.</p> + <p>Add or update configuration data for the logger. If the + given <c><anno>Key</anno></c> already exists, its associated + value will be changed to <c><anno>Value</anno></c>. If it + doesn't exist, it will be added.</p> </desc> </func> <func> <name name="set_handler_config" arity="2"/> + <fsummary>Set configuration data for the specified handler.</fsummary> + <desc> + <p>Set configuration data for the specified handler. This + overwrites the current handler configuration.</p> + <p>To modify the existing configuration, + use <seealso marker="#set_handler_config-3"><c>set_handler_config/3</c> + </seealso>, or read the current configuration + with <seealso marker="#get_handler_config-1"><c>get_handler_config/1</c> + </seealso>, then merge in your added or updated + associations before writing it back.</p> + <p>If a key is removed compared to the current configuration, + and the key is know by Logger, the default value is used. If + it is a custom key, then it is up to the handler + implementation if the value is removed or a default value is + inserted.</p> + </desc> + </func> + + <func> <name name="set_handler_config" arity="3"/> <fsummary>Add or update configuration data for the specified handler.</fsummary> <desc> <p>Add or update configuration data for the specified - handler.</p> + handler. If the given <c><anno>Key</anno></c> already + exists, its associated value will be changed + to <c><anno>Value</anno></c>. If it doesn't exist, it will + be added.</p> </desc> </func> @@ -437,17 +625,37 @@ Current logger configuration: <name name="set_process_metadata" arity="1"/> <fsummary>Set metadata to use when logging from current process.</fsummary> <desc> - <p>Set metadata which <c>logger</c> automatically inserts it - in all log events produced on the current - process. Subsequent calls will overwrite previous data set - by this function.</p> - <p>When logging, location data produced by the log macros, - and/or metadata given as argument to the log call (API - function or macro), will be merged with the process - metadata. If the same keys occur, values from the metadata - argument to the log call will overwrite values in the - process metadata, which in turn will overwrite values from - the location data.</p> + <p>Set metadata which Logger shall automatically insert in + all log events produced on the current process.</p> + <p>Location data produced by the log macros, and/or metadata + given as argument to the log call (API function or macro), + are merged with the process metadata. If the same keys + occur, values from the metadata argument to the log call + overwrite values from the process metadata, which in turn + overwrite values from the location data.</p> + <p>Subsequent calls to this function overwrites previous data + set. To update existing data instead of overwriting it, + see <seealso marker="#update_process_metadata-1"> + <c>update_process_metadata/1</c></seealso>.</p> + </desc> + </func> + + <func> + <name name="update_process_metadata" arity="1"/> + <fsummary>Set or update metadata to use when logging from + current process.</fsummary> + <desc> + <p>Set or update metadata to use when logging from current + process</p> + <p>If process metadata exists for the current process, this + function behaves as if it was implemented as follows:</p> + <code type="erl"> +logger:set_process_metadata(maps:merge(logger:get_process_metadata(),Meta)) + </code> + <p>If no process metadata exists, the function behaves as + <seealso marker="#set_process_metadata-1"> + <c>set_process_metadata/1</c> + </seealso>.</p> </desc> </func> @@ -457,7 +665,9 @@ Current logger configuration: <desc> <p>Retrieve data set with <seealso marker="#set_process_metadata-1"> - <c>set_process_metadata/1</c></seealso>.</p> + <c>set_process_metadata/1</c></seealso> or + <seealso marker="#update_process_metadata-1"> + <c>update_process_metadata/1</c></seealso>.</p> </desc> </func> @@ -467,12 +677,103 @@ Current logger configuration: <desc> <p>Delete data set with <seealso marker="#set_process_metadata-1"> - <c>set_process_metadata/1</c></seealso>.</p> + <c>set_process_metadata/1</c></seealso> or + <seealso marker="#update_process_metadata-1"> + <c>update_process_metadata/1</c></seealso>.</p> + </desc> + </func> + + <func> + <name name="format_report" arity="1"/> + <fsummary>Convert a log message on report form to {Format,Args}.</fsummary> + <desc> + <p>Convert a log message on report form to <c>{Format,Args}</c>.</p> + <p>This is the default report callback used + by <seealso marker="logger_formatter"> + <c>logger_formatter</c></seealso> when no custom report + callback is found.</p> + <p>The function produces lines of <c>Key: Value</c> from + key-value lists. Strings are printed with <c>~ts</c> and + other terms with <c>~tp</c>.</p> + <p>If the <c><anno>Report</anno></c> is a map, it is + converted to a key-value list before formatting as such.</p> </desc> </func> </funcs> + <section> + <title>Callback Functions</title> + <p>The following functions are to be exported from a handler + callback module.</p> + </section> + + <funcs> + <func> + <name>Module:adding_handler(HandlerId,Config1) -> {ok,Config2} | {error,Reason}</name> + <fsummary>An instance of this handler is about to be added.</fsummary> + <type> + <v>HandlerId = + <seealso marker="#type-handler_id">handler_id()</seealso></v> + <v>Config1 = Config2 = + <seealso marker="#type-config">config()</seealso></v> + <v>Reason = term()</v> + </type> + <desc> + <p>This callback function is optional.</p> + <p>The function is called when an new handler is about to be + added, and the purpose is to verify the configuration and + initiate all resourced needed by the handler.</p> + <p>If everything succeeds, the callback function can add + possible default values or internal state values to the + configuration, and return the adjusted map + in <c>{ok,Config2}</c>.</p> + <p>If the configuration is faulty, or if the initiation fails, + the callback function must return <c>{error,Reason}</c>.</p> + </desc> + </func> + + <func> + <name>Module:removing_handler(HandlerId,Config) -> ok</name> + <fsummary>The given handler is about to be removed.</fsummary> + <type> + <v>HandlerId = + <seealso marker="#type-handler_id">handler_id()</seealso></v> + <v>Config = + <seealso marker="#type-config">config()</seealso></v> + </type> + <desc> + <p>This callback function is optional.</p> + <p>The function is called when a handler is about to be + removed, and the purpose is to release all resources used by + the handler. The return value is ignored by Logger.</p> + </desc> + </func> + + <func> + <name>Module:changing_config(HandlerId,Config1,Config2) -> {ok,Config3} | {error,Reason}</name> + <fsummary>The configuration for this handler is about to change.</fsummary> + <type> + <v>HandlerId = + <seealso marker="#type-handler_id">handler_id()</seealso></v> + <v>Config1 = Config2 = Config3 = + <seealso marker="#type-config">config()</seealso></v> + <v>Reason = term()</v> + </type> + <desc> + <p>This callback function is optional.</p> + <p>The function is called when the configuration for a handler + is about to change, and the purpose is to verify and act on + the new configuration.</p> + <p><c>Config1</c> is the existing configuration + and <c>Config2</c> is the new configuration.</p> + <p>If everything succeeds, the callback function must return a + possibly adjusted configuration in <c>{ok,Config3}</c>.</p> + <p>If the configuration is faulty, the callback function must + return <c>{error,Reason}</c>.</p> + </desc> + </func> + </funcs> </erlref> diff --git a/lib/kernel/doc/src/logger_chapter.xml b/lib/kernel/doc/src/logger_chapter.xml index 0374a0c93a..3150c5adb4 100644 --- a/lib/kernel/doc/src/logger_chapter.xml +++ b/lib/kernel/doc/src/logger_chapter.xml @@ -157,7 +157,7 @@ <p>A formatter is defined as a module exporting the following function:</p> - <code>format(Log,Extra) -> string()</code> + <code>format(Log,Extra) -> unicode:chardata()</code> <p>The formatter plugin is called by each handler, and the returned string can be printed to the handler's destination @@ -322,19 +322,6 @@ return <c>ignore</c>.</p> <p>Default is <c>log</c>.</p> </item> - <tag><c>depth = pos_integer() | unlimited</c></tag> - <item> - <p>Specifies if the depth of terms in the log events shall - be limited by using control characters <c>~P</c> - and <c>~W</c> instead of <c>~p</c> and <c>~w</c>, - respectively. See - <seealso marker="stdlib:io#format-1"><c>io:format</c></seealso>.</p> - </item> - <tag><c>max_size = pos_integer() | unlimited</c></tag> - <item> - <p>Specifies if the size of a log event shall be limited by - truncating the formatted string.</p> - </item> <tag><c>formatter = {Module::module(),Extra::term()}</c></tag> <item> <p>See <seealso marker="#Formatter">Formatter</seealso> for more @@ -347,10 +334,9 @@ <p>Note that <c>level</c> and <c>filters</c> are obeyed by Logger itself before forwarding the log events to each - handler, while <c>depth</c>, <c>max_size</c> - and <c>formatter</c> are left to the handler - implementation. All Logger's built-in handlers do apply these - configuration parameters before printing.</p> + handler, while <c>formatter</c> is left to the handler + implementation. All Logger's built-in handlers will call the + given formatter before printing.</p> </section> </section> @@ -488,8 +474,9 @@ error_logger:add_report_handler/1,2. level => debug} 2> <input>logger:add_handler(debug_handler,logger_std_h,Config).</input> ok</pre> - <p>By default, the handler receives all events, so we need to add a filter - to stop all non-debug events:</p> + <p>By default, the handler receives all events + (<c>filter_defalt=log</c>), so we need to add a filter to stop + all non-debug events:</p> <pre> 3> <input>Fun = fun(#{level:=debug}=Log,_) -> Log; (_,_) -> stop end.</input> #Fun<erl_eval.12.98642416> @@ -516,7 +503,7 @@ ok</pre> <p>It may also implement the following callbacks:</p> <code> adding_handler(logger:handler_id(),logger:config()) -> {ok,logger:config()} | {error,term()} -removing_handler(logger:handler_id()) -> ok +removing_handler(logger:handler_id(),logger:config()) -> ok changing_config(logger:handler_id(),logger:config(),logger:config()) -> {ok,logger:config()} | {error,term()} </code> <p>When logger:add_handler(Id,Module,Config) is called, logger @@ -526,7 +513,7 @@ changing_config(logger:handler_id(),logger:config(),logger:config()) -> {ok,logg events as calls to Module:log/2.</p> <p>A handler can be removed by calling logger:remove_handler(Id). logger will call - Module:removing_handler(Id), and then remove the handler's + Module:removing_handler(Id,Config), and then remove the handler's configuration from the configuration database.</p> <p>When logger:set_handler_config is called, logger calls Module:changing_config(Id,OldConfig,NewConfig). If this function @@ -539,19 +526,15 @@ changing_config(logger:handler_id(),logger:config(),logger:config()) -> {ok,logg -module(myhandler). -export([log/2]). -log(#{msg:={report,R}},_) -> - io:format("~p~n",[R]); -log(#{msg:={string,S}},_) -> - io:put_chars(S); -log(#{msg:={F,A}},_) -> - io:format(F,A). +log(Log,#{formatter:={FModule,FConfig}) -> + io:put_chars(FModule:format(Log,FConfig)). </code> <p>A simple handler which prints to file could be implemented like this:</p> <code> -module(myhandler). --export([adding_handler/2, removing_handler/1, log/2]). +-export([adding_handler/2, removing_handler/2, log/2]). -export([init/1, handle_call/3, handle_cast/2, terminate/2]). adding_handler(Id,Config) -> @@ -562,18 +545,13 @@ removing_handler(Id,#{myhandler_fd:=Fd}) -> _ = file:close(Fd), ok. -log(#{msg:={report,R}},#{myhandler_fd:=Fd}) -> - io:format(Fd,"~p~n",[R]); -log(#{msg:={string,S}},#{myhandler_fd:=Fd}) -> - io:put_chars(Fd,S); -log(#{msg:={F,A}},#{myhandler_fd:=Fd}) -> - io:format(Fd,F,A). +log(Log,#{myhandler_fd:=Fd,formatter:={FModule,FConfig}}) -> + io:put_chars(Fd,FModule:format(Log,FConfig)). </code> - <p>Note that none of the above handlers have any overload + <note><p>The above handlers do not have any overload protection, and all log events are printed directly from the - client process. Neither do the handlers use the formatter or - in any way add time or other metadata to the printed events.</p> + client process.</p></note> <p>For examples of overload protection, please refer to the implementation @@ -582,17 +560,10 @@ log(#{msg:={F,A}},#{myhandler_fd:=Fd}) -> </seealso>.</p> <p>Below is a simpler example of a handler which logs through one - single process, and uses the default formatter to gain a common - look of the log events.</p> - <p>It also uses the metadata field <c>report_cb</c>, if it exists, - to print reports in the way the event issuer suggests. The - formatter will normally do this, but if the handler either has - an own default (as in this example) or if the - given <c>report_cb</c> should not be used at all, then the - handler must take care of this itself.</p> + single process.</p> <code> -module(myhandler). --export([adding_handler/2, removing_handler/1, log/2]). +-export([adding_handler/2, removing_handler/2, log/2]). -export([init/1, handle_call/3, handle_cast/2, terminate/2]). adding_handler(Id,Config) -> @@ -620,16 +591,9 @@ terminate(Reason,#{fd:=Fd}) -> _ = file:close(Fd), ok. -do_log(Fd,#{msg:={report,R}} = Log, Config) -> - Fun = maps:get(report_cb,Config,fun my_report_cb/1, - {F,A} = Fun(R), - do_log(Fd,Log#{msg=>{F,A},Config); do_log(Fd,Log,#{formatter:={FModule,FConfig}}) -> String = FModule:format(Log,FConfig), io:put_chars(Fd,String). - -my_report_cb(R) -> - {"~p",[R]}. </code> </section> diff --git a/lib/kernel/doc/src/logger_filters.xml b/lib/kernel/doc/src/logger_filters.xml index d742391e35..c34ec7d14c 100644 --- a/lib/kernel/doc/src/logger_filters.xml +++ b/lib/kernel/doc/src/logger_filters.xml @@ -33,16 +33,20 @@ <file>logger_filters.xml</file> </header> <module>logger_filters</module> - <modulesummary>Filters to use with logger.</modulesummary> + <modulesummary>Filters to use with Logger.</modulesummary> <description> - <p>Filters to use with logger. All functions exported from this - module can be used as logger or handler + <p>All functions exported from this module can be used as logger + or handler filters. See <seealso marker="logger#add_logger_filter-2"> <c>logger:add_logger_filter/2</c></seealso> and <seealso marker="logger#add_handler_filter-3"> - <c>logger:add_handler_filter/3</c></seealso> - for more information about how filters are added.</p> + <c>logger:add_handler_filter/3</c></seealso> for more information + about how filters are added.</p> + <p>Filters are removed with <seealso marker="logger#remove_logger_filter-1"> + <c>logger:remove_logger_filter/1</c></seealso> + and <seealso marker="logger#remove_handler_filter-2"> + <c>logger:remove_handler_filter/2</c></seealso>.</p> </description> <funcs> diff --git a/lib/kernel/doc/src/logger_formatter.xml b/lib/kernel/doc/src/logger_formatter.xml index 6a17e3641f..7df4c88f40 100644 --- a/lib/kernel/doc/src/logger_formatter.xml +++ b/lib/kernel/doc/src/logger_formatter.xml @@ -33,12 +33,187 @@ <file>logger_formatter.xml</file> </header> <module>logger_formatter</module> - <modulesummary>Default formatter for the Logger application.</modulesummary> + <modulesummary>Default formatter for Logger.</modulesummary> <description> - <p>Default formatter for the Logger application.</p> + <p>Each log handler has a configured formatter specified as a + module and a configuration term. The purpose of the formatter is + to translate the log events to a final printable string + (<c>unicode:chardata()</c>) which can be written to the output + device of the handler.</p> + <p><c>logger_formatter</c> is the default formatter used by + Logger.</p> </description> + <section> + <title>Configuration</title> + <p>The configuration term for <c>logger_formatter</c> is a map, + and the following keys can be set as configuration + parameters:</p> + <taglist> + <tag><c>chars_limit = pos_integer() | unlimited</c></tag> + <item> + <p>A positive integer representing the value of the option + with the same name to be used when calling + <seealso marker="stdlib:io_lib#format-3">io_lib:format/3</seealso>. + This value limits the total number of characters printed + for each log event. Notice that this is a soft limit. For a + hard truncation limit, see option <c>max_size</c>.</p> + <p>Default is <c>unlimited</c>.</p> + <note> + <p><c>chars_limit</c> has no effect on log messages on + string form. These are expected to be short, but can still + be truncated by the <c>max_size</c> parameter.</p> + </note> + </item> + <tag><c>depth = pos_integer() | unlimited</c></tag> + <item> + <p>A positive integer representing the maximum depth to + which terms shall be printed by this formatter. Format + strings passed to this formatter are rewritten. The format + controls ~p and ~w are replaced with ~P and ~W, + respectively, and the value is used as the depth + parameter. For details, see + <seealso marker="stdlib:io#format-2">io:format/2,3</seealso> + in STDLIB.</p> + <p>Default is <c>unlimited</c>.</p> + <note> + <p><c>depth</c> has no effect on log messages on string + form. These are expected to be short, but can still be + truncated by the <c>max_size</c> parameter.</p> + </note> + </item> + <tag><c>max_size = pos_integer() | unlimited</c></tag> + <item> + <p>A positive integer representing the absolute maximum size a + string returned from this formatter can have. If the + formatted string is longer, after possibly being limited + by <c>chars_limit</c> or <c>depth</c>, it is truncated.</p> + <p>Default is <c>unlimited</c>.</p> + </item> + <tag><c>single_line = boolean()</c></tag> + <item> + <p>If set to <c>true</c>, all newlines in the message are + replaced with <c>", "</c>, and whitespaces following + directly after newlines are removed. Note that newlines + added by the <c>template</c> parameter are not replaced.</p> + <p>Default is <c>true</c>.</p> + </item> + <tag><c>legacy_header = boolen()</c></tag> + <item> + <p>If set to <c>true</c> a header field is added to + logger_formatter's part of <c>Metadata</c>. The value of + this field is a string similar to the header created by the + old <c>error_logger</c> event handlers. It can be included + in the log event by adding the + tuple <c>{logger_formatter,header}</c> to the template. See + section <seealso marker="#default_templates">Default + Templates</seealso> for more information.</p> + <p>Default is <c>false</c>.</p> + </item> + <tag><c>report_cb = fun((</c><seealso marker="logger#type-report"><c>logger:report()</c></seealso><c>) -> {</c><seealso marker="stdlib:io#type-format"><c>io:format()</c></seealso><c>,[term()]})</c></tag> + <item> + <p>A report callback is used by the formatter to transform log + messages on report form to a format string and + arguments. The report callback can be specified in the + metadata for the log event. If no report callback exist in + metadata, <c>logger_formatter</c> will + use <seealso marker="logger#format_report-1"> + <c>logger:format_report/1</c></seealso> as default + callback.</p> + <p>If this configuration parameter is set, it replaces both + the default report callback, and any report callback found + in metadata. That is, all reports are converted by this + configured function.</p> + <p>The value must be a function with arity 1, + returning <c>{Format,Args}</c>, and it will be called with a + report as only argument.</p> + </item> + <tag><c>template = </c><seealso marker="#type-template"><c>template()</c></seealso></tag> + <item> + <p>The template is a list of atoms, tuples and strings. The + atoms <c>level</c> or <c>msg</c>, are treated as + placeholders for the severity level and the log message, + repectively. Other atoms or tuples are interpreted as + placeholders for metadata, where atoms are expected to match + top level keys, and tuples represent paths to sub keys when + the metadata is a nested map. For example the + tuple <c>{key1,key2}</c> is replaced by the value of + the <c>key2</c> field in the nested map below. The + atom <c>key1</c> on its own is replaced by the complete + value of the <c>key1</c> field. The values are converted to + strings.</p> + +<code> +#{key1=>#{key2=>my_value, + ...} + ...}</code> + + <p>Strings in the template are printed literally.</p> + <p>The default template differs depending on the values + of <c>legacy_header</c> + and <c>single_line</c>. See <seealso marker="#default_templates">Default + Templates</seealso> for more information</p> + </item> + <tag><c>utc = boolean()</c></tag> + <item> + <p>If set to <c>true</c>, all dates are displayed in Universal + Coordinated Time.</p> + <p>Default is <c>false</c>.</p> + </item> + </taglist> + </section> + + <section> + <marker id="default_templates"/> + <title>Default templates</title> + + <p>The default value for the <c>template</c> configuration + parameter depends on the value of <c>single_line</c> + and <c>legacy_header</c> as follows.</p> + + <p>The log event used in the examples is:</p> + <code> +?LOG_ERROR("name: ~p~nexit_reason: ~p",[my_reg_name,"It crashed"])</code> + + <taglist> + <tag><c>legacy_header=true</c></tag> + <item> + <p>Default template: <c>[{logger_formatter,header},"\n",msg,"\n"]</c></p> + + <p>Example log entry:</p> + <code> +=ERROR REPORT==== 29-Dec-2017::13:30:51.245123 === +name: my_reg_name +exit_reason: "It crashed"</code> + + <p>Notice that all eight levels might occur in the heading, + not only <c>ERROR</c>, <c>WARNING</c> or <c>INFO</c> as the + old <c>error_logger</c> produced. And microseconds are + added at the end of the timestamp.</p> + </item> + + <tag><c>single_line=true</c></tag> + <item> + <p>Default template: <c>[time," ",level,": ",msg,"\n"]</c></p> + + <p>Example log entry:</p> + <code>2017-12-29 13:31:49.640317 error: name: my_reg_name, exit_reason: "It crashed"</code> + </item> + + <tag><c>legacy_header=false, single_line=false</c></tag> + <item> + <p>Default template: <c>[time," ",level,":\n",msg,"\n"]</c></p> + + <p>Example log entry:</p> + <code> +2017-12-29 13:32:25.191925 error: +name: my_reg_name +exit_reason: "It crashed"</code> + </item> + </taglist> + </section> + <datatypes> <datatype> <name name="template"/> @@ -52,101 +227,22 @@ <name name="format" arity="2"/> <fsummary>Formats the given message.</fsummary> <desc> - <p>Formats the given message.</p> - <p>The template is a list of atoms, tuples and strings. Atoms - can be <c>level</c> or <c>msg</c>, which are placeholders - for the severity level and the log message, - repectively. Tuples are interpreted as placeholders for - metadata. Each element in the tuple must be an atom which - matches a key in the nested metadata map, e.g. the - tuple <c>{key1,key2}</c> will be replaced by the value of - the key2 field in this nested map (the value vill be - converted to a string):</p> - -<code> -#{key1=>#{key2=>my_value, - ...}, - ...}</code> - - - <p> Strings are printed literally.</p> - - <p><c>depth</c> is a positive integer representing the maximum - depth to which terms shall be printed by this - formatter. Format strings passed to this formatter are - rewritten. The format controls ~p and ~w are replaced with - ~P and ~W, respectively, and the value is used as the depth - parameter. For details, see - <seealso marker="stdlib:io#format-2">io:format/2,3</seealso> - in STDLIB.</p> - - <p><c>chars_limit</c> is a positive integer representing the - value of the option with the same name to be used when calling - <seealso marker="stdlib:io#format-3">io:format/3</seealso>. This - value limits the total number of characters printed bu the - formatter. Notes that this is a soft limit. For a hard - truncation limit, see option <c>max_size</c>.</p> - - <p><c>max_size</c> is a positive integer representing the - maximum size a string returned from this formatter can - have. If the formatted string is longer, after possibly - being limited by <c>depth</c> and/or <c>chars_limit</c>, it - will be truncated.</p> - - <p><c>utc</c> is a boolean. If set to true, all dates are - displayed in Universal Coordinated Time. Default - is <c>false</c>.</p> - - <p><c>report_cb</c> must be a function with arity 1, - returning <c>{Format,Args}</c>. This function will replace - any <c>report_cb</c> found in metadata.</p> - - <p>If <c>single_line=true</c>, all newlines in the message are - replaced with <c>", "</c>, and whitespaces following directly - after newlines are removed. Note that newlines added by the - formatter template are not replaced.</p> - - <p>If <c>legacy_header=true</c> a header field is added to - logger_formatter's part of <c>Metadata</c>. The value of - this field is a string similar to the header created by the - old <c>error_logger</c> event handlers. It can be included - in the log event by adding the - tuple <c>{logger_formatter,header}</c> to the template.</p> - - <p>The default template when <c>legacy_header=true</c> is</p> - - <code>[{logger_formatter,header},"\n",msg,"\n"]</code> - - <p>which will cause log entries like this:</p> - - <code>=ERROR REPORT==== 29-Dec-2017::13:30:51.245123 === - process: <0.74.0> - exit_reason: "Something went wrong"</code> - - <p>Note that all eight levels might occur here, not - only <c>ERROR</c>, <c>WARNING</c> or <c>INFO</c>. And also - that micro seconds are added at the end of the - timestamp.</p> - - <p>The default template when <c>single_line=true</c> is</p> - - <code>[time," ",level,": ",msg,"\n"]</code> - - <p>which will cause log entries like this:</p> - - <code>2017-12-29 13:31:49.640317 error: process: <0.74.0>, exit_reason: "Something went wrong"</code> - - <p>The default template when both <c>legacy_header</c> and - <c>single_line</c> are set to false is:</p> - - <code>[time," ",level,":\n",msg,"\n"]</code> - - <p>which will cause log entries like this:</p> - - <code>2017-12-29 13:32:25.191925 error: - process: <0.74.0> - exit_reason: "Something went wrong"</code> - + <p>This the formatter callback function to be called from + handlers. The log event is processed as follows:</p> + <list> + <item>If the message is on report form, it is converted to + <c>{Format,Args}</c> by calling the report + callback.</item> + <item>The size is limited according to the values of + configuration parameters <c>chars_limit</c> + and <c>depth</c>. Notice that this does not apply to + messages on string form.</item> + <item>The full log entry is composed according to + the <c>template</c>.</item> + <item>If the final string is too long, it is truncated + according to the value of configuration + parameter <c>max_size</c>.</item> + </list> </desc> </func> diff --git a/lib/kernel/doc/src/ref_man.xml b/lib/kernel/doc/src/ref_man.xml index c06914d23d..a633ae4832 100644 --- a/lib/kernel/doc/src/ref_man.xml +++ b/lib/kernel/doc/src/ref_man.xml @@ -38,6 +38,7 @@ <xi:include href="disk_log.xml"/> <xi:include href="erl_boot_server.xml"/> <xi:include href="erl_ddll.xml"/> + <xi:include href="erl_epmd.xml"/> <xi:include href="erl_prim_loader_stub.xml"/> <xi:include href="erlang_stub.xml"/> <xi:include href="error_handler.xml"/> diff --git a/lib/kernel/doc/src/specs.xml b/lib/kernel/doc/src/specs.xml index bcc422930e..b8c25ca53b 100644 --- a/lib/kernel/doc/src/specs.xml +++ b/lib/kernel/doc/src/specs.xml @@ -6,6 +6,7 @@ <xi:include href="../specs/specs_disk_log.xml"/> <xi:include href="../specs/specs_erl_boot_server.xml"/> <xi:include href="../specs/specs_erl_ddll.xml"/> + <xi:include href="../specs/specs_erl_epmd.xml"/> <xi:include href="../specs/specs_erl_prim_loader_stub.xml"/> <xi:include href="../specs/specs_erlang_stub.xml"/> <xi:include href="../specs/specs_error_handler.xml"/> diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 702845512c..eeb8c6ab2f 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -146,7 +146,7 @@ HRL_FILES= ../include/file.hrl ../include/inet.hrl ../include/inet_sctp.hrl \ ../include/net_address.hrl ../include/logger.hrl INTERNAL_HRL_FILES= application_master.hrl disk_log.hrl \ - erl_epmd.hrl hipe_ext_format.hrl \ + erl_epmd.hrl file_int.hrl hipe_ext_format.hrl \ inet_dns.hrl inet_res.hrl \ inet_boot.hrl inet_config.hrl inet_int.hrl \ inet_dns_record_adts.hrl \ diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl index b9cb722575..ff5df667b5 100644 --- a/lib/kernel/src/application_controller.erl +++ b/lib/kernel/src/application_controller.erl @@ -1272,9 +1272,7 @@ load(S, {ApplData, ApplEnv, IncApps, Descr, Id, Vsn, Apps}) -> NewEnv = merge_app_env(ApplEnv, ConfEnv), CmdLineEnv = get_cmd_env(Name), NewEnv2 = merge_app_env(NewEnv, CmdLineEnv), - NewEnv3 = keyreplaceadd(included_applications, 1, NewEnv2, - {included_applications, IncApps}), - add_env(Name, NewEnv3), + add_env(Name, NewEnv2), Appl = #appl{name = Name, descr = Descr, id = Id, vsn = Vsn, appl_data = ApplData, inc_apps = IncApps, apps = Apps}, ets:insert(ac_tab, {{loaded, Name}, Appl}), @@ -1292,7 +1290,7 @@ load(S, {ApplData, ApplEnv, IncApps, Descr, Id, Vsn, Apps}) -> {ok, NewS}. unload(AppName, S) -> - {ok, IncApps} = get_env(AppName, included_applications), + {ok, IncApps} = get_key(AppName, included_applications), del_env(AppName), ets:delete(ac_tab, {loaded, AppName}), foldl(fun(App, S1) -> @@ -1583,13 +1581,9 @@ do_change_appl({ok, {ApplData, Env, IncApps, Descr, Id, Vsn, Apps}}, CmdLineEnv = get_cmd_env(AppName), NewEnv2 = merge_app_env(NewEnv1, CmdLineEnv), - %% included_apps is made into an env parameter as well - NewEnv3 = keyreplaceadd(included_applications, 1, NewEnv2, - {included_applications, IncApps}), - %% Update ets table with new application env del_env(AppName), - add_env(AppName, NewEnv3), + add_env(AppName, NewEnv2), OldAppl#appl{appl_data=ApplData, descr=Descr, diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl index f96bc88913..9a0939972d 100644 --- a/lib/kernel/src/erl_epmd.erl +++ b/lib/kernel/src/erl_epmd.erl @@ -29,10 +29,20 @@ -define(port_please_failure2(Term), noop). -endif. +-ifndef(erlang_daemon_port). +-define(erlang_daemon_port, 4369). +-endif. +-ifndef(epmd_dist_high). +-define(epmd_dist_high, 4370). +-endif. +-ifndef(epmd_dist_low). +-define(epmd_dist_low, 4370). +-endif. + %% External exports -export([start/0, start_link/0, stop/0, port_please/2, port_please/3, names/0, names/1, - register_node/2, register_node/3, open/0, open/1, open/2]). + register_node/2, register_node/3, address_please/3, open/0, open/1, open/2]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, @@ -53,7 +63,7 @@ start() -> gen_server:start({local, erl_epmd}, ?MODULE, [], []). - +-spec start_link() -> {ok, pid()} | ignore | {error,term()}. start_link() -> gen_server:start_link({local, erl_epmd}, ?MODULE, [], []). @@ -66,9 +76,22 @@ stop() -> %% return {port, P, Version} | noport %% +-spec port_please(Name, Host) -> {ok, Port, Version} | noport when + Name :: string(), + Host :: inet:ip_address(), + Port :: non_neg_integer(), + Version :: non_neg_integer(). + port_please(Node, Host) -> port_please(Node, Host, infinity). +-spec port_please(Name, Host, Timeout) -> {ok, Port, Version} | noport when + Name :: string(), + Host :: inet:ip_address(), + Timeout :: non_neg_integer() | infinity, + Port :: non_neg_integer(), + Version :: non_neg_integer(). + port_please(Node,HostName, Timeout) when is_atom(HostName) -> port_please1(Node,atom_to_list(HostName), Timeout); port_please(Node,HostName, Timeout) when is_list(HostName) -> @@ -92,10 +115,21 @@ port_please1(Node,HostName, Timeout) -> Else end. +-spec names() -> {ok, [{Name, Port}]} | {error, Reason} when + Name :: string(), + Port :: non_neg_integer(), + Reason :: address | file:posix(). + names() -> {ok, H} = inet:gethostname(), names(H). +-spec names(Host) -> {ok, [{Name, Port}]} | {error, Reason} when + Host :: atom() | string() | inet:ip_address(), + Name :: string(), + Port :: non_neg_integer(), + Reason :: address | file:posix(). + names(HostName) when is_atom(HostName); is_list(HostName) -> case inet:gethostbyname(HostName) of {ok,{hostent, _Name, _ , _Af, _Size, [EpmdAddr | _]}} -> @@ -106,9 +140,22 @@ names(HostName) when is_atom(HostName); is_list(HostName) -> names(EpmdAddr) -> get_names(EpmdAddr). +-spec register_node(Name, Port) -> Result when + Name :: string(), + Port :: non_neg_integer(), + Creation :: non_neg_integer(), + Result :: {ok, Creation} | {error, already_registered} | term(). register_node(Name, PortNo) -> - register_node(Name, PortNo, inet). + register_node(Name, PortNo, inet). + +-spec register_node(Name, Port, Driver) -> Result when + Name :: string(), + Port :: non_neg_integer(), + Driver :: inet_tcp | inet6_tcp | inet | inet6, + Creation :: non_neg_integer(), + Result :: {ok, Creation} | {error, already_registered} | term(). + register_node(Name, PortNo, inet_tcp) -> register_node(Name, PortNo, inet); register_node(Name, PortNo, inet6_tcp) -> @@ -116,6 +163,17 @@ register_node(Name, PortNo, inet6_tcp) -> register_node(Name, PortNo, Family) -> gen_server:call(erl_epmd, {register, Name, PortNo, Family}, infinity). +-spec address_please(Name, Host, AddressFamily) -> Success | {error, term()} when + Name :: string(), + Host :: string() | inet:ip_address(), + AddressFamily :: inet | inet6, + Port :: non_neg_integer(), + Version :: non_neg_integer(), + Success :: {ok, inet:ip_address()} | {ok, inet:ip_address(), Port, Version}. + +address_please(_Name, Host, AddressFamily) -> + inet:getaddr(Host, AddressFamily). + %%%---------------------------------------------------------------------- %%% Callback functions from gen_server %%%---------------------------------------------------------------------- diff --git a/lib/kernel/src/erl_signal_handler.erl b/lib/kernel/src/erl_signal_handler.erl index 22f235d4e4..b76c2a217a 100644 --- a/lib/kernel/src/erl_signal_handler.erl +++ b/lib/kernel/src/erl_signal_handler.erl @@ -19,12 +19,21 @@ -module(erl_signal_handler). -behaviour(gen_event). --export([init/1, format_status/2, +-export([start/0, init/1, format_status/2, handle_event/2, handle_call/2, handle_info/2, terminate/2, code_change/3]). -record(state,{}). +start() -> + %% add signal handler + case whereis(erl_signal_server) of + %% in case of minimal mode + undefined -> ok; + _ -> + gen_event:add_handler(erl_signal_server, erl_signal_handler, []) + end. + init(_Args) -> {ok, #state{}}. diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl index 0706220a94..47d0ca5ea3 100644 --- a/lib/kernel/src/error_logger.erl +++ b/lib/kernel/src/error_logger.erl @@ -32,7 +32,7 @@ which_report_handlers/0]). %% logger callbacks --export([adding_handler/2, removing_handler/1, log/2]). +-export([adding_handler/2, removing_handler/2, log/2]). -export([get_format_depth/0, limit_term/1]). @@ -111,8 +111,8 @@ adding_handler(?MODULE,Config) -> Error end. --spec removing_handler(logger:handler_id()) -> ok. -removing_handler(?MODULE) -> +-spec removing_handler(logger:handler_id(),logger:config()) -> ok. +removing_handler(?MODULE,_Config) -> stop(), ok. diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index fd06f0f7d8..5704cc79c2 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -453,7 +453,7 @@ make_beam_stub(Mod, LoaderState, MD5, Beam, FunDefs, ClosuresToPatch) -> %%======================================================================== %% Patching %% @spec patch(refs(), BaseAddress::integer(), ConstAndZone::term(), -%% FunDefs::term(), TrampolineMap::term()) -> 'ok'. +%% FunDefs::term(), TrampolineMap::term()) -> 'ok' %% @type refs()=[{RefType::integer(), Reflist::reflist()} | refs()] %% %% @type reflist()= [{Data::term(), Offsets::offests()}|reflist()] diff --git a/lib/kernel/src/inet_tcp_dist.erl b/lib/kernel/src/inet_tcp_dist.erl index e3fdb1bb22..b4b50899f7 100644 --- a/lib/kernel/src/inet_tcp_dist.erl +++ b/lib/kernel/src/inet_tcp_dist.erl @@ -283,73 +283,22 @@ do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> ?trace("~p~n",[{inet_tcp_dist,self(),setup,Node}]), [Name, Address] = splitnode(Driver, Node, LongOrShortNames), AddressFamily = Driver:family(), - case inet:getaddr(Address, AddressFamily) of + ErlEpmd = net_kernel:epmd_module(), + {ARMod, ARFun} = get_address_resolver(ErlEpmd), + Timer = dist_util:start_timer(SetupTime), + case ARMod:ARFun(Name, Address, AddressFamily) of + {ok, Ip, TcpPort, Version} -> + ?trace("address_please(~p) -> version ~p~n", + [Node,Version]), + do_setup_connect(Driver, Kernel, Node, Address, AddressFamily, + Ip, TcpPort, Version, Type, MyNode, Timer); {ok, Ip} -> - Timer = dist_util:start_timer(SetupTime), - ErlEpmd = net_kernel:epmd_module(), case ErlEpmd:port_please(Name, Ip) of {port, TcpPort, Version} -> ?trace("port_please(~p) -> version ~p~n", [Node,Version]), - dist_util:reset_timer(Timer), - case - Driver:connect( - Ip, TcpPort, - connect_options([{active, false}, {packet, 2}])) - of - {ok, Socket} -> - HSData = #hs_data{ - kernel_pid = Kernel, - other_node = Node, - this_node = MyNode, - socket = Socket, - timer = Timer, - this_flags = 0, - other_version = Version, - f_send = fun Driver:send/2, - f_recv = fun Driver:recv/3, - f_setopts_pre_nodeup = - fun(S) -> - inet:setopts - (S, - [{active, false}, - {packet, 4}, - nodelay()]) - end, - f_setopts_post_nodeup = - fun(S) -> - inet:setopts - (S, - [{active, true}, - {deliver, port}, - {packet, 4}, - nodelay()]) - end, - - f_getll = fun inet:getll/1, - f_address = - fun(_,_) -> - #net_address{ - address = {Ip,TcpPort}, - host = Address, - protocol = tcp, - family = AddressFamily} - end, - mf_tick = fun(S) -> ?MODULE:tick(Driver, S) end, - mf_getstat = fun ?MODULE:getstat/1, - request_type = Type, - mf_setopts = fun ?MODULE:setopts/2, - mf_getopts = fun ?MODULE:getopts/2 - }, - dist_util:handshake_we_started(HSData); - _ -> - %% Other Node may have closed since - %% port_please ! - ?trace("other node (~p) " - "closed since port_please.~n", - [Node]), - ?shutdown(Node) - end; + do_setup_connect(Driver, Kernel, Node, Address, AddressFamily, + Ip, TcpPort, Version, Type, MyNode, Timer); _ -> ?trace("port_please (~p) " "failed.~n", [Node]), @@ -361,6 +310,71 @@ do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> ?shutdown(Node) end. +%% +%% Actual setup of connection +%% +do_setup_connect(Driver, Kernel, Node, Address, AddressFamily, + Ip, TcpPort, Version, Type, MyNode, Timer) -> + dist_util:reset_timer(Timer), + case + Driver:connect( + Ip, TcpPort, + connect_options([{active, false}, {packet, 2}])) + of + {ok, Socket} -> + HSData = #hs_data{ + kernel_pid = Kernel, + other_node = Node, + this_node = MyNode, + socket = Socket, + timer = Timer, + this_flags = 0, + other_version = Version, + f_send = fun Driver:send/2, + f_recv = fun Driver:recv/3, + f_setopts_pre_nodeup = + fun(S) -> + inet:setopts + (S, + [{active, false}, + {packet, 4}, + nodelay()]) + end, + f_setopts_post_nodeup = + fun(S) -> + inet:setopts + (S, + [{active, true}, + {deliver, port}, + {packet, 4}, + nodelay()]) + end, + + f_getll = fun inet:getll/1, + f_address = + fun(_,_) -> + #net_address{ + address = {Ip,TcpPort}, + host = Address, + protocol = tcp, + family = AddressFamily} + end, + mf_tick = fun(S) -> ?MODULE:tick(Driver, S) end, + mf_getstat = fun ?MODULE:getstat/1, + request_type = Type, + mf_setopts = fun ?MODULE:setopts/2, + mf_getopts = fun ?MODULE:getopts/2 + }, + dist_util:handshake_we_started(HSData); + _ -> + %% Other Node may have closed since + %% discovery ! + ?trace("other node (~p) " + "closed since discovery (port_please).~n", + [Node]), + ?shutdown(Node) + end. + connect_options(Opts) -> case application:get_env(kernel, inet_dist_connect_options) of {ok,ConnectOpts} -> @@ -430,6 +444,16 @@ get_tcp_address(Driver, Socket) -> }. %% ------------------------------------------------------------ +%% Determine if EPMD module supports address resolving. Default +%% is to use inet:getaddr/2. +%% ------------------------------------------------------------ +get_address_resolver(EpmdModule) -> + case erlang:function_exported(EpmdModule, address_please, 3) of + true -> {EpmdModule, address_please}; + _ -> {inet, getaddr} + end. + +%% ------------------------------------------------------------ %% Do only accept new connection attempts from nodes at our %% own LAN, if the check_ip environment parameter is true. %% ------------------------------------------------------------ diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl index 20aa47f602..ae982c1741 100644 --- a/lib/kernel/src/kernel.erl +++ b/lib/kernel/src/kernel.erl @@ -32,13 +32,7 @@ start(_, []) -> case supervisor:start_link({local, kernel_sup}, kernel, []) of {ok, Pid} -> - %% add signal handler - case whereis(erl_signal_server) of - %% in case of minimal mode - undefined -> ok; - _ -> - ok = gen_event:add_handler(erl_signal_server, erl_signal_handler, []) - end, + ok = erl_signal_handler:start(), %% add error handler case logger:setup_standard_handler() of ok -> {ok, Pid, []}; diff --git a/lib/kernel/src/kernel_config.erl b/lib/kernel/src/kernel_config.erl index 535083ef27..c5ff1887c2 100644 --- a/lib/kernel/src/kernel_config.erl +++ b/lib/kernel/src/kernel_config.erl @@ -30,11 +30,8 @@ %%%----------------------------------------------------------------- %%% This module implements a process that configures the kernel %%% application. -%%% Its purpose is that in the init phase add an error_logger -%%% and when it dies (when the kernel application dies) deleting the -%%% previously installed error_logger. -%%% Also, this process waits for other nodes at startup, if -%%% specified. +%%% Its purpose is that in the init phase waits for other nodes at startup, +%%% if specified. %%%----------------------------------------------------------------- start_link() -> gen_server:start_link(kernel_config, [], []). diff --git a/lib/kernel/src/logger.erl b/lib/kernel/src/logger.erl index 943ef8c2d1..98a9937111 100644 --- a/lib/kernel/src/logger.erl +++ b/lib/kernel/src/logger.erl @@ -44,8 +44,8 @@ %% Misc -export([compare_levels/2]). --export([set_process_metadata/1, unset_process_metadata/0, - get_process_metadata/0]). +-export([set_process_metadata/1, update_process_metadata/1, + unset_process_metadata/0, get_process_metadata/0]). -export([i/0, i/1]). -export([setup_standard_handler/0, replace_simple_handler/3]). -export([limit_term/1, get_format_depth/0, get_max_size/0, get_utc_config/0]). @@ -60,27 +60,41 @@ %%%----------------------------------------------------------------- %%% Types --type log() :: #{level=>level(), - msg=>{io:format(),[term()]} | +-type log() :: #{level:=level(), + msg:={io:format(),[term()]} | {report,report()} | {string,unicode:chardata()}, - meta=>metadata()}. + meta:=metadata()}. -type level() :: emergency | alert | critical | error | warning | notice | info | debug. -type report() :: map() | [{atom(),term()}]. -type msg_fun() :: fun((term()) -> {io:format(),[term()]} | report() | unicode:chardata()). --type metadata() :: map(). - +-type metadata() :: #{pid => pid(), + gl => pid(), + time => timestamp(), + mfa => {module(),atom(),non_neg_integer()}, + file => file:filename(), + line => non_neg_integer(), + term() => term()}. +-type location() :: #{mfa := {module(),atom(),non_neg_integer()}, + file := file:filename(), + line := non_neg_integer()}. -type handler_id() :: atom(). -type filter_id() :: atom(). --type filter() :: {fun((log(),term()) -> filter_return()),term()}. +-type filter() :: {fun((log(),filter_arg()) -> filter_return()),filter_arg()}. +-type filter_arg() :: term(). -type filter_return() :: stop | ignore | log(). --type config() :: map(). +-type config() :: #{level => level(), + filter_default => log | stop, + filters => [{filter_id(),filter()}], + formatter => {module(),term()}, + term() => term()}. +-type timestamp() :: integer(). -export_type([log/0,level/0,report/0,msg_fun/0,metadata/0,config/0,handler_id/0, - filter_id/0,filter/0,filter_return/0]). + filter_id/0,filter/0,filter_arg/0,filter_return/0]). %%%----------------------------------------------------------------- %%% API @@ -185,24 +199,24 @@ allow(Level,Module) when ?IS_LEVEL(Level), is_atom(Module) -> -spec macro_log(Location,Level,StringOrReport) -> ok when - Location :: map(), + Location :: location(), Level :: level(), StringOrReport :: unicode:chardata() | report(). macro_log(Location,Level,StringOrReport) -> log_allowed(Location,Level,StringOrReport,#{}). -spec macro_log(Location,Level,StringOrReport,Meta) -> ok when - Location :: map(), + Location :: location(), Level :: level(), StringOrReport :: unicode:chardata() | report(), Meta :: metadata(); (Location,Level,Format,Args) -> ok when - Location :: map(), + Location :: location(), Level :: level(), Format :: io:format(), Args ::[term()]; (Location,Level,Fun,FunArgs) -> ok when - Location :: map(), + Location :: location(), Level :: level(), Fun :: msg_fun(), FunArgs :: term(). @@ -213,13 +227,13 @@ macro_log(Location,Level,FunOrFormat,Args) -> log_allowed(Location,Level,{FunOrFormat,Args},#{}). -spec macro_log(Location,Level,Format,Args,Meta) -> ok when - Location :: map(), + Location :: location(), Level :: level(), Format :: io:format(), Args ::[term()], Meta :: metadata(); (Location,Level,Fun,FunArgs,Meta) -> ok when - Location :: map(), + Location :: location(), Level :: level(), Fun :: msg_fun(), FunArgs :: term(), @@ -390,6 +404,19 @@ set_process_metadata(Meta) when is_map(Meta) -> set_process_metadata(Meta) -> erlang:error(badarg,[Meta]). +-spec update_process_metadata(Meta) -> ok when + Meta :: metadata(). +update_process_metadata(Meta) when is_map(Meta) -> + case get_process_metadata() of + undefined -> + set_process_metadata(Meta); + Meta0 when is_map(Meta0) -> + set_process_metadata(maps:merge(Meta0,Meta)), + ok + end; +update_process_metadata(Meta) -> + erlang:error(badarg,[Meta]). + -spec get_process_metadata() -> Meta | undefined when Meta :: metadata(). get_process_metadata() -> @@ -699,7 +726,7 @@ do_log_1(Level,Msg,Meta) -> end. -spec log_allowed(Location,Level,Msg,Meta) -> ok when - Location :: map(), + Location :: location() | #{}, Level :: level(), Msg :: {msg_fun(),term()} | {io:format(),[term()]} | diff --git a/lib/kernel/src/logger_disk_log_h.erl b/lib/kernel/src/logger_disk_log_h.erl index eaa5cd6f99..57c54ce27e 100644 --- a/lib/kernel/src/logger_disk_log_h.erl +++ b/lib/kernel/src/logger_disk_log_h.erl @@ -34,7 +34,7 @@ %% logger callbacks -export([log/2, - adding_handler/2, removing_handler/1, + adding_handler/2, removing_handler/2, changing_config/3, swap_buffer/2]). %%%=================================================================== @@ -223,7 +223,7 @@ check_my_config([]) -> %%%----------------------------------------------------------------- %%% Handler being removed -removing_handler(Name) -> +removing_handler(Name, _Config) -> stop(Name). %%%----------------------------------------------------------------- diff --git a/lib/kernel/src/logger_formatter.erl b/lib/kernel/src/logger_formatter.erl index 386e7832e2..8e954f8d98 100644 --- a/lib/kernel/src/logger_formatter.erl +++ b/lib/kernel/src/logger_formatter.erl @@ -29,7 +29,7 @@ %%%----------------------------------------------------------------- %%% API --spec format(Log,Config) -> String when +-spec format(Log,Config) -> unicode:chardata() when Log :: logger:log(), Config :: #{single_line=>boolean(), legacy_header=>boolean(), @@ -38,8 +38,7 @@ max_size=>pos_integer() | unlimited, depth=>pos_integer() | unlimited, template=>template(), - utc=>boolean()}, - String :: string(). + utc=>boolean()}. format(#{level:=Level,msg:=Msg0,meta:=Meta},Config0) when is_map(Config0) -> Config = add_default_config(Config0), @@ -263,7 +262,7 @@ utcstr(_) -> "". add_default_config(#{utc:=_}=Config0) -> Default = #{legacy_header=>false, - single_line=>false, + single_line=>true, chars_limit=>unlimited}, MaxSize = get_max_size(maps:get(max_size,Config0,false)), Depth = get_depth(maps:get(depth,Config0,false)), diff --git a/lib/kernel/src/logger_internal.hrl b/lib/kernel/src/logger_internal.hrl index 82df499c2b..8c0fc2725d 100644 --- a/lib/kernel/src/logger_internal.hrl +++ b/lib/kernel/src/logger_internal.hrl @@ -31,6 +31,7 @@ {no_domain,{fun logger_filters:domain/2,{log,no_domain,[]}}}]). -define(DEFAULT_FORMATTER,logger_formatter). -define(DEFAULT_FORMAT_CONFIG,#{legacy_header=>true, + single_line=>false, template=>?DEFAULT_FORMAT_TEMPLATE_HEADER}). -define(DEFAULT_FORMAT_TEMPLATE_HEADER, [{logger_formatter,header},"\n",msg,"\n"]). diff --git a/lib/kernel/src/logger_server.erl b/lib/kernel/src/logger_server.erl index 6ef3b8582a..a7f302ac8f 100644 --- a/lib/kernel/src/logger_server.erl +++ b/lib/kernel/src/logger_server.erl @@ -158,7 +158,7 @@ handle_call({remove_handler,HandlerId}, _From, #state{tid=Tid}=State) -> Handlers0 = maps:get(handlers,Config,[]), Handlers = lists:delete(HandlerId,Handlers0), %% inform the handler - _ = call_h(Module,removing_handler,[HandlerId],ok), + _ = call_h(Module,removing_handler,[HandlerId,Config],ok), do_set_config(Tid,logger,Config#{handlers=>Handlers}), logger_config:delete(Tid,HandlerId), ok; @@ -234,7 +234,13 @@ handle_info({log,Level,Report,Meta}, State) -> {noreply, State}; handle_info({Ref,_Reply},State) when is_reference(Ref) -> %% Assuming this is a timed-out gen_server reply - ignoring - {noreply, State}. + {noreply, State}; +handle_info(Unexpected,State) -> + ?LOG_INTERNAL(debug, + [{logger,got_unexpected_message}, + {process,?SERVER}, + {message,Unexpected}]), + {noreply,State}. terminate(_Reason, _State) -> ok. diff --git a/lib/kernel/src/logger_simple.erl b/lib/kernel/src/logger_simple.erl index 23ff6ccd2e..a1b427b96c 100644 --- a/lib/kernel/src/logger_simple.erl +++ b/lib/kernel/src/logger_simple.erl @@ -19,7 +19,7 @@ %% -module(logger_simple). --export([adding_handler/2, removing_handler/1, log/2]). +-export([adding_handler/2, removing_handler/2, log/2]). -export([get_buffer/0]). %% This module implements a simple handler for logger. It is the @@ -63,7 +63,7 @@ adding_handler(?MODULE,Config) -> {error,{handler_process_name_already_exists,?MODULE}} end. -removing_handler(?MODULE) -> +removing_handler(?MODULE,_Config) -> case whereis(?MODULE) of undefined -> ok; diff --git a/lib/kernel/src/logger_std_h.erl b/lib/kernel/src/logger_std_h.erl index 813fbad0ed..e5e0febc88 100644 --- a/lib/kernel/src/logger_std_h.erl +++ b/lib/kernel/src/logger_std_h.erl @@ -35,7 +35,7 @@ terminate/2, code_change/3]). %% logger callbacks --export([log/2, adding_handler/2, removing_handler/1, +-export([log/2, adding_handler/2, removing_handler/2, changing_config/3, swap_buffer/2]). %%%=================================================================== @@ -207,7 +207,7 @@ check_my_config([]) -> %%%----------------------------------------------------------------- %%% Handler being removed -removing_handler(Name) -> +removing_handler(Name,_Config) -> stop(Name). %%%----------------------------------------------------------------- diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl index c00fb44c46..988f26280f 100644 --- a/lib/kernel/test/application_SUITE.erl +++ b/lib/kernel/test/application_SUITE.erl @@ -1603,8 +1603,7 @@ get_key(Conf) when is_list(Conf) -> {ok, [{init, [kalle]}, {takeover, []}, {go, [sune]}]} = rpc:call(Cp1, application, get_key, [appinc, start_phases]), {ok, Env} = rpc:call(Cp1, application, get_key, [appinc ,env]), - [{included_applications,[appinc1,appinc2]}, - {own2,val2},{own_env1,value1}] = lists:sort(Env), + [{own2,val2},{own_env1,value1}] = lists:sort(Env), {ok, []} = rpc:call(Cp1, application, get_key, [appinc, modules]), {ok, {application_starter, [ch_sup, {appinc, 41, 43}] }} = rpc:call(Cp1, application, get_key, [appinc, mod]), @@ -1625,8 +1624,7 @@ get_key(Conf) when is_list(Conf) -> {mod, {application_starter, [ch_sup, {appinc, 41, 43}] }}, {start_phases, [{init, [kalle]}, {takeover, []}, {go, [sune]}]}]} = rpc:call(Cp1, application, get_all_key, [appinc]), - [{included_applications,[appinc1,appinc2]}, - {own2,val2},{own_env1,value1}] = lists:sort(Env), + [{own2,val2},{own_env1,value1}] = lists:sort(Env), {ok, "Test of new app file, including appnew"} = gen_server:call({global, {ch,41}}, {get_pid_key, description}), @@ -1643,8 +1641,7 @@ get_key(Conf) when is_list(Conf) -> {ok, [{init, [kalle]}, {takeover, []}, {go, [sune]}]} = gen_server:call({global, {ch,41}}, {get_pid_key, start_phases}), {ok, Env} = gen_server:call({global, {ch,41}}, {get_pid_key, env}), - [{included_applications,[appinc1,appinc2]}, - {own2,val2},{own_env1,value1}] = lists:sort(Env), + [{own2,val2},{own_env1,value1}] = lists:sort(Env), {ok, []} = gen_server:call({global, {ch,41}}, {get_pid_key, modules}), {ok, {application_starter, [ch_sup, {appinc, 41, 43}] }} = @@ -1671,8 +1668,7 @@ get_key(Conf) when is_list(Conf) -> {mod, {application_starter, [ch_sup, {appinc, 41, 43}] }}, {start_phases, [{init, [kalle]}, {takeover, []}, {go, [sune]}]}]} = gen_server:call({global, {ch,41}}, get_pid_all_key), - [{included_applications,[appinc1,appinc2]}, - {own2,val2},{own_env1,value1}] = lists:sort(Env), + [{own2,val2},{own_env1,value1}] = lists:sort(Env), stop_node_nice(Cp1), ok. diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index 0470f09f29..9c6712ad74 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -244,7 +244,7 @@ illegal(Name) -> test_node(Name) -> test_node(Name, false). test_node(Name, Illigal) -> - ProgName = atom_to_list(lib:progname()), + ProgName = ct:get_progname(), Command = ProgName ++ " -noinput " ++ long_or_short() ++ Name ++ " -eval \"net_adm:ping('" ++ atom_to_list(node()) ++ "')\"" ++ case Illigal of diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl index 22db24de5f..e95635b800 100644 --- a/lib/kernel/test/heart_SUITE.erl +++ b/lib/kernel/test/heart_SUITE.erl @@ -168,7 +168,7 @@ reboot(Config) when is_list(Config) -> {ok, Node} = start_check(slave, ?UNIQ_NODE_NAME), ok = rpc:call(Node, heart, set_cmd, - [atom_to_list(lib:progname()) ++ + [ct:get_progname() ++ " -noshell -heart " ++ name(Node) ++ "&"]), rpc:call(Node, init, reboot, []), receive @@ -203,7 +203,7 @@ node_start_immediately_after_crash_test(Config) when is_list(Config) -> [{"ERL_CRASH_DUMP_SECONDS", "0"}]), ok = rpc:call(Node, heart, set_cmd, - [atom_to_list(lib:progname()) ++ + [ct:get_progname() ++ " -noshell -heart " ++ name(Node) ++ "&"]), Mod = exhaust_atoms, @@ -254,7 +254,7 @@ node_start_soon_after_crash_test(Config) when is_list(Config) -> [{"ERL_CRASH_DUMP_SECONDS", "10"}]), ok = rpc:call(Node, heart, set_cmd, - [atom_to_list(lib:progname()) ++ + [ct:get_progname() ++ " -noshell -heart " ++ name(Node) ++ "&"]), Mod = exhaust_atoms, @@ -309,7 +309,7 @@ set_cmd(Config) when is_list(Config) -> clear_cmd(Config) when is_list(Config) -> {ok, Node} = start_check(slave, ?UNIQ_NODE_NAME), ok = rpc:call(Node, heart, set_cmd, - [atom_to_list(lib:progname()) ++ + [ct:get_progname() ++ " -noshell -heart " ++ name(Node) ++ "&"]), rpc:call(Node, init, reboot, []), receive diff --git a/lib/kernel/test/kernel_config_SUITE.erl b/lib/kernel/test/kernel_config_SUITE.erl index 9a4578917d..a21020ff97 100644 --- a/lib/kernel/test/kernel_config_SUITE.erl +++ b/lib/kernel/test/kernel_config_SUITE.erl @@ -76,7 +76,7 @@ sync(Conf) when is_list(Conf) -> %% Reset wall_clock {T1,_} = erlang:statistics(wall_clock), io:format("~p~n", [{t1, T1}]), - Command = lists:concat([lib:progname(), + Command = lists:append([ct:get_progname(), " -detached -sname cp1 ", "-config ", Config, " -env ERL_CRASH_DUMP erl_crash_dump.cp1"]), diff --git a/lib/kernel/test/logger_SUITE.erl b/lib/kernel/test/logger_SUITE.erl index 0edce3e34c..f311a9c7ed 100644 --- a/lib/kernel/test/logger_SUITE.erl +++ b/lib/kernel/test/logger_SUITE.erl @@ -666,6 +666,9 @@ process_metadata(_Config) -> check_logged(info,S3,#{time=>Time,line=>0,custom=>func}), ProcMeta = logger:get_process_metadata(), + ok = logger:update_process_metadata(#{custom=>changed,custom2=>added}), + Expected = ProcMeta#{custom:=changed,custom2=>added}, + Expected = logger:get_process_metadata(), ok = logger:unset_process_metadata(), undefined = logger:get_process_metadata(), @@ -720,7 +723,7 @@ check_maps(Expected,Got,What) -> adding_handler(_Id,Config) -> maybe_send(add), {ok,Config}. -removing_handler(_Id) -> +removing_handler(_Id,_Config) -> maybe_send(remove), ok. changing_config(_Id,_Old,#{call:=Fun}) -> diff --git a/lib/kernel/test/logger_disk_log_h_SUITE.erl b/lib/kernel/test/logger_disk_log_h_SUITE.erl index bb88c53f26..7c33c9130c 100644 --- a/lib/kernel/test/logger_disk_log_h_SUITE.erl +++ b/lib/kernel/test/logger_disk_log_h_SUITE.erl @@ -505,24 +505,19 @@ disk_log_sync(Config) -> filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]), formatter=>{?MODULE,nl}}), - start_tracer([{?MODULE,format,2}, - {disk_log,blog,2}, + start_tracer([{disk_log,blog,2}, {disk_log,sync,1}], - [{formatter,"first"}, - {disk_log,blog}, + [{disk_log,blog,<<"first\n">>}, {disk_log,sync}]), logger:info("first", ?domain), %% wait for automatic disk_log_sync check_tracer(?FILESYNC_REPEAT_INTERVAL*2), - start_tracer([{?MODULE,format,2}, - {disk_log,blog,2}, + start_tracer([{disk_log,blog,2}, {disk_log,sync,1}], - [{formatter,"second"}, - {formatter,"third"}, - {disk_log,blog}, - {disk_log,blog}, + [{disk_log,blog,<<"second\n">>}, + {disk_log,blog,<<"third\n">>}, {disk_log,sync}]), %% two log requests in fast succession will make the handler skip %% an automatic disk log sync @@ -539,13 +534,10 @@ disk_log_sync(Config) -> no_repeat = maps:get(filesync_repeat_interval, logger_disk_log_h:info(?MODULE)), - start_tracer([{?MODULE,format,2}, - {disk_log,blog,2}, + start_tracer([{disk_log,blog,2}, {disk_log,sync,1}], - [{formatter,"fourth"}, - {disk_log,blog}, - {formatter,"fifth"}, - {disk_log,blog}, + [{disk_log,blog,<<"fourth\n">>}, + {disk_log,blog,<<"fifth\n">>}, {disk_log,sync}]), logger:info("fourth", ?domain), @@ -574,6 +566,7 @@ disk_log_sync(Config) -> check_tracer(100), ok. disk_log_sync(cleanup,_Config) -> + dbg:stop_clear(), logger:remove_handler(?MODULE). disk_log_wrap(Config) -> @@ -631,6 +624,7 @@ disk_log_wrap(Config) -> ok. disk_log_wrap(cleanup,_Config) -> + dbg:stop_clear(), logger:remove_handler(?MODULE). disk_log_full(Config) -> @@ -676,6 +670,7 @@ disk_log_full(Config) -> {trace,{error_status,{error,{full,_}}}}] = Received, ok. disk_log_full(cleanup, _Config) -> + dbg:stop_clear(), logger:remove_handler(?MODULE). disk_log_events(Config) -> @@ -721,6 +716,7 @@ disk_log_events(Config) -> end, Received), ok. disk_log_events(cleanup, _Config) -> + dbg:stop_clear(), logger:remove_handler(?MODULE). write_failure(Config) -> @@ -771,7 +767,7 @@ sync_failure(Config) -> Dir = ?config(priv_dir, Config), FileName = lists:concat([?MODULE,"_",?FUNCTION_NAME]), File = filename:join(Dir, FileName), - Log = lists:concat([File,".1"]), + Node = start_h_on_new_node(Config, ?FUNCTION_NAME, File), false = (undefined == rpc:call(Node, ets, whereis, [?TEST_HOOKS_TAB])), @@ -840,10 +836,10 @@ log_on_remote_node(Node,Msg) -> ok. %% functions for test hook macros to be called by rpc -set_internal_log(Mod, Func) -> - ?set_internal_log({Mod,Func}). -set_result(Op, Result) -> - ?set_result(Op, Result). +set_internal_log(_Mod, _Func) -> + ?set_internal_log({_Mod,_Func}). +set_result(_Op, _Result) -> + ?set_result(_Op, _Result). set_defaults() -> ?set_defaults(). @@ -919,7 +915,7 @@ op_switch_to_drop(cleanup, _Config) -> _ = stop_handler(?MODULE). op_switch_to_flush() -> - [{timetrap,{seconds,180}}]. + [{timetrap,{minutes,3}}]. op_switch_to_flush(Config) -> Test = fun() -> @@ -1049,7 +1045,7 @@ kill_disabled(cleanup, _Config) -> ok = stop_handler(?MODULE). qlen_kill_new(Config) -> - {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config), + {_Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config), Pid0 = whereis(?MODULE), {_,Mem0} = process_info(Pid0, memory), RestartAfter = ?HANDLER_RESTART_AFTER, @@ -1086,7 +1082,7 @@ qlen_kill_new(cleanup, _Config) -> ok = stop_handler(?MODULE). mem_kill_new(Config) -> - {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config), + {_Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config), Pid0 = whereis(?MODULE), {_,Mem0} = process_info(Pid0, memory), RestartAfter = ?HANDLER_RESTART_AFTER, @@ -1172,7 +1168,7 @@ restart_after(cleanup, _Config) -> %% during high load to verify that sync, dropping and flushing is %% handled correctly. handler_requests_under_load() -> - [{timetrap,{seconds,60}}]. + [{timetrap,{minutes,3}}]. handler_requests_under_load(Config) -> {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config), NewHConfig = @@ -1201,7 +1197,7 @@ handler_requests_under_load(Config) -> NoOfReqs = lists:foldl(fun({_,Res}, N) -> N + length(Res) end, 0, ReqResult), ct:pal("~w requests made. Errors: ~n~p", [NoOfReqs,Errors]), ok = file:delete(Log). -handler_requests_under_load(cleanup, Config) -> +handler_requests_under_load(cleanup, _Config) -> ok = stop_handler(?MODULE). send_requests(HName, TO, Reqs = [{Req,Res}|Rs]) -> @@ -1453,7 +1449,6 @@ start_tracer(Trace,Expected) -> Pid = self(), dbg:tracer(process,{fun tracer/2,{Pid,Expected}}), dbg:p(whereis(?MODULE),[c]), - dbg:p(Pid,[c]), tpl(Trace), ok. @@ -1471,15 +1466,15 @@ tpl([{M,F,A}|Trace]) -> tpl([]) -> ok. -tracer({trace,_,call,{?MODULE,format,[#{msg:={string,Msg}}|_]}}, - {Pid,[{formatter,Msg}|Expected]}) -> - maybe_tracer_done(Pid,Expected,{formatter,Msg}); tracer({trace,_,call,{logger_disk_log_h,handle_cast,[Op|_]}}, {Pid,[{Mod,Func,Op}|Expected]}) -> maybe_tracer_done(Pid,Expected,{Mod,Func,Op}); +tracer({trace,_,call,{Mod=disk_log,Func=blog,[_,Data]}}, {Pid,[{Mod,Func,Data}|Expected]}) -> + maybe_tracer_done(Pid,Expected,{Mod,Func,Data}); tracer({trace,_,call,{Mod,Func,_}}, {Pid,[{Mod,Func}|Expected]}) -> maybe_tracer_done(Pid,Expected,{Mod,Func}); tracer({trace,_,call,Call}, {Pid,Expected}) -> + ct:log("Tracer got unexpected: ~p~nExpected: ~p~n",[Call,Expected]), Pid ! {tracer_got_unexpected,Call,Expected}, {Pid,Expected}. @@ -1499,5 +1494,6 @@ check_tracer(T) -> dbg:stop_clear(), ct:fail({tracer_got_unexpected,Got,Expected}) after T -> + dbg:stop_clear(), ct:fail({timeout,tracer}) end. diff --git a/lib/kernel/test/logger_formatter_SUITE.erl b/lib/kernel/test/logger_formatter_SUITE.erl index ac1abba629..7d1f33746d 100644 --- a/lib/kernel/test/logger_formatter_SUITE.erl +++ b/lib/kernel/test/logger_formatter_SUITE.erl @@ -73,18 +73,19 @@ all() -> default(_Config) -> String1 = format(info,{"~p",[term]},#{},#{}), ct:log(String1), - [_Date,_Time,"info:\nterm\n"] = string:lexemes(String1," "), + [_Date,_Time,"info:","term\n"] = string:lexemes(String1," "), Time = timestamp(), ExpectedTimestamp = default_time_format(Time), String2 = format(info,{"~p",[term]},#{time=>Time},#{}), ct:log(String2), - " info:\nterm\n" = string:prefix(String2,ExpectedTimestamp), + " info: term\n" = string:prefix(String2,ExpectedTimestamp), ok. legacy_header(_Config) -> Time = timestamp(), - String1 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>true}), + String1 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>true, + single_line=>false}), ct:log(String1), "=INFO REPORT==== "++Rest = String1, [Timestamp,"\nterm\n"] = string:lexemes(Rest," ="), @@ -98,12 +99,14 @@ legacy_header(_Config) -> true = lists:member(M,["Jan","Feb","Mar","Apr","May","Jun", "Jul","Aug","Sep","Oct","Nov","Dec"]), - String2 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>false}), + String2 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>false, + single_line=>false}), ct:log(String2), ExpectedTimestamp = default_time_format(Time), " info:\nterm\n" = string:prefix(String2,ExpectedTimestamp), - String3 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>bad}), + String3 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>bad, + single_line=>false}), ct:log(String3), String3 = String2, @@ -114,7 +117,8 @@ legacy_header(_Config) -> String4 = String1, String5 = format(info,{"~p",[term]},#{}, % <--- no time - #{legacy_header=>true}), + #{legacy_header=>true, + single_line=>false}), ct:log(String5), "=INFO REPORT==== "++_ = String5, ok. @@ -289,38 +293,36 @@ report_cb(_Config) -> ok. max_size(_Config) -> - Template = [msg], + Cfg = #{template=>[msg], + single_line=>false}, "12345678901234567890" = - format(info,{"12345678901234567890",[]},#{},#{template=>Template}), + format(info,{"12345678901234567890",[]},#{},Cfg), application:set_env(kernel,logger_max_size,11), "12345678901234567890" = % min value is 50, so this is not limited - format(info,{"12345678901234567890",[]},#{},#{template=>Template}), + format(info,{"12345678901234567890",[]},#{},Cfg), "12345678901234567890123456789012345678901234567..." = % 50 format(info, {"123456789012345678901234567890123456789012345678901234567890", []}, #{}, - #{template=>Template}), + Cfg), application:set_env(kernel,logger_max_size,53), "12345678901234567890123456789012345678901234567890..." = %53 format(info, {"123456789012345678901234567890123456789012345678901234567890", []}, #{}, - #{template=>Template}), + Cfg), "123456789012..." = - format(info,{"12345678901234567890",[]},#{},#{template=>Template, - max_size=>15}), + format(info,{"12345678901234567890",[]},#{},Cfg#{max_size=>15}), "12345678901234567890" = - format(info,{"12345678901234567890",[]},#{},#{template=>Template, - max_size=>unlimited}), + format(info,{"12345678901234567890",[]},#{},Cfg#{max_size=>unlimited}), %% Check that one newline at the end of the line is kept (if it exists) "12345678901...\n" = - format(info,{"12345678901234567890\n",[]},#{},#{template=>Template, - max_size=>15}), + format(info,{"12345678901234567890\n",[]},#{},Cfg#{max_size=>15}), "12345678901...\n" = - format(info,{"12345678901234567890",[]},#{},#{template=>[msg,"\n"], - max_size=>15}), + format(info,{"12345678901234567890",[]},#{},Cfg#{template=>[msg,"\n"], + max_size=>15}), ok. max_size(cleanup,_Config) -> application:unset_env(kernel,logger_max_size), @@ -441,20 +443,20 @@ format_time(_Config) -> ExpectedTimestamp1 = default_time_format(Time1), String1 = format(info,{"~p",[term]},#{time=>Time1},#{}), ct:log(String1), - " info:\nterm\n" = string:prefix(String1,ExpectedTimestamp1), + " info: term\n" = string:prefix(String1,ExpectedTimestamp1), Time2 = timestamp(), ExpectedTimestamp2 = default_time_format(Time2,true), String2 = format(info,{"~p",[term]},#{time=>Time2},#{utc=>true}), ct:log(String2), - " info:\nterm\n" = string:prefix(String2,ExpectedTimestamp2), + " info: term\n" = string:prefix(String2,ExpectedTimestamp2), application:set_env(kernel,logger_utc,true), Time3 = timestamp(), ExpectedTimestamp3 = default_time_format(Time3,true), String3 = format(info,{"~p",[term]},#{time=>Time3},#{}), ct:log(String3), - " info:\nterm\n" = string:prefix(String3,ExpectedTimestamp3), + " info: term\n" = string:prefix(String3,ExpectedTimestamp3), ok. diff --git a/lib/kernel/test/logger_std_h_SUITE.erl b/lib/kernel/test/logger_std_h_SUITE.erl index 3ebbbe74ef..34c3167960 100644 --- a/lib/kernel/test/logger_std_h_SUITE.erl +++ b/lib/kernel/test/logger_std_h_SUITE.erl @@ -506,86 +506,79 @@ filesync(Config) -> #{logger_std_h => #{type => Type}, filter_default=>log, filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]), - formatter=>{?MODULE,self()}}), - Tester = self(), - TraceFun = fun({trace,_,call,{Mod,Func,Details}}, Pid) -> - Pid ! {trace,Mod,Func,Details}, - Pid; - ({trace,TPid,'receive',Received}, Pid) -> - Pid ! {trace,TPid,Received}, - Pid - end, - {ok,_} = dbg:tracer(process, {TraceFun, Tester}), - FileCtrlPid = maps:get(file_ctrl_pid , logger_std_h:info(?MODULE)), - {ok,_} = dbg:p(FileCtrlPid, [c]), - {ok,_} = dbg:tpl(logger_std_h, write_to_dev, 5, []), - {ok,_} = dbg:tpl(logger_std_h, sync_dev, 4, []), - {ok,_} = dbg:tp(file, datasync, 1, []), + formatter=>{?MODULE,nl}}), + + %% check repeated filesync happens + start_tracer([{logger_std_h, write_to_dev, 5}, + {logger_std_h, sync_dev, 4}, + {file, datasync, 1}], + [{logger_std_h, write_to_dev, <<"first\n">>}, + {logger_std_h, sync_dev}, + {file,datasync}]), logger:info("first", ?domain), %% wait for automatic filesync - timer:sleep(?FILESYNC_REP_INT), - Expected1 = [{log,"first"}, {trace,logger_std_h,write_to_dev}, - {trace,logger_std_h,sync_dev}, {trace,file,datasync}], - + check_tracer(?FILESYNC_REP_INT*2), + + %% check that explicit filesync is only done once + start_tracer([{logger_std_h, write_to_dev, 5}, + {logger_std_h, sync_dev, 4}, + {file, datasync, 1}], + [{logger_std_h, write_to_dev, <<"second\n">>}, + {logger_std_h, sync_dev}, + {file,datasync}, + {no_more,500} + ]), logger:info("second", ?domain), %% do explicit filesync logger_std_h:filesync(?MODULE), %% a second filesync should be ignored logger_std_h:filesync(?MODULE), - Expected2 = [{log,"second"}, {trace,logger_std_h,write_to_dev}, - {trace,logger_std_h,sync_dev}, {trace,file,datasync}], + check_tracer(100), %% check that if there's no repeated filesync active, %% a filesync is still performed when handler goes idle logger:set_handler_config(?MODULE, logger_std_h, #{filesync_repeat_interval => no_repeat}), no_repeat = maps:get(filesync_repeat_interval, logger_std_h:info(?MODULE)), + %% The following timer is to make sure the time from last log + %% ("second") to next ("third") is long enough, so the a flush is + %% triggered by the idle timeout between "thrid" and "fourth". + timer:sleep(?IDLE_DETECT_TIME_MSEC*2), + start_tracer([{logger_std_h, write_to_dev, 5}, + {logger_std_h, sync_dev, 4}, + {file, datasync, 1}], + [{logger_std_h, write_to_dev, <<"third\n">>}, + {logger_std_h, sync_dev}, + {file,datasync}, + {logger_std_h, write_to_dev, <<"fourth\n">>}, + {logger_std_h, sync_dev}, + {file,datasync}]), logger:info("third", ?domain), + %% wait for automatic filesync timer:sleep(?IDLE_DETECT_TIME_MSEC*2), logger:info("fourth", ?domain), %% wait for automatic filesync - timer:sleep(?IDLE_DETECT_TIME_MSEC*2), - Expected3 = [{log,"third"}, {trace,logger_std_h,write_to_dev}, - {log,"fourth"}, {trace,logger_std_h,write_to_dev}, - {trace,logger_std_h,sync_dev}, {trace,file,datasync}], - - dbg:stop_clear(), - - %% verify that filesync has been performed as expected - Received1 = lists:map(fun({trace,M,F,_}) -> {trace,M,F}; - (Other) -> Other - end, test_server:messages_get()), - ct:pal("Trace #1 =~n~p", [Received1]), - Received1 = Expected1 ++ Expected2 ++ Expected3, - - try_read_file(Log, {ok,<<"first\nsecond\nthird\nfourth\n">>}, 1000), - - {ok,_} = dbg:tracer(process, {TraceFun, Tester}), - {ok,_} = dbg:p(whereis(?MODULE), [c]), - {ok,_} = dbg:tpl(logger_std_h, handle_cast, 2, []), + check_tracer(?IDLE_DETECT_TIME_MSEC*2), %% switch repeated filesync on and verify that the looping works SyncInt = 1000, WaitT = 4500, + OneSync = {logger_std_h,handle_cast,repeated_filesync}, + %% receive 1 initial repeated_filesync, then 1 per sec + start_tracer([{logger_std_h,handle_cast,2}], + [OneSync || _ <- lists:seq(1, 1 + trunc(WaitT/SyncInt))]), + logger:set_handler_config(?MODULE, logger_std_h, #{filesync_repeat_interval => SyncInt}), SyncInt = maps:get(filesync_repeat_interval, logger_std_h:info(?MODULE)), timer:sleep(WaitT), logger:set_handler_config(?MODULE, logger_std_h, - #{filesync_repeat_interval => no_repeat}), - dbg:stop_clear(), - - Received2 = lists:map(fun({trace,_M,handle_cast,[Op,_]}) -> {trace,Op}; - (Other) -> Other - end, test_server:messages_get()), - ct:pal("Trace #2 =~n~p", [Received2]), - OneSync = [{trace,repeated_filesync}], - %% receive 1 initial repeated_filesync, then 1 per sec - Received2 = - lists:flatten([OneSync || _ <- lists:seq(1, 1 + trunc(WaitT/SyncInt))]), + #{filesync_repeat_interval => no_repeat}), + check_tracer(100), ok. filesync(cleanup, _Config) -> + dbg:stop_clear(), logger:remove_handler(?MODULE). write_failure(Config) -> @@ -807,7 +800,7 @@ op_switch_to_drop_tty(cleanup, _Config) -> ok = stop_handler(?MODULE). op_switch_to_flush_file() -> - [{timetrap,{seconds,180}}]. + [{timetrap,{minutes,3}}]. op_switch_to_flush_file(Config) -> Test = fun() -> @@ -1097,7 +1090,7 @@ restart_after(cleanup, _Config) -> %% during high load to verify that sync, dropping and flushing is %% handled correctly. handler_requests_under_load() -> - [{timetrap,{seconds,60}}]. + [{timetrap,{minutes,3}}]. handler_requests_under_load(Config) -> {Log,HConfig,StdHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config), @@ -1178,8 +1171,9 @@ start_handler(Name, FuncName, Config) -> {Log,HConfig,StdHConfig}. stop_handler(Name) -> - ok = logger:remove_handler(Name), - ct:pal("Handler ~p stopped!", [Name]). + R = logger:remove_handler(Name), + ct:pal("Handler ~p stopped! Result: ~p", [Name,R]), + R. count_lines(File) -> wait_until_written(File, -1), @@ -1463,3 +1457,67 @@ analyse(Msgs) -> From ! {result,self(),TestFun(Msgs)}, analyse(Msgs) end. + +start_tracer(Trace,Expected) -> + Pid = self(), + FileCtrlPid = maps:get(file_ctrl_pid, logger_std_h:info(?MODULE)), + dbg:tracer(process,{fun tracer/2,{Pid,Expected}}), + dbg:p(whereis(?MODULE),[c]), + dbg:p(FileCtrlPid,[c]), + tpl(Trace), + ok. + +tpl([{M,F,A}|Trace]) -> + {ok,Match} = dbg:tpl(M,F,A,[]), + case lists:keyfind(matched,1,Match) of + {_,_,1} -> + ok; + _ -> + dbg:stop_clear(), + throw({skip,"Can't trace "++atom_to_list(M)++":"++ + atom_to_list(F)++"/"++integer_to_list(A)}) + end, + tpl(Trace); +tpl([]) -> + ok. + +tracer({trace,_,call,{logger_std_h,handle_cast,[Op|_]}}, + {Pid,[{Mod,Func,Op}|Expected]}) -> + maybe_tracer_done(Pid,Expected,{Mod,Func,Op}); +tracer({trace,_,call,{Mod=logger_std_h,Func=write_to_dev,[_,Data,_,_,_]}}, + {Pid,[{Mod,Func,Data}|Expected]}) -> + maybe_tracer_done(Pid,Expected,{Mod,Func,Data}); +tracer({trace,_,call,{Mod,Func,_}}, {Pid,[{Mod,Func}|Expected]}) -> + maybe_tracer_done(Pid,Expected,{Mod,Func}); +tracer({trace,_,call,Call}, {Pid,Expected}) -> + ct:log("Tracer got unexpected: ~p~nExpected: ~p~n",[Call,Expected]), + Pid ! {tracer_got_unexpected,Call,Expected}, + {Pid,Expected}. + +maybe_tracer_done(Pid,[]=Expected,Got) -> + ct:log("Tracer got: ~p~n",[Got]), + Pid ! {tracer_done,0}, + {Pid,Expected}; +maybe_tracer_done(Pid,[{no_more,T}]=Expected,Got) -> + ct:log("Tracer got: ~p~n",[Got]), + Pid ! {tracer_done,T}, + {Pid,Expected}; +maybe_tracer_done(Pid,Expected,Got) -> + ct:log("Tracer got: ~p~n",[Got]), + {Pid,Expected}. + +check_tracer(T) -> + check_tracer(T,fun() -> ct:fail({timeout,tracer}) end). +check_tracer(T,TimeoutFun) -> + receive + {tracer_done,Delay} -> + %% Possibly wait Delay ms to check that no unexpected + %% traces are received + check_tracer(Delay,fun() -> ok end); + {tracer_got_unexpected,Got,Expected} -> + dbg:stop_clear(), + ct:fail({tracer_got_unexpected,Got,Expected}) + after T -> + dbg:stop_clear(), + TimeoutFun() + end. diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl index 591fbb2125..abbc301360 100644 --- a/lib/kernel/test/os_SUITE.erl +++ b/lib/kernel/test/os_SUITE.erl @@ -227,8 +227,8 @@ find_executable(Config) when is_list(Config) -> DataDir = proplists:get_value(data_dir, Config), %% Smoke test. - case lib:progname() of - erl -> + case ct:get_progname() of + "erl" -> ErlPath = os:find_executable("erl"), true = is_list(ErlPath), true = filelib:is_regular(ErlPath); @@ -388,7 +388,7 @@ comp(Expected, Got) -> ct:fail(failed) end. -%% Like lib:nonl/1, but strips \r as well as \n. +%% strips \n and \r\n from end of string strip_nl([$\r, $\n]) -> []; strip_nl([$\n]) -> []; diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 0678b64134..718ef91942 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -682,7 +682,7 @@ parse_string(Str) -> {error, {_SLine, SMod, SError}, _} -> throw(io_lib:format("~ts", [SMod:format_error(SError)])) end, - case lib:extended_parse_term(Tokens) of + case erl_eval:extended_parse_term(Tokens) of {error, {_PLine, PMod, PError}} -> throw(io_lib:format("~ts", [PMod:format_error(PError)])); Res -> Res diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl index b4e1cfe5e3..ce1b9468fd 100644 --- a/lib/parsetools/src/yecc.erl +++ b/lib/parsetools/src/yecc.erl @@ -455,10 +455,14 @@ os_process_size() -> case os:type() of {unix, sunos} -> Size = os:cmd("ps -o vsz -p " ++ os:getpid() ++ " | tail -1"), - list_to_integer(lib:nonl(Size)); + list_to_integer(nonl(Size)); _ -> 0 - end. + end. + +nonl([$\n]) -> []; +nonl([]) -> []; +nonl([H|T]) -> [H|nonl(T)]. timeit(Name, Fun, St0) -> Time = runtime, diff --git a/lib/sasl/src/sasl.erl b/lib/sasl/src/sasl.erl index 657eb6688a..2bf11bdcdf 100644 --- a/lib/sasl/src/sasl.erl +++ b/lib/sasl/src/sasl.erl @@ -130,6 +130,7 @@ add_sasl_logger(undefined, _Level) -> ok; add_sasl_logger(std, undefined) -> ok; add_sasl_logger(Dest, Level) -> FC0 = #{legacy_header=>true, + single_line=>false, template=>[{logger_formatter,header},"\n",msg,"\n"]}, FC = case application:get_env(sasl,utc_log) of {ok,Bool} when is_boolean(Bool) -> diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index d78309167a..d0ed674eee 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -30,6 +30,28 @@ <file>notes.xml</file> </header> +<section><title>Ssh 4.6.9</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Host key hash erroneously calculated for clients + following draft-00 of RFC 4419, for example PuTTY</p> + <p> + Own Id: OTP-15064</p> + </item> + <item> + <p> + Renegotiation could fail in some states</p> + <p> + Own Id: OTP-15066</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.6.8</title> <section><title>Fixed Bugs and Malfunctions</title> <list> @@ -487,6 +509,34 @@ </section> +<section><title>Ssh 4.4.2.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix rare spurios shutdowns of ssh servers when receiveing + <c>{'EXIT',_,normal}</c> messages.</p> + <p> + Own Id: OTP-15018</p> + </item> + <item> + <p> + Host key hash erroneously calculated for clients + following draft-00 of RFC 4419, for example PuTTY</p> + <p> + Own Id: OTP-15064</p> + </item> + <item> + <p> + Renegotiation could fail in some states</p> + <p> + Own Id: OTP-15066</p> + </item> + </list> + </section> + +</section> <section><title>Ssh 4.4.2.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 0223831cb1..407956cc6f 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -762,9 +762,23 @@ <datatype> <name name="rekey_limit_common_option"/> + <name name="limit_bytes"/> + <name name="limit_time"/> <desc> - <p>Sets a limit, in bytes, when rekeying is to be initiated. - Defaults to once per each GB and once per hour.</p> + <p>Sets the limit when rekeying is to be initiated. Both the max time and max amount of data + could be configured: + </p> + <list> + <item><c>{Minutes, Bytes}</c> initiate rekeying when any of the limits are reached.</item> + <item><c>Bytes</c> initiate rekeying when <c>Bytes</c> number of bytes are transferred, + or at latest after one hour.</item> + </list> + <p>When a rekeying is done, both the timer and the byte counter are restarted. + Defaults to one hour and one GByte.</p> + <p>If <c>Minutes</c> is set to <c>infinity</c>, no rekeying will ever occur due to that max time has passed. + Setting <c>Bytes</c> to <c>infinity</c> will inhibit rekeying after a certain amount of data has been transferred. + If the option value is set to <c>{infinity, infinity}</c>, no rekeying will be initiated. Note that rekeying initiated + by the peer will still be performed.</p> </desc> </datatype> diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index a3d9a1b1cb..2efd239aae 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -29,7 +29,6 @@ -define(SSH_DEFAULT_PORT, 22). -define(SSH_MAX_PACKET_SIZE, (256*1024)). --define(REKEY_TIMOUT, 3600000). -define(REKEY_DATA_TIMOUT, 60000). -define(DEFAULT_PROFILE, default). @@ -192,7 +191,12 @@ -type user_dir_common_option() :: {user_dir, false | string()}. -type profile_common_option() :: {profile, atom() }. -type max_idle_time_common_option() :: {idle_time, timeout()}. --type rekey_limit_common_option() :: {rekey_limit, non_neg_integer() }. +-type rekey_limit_common_option() :: {rekey_limit, Bytes::limit_bytes() | + {Minutes::limit_time(), Bytes::limit_bytes()} + }. + +-type limit_bytes() :: non_neg_integer() | infinity . % non_neg_integer due to compatibility +-type limit_time() :: pos_integer() | infinity . -type key_cb_common_option() :: {key_cb, Module::atom() | {Module::atom(),Opts::[term()]} } . -type disconnectfun_common_option() :: diff --git a/lib/ssh/src/ssh_client_channel.erl b/lib/ssh/src/ssh_client_channel.erl index f20007baaf..134d3f08bd 100644 --- a/lib/ssh/src/ssh_client_channel.erl +++ b/lib/ssh/src/ssh_client_channel.erl @@ -305,8 +305,8 @@ terminate(Reason, #state{cm = ConnectionManager, close_sent = false} = State) -> catch ssh_connection:close(ConnectionManager, ChannelId), terminate(Reason, State#state{close_sent = true}); -terminate(_, #state{channel_cb = Cb, channel_state = ChannelState}) -> - catch Cb:terminate(Cb, ChannelState), +terminate(Reason, #state{channel_cb = Cb, channel_state = ChannelState}) -> + catch Cb:terminate(Reason, ChannelState), ok. %%-------------------------------------------------------------------- diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 57641cf74c..f1ff3a70e2 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -71,7 +71,7 @@ -export([init_connection_handler/3, % proc_lib:spawn needs this init_ssh_record/3, % Export of this internal function % intended for low-level protocol test suites - renegotiate/1, renegotiate_data/1, alg/1 % Export intended for test cases + renegotiate/1, alg/1 % Export intended for test cases ]). -export([dbg_trace/3]). @@ -325,14 +325,7 @@ close(ConnectionHandler, ChannelId) -> ) -> ok. %% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . renegotiate(ConnectionHandler) -> - cast(ConnectionHandler, renegotiate). - -%%-------------------------------------------------------------------- --spec renegotiate_data(connection_ref() - ) -> ok. -%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . -renegotiate_data(ConnectionHandler) -> - cast(ConnectionHandler, data_size). + cast(ConnectionHandler, force_renegotiate). %%-------------------------------------------------------------------- alg(ConnectionHandler) -> @@ -349,11 +342,6 @@ alg(ConnectionHandler) -> connection_state :: #connection{}, latest_channel_id = 0 :: non_neg_integer() | undefined, - idle_timer_ref :: undefined - | infinity - | reference(), - idle_timer_value = infinity :: infinity - | pos_integer(), transport_protocol :: atom() | undefined, % ex: tcp transport_cb :: atom() @@ -429,20 +417,16 @@ init([Role,Socket,Opts]) -> }, D = case Role of client -> - %% Start the renegotiation timers - timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), - timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), - cache_init_idle_timer(D0); + D0; server -> Sups = ?GET_INTERNAL_OPT(supervisors, Opts), - cache_init_idle_timer( - D0#data{connection_state = - C#connection{cli_spec = ?GET_OPT(ssh_cli, Opts, {ssh_cli,[?GET_OPT(shell, Opts)]}), - exec = ?GET_OPT(exec, Opts), - system_supervisor = proplists:get_value(system_sup, Sups), - sub_system_supervisor = proplists:get_value(subsystem_sup, Sups), - connection_supervisor = proplists:get_value(connection_sup, Sups) - }}) + D0#data{connection_state = + C#connection{cli_spec = ?GET_OPT(ssh_cli, Opts, {ssh_cli,[?GET_OPT(shell, Opts)]}), + exec = ?GET_OPT(exec, Opts), + system_supervisor = proplists:get_value(system_sup, Sups), + sub_system_supervisor = proplists:get_value(subsystem_sup, Sups), + connection_supervisor = proplists:get_value(connection_sup, Sups) + }} end, {ok, {hello,Role}, D}; @@ -544,7 +528,7 @@ role({_,Role}) -> Role; role({_,Role,_}) -> Role. -spec renegotiation(state_name()) -> boolean(). -renegotiation({_,_,ReNeg}) -> ReNeg == renegotiation; +renegotiation({_,_,ReNeg}) -> ReNeg == renegotiate; renegotiation(_) -> false. @@ -558,10 +542,15 @@ renegotiation(_) -> false. #data{} ) -> gen_statem:event_handler_result(state_name()) . +-define(CONNECTION_MSG(Msg), + [{next_event, internal, prepare_next_packet}, + {next_event,internal,{conn_msg,Msg}}]). + %% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . callback_mode() -> - handle_event_function. + [handle_event_function, + state_enter]. handle_event(_, _Event, {init_error,Error}=StateName, D) -> @@ -1016,95 +1005,92 @@ handle_event(_, #ssh_msg_debug{} = Msg, _, D) -> debug_fun(Msg, D), keep_state_and_data; -handle_event(internal, Msg=#ssh_msg_global_request{}, StateName, D) -> - handle_connection_msg(Msg, StateName, D); - -handle_event(internal, Msg=#ssh_msg_request_success{}, StateName, D) -> - handle_connection_msg(Msg, StateName, D); - -handle_event(internal, Msg=#ssh_msg_request_failure{}, StateName, D) -> - handle_connection_msg(Msg, StateName, D); - -handle_event(internal, Msg=#ssh_msg_channel_open{}, StateName, D) -> - handle_connection_msg(Msg, StateName, D); - -handle_event(internal, Msg=#ssh_msg_channel_open_confirmation{}, StateName, D) -> - handle_connection_msg(Msg, StateName, D); - -handle_event(internal, Msg=#ssh_msg_channel_open_failure{}, StateName, D) -> - handle_connection_msg(Msg, StateName, D); - -handle_event(internal, Msg=#ssh_msg_channel_window_adjust{}, StateName, D) -> - handle_connection_msg(Msg, StateName, D); - -handle_event(internal, Msg=#ssh_msg_channel_data{}, StateName, D) -> - handle_connection_msg(Msg, StateName, D); - -handle_event(internal, Msg=#ssh_msg_channel_extended_data{}, StateName, D) -> - handle_connection_msg(Msg, StateName, D); - -handle_event(internal, Msg=#ssh_msg_channel_eof{}, StateName, D) -> - handle_connection_msg(Msg, StateName, D); - -handle_event(internal, Msg=#ssh_msg_channel_close{}, {connected,server} = StateName, D) -> - handle_connection_msg(Msg, StateName, cache_request_idle_timer_check(D)); - -handle_event(internal, Msg=#ssh_msg_channel_close{}, StateName, D) -> - handle_connection_msg(Msg, StateName, D); +handle_event(internal, {conn_msg,Msg}, StateName, #data{starter = User, + connection_state = Connection0, + event_queue = Qev0} = D0) -> + Role = role(StateName), + Rengotation = renegotiation(StateName), + try ssh_connection:handle_msg(Msg, Connection0, Role) of + {disconnect, Reason0, RepliesConn} -> + {Repls, D} = send_replies(RepliesConn, D0), + case {Reason0,Role} of + {{_, Reason}, client} when ((StateName =/= {connected,client}) + and (not Rengotation)) -> + User ! {self(), not_connected, Reason}; + _ -> + ok + end, + {stop_and_reply, {shutdown,normal}, Repls, D}; -handle_event(internal, Msg=#ssh_msg_channel_request{}, StateName, D) -> - handle_connection_msg(Msg, StateName, D); + {Replies, Connection} when is_list(Replies) -> + {Repls, D} = + case StateName of + {connected,_} -> + send_replies(Replies, D0#data{connection_state=Connection}); + _ -> + {ConnReplies, NonConnReplies} = lists:splitwith(fun not_connected_filter/1, Replies), + send_replies(NonConnReplies, D0#data{event_queue = Qev0 ++ ConnReplies}) + end, + case {Msg, StateName} of + {#ssh_msg_channel_close{}, {connected,_}} -> + {keep_state, D, [cond_set_idle_timer(D)|Repls]}; + {#ssh_msg_channel_success{}, _} -> + update_inet_buffers(D#data.socket), + {keep_state, D, Repls}; + _ -> + {keep_state, D, Repls} + end -handle_event(internal, Msg=#ssh_msg_channel_success{}, StateName, D) -> - update_inet_buffers(D#data.socket), - handle_connection_msg(Msg, StateName, D); + catch + Class:Error -> + {Repls, D1} = send_replies(ssh_connection:handle_stop(Connection0), D0), + {Shutdown, D} = ?send_disconnect(?SSH_DISCONNECT_BY_APPLICATION, + io_lib:format("Internal error: ~p:~p",[Class,Error]), + StateName, D1), + {stop_and_reply, Shutdown, Repls, D} + end; -handle_event(internal, Msg=#ssh_msg_channel_failure{}, StateName, D) -> - handle_connection_msg(Msg, StateName, D); +handle_event(enter, _OldState, {connected,_}=State, D) -> + %% Entering the state where re-negotiation is possible + init_renegotiate_timers(State, D); + +handle_event(enter, _OldState, {ext_info,_,renegotiate}=State, D) -> + %% Could be hanging in exit_info state if nothing else arrives + init_renegotiate_timers(State, D); + +handle_event(enter, {connected,_}, State, D) -> + %% Exiting the state where re-negotiation is possible + pause_renegotiate_timers(State, D); + +handle_event(cast, force_renegotiate, StateName, D) -> + handle_event({timeout,renegotiate}, undefined, StateName, D); + +handle_event({timeout,renegotiate}, _, StateName, D0) -> + case StateName of + {connected,Role} -> + start_rekeying(Role, D0); + {ext_info,Role,renegotiate} -> + start_rekeying(Role, D0); + _ -> + %% Wrong state for starting a renegotiation, must be in re-negotiation + keep_state_and_data + end; -handle_event(cast, renegotiate, {connected,Role}, D) -> - {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(D#data.ssh_params), - send_bytes(SshPacket, D), - timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), - {next_state, {kexinit,Role,renegotiate}, D#data{ssh_params = Ssh, - key_exchange_init_msg = KeyInitMsg}}; +handle_event({timeout,check_data_size}, _, StateName, D0) -> + %% Rekey due to sent data limit reached? (Can't be in {ext_info,...} if data is sent) + case StateName of + {connected,Role} -> + check_data_rekeying(Role, D0); + _ -> + %% Wrong state for starting a renegotiation, must be in re-negotiation + keep_state_and_data + end; handle_event({call,From}, get_alg, _, D) -> #ssh{algorithms=Algs} = D#data.ssh_params, {keep_state_and_data, [{reply,From,Algs}]}; -handle_event(cast, renegotiate, _, _) -> - %% Already in key-exchange so safe to ignore - timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), % FIXME: not here in original - keep_state_and_data; - - -%% Rekey due to sent data limit reached? -handle_event(cast, data_size, {connected,Role}, D) -> - {ok, [{send_oct,Sent0}]} = inet:getstat(D#data.socket, [send_oct]), - Sent = Sent0 - D#data.last_size_rekey, - MaxSent = ?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts), - timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), - case Sent >= MaxSent of - true -> - {KeyInitMsg, SshPacket, Ssh} = - ssh_transport:key_exchange_init_msg(D#data.ssh_params), - send_bytes(SshPacket, D), - {next_state, {kexinit,Role,renegotiate}, D#data{ssh_params = Ssh, - key_exchange_init_msg = KeyInitMsg, - last_size_rekey = Sent0}}; - _ -> - keep_state_and_data - end; - -handle_event(cast, data_size, _, _) -> - %% Already in key-exchange so safe to ignore - timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), % FIXME: not here in original - keep_state_and_data; - - - handle_event(cast, _, StateName, _) when not ?CONNECTED(StateName) -> {keep_state_and_data, [postpone]}; @@ -1218,7 +1204,7 @@ handle_event({call,From}, {request, ChannelPid, ChannelId, Type, Data, Timeout}, D -> %% Note reply to channel will happen later when reply is recived from peer on the socket start_channel_request_timer(ChannelId, From, Timeout), - {keep_state, cache_request_idle_timer_check(D)} + {keep_state, D, cond_set_idle_timer(D)} end; handle_event({call,From}, {request, ChannelId, Type, Data, Timeout}, StateName, D0) @@ -1229,7 +1215,7 @@ handle_event({call,From}, {request, ChannelId, Type, Data, Timeout}, StateName, D -> %% Note reply to channel will happen later when reply is recived from peer on the socket start_channel_request_timer(ChannelId, From, Timeout), - {keep_state, cache_request_idle_timer_check(D)} + {keep_state, D, cond_set_idle_timer(D)} end; handle_event({call,From}, {data, ChannelId, Type, Data, Timeout}, StateName, D0) @@ -1270,7 +1256,7 @@ handle_event({call,From}, }), D = add_request(true, ChannelId, From, D2), start_channel_request_timer(ChannelId, From, Timeout), - {keep_state, cache_cancel_idle_timer(D)}; + {keep_state, D, cond_set_idle_timer(D)}; handle_event({call,From}, {send_window, ChannelId}, StateName, D) when ?CONNECTED(StateName) -> @@ -1300,7 +1286,7 @@ handle_event({call,From}, {close, ChannelId}, StateName, D0) #channel{remote_id = Id} = Channel -> D1 = send_msg(ssh_connection:channel_close_msg(Id), D0), ssh_client_channel:cache_update(cache(D1), Channel#channel{sent_close = true}), - {keep_state, cache_request_idle_timer_check(D1), [{reply,From,ok}]}; + {keep_state, D1, [cond_set_idle_timer(D1), {reply,From,ok}]}; undefined -> {keep_state_and_data, [{reply,From,ok}]} end; @@ -1316,6 +1302,7 @@ handle_event(info, {Proto, Sock, Info}, {hello,_}, #data{socket = Sock, {keep_state_and_data, [{next_event, internal, {info_line,Info}}]} end; + handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock, transport_protocol = Proto}) -> try ssh_transport:handle_packet_part( @@ -1333,13 +1320,29 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock, try ssh_message:decode(set_kex_overload_prefix(DecryptedBytes,D1)) of - Msg = #ssh_msg_kexinit{} -> + #ssh_msg_kexinit{} = Msg -> {keep_state, D1, [{next_event, internal, prepare_next_packet}, {next_event, internal, {Msg,DecryptedBytes}} ]}; + + #ssh_msg_global_request{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)}; + #ssh_msg_request_success{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)}; + #ssh_msg_request_failure{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)}; + #ssh_msg_channel_open{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)}; + #ssh_msg_channel_open_confirmation{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)}; + #ssh_msg_channel_open_failure{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)}; + #ssh_msg_channel_window_adjust{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)}; + #ssh_msg_channel_data{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)}; + #ssh_msg_channel_extended_data{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)}; + #ssh_msg_channel_eof{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)}; + #ssh_msg_channel_close{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)}; + #ssh_msg_channel_request{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)}; + #ssh_msg_channel_failure{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)}; + #ssh_msg_channel_success{} = Msg -> {keep_state, D1, ?CONNECTION_MSG(Msg)}; + Msg -> {keep_state, D1, [{next_event, internal, prepare_next_packet}, - {next_event, internal, Msg} + {next_event, internal, Msg} ]} catch C:E -> @@ -1418,8 +1421,20 @@ handle_event(info, {timeout, {_, From} = Request}, _, end; %%% Handle that ssh channels user process goes down -handle_event(info, {'DOWN', _Ref, process, ChannelPid, _Reason}, _, D0) -> - {keep_state, handle_channel_down(ChannelPid, D0)}; +handle_event(info, {'DOWN', _Ref, process, ChannelPid, _Reason}, _, D) -> + Cache = cache(D), + ssh_client_channel:cache_foldl( + fun(#channel{user=U, + local_id=Id}, Acc) when U == ChannelPid -> + ssh_client_channel:cache_delete(Cache, Id), + Acc; + (_,Acc) -> + Acc + end, [], Cache), + {keep_state, D, cond_set_idle_timer(D)}; + +handle_event({timeout,idle_time}, _Data, _StateName, _D) -> + {stop, {shutdown, "Timeout"}}; %%% So that terminate will be run when supervisor is shutdown handle_event(info, {'EXIT', _Sup, Reason}, StateName, _) -> @@ -1439,7 +1454,7 @@ handle_event(info, {'EXIT', _Sup, Reason}, StateName, _) -> end; handle_event(info, check_cache, _, D) -> - {keep_state, cache_check_set_idle_timer(D)}; + {keep_state, D, cond_set_idle_timer(D)}; handle_event(info, UnexpectedMessage, StateName, D = #data{ssh_params = Ssh}) -> case unexpected_fun(UnexpectedMessage, D) of @@ -1486,6 +1501,11 @@ handle_event(internal, {send_disconnect,Code,DetailedText,Module,Line}, StateNam send_disconnect(Code, DetailedText, Module, Line, StateName, D0), {stop, Shutdown, D}; + +handle_event(enter, _OldState, State, D) -> + %% Just skip + {next_state, State, D}; + handle_event(_Type, _Msg, {ext_info,Role,_ReNegFlag}, D) -> %% If something else arrives, goto next state and handle the event in that one {next_state, {connected,Role}, D, [postpone]}; @@ -1743,46 +1763,6 @@ call(FsmPid, Event, Timeout) -> end. -handle_connection_msg(Msg, StateName, D0 = #data{starter = User, - connection_state = Connection0, - event_queue = Qev0}) -> - Renegotiation = renegotiation(StateName), - Role = role(StateName), - try ssh_connection:handle_msg(Msg, Connection0, Role) of - {disconnect, Reason0, RepliesConn} -> - {Repls, D} = send_replies(RepliesConn, D0), - case {Reason0,Role} of - {{_, Reason}, client} when ((StateName =/= {connected,client}) and (not Renegotiation)) -> - User ! {self(), not_connected, Reason}; - _ -> - ok - end, - {stop_and_reply, {shutdown,normal}, Repls, D}; - - {[], Connection} -> - {keep_state, D0#data{connection_state = Connection}}; - - {Replies, Connection} when is_list(Replies) -> - {Repls, D} = - case StateName of - {connected,_} -> - send_replies(Replies, D0#data{connection_state=Connection}); - _ -> - {ConnReplies, NonConnReplies} = lists:splitwith(fun not_connected_filter/1, Replies), - send_replies(NonConnReplies, D0#data{event_queue = Qev0 ++ ConnReplies}) - end, - {keep_state, D, Repls} - - catch - Class:Error -> - {Repls, D1} = send_replies(ssh_connection:handle_stop(Connection0), D0), - {Shutdown, D} = ?send_disconnect(?SSH_DISCONNECT_BY_APPLICATION, - io_lib:format("Internal error: ~p:~p",[Class,Error]), - StateName, D1), - {stop_and_reply, Shutdown, Repls, D} - end. - - set_kex_overload_prefix(Msg = <<?BYTE(Op),_/binary>>, #data{ssh_params=SshParams}) when Op == 30; Op == 31 @@ -1888,19 +1868,6 @@ handle_request(ChannelId, Type, Data, WantReply, From, D) -> end. %%%---------------------------------------------------------------- -handle_channel_down(ChannelPid, D) -> - Cache = cache(D), - ssh_client_channel:cache_foldl( - fun(#channel{user=U, - local_id=Id}, Acc) when U == ChannelPid -> - ssh_client_channel:cache_delete(Cache, Id), - Acc; - (_,Acc) -> - Acc - end, [], Cache), - cache_check_set_idle_timer(D). - - update_sys(Cache, Channel, Type, ChannelPid) -> ssh_client_channel:cache_update(Cache, Channel#channel{sys = Type, user = ChannelPid}). @@ -1919,6 +1886,42 @@ new_channel_id(#data{connection_state = #connection{channel_id_seed = Id} = {Id, State#data{connection_state = Connection#connection{channel_id_seed = Id + 1}}}. + +%%%---------------------------------------------------------------- +start_rekeying(Role, D0) -> + {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(D0#data.ssh_params), + send_bytes(SshPacket, D0), + D = D0#data{ssh_params = Ssh, + key_exchange_init_msg = KeyInitMsg}, + {next_state, {kexinit,Role,renegotiate}, D}. + + +init_renegotiate_timers(State, D) -> + {RekeyTimeout,_MaxSent} = ?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts), + {next_state, State, D, [{{timeout,renegotiate}, RekeyTimeout, none}, + {{timeout,check_data_size}, ?REKEY_DATA_TIMOUT, none} ]}. + + +pause_renegotiate_timers(State, D) -> + {next_state, State, D, [{{timeout,renegotiate}, infinity, none}, + {{timeout,check_data_size}, infinity, none} ]}. + +check_data_rekeying(Role, D) -> + {ok, [{send_oct,SocketSentTotal}]} = inet:getstat(D#data.socket, [send_oct]), + SentSinceRekey = SocketSentTotal - D#data.last_size_rekey, + {_RekeyTimeout,MaxSent} = ?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts), + case check_data_rekeying_dbg(SentSinceRekey, MaxSent) of + true -> + start_rekeying(Role, D#data{last_size_rekey = SocketSentTotal}); + _ -> + %% Not enough data sent for a re-negotiation. Restart timer. + {keep_state, D, {{timeout,check_data_size}, ?REKEY_DATA_TIMOUT, none}} + end. + +check_data_rekeying_dbg(SentSinceRekey, MaxSent) -> + %% This function is for the ssh_dbg to trace on. See dbg_trace/3 at the end. + SentSinceRekey >= MaxSent. + %%%---------------------------------------------------------------- %%% This server/client has decided to disconnect via the state machine: %%% The unused arguments are for debugging. @@ -2131,60 +2134,12 @@ retry_fun(User, Reason, #data{ssh_params = #ssh{opts = Opts, %%% Cache idle timer that closes the connection if there are no %%% channels open for a while. -cache_init_idle_timer(D) -> - case ?GET_OPT(idle_time, (D#data.ssh_params)#ssh.opts) of - infinity -> - D#data{idle_timer_value = infinity, - idle_timer_ref = infinity % A flag used later... - }; - IdleTime -> - %% We dont want to set the timeout on first connect - D#data{idle_timer_value = IdleTime} - end. - - -cache_check_set_idle_timer(D = #data{idle_timer_ref = undefined, - idle_timer_value = IdleTime}) -> - %% No timer set - shall we set one? +cond_set_idle_timer(D) -> case ssh_client_channel:cache_info(num_entries, cache(D)) of - 0 when IdleTime == infinity -> - %% No. Meaningless to set a timer that fires in an infinite time... - D; - 0 -> - %% Yes, we'll set one since the cache is empty and it should not - %% be that for a specified time - D#data{idle_timer_ref = - erlang:send_after(IdleTime, self(), {'EXIT',[],"Timeout"})}; - _ -> - %% No - there are entries in the cache - D - end; -cache_check_set_idle_timer(D) -> - %% There is already a timer set or the timeout time is infinite - D. - - -cache_cancel_idle_timer(D) -> - case D#data.idle_timer_ref of - infinity -> - %% The timer is not activated - D; - undefined -> - %% The timer is already cancelled - D; - TimerRef -> - %% The timer is active - erlang:cancel_timer(TimerRef), - D#data{idle_timer_ref = undefined} + 0 -> {{timeout,idle_time}, ?GET_OPT(idle_time, (D#data.ssh_params)#ssh.opts), none}; + _ -> {{timeout,idle_time}, infinity, none} end. - -cache_request_idle_timer_check(D = #data{idle_timer_value = infinity}) -> - D; -cache_request_idle_timer_check(D = #data{idle_timer_value = IdleTime}) -> - erlang:send_after(IdleTime, self(), check_cache), - D. - %%%---------------------------------------------------------------- start_channel_request_timer(_,_, infinity) -> ok; @@ -2245,7 +2200,7 @@ update_inet_buffers(Socket) -> %%%# Tracing %%%# -dbg_trace(points, _, _) -> [terminate, disconnect, connections, connection_events]; +dbg_trace(points, _, _) -> [terminate, disconnect, connections, connection_events, renegotiation]; dbg_trace(flags, connections, A) -> [c] ++ dbg_trace(flags, terminate, A); dbg_trace(on, connections, A) -> dbg:tp(?MODULE, init_connection_handler, 3, x), @@ -2288,6 +2243,33 @@ dbg_trace(format, connection_events, {return_from, {?MODULE,handle_event,4}, Ret io_lib:format("~p~n", [event_handler_result(Ret)]) ]; +dbg_trace(flags, renegotiation, _) -> [c]; +dbg_trace(on, renegotiation, _) -> dbg:tpl(?MODULE, init_renegotiate_timers, 2, x), + dbg:tpl(?MODULE, pause_renegotiate_timers, 2, x), + dbg:tpl(?MODULE, check_data_rekeying_dbg, 2, x), + dbg:tpl(?MODULE, start_rekeying, 2, x); +dbg_trace(off, renegotiation, _) -> dbg:ctpl(?MODULE, init_renegotiate_timers, 2), + dbg:ctpl(?MODULE, pause_renegotiate_timers, 2), + dbg:ctpl(?MODULE, check_data_rekeying_dbg, 2), + dbg:ctpl(?MODULE, start_rekeying, 2); +dbg_trace(format, renegotiation, {call, {?MODULE,init_renegotiate_timers,[_State,D]}}) -> + ["Renegotiation init\n", + io_lib:format("rekey_limit: ~p ({ms,bytes})~ncheck_data_size: ~p (ms)~n", + [?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts), + ?REKEY_DATA_TIMOUT]) + ]; +dbg_trace(format, renegotiation, {call, {?MODULE,pause_renegotiate_timers,[_State,_D]}}) -> + ["Renegotiation pause\n"]; +dbg_trace(format, renegotiation, {call, {?MODULE,start_rekeying,[_Role,_D]}}) -> + ["Renegotiation start rekeying\n"]; +dbg_trace(format, renegotiation, {call, {?MODULE,check_data_rekeying_dbg,[SentSinceRekey, MaxSent]}}) -> + ["Renegotiation check data sent\n", + io_lib:format("TotalSentSinceRekey: ~p~nMaxBeforeRekey: ~p~nStartRekey: ~p~n", + [SentSinceRekey, MaxSent, SentSinceRekey >= MaxSent]) + ]; + + + dbg_trace(flags, terminate, _) -> [c]; dbg_trace(on, terminate, _) -> dbg:tp(?MODULE, terminate, 3, x); dbg_trace(off, terminate, _) -> dbg:ctpg(?MODULE, terminate, 3); diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl index 4dd9082250..fe95d2ac54 100644 --- a/lib/ssh/src/ssh_options.erl +++ b/lib/ssh/src/ssh_options.erl @@ -599,9 +599,24 @@ default(common) -> class => user_options }, - {rekey_limit, def} => % FIXME: Why not common? - #{default => 1024000000, - chk => fun check_non_neg_integer/1, + {rekey_limit, def} => + #{default => {3600000, 1024000000}, % {1 hour, 1 GB} + chk => fun({infinity, infinity}) -> + true; + ({Mins, infinity}) when is_integer(Mins), Mins>0 -> + {true, {Mins*60*1000, infinity}}; + ({infinity, Bytes}) when is_integer(Bytes), Bytes>=0 -> + true; + ({Mins, Bytes}) when is_integer(Mins), Mins>0, + is_integer(Bytes), Bytes>=0 -> + {true, {Mins*60*1000, Bytes}}; + (infinity) -> + {true, {3600000, infinity}}; + (Bytes) when is_integer(Bytes), Bytes>=0 -> + {true, {3600000, Bytes}}; + (_) -> + false + end, class => user_options }, diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index 5984713ec9..9c391abc43 100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -171,21 +171,16 @@ start_channel(Host, Port, UserOptions) -> stop_channel(Pid) -> case is_process_alive(Pid) of true -> - OldValue = process_flag(trap_exit, true), - link(Pid), - exit(Pid, ssh_sftp_stop_channel), - receive - {'EXIT', Pid, normal} -> - ok - after 5000 -> - exit(Pid, kill), - receive - {'EXIT', Pid, killed} -> - ok - end - end, - process_flag(trap_exit, OldValue), - ok; + MonRef = erlang:monitor(process, Pid), + unlink(Pid), + exit(Pid, ssh_sftp_stop_channel), + receive {'DOWN',MonRef,_,_,_} -> ok + after + 1000 -> + exit(Pid, kill), + erlang:demonitor(MonRef, [flush]), + ok + end; false -> ok end. diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index f5bba9f824..631c4d0213 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -1808,9 +1808,10 @@ kex_alg_dependent({E, F, K}) -> %% diffie-hellman and ec diffie-hellman (with E = Q_c, F = Q_s) <<?Empint(E), ?Empint(F), ?Empint(K)>>; -kex_alg_dependent({-1, _, -1, _, _, E, F, K}) -> +kex_alg_dependent({-1, NBits, -1, Prime, Gen, E, F, K}) -> %% ssh_msg_kex_dh_gex_request_old - <<?Empint(E), ?Empint(F), ?Empint(K)>>; + <<?Euint32(NBits), + ?Empint(Prime), ?Empint(Gen), ?Empint(E), ?Empint(F), ?Empint(K)>>; kex_alg_dependent({Min, NBits, Max, Prime, Gen, E, F, K}) -> %% diffie-hellman group exchange @@ -1849,9 +1850,6 @@ public_algo({#'ECPoint'{},{namedCurve,OID}}) -> Curve = public_key:oid2ssh_curvename(OID), list_to_atom("ecdsa-sha2-" ++ binary_to_list(Curve)). - - - sha('ssh-rsa') -> sha; sha('rsa-sha2-256') -> sha256; sha('rsa-sha2-384') -> sha384; diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 1fa94bef11..807e23ff01 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -32,7 +32,7 @@ -define(NEWLINE, <<"\r\n">>). --define(REKEY_DATA_TMO, 65000). +-define(REKEY_DATA_TMO, 1 * 60000). % Should be multiples of 60000 %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- @@ -45,7 +45,6 @@ suite() -> all() -> [{group, all_tests}]. - groups() -> [{all_tests, [parallel], [{group, ssh_renegotiate_SUITE}, {group, ssh_basic_SUITE} @@ -76,8 +75,17 @@ groups() -> shell_exit_status ]}, - {ssh_renegotiate_SUITE, [parallel], [rekey, - rekey_limit, + {ssh_renegotiate_SUITE, [parallel], [rekey0, + rekey1, + rekey2, + rekey3, + rekey4, + rekey_limit_client, + rekey_limit_daemon, + rekey_time_limit_client, + rekey_time_limit_daemon, + norekey_limit_client, + norekey_limit_daemon, renegotiate1, renegotiate2]}, @@ -1325,69 +1333,231 @@ shell_exit_status(Config) when is_list(Config) -> ssh:stop_daemon(Pid). +%%---------------------------------------------------------------------------- %%% Idle timeout test -rekey() -> [{timetrap,{seconds,90}}]. +rekey0() -> [{timetrap,{seconds,90}}]. +rekey1() -> [{timetrap,{seconds,90}}]. +rekey2() -> [{timetrap,{seconds,90}}]. +rekey3() -> [{timetrap,{seconds,90}}]. +rekey4() -> [{timetrap,{seconds,90}}]. -rekey(Config) -> - {Pid, Host, Port} = - ssh_test_lib:std_daemon(Config, - [{rekey_limit, 0}]), - ConnectionRef = - ssh_test_lib:std_connect(Config, Host, Port, - [{rekey_limit, 0}]), +rekey0(Config) -> rekey_chk(Config, 0, 0). +rekey1(Config) -> rekey_chk(Config, infinity, 0). +rekey2(Config) -> rekey_chk(Config, {infinity,infinity}, 0). +rekey3(Config) -> rekey_chk(Config, 0, infinity). +rekey4(Config) -> rekey_chk(Config, 0, {infinity,infinity}). + +rekey_chk(Config, RLdaemon, RLclient) -> + {Pid, Host, Port} = ssh_test_lib:std_daemon(Config, [{rekey_limit, RLdaemon}]), + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{rekey_limit, RLclient}]), Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), - receive - after ?REKEY_DATA_TMO -> - %%By this time rekeying would have been done - Kex2 = ssh_test_lib:get_kex_init(ConnectionRef), - false = (Kex2 == Kex1), - ssh:close(ConnectionRef), - ssh:stop_daemon(Pid) - end. -%%-------------------------------------------------------------------- + %% Make both sides send something: + {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), -%%% Test rekeying by data volume + %% Check rekeying + timer:sleep(?REKEY_DATA_TMO), + ?wait_match(false, Kex1==ssh_test_lib:get_kex_init(ConnectionRef), [], 2000, 10), -rekey_limit() -> [{timetrap,{seconds,400}}]. + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). -rekey_limit(Config) -> +%%-------------------------------------------------------------------- +%%% Test rekeying by data volume + +rekey_limit_client() -> [{timetrap,{seconds,400}}]. +rekey_limit_client(Config) -> + Limit = 6000, UserDir = proplists:get_value(priv_dir, Config), DataFile = filename:join(UserDir, "rekey.data"), - + Data = lists:duplicate(Limit+10,1), Algs = proplists:get_value(preferred_algorithms, Config), {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0}, {preferred_algorithms,Algs}]), - ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{rekey_limit, 6000}, + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{rekey_limit, Limit}, {max_random_length_padding,0}]), {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), + %% Check that it doesn't rekey without data transfer Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), + timer:sleep(?REKEY_DATA_TMO), + true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)), + %% Check that datatransfer triggers rekeying + ok = ssh_sftp:write_file(SftpPid, DataFile, Data), timer:sleep(?REKEY_DATA_TMO), - Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), + ?wait_match(false, Kex1==(Kex2=ssh_test_lib:get_kex_init(ConnectionRef)), Kex2, 2000, 10), - Data = lists:duplicate(159000,1), + %% Check that datatransfer continues to trigger rekeying ok = ssh_sftp:write_file(SftpPid, DataFile, Data), + timer:sleep(?REKEY_DATA_TMO), + ?wait_match(false, Kex2==(Kex3=ssh_test_lib:get_kex_init(ConnectionRef)), Kex3, 2000, 10), + %% Check that it doesn't rekey without data transfer timer:sleep(?REKEY_DATA_TMO), - Kex2 = ssh_test_lib:get_kex_init(ConnectionRef), + true = (Kex3 == ssh_test_lib:get_kex_init(ConnectionRef)), - false = (Kex2 == Kex1), + %% Check that it doesn't rekey on a small datatransfer + ok = ssh_sftp:write_file(SftpPid, DataFile, "hi\n"), + timer:sleep(?REKEY_DATA_TMO), + true = (Kex3 == ssh_test_lib:get_kex_init(ConnectionRef)), + %% Check that it doesn't rekey without data transfer timer:sleep(?REKEY_DATA_TMO), - Kex2 = ssh_test_lib:get_kex_init(ConnectionRef), + true = (Kex3 == ssh_test_lib:get_kex_init(ConnectionRef)), - ok = ssh_sftp:write_file(SftpPid, DataFile, "hi\n"), + ssh_sftp:stop_channel(SftpPid), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + + + +rekey_limit_daemon() -> [{timetrap,{seconds,400}}]. +rekey_limit_daemon(Config) -> + Limit = 6000, + UserDir = proplists:get_value(priv_dir, Config), + DataFile1 = filename:join(UserDir, "rekey1.data"), + DataFile2 = filename:join(UserDir, "rekey2.data"), + file:write_file(DataFile1, lists:duplicate(Limit+10,1)), + file:write_file(DataFile2, "hi\n"), + Algs = proplists:get_value(preferred_algorithms, Config), + {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{rekey_limit, Limit}, + {max_random_length_padding,0}, + {preferred_algorithms,Algs}]), + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{max_random_length_padding,0}]), + {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), + + %% Check that it doesn't rekey without data transfer + Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), timer:sleep(?REKEY_DATA_TMO), - Kex2 = ssh_test_lib:get_kex_init(ConnectionRef), + Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), - false = (Kex2 == Kex1), + %% Check that datatransfer triggers rekeying + {ok,_} = ssh_sftp:read_file(SftpPid, DataFile1), + timer:sleep(?REKEY_DATA_TMO), + ?wait_match(false, Kex1==(Kex2=ssh_test_lib:get_kex_init(ConnectionRef)), Kex2, 2000, 10), + %% Check that datatransfer continues to trigger rekeying + {ok,_} = ssh_sftp:read_file(SftpPid, DataFile1), timer:sleep(?REKEY_DATA_TMO), - Kex2 = ssh_test_lib:get_kex_init(ConnectionRef), + ?wait_match(false, Kex2==(Kex3=ssh_test_lib:get_kex_init(ConnectionRef)), Kex3, 2000, 10), + + %% Check that it doesn't rekey without data transfer + timer:sleep(?REKEY_DATA_TMO), + true = (Kex3 == ssh_test_lib:get_kex_init(ConnectionRef)), + + %% Check that it doesn't rekey on a small datatransfer + {ok,_} = ssh_sftp:read_file(SftpPid, DataFile2), + timer:sleep(?REKEY_DATA_TMO), + true = (Kex3 == ssh_test_lib:get_kex_init(ConnectionRef)), + + %% Check that it doesn't rekey without data transfer + timer:sleep(?REKEY_DATA_TMO), + true = (Kex3 == ssh_test_lib:get_kex_init(ConnectionRef)), + + ssh_sftp:stop_channel(SftpPid), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + + +%%-------------------------------------------------------------------- +%% Check that datatransfer in the other direction does not trigger re-keying +norekey_limit_client() -> [{timetrap,{seconds,400}}]. +norekey_limit_client(Config) -> + Limit = 6000, + UserDir = proplists:get_value(priv_dir, Config), + DataFile = filename:join(UserDir, "rekey3.data"), + file:write_file(DataFile, lists:duplicate(Limit+10,1)), + + Algs = proplists:get_value(preferred_algorithms, Config), + {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0}, + {preferred_algorithms,Algs}]), + + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{rekey_limit, Limit}, + {max_random_length_padding,0}]), + {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), + + Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), + timer:sleep(?REKEY_DATA_TMO), + true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)), + + {ok,_} = ssh_sftp:read_file(SftpPid, DataFile), + timer:sleep(?REKEY_DATA_TMO), + true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)), + + ssh_sftp:stop_channel(SftpPid), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + +%% Check that datatransfer in the other direction does not trigger re-keying +norekey_limit_daemon() -> [{timetrap,{seconds,400}}]. +norekey_limit_daemon(Config) -> + Limit = 6000, + UserDir = proplists:get_value(priv_dir, Config), + DataFile = filename:join(UserDir, "rekey4.data"), + + Algs = proplists:get_value(preferred_algorithms, Config), + {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{rekey_limit, Limit}, + {max_random_length_padding,0}, + {preferred_algorithms,Algs}]), + + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{max_random_length_padding,0}]), + {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), + + Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), + timer:sleep(?REKEY_DATA_TMO), + true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)), + + ok = ssh_sftp:write_file(SftpPid, DataFile, lists:duplicate(Limit+10,1)), + timer:sleep(?REKEY_DATA_TMO), + true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)), + + ssh_sftp:stop_channel(SftpPid), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- +%%% Test rekeying by time + +rekey_time_limit_client() -> [{timetrap,{seconds,400}}]. +rekey_time_limit_client(Config) -> + Minutes = ?REKEY_DATA_TMO div 60000, + GB = 1024*1000*1000, + Algs = proplists:get_value(preferred_algorithms, Config), + {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0}, + {preferred_algorithms,Algs}]), + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{rekey_limit, {Minutes, GB}}, + {max_random_length_padding,0}]), + rekey_time_limit(Pid, ConnectionRef). + +rekey_time_limit_daemon() -> [{timetrap,{seconds,400}}]. +rekey_time_limit_daemon(Config) -> + Minutes = ?REKEY_DATA_TMO div 60000, + GB = 1024*1000*1000, + Algs = proplists:get_value(preferred_algorithms, Config), + {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{rekey_limit, {Minutes, GB}}, + {max_random_length_padding,0}, + {preferred_algorithms,Algs}]), + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{max_random_length_padding,0}]), + rekey_time_limit(Pid, ConnectionRef). + + +rekey_time_limit(Pid, ConnectionRef) -> + {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), + Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), + + timer:sleep(5000), + true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)), + + %% Check that it rekeys when the max time + 30s has passed + timer:sleep(?REKEY_DATA_TMO + 30*1000), + ?wait_match(false, Kex1==(Kex2=ssh_test_lib:get_kex_init(ConnectionRef)), Kex2, 2000, 10), + + %% Check that it does not rekey when nothing is transferred + timer:sleep(?REKEY_DATA_TMO + 30*1000), + ?wait_match(false, Kex2==ssh_test_lib:get_kex_init(ConnectionRef), [], 2000, 10), ssh_sftp:stop_channel(SftpPid), ssh:close(ConnectionRef), @@ -1395,7 +1565,7 @@ rekey_limit(Config) -> %%-------------------------------------------------------------------- -%%% Test rekeying with simulataneous send request +%%% Test rekeying with simultaneous send request renegotiate1(Config) -> UserDir = proplists:get_value(priv_dir, Config), diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 57ae2dbac2..65970535f4 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -926,7 +926,7 @@ get_kex_init(Conn, Ref, TRef) -> end; false -> - ct:log("Not in 'connected' state: ~p",[State]), + ct:log("~p:~p Not in 'connected' state: ~p",[?MODULE,?LINE,State]), receive {reneg_timeout,Ref} -> ct:log("S = ~p", [S]), diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index f327d2ec11..f10e7aa96a 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,4 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.6.8 +SSH_VSN = 4.6.9 + APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl index 3e9828a2fe..d45f209838 100644 --- a/lib/ssl/src/inet_tls_dist.erl +++ b/lib/ssl/src/inet_tls_dist.erl @@ -518,51 +518,16 @@ gen_setup(Driver, Node, Type, MyNode, LongOrShortNames, SetupTime) -> do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> {Name, Address} = split_node(Driver, Node, LongOrShortNames), - case Driver:getaddr(Address) of + ErlEpmd = net_kernel:epmd_module(), + {ARMod, ARFun} = get_address_resolver(ErlEpmd, Driver), + Timer = trace(dist_util:start_timer(SetupTime)), + case ARMod:ARFun(Address) of + {ok, Ip, TcpPort, Version} -> + do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNode, Timer); {ok, Ip} -> - Timer = trace(dist_util:start_timer(SetupTime)), - ErlEpmd = net_kernel:epmd_module(), case ErlEpmd:port_please(Name, Ip) of {port, TcpPort, Version} -> - Opts = - trace( - connect_options( - %% - %% Use verify_server/3 to verify that - %% the server's certificate is for Node - %% - setup_verify_server( - get_ssl_options(client), Node))), - dist_util:reset_timer(Timer), - case ssl:connect( - Address, TcpPort, - [binary, {active, false}, {packet, 4}, - Driver:family(), nodelay()] ++ Opts, - net_kernel:connecttime()) of - {ok, #sslsocket{pid = DistCtrl} = SslSocket} -> - _ = monitor_pid(DistCtrl), - ok = ssl:controlling_process(SslSocket, self()), - HSData0 = hs_data_common(SslSocket), - HSData = - HSData0#hs_data{ - kernel_pid = Kernel, - other_node = Node, - this_node = MyNode, - socket = DistCtrl, - timer = Timer, - this_flags = 0, - other_version = Version, - request_type = Type}, - link(DistCtrl), - dist_util:handshake_we_started(trace(HSData)); - Other -> - %% Other Node may have closed since - %% port_please ! - ?shutdown2( - Node, - trace( - {ssl_connect_failed, Ip, TcpPort, Other})) - end; + do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNode, Timer); Other -> ?shutdown2( Node, @@ -575,6 +540,47 @@ do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> trace({getaddr_failed, Driver, Address, Other})) end. +do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNode, Timer) -> + Opts = + trace( + connect_options( + %% + %% Use verify_server/3 to verify that + %% the server's certificate is for Node + %% + setup_verify_server( + get_ssl_options(client), Node))), + dist_util:reset_timer(Timer), + case ssl:connect( + Address, TcpPort, + [binary, {active, false}, {packet, 4}, + Driver:family(), nodelay()] ++ Opts, + net_kernel:connecttime()) of + {ok, #sslsocket{pid = DistCtrl} = SslSocket} -> + _ = monitor_pid(DistCtrl), + ok = ssl:controlling_process(SslSocket, self()), + HSData0 = hs_data_common(SslSocket), + HSData = + HSData0#hs_data{ + kernel_pid = Kernel, + other_node = Node, + this_node = MyNode, + socket = DistCtrl, + timer = Timer, + this_flags = 0, + other_version = Version, + request_type = Type}, + link(DistCtrl), + dist_util:handshake_we_started(trace(HSData)); + Other -> + %% Other Node may have closed since + %% port_please ! + ?shutdown2( + Node, + trace( + {ssl_connect_failed, Ip, TcpPort, Other})) + end. + close(Socket) -> gen_close(inet, Socket). @@ -644,6 +650,16 @@ verify_server(PeerCert, valid_peer, {CertNodesFun,Node} = S) -> %% ------------------------------------------------------------ +%% Determine if EPMD module supports address resolving. Default +%% is to use inet_tcp:getaddr/2. +%% ------------------------------------------------------------ +get_address_resolver(EpmdModule, Driver) -> + case erlang:function_exported(EpmdModule, address_please, 3) of + true -> {EpmdModule, address_please}; + _ -> {Driver, getaddr} + end. + +%% ------------------------------------------------------------ %% Do only accept new connection attempts from nodes at our %% own LAN, if the check_ip environment parameter is true. %% ------------------------------------------------------------ diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 5b6d92ebf4..fb13a1ce7e 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -23,9 +23,17 @@ %%% Purpose : Main API module for SSL see also tls.erl and dtls.erl -module(ssl). --include("ssl_internal.hrl"). + -include_lib("public_key/include/public_key.hrl"). +-include("ssl_internal.hrl"). +-include("ssl_api.hrl"). +-include("ssl_internal.hrl"). +-include("ssl_record.hrl"). +-include("ssl_cipher.hrl"). +-include("ssl_handshake.hrl"). +-include("ssl_srp.hrl"). + %% Application handling -export([start/0, start/1, stop/0, clear_pem_cache/0]). @@ -39,8 +47,8 @@ close/1, close/2, shutdown/2, recv/2, recv/3, send/2, getopts/2, setopts/2, getstat/1, getstat/2 ]). -%% SSL/TLS protocol handling +%% SSL/TLS protocol handling -export([cipher_suites/0, cipher_suites/1, cipher_suites/2, filter_cipher_suites/2, prepend_cipher_suites/2, append_cipher_suites/2, eccs/0, eccs/1, versions/0, @@ -49,14 +57,9 @@ %% Misc -export([handle_options/2, tls_version/1, new_ssl_options/3]). --include("ssl_api.hrl"). --include("ssl_internal.hrl"). --include("ssl_record.hrl"). --include("ssl_cipher.hrl"). --include("ssl_handshake.hrl"). --include("ssl_srp.hrl"). - --include_lib("public_key/include/public_key.hrl"). +-deprecated({ssl_accept, 1, eventually}). +-deprecated({ssl_accept, 2, eventually}). +-deprecated({ssl_accept, 3, eventually}). %%-------------------------------------------------------------------- -spec start() -> ok | {error, reason()}. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 0956d3501d..3f8b9a8a9b 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -2230,7 +2230,7 @@ filter(DerCert, Ciphers0, Version) -> Ciphers0, Version, OtpCert), {_, Sign} = public_key:pkix_sign_types(SigAlg#'SignatureAlgorithm'.algorithm), filter_suites_signature(Sign, Ciphers, Version). - + %%-------------------------------------------------------------------- -spec filter_suites([erl_cipher_suite()] | [cipher_suite()], map()) -> [erl_cipher_suite()] | [cipher_suite()]. @@ -2662,29 +2662,33 @@ next_iv(Bin, IV) -> <<_:FirstPart/binary, NextIV:IVSz/binary>> = Bin, NextIV. - -filter_suites_pubkey(rsa, CiphersSuites0, Version, OtpCert) -> +filter_suites_pubkey(rsa, CiphersSuites0, _Version, OtpCert) -> KeyUses = key_uses(OtpCert), + NotECDSAKeyed = (CiphersSuites0 -- ec_keyed_suites(CiphersSuites0)) + -- dss_keyed_suites(CiphersSuites0), CiphersSuites = filter_keyuse_suites(keyEncipherment, KeyUses, - (CiphersSuites0 -- ec_keyed_suites(CiphersSuites0)) - -- dss_keyed_suites(CiphersSuites0), + NotECDSAKeyed, rsa_suites_encipher(CiphersSuites0)), filter_keyuse_suites(digitalSignature, KeyUses, CiphersSuites, - rsa_signed_suites(CiphersSuites, Version)); -filter_suites_pubkey(dsa, Ciphers, _, _OtpCert) -> - (Ciphers -- rsa_keyed_suites(Ciphers)) -- ec_keyed_suites(Ciphers); + rsa_ecdhe_dhe_suites(CiphersSuites)); +filter_suites_pubkey(dsa, Ciphers, _, OtpCert) -> + KeyUses = key_uses(OtpCert), + NotECRSAKeyed = (Ciphers -- rsa_keyed_suites(Ciphers)) -- ec_keyed_suites(Ciphers), + filter_keyuse_suites(digitalSignature, KeyUses, NotECRSAKeyed, + dss_dhe_suites(Ciphers)); filter_suites_pubkey(ec, Ciphers, _, OtpCert) -> - Uses = key_uses(OtpCert), - filter_keyuse_suites(digitalSignature, Uses, - (Ciphers -- rsa_keyed_suites(Ciphers)) -- dss_keyed_suites(Ciphers), - ecdsa_sign_suites(Ciphers)). + Uses = key_uses(OtpCert), + NotRSADSAKeyed = (Ciphers -- rsa_keyed_suites(Ciphers)) -- dss_keyed_suites(Ciphers), + CiphersSuites = filter_keyuse_suites(digitalSignature, Uses, NotRSADSAKeyed, + ec_ecdhe_suites(Ciphers)), + filter_keyuse_suites(keyAgreement, Uses, CiphersSuites, ec_ecdh_suites(Ciphers)). filter_suites_signature(rsa, Ciphers, Version) -> - Ciphers -- ecdsa_signed_suites(Ciphers, Version) -- dsa_signed_suites(Ciphers, Version); + (Ciphers -- ecdsa_signed_suites(Ciphers, Version)) -- dsa_signed_suites(Ciphers, Version); filter_suites_signature(dsa, Ciphers, Version) -> - Ciphers -- ecdsa_signed_suites(Ciphers, Version) -- rsa_signed_suites(Ciphers, Version); + (Ciphers -- ecdsa_signed_suites(Ciphers, Version)) -- rsa_signed_suites(Ciphers, Version); filter_suites_signature(ecdsa, Ciphers, Version) -> - Ciphers -- rsa_signed_suites(Ciphers, Version) -- dsa_signed_suites(Ciphers, Version). + (Ciphers -- rsa_signed_suites(Ciphers, Version)) -- dsa_signed_suites(Ciphers, Version). %% From RFC 5246 - Section 7.4.2. Server Certificate @@ -2751,8 +2755,6 @@ rsa_keyed(rsa_psk) -> true; rsa_keyed(srp_rsa) -> true; -rsa_keyed(ecdhe_rsa) -> - true; rsa_keyed(_) -> false. @@ -2793,24 +2795,22 @@ dsa_signed_suites(Ciphers, Version) -> cipher_filters => [], mac_filters => [], prf_filters => []}). - -dsa_signed({3,N}) when N >= 3 -> - fun(dhe_dss) -> true; - (ecdhe_dss) -> true; - (_) -> false - end; dsa_signed(_) -> fun(dhe_dss) -> true; - (ecdh_dss) -> true; - (ecdhe_dss) -> true; (_) -> false end. +dss_dhe_suites(Ciphers) -> + filter_suites(Ciphers, #{key_exchange_filters => [fun(dhe_dss) -> true; + (_) -> false + end], + cipher_filters => [], + mac_filters => [], + prf_filters => []}). + ec_keyed(ecdh_ecdsa) -> true; -ec_keyed(ecdhe_ecdsa) -> - true; -ec_keyed(ecdh_rsa) -> +ec_keyed(ecdh_rsa) -> true; ec_keyed(_) -> false. @@ -2822,9 +2822,28 @@ ec_keyed_suites(Ciphers) -> mac_filters => [], prf_filters => []}). -%% EC Certs key can be used for signing -ecdsa_sign_suites(Ciphers)-> +%% EC Certs key usage keyAgreement +ec_ecdh_suites(Ciphers)-> + filter_suites(Ciphers, #{key_exchange_filters => [fun(ecdh_ecdsa) -> true; + (_) -> false + end], + cipher_filters => [], + mac_filters => [], + prf_filters => []}). + +%% EC Certs key usage digitalSignature +ec_ecdhe_suites(Ciphers) -> filter_suites(Ciphers, #{key_exchange_filters => [fun(ecdhe_ecdsa) -> true; + (ecdhe_rsa) -> true; + (_) -> false + end], + cipher_filters => [], + mac_filters => [], + prf_filters => []}). +%% RSA Certs key usage digitalSignature +rsa_ecdhe_dhe_suites(Ciphers) -> + filter_suites(Ciphers, #{key_exchange_filters => [fun(dhe_rsa) -> true; + (ecdhe_rsa) -> true; (_) -> false end], cipher_filters => [], @@ -2837,11 +2856,14 @@ key_uses(OtpCert) -> Extensions = ssl_certificate:extensions_list(TBSExtensions), case ssl_certificate:select_extension(?'id-ce-keyUsage', Extensions) of undefined -> - undefined; + []; #'Extension'{extnValue = KeyUses} -> KeyUses end. +%% If no key-usage extension is defined all key-usages are allowed +filter_keyuse_suites(_, [], CiphersSuites, _) -> + CiphersSuites; filter_keyuse_suites(Use, KeyUse, CipherSuits, Suites) -> case ssl_certificate:is_valid_key_usage(KeyUse, Use) of true -> diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 090e7b69b7..ebbb633b22 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -2233,13 +2233,12 @@ sign_algo(Alg) -> is_acceptable_hash_sign(Algos, _, _, KeyExAlgo, SupportedHashSigns) when KeyExAlgo == dh_dss; KeyExAlgo == dh_rsa; - KeyExAlgo == ecdh_ecdsa; KeyExAlgo == ecdh_rsa; KeyExAlgo == ecdh_ecdsa -> %% *dh_* could be called only *dh in TLS-1.2 is_acceptable_hash_sign(Algos, SupportedHashSigns); -is_acceptable_hash_sign(Algos, rsa, ecdsa, ecdh_rsa, SupportedHashSigns) -> +is_acceptable_hash_sign(Algos, rsa, ecdsa, ecdhe_rsa, SupportedHashSigns) -> is_acceptable_hash_sign(Algos, SupportedHashSigns); is_acceptable_hash_sign({_, rsa} = Algos, rsa, _, dhe_rsa, SupportedHashSigns) -> is_acceptable_hash_sign(Algos, SupportedHashSigns); @@ -2270,7 +2269,7 @@ is_acceptable_hash_sign(_, _, _, KeyExAlgo, _) when KeyExAlgo == ecdhe_anon -> true; -is_acceptable_hash_sign(_,_, _,_,_) -> +is_acceptable_hash_sign(_,_,_,_,_) -> false. is_acceptable_hash_sign(Algos, SupportedHashSigns) -> lists:member(Algos, SupportedHashSigns). diff --git a/lib/ssl/test/ssl_ECC.erl b/lib/ssl/test/ssl_ECC.erl index 2096cf8166..36d949f74b 100644 --- a/lib/ssl/test/ssl_ECC.erl +++ b/lib/ssl/test/ssl_ECC.erl @@ -34,53 +34,65 @@ %% ECDH_RSA client_ecdh_rsa_server_ecdh_rsa(Config) when is_list(Config) -> + Ext = x509_test:extensions([{key_usage, [keyAgreement]}]), Suites = all_rsa_suites(Config), Default = ssl_test_lib:default_cert_chain_conf(), - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, + [[], [], [{extensions, Ext}]]}, {client_chain, Default}], ecdh_rsa, ecdh_rsa, Config), ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config), ssl_test_lib:ssl_options(SOpts, Config), [{check_keyex, ecdh_rsa}, {ciphers, Suites} | proplists:delete(check_keyex, Config)]). client_ecdhe_rsa_server_ecdh_rsa(Config) when is_list(Config) -> + Ext = x509_test:extensions([{key_usage, [keyAgreement]}]), Suites = all_rsa_suites(Config), Default = ssl_test_lib:default_cert_chain_conf(), - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, + [[], [], [{extensions, Ext}]]}, {client_chain, Default}], ecdhe_rsa, ecdh_rsa, Config), ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config), ssl_test_lib:ssl_options(SOpts, Config), [{check_keyex, ecdh_rsa}, {ciphers, Suites} | proplists:delete(check_keyex, Config)]). client_ecdhe_ecdsa_server_ecdh_rsa(Config) when is_list(Config) -> + Ext = x509_test:extensions([{key_usage, [keyAgreement]}]), Suites = all_rsa_suites(Config), Default = ssl_test_lib:default_cert_chain_conf(), - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, + [[], [], [{extensions, Ext}]]}, {client_chain, Default}], ecdhe_ecdsa, ecdh_rsa, Config), ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config), - ssl_test_lib:ssl_options(SOpts, Config), - [{check_keyex, ecdh_rsa}, {ciphers, Suites} | proplists:delete(check_keyex, Config)]). + ssl_test_lib:ssl_options(SOpts, Config), + [{check_keyex, ecdh_rsa}, {ciphers, Suites} | proplists:delete(check_keyex, Config)]). %% ECDHE_RSA client_ecdh_rsa_server_ecdhe_rsa(Config) when is_list(Config) -> + Ext = x509_test:extensions([{key_usage, [digitalSignature]}]), Default = ssl_test_lib:default_cert_chain_conf(), - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, + [[], [], [{extensions, Ext}]]}, {client_chain, Default}], ecdh_rsa, ecdhe_rsa, Config), ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config), ssl_test_lib:ssl_options(SOpts, Config), [{check_keyex, ecdhe_rsa} | proplists:delete(check_keyex, Config)]). client_ecdhe_rsa_server_ecdhe_rsa(Config) when is_list(Config) -> + Ext = x509_test:extensions([{key_usage, [digitalSignature]}]), Default = ssl_test_lib:default_cert_chain_conf(), - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, + [[], [], [{extensions, Ext}]]}, {client_chain, Default}], ecdhe_rsa, ecdhe_rsa, Config), ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config), - ssl_test_lib:ssl_options(SOpts, Config), + ssl_test_lib:ssl_options(SOpts, Config), [{check_keyex, ecdhe_rsa} | proplists:delete(check_keyex, Config)]). client_ecdhe_ecdsa_server_ecdhe_rsa(Config) when is_list(Config) -> + Ext = x509_test:extensions([{key_usage, [digitalSignature]}]), Default = ssl_test_lib:default_cert_chain_conf(), - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, + [[], [], [{extensions, Ext}]]}, {client_chain, Default}], ecdh_ecdsa, ecdhe_rsa, Config), ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config), @@ -122,24 +134,30 @@ client_ecdhe_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) -> %% ECDHE_ECDSA client_ecdh_rsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> - Default = ssl_test_lib:default_cert_chain_conf(), - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, + Ext = x509_test:extensions([{key_usage, [digitalSignature]}]), + Default = ssl_test_lib:default_cert_chain_conf(), + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, + [[], [], [{extensions, Ext}]]}, {client_chain, Default}], ecdh_rsa, ecdhe_ecdsa, Config), ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config), ssl_test_lib:ssl_options(SOpts, Config), [{check_keyex, ecdhe_ecdsa} | proplists:delete(check_keyex, Config)]). client_ecdh_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> + Ext = x509_test:extensions([{key_usage, [digitalSignature]}]), Default = ssl_test_lib:default_cert_chain_conf(), - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, + [[], [], [{extensions, Ext}]]}, {client_chain, Default}], ecdh_ecdsa, ecdhe_ecdsa, Config), ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config), ssl_test_lib:ssl_options(SOpts, Config), [{check_keyex, ecdhe_ecdsa} | proplists:delete(check_keyex, Config)]). client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> + Ext = x509_test:extensions([{key_usage, [digitalSignature]}]), Default = ssl_test_lib:default_cert_chain_conf(), - {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, + {COpts, SOpts} = ssl_test_lib:make_ec_cert_chains([{server_chain, + [[], [], [{extensions, Ext}]]}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, Config), ssl_test_lib:basic_test(ssl_test_lib:ssl_options(COpts, Config), diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index fe4f02f100..d3b13050e3 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -273,7 +273,8 @@ init_per_suite(Config0) -> proplists:get_value(priv_dir, Config0)), Config1 = ssl_test_lib:make_dsa_cert(Config0), Config2 = ssl_test_lib:make_ecdsa_cert(Config1), - Config = ssl_test_lib:make_ecdh_rsa_cert(Config2), + Config3 = ssl_test_lib:make_rsa_cert(Config2), + Config = ssl_test_lib:make_ecdh_rsa_cert(Config3), ssl_test_lib:cert_options(Config) catch _:_ -> {skip, "Crypto did not start"} @@ -3180,10 +3181,10 @@ der_input(Config) when is_list(Config) -> Size = ets:info(CADb, size), - SeverVerifyOpts = ssl_test_lib:ssl_options(server_opts, Config), + SeverVerifyOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {ServerCert, ServerKey, ServerCaCerts, DHParams} = der_input_opts([{dhfile, DHParamFile} | SeverVerifyOpts]), - ClientVerifyOpts = ssl_test_lib:ssl_options(client_opts, Config), + ClientVerifyOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), {ClientCert, ClientKey, ClientCaCerts, DHParams} = der_input_opts([{dhfile, DHParamFile} | ClientVerifyOpts]), ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true}, diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 4022f49077..8c27571d64 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1597,6 +1597,8 @@ openssl_sane_dtls() -> false; "OpenSSL 1.0.2n" ++ _ -> false; + "OpenSSL 1.0.2m" ++ _ -> + false; "OpenSSL 1.0.0" ++ _ -> false; "OpenSSL" ++ _ -> @@ -1768,9 +1770,12 @@ supports_ssl_tls_version(sslv2 = Version) -> VersionFlag = version_flag(Version), Exe = "openssl", Args = ["s_client", VersionFlag], + [{trap_exit, Trap}] = process_info(self(), [trap_exit]), + process_flag(trap_exit, true), Port = ssl_test_lib:portable_open_port(Exe, Args), Bool = do_supports_ssl_tls_version(Port, ""), consume_port_exit(Port), + process_flag(trap_exit, Trap), Bool end; diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index 508a4fa2de..5c6b714f80 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -71,7 +71,6 @@ XML_REF3_FILES = \ gen_statem.xml \ io.xml \ io_lib.xml \ - lib.xml \ lists.xml \ log_mf_h.xml \ maps.xml \ diff --git a/lib/stdlib/doc/src/lib.xml b/lib/stdlib/doc/src/lib.xml deleted file mode 100644 index 58dad7c9e0..0000000000 --- a/lib/stdlib/doc/src/lib.xml +++ /dev/null @@ -1,103 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <header> - <copyright> - <year>1996</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>lib</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <module>lib</module> - <modulesummary>Useful library functions.</modulesummary> - <description> - <warning> - <p>This module is retained for backward compatibility. It can disappear - without warning in a future Erlang/OTP release.</p> - </warning> - </description> - - <funcs> - <func> - <name name="error_message" arity="2"/> - <fsummary>Print error message.</fsummary> - <desc> - <p>Prints error message <c><anno>Args</anno></c> in accordance with - <c><anno>Format</anno></c>. Similar to - <seealso marker="io#format/1"><c>io:format/2</c></seealso>.</p> - </desc> - </func> - - <func> - <name name="flush_receive" arity="0"/> - <fsummary>Flush messages.</fsummary> - <desc> - <p>Flushes the message buffer of the current process.</p> - </desc> - </func> - - <func> - <name name="nonl" arity="1"/> - <fsummary>Remove last newline.</fsummary> - <desc> - <p>Removes the last newline character, if any, in - <c><anno>String1</anno></c>.</p> - </desc> - </func> - - <func> - <name name="progname" arity="0"/> - <fsummary>Return name of Erlang start script.</fsummary> - <desc> - <p>Returns the name of the script that started the current - Erlang session.</p> - </desc> - </func> - - <func> - <name name="send" arity="2"/> - <fsummary>Send a message.</fsummary> - <desc> - <p>Makes it possible to send a message using the <c>apply/3</c> BIF.</p> - </desc> - </func> - - <func> - <name name="sendw" arity="2"/> - <fsummary>Send a message and wait for an answer.</fsummary> - <desc> - <p>As <seealso marker="#send/2"><c>send/2</c></seealso>, - but waits for an answer. It is implemented as follows:</p> - <code type="none"> -sendw(To, Msg) -> - To ! {self(),Msg}, - receive - Reply -> Reply - end.</code> - <p>The returned message is not necessarily a reply to the sent - message.</p> - </desc> - </func> - </funcs> -</erlref> - diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml index 68bfddbc71..c6f30d272d 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -66,7 +66,6 @@ <xi:include href="gen_statem.xml"/> <xi:include href="io.xml"/> <xi:include href="io_lib.xml"/> - <xi:include href="lib.xml"/> <xi:include href="lists.xml"/> <xi:include href="log_mf_h.xml"/> <xi:include href="maps.xml"/> diff --git a/lib/stdlib/doc/src/specs.xml b/lib/stdlib/doc/src/specs.xml index d559adf9b6..fd2d625685 100644 --- a/lib/stdlib/doc/src/specs.xml +++ b/lib/stdlib/doc/src/specs.xml @@ -33,7 +33,6 @@ <xi:include href="../specs/specs_gen_statem.xml"/> <xi:include href="../specs/specs_io.xml"/> <xi:include href="../specs/specs_io_lib.xml"/> - <xi:include href="../specs/specs_lib.xml"/> <xi:include href="../specs/specs_lists.xml"/> <xi:include href="../specs/specs_log_mf_h.xml"/> <xi:include href="../specs/specs_maps.xml"/> diff --git a/lib/stdlib/doc/src/string.xml b/lib/stdlib/doc/src/string.xml index c7772d63a3..4a3d37dcb6 100644 --- a/lib/stdlib/doc/src/string.xml +++ b/lib/stdlib/doc/src/string.xml @@ -641,7 +641,7 @@ ÖÄAÌŠ</pre> <note><p> The functions are kept for backward compatibility, but are not recommended. - They will be deprecated in Erlang/OTP 21. + They will be deprecated in a future release. </p> <p>Any undocumented functions in <c>string</c> are not to be used.</p> </note> diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index dc3735055a..dfe6bf3e68 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -62,6 +62,7 @@ MODULES= \ erl_anno \ erl_bits \ erl_compile \ + erl_error \ erl_eval \ erl_expand_records \ erl_internal \ @@ -91,7 +92,6 @@ MODULES= \ io_lib_format \ io_lib_fread \ io_lib_pretty \ - lib \ lists \ log_mf_h \ maps \ @@ -176,6 +176,7 @@ docs: primary_bootstrap_compiler: \ $(BOOTSTRAP_COMPILER)/ebin/epp.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_anno.beam \ + $(BOOTSTRAP_COMPILER)/ebin/erl_error.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_scan.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_parse.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_lint.beam \ diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 77cc88eb08..cc34d4bdd3 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -38,7 +38,7 @@ -type epp_handle() :: pid(). -type source_encoding() :: latin1 | utf8. --type ifdef() :: 'ifdef' | 'ifndef' | 'else'. +-type ifdef() :: 'ifdef' | 'ifndef' | 'if' | 'else'. -type name() :: atom(). -type argspec() :: 'none' %No arguments @@ -221,6 +221,8 @@ format_error({illegal_function,Macro}) -> io_lib:format("?~s can only be used within a function", [Macro]); format_error({illegal_function_usage,Macro}) -> io_lib:format("?~s must not begin a form", [Macro]); +format_error(elif_after_else) -> + "'elif' following 'else'"; format_error({'NYI',What}) -> io_lib:format("not yet implemented '~s'", [What]); format_error({error,Term}) -> @@ -571,6 +573,7 @@ init_server(Pid, Name, Options, St0) -> predef_macros(File) -> Machine = list_to_atom(erlang:system_info(machine)), Anno = line1(), + OtpVersion = list_to_integer(erlang:system_info(otp_release)), Defs = [{'FILE', {none,[{string,Anno,File}]}}, {'FUNCTION_NAME', undefined}, {'FUNCTION_ARITY', undefined}, @@ -580,7 +583,8 @@ predef_macros(File) -> {'BASE_MODULE', undefined}, {'BASE_MODULE_STRING', undefined}, {'MACHINE', {none,[{atom,Anno,Machine}]}}, - {Machine, {none,[{atom,Anno,true}]}} + {Machine, {none,[{atom,Anno,true}]}}, + {'OTP_RELEASE', {none,[{integer,Anno,OtpVersion}]}} ], maps:from_list(Defs). @@ -1085,21 +1089,118 @@ scan_else(_Toks, Else, From, St) -> epp_reply(From, {error,{loc(Else),epp,{bad,'else'}}}), wait_req_scan(St). -%% scan_if(Tokens, EndifToken, From, EppState) +%% scan_if(Tokens, IfToken, From, EppState) %% Handle the conditional parsing of a file. -%% Report a badly formed if test and then treat as false macro. +scan_if([{'(',_}|_]=Toks, If, From, St) -> + try eval_if(Toks, St) of + true -> + scan_toks(From, St#epp{istk=['if'|St#epp.istk]}); + _ -> + skip_toks(From, St, ['if']) + catch + throw:Error0 -> + Error = case Error0 of + {_,erl_parse,_} -> + {error,Error0}; + _ -> + {error,{loc(If),epp,Error0}} + end, + epp_reply(From, Error), + wait_req_skip(St, ['if']) + end; scan_if(_Toks, If, From, St) -> - epp_reply(From, {error,{loc(If),epp,{'NYI','if'}}}), + epp_reply(From, {error,{loc(If),epp,{bad,'if'}}}), wait_req_skip(St, ['if']). +eval_if(Toks0, St) -> + Toks = expand_macros(Toks0, St), + Es1 = case erl_parse:parse_exprs(Toks) of + {ok,Es0} -> Es0; + {error,E} -> throw(E) + end, + Es = rewrite_expr(Es1, St), + assert_guard_expr(Es), + Bs = erl_eval:new_bindings(), + LocalFun = fun(_Name, _Args) -> + error(badarg) + end, + try erl_eval:exprs(Es, Bs, {value,LocalFun}) of + {value,Res,_} -> + Res + catch + _:_ -> + false + end. + +assert_guard_expr([E0]) -> + E = rewrite_expr(E0, none), + case erl_lint:is_guard_expr(E) of + false -> + throw({bad,'if'}); + true -> + ok + end; +assert_guard_expr(_) -> + throw({bad,'if'}). + +%% Dual-purpose rewriting function. When the second argument is +%% an #epp{} record, calls to defined(Symbol) will be evaluated. +%% When the second argument is 'none', legal calls to our built-in +%% functions are eliminated in order to turn the expression into +%% a legal guard expression. + +rewrite_expr({call,_,{atom,_,defined},[N0]}, #epp{macs=Macs}) -> + %% Evaluate defined(Symbol). + N = case N0 of + {var,_,N1} -> N1; + {atom,_,N1} -> N1; + _ -> throw({bad,'if'}) + end, + {atom,0,maps:is_key(N, Macs)}; +rewrite_expr({call,_,{atom,_,Name},As0}, none) -> + As = rewrite_expr(As0, none), + Arity = length(As), + case erl_internal:bif(Name, Arity) andalso + not erl_internal:guard_bif(Name, Arity) of + false -> + %% A guard BIF, an -if built-in, or an unknown function. + %% Eliminate the call so that erl_lint will not complain. + %% The call might fail later at evaluation time. + to_conses(As); + true -> + %% An auto-imported BIF (not guard BIF). Not allowed. + throw({bad,'if'}) + end; +rewrite_expr([H|T], St) -> + [rewrite_expr(H, St)|rewrite_expr(T, St)]; +rewrite_expr(Tuple, St) when is_tuple(Tuple) -> + list_to_tuple(rewrite_expr(tuple_to_list(Tuple), St)); +rewrite_expr(Other, _) -> + Other. + +to_conses([H|T]) -> + {cons,0,H,to_conses(T)}; +to_conses([]) -> + {nil,0}. + %% scan_elif(Tokens, EndifToken, From, EppState) %% Handle the conditional parsing of a file. %% Report a badly formed if test and then treat as false macro. scan_elif(_Toks, Elif, From, St) -> - epp_reply(From, {error,{loc(Elif),epp,{'NYI','elif'}}}), - wait_req_scan(St). + case St#epp.istk of + ['else'|Cis] -> + epp_reply(From, {error,{loc(Elif), + epp,{illegal,"unbalanced",'elif'}}}), + wait_req_skip(St#epp{istk=Cis}, ['else']); + [_I|Cis] -> + skip_toks(From, St#epp{istk=Cis}, ['elif']); + [] -> + epp_reply(From, {error,{loc(Elif),epp, + {illegal,"unbalanced",elif}}}), + wait_req_scan(St) + end. %% scan_endif(Tokens, EndifToken, From, EppState) %% If we are in an if body then exit it, else report an error. @@ -1158,6 +1259,8 @@ skip_toks(From, St, [I|Sis]) -> skip_toks(From, St#epp{location=Cl}, ['if',I|Sis]); {ok,[{'-',_Lh},{atom,_Le,'else'}=Else|_Toks],Cl}-> skip_else(Else, From, St#epp{location=Cl}, [I|Sis]); + {ok,[{'-',_Lh},{atom,_Le,'elif'}=Elif|Toks],Cl}-> + skip_elif(Toks, Elif, From, St#epp{location=Cl}, [I|Sis]); {ok,[{'-',_Lh},{atom,_Le,endif}|_Toks],Cl} -> skip_toks(From, St#epp{location=Cl}, Sis); {ok,_Toks,Cl} -> @@ -1188,11 +1291,21 @@ skip_toks(From, St, []) -> skip_else(Else, From, St, ['else'|Sis]) -> epp_reply(From, {error,{loc(Else),epp,{illegal,"repeated",'else'}}}), wait_req_skip(St, ['else'|Sis]); +skip_else(_Else, From, St, ['elif'|Sis]) -> + skip_toks(From, St, ['else'|Sis]); skip_else(_Else, From, St, [_I]) -> scan_toks(From, St#epp{istk=['else'|St#epp.istk]}); skip_else(_Else, From, St, Sis) -> skip_toks(From, St, Sis). +skip_elif(_Toks, Elif, From, St, ['else'|_]=Sis) -> + epp_reply(From, {error,{loc(Elif),epp,elif_after_else}}), + wait_req_skip(St, Sis); +skip_elif(Toks, Elif, From, St, [_I]) -> + scan_if(Toks, Elif, From, St); +skip_elif(_Toks, _Elif, From, St, Sis) -> + skip_toks(From, St, Sis). + %% macro_pars(Tokens, ArgStack) %% macro_expansion(Tokens, Anno) %% Extract the macro parameters and the expansion from a macro definition. diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/erl_error.erl index 51e0c3f77e..fdcb9e824c 100644 --- a/lib/stdlib/src/lib.erl +++ b/lib/stdlib/src/erl_error.erl @@ -17,337 +17,12 @@ %% %% %CopyrightEnd% %% --module(lib). - --export([flush_receive/0, error_message/2, progname/0, nonl/1, send/2, - sendw/2, eval_str/1]). - --export([extended_parse_exprs/1, extended_parse_term/1, - subst_values_for_vars/2]). +-module(erl_error). -export([format_exception/6, format_exception/7, format_stacktrace/4, format_stacktrace/5, format_call/4, format_call/5, format_fun/1, format_fun/2]). --spec flush_receive() -> 'ok'. - -flush_receive() -> - receive - _Any -> - flush_receive() - after - 0 -> - ok - end. - -%% -%% Functions for doing standard system format i/o. -%% --spec error_message(Format, Args) -> 'ok' when - Format :: io:format(), - Args :: [term()]. - -error_message(Format, Args) -> - io:format(<<"** ~ts **\n">>, [io_lib:format(Format, Args)]). - -%% Return the name of the script that starts (this) erlang -%% --spec progname() -> atom(). - -progname() -> - case init:get_argument(progname) of - {ok, [[Prog]]} -> - list_to_atom(Prog); - _Other -> - no_prog_name - end. - --spec nonl(String1) -> String2 when - String1 :: string(), - String2 :: string(). - -nonl([10]) -> []; -nonl([]) -> []; -nonl([H|T]) -> [H|nonl(T)]. - --spec send(To, Msg) -> Msg when - To :: pid() | atom() | {atom(), node()}, - Msg :: term(). - -send(To, Msg) -> To ! Msg. - --spec sendw(To, Msg) -> term() when - To :: pid() | atom() | {atom(), node()}, - Msg :: term(). - -sendw(To, Msg) -> - To ! {self(), Msg}, - receive - Reply -> Reply - end. - -%% eval_str(InStr) -> {ok, OutStr} | {error, ErrStr'} -%% InStr must represent a body -%% Note: If InStr is a binary it has to be a Latin-1 string. -%% If you have a UTF-8 encoded binary you have to call -%% unicode:characters_to_list/1 before the call to eval_str(). - --define(result(F,D), lists:flatten(io_lib:format(F, D))). - --spec eval_str(string() | unicode:latin1_binary()) -> - {'ok', string()} | {'error', string()}. - -eval_str(Str) when is_list(Str) -> - case erl_scan:tokens([], Str, 0) of - {more, _} -> - {error, "Incomplete form (missing .<cr>)??"}; - {done, {ok, Toks, _}, Rest} -> - case all_white(Rest) of - true -> - case erl_parse:parse_exprs(Toks) of - {ok, Exprs} -> - case catch erl_eval:exprs(Exprs, erl_eval:new_bindings()) of - {value, Val, _} -> - {ok, Val}; - Other -> - {error, ?result("*** eval: ~p", [Other])} - end; - {error, {_Line, Mod, Args}} -> - Msg = ?result("*** ~ts",[Mod:format_error(Args)]), - {error, Msg} - end; - false -> - {error, ?result("Non-white space found after " - "end-of-form :~ts", [Rest])} - end - end; -eval_str(Bin) when is_binary(Bin) -> - eval_str(binary_to_list(Bin)). - -all_white([$\s|T]) -> all_white(T); -all_white([$\n|T]) -> all_white(T); -all_white([$\t|T]) -> all_white(T); -all_white([]) -> true; -all_white(_) -> false. - -%% `Tokens' is assumed to have been scanned with the 'text' option. -%% The annotations of the returned expressions are locations. -%% -%% Can handle pids, ports, references, and external funs ("items"). -%% Known items are represented by variables in the erl_parse tree, and -%% the items themselves are stored in the returned bindings. - --spec extended_parse_exprs(Tokens) -> - {'ok', ExprList, Bindings} | {'error', ErrorInfo} when - Tokens :: [erl_scan:token()], - ExprList :: [erl_parse:abstract_expr()], - Bindings :: erl_eval:binding_struct(), - ErrorInfo :: erl_parse:error_info(). - -extended_parse_exprs(Tokens) -> - Ts = tokens_fixup(Tokens), - case erl_parse:parse_exprs(Ts) of - {ok, Exprs0} -> - {Exprs, Bs} = expr_fixup(Exprs0), - {ok, reset_expr_anno(Exprs), Bs}; - _ErrorInfo -> - erl_parse:parse_exprs(reset_token_anno(Ts)) - end. - -tokens_fixup([]) -> []; -tokens_fixup([T|Ts]=Ts0) -> - try token_fixup(Ts0) of - {NewT, NewTs} -> - [NewT|tokens_fixup(NewTs)] - catch - _:_ -> - [T|tokens_fixup(Ts)] - end. - -token_fixup(Ts) -> - {AnnoL, NewTs, FixupTag} = unscannable(Ts), - String = lists:append([erl_anno:text(A) || A <- AnnoL]), - _ = (fixup_fun(FixupTag))(String), - NewAnno = erl_anno:set_text(fixup_text(FixupTag), hd(AnnoL)), - {{string, NewAnno, String}, NewTs}. - -unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _}, - {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) -> - {[A1, A2, A3, A4, A5, A6, A7], Ts, function}; -unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _}, - {'.', A5}, {atom, A6, _}, {'.', A7}, {integer, A8, _}, - {'>', A9}|Ts]) -> - {[A1, A2, A3, A4, A5, A6, A7, A8, A9], Ts, function}; -unscannable([{'<', A1}, {float, A2, _}, {'.', A3}, {integer, A4, _}, - {'>', A5}|Ts]) -> - {[A1, A2, A3, A4, A5], Ts, pid}; -unscannable([{'#', A1}, {var, A2, 'Port'}, {'<', A3}, {float, A4, _}, - {'>', A5}|Ts]) -> - {[A1, A2, A3, A4, A5], Ts, port}; -unscannable([{'#', A1}, {var, A2, 'Ref'}, {'<', A3}, {float, A4, _}, - {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) -> - {[A1, A2, A3, A4, A5, A6, A7], Ts, reference}. - -expr_fixup(Expr0) -> - {Expr, Bs, _} = expr_fixup(Expr0, erl_eval:new_bindings(), 1), - {Expr, Bs}. - -expr_fixup({string,A,S}=T, Bs0, I) -> - try string_fixup(A, S) of - Value -> - Var = new_var(I), - Bs = erl_eval:add_binding(Var, Value, Bs0), - {{var, A, Var}, Bs, I+1} - catch - _:_ -> - {T, Bs0, I} - end; -expr_fixup(Tuple, Bs0, I0) when is_tuple(Tuple) -> - {L, Bs, I} = expr_fixup(tuple_to_list(Tuple), Bs0, I0), - {list_to_tuple(L), Bs, I}; -expr_fixup([E0|Es0], Bs0, I0) -> - {E, Bs1, I1} = expr_fixup(E0, Bs0, I0), - {Es, Bs, I} = expr_fixup(Es0, Bs1, I1), - {[E|Es], Bs, I}; -expr_fixup(T, Bs, I) -> - {T, Bs, I}. - -string_fixup(A, S) -> - Text = erl_anno:text(A), - FixupTag = fixup_tag(Text, S), - (fixup_fun(FixupTag))(S). - -new_var(I) -> - list_to_atom(lists:concat(['__ExtendedParseExprs_', I, '__'])). - -reset_token_anno(Tokens) -> - [setelement(2, T, (reset_anno())(element(2, T))) || T <- Tokens]. - -reset_expr_anno(Exprs) -> - [erl_parse:map_anno(reset_anno(), E) || E <- Exprs]. - -reset_anno() -> - fun(A) -> erl_anno:new(erl_anno:location(A)) end. - -fixup_fun(function) -> fun function/1; -fixup_fun(pid) -> fun erlang:list_to_pid/1; -fixup_fun(port) -> fun erlang:list_to_port/1; -fixup_fun(reference) -> fun erlang:list_to_ref/1. - -function(S) -> - %% External function. - {ok, [_, _, _, - {atom, _, Module}, _, - {atom, _, Function}, _, - {integer, _, Arity}|_], _} = erl_scan:string(S), - erlang:make_fun(Module, Function, Arity). - -fixup_text(function) -> "function"; -fixup_text(pid) -> "pid"; -fixup_text(port) -> "port"; -fixup_text(reference) -> "reference". - -fixup_tag("function", "#"++_) -> function; -fixup_tag("pid", "<"++_) -> pid; -fixup_tag("port", "#"++_) -> port; -fixup_tag("reference", "#"++_) -> reference. - -%%% End of extended_parse_exprs. - -%% `Tokens' is assumed to have been scanned with the 'text' option. -%% -%% Can handle pids, ports, references, and external funs. - --spec extended_parse_term(Tokens) -> - {'ok', Term} | {'error', ErrorInfo} when - Tokens :: [erl_scan:token()], - Term :: term(), - ErrorInfo :: erl_parse:error_info(). - -extended_parse_term(Tokens) -> - case extended_parse_exprs(Tokens) of - {ok, [Expr], Bindings} -> - try normalise(Expr, Bindings) of - Term -> - {ok, Term} - catch - _:_ -> - Loc = erl_anno:location(element(2, Expr)), - {error,{Loc,?MODULE,"bad term"}} - end; - {ok, [_,Expr|_], _Bindings} -> - Loc = erl_anno:location(element(2, Expr)), - {error,{Loc,?MODULE,"bad term"}}; - {error, _} = Error -> - Error - end. - -%% From erl_parse. -normalise({var, _, V}, Bs) -> - {value, Value} = erl_eval:binding(V, Bs), - Value; -normalise({char,_,C}, _Bs) -> C; -normalise({integer,_,I}, _Bs) -> I; -normalise({float,_,F}, _Bs) -> F; -normalise({atom,_,A}, _Bs) -> A; -normalise({string,_,S}, _Bs) -> S; -normalise({nil,_}, _Bs) -> []; -normalise({bin,_,Fs}, Bs) -> - {value, B, _} = - eval_bits:expr_grp(Fs, [], - fun(E, _) -> - {value, normalise(E, Bs), []} - end, [], true), - B; -normalise({cons,_,Head,Tail}, Bs) -> - [normalise(Head, Bs)|normalise(Tail, Bs)]; -normalise({tuple,_,Args}, Bs) -> - list_to_tuple(normalise_list(Args, Bs)); -normalise({map,_,Pairs}, Bs) -> - maps:from_list(lists:map(fun - %% only allow '=>' - ({map_field_assoc,_,K,V}) -> - {normalise(K, Bs),normalise(V, Bs)} - end, Pairs)); -%% Special case for unary +/-. -normalise({op,_,'+',{char,_,I}}, _Bs) -> I; -normalise({op,_,'+',{integer,_,I}}, _Bs) -> I; -normalise({op,_,'+',{float,_,F}}, _Bs) -> F; -normalise({op,_,'-',{char,_,I}}, _Bs) -> -I; %Weird, but compatible! -normalise({op,_,'-',{integer,_,I}}, _Bs) -> -I; -normalise({op,_,'-',{float,_,F}}, _Bs) -> -F; -normalise({'fun',_,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Bs) -> - %% Since "#Fun<M.F.A>" is recognized, "fun M:F/A" should be too. - fun M:F/A. - -normalise_list([H|T], Bs) -> - [normalise(H, Bs)|normalise_list(T, Bs)]; -normalise_list([], _Bs) -> - []. - -%% To be used on ExprList and Bindings returned from extended_parse_exprs(). -%% Substitute {value, A, Item} for {var, A, ExtendedParseVar}. -%% {value, A, Item} is a shell/erl_eval convention, and for example -%% the linter cannot handle it. - --spec subst_values_for_vars(ExprList, Bindings) -> [term()] when - ExprList :: [erl_parse:abstract_expr()], - Bindings :: erl_eval:binding_struct(). - -subst_values_for_vars({var, A, V}=Var, Bs) -> - case erl_eval:binding(V, Bs) of - {value, Value} -> - {value, A, Value}; - unbound -> - Var - end; -subst_values_for_vars(L, Bs) when is_list(L) -> - [subst_values_for_vars(E, Bs) || E <- L]; -subst_values_for_vars(T, Bs) when is_tuple(T) -> - list_to_tuple(subst_values_for_vars(tuple_to_list(T), Bs)); -subst_values_for_vars(T, _Bs) -> - T. - %%% Formatting of exceptions, mfa:s and funs. %% -> iolist() (no \n at end) diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 4ee11383da..0f6d48b9a3 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -27,7 +27,8 @@ -export([exprs/2,exprs/3,exprs/4,expr/2,expr/3,expr/4,expr/5, expr_list/2,expr_list/3,expr_list/4]). -export([new_bindings/0,bindings/1,binding/2,add_binding/3,del_binding/2]). - +-export([extended_parse_exprs/1, extended_parse_term/1, + subst_values_for_vars/2]). -export([is_constant_expr/1, partial_eval/1]). %% Is used by standalone Erlang (escript). @@ -1286,6 +1287,224 @@ merge_bindings(Bs1, Bs2) -> %% error -> Bs %% end %% end, Bs2, Bs1). + +%% Substitute {value, A, Item} for {var, A, Var}, preserving A. +%% {value, A, Item} is a shell/erl_eval convention, and for example +%% the linter cannot handle it. + +-spec subst_values_for_vars(ExprList, Bindings) -> [term()] when + ExprList :: [erl_parse:abstract_expr()], + Bindings :: binding_struct(). + +subst_values_for_vars({var, A, V}=Var, Bs) -> + case erl_eval:binding(V, Bs) of + {value, Value} -> + {value, A, Value}; + unbound -> + Var + end; +subst_values_for_vars(L, Bs) when is_list(L) -> + [subst_values_for_vars(E, Bs) || E <- L]; +subst_values_for_vars(T, Bs) when is_tuple(T) -> + list_to_tuple(subst_values_for_vars(tuple_to_list(T), Bs)); +subst_values_for_vars(T, _Bs) -> + T. + +%% `Tokens' is assumed to have been scanned with the 'text' option. +%% The annotations of the returned expressions are locations. +%% +%% Can handle pids, ports, references, and external funs ("items"). +%% Known items are represented by variables in the erl_parse tree, and +%% the items themselves are stored in the returned bindings. + +-spec extended_parse_exprs(Tokens) -> + {'ok', ExprList, Bindings} | {'error', ErrorInfo} when + Tokens :: [erl_scan:token()], + ExprList :: [erl_parse:abstract_expr()], + Bindings :: erl_eval:binding_struct(), + ErrorInfo :: erl_parse:error_info(). + +extended_parse_exprs(Tokens) -> + Ts = tokens_fixup(Tokens), + case erl_parse:parse_exprs(Ts) of + {ok, Exprs0} -> + {Exprs, Bs} = expr_fixup(Exprs0), + {ok, reset_expr_anno(Exprs), Bs}; + _ErrorInfo -> + erl_parse:parse_exprs(reset_token_anno(Ts)) + end. + +tokens_fixup([]) -> []; +tokens_fixup([T|Ts]=Ts0) -> + try token_fixup(Ts0) of + {NewT, NewTs} -> + [NewT|tokens_fixup(NewTs)] + catch + _:_ -> + [T|tokens_fixup(Ts)] + end. + +token_fixup(Ts) -> + {AnnoL, NewTs, FixupTag} = unscannable(Ts), + String = lists:append([erl_anno:text(A) || A <- AnnoL]), + _ = (fixup_fun(FixupTag))(String), + NewAnno = erl_anno:set_text(fixup_text(FixupTag), hd(AnnoL)), + {{string, NewAnno, String}, NewTs}. + +unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _}, + {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) -> + {[A1, A2, A3, A4, A5, A6, A7], Ts, function}; +unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _}, + {'.', A5}, {atom, A6, _}, {'.', A7}, {integer, A8, _}, + {'>', A9}|Ts]) -> + {[A1, A2, A3, A4, A5, A6, A7, A8, A9], Ts, function}; +unscannable([{'<', A1}, {float, A2, _}, {'.', A3}, {integer, A4, _}, + {'>', A5}|Ts]) -> + {[A1, A2, A3, A4, A5], Ts, pid}; +unscannable([{'#', A1}, {var, A2, 'Port'}, {'<', A3}, {float, A4, _}, + {'>', A5}|Ts]) -> + {[A1, A2, A3, A4, A5], Ts, port}; +unscannable([{'#', A1}, {var, A2, 'Ref'}, {'<', A3}, {float, A4, _}, + {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) -> + {[A1, A2, A3, A4, A5, A6, A7], Ts, reference}. + +expr_fixup(Expr0) -> + {Expr, Bs, _} = expr_fixup(Expr0, erl_eval:new_bindings(), 1), + {Expr, Bs}. + +expr_fixup({string,A,S}=T, Bs0, I) -> + try string_fixup(A, S) of + Value -> + Var = new_var(I), + Bs = erl_eval:add_binding(Var, Value, Bs0), + {{var, A, Var}, Bs, I+1} + catch + _:_ -> + {T, Bs0, I} + end; +expr_fixup(Tuple, Bs0, I0) when is_tuple(Tuple) -> + {L, Bs, I} = expr_fixup(tuple_to_list(Tuple), Bs0, I0), + {list_to_tuple(L), Bs, I}; +expr_fixup([E0|Es0], Bs0, I0) -> + {E, Bs1, I1} = expr_fixup(E0, Bs0, I0), + {Es, Bs, I} = expr_fixup(Es0, Bs1, I1), + {[E|Es], Bs, I}; +expr_fixup(T, Bs, I) -> + {T, Bs, I}. + +string_fixup(A, S) -> + Text = erl_anno:text(A), + FixupTag = fixup_tag(Text, S), + (fixup_fun(FixupTag))(S). + +new_var(I) -> + list_to_atom(lists:concat(['__ExtendedParseExprs_', I, '__'])). + +reset_token_anno(Tokens) -> + [setelement(2, T, (reset_anno())(element(2, T))) || T <- Tokens]. + +reset_expr_anno(Exprs) -> + [erl_parse:map_anno(reset_anno(), E) || E <- Exprs]. + +reset_anno() -> + fun(A) -> erl_anno:new(erl_anno:location(A)) end. + +fixup_fun(function) -> fun function/1; +fixup_fun(pid) -> fun erlang:list_to_pid/1; +fixup_fun(port) -> fun erlang:list_to_port/1; +fixup_fun(reference) -> fun erlang:list_to_ref/1. + +function(S) -> + %% External function. + {ok, [_, _, _, + {atom, _, Module}, _, + {atom, _, Function}, _, + {integer, _, Arity}|_], _} = erl_scan:string(S), + erlang:make_fun(Module, Function, Arity). + +fixup_text(function) -> "function"; +fixup_text(pid) -> "pid"; +fixup_text(port) -> "port"; +fixup_text(reference) -> "reference". + +fixup_tag("function", "#"++_) -> function; +fixup_tag("pid", "<"++_) -> pid; +fixup_tag("port", "#"++_) -> port; +fixup_tag("reference", "#"++_) -> reference. + +%%% End of extended_parse_exprs. + +%% `Tokens' is assumed to have been scanned with the 'text' option. +%% +%% Can handle pids, ports, references, and external funs. + +-spec extended_parse_term(Tokens) -> + {'ok', Term} | {'error', ErrorInfo} when + Tokens :: [erl_scan:token()], + Term :: term(), + ErrorInfo :: erl_parse:error_info(). + +extended_parse_term(Tokens) -> + case extended_parse_exprs(Tokens) of + {ok, [Expr], Bindings} -> + try normalise(Expr, Bindings) of + Term -> + {ok, Term} + catch + _:_ -> + Loc = erl_anno:location(element(2, Expr)), + {error,{Loc,?MODULE,"bad term"}} + end; + {ok, [_,Expr|_], _Bindings} -> + Loc = erl_anno:location(element(2, Expr)), + {error,{Loc,?MODULE,"bad term"}}; + {error, _} = Error -> + Error + end. + +%% From erl_parse. +normalise({var, _, V}, Bs) -> + {value, Value} = erl_eval:binding(V, Bs), + Value; +normalise({char,_,C}, _Bs) -> C; +normalise({integer,_,I}, _Bs) -> I; +normalise({float,_,F}, _Bs) -> F; +normalise({atom,_,A}, _Bs) -> A; +normalise({string,_,S}, _Bs) -> S; +normalise({nil,_}, _Bs) -> []; +normalise({bin,_,Fs}, Bs) -> + {value, B, _} = + eval_bits:expr_grp(Fs, [], + fun(E, _) -> + {value, normalise(E, Bs), []} + end, [], true), + B; +normalise({cons,_,Head,Tail}, Bs) -> + [normalise(Head, Bs)|normalise(Tail, Bs)]; +normalise({tuple,_,Args}, Bs) -> + list_to_tuple(normalise_list(Args, Bs)); +normalise({map,_,Pairs}, Bs) -> + maps:from_list(lists:map(fun + %% only allow '=>' + ({map_field_assoc,_,K,V}) -> + {normalise(K, Bs),normalise(V, Bs)} + end, Pairs)); +%% Special case for unary +/-. +normalise({op,_,'+',{char,_,I}}, _Bs) -> I; +normalise({op,_,'+',{integer,_,I}}, _Bs) -> I; +normalise({op,_,'+',{float,_,F}}, _Bs) -> F; +normalise({op,_,'-',{char,_,I}}, _Bs) -> -I; %Weird, but compatible! +normalise({op,_,'-',{integer,_,I}}, _Bs) -> -I; +normalise({op,_,'-',{float,_,F}}, _Bs) -> -F; +normalise({'fun',_,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Bs) -> + %% Since "#Fun<M.F.A>" is recognized, "fun M:F/A" should be too. + fun M:F/A. + +normalise_list([H|T], Bs) -> + [normalise(H, Bs)|normalise_list(T, Bs)]; +normalise_list([], _Bs) -> + []. + %%---------------------------------------------------------------------------- %% %% Evaluate expressions: diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 6d3d5baa23..dd509191ef 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -109,6 +109,7 @@ new_type_test(is_function, 2) -> true; new_type_test(is_integer, 1) -> true; new_type_test(is_list, 1) -> true; new_type_test(is_map, 1) -> true; +new_type_test(is_map_key, 2) -> true; new_type_test(is_number, 1) -> true; new_type_test(is_pid, 1) -> true; new_type_test(is_port, 1) -> true; @@ -315,6 +316,7 @@ bif(is_function, 2) -> true; bif(is_integer, 1) -> true; bif(is_list, 1) -> true; bif(is_map, 1) -> true; +bif(is_map_key, 2) -> true; bif(is_number, 1) -> true; bif(is_pid, 1) -> true; bif(is_port, 1) -> true; diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index beea9927d2..89a81684f5 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -882,7 +882,7 @@ format_exception(Class, Reason, StackTrace) -> io_lib:format("~." ++ integer_to_list(I) ++ P, [Term, 50]) end, StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end, - lib:format_exception(1, Class, Reason, StackTrace, StackFun, PF, Enc). + erl_error:format_exception(1, Class, Reason, StackTrace, StackFun, PF, Enc). encoding() -> [{encoding, Encoding}] = enc(), diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 6a559f0be5..a35f79c0d9 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -77,7 +77,9 @@ whereis/1]). %% internal exports --export([internal_request_all/0]). +-export([internal_request_all/0, + internal_delete_all/2, + internal_select_delete/2]). -spec all() -> [Tab] when Tab :: tab(). @@ -116,7 +118,15 @@ delete(_, _) -> -spec delete_all_objects(Tab) -> true when Tab :: tab(). -delete_all_objects(_) -> +delete_all_objects(Tab) -> + _ = ets:internal_delete_all(Tab, undefined), + true. + +-spec internal_delete_all(Tab, undefined) -> NumDeleted when + Tab :: tab(), + NumDeleted :: non_neg_integer(). + +internal_delete_all(_, _) -> erlang:nif_error(undef). -spec delete_object(Tab, Object) -> true when @@ -378,7 +388,17 @@ select_count(_, _) -> MatchSpec :: match_spec(), NumDeleted :: non_neg_integer(). -select_delete(_, _) -> +select_delete(Tab, [{'_',[],[true]}]) -> + ets:internal_delete_all(Tab, undefined); +select_delete(Tab, MatchSpec) -> + ets:internal_select_delete(Tab, MatchSpec). + +-spec internal_select_delete(Tab, MatchSpec) -> NumDeleted when + Tab :: tab(), + MatchSpec :: match_spec(), + NumDeleted :: non_neg_integer(). + +internal_select_delete(_, _) -> erlang:nif_error(undef). -spec select_replace(Tab, MatchSpec) -> NumReplaced when diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 53042251cc..3ee2031d02 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -122,7 +122,7 @@ -type add_handler_ret() :: ok | term() | {'EXIT',term()}. -type del_handler_ret() :: ok | term() | {'EXIT',term()}. --type emgr_name() :: {'local', atom()} | {'global', atom()} +-type emgr_name() :: {'local', atom()} | {'global', term()} | {'via', atom(), term()}. -type debug_flag() :: 'trace' | 'log' | 'statistics' | 'debug' | {'logfile', string()}. @@ -130,7 +130,7 @@ | {'debug', [debug_flag()]} | {'spawn_opt', [proc_lib:spawn_option()]} | {'hibernate_after', timeout()}. --type emgr_ref() :: atom() | {atom(), atom()} | {'global', atom()} +-type emgr_ref() :: atom() | {atom(), atom()} | {'global', term()} | {'via', atom(), term()} | pid(). -type start_ret() :: {'ok', pid()} | {'error', term()}. @@ -146,7 +146,7 @@ %% start_link() %% start_link(MgrName | Options) %% start_link(MgrName, Options) -%% MgrName ::= {local, atom()} | {global, atom()} | {via, atom(), term()} +%% MgrName ::= {local, atom()} | {global, term()} | {via, atom(), term()} %% Options ::= [{timeout, Timeout} | {debug, [Flag]} | {spawn_opt,SOpts}] %% Flag ::= trace | log | {logfile, File} | statistics | debug %% (debug == log && statistics) diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index f65ef78636..035dd871ff 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -166,7 +166,7 @@ %%% start(Name, Mod, Args, Options) %%% start_link(Mod, Args, Options) %%% start_link(Name, Mod, Args, Options) where: -%%% Name ::= {local, atom()} | {global, atom()} | {via, atom(), term()} +%%% Name ::= {local, atom()} | {global, term()} | {via, atom(), term()} %%% Mod ::= atom(), callback module implementing the 'real' server %%% Args ::= term(), init arguments (to Mod:init/1) %%% Options ::= [{timeout, Timeout} | {debug, [Flag]}] diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index ec8cfd56c2..428c23524b 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -929,6 +929,7 @@ bool_test(is_port,1) -> true; bool_test(is_reference,1) -> true; bool_test(is_tuple,1) -> true; bool_test(is_map,1) -> true; +bool_test(is_map_key, 2) -> true; bool_test(is_binary,1) -> true; bool_test(is_function,1) -> true; bool_test(is_record,2) -> true; diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index a17addcc42..ceec3079a1 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -612,6 +612,15 @@ obsolete_1(erlang, get_stacktrace, 0) -> obsolete_1(erlang, hash, 2) -> {removed, {erlang, phash2, 2}, "20.0"}; +%% Add in OTP 21. + +obsolete_1(ssl, ssl_accept, 1) -> + {deprecated, "deprecated; use ssl:handshake/1 instead"}; +obsolete_1(ssl, ssl_accept, 2) -> + {deprecated, "deprecated; use ssl:handshake/2 instead"}; +obsolete_1(ssl, ssl_accept, 3) -> + {deprecated, "deprecated; use ssl:handshake/3 instead"}; + %% not obsolete obsolete_1(_, _, _) -> diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index 8d01840313..9094e0c0cd 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -841,8 +841,8 @@ format_exception(Class, Reason, StackTrace, {Enc,_}=Extra) -> StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end, %% EI = " exception: ", EI = " ", - [EI, lib:format_exception(1+length(EI), Class, Reason, - StackTrace, StackFun, PF, Enc), "\n"]. + [EI, erl_error:format_exception(1+length(EI), Class, Reason, + StackTrace, StackFun, PF, Enc), "\n"]. to_string(A, latin1) -> io_lib:write_atom_as_latin1(A); diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 3a66f6930b..4a0e976ba4 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -638,7 +638,7 @@ string_to_handle(Str, Options, Bindings) when is_list(Str) -> case erl_scan:string(Str, 1, [text]) of {ok, Tokens, _} -> ScanRes = - case lib:extended_parse_exprs(Tokens) of + case erl_eval:extended_parse_exprs(Tokens) of {ok, [Expr0], SBs} -> {ok, Expr0, SBs}; {ok, _ExprList, _SBs} -> @@ -1196,8 +1196,8 @@ abstract1({table, TableDesc}, _NElements, _Depth, _A) -> {ok, Tokens, _} = erl_scan:string(lists:flatten(TableDesc++"."), 1, [text]), {ok, Es, Bs} = - lib:extended_parse_exprs(Tokens), - [Expr] = lib:subst_values_for_vars(Es, Bs), + erl_eval:extended_parse_exprs(Tokens), + [Expr] = erl_eval:subst_values_for_vars(Es, Bs), special(Expr); false -> % abstract expression TableDesc @@ -3749,7 +3749,7 @@ maybe_error_logger(Name, Why) -> expand_stacktrace(), Trimmer = fun(M, _F, _A) -> M =:= erl_eval end, Formater = fun(Term, I) -> io_lib:print(Term, I, 80, -1) end, - X = lib:format_stacktrace(1, Stacktrace, Trimmer, Formater), + X = erl_error:format_stacktrace(1, Stacktrace, Trimmer, Formater), error_logger:Name("qlc: temporary file was needed for ~w\n~ts\n", [Why, lists:flatten(X)]). diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 1be37672e7..c73cf22943 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -230,7 +230,7 @@ server_loop(N0, Eval_0, Bs00, RT, Ds00, History0, Results0) -> {Res,Eval0} = get_command(Prompt, Eval_1, Bs0, RT, Ds0), case Res of {ok,Es0,XBs} -> - Es1 = lib:subst_values_for_vars(Es0, XBs), + Es1 = erl_eval:subst_values_for_vars(Es0, XBs), case expand_hist(Es1, N) of {ok,Es} -> {V,Eval,Bs,Ds} = shell_cmd(Es, Eval0, Bs0, RT, Ds0, cmd), @@ -280,7 +280,7 @@ get_command(Prompt, Eval, Bs, RT, Ds) -> io:scan_erl_exprs(group_leader(), Prompt, 1, [text]) of {ok,Toks,_EndPos} -> - lib:extended_parse_exprs(Toks); + erl_eval:extended_parse_exprs(Toks); {eof,_EndPos} -> eof; {error,ErrorInfo,_EndPos} -> @@ -589,7 +589,7 @@ report_exception(Class, Severity, {Reason,Stacktrace}, RT) -> PF = fun(Term, I1) -> pp(Term, I1, RT) end, SF = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end, Enc = encoding(), - Str = lib:format_exception(I, Class, Reason, Stacktrace, SF, PF, Enc), + Str = erl_error:format_exception(I, Class, Reason, Stacktrace, SF, PF, Enc), io:requests([{put_chars, latin1, Tag}, {put_chars, unicode, Str}, nl]). diff --git a/lib/stdlib/src/slave.erl b/lib/stdlib/src/slave.erl index b3f3206d67..37c1f6bfd9 100644 --- a/lib/stdlib/src/slave.erl +++ b/lib/stdlib/src/slave.erl @@ -187,7 +187,7 @@ start_link(Host, Name, Args) -> start(Host, Name, Args, self()). start(Host0, Name, Args, LinkTo) -> - Prog = lib:progname(), + Prog = progname(), start(Host0, Name, Args, LinkTo, Prog). start(Host0, Name, Args, LinkTo, Prog) -> @@ -296,7 +296,6 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) -> " -s slave slave_start ", node(), " ", Waiter, " ", Args]), - case after_char($@, atom_to_list(node())) of Host -> {ok, BasicCmd}; @@ -309,6 +308,15 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) -> end end. +%% Return the name of the script that starts (this) erlang +progname() -> + case init:get_argument(progname) of + {ok, [[Prog]]} -> + Prog; + _Other -> + "no_prog_name" + end. + %% This is an attempt to distinguish between spaces in the program %% path and spaces that separate arguments. The program is quoted to %% allow spaces in the path. @@ -317,7 +325,7 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) -> %% (through start/5) or if the -program switch to beam is used and %% includes arguments (typically done by cerl in OTP test environment %% in order to ensure that slave/peer nodes are started with the same -%% emulator and flags as the test node. The return from lib:progname() +%% emulator and flags as the test node. The result from progname() %% could then typically be '/<full_path_to>/cerl -gcov'). quote_progname(Progname) -> do_quote_progname(string:lexemes(to_list(Progname)," ")). diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 5fb48acfab..cd09872b87 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All 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 @@ erl_anno, erl_bits, erl_compile, + erl_error, erl_eval, erl_expand_records, erl_internal, @@ -71,7 +72,6 @@ io_lib_format, io_lib_fread, io_lib_pretty, - lib, lists, log_mf_h, maps, diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl index 0736374f21..f5d271c06d 100644 --- a/lib/stdlib/src/string.erl +++ b/lib/stdlib/src/string.erl @@ -323,16 +323,30 @@ take(Str, Sep0, true, trailing) -> %% Uppercase all chars in Str -spec uppercase(String::unicode:chardata()) -> unicode:chardata(). uppercase(CD) when is_list(CD) -> - uppercase_list(CD); -uppercase(CD) when is_binary(CD) -> - uppercase_bin(CD,<<>>). + try uppercase_list(CD, false) + catch unchanged -> CD + end; +uppercase(<<CP1/utf8, Rest/binary>>=Orig) -> + try uppercase_bin(CP1, Rest, false) of + List -> unicode:characters_to_binary(List) + catch unchanged -> Orig + end; +uppercase(<<>>) -> + <<>>. %% Lowercase all chars in Str -spec lowercase(String::unicode:chardata()) -> unicode:chardata(). lowercase(CD) when is_list(CD) -> - lowercase_list(CD); -lowercase(CD) when is_binary(CD) -> - lowercase_bin(CD,<<>>). + try lowercase_list(CD, false) + catch unchanged -> CD + end; +lowercase(<<CP1/utf8, Rest/binary>>=Orig) -> + try lowercase_bin(CP1, Rest, false) of + List -> unicode:characters_to_binary(List) + catch unchanged -> Orig + end; +lowercase(<<>>) -> + <<>>. %% Make a titlecase of the first char in Str -spec titlecase(String::unicode:chardata()) -> unicode:chardata(). @@ -352,9 +366,16 @@ titlecase(CD) when is_binary(CD) -> %% Make a comparable string of the Str should be used for equality tests only -spec casefold(String::unicode:chardata()) -> unicode:chardata(). casefold(CD) when is_list(CD) -> - casefold_list(CD); -casefold(CD) when is_binary(CD) -> - casefold_bin(CD,<<>>). + try casefold_list(CD, false) + catch unchanged -> CD + end; +casefold(<<CP1/utf8, Rest/binary>>=Orig) -> + try casefold_bin(CP1, Rest, false) of + List -> unicode:characters_to_binary(List) + catch unchanged -> Orig + end; +casefold(<<>>) -> + <<>>. -spec to_integer(String) -> {Int, Rest} | {'error', Reason} when String :: unicode:chardata(), @@ -652,52 +673,127 @@ slice_bin(CD, CP1, N) when N > 0 -> slice_bin(CD, CP1, 0) -> byte_size(CD)+byte_size(<<CP1/utf8>>). -uppercase_list(CPs0) -> +uppercase_list([CP1|[CP2|_]=Cont], _Changed) when $a =< CP1, CP1 =< $z, CP2 < 256 -> + [CP1-32|uppercase_list(Cont, true)]; +uppercase_list([CP1|[CP2|_]=Cont], Changed) when CP1 < 128, CP2 < 256 -> + [CP1|uppercase_list(Cont, Changed)]; +uppercase_list([], true) -> + []; +uppercase_list([], false) -> + throw(unchanged); +uppercase_list(CPs0, Changed) -> case unicode_util:uppercase(CPs0) of - [Char|CPs] -> append(Char,uppercase_list(CPs)); - [] -> [] + [Char|CPs] when Char =:= hd(CPs0) -> [Char|uppercase_list(CPs, Changed)]; + [Char|CPs] -> append(Char,uppercase_list(CPs, true)); + [] -> uppercase_list([], Changed) end. -uppercase_bin(CPs0, Acc) -> - case unicode_util:uppercase(CPs0) of - [Char|CPs] when is_integer(Char) -> - uppercase_bin(CPs, <<Acc/binary, Char/utf8>>); - [Chars|CPs] -> - uppercase_bin(CPs, <<Acc/binary, - << <<CP/utf8>> || CP <- Chars>>/binary >>); - [] -> Acc +uppercase_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed) + when $a =< CP1, CP1 =< $z, CP2 < 256 -> + [CP1-32|uppercase_bin(CP2, Bin, true)]; +uppercase_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed) + when CP1 < 128, CP2 < 256 -> + [CP1|uppercase_bin(CP2, Bin, false)]; +uppercase_bin(CP1, Bin, Changed) -> + case unicode_util:uppercase([CP1|Bin]) of + [CP1|CPs] -> + case unicode_util:cp(CPs) of + [Next|Rest] -> + [CP1|uppercase_bin(Next, Rest, Changed)]; + [] when Changed -> + [CP1]; + [] -> + throw(unchanged) + end; + [Char|CPs] -> + case unicode_util:cp(CPs) of + [Next|Rest] -> + [Char|uppercase_bin(Next, Rest, true)]; + [] -> + [Char] + end end. -lowercase_list(CPs0) -> +lowercase_list([CP1|[CP2|_]=Cont], _Changed) when $A =< CP1, CP1 =< $Z, CP2 < 256 -> + [CP1+32|lowercase_list(Cont, true)]; +lowercase_list([CP1|[CP2|_]=Cont], Changed) when CP1 < 128, CP2 < 256 -> + [CP1|lowercase_list(Cont, Changed)]; +lowercase_list([], true) -> + []; +lowercase_list([], false) -> + throw(unchanged); +lowercase_list(CPs0, Changed) -> case unicode_util:lowercase(CPs0) of - [Char|CPs] -> append(Char,lowercase_list(CPs)); - [] -> [] + [Char|CPs] when Char =:= hd(CPs0) -> [Char|lowercase_list(CPs, Changed)]; + [Char|CPs] -> append(Char,lowercase_list(CPs, true)); + [] -> lowercase_list([], Changed) end. -lowercase_bin(CPs0, Acc) -> - case unicode_util:lowercase(CPs0) of - [Char|CPs] when is_integer(Char) -> - lowercase_bin(CPs, <<Acc/binary, Char/utf8>>); - [Chars|CPs] -> - lowercase_bin(CPs, <<Acc/binary, - << <<CP/utf8>> || CP <- Chars>>/binary >>); - [] -> Acc +lowercase_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed) + when $A =< CP1, CP1 =< $Z, CP2 < 256 -> + [CP1+32|lowercase_bin(CP2, Bin, true)]; +lowercase_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed) + when CP1 < 128, CP2 < 256 -> + [CP1|lowercase_bin(CP2, Bin, false)]; +lowercase_bin(CP1, Bin, Changed) -> + case unicode_util:lowercase([CP1|Bin]) of + [CP1|CPs] -> + case unicode_util:cp(CPs) of + [Next|Rest] -> + [CP1|lowercase_bin(Next, Rest, Changed)]; + [] when Changed -> + [CP1]; + [] -> + throw(unchanged) + end; + [Char|CPs] -> + case unicode_util:cp(CPs) of + [Next|Rest] -> + [Char|lowercase_bin(Next, Rest, true)]; + [] -> + [Char] + end end. -casefold_list(CPs0) -> +casefold_list([CP1|[CP2|_]=Cont], _Changed) when $A =< CP1, CP1 =< $Z, CP2 < 256 -> + [CP1+32|casefold_list(Cont, true)]; +casefold_list([CP1|[CP2|_]=Cont], Changed) when CP1 < 128, CP2 < 256 -> + [CP1|casefold_list(Cont, Changed)]; +casefold_list([], true) -> + []; +casefold_list([], false) -> + throw(unchanged); +casefold_list(CPs0, Changed) -> case unicode_util:casefold(CPs0) of - [Char|CPs] -> append(Char, casefold_list(CPs)); - [] -> [] + [Char|CPs] when Char =:= hd(CPs0) -> [Char|casefold_list(CPs, Changed)]; + [Char|CPs] -> append(Char,casefold_list(CPs, true)); + [] -> casefold_list([], Changed) end. -casefold_bin(CPs0, Acc) -> - case unicode_util:casefold(CPs0) of - [Char|CPs] when is_integer(Char) -> - casefold_bin(CPs, <<Acc/binary, Char/utf8>>); - [Chars|CPs] -> - casefold_bin(CPs, <<Acc/binary, - << <<CP/utf8>> || CP <- Chars>>/binary >>); - [] -> Acc +casefold_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed) + when $A =< CP1, CP1 =< $Z, CP2 < 256 -> + [CP1+32|casefold_bin(CP2, Bin, true)]; +casefold_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed) + when CP1 < 128, CP2 < 256 -> + [CP1|casefold_bin(CP2, Bin, false)]; +casefold_bin(CP1, Bin, Changed) -> + case unicode_util:casefold([CP1|Bin]) of + [CP1|CPs] -> + case unicode_util:cp(CPs) of + [Next|Rest] -> + [CP1|casefold_bin(Next, Rest, Changed)]; + [] when Changed -> + [CP1]; + [] -> + throw(unchanged) + end; + [Char|CPs] -> + case unicode_util:cp(CPs) of + [Next|Rest] -> + [Char|casefold_bin(Next, Rest, true)]; + [] -> + [Char] + end end. %% Fast path for ascii searching for one character in lists diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 9123bf2f28..a3e294ffea 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -28,7 +28,8 @@ otp_8130/1, overload_mac/1, otp_8388/1, otp_8470/1, otp_8562/1, otp_8665/1, otp_8911/1, otp_10302/1, otp_10820/1, otp_11728/1, encoding/1, extends/1, function_macro/1, - test_error/1, test_warning/1, otp_14285/1]). + test_error/1, test_warning/1, otp_14285/1, + test_if/1]). -export([epp_parse_erl_form/2]). @@ -69,7 +70,7 @@ all() -> overload_mac, otp_8388, otp_8470, otp_8562, otp_8665, otp_8911, otp_10302, otp_10820, otp_11728, encoding, extends, function_macro, test_error, test_warning, - otp_14285]. + otp_14285, test_if]. groups() -> [{upcase_mac, [], [upcase_mac_1, upcase_mac_2]}, @@ -799,7 +800,8 @@ otp_8130(Config) when is_list(Config) -> PreDefMacs = macs(Epp), ['BASE_MODULE','BASE_MODULE_STRING','BEAM','FILE', 'FUNCTION_ARITY','FUNCTION_NAME', - 'LINE','MACHINE','MODULE','MODULE_STRING'] = PreDefMacs, + 'LINE','MACHINE','MODULE','MODULE_STRING', + 'OTP_RELEASE'] = PreDefMacs, {ok,[{'-',_},{atom,_,file}|_]} = epp:scan_erl_form(Epp), {ok,[{'-',_},{atom,_,module}|_]} = epp:scan_erl_form(Epp), {ok,[{atom,_,t}|_]} = epp:scan_erl_form(Epp), @@ -952,27 +954,7 @@ ifdef(Config) -> {define_c5, <<"-\ndefine a.\n">>, - {errors,[{{2,1},epp,{bad,define}}],[]}}, - - {define_c6, - <<"\n-if.\n" - "-endif.\n">>, - {errors,[{{2,2},epp,{'NYI','if'}}],[]}}, - - {define_c7, - <<"-ifndef(a).\n" - "-elif.\n" - "-endif.\n">>, - {errors,[{{2,2},epp,{'NYI',elif}}],[]}}, - - {define_c7, - <<"-ifndef(a).\n" - "-if.\n" - "-elif.\n" - "-endif.\n" - "-endif.\n" - "t() -> a.\n">>, - {errors,[{{2,2},epp,{'NYI','if'}}],[]}} + {errors,[{{2,1},epp,{bad,define}}],[]}} ], [] = compile(Config, Cs), @@ -1117,6 +1099,147 @@ test_warning(Config) -> [] = compile(Config, Cs), ok. +%% OTP-12847: Test the -if and -elif directives and the built-in +%% function defined(Symbol). +test_if(Config) -> + Cs = [{if_1c, + <<"-if.\n" + "-endif.\n" + "-if no_parentheses.\n" + "-endif.\n" + "-if(syntax error.\n" + "-endif.\n" + "-if(true).\n" + "-if(a+3).\n" + "syntax error not triggered here.\n" + "-endif.\n">>, + {errors,[{1,epp,{bad,'if'}}, + {3,epp,{bad,'if'}}, + {5,erl_parse,["syntax error before: ","error"]}, + {11,epp,{illegal,"unterminated",'if'}}], + []}}, + + {if_2c, %Bad guard expressions. + <<"-if(is_list(integer_to_list(42))).\n" %Not guard BIF. + "-endif.\n" + "-if(begin true end).\n" + "-endif.\n">>, + {errors,[{1,epp,{bad,'if'}}, + {3,epp,{bad,'if'}}], + []}}, + + {if_3c, %Invalid use of defined/1. + <<"-if defined(42).\n" + "-endif.\n">>, + {errors,[{1,epp,{bad,'if'}}],[]}}, + + {if_4c, + <<"-elif OTP_RELEASE > 18.\n">>, + {errors,[{1,epp,{illegal,"unbalanced",'elif'}}],[]}}, + + {if_5c, + <<"-ifdef(not_defined_today).\n" + "-else.\n" + "-elif OTP_RELEASE > 18.\n" + "-endif.\n">>, + {errors,[{3,epp,{illegal,"unbalanced",'elif'}}],[]}}, + + {if_6c, + <<"-if(defined(OTP_RELEASE)).\n" + "-else.\n" + "-elif(true).\n" + "-endif.\n">>, + {errors,[{3,epp,elif_after_else}],[]}}, + + {if_7c, + <<"-if(begin true end).\n" %Not a guard expression. + "-endif.\n">>, + {errors,[{1,epp,{bad,'if'}}],[]}} + + ], + [] = compile(Config, Cs), + + Ts = [{if_1, + <<"-if(?OTP_RELEASE > 18).\n" + "t() -> ok.\n" + "-else.\n" + "a bug.\n" + "-endif.\n">>, + ok}, + + {if_2, + <<"-if(false).\n" + "a bug.\n" + "-elif(?OTP_RELEASE > 18).\n" + "t() -> ok.\n" + "-else.\n" + "a bug.\n" + "-endif.\n">>, + ok}, + + {if_3, + <<"-if(true).\n" + "t() -> ok.\n" + "-elif(?OTP_RELEASE > 18).\n" + "a bug.\n" + "-else.\n" + "a bug.\n" + "-endif.\n">>, + ok}, + + {if_4, + <<"-define(a, 1).\n" + "-if(defined(a) andalso defined(OTP_RELEASE)).\n" + "t() -> ok.\n" + "-else.\n" + "a bug.\n" + "-endif.\n">>, + ok}, + + {if_5, + <<"-if(defined(a)).\n" + "a bug.\n" + "-else.\n" + "t() -> ok.\n" + "-endif.\n">>, + ok}, + + {if_6, + <<"-if(defined(not_defined_today)).\n" + " -if(true).\n" + " bug1.\n" + " -elif(true).\n" + " bug2.\n" + " -elif(true).\n" + " bug3.\n" + " -else.\n" + " bug4.\n" + " -endif.\n" + "-else.\n" + "t() -> ok.\n" + "-endif.\n">>, + ok}, + + {if_7, + <<"-if(not_builtin()).\n" + "a bug.\n" + "-else.\n" + "t() -> ok.\n" + "-endif.\n">>, + ok}, + + {if_8, + <<"-if(42).\n" %Not boolean. + "a bug.\n" + "-else.\n" + "t() -> ok.\n" + "-endif.\n">>, + ok} + ], + [] = run(Config, Ts), + + ok. + %% Advanced test on overloading macros. overload_mac(Config) when is_list(Config) -> Cs = [ diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 02211fa8df..574aac96c8 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -87,6 +87,7 @@ -export([t_select_reverse/1]). +-include_lib("stdlib/include/ms_transform.hrl"). % ets:fun2ms -include_lib("common_test/include/ct.hrl"). -define(m(A,B), assert_eq(A,B)). @@ -173,10 +174,12 @@ groups() -> init_per_suite(Config) -> erts_debug:set_internal_state(available_internal_state, true), + erts_debug:set_internal_state(ets_force_trap, true), Config. end_per_suite(_Config) -> stop_spawn_logger(), + erts_debug:set_internal_state(ets_force_trap, false), catch erts_debug:set_internal_state(available_internal_state, false), ok. @@ -812,7 +815,60 @@ t_delete_all_objects_do(Opts) -> 4000 = ets:info(T,size), true = ets:delete_all_objects(T), 0 = ets:info(T,size), - ets:delete(T). + ets:delete(T), + + %% Test delete_all_objects is atomic + T2 = ets:new(t_delete_all_objects, [public | Opts]), + Self = self(), + Inserters = [spawn_link(fun() -> inserter(T2, 100*1000, 1, Self) end) || _ <- [1,2,3,4]], + [receive {Ipid, running} -> ok end || Ipid <- Inserters], + + ets:delete_all_objects(T2), + erlang:yield(), + [Ipid ! stop || Ipid <- Inserters], + Result = [receive {Ipid, stopped, Highest} -> {Ipid,Highest} end || Ipid <- Inserters], + + %% Verify unbroken sequences of objects inserted _after_ ets:delete_all_objects. + Sum = lists:foldl(fun({Ipid, Highest}, AccSum) -> + %% ets:fun2ms(fun({{K,Ipid}}) when K =< Highest -> true end), + AliveMS = [{{{'$1',Ipid}},[{'=<','$1',{const,Highest}}],[true]}], + Alive = ets:select_count(T2, AliveMS), + Lowest = Highest - (Alive-1), + + %% ets:fun2ms(fun({{K,Ipid}}) when K < Lowest -> true end) + DeletedMS = [{{{'$1',Ipid}},[{'<','$1',{const,Lowest}}],[true]}], + 0 = ets:select_count(T2, DeletedMS), + AccSum + Alive + end, + 0, + Result), + ok = case ets:info(T2, size) of + Sum -> ok; + Size -> + io:format("Sum = ~p\nSize = ~p\n", [Sum, Size]), + {Sum,Size} + end, + + ets:delete(T2). + +inserter(_, 0, _, _) -> + ok; +inserter(T, N, Next, Papa) -> + case Next of + 10*1000 -> + Papa ! {self(), running}; + _ -> + ok + end, + + ets:insert(T, {{Next, self()}}), + receive + stop -> + Papa ! {self(), stopped, Next}, + ok + after 0 -> + inserter(T, N-1, Next+1, Papa) + end. %% Test ets:delete_object/2. diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 9f48fbf5e3..13f2cbd27b 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -1808,7 +1808,7 @@ rpc_call_max(Node, M, F, Args) -> %% Make sure that a bad specification for a printable range is rejected. bad_printable_range(Config) when is_list(Config) -> - Cmd = lists:concat([lib:progname()," +pcunnnnnicode -run erlang halt"]), + Cmd = ct:get_progname() ++ " +pcunnnnnicode -run erlang halt", P = open_port({spawn, Cmd}, [stderr_to_stdout, {line, 200}]), ok = receive {P, {data, {eol , "bad range of printable characters" ++ _}}} -> diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 8f8a0f6e73..5c189a6c73 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -7468,7 +7468,7 @@ strip_qlc_call(H) -> strip_qlc_call2(H) -> S = qlc:info(H, {flat, false}), {ok, Tokens, _EndLine} = erl_scan:string(S++".", 1, [text]), - {ok, [Expr], Bs} = lib:extended_parse_exprs(Tokens), + {ok, [Expr], Bs} = erl_eval:extended_parse_exprs(Tokens), {case Expr of {call,_,{remote,_,{atom,_,qlc},{atom,_,q}},[LC]} -> {qlc, lists:flatten([erl_pp:expr(LC), "."]), []}; @@ -7489,7 +7489,7 @@ strip_qlc_call2(H) -> join_info_count(H) -> S = qlc:info(H, {flat, false}), {ok, Tokens, _EndLine} = erl_scan:string(S++".", 1, [text]), - {ok, [Expr], _Bs} = lib:extended_parse_exprs(Tokens), + {ok, [Expr], _Bs} = erl_eval:extended_parse_exprs(Tokens), #ji{nmerge = Nmerge, nlookup = Nlookup, nkeysort = NKeysort, nnested_loop = Nnested_loop} = ji(Expr, #ji{}), @@ -7533,7 +7533,7 @@ lookup_keys({generate,_,Q}, L) -> lookup_keys(Q, L); lookup_keys({table,Chars}, L) when is_list(Chars) -> {ok, Tokens, _} = erl_scan:string(lists:flatten(Chars++"."), 1, [text]), - {ok, [Expr], _Bs} = lib:extended_parse_exprs(Tokens), + {ok, [Expr], _Bs} = erl_eval:extended_parse_exprs(Tokens), case Expr of {call,_,_,[_fun,AKs]} -> case erl_parse:normalise(AKs) of diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index ca85314775..22136d687c 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -2780,7 +2780,7 @@ otp_10302(Config) when is_list(Config) -> rpc:call(Node,shell, prompt_func, [default]), _ = shell:prompt_func(default), - %% Test lib:format_exception() (cf. OTP-6554) + %% Test erl_error:format_exception() (cf. OTP-6554) Test6 = <<"begin A = <<\"\\xaa\">>, @@ -2967,10 +2967,10 @@ otp_14296(Config) when is_list(Config) -> R = t(S) end(), - %% Test lib:extended_parse_term/1 + %% Test erl_eval:extended_parse_term/1 TF = fun(S) -> {ok, Ts, _} = erl_scan:string(S++".", 1, [text]), - case lib:extended_parse_term(Ts) of + case erl_eval:extended_parse_term(Ts) of {ok, Term} -> Term; {error, _}=Error -> Error end diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index fdff2d24b8..29fabb4583 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -810,6 +810,18 @@ do_measure(DataDir) -> Do2(slice, repeat(fun() -> string:slice(S0, 20, 15) end), list), Do2(slice, repeat(fun() -> string:slice(S0B, 20, 15) end), binary), + LCase = "areaa reare rerar earea reare reare", + LCaseB = unicode:characters_to_binary(LCase), + UCase = string:uppercase(LCase), + UCaseB = unicode:characters_to_binary(UCase), + + Do2(to_upper_0, repeat(fun() -> string:to_upper(UCase) end), list), + Do2(uppercase_0, repeat(fun() -> string:uppercase(UCase) end), list), + Do2(uppercase_0, repeat(fun() -> string:uppercase(UCaseB) end), binary), + Do2(to_upper_a, repeat(fun() -> string:to_upper(LCase) end), list), + Do2(uppercase_a, repeat(fun() -> string:uppercase(LCase) end), list), + Do2(uppercase_a, repeat(fun() -> string:uppercase(LCaseB) end), binary), + io:format("--~n",[]), NthTokens = {nth_lexemes, fun(Str) -> string:nth_lexeme(Str, 18000, [$\n,$\r]) end}, [Do(Name,Fun,Mode) || {Name,Fun} <- [NthTokens], Mode <- [list, binary]], diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl index 0a12e8fd8b..7e741cc649 100644 --- a/lib/syntax_tools/src/epp_dodger.erl +++ b/lib/syntax_tools/src/epp_dodger.erl @@ -502,6 +502,10 @@ quickscan_form([{'-', _L}, {atom, La, ifdef} | _Ts]) -> kill_form(La); quickscan_form([{'-', _L}, {atom, La, ifndef} | _Ts]) -> kill_form(La); +quickscan_form([{'-', _L}, {'if', La} | _Ts]) -> + kill_form(La); +quickscan_form([{'-', _L}, {atom, La, elif} | _Ts]) -> + kill_form(La); quickscan_form([{'-', _L}, {atom, La, else} | _Ts]) -> kill_form(La); quickscan_form([{'-', _L}, {atom, La, endif} | _Ts]) -> @@ -615,8 +619,13 @@ filter_form(T) -> %% --------------------------------------------------------------------- %% Normal parsing - try to preserve all information -normal_parser(Ts, Opt) -> - rewrite_form(parse_tokens(scan_form(Ts, Opt))). +normal_parser(Ts0, Opt) -> + case scan_form(Ts0, Opt) of + Ts when is_list(Ts) -> + rewrite_form(parse_tokens(Ts)); + Node -> + Node + end. scan_form([{'-', _L}, {atom, La, define} | Ts], Opt) -> [{atom, La, ?pp_form}, {'(', La}, {')', La}, {'->', La}, @@ -636,12 +645,26 @@ scan_form([{'-', _L}, {atom, La, ifdef} | Ts], Opt) -> scan_form([{'-', _L}, {atom, La, ifndef} | Ts], Opt) -> [{atom, La, ?pp_form}, {'(', La}, {')', La}, {'->', La}, {atom, La, ifndef} | scan_macros(Ts, Opt)]; +scan_form([{'-', _L}, {'if', La} | Ts], Opt) -> + [{atom, La, ?pp_form}, {'(', La}, {')', La}, {'->', La}, + {atom, La, 'if'} | scan_macros(Ts, Opt)]; +scan_form([{'-', _L}, {atom, La, elif} | Ts], Opt) -> + [{atom, La, ?pp_form}, {'(', La}, {')', La}, {'->', La}, + {atom, La, 'elif'} | scan_macros(Ts, Opt)]; scan_form([{'-', _L}, {atom, La, else} | Ts], Opt) -> [{atom, La, ?pp_form}, {'(', La}, {')', La}, {'->', La}, {atom, La, else} | scan_macros(Ts, Opt)]; scan_form([{'-', _L}, {atom, La, endif} | Ts], Opt) -> [{atom, La, ?pp_form}, {'(', La}, {')', La}, {'->', La}, {atom, La, endif} | scan_macros(Ts, Opt)]; +scan_form([{'-', _L}, {atom, La, error} | Ts], _Opt) -> + Desc = build_info_string("-error", Ts), + ErrorInfo = {La, ?MODULE, {error, Desc}}, + erl_syntax:error_marker(ErrorInfo); +scan_form([{'-', _L}, {atom, La, warning} | Ts], _Opt) -> + Desc = build_info_string("-warning", Ts), + ErrorInfo = {La, ?MODULE, {warning, Desc}}, + erl_syntax:error_marker(ErrorInfo); scan_form([{'-', L}, {'?', L1}, {Type, _, _}=N | [{'(', _} | _]=Ts], Opt) when Type =:= atom; Type =:= var -> %% minus, macro and open parenthesis at start of form - assume that @@ -657,6 +680,11 @@ scan_form([{'?', L}, {Type, _, _}=N | [{'(', _} | _]=Ts], Opt) scan_form(Ts, Opt) -> scan_macros(Ts, Opt). +build_info_string(Prefix, Ts0) -> + Ts = lists:droplast(Ts0), + String = lists:droplast(tokens_to_string(Ts)), + Prefix ++ " " ++ String ++ ".". + scan_macros(Ts, Opt) -> scan_macros(Ts, [], Opt). @@ -865,6 +893,10 @@ tokens_to_string([]) -> format_error(macro_args) -> errormsg("macro call missing end parenthesis"); +format_error({error, Error}) -> + Error; +format_error({warning, Error}) -> + Error; format_error({unknown, Reason}) -> errormsg(io_lib:format("unknown error: ~tP", [Reason, 15])). diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index 60a15c8e3f..6906ef1553 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -675,7 +675,12 @@ lay_2(Node, Ctxt) -> %% attribute name, without following parentheses. Ctxt1 = reset_prec(Ctxt), Args = erl_syntax:attribute_arguments(Node), - N = erl_syntax:attribute_name(Node), + N = case erl_syntax:attribute_name(Node) of + {atom, _, 'if'} -> + erl_syntax:variable('if'); + N0 -> + N0 + end, D = case attribute_type(Node) of spec -> [SpecTuple] = Args, diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl index c7f477c4d2..ced0dba3e2 100644 --- a/lib/syntax_tools/src/erl_syntax_lib.erl +++ b/lib/syntax_tools/src/erl_syntax_lib.erl @@ -1317,6 +1317,8 @@ analyze_attribute(Node) -> include_lib -> preprocessor; ifdef -> preprocessor; ifndef -> preprocessor; + 'if' -> preprocessor; + elif -> preprocessor; else -> preprocessor; endif -> preprocessor; A -> diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index fd51aca861..e08db0ea79 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -804,6 +804,7 @@ resulting regexp is surrounded by \\_< and \\_>." "is_integer" "is_list" "is_map" + "is_map_key" "is_number" "is_pid" "is_port" diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl index d0152a4915..1db90c1d86 100644 --- a/lib/tools/src/lcnt.erl +++ b/lib/tools/src/lcnt.erl @@ -125,7 +125,7 @@ %% -------------------------------------------------------------------- %% start() -> gen_server:start({local, ?MODULE}, ?MODULE, [], []). -stop() -> gen_server:call(?MODULE, stop, infinity). +stop() -> gen_server:stop(?MODULE, normal, infinity). init([]) -> {ok, #state{ locks = [], duration = 0 } }. start_internal() -> @@ -442,9 +442,6 @@ handle_call({save, Filename}, _From, State) -> {reply, {error, Error}, State} end; -handle_call(stop, _From, State) -> - {stop, normal, ok, State}; - handle_call(Command, _From, State) -> {reply, {error, {undefined, Command}}, State}. diff --git a/lib/tools/src/xref.erl b/lib/tools/src/xref.erl index 32efa36fa2..466ec7d331 100644 --- a/lib/tools/src/xref.erl +++ b/lib/tools/src/xref.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. +%% Copyright Ericsson AB 2000-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -182,7 +182,9 @@ split_args(Opts) -> end. stop(Name) -> - gen_server:call(Name, stop, infinity). + try gen_server:call(Name, stop, infinity) + after catch unregister(Name) % ensure the name is gone + end. add_release(Name, Dir) -> gen_server:call(Name, {add_release, Dir}, infinity). diff --git a/lib/tools/test/eprof_SUITE_data/eed.erl b/lib/tools/test/eprof_SUITE_data/eed.erl index 5f2a21aa60..9fe49c6f5c 100644 --- a/lib/tools/test/eprof_SUITE_data/eed.erl +++ b/lib/tools/test/eprof_SUITE_data/eed.erl @@ -54,7 +54,7 @@ edit(Name) -> loop(St0) -> {ok, St1, Cmd} = get_line(St0), - case catch command(lib:nonl(Cmd), St1) of + case catch command(nonl(Cmd), St1) of {'EXIT', Reason} -> %% XXX Should clear outstanding global command here. loop(print_error({'EXIT', Reason}, St1)); @@ -66,6 +66,10 @@ loop(St0) -> loop(St2) end. +nonl([$\n]) -> []; +nonl([]) -> []; +nonl([H|T]) -> [H|nonl(T)]. + command(Cmd, St) -> case parse_command(Cmd, St) of quit -> diff --git a/otp_versions.table b/otp_versions.table index e47f6ccc34..c66a390f21 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-20.3.6 : crypto-4.2.2 ssh-4.6.9 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.2 erts-9.3.1 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4 inets-6.5.1 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.10 ssl-8.2.6 stdlib-3.4.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : OTP-20.3.5 : erts-9.3.1 ssl-8.2.6 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.2 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4 inets-6.5.1 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.10 ssh-4.6.8 stdlib-3.4.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : OTP-20.3.4 : erl_interface-3.10.2 ic-4.4.4 inets-6.5.1 ssh-4.6.8 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erts-9.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.10 ssl-8.2.5 stdlib-3.4.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : OTP-20.3.3 : sasl-3.1.2 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.1 erts-9.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.3 inets-6.5 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 snmp-5.2.10 ssh-4.6.7 ssl-8.2.5 stdlib-3.4.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : @@ -24,6 +25,7 @@ OTP-20.0.3 : asn1-5.0.2 compiler-7.1.1 erts-9.0.3 ssh-4.5.1 # common_test-1.15.1 OTP-20.0.2 : asn1-5.0.1 erts-9.0.2 kernel-5.3.1 # common_test-1.15.1 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12.1 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4.1 syntax_tools-2.1.2 tools-2.10.1 wx-1.8.1 xmerl-1.3.15 : OTP-20.0.1 : common_test-1.15.1 erts-9.0.1 runtime_tools-1.12.1 stdlib-3.4.1 tools-2.10.1 # asn1-5.0 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 syntax_tools-2.1.2 wx-1.8.1 xmerl-1.3.15 : OTP-20.0 : asn1-5.0 common_test-1.15 compiler-7.1 cosProperty-1.2.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 erl_docgen-0.7 erl_interface-3.10 erts-9.0 eunit-2.3.3 hipe-3.16 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 orber-3.8.3 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4 syntax_tools-2.1.2 tools-2.10 wx-1.8.1 xmerl-1.3.15 # cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 eldap-1.2.2 et-1.6 ic-4.4.2 odbc-2.12 os_mon-2.4.2 otp_mibs-1.1.1 : +OTP-19.3.6.9 : ssh-4.4.2.4 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.4 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2.0.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssl-8.1.3.1.1 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 : OTP-19.3.6.8 : ssh-4.4.2.3 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.4 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2.0.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssl-8.1.3.1.1 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 : OTP-19.3.6.7 : kernel-5.2.0.1 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.4 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2.2 ssl-8.1.3.1.1 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 : OTP-19.3.6.6 : ssh-4.4.2.2 ssl-8.1.3.1.1 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.4 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 : diff --git a/scripts/diffable b/scripts/diffable index f22194e99f..08d2d5cb35 100755 --- a/scripts/diffable +++ b/scripts/diffable @@ -60,6 +60,7 @@ do_compile(OutDir, Opts0) -> "asn1", "stdlib", "kernel", + "hipe", "reltool", "runtime_tools", "xmerl", @@ -129,6 +130,10 @@ add_opts([], _Opts) -> get_src(["preloaded"|Apps]) -> WC = filename:join(code:root_dir(), "erts/preloaded/src/*.erl"), filelib:wildcard(WC) ++ get_src(Apps); +get_src(["hipe"|Apps]) -> + LibDir = code:lib_dir(hipe), + WC = filename:join(LibDir, "*/*.erl"), + filelib:wildcard(WC) ++ get_src(Apps); get_src(["inets"|Apps]) -> LibDir = code:lib_dir(inets), WC = filename:join(LibDir, "src/*/*.erl"), diff --git a/system/doc/efficiency_guide/binaryhandling.xml b/system/doc/efficiency_guide/binaryhandling.xml index 19f40c9abe..d07ff1325f 100644 --- a/system/doc/efficiency_guide/binaryhandling.xml +++ b/system/doc/efficiency_guide/binaryhandling.xml @@ -357,25 +357,8 @@ all_but_zeroes_to_list(<<Byte,T/binary>>, Acc, Remaining) -> <c>Buffer</c> from a match context to a sub binary (or do nothing if <c>Buffer</c> is a binary already).</p> - <p>Before you begin to think that the compiler can optimize any binary - patterns, the following function cannot be optimized by the compiler - (currently, at least):</p> - - <code type="erl"><![CDATA[ -non_opt_eq([H|T1], <<H,T2/binary>>) -> - non_opt_eq(T1, T2); -non_opt_eq([_|_], <<_,_/binary>>) -> - false; -non_opt_eq([], <<>>) -> - true.]]></code> - - <p>It was mentioned earlier that the compiler can only delay creation of - sub binaries if it knows that the binary will not be shared. In this case, - the compiler cannot know.</p> - - <p>Soon it is shown how to rewrite <c>non_opt_eq/2</c> so that the delayed - sub binary optimization can be applied, and more importantly, it is shown - how you can find out whether your code can be optimized.</p> + <p>But in more complicated code, how can one know whether the + optimization is applied or not?</p> <section> <marker id="bin_opt_info"></marker> @@ -422,67 +405,6 @@ after_zero(<<>>) -> binary cannot be delayed, because it will be returned. The warning for the second clause says that a sub binary will not be created (yet).</p> - - <p>Let us revisit the earlier example of the code that could not - be optimized and find out why:</p> - - <code type="erl"><![CDATA[ -non_opt_eq([H|T1], <<H,T2/binary>>) -> - %% INFO: matching anything else but a plain variable to - %% the left of binary pattern will prevent delayed - %% sub binary optimization; - %% SUGGEST changing argument order - %% NOT OPTIMIZED: called function non_opt_eq/2 does not - %% begin with a suitable binary matching instruction - non_opt_eq(T1, T2); -non_opt_eq([_|_], <<_,_/binary>>) -> - false; -non_opt_eq([], <<>>) -> - true.]]></code> - - <p>The compiler emitted two warnings. The <c>INFO</c> warning refers - to the function <c>non_opt_eq/2</c> as a callee, indicating that any - function that call <c>non_opt_eq/2</c> cannot make delayed sub binary - optimization. There is also a suggestion to change argument order. - The second warning (that happens to refer to the same line) refers to - the construction of the sub binary itself.</p> - - <p>Soon another example will show the difference between the - <c>INFO</c> and <c>NOT OPTIMIZED</c> warnings somewhat clearer, but - let us first follow the suggestion to change argument order:</p> - - <code type="erl"><![CDATA[ -opt_eq(<<H,T1/binary>>, [H|T2]) -> - %% OPTIMIZED: creation of sub binary delayed - opt_eq(T1, T2); -opt_eq(<<_,_/binary>>, [_|_]) -> - false; -opt_eq(<<>>, []) -> - true.]]></code> - - <p>The compiler gives a warning for the following code fragment:</p> - - <code type="erl"><![CDATA[ -match_body([0|_], <<H,_/binary>>) -> - %% INFO: matching anything else but a plain variable to - %% the left of binary pattern will prevent delayed - %% sub binary optimization; - %% SUGGEST changing argument order - done; -...]]></code> - - <p>The warning means that <em>if</em> there is a call to <c>match_body/2</c> - (from another clause in <c>match_body/2</c> or another function), the - delayed sub binary optimization will not be possible. More warnings will - occur for any place where a sub binary is matched out at the end of and - passed as the second argument to <c>match_body/2</c>, for example:</p> - - <code type="erl"><![CDATA[ -match_head(List, <<_:10,Data/binary>>) -> - %% NOT OPTIMIZED: called function match_body/2 does not - %% begin with a suitable binary matching instruction - match_body(List, Data).]]></code> - </section> <section> diff --git a/system/doc/efficiency_guide/efficiency_guide.erl b/system/doc/efficiency_guide/efficiency_guide.erl index e982bdae65..c57785aaa3 100644 --- a/system/doc/efficiency_guide/efficiency_guide.erl +++ b/system/doc/efficiency_guide/efficiency_guide.erl @@ -1,5 +1,5 @@ -module(efficiency_guide). --compile(export_all). +-compile([export_all,nowarn_export_all). %% DO NOT naive_reverse([H|T]) -> @@ -71,28 +71,6 @@ all_but_zeroes_to_list(<<0,T/binary>>, Acc, Remaining) -> all_but_zeroes_to_list(<<Byte,T/binary>>, Acc, Remaining) -> all_but_zeroes_to_list(T, [Byte|Acc], Remaining-1). -non_opt_eq([H|T1], <<H,T2/binary>>) -> - non_opt_eq(T1, T2); -non_opt_eq([_|_], <<_,_/binary>>) -> - false; -non_opt_eq([], <<>>) -> - true. - -opt_eq(<<H,T1/binary>>, [H|T2]) -> - opt_eq(T1, T2); -opt_eq(<<_,_/binary>>, [_|_]) -> - false; -opt_eq(<<>>, []) -> - true. - -match_head(List, <<_:10,Data/binary>>) -> - match_body(List, Data). - -match_body([0|_], <<H,_/binary>>) -> - done; -match_body([H|T1], <<H,T2/binary>>) -> - {T1,T2}. - count1(<<_,T/binary>>, Count) -> count1(T, Count+1); count1(<<>>, Count) -> Count. diff --git a/system/doc/reference_manual/macros.xml b/system/doc/reference_manual/macros.xml index a341307ab7..760599308c 100644 --- a/system/doc/reference_manual/macros.xml +++ b/system/doc/reference_manual/macros.xml @@ -150,6 +150,11 @@ bar(X) -> <item>The name of the current function.</item> <tag><c>?FUNCTION_ARITY</c></tag> <item>The arity (number of arguments) for the current function.</item> + <tag><c>?OTP_RELEASE</c></tag> + <item>The OTP release that the currently executing ERTS + application is part of, as an integer. For details, see + <seealso marker="erts:erlang#system_info/1"><c>erlang:system_info(otp_release)</c></seealso>. + This macro was introduced in OTP release 21.</item> </taglist> </section> @@ -202,8 +207,16 @@ f() -> directive. If that condition is false, the lines following <c>else</c> are evaluated instead.</item> <tag><c>-endif.</c></tag> - <item>Specifies the end of an <c>ifdef</c> or <c>ifndef</c> - directive.</item> + <item>Specifies the end of an <c>ifdef</c>, an <c>ifndef</c> + directive, or the end of an <c>if</c> or <c>elif</c> directive.</item> + <tag><c>-if(Condition).</c></tag> + <item>Evaluates the following lines only if <c>Condition</c> + evaluates to true.</item> + <tag><c>-elif(Condition).</c></tag> + <item>Only allowed after an <c>if</c> or another <c>elif</c> directive. + If the preceding <c>if</c> or <c>elif</c> directives do not + evaluate to true, and the <c>Condition</c> evaluates to true, + the lines following the <c>elif</c> are evaluated instead.</item> </taglist> <note> <p>The macro directives cannot be used inside functions.</p> @@ -231,6 +244,24 @@ or {ok,m}</pre> <p><c>?LOG(Arg)</c> is then expanded to a call to <c>io:format/2</c> and provide the user with some simple trace output.</p> + + <p><em>Example:</em></p> + <code type="none"> +-module(m) +... +-ifdef(OTP_RELEASE). + %% OTP 21 or higher + -if(?OTP_RELEASE >= 22). + %% Code that will work in OTP 22 or higher + -elif(?OTP_RELEASE >= 21). + %% Code that will work in OTP 21 or higher + -endif. +-else. + %% OTP 20 or lower. +-endif. +...</code> + <p>The code uses the <c>OTP_RELEASE</c> macro to conditionally + select code depending on release.</p> </section> <section> |