aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--bootstrap/lib/compiler/ebin/compile.beambin41364 -> 41372 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_error.beambin0 -> 8368 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_eval.beambin30260 -> 35216 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/escript.beambin16824 -> 16832 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/lib.beambin14936 -> 0 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/proc_lib.beambin12436 -> 12444 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/qlc.beambin68808 -> 68816 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/shell.beambin29804 -> 29812 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/slave.beambin4740 -> 4816 bytes
-rw-r--r--erts/configure.in571
-rw-r--r--erts/doc/src/Makefile1
-rw-r--r--erts/doc/src/alt_disco.xml93
-rw-r--r--erts/doc/src/erl_driver.xml6
-rw-r--r--erts/doc/src/erlang.xml46
-rw-r--r--erts/doc/src/part.xml1
-rw-r--r--erts/emulator/Makefile.in2
-rw-r--r--erts/emulator/beam/atom.names3
-rw-r--r--erts/emulator/beam/beam_bif_load.c32
-rw-r--r--erts/emulator/beam/beam_emu.c3
-rw-r--r--erts/emulator/beam/bif.c181
-rw-r--r--erts/emulator/beam/bif.h37
-rw-r--r--erts/emulator/beam/bif.tab9
-rw-r--r--erts/emulator/beam/dist.c406
-rw-r--r--erts/emulator/beam/erl_alloc.types3
-rw-r--r--erts/emulator/beam/erl_bif_info.c202
-rw-r--r--erts/emulator/beam/erl_bif_trace.c190
-rw-r--r--erts/emulator/beam/erl_gc.c15
-rw-r--r--erts/emulator/beam/erl_map.c32
-rw-r--r--erts/emulator/beam/erl_message.c5
-rw-r--r--erts/emulator/beam/erl_monitor_link.c97
-rw-r--r--erts/emulator/beam/erl_monitor_link.h57
-rw-r--r--erts/emulator/beam/erl_proc_sig_queue.c534
-rw-r--r--erts/emulator/beam/erl_proc_sig_queue.h141
-rw-r--r--erts/emulator/beam/erl_process.c897
-rw-r--r--erts/emulator/beam/erl_process.h57
-rw-r--r--erts/emulator/beam/erl_trace.c32
-rw-r--r--erts/emulator/beam/erl_trace.h2
-rw-r--r--erts/emulator/hipe/hipe_mode_switch.c13
-rw-r--r--erts/emulator/hipe/hipe_native_bif.c23
-rw-r--r--erts/emulator/hipe/hipe_process.h9
-rw-r--r--erts/emulator/nifs/unix/unix_prim_file.c2
-rw-r--r--erts/emulator/sys/unix/erl_unix_sys.h2
-rw-r--r--erts/emulator/test/code_SUITE.erl2
-rw-r--r--erts/emulator/test/distribution_SUITE.erl13
-rw-r--r--erts/emulator/test/port_SUITE.erl8
-rw-r--r--erts/emulator/test/sensitive_SUITE.erl2
-rw-r--r--erts/emulator/test/trace_SUITE.erl62
-rw-r--r--erts/emulator/test/tracer_SUITE.erl6
-rw-r--r--erts/etc/unix/etp-commands.in161
-rw-r--r--erts/preloaded/ebin/erlang.beambin101844 -> 103344 bytes
-rw-r--r--erts/preloaded/ebin/erts_dirty_process_signal_handler.beambin2720 -> 2760 bytes
-rw-r--r--erts/preloaded/ebin/erts_internal.beambin15584 -> 16672 bytes
-rw-r--r--erts/preloaded/src/erlang.erl92
-rw-r--r--erts/preloaded/src/erts_dirty_process_signal_handler.erl34
-rw-r--r--erts/preloaded/src/erts_internal.erl49
-rw-r--r--erts/test/erlc_SUITE.erl4
-rw-r--r--lib/common_test/doc/src/ct.xml10
-rw-r--r--lib/common_test/src/ct.erl17
-rw-r--r--lib/common_test/src/test_server_ctrl.erl2
-rw-r--r--lib/common_test/src/test_server_node.erl8
-rw-r--r--lib/common_test/test_server/ts_erl_config.erl10
-rw-r--r--lib/common_test/test_server/ts_run.erl2
-rw-r--r--lib/compiler/src/compile.erl2
-rw-r--r--lib/debugger/src/dbg_icmd.erl2
-rw-r--r--lib/debugger/src/dbg_wx_win.erl2
-rw-r--r--lib/dialyzer/test/options1_SUITE_data/results/compiler2
-rw-r--r--lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl6
-rw-r--r--lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_esi.erl44
-rw-r--r--lib/hipe/main/hipe.erl4
-rw-r--r--lib/inets/src/http_server/mod_esi.erl44
-rw-r--r--lib/kernel/doc/src/Makefile1
-rw-r--r--lib/kernel/doc/src/erl_epmd.xml104
-rw-r--r--lib/kernel/doc/src/kernel_app.xml15
-rw-r--r--lib/kernel/doc/src/ref_man.xml1
-rw-r--r--lib/kernel/doc/src/specs.xml1
-rw-r--r--lib/kernel/src/application_controller.erl12
-rw-r--r--lib/kernel/src/erl_epmd.erl64
-rw-r--r--lib/kernel/src/erl_signal_handler.erl11
-rw-r--r--lib/kernel/src/inet_tcp_dist.erl148
-rw-r--r--lib/kernel/src/kernel.erl8
-rw-r--r--lib/kernel/src/kernel_config.erl7
-rw-r--r--lib/kernel/test/application_SUITE.erl12
-rw-r--r--lib/kernel/test/erl_distribution_SUITE.erl2
-rw-r--r--lib/kernel/test/heart_SUITE.erl8
-rw-r--r--lib/kernel/test/kernel_config_SUITE.erl2
-rw-r--r--lib/kernel/test/os_SUITE.erl6
-rw-r--r--lib/observer/src/observer_lib.erl2
-rw-r--r--lib/parsetools/src/yecc.erl8
-rw-r--r--lib/ssh/doc/src/ssh.xml6
-rw-r--r--lib/ssh/src/ssh.hrl7
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl425
-rw-r--r--lib/ssh/src/ssh_options.erl21
-rw-r--r--lib/ssh/test/ssh_basic_SUITE.erl135
-rw-r--r--lib/ssh/test/ssh_test_lib.erl2
-rw-r--r--lib/ssl/src/inet_tls_dist.erl100
-rw-r--r--lib/ssl/src/ssl_cipher.erl84
-rw-r--r--lib/ssl/src/ssl_handshake.erl5
-rw-r--r--lib/ssl/test/ssl_ECC.erl44
-rw-r--r--lib/stdlib/doc/src/Makefile1
-rw-r--r--lib/stdlib/doc/src/lib.xml103
-rw-r--r--lib/stdlib/doc/src/ref_man.xml1
-rw-r--r--lib/stdlib/doc/src/specs.xml1
-rw-r--r--lib/stdlib/src/Makefile3
-rw-r--r--lib/stdlib/src/erl_error.erl (renamed from lib/stdlib/src/lib.erl)327
-rw-r--r--lib/stdlib/src/erl_eval.erl221
-rw-r--r--lib/stdlib/src/escript.erl2
-rw-r--r--lib/stdlib/src/proc_lib.erl4
-rw-r--r--lib/stdlib/src/qlc.erl8
-rw-r--r--lib/stdlib/src/shell.erl6
-rw-r--r--lib/stdlib/src/slave.erl14
-rw-r--r--lib/stdlib/src/stdlib.app.src4
-rw-r--r--lib/stdlib/test/io_SUITE.erl2
-rw-r--r--lib/stdlib/test/qlc_SUITE.erl6
-rw-r--r--lib/stdlib/test/shell_SUITE.erl6
-rw-r--r--lib/tools/src/xref.erl6
-rw-r--r--lib/tools/test/eprof_SUITE_data/eed.erl6
116 files changed, 3299 insertions, 2955 deletions
diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam
index 99a6c5d7f0..5772dd173b 100644
--- a/bootstrap/lib/compiler/ebin/compile.beam
+++ b/bootstrap/lib/compiler/ebin/compile.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_error.beam b/bootstrap/lib/stdlib/ebin/erl_error.beam
new file mode 100644
index 0000000000..dc9d0a8d39
--- /dev/null
+++ b/bootstrap/lib/stdlib/ebin/erl_error.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam
index f3fc64ee32..a6dc4e0d68 100644
--- a/bootstrap/lib/stdlib/ebin/erl_eval.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/escript.beam b/bootstrap/lib/stdlib/ebin/escript.beam
index 79ed0a3876..781484fe0b 100644
--- a/bootstrap/lib/stdlib/ebin/escript.beam
+++ b/bootstrap/lib/stdlib/ebin/escript.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/lib.beam b/bootstrap/lib/stdlib/ebin/lib.beam
deleted file mode 100644
index 2cc777b388..0000000000
--- a/bootstrap/lib/stdlib/ebin/lib.beam
+++ /dev/null
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam
index 9025f68b68..f475eff9b0 100644
--- a/bootstrap/lib/stdlib/ebin/proc_lib.beam
+++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam
index 523f93a848..5d4375adca 100644
--- a/bootstrap/lib/stdlib/ebin/qlc.beam
+++ b/bootstrap/lib/stdlib/ebin/qlc.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam
index abbe513b39..36a9c27c35 100644
--- a/bootstrap/lib/stdlib/ebin/shell.beam
+++ b/bootstrap/lib/stdlib/ebin/shell.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/slave.beam b/bootstrap/lib/stdlib/ebin/slave.beam
index 596dda4ed5..e832637c7c 100644
--- a/bootstrap/lib/stdlib/ebin/slave.beam
+++ b/bootstrap/lib/stdlib/ebin/slave.beam
Binary files differ
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 3154fdaf8c..cff56b9cb8 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -7005,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
@@ -7032,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/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 33738dc20b..21dda9ff03 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
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..55450e397f 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)
{
- Process *rp;
+ if (redsp)
+ *redsp = 1;
- if (BIF_ARG_2 != am_backtrace)
- BIF_ERROR(BIF_P, BADARG);
+ if (ERTS_PROC_IS_EXITING(c_p))
+ return 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);
+ 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)
+{
+ Eterm res;
+
+ if (BIF_ARG_2 != am_backtrace)
+ BIF_RET(am_badarg);
+
+ 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;
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_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 3d565b1bb8..05e8fc11a2 100644
--- a/erts/emulator/beam/erl_map.c
+++ b/erts/emulator/beam/erl_map.c
@@ -3058,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
@@ -3117,13 +3117,21 @@ 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;
}
@@ -3149,9 +3157,9 @@ 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 = TUPLE3(hp, CAR(lst), CDR(lst), make_tuple(hp+4));
+ hp += 4;
+ patch_ptr = hp-1;
} else {
Eterm tup = TUPLE2(hp, CAR(lst), CDR(lst)); hp += 3;
res = CONS(hp, tup, res); hp += 2;
@@ -3188,7 +3196,8 @@ 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;
+ (void) TUPLE3(hp, CAR(lst), CDR(lst), make_tuple(hp+4)); hp += 4;
+ patch_ptr = hp-1;
} else {
Eterm tup = TUPLE2(hp, CAR(lst), CDR(lst)); hp += 3;
res = CONS(hp, tup, res); hp += 2;
@@ -3286,7 +3295,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;
@@ -3294,6 +3303,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_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..efa7c08664 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.
@@ -744,6 +845,13 @@ erts_enqueue_signals(Process *rp, ErtsMessage *first,
void
erts_proc_sig_send_pending(ErtsSchedulerData* esdp);
+/* SVERK Doc me up! */
+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 +921,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 +1002,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..b373d08a6b 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();
@@ -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;
+ BIF_RET(am_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 ------------------------------------- */
- }
-
-#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;
+ BIF_ERROR(BIF_P, BADARG);
}
- 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;
- }
-
- 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 == erts_monitor_tree_lookup(BIF_P->suspend_monitors, BIF_ARG_1));
+ ASSERT(mon->type == ERTS_MON_TYPE_SUSPEND);
+ msp = (ErtsMonitorSuspend *) erts_monitor_to_data(mon);
- ASSERT(ERTS_PSFLG_SUSPENDED
- & erts_atomic32_read_nob(&suspendee->state));
- ASSERT(BIF_P != suspendee);
- resume_process(suspendee, ERTS_PROC_LOCK_STATUS);
+ mstate = erts_atomic_dec_read_relb(&msp->state);
- erts_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS);
- }
+ ASSERT((mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK) >= 0);
- if (!smon->active && !smon->pending) {
- ASSERT(mon);
- erts_monitor_tree_delete(&BIF_P->suspend_monitors, mon);
- erts_monitor_suspend_destroy(smon);
+ if ((mstate & ERTS_MSUSPEND_STATE_COUNTER_MASK) == 0) {
+ erts_monitor_tree_delete(&ERTS_P_MONITORS(BIF_P), mon);
+ erts_proc_sig_send_demonitor(mon);
}
- 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
@@ -9694,12 +9169,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 +9217,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;
{
@@ -10195,8 +9666,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 +9754,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 +9814,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 +11334,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 +11382,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 +11438,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 +11604,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 +11654,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 +11666,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 +11703,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 +11716,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 +11821,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 +11900,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 +11972,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 +12125,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 +12156,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 +12288,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 +12495,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 +12518,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_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/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/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/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/erlang.beam b/erts/preloaded/ebin/erlang.beam
index 6184a36d7c..52f4c686a9 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam b/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam
index 8d9ca3fcae..1013b8de0c 100644
--- a/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam
+++ b/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam
index cdfdaf9640..73bd730eaa 100644
--- a/erts/preloaded/ebin/erts_internal.beam
+++ b/erts/preloaded/ebin/erts_internal.beam
Binary files differ
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index 5fcad25c6d..3a42e841e2 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -1521,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
@@ -1530,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
@@ -1685,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
@@ -1749,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
@@ -3045,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() -&gt; 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() -&gt; TestStatus | {error, Reason} | no_tests_running</name>
<fsummary>Returns status of ongoing test.</fsummary>
<type>
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/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/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/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/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/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 f96d946a5d..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
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/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/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/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/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/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index 6aed525e8b..407956cc6f 100644
--- a/lib/ssh/doc/src/ssh.xml
+++ b/lib/ssh/doc/src/ssh.xml
@@ -762,6 +762,8 @@
<datatype>
<name name="rekey_limit_common_option"/>
+ <name name="limit_bytes"/>
+ <name name="limit_time"/>
<desc>
<p>Sets the limit when rekeying is to be initiated. Both the max time and max amount of data
could be configured:
@@ -773,6 +775,10 @@
</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 fc0a3786ac..2efd239aae 100644
--- a/lib/ssh/src/ssh.hrl
+++ b/lib/ssh/src/ssh.hrl
@@ -191,10 +191,13 @@
-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, Bytes::non_neg_integer() |
- {Minutes::non_neg_integer(), Bytes::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() ::
{disconnectfun, fun((Reason::term()) -> void | any()) }.
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index dfdad769ed..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,22 +417,17 @@ init([Role,Socket,Opts]) ->
},
D = case Role of
client ->
- 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,
- %% Start the renegotiation timers
- {RekeyTimeout,_MaxSent} = ?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts),
- timer:apply_after(RekeyTimeout, gen_statem, cast, [self(), renegotiate]),
- timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]),
{ok, {hello,Role}, D};
{error,Error} ->
@@ -559,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) ->
@@ -1017,97 +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),
- {RekeyTimeout,_MaxSent} = ?GET_OPT(rekey_limit, Ssh#ssh.opts),
- timer:apply_after(RekeyTimeout, 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, _, D) ->
- %% Already in key-exchange so safe to ignore
- {RekeyTimeout,_MaxSent} = ?GET_OPT(rekey_limit, (D#data.ssh_params)#ssh.opts),
- timer:apply_after(RekeyTimeout, gen_statem, cast, [self(), renegotiate]),
- 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,
- {_RekeyTimeout,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]};
@@ -1221,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)
@@ -1232,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)
@@ -1273,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) ->
@@ -1303,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;
@@ -1319,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(
@@ -1336,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 ->
@@ -1421,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, _) ->
@@ -1442,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
@@ -1489,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]};
@@ -1746,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
@@ -1891,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}).
@@ -1922,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.
@@ -2134,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;
@@ -2248,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),
@@ -2291,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 73287e464a..fe95d2ac54 100644
--- a/lib/ssh/src/ssh_options.erl
+++ b/lib/ssh/src/ssh_options.erl
@@ -601,14 +601,19 @@ default(common) ->
{rekey_limit, def} =>
#{default => {3600000, 1024000000}, % {1 hour, 1 GB}
- chk => fun({TimeMins, SizBytes}) when is_integer(TimeMins) andalso TimeMins>=0,
- is_integer(SizBytes) andalso SizBytes>=0 ->
- %% New (>= 21) format
- {true, {TimeMins * 60*1000, % To ms
- SizBytes}};
- (SizBytes) when is_integer(SizBytes) andalso SizBytes>=0 ->
- %% Old (< 21) format
- {true, {3600000, SizBytes}};
+ 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,
diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl
index 603ac71d4b..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,7 +75,11 @@ groups() ->
shell_exit_status
]},
- {ssh_renegotiate_SUITE, [parallel], [rekey,
+ {ssh_renegotiate_SUITE, [parallel], [rekey0,
+ rekey1,
+ rekey2,
+ rekey3,
+ rekey4,
rekey_limit_client,
rekey_limit_daemon,
rekey_time_limit_client,
@@ -1330,28 +1333,36 @@ 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),
+
+ %% Check rekeying
+ timer:sleep(?REKEY_DATA_TMO),
+ ?wait_match(false, Kex1==ssh_test_lib:get_kex_init(ConnectionRef), [], 2000, 10),
+ ssh:close(ConnectionRef),
+ ssh:stop_daemon(Pid).
+
+%%--------------------------------------------------------------------
%%% Test rekeying by data volume
rekey_limit_client() -> [{timetrap,{seconds,400}}].
@@ -1359,7 +1370,7 @@ 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}]),
@@ -1368,31 +1379,33 @@ rekey_limit_client(Config) ->
{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),
- Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
+ true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)),
- Data = lists:duplicate(Limit+10,1),
+ %% Check that datatransfer triggers rekeying
ok = ssh_sftp:write_file(SftpPid, DataFile, Data),
-
timer:sleep(?REKEY_DATA_TMO),
- Kex2 = ssh_test_lib:get_kex_init(ConnectionRef),
+ ?wait_match(false, Kex1==(Kex2=ssh_test_lib:get_kex_init(ConnectionRef)), Kex2, 2000, 10),
- false = (Kex2 == Kex1),
+ %% 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)),
+ %% Check that it doesn't rekey on a small datatransfer
ok = ssh_sftp:write_file(SftpPid, DataFile, "hi\n"),
-
timer:sleep(?REKEY_DATA_TMO),
- Kex2 = ssh_test_lib:get_kex_init(ConnectionRef),
-
- false = (Kex2 == Kex1),
+ 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)),
ssh_sftp:stop_channel(SftpPid),
ssh:close(ConnectionRef),
@@ -1416,32 +1429,40 @@ rekey_limit_daemon(Config) ->
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),
Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
+ %% 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),
- false = (Kex2 == Kex1),
+ ?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)),
+ %% Check that it doesn't rekey on a small datatransfer
{ok,_} = ssh_sftp:read_file(SftpPid, DataFile2),
-
timer:sleep(?REKEY_DATA_TMO),
- Kex2 = ssh_test_lib:get_kex_init(ConnectionRef),
+ 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)),
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) ->
@@ -1460,13 +1481,12 @@ norekey_limit_client(Config) ->
Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
timer:sleep(?REKEY_DATA_TMO),
- Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
+ true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)),
{ok,_} = ssh_sftp:read_file(SftpPid, DataFile),
timer:sleep(?REKEY_DATA_TMO),
- Kex2 = ssh_test_lib:get_kex_init(ConnectionRef),
+ true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)),
- Kex1 = Kex2,
ssh_sftp:stop_channel(SftpPid),
ssh:close(ConnectionRef),
ssh:stop_daemon(Pid).
@@ -1488,13 +1508,12 @@ norekey_limit_daemon(Config) ->
Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
timer:sleep(?REKEY_DATA_TMO),
- Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
+ 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),
- Kex2 = ssh_test_lib:get_kex_init(ConnectionRef),
+ true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)),
- Kex1 = Kex2,
ssh_sftp:stop_channel(SftpPid),
ssh:close(ConnectionRef),
ssh:stop_daemon(Pid).
@@ -1504,39 +1523,41 @@ norekey_limit_daemon(Config) ->
rekey_time_limit_client() -> [{timetrap,{seconds,400}}].
rekey_time_limit_client(Config) ->
- Minutes = 1,
+ 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}]),
- {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef),
- rekey_time_limit(Pid, Minutes, ConnectionRef, SftpPid).
+ rekey_time_limit(Pid, ConnectionRef).
rekey_time_limit_daemon() -> [{timetrap,{seconds,400}}].
rekey_time_limit_daemon(Config) ->
- Minutes = 1,
+ 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}]),
- {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef),
- rekey_time_limit(Pid, Minutes, ConnectionRef, SftpPid).
+ rekey_time_limit(Pid, ConnectionRef).
-rekey_time_limit(Pid, Minutes, ConnectionRef, SftpPid) ->
+rekey_time_limit(Pid, ConnectionRef) ->
+ {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef),
Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
timer:sleep(5000),
- Kex1 = ssh_test_lib:get_kex_init(ConnectionRef),
+ true = (Kex1 == ssh_test_lib:get_kex_init(ConnectionRef)),
- timer:sleep((Minutes*60 + 30) * 1000),
- Kex2 = 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),
- false = (Kex2 == Kex1),
+ %% 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),
@@ -1544,7 +1565,7 @@ rekey_time_limit(Pid, Minutes, ConnectionRef, SftpPid) ->
%%--------------------------------------------------------------------
-%%% 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/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_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/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/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/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/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/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/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/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 ->