aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--OTP_VERSION1
-rw-r--r--bootstrap/lib/compiler/ebin/beam_dead.beambin13052 -> 13804 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_peep.beambin2872 -> 3004 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_type.beambin18632 -> 18692 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/compile.beambin41364 -> 41372 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/erl_bifs.beambin2088 -> 2104 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_codegen.beambin65172 -> 65360 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/erl_internal.beambin6984 -> 7012 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/ms_transform.beambin19452 -> 19468 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.xml66
-rw-r--r--erts/doc/src/match_spec.xml23
-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.tab10
-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_db_util.c6
-rw-r--r--erts/emulator/beam/erl_gc.c15
-rw-r--r--erts/emulator/beam/erl_map.c49
-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_nif.c6
-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/map_SUITE.erl43
-rw-r--r--erts/emulator/test/match_spec_SUITE.erl7
-rw-r--r--erts/emulator/test/nif_SUITE.erl17
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_SUITE.c10
-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/erl_prim_loader.beambin54476 -> 54432 bytes
-rw-r--r--erts/preloaded/ebin/erlang.beambin101656 -> 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/ebin/init.beambin51452 -> 51408 bytes
-rw-r--r--erts/preloaded/ebin/prim_file.beambin27768 -> 27724 bytes
-rw-r--r--erts/preloaded/src/erlang.erl101
-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/Makefile2
-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/beam_dead.erl20
-rw-r--r--lib/compiler/src/beam_peep.erl6
-rw-r--r--lib/compiler/src/beam_type.erl3
-rw-r--r--lib/compiler/src/cerl_trees.erl7
-rw-r--r--lib/compiler/src/compile.erl2
-rw-r--r--lib/compiler/src/erl_bifs.erl1
-rw-r--r--lib/compiler/src/v3_codegen.erl6
-rw-r--r--lib/compiler/test/map_SUITE.erl18
-rw-r--r--lib/crypto/c_src/crypto.c34
-rw-r--r--lib/crypto/c_src/otp_test_engine.c19
-rw-r--r--lib/crypto/doc/src/notes.xml22
-rw-r--r--lib/crypto/vsn.mk2
-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/edoc/src/edoc_doclet.erl2
-rw-r--r--lib/hipe/cerl/erl_bif_types.erl6
-rw-r--r--lib/hipe/main/hipe.erl4
-rw-r--r--lib/hipe/opt/hipe_schedule.erl1483
-rw-r--r--lib/hipe/opt/hipe_schedule_prio.erl53
-rw-r--r--lib/hipe/opt/hipe_target_machine.erl87
-rw-r--r--lib/hipe/opt/hipe_ultra_mod2.erl233
-rw-r--r--lib/hipe/opt/hipe_ultra_prio.erl298
-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.xml45
-rw-r--r--lib/kernel/doc/src/logger.xml409
-rw-r--r--lib/kernel/doc/src/logger_chapter.xml35
-rw-r--r--lib/kernel/doc/src/logger_filters.xml14
-rw-r--r--lib/kernel/doc/src/logger_formatter.xml290
-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/error_logger.erl6
-rw-r--r--lib/kernel/src/hipe_unified_loader.erl2
-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/src/logger.erl61
-rw-r--r--lib/kernel/src/logger_disk_log_h.erl4
-rw-r--r--lib/kernel/src/logger_formatter.erl7
-rw-r--r--lib/kernel/src/logger_internal.hrl1
-rw-r--r--lib/kernel/src/logger_server.erl10
-rw-r--r--lib/kernel/src/logger_simple.erl4
-rw-r--r--lib/kernel/src/logger_std_h.erl4
-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/logger_SUITE.erl5
-rw-r--r--lib/kernel/test/logger_disk_log_h_SUITE.erl55
-rw-r--r--lib/kernel/test/logger_formatter_SUITE.erl46
-rw-r--r--lib/kernel/test/logger_std_h_SUITE.erl163
-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/sasl/src/sasl.erl1
-rw-r--r--lib/ssh/doc/src/notes.xml50
-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.erl427
-rw-r--r--lib/ssh/src/ssh_options.erl21
-rw-r--r--lib/ssh/src/ssh_transport.erl8
-rw-r--r--lib/ssh/test/ssh_basic_SUITE.erl135
-rw-r--r--lib/ssh/test/ssh_test_lib.erl2
-rw-r--r--lib/ssh/vsn.mk3
-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/doc/src/string.xml2
-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/erl_internal.erl2
-rw-r--r--lib/stdlib/src/escript.erl2
-rw-r--r--lib/stdlib/src/gen_event.erl6
-rw-r--r--lib/stdlib/src/gen_server.erl2
-rw-r--r--lib/stdlib/src/ms_transform.erl1
-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/src/string.erl180
-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/stdlib/test/string_SUITE.erl12
-rw-r--r--lib/tools/emacs/erlang.el1
-rw-r--r--lib/tools/src/lcnt.erl5
-rw-r--r--lib/tools/src/xref.erl6
-rw-r--r--lib/tools/test/eprof_SUITE_data/eed.erl6
-rw-r--r--otp_versions.table2
-rw-r--r--system/doc/efficiency_guide/binaryhandling.xml82
-rw-r--r--system/doc/efficiency_guide/efficiency_guide.erl24
186 files changed, 4589 insertions, 5656 deletions
diff --git a/OTP_VERSION b/OTP_VERSION
index 2f45cf5f2f..2acad36e08 100644
--- a/OTP_VERSION
+++ b/OTP_VERSION
@@ -1,2 +1 @@
21.0-rc1
-
diff --git a/bootstrap/lib/compiler/ebin/beam_dead.beam b/bootstrap/lib/compiler/ebin/beam_dead.beam
index af2f76c6ee..8934cb5d11 100644
--- a/bootstrap/lib/compiler/ebin/beam_dead.beam
+++ b/bootstrap/lib/compiler/ebin/beam_dead.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_peep.beam b/bootstrap/lib/compiler/ebin/beam_peep.beam
index 67d1f808b6..1bf1e5a79f 100644
--- a/bootstrap/lib/compiler/ebin/beam_peep.beam
+++ b/bootstrap/lib/compiler/ebin/beam_peep.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_type.beam b/bootstrap/lib/compiler/ebin/beam_type.beam
index dab30b21eb..f21ede5043 100644
--- a/bootstrap/lib/compiler/ebin/beam_type.beam
+++ b/bootstrap/lib/compiler/ebin/beam_type.beam
Binary files differ
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/compiler/ebin/erl_bifs.beam b/bootstrap/lib/compiler/ebin/erl_bifs.beam
index feb60041bf..be3dc425f4 100644
--- a/bootstrap/lib/compiler/ebin/erl_bifs.beam
+++ b/bootstrap/lib/compiler/ebin/erl_bifs.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam
index 833ddf86bb..5aeca65888 100644
--- a/bootstrap/lib/compiler/ebin/v3_codegen.beam
+++ b/bootstrap/lib/compiler/ebin/v3_codegen.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/erl_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam
index 522230cf51..c635408fde 100644
--- a/bootstrap/lib/stdlib/ebin/erl_internal.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_internal.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/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam
index ace2e0c2f4..03b4b75bb6 100644
--- a/bootstrap/lib/stdlib/ebin/ms_transform.beam
+++ b/bootstrap/lib/stdlib/ebin/ms_transform.beam
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 f561413fab..cff56b9cb8 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -2432,6 +2432,26 @@ os_prompt%</pre>
</func>
<func>
+ <name name="is_map_key" arity="2"/>
+ <fsummary></fsummary>
+ <desc>
+ <p>Returns <c>true</c> if map <c><anno>Map</anno></c> contains
+ <c><anno>Key</anno></c> and returns <c>false</c> if it does not
+ contain the <c><anno>Key</anno></c>.</p>
+ <p>The call fails with a <c>{badmap,Map}</c> exception if
+ <c><anno>Map</anno></c> is not a map.</p>
+ <p><em>Example:</em></p>
+ <code type="none">
+> Map = #{"42" => value}.
+#{"42" => value}
+> is_map_key("42",Map).
+true
+> is_map_key(value,Map).
+false</code>
+ </desc>
+ </func>
+
+ <func>
<name name="is_number" arity="1"/>
<fsummary>Check whether a term is a number.</fsummary>
<desc>
@@ -6985,10 +7005,47 @@ ok
from other events in the system. It is only guaranteed that
<c><anno>Suspendee</anno></c> <em>eventually</em> suspends
(unless it
- is resumed). If option <c>asynchronous</c> has <em>not</em>
+ is resumed). If no <c>asynchronous</c> options has
been passed, the caller of <c>erlang:suspend_process/2</c> is
blocked until <c><anno>Suspendee</anno></c> has suspended.</p>
</item>
+ <tag><c>{asynchronous, ReplyTag}</c></tag>
+ <item>
+ <p>A suspend request is sent to the process identified by
+ <c><anno>Suspendee</anno></c>. When the suspend request
+ has been processed, a reply message is sent to the caller
+ of this function. The reply is on the form <c>{ReplyTag,
+ State}</c> where <c>State</c> is either:</p>
+ <taglist>
+ <tag><c>exited</c></tag>
+ <item>
+ <p>
+ <c><anno>Suspendee</anno></c> has exited.
+ </p>
+ </item>
+ <tag><c>suspended</c></tag>
+ <item>
+ <p>
+ <c><anno>Suspendee</anno></c> is now suspended.
+ </p>
+ </item>
+ <tag><c>not_suspended</c></tag>
+ <item>
+ <p>
+ <c><anno>Suspendee</anno></c> is not suspended.
+ This can only happen when the process that
+ issued this request, have called
+ <c>resume_process(<anno>Suspendee</anno>)</c>
+ before getting the reply.
+ </p>
+ </item>
+ </taglist>
+ <p>
+ Appart from the reply message, the <c>{asynchronous,
+ ReplyTag}</c> option behaves exactly the same as the
+ <c>asynchronous</c> option without reply tag.
+ </p>
+ </item>
<tag><c>unless_suspending</c></tag>
<item>
<p>The process identified by <c><anno>Suspendee</anno></c> is
@@ -7012,6 +7069,13 @@ ok
<warning>
<p>This BIF is intended for debugging only.</p>
</warning>
+ <warning>
+ <p>You can easily create deadlocks if processes suspends
+ each other (directly or in circles). In ERTS versions prior
+ to ERTS version 10.0, the runtime system prevented such
+ deadlocks, but this prevention has now been removed due
+ to performance reasons.</p>
+ </warning>
<p>Failures:</p>
<taglist>
<tag><c>badarg</c></tag>
diff --git a/erts/doc/src/match_spec.xml b/erts/doc/src/match_spec.xml
index 888366b239..46a3daebe8 100644
--- a/erts/doc/src/match_spec.xml
+++ b/erts/doc/src/match_spec.xml
@@ -86,12 +86,12 @@
<c><![CDATA[is_list]]></c> | <c><![CDATA[is_number]]></c> |
<c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> |
<c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> |
- <c><![CDATA[is_map]]></c> | <c><![CDATA[is_binary]]></c> |
- <c><![CDATA[is_function]]></c> | <c><![CDATA[is_record]]></c> |
- <c><![CDATA[is_seq_trace]]></c> | <c><![CDATA['and']]></c> |
- <c><![CDATA['or']]></c> | <c><![CDATA['not']]></c> |
- <c><![CDATA['xor']]></c> | <c><![CDATA['andalso']]></c> |
- <c><![CDATA['orelse']]></c>
+ <c><![CDATA[is_map]]></c> | <c><![CDATA[is_map_key]]></c> |
+ <c><![CDATA[is_binary]]></c> | <c><![CDATA[is_function]]></c> |
+ <c><![CDATA[is_record]]></c> | <c><![CDATA[is_seq_trace]]></c> |
+ <c><![CDATA['and']]></c> | <c><![CDATA['or']]></c> |
+ <c><![CDATA['not']]></c> | <c><![CDATA['xor']]></c> |
+ <c><![CDATA['andalso']]></c> | <c><![CDATA['orelse']]></c>
</item>
<item>ConditionExpression ::= ExprMatchVariable | { GuardFunction } |
{ GuardFunction, ConditionExpression, ... } | TermConstruct
@@ -168,11 +168,12 @@
<c><![CDATA[is_list]]></c> | <c><![CDATA[is_number]]></c> |
<c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> |
<c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> |
- <c><![CDATA[is_map]]></c> | <c><![CDATA[is_binary]]></c> |
- <c><![CDATA[is_function]]></c> | <c><![CDATA[is_record]]></c> |
- <c><![CDATA['and']]></c> | <c><![CDATA['or']]></c> |
- <c><![CDATA['not']]></c> | <c><![CDATA['xor']]></c> |
- <c><![CDATA['andalso']]></c> | <c><![CDATA['orelse']]></c>
+ <c><![CDATA[is_map]]></c> | <c><![CDATA[map_is_key]]></c> |
+ <c><![CDATA[is_binary]]></c> | <c><![CDATA[is_function]]></c> |
+ <c><![CDATA[is_record]]></c> | <c><![CDATA['and']]></c> |
+ <c><![CDATA['or']]></c> | <c><![CDATA['not']]></c> |
+ <c><![CDATA['xor']]></c> | <c><![CDATA['andalso']]></c> |
+ <c><![CDATA['orelse']]></c>
</item>
<item>ConditionExpression ::= ExprMatchVariable | { GuardFunction } |
{ GuardFunction, ConditionExpression, ... } | TermConstruct
diff --git a/erts/doc/src/part.xml b/erts/doc/src/part.xml
index d583b873a0..fc39cb30e6 100644
--- a/erts/doc/src/part.xml
+++ b/erts/doc/src/part.xml
@@ -37,6 +37,7 @@
<xi:include href="match_spec.xml"/>
<xi:include href="crash_dump.xml"/>
<xi:include href="alt_dist.xml"/>
+ <xi:include href="alt_disco.xml"/>
<xi:include href="absform.xml"/>
<xi:include href="tty.xml"/>
<xi:include href="driver.xml"/>
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 5dfa60ee74..221cf84622 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -570,7 +570,7 @@ $(TTF_DIR)/OPCODES-GENERATED: $(OPCODE_TABLES) utils/beam_makeops
-code-model @CODE_MODEL@ \
-outdir $(TTF_DIR) \
-DUSE_VM_PROBES=$(if $(USE_VM_PROBES),1,0) \
- -DNO_FPE_SIGNALS=$(if $filter(unreliable,$(FPE)),1,0) \
+ -DNO_FPE_SIGNALS=$(if $(filter unreliable,$(FPE)),1,0) \
-emulator $(OPCODE_TABLES) && echo $? >$(TTF_DIR)/OPCODES-GENERATED
GENERATE += $(TTF_DIR)/OPCODES-GENERATED
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index fba0611042..45b7540aeb 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -142,6 +142,7 @@ atom bsr
atom bsr_anycrlf
atom bsr_unicode
atom build_type
+atom busy
atom busy_dist_port
atom busy_port
atom call
@@ -252,6 +253,7 @@ atom exception_from
atom exception_trace
atom exclusive
atom exit_status
+atom exited
atom existing
atom existing_processes
atom existing_ports
@@ -445,6 +447,7 @@ atom no_float
atom no_integer
atom no_network
atom no_start_optimize
+atom not_suspended
atom not
atom not_a_list
atom not_loaded
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index d9312f4df8..a0dbd9ec7b 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -603,8 +603,9 @@ badarg:
BIF_RETTYPE erts_internal_check_dirty_process_code_2(BIF_ALIST_2)
{
+ erts_aint32_t state;
Process *rp;
- int reds = 0;
+ int dirty, busy, reds = 0;
Eterm res;
if (BIF_P != erts_dirty_process_signal_handler
@@ -618,20 +619,29 @@ BIF_RETTYPE erts_internal_check_dirty_process_code_2(BIF_ALIST_2)
if (is_not_atom(BIF_ARG_2))
BIF_ERROR(BIF_P, BADARG);
- rp = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN,
- BIF_ARG_1, ERTS_PROC_LOCK_MAIN);
- if (rp == ERTS_PROC_LOCK_BUSY)
- ERTS_BIF_YIELD2(bif_export[BIF_erts_internal_check_dirty_process_code_2],
- BIF_P, BIF_ARG_1, BIF_ARG_2);
+ if (BIF_ARG_1 == BIF_P->common.id)
+ BIF_RET(am_normal);
+
+ rp = erts_proc_lookup_raw(BIF_ARG_1);
if (!rp)
- BIF_RET(am_false);
-
+ BIF_RET(am_false);
+
+ state = erts_atomic32_read_nob(&rp->state);
+ dirty = (state & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS));
+ if (!dirty)
+ BIF_RET(am_normal);
+
+ busy = erts_proc_trylock(rp, ERTS_PROC_LOCK_MAIN) == EBUSY;
+
+ if (busy)
+ BIF_RET(am_busy);
+
res = erts_check_process_code(rp, BIF_ARG_2, &reds, BIF_P->fcalls);
- if (BIF_P != rp)
- erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
+ erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
- ASSERT(is_value(res));
+ ASSERT(res == am_true || res == am_false);
BIF_RET2(res, reds);
}
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index ee287243a4..ab5920a67e 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -1166,6 +1166,9 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp)
reds_used = treds > INT_MAX ? INT_MAX : (int) treds;
}
+ if (c_p && ERTS_PROC_GET_PENDING_SUSPEND(c_p))
+ erts_proc_sig_handle_pending_suspend(c_p);
+
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 79244b8544..97e1ee1286 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -1364,13 +1364,14 @@ BIF_RETTYPE exit_signal_2(BIF_ALIST_2)
/* Handle flags common to both process_flag_2 and process_flag_3. */
-static BIF_RETTYPE process_flag_aux(Process *BIF_P,
- Process *rp,
- Eterm flag,
- Eterm val)
+static Eterm process_flag_aux(Process *c_p, int *redsp, Eterm flag, Eterm val)
{
Eterm old_value = NIL; /* shut up warning about use before set */
Sint i;
+
+ if (redsp)
+ *redsp = 1;
+
if (flag == am_save_calls) {
struct saved_calls *scb;
if (!is_small(val))
@@ -1390,30 +1391,89 @@ static BIF_RETTYPE process_flag_aux(Process *BIF_P,
}
#ifdef HIPE
- if (rp->flags & F_HIPE_MODE) {
- ASSERT(!ERTS_PROC_GET_SAVED_CALLS_BUF(rp));
- scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(rp, scb);
+ if (c_p->flags & F_HIPE_MODE) {
+ ASSERT(!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p));
+ scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(c_p, scb);
}
else
#endif
{
#ifdef HIPE
- ASSERT(!ERTS_PROC_GET_SUSPENDED_SAVED_CALLS_BUF(rp));
+ ASSERT(!ERTS_PROC_GET_SUSPENDED_SAVED_CALLS_BUF(c_p));
#endif
- scb = ERTS_PROC_SET_SAVED_CALLS_BUF(rp, scb);
- if (rp == BIF_P && ((scb && i == 0) || (!scb && i != 0))) {
- /* Adjust fcalls to match save calls setting... */
- if (i == 0)
- BIF_P->fcalls += CONTEXT_REDS; /* disabled it */
- else
- BIF_P->fcalls -= CONTEXT_REDS; /* enabled it */
-
- /*
- * Make sure we reschedule immediately so the
- * change take effect at once.
- */
- ERTS_VBUMP_ALL_REDS(BIF_P);
- }
+ scb = ERTS_PROC_SET_SAVED_CALLS_BUF(c_p, scb);
+
+ if (((scb && i == 0) || (!scb && i != 0))) {
+
+ /*
+ * Make sure we reschedule immediately so the
+ * change take effect at once.
+ */
+ if (!redsp) {
+ /* Executed via BIF call.. */
+ via_bif:
+
+ /* Adjust fcalls to match save calls setting... */
+ if (i == 0)
+ c_p->fcalls += CONTEXT_REDS; /* disabled it */
+ else
+ c_p->fcalls -= CONTEXT_REDS; /* enabled it */
+
+ ERTS_VBUMP_ALL_REDS(c_p);
+ }
+ else {
+ erts_aint32_t state;
+ /*
+ * Executed via signal handler. Try to figure
+ * out in what context we are executing...
+ */
+
+ state = erts_atomic32_read_nob(&c_p->state);
+ if (state & (ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING)) {
+ /*
+ * We are either processing signals before
+ * being executed or executing dirty. That
+ * is, no need to adjust anything...
+ */
+ *redsp = 1;
+ }
+ else {
+ ErtsSchedulerData *esdp;
+ ASSERT(state & ERTS_PSFLG_RUNNING);
+
+ /*
+ * F_DELAY_GC is currently only set when
+ * we handle signals in state running via
+ * receive helper...
+ */
+
+ if (!(c_p->flags & F_DELAY_GC)) {
+ *redsp = 1;
+ goto via_bif;
+ }
+
+ /*
+ * Executing via receive helper...
+ *
+ * We utilize the virtual reds counter
+ * in order to get correct calculation
+ * of reductions consumed when scheduling
+ * out the process...
+ */
+
+ esdp = erts_get_scheduler_data();
+
+ if (i == 0)
+ esdp->virtual_reds += CONTEXT_REDS; /* disabled it */
+ else
+ esdp->virtual_reds -= CONTEXT_REDS; /* enabled it */
+
+ *redsp = -1;
+ }
+ }
+ }
}
if (!scb)
@@ -1423,11 +1483,12 @@ static BIF_RETTYPE process_flag_aux(Process *BIF_P,
erts_free(ERTS_ALC_T_CALLS_BUF, (void *) scb);
}
- BIF_RET(old_value);
+ ASSERT(is_immed(old_value));
+ return old_value;
}
error:
- BIF_ERROR(BIF_P, BADARG);
+ return am_badarg;
}
BIF_RETTYPE process_flag_2(BIF_ALIST_2)
@@ -1596,29 +1657,73 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2)
/* Fall through and try process_flag_aux() ... */
}
- BIF_RET(process_flag_aux(BIF_P, BIF_P, BIF_ARG_1, BIF_ARG_2));
+ old_value = process_flag_aux(BIF_P, NULL, BIF_ARG_1, BIF_ARG_2);
+ if (old_value != am_badarg)
+ BIF_RET(old_value);
error:
BIF_ERROR(BIF_P, BADARG);
}
-BIF_RETTYPE process_flag_3(BIF_ALIST_3)
+typedef struct {
+ Eterm flag;
+ Eterm value;
+ ErlOffHeap oh;
+ Eterm heap[1];
+} ErtsProcessFlag3Args;
+
+static Eterm
+exec_process_flag_3(Process *c_p, void *arg, int *redsp, ErlHeapFragment **bpp)
{
- Process *rp;
- Eterm res;
+ ErtsProcessFlag3Args *pf3a = arg;
+ Eterm res;
+
+ if (ERTS_PROC_IS_EXITING(c_p))
+ res = am_badarg;
+ else
+ res = process_flag_aux(c_p, redsp, pf3a->flag, pf3a->value);
+ erts_cleanup_offheap(&pf3a->oh);
+ erts_free(ERTS_ALC_T_PF3_ARGS, arg);
+ return res;
+}
+
+
+BIF_RETTYPE erts_internal_process_flag_3(BIF_ALIST_3)
+{
+ Eterm res, *hp;
+ ErlOffHeap *ohp;
+ ErtsProcessFlag3Args *pf3a;
+ Uint flag_sz, value_sz;
+
+ if (BIF_P->common.id == BIF_ARG_1) {
+ res = process_flag_aux(BIF_P, NULL, BIF_ARG_2, BIF_ARG_3);
+ BIF_RET(res);
+ }
+
+ if (is_not_internal_pid(BIF_ARG_1))
+ BIF_RET(am_badarg);
+
+ flag_sz = is_immed(BIF_ARG_2) ? 0 : size_object(BIF_ARG_2);
+ value_sz = is_immed(BIF_ARG_3) ? 0 : size_object(BIF_ARG_3);
+
+ pf3a = erts_alloc(ERTS_ALC_T_PF3_ARGS,
+ sizeof(ErtsProcessFlag3Args)
+ + sizeof(Eterm)*(flag_sz+value_sz-1));
+
+ ohp = &pf3a->oh;
+ ERTS_INIT_OFF_HEAP(&pf3a->oh);
- rp = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN,
- BIF_ARG_1, ERTS_PROC_LOCK_MAIN);
- if (rp == ERTS_PROC_LOCK_BUSY)
- ERTS_BIF_YIELD3(bif_export[BIF_process_flag_3], BIF_P,
- BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+ hp = &pf3a->heap[0];
- if (!rp)
- BIF_ERROR(BIF_P, BADARG);
+ pf3a->flag = copy_struct(BIF_ARG_2, flag_sz, &hp, ohp);
+ pf3a->value = copy_struct(BIF_ARG_3, value_sz, &hp, ohp);
- res = process_flag_aux(BIF_P, rp, BIF_ARG_2, BIF_ARG_3);
+ res = erts_proc_sig_send_rpc_request(BIF_P, BIF_ARG_1,
+ !0,
+ exec_process_flag_3,
+ (void *) pf3a);
- if (rp != BIF_P)
- erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
+ if (is_non_value(res))
+ BIF_RET(am_badarg);
return res;
}
diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h
index a47339253e..cf9f61c0b8 100644
--- a/erts/emulator/beam/bif.h
+++ b/erts/emulator/beam/bif.h
@@ -295,6 +295,19 @@ do { \
(Ret) = THE_NON_VALUE; \
} while (0)
+#define ERTS_BIF_PREP_TRAP4(Ret, Trap, Proc, A0, A1, A2, A3) \
+do { \
+ Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \
+ (Proc)->arity = 4; \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ reg[2] = (Eterm) (A2); \
+ reg[3] = (Eterm) (A3); \
+ (Proc)->i = (BeamInstr*) ((Trap)->addressv[erts_active_code_ix()]); \
+ (Proc)->freason = TRAP; \
+ (Ret) = THE_NON_VALUE; \
+} while (0)
+
#define ERTS_BIF_PREP_TRAP3_NO_RET(Trap, Proc, A0, A1, A2)\
do { \
Eterm* reg = erts_proc_sched_data((Proc))->x_reg_array; \
@@ -343,6 +356,18 @@ do { \
return THE_NON_VALUE; \
} while(0)
+#define BIF_TRAP4(Trap_, p, A0, A1, A2, A3) do { \
+ Eterm* reg = erts_proc_sched_data((p))->x_reg_array; \
+ (p)->arity = 4; \
+ reg[0] = (A0); \
+ reg[1] = (A1); \
+ reg[2] = (A2); \
+ reg[3] = (A3); \
+ (p)->i = (BeamInstr*) ((Trap_)->addressv[erts_active_code_ix()]); \
+ (p)->freason = TRAP; \
+ return THE_NON_VALUE; \
+ } while(0)
+
#define BIF_TRAP_CODE_PTR_0(p, Code_) do { \
(p)->arity = 0; \
(p)->i = (BeamInstr*) (Code_); \
@@ -401,6 +426,12 @@ do { \
ERTS_BIF_PREP_TRAP3(RET, (TRP), (P), (A0), (A1), (A2)); \
} while (0)
+#define ERTS_BIF_PREP_YIELD4(RET, TRP, P, A0, A1, A2, A3) \
+do { \
+ ERTS_VBUMP_ALL_REDS((P)); \
+ ERTS_BIF_PREP_TRAP4(RET, (TRP), (P), (A0), (A1), (A2), (A3)); \
+} while (0)
+
#define ERTS_BIF_YIELD0(TRP, P) \
do { \
ERTS_VBUMP_ALL_REDS((P)); \
@@ -425,6 +456,12 @@ do { \
BIF_TRAP3((TRP), (P), (A0), (A1), (A2)); \
} while (0)
+#define ERTS_BIF_YIELD4(TRP, P, A0, A1, A2, A3) \
+do { \
+ ERTS_VBUMP_ALL_REDS((P)); \
+ BIF_TRAP4((TRP), (P), (A0), (A1), (A2), (A3)); \
+} while (0)
+
#define ERTS_BIF_PREP_EXITED(RET, PROC) \
do { \
KILL_CATCHES((PROC)); \
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 276bef2bbb..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
@@ -696,3 +697,4 @@ bif ets:whereis/1
bif erts_internal:gather_alloc_histograms/1
bif erts_internal:gather_carrier_info/1
ubif erlang:map_get/2
+ubif erlang:is_map_key/2
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_db_util.c b/erts/emulator/beam/erl_db_util.c
index 6354abfd1f..ef22cda1f0 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -644,6 +644,12 @@ static DMCGuardBif guard_tab[] =
DBIF_ALL
},
{
+ am_is_map_key,
+ &is_map_key_2,
+ 2,
+ DBIF_ALL
+ },
+ {
am_bit_size,
&bit_size_1,
1,
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 0692cea0ee..a65dbbf42b 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -413,21 +413,20 @@ erts_gc_after_bif_call_lhf(Process* p, ErlHeapFragment *live_hf_end,
{
int cost;
- if (p->flags & F_HIBERNATE_SCHED) {
+ if (p->flags & (F_HIBERNATE_SCHED|F_HIPE_RECV_LOCKED)) {
/*
* We just hibernated. We do *not* want to mess
* up the hibernation by an ordinary GC...
+ *
+ * OR
+ *
+ * We left a receive in HiPE with message
+ * queue lock locked, and we do not want to
+ * do a GC with message queue locked...
*/
return result;
}
-#ifdef HIPE
- if (p->hipe_smp.have_receive_locks) {
- /* Do not want to GC with message queue locked... */
- return result;
- }
-#endif
-
if (!p->mbuf) {
/* Must have GC:d in BIF call... invalidate live_hf_end */
live_hf_end = ERTS_INVALID_HFRAG_PTR;
diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c
index f577b017c3..48154b5d0f 100644
--- a/erts/emulator/beam/erl_map.c
+++ b/erts/emulator/beam/erl_map.c
@@ -43,6 +43,7 @@
*
* DONE:
* - erlang:is_map/1
+ * - erlang:is_map_key/2
* - erlang:map_size/1
* - erlang:map_get/2
*
@@ -919,7 +920,7 @@ static int hxnodecmp(hxnode_t *a, hxnode_t *b) {
return -1;
}
-/* maps:is_key/2 */
+/* maps:is_key/2 and erlang:is_map_key/2 */
BIF_RETTYPE maps_is_key_2(BIF_ALIST_2) {
if (is_map(BIF_ARG_2)) {
@@ -929,6 +930,10 @@ BIF_RETTYPE maps_is_key_2(BIF_ALIST_2) {
BIF_ERROR(BIF_P, BADMAP);
}
+BIF_RETTYPE is_map_key_2(BIF_ALIST_2) {
+ BIF_RET(maps_is_key_2(BIF_CALL_ARGS));
+}
+
/* maps:keys/1 */
BIF_RETTYPE maps_keys_1(BIF_ALIST_1) {
@@ -3053,7 +3058,7 @@ BIF_RETTYPE erts_internal_map_next_3(BIF_ALIST_3) {
Uint path_length = 0;
Uint *path_rest = NULL;
int i, elems, orig_elems;
- Eterm node = map, res, *path_ptr = NULL, *hp;
+ Eterm node = map, res, *patch_ptr = NULL, *hp;
/* A stack WSTACK is used when traversing the hashmap.
* It contains: node, idx, sz, ptr
@@ -3112,15 +3117,22 @@ BIF_RETTYPE erts_internal_map_next_3(BIF_ALIST_3) {
}
if (type == iterator) {
- /* iterator uses the format {K, V, {K, V, {K, V, [Path | Map]}}},
- * so each element is 4 words large */
+ /*
+ * Iterator uses the format {K1, V1, {K2, V2, {K3, V3, [Path | Map]}}},
+ * so each element is 4 words large.
+ * To make iteration order independent of input reductions
+ * the KV-pairs are here built in DESTRUCTIVE non-reverse order.
+ */
hp = HAlloc(BIF_P, 4 * elems);
- res = am_none;
} else {
- /* list used the format [Path, Map, {K,V}, {K,V} | BIF_ARG_3],
- * so each element is 2+3 words large */
+ /*
+ * List used the format [Path, Map, {K3,V3}, {K2,V2}, {K1,V1} | BIF_ARG_3],
+ * so each element is 2+3 words large.
+ * To make list order independent of input reductions
+ * the KV-pairs are here built in FUNCTIONAL reverse order
+ * as this is how the list as a whole is constructed.
+ */
hp = HAlloc(BIF_P, (2 + 3) * elems);
- res = BIF_ARG_3;
}
orig_elems = elems;
@@ -3144,12 +3156,15 @@ BIF_RETTYPE erts_internal_map_next_3(BIF_ALIST_3) {
if (is_list(ptr[PATH_ELEM(curr_path)])) {
Eterm *lst = list_val(ptr[PATH_ELEM(curr_path)]);
if (type == iterator) {
- res = TUPLE3(hp, CAR(lst), CDR(lst), res); hp += 4;
- /* Note where we should patch the Iterator is needed */
- path_ptr = hp-1;
+ res = make_tuple(hp);
+ hp[0] = make_arityval(3);
+ hp[1] = CAR(lst);
+ hp[2] = CDR(lst);
+ patch_ptr = &hp[3];
+ hp += 4;
} else {
Eterm tup = TUPLE2(hp, CAR(lst), CDR(lst)); hp += 3;
- res = CONS(hp, tup, res); hp += 2;
+ res = CONS(hp, tup, BIF_ARG_3); hp += 2;
}
elems--;
break;
@@ -3183,7 +3198,12 @@ BIF_RETTYPE erts_internal_map_next_3(BIF_ALIST_3) {
while (idx < sz && elems != 0 && is_list(ptr[idx])) {
Eterm *lst = list_val(ptr[idx]);
if (type == iterator) {
- res = TUPLE3(hp, CAR(lst), CDR(lst), res); hp += 4;
+ *patch_ptr = make_tuple(hp);
+ hp[0] = make_arityval(3);
+ hp[1] = CAR(lst);
+ hp[2] = CDR(lst);
+ patch_ptr = &hp[3];
+ hp += 4;
} else {
Eterm tup = TUPLE2(hp, CAR(lst), CDR(lst)); hp += 3;
res = CONS(hp, tup, res); hp += 2;
@@ -3281,7 +3301,7 @@ BIF_RETTYPE erts_internal_map_next_3(BIF_ALIST_3) {
if (type == iterator) {
hp = HAlloc(BIF_P, 2);
- *path_ptr = CONS(hp, path, map); hp += 2;
+ *patch_ptr = CONS(hp, path, map); hp += 2;
} else {
hp = HAlloc(BIF_P, 4);
res = CONS(hp, map, res); hp += 2;
@@ -3289,6 +3309,7 @@ BIF_RETTYPE erts_internal_map_next_3(BIF_ALIST_3) {
}
} else {
if (type == iterator) {
+ *patch_ptr = am_none;
HRelease(BIF_P, hp + 4 * elems, hp);
} else {
HRelease(BIF_P, hp + (2+3) * elems, hp);
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index bea7a0fe86..507cc989d2 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -379,7 +379,10 @@ queue_messages(Process* receiver,
erts_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ);
}
- erts_proc_notify_new_message(receiver, receiver_locks);
+ if (last == &first->next)
+ erts_proc_notify_new_message(receiver, receiver_locks);
+ else
+ erts_proc_notify_new_sig(receiver, state, ERTS_PSFLG_ACTIVE);
}
static ERTS_INLINE
diff --git a/erts/emulator/beam/erl_monitor_link.c b/erts/emulator/beam/erl_monitor_link.c
index 70f36fb6b7..48d9bd4ca5 100644
--- a/erts/emulator/beam/erl_monitor_link.c
+++ b/erts/emulator/beam/erl_monitor_link.c
@@ -630,7 +630,9 @@ erts_monitor_tree_lookup_create(ErtsMonitor **root, int *created, Uint16 type,
ErtsMonitor *res;
ErtsMonitorCreateCtxt cctxt = {type, origin};
- ERTS_ML_ASSERT(type == ERTS_MON_TYPE_NODE || type == ERTS_MON_TYPE_NODES);
+ ERTS_ML_ASSERT(type == ERTS_MON_TYPE_NODE
+ || type == ERTS_MON_TYPE_NODES
+ || type == ERTS_MON_TYPE_SUSPEND);
res = (ErtsMonitor *) ml_rbt_lookup_create((ErtsMonLnkNode **) root,
target, create_monitor,
@@ -760,11 +762,13 @@ erts_monitor_create(Uint16 type, Eterm ref, Eterm orgn, Eterm trgt, Eterm name)
switch (type) {
case ERTS_MON_TYPE_PROC:
case ERTS_MON_TYPE_PORT:
- case ERTS_MON_TYPE_TIME_OFFSET:
if (is_nil(name)) {
ErtsMonitorDataHeap *mdhp;
ErtsORefThing *ortp;
+ case ERTS_MON_TYPE_TIME_OFFSET:
+
+ ERTS_ML_ASSERT(is_nil(name));
ERTS_ML_ASSERT(is_immed(orgn) && is_immed(trgt));
ERTS_ML_ASSERT(is_internal_ordinary_ref(ref));
@@ -860,10 +864,38 @@ erts_monitor_create(Uint16 type, Eterm ref, Eterm orgn, Eterm trgt, Eterm name)
mdep->dist = NULL;
break;
}
- case ERTS_MON_TYPE_SUSPEND:
- ERTS_INTERNAL_ERROR("Use erts_monitor_suspend_create() instead...");
- mdp = NULL;
+ case ERTS_MON_TYPE_SUSPEND: {
+ ErtsMonitorSuspend *msp;
+
+ ERTS_ML_ASSERT(is_nil(name));
+ ERTS_ML_ASSERT(is_nil(ref));
+ ERTS_ML_ASSERT(is_internal_pid(orgn) && is_internal_pid(trgt));
+
+ msp = erts_alloc(ERTS_ALC_T_MONITOR_SUSPEND,
+ sizeof(ErtsMonitorSuspend));
+ mdp = &msp->md;
+ ERTS_ML_ASSERT(((void *) mdp) == ((void *) msp));
+
+ mdp->ref = NIL;
+
+ mdp->origin.other.item = trgt;
+ mdp->origin.offset = (Uint16) offsetof(ErtsMonitorData, origin);
+ mdp->origin.key_offset = (Uint16) offsetof(ErtsMonitor, other.item);
+ ERTS_ML_ASSERT(mdp->origin.key_offset >= mdp->origin.offset);
+ mdp->origin.flags = (Uint16) ERTS_ML_FLG_EXTENDED;
+ mdp->origin.type = type;
+
+ mdp->target.other.item = orgn;
+ mdp->target.offset = (Uint16) offsetof(ErtsMonitorData, target);
+ mdp->target.key_offset = (Uint16) offsetof(ErtsMonitor, other.item);
+ mdp->target.flags = ERTS_ML_FLG_TARGET|ERTS_ML_FLG_EXTENDED;
+ mdp->target.type = type;
+
+ msp->next = NULL;
+ erts_atomic_init_relb(&msp->state, 0);
+
break;
+ }
default:
ERTS_INTERNAL_ERROR("Invalid monitor type");
mdp = NULL;
@@ -887,10 +919,11 @@ erts_monitor_destroy__(ErtsMonitorData *mdp)
ERTS_ML_ASSERT(!(mdp->target.flags & ERTS_ML_FLG_IN_TABLE));
ERTS_ML_ASSERT((mdp->origin.flags & ERTS_ML_FLGS_SAME)
== (mdp->target.flags & ERTS_ML_FLGS_SAME));
- ERTS_ML_ASSERT(mdp->origin.type != ERTS_MON_TYPE_SUSPEND);
if (!(mdp->origin.flags & ERTS_ML_FLG_EXTENDED))
erts_free(ERTS_ALC_T_MONITOR, mdp);
+ else if (mdp->origin.type == ERTS_MON_TYPE_SUSPEND)
+ erts_free(ERTS_ALC_T_MONITOR_SUSPEND, mdp);
else {
ErtsMonitorDataExtended *mdep = (ErtsMonitorDataExtended *) mdp;
ErlOffHeap oh;
@@ -927,10 +960,10 @@ erts_monitor_size(ErtsMonitor *mon)
Uint size, refc;
ErtsMonitorData *mdp = erts_monitor_to_data(mon);
- ERTS_ML_ASSERT(mon->type != ERTS_MON_TYPE_SUSPEND);
-
if (!(mon->flags & ERTS_ML_FLG_EXTENDED))
size = sizeof(ErtsMonitorDataHeap);
+ else if (mon->type == ERTS_MON_TYPE_SUSPEND)
+ size = sizeof(ErtsMonitorSuspend);
else {
ErtsMonitorDataExtended *mdep;
Uint hsz = 0;
@@ -957,54 +990,6 @@ erts_monitor_size(ErtsMonitor *mon)
return size / refc;
}
-
-/* suspend monitors... */
-
-ErtsMonitorSuspend *
-erts_monitor_suspend_create(Eterm pid)
-{
- ErtsMonitorSuspend *msp;
-
- ERTS_ML_ASSERT(is_internal_pid(pid));
-
- msp = erts_alloc(ERTS_ALC_T_SUSPEND_MON,
- sizeof(ErtsMonitorSuspend));
- msp->mon.offset = (Uint16) offsetof(ErtsMonitorSuspend, mon);
- msp->mon.key_offset = (Uint16) offsetof(ErtsMonitor, other.item);
- msp->mon.other.item = pid;
- msp->mon.flags = 0;
- msp->mon.type = ERTS_MON_TYPE_SUSPEND;
- msp->pending = 0;
- msp->active = 0;
- return msp;
-}
-
-static ErtsMonLnkNode *
-create_monitor_suspend(Eterm pid, void *unused)
-{
- ErtsMonitorSuspend *msp = erts_monitor_suspend_create(pid);
- return (ErtsMonLnkNode *) &msp->mon;
-}
-
-ErtsMonitorSuspend *
-erts_monitor_suspend_tree_lookup_create(ErtsMonitor **root, int *created,
- Eterm pid)
-{
- ErtsMonitor *mon;
- mon = (ErtsMonitor *) ml_rbt_lookup_create((ErtsMonLnkNode **) root,
- pid, create_monitor_suspend,
- NULL,
- created);
- return erts_monitor_suspend(mon);
-}
-
-void
-erts_monitor_suspend_destroy(ErtsMonitorSuspend *msp)
-{
- ERTS_ML_ASSERT(!(msp->mon.flags & ERTS_ML_FLG_IN_TABLE));
- erts_free(ERTS_ALC_T_SUSPEND_MON, msp);
-}
-
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
* Link Operations *
* *
diff --git a/erts/emulator/beam/erl_monitor_link.h b/erts/emulator/beam/erl_monitor_link.h
index 603aead8cc..9ff8aa509a 100644
--- a/erts/emulator/beam/erl_monitor_link.h
+++ b/erts/emulator/beam/erl_monitor_link.h
@@ -246,15 +246,28 @@
*
* --- ERTS_MON_TYPE_SUSPEND -------------------------------------
*
- * Suspend monitor.
+ * Suspend monitor. A local process (origin) suspends another
+ * local process (target).
*
- * Other Item: Suspendee process identifier
- * Key: Suspendee process identifier
- *
- * Valid keys are only ordinary internal references.
+ * Origin:
+ * Other Item: Process identifier of suspendee
+ * (target)
+ * Key: Process identifier of suspendee
+ * (target)
+ * Target:
+ * Other Item: Process identifier of suspender
+ * (origin)
+ * Key: Process identifier of suspender
+ * (origin)
+ * Shared:
+ * Next: Pointer to another suspend monitor
+ * State: Number of suspends and a flag
+ * indicating if the suspend is
+ * active or not.
*
- * This type of monitor is a bit strange and the whole process
- * suspend functionality should be improved...
+ * Origin part of the monitor is stored in the monitor tree of
+ * origin process and target part of the monitor is stored in
+ * monitor list for local targets on the target process.
*
*
*
@@ -638,11 +651,15 @@ struct ErtsMonitorDataExtended__ {
Eterm heap[1]; /* heap start... */
};
-typedef struct {
- ErtsMonitor mon;
- int pending;
- int active;
-} ErtsMonitorSuspend;
+typedef struct ErtsMonitorSuspend__ ErtsMonitorSuspend;
+
+struct ErtsMonitorSuspend__ {
+ ErtsMonitorData md; /* origin = suspender; target = suspendee */
+ ErtsMonitorSuspend *next;
+ erts_atomic_t state;
+};
+#define ERTS_MSUSPEND_STATE_FLG_ACTIVE ((erts_aint_t) (((Uint) 1) << (sizeof(Uint)*8 - 1)))
+#define ERTS_MSUSPEND_STATE_COUNTER_MASK (~ERTS_MSUSPEND_STATE_FLG_ACTIVE)
/*
* --- Monitor tree operations ---
@@ -1094,24 +1111,25 @@ int erts_monitor_list_foreach_delete_yielding(ErtsMonitor **list,
*
* @brief Create a monitor
*
- * Can create all types of monitors exept for suspend monitors
+ * Can create all types of monitors
*
* When the funcion is called it is assumed that:
* - 'ref' is an internal ordinary reference if type is ERTS_MON_TYPE_PROC,
* ERTS_MON_TYPE_PORT, ERTS_MON_TYPE_TIME_OFFSET, or ERTS_MON_TYPE_RESOURCE
- * - 'ref' is NIL if type is ERTS_MON_TYPE_NODE or ERTS_MON_TYPE_NODES
+ * - 'ref' is NIL if type is ERTS_MON_TYPE_NODE, ERTS_MON_TYPE_NODES, or
+ * ERTS_MON_TYPE_SUSPEND
* - 'ref' is and ordinary internal reference or an external reference if
* type is ERTS_MON_TYPE_DIST_PROC
* - 'name' is an atom or NIL if type is ERTS_MON_TYPE_PROC,
* ERTS_MON_TYPE_PORT, or ERTS_MON_TYPE_DIST_PROC
* - 'name is NIL if type is ERTS_MON_TYPE_TIME_OFFSET, ERTS_MON_TYPE_RESOURCE,
- * ERTS_MON_TYPE_NODE, or ERTS_MON_TYPE_NODES
+ * ERTS_MON_TYPE_NODE, ERTS_MON_TYPE_NODES, or ERTS_MON_TYPE_SUSPEND
* If the above is not true, bad things will happen.
*
* @param[in] type ERTS_MON_TYPE_PROC, ERTS_MON_TYPE_PORT,
* ERTS_MON_TYPE_TIME_OFFSET, ERTS_MON_TYPE_DIST_PROC,
* ERTS_MON_TYPE_RESOURCE, ERTS_MON_TYPE_NODE,
- * or ERTS_MON_TYPE_NODES
+ * ERTS_MON_TYPE_NODES, or ERTS_MON_TYPE_SUSPEND
*
* @param[in] ref A reference or NIL depending on type
*
@@ -1119,6 +1137,10 @@ int erts_monitor_list_foreach_delete_yielding(ErtsMonitor **list,
*
* @param[in] target The key of the target
*
+ * @param[in] name An atom (the name) or NIL depending on type
+ *
+ * @returns A pointer to monitor data structure
+ *
*/
ErtsMonitorData *erts_monitor_create(Uint16 type, Eterm ref, Eterm origin,
Eterm target, Eterm name);
@@ -1347,7 +1369,8 @@ erts_monitor_to_data(ErtsMonitor *mon)
ERTS_ML_ASSERT(erts_monitor_origin_offset == (size_t) mdp->origin.offset);
ERTS_ML_ASSERT(!!(mdp->target.flags & ERTS_ML_FLG_TARGET));
ERTS_ML_ASSERT(erts_monitor_target_offset == (size_t) mdp->target.offset);
- if (mon->type == ERTS_MON_TYPE_NODE || mon->type == ERTS_MON_TYPE_NODES) {
+ if (mon->type == ERTS_MON_TYPE_NODE || mon->type == ERTS_MON_TYPE_NODES
+ || mon->type == ERTS_MON_TYPE_SUSPEND) {
ERTS_ML_ASSERT(erts_monitor_node_key_offset == (size_t) mdp->origin.key_offset);
ERTS_ML_ASSERT(erts_monitor_node_key_offset == (size_t) mdp->target.key_offset);
}
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index e208792868..0fbf0eb03a 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -1255,8 +1255,10 @@ size_t enif_binary_to_term(ErlNifEnv *dst_env,
if (is_non_value(*term)) {
return 0;
}
- erts_factory_close(&factory);
- cache_env(dst_env);
+ if (size > 0) {
+ erts_factory_close(&factory);
+ cache_env(dst_env);
+ }
ASSERT(bp > data);
return bp - data;
diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c
index 5165cd22a5..e9b41ad298 100644
--- a/erts/emulator/beam/erl_proc_sig_queue.c
+++ b/erts/emulator/beam/erl_proc_sig_queue.c
@@ -39,6 +39,7 @@
#include "big.h"
#include "erl_gc.h"
#include "bif.h"
+#include "erl_bif_unique.h"
#include "erl_proc_sig_queue.h"
#include "dtrace-wrapper.h"
@@ -49,7 +50,7 @@
* Note that not all signal are handled using this functionality!
*/
-#define ERTS_SIG_Q_OP_MAX 11
+#define ERTS_SIG_Q_OP_MAX 13
#define ERTS_SIG_Q_OP_EXIT 0
#define ERTS_SIG_Q_OP_EXIT_LINKED 1
@@ -62,7 +63,9 @@
#define ERTS_SIG_Q_OP_TRACE_CHANGE_STATE 8
#define ERTS_SIG_Q_OP_PERSISTENT_MON_MSG 9
#define ERTS_SIG_Q_OP_IS_ALIVE 10
-#define ERTS_SIG_Q_OP_PROCESS_INFO ERTS_SIG_Q_OP_MAX
+#define ERTS_SIG_Q_OP_PROCESS_INFO 11
+#define ERTS_SIG_Q_OP_SYNC_SUSPEND 12
+#define ERTS_SIG_Q_OP_RPC ERTS_SIG_Q_OP_MAX
#define ERTS_SIG_Q_TYPE_MAX (ERTS_MON_LNK_TYPE_MAX + 5)
@@ -154,6 +157,17 @@ typedef struct {
} ErtsIsAliveRequest;
typedef struct {
+ Eterm message;
+ Eterm requester;
+ int async;
+} ErtsSyncSuspendRequest;
+
+typedef struct {
+ ErtsMonitorSuspend *mon;
+ ErtsMessage *sync;
+} ErtsProcSigPendingSuspend;
+
+typedef struct {
ErtsSignalCommon common;
Sint refc;
Sint delayed_len;
@@ -176,6 +190,15 @@ typedef struct {
#define ERTS_PROC_SIG_PI_MSGQ_LEN_IGNORE ((Sint) -1)
#define ERTS_PROC_SIG_PI_MSGQ_LEN_SYNC ((Sint) -2)
+typedef struct {
+ ErtsSignalCommon common;
+ Eterm requester;
+ Eterm (*func)(Process *, void *, int *, ErlHeapFragment **);
+ void *arg;
+ Eterm ref;
+ ErtsORefThing oref_thing;
+} ErtsProcSigRPC;
+
static int handle_msg_tracing(Process *c_p,
ErtsSigRecvTracing *tracing,
ErtsMessage ***next_nm_sig);
@@ -519,41 +542,42 @@ erts_aint32_t erts_enqueue_signals(Process *rp, ErtsMessage *first,
return enqueue_signals(rp, first, last, last_next, num_msgs, in_state);
}
-static ERTS_INLINE void
-ensure_dirty_proc_handled(Eterm pid,
- erts_aint32_t state,
- erts_aint32_t prio)
+void
+erts_make_dirty_proc_handled(Eterm pid,
+ erts_aint32_t state,
+ erts_aint32_t prio)
{
- if (state & (ERTS_PSFLG_DIRTY_RUNNING
- | ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
- Eterm *hp;
- ErtsMessage *mp;
- Process *sig_handler;
+ Eterm *hp;
+ ErtsMessage *mp;
+ Process *sig_handler;
- if (prio < 0)
- prio = (int) ERTS_PSFLGS_GET_USR_PRIO(state);
+ ASSERT(state & (ERTS_PSFLG_DIRTY_RUNNING |
+ ERTS_PSFLG_DIRTY_RUNNING_SYS));
- switch (prio) {
- case PRIORITY_MAX:
- sig_handler = erts_dirty_process_signal_handler_max;
- break;
- case PRIORITY_HIGH:
- sig_handler = erts_dirty_process_signal_handler_high;
- break;
- default:
- sig_handler = erts_dirty_process_signal_handler;
- break;
- }
+ if (prio < 0)
+ prio = (int) ERTS_PSFLGS_GET_USR_PRIO(state);
- /* Make sure signals are handled... */
- mp = erts_alloc_message(0, &hp);
- erts_queue_message(sig_handler, 0, mp, pid, am_system);
+ switch (prio) {
+ case PRIORITY_MAX:
+ sig_handler = erts_dirty_process_signal_handler_max;
+ break;
+ case PRIORITY_HIGH:
+ sig_handler = erts_dirty_process_signal_handler_high;
+ break;
+ default:
+ sig_handler = erts_dirty_process_signal_handler;
+ break;
}
+
+ /* Make sure signals are handled... */
+ mp = erts_alloc_message(0, &hp);
+ erts_queue_message(sig_handler, 0, mp, pid, am_system);
}
static void
check_push_msgq_len_offs_marker(Process *rp, ErtsSignal *sig);
+
static int
proc_queue_signal(Process *c_p, Eterm pid, ErtsSignal *sig, int op)
{
@@ -679,14 +703,7 @@ first_last_done:
sig_enqueue_trace_cleanup(first, sig, last);
}
- if (!(state & (ERTS_PSFLG_EXITING
- | ERTS_PSFLG_ACTIVE_SYS
- | ERTS_PSFLG_SIG_IN_Q))) {
- /* Schedule process... */
- state = erts_proc_sys_schedule(rp, state, 0);
- }
-
- ensure_dirty_proc_handled(rp->common.id, state, -1);
+ erts_proc_notify_new_sig(rp, state, 0);
if (!is_normal_sched)
erts_proc_dec_refc(rp);
@@ -742,7 +759,10 @@ maybe_elevate_sig_handling_prio(Process *c_p, Eterm other)
if (res) {
/* ensure handled if dirty executing... */
state = erts_atomic32_read_nob(&rp->state);
- ensure_dirty_proc_handled(other, state, my_prio);
+ if (state & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
+ erts_make_dirty_proc_handled(other, state, my_prio);
+ }
}
}
}
@@ -1311,6 +1331,8 @@ erts_proc_sig_send_monitor_down(ErtsMonitor *mon, Eterm reason)
/* Pass signal using old monitor structure... */
ErtsSignal *sig;
+ send_using_monitor_struct:
+
mon->other.item = reason; /* Pass immed reason via other.item... */
sig = (ErtsSignal *) mon;
sig->common.tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_MONITOR_DOWN,
@@ -1322,6 +1344,18 @@ erts_proc_sig_send_monitor_down(ErtsMonitor *mon, Eterm reason)
ErtsMonitorData *mdp = erts_monitor_to_data(mon);
Eterm from_tag, monitored, heap[3];
+ if (mon->type == ERTS_MON_TYPE_SUSPEND) {
+ /*
+ * Set reason to 'undefined', since exit
+ * reason is not used for suspend monitors,
+ * and send using monitor structure. This
+ * since we don't want to trigger
+ * unnecessary memory allocation etc...
+ */
+ reason = am_undefined;
+ goto send_using_monitor_struct;
+ }
+
if (!(mon->flags & ERTS_ML_FLG_NAME)) {
from_tag = monitored = mdp->origin.other.item;
if (is_external_pid(from_tag)) {
@@ -1599,7 +1633,173 @@ erts_proc_sig_send_process_info_request(Process *c_p,
else
erts_free(ERTS_ALC_T_SIG_DATA, pis);
return res;
-}
+}
+
+void
+erts_proc_sig_send_sync_suspend(Process *c_p, Eterm to, Eterm tag, Eterm reply)
+{
+ ErlHeapFragment *hfrag;
+ Uint hsz, tag_sz;
+ Eterm *hp, *start_hp, tag_cpy, msg, default_reply;
+ ErlOffHeap *ohp;
+ ErtsMessage *mp;
+ ErtsSyncSuspendRequest *ssusp;
+ int async_suspend;
+
+ tag_sz = size_object(tag);
+
+ hsz = 3 + tag_sz + sizeof(ErtsSyncSuspendRequest)/sizeof(Eterm);
+
+ mp = erts_alloc_message(hsz, &hp);
+ hfrag = &mp->hfrag;
+ mp->next = NULL;
+ ohp = &hfrag->off_heap;
+ start_hp = hp;
+
+ tag_cpy = copy_struct(tag, tag_sz, &hp, ohp);
+
+ async_suspend = is_non_value(reply);
+ default_reply = async_suspend ? am_suspended : reply;
+
+ msg = TUPLE2(hp, tag_cpy, default_reply);
+ hp += 3;
+
+ hfrag->used_size = hp - start_hp;
+
+ ssusp = (ErtsSyncSuspendRequest *) (char *) hp;
+ ssusp->message = msg;
+ ssusp->requester = c_p->common.id;
+ ssusp->async = async_suspend;
+
+ ERL_MESSAGE_TERM(mp) = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_SYNC_SUSPEND,
+ ERTS_SIG_Q_TYPE_UNDEFINED,
+ 0);
+ ERL_MESSAGE_TOKEN(mp) = NIL;
+ ERL_MESSAGE_FROM(mp) = am_system;
+#ifdef USE_VM_PROBES
+ ERL_MESSAGE_DT_UTAG(mp) = NIL;
+#endif
+
+ if (proc_queue_signal(c_p, to, (ErtsSignal *) mp, ERTS_SIG_Q_OP_SYNC_SUSPEND))
+ (void) maybe_elevate_sig_handling_prio(c_p, to);
+ else {
+ Eterm *tp;
+ /* It wasn't alive; reply to ourselves... */
+ mp->next = NULL;
+ mp->data.attached = ERTS_MSG_COMBINED_HFRAG;
+ tp = tuple_val(msg);
+ tp[2] = async_suspend ? am_badarg : am_exited;
+ erts_queue_message(c_p, ERTS_PROC_LOCK_MAIN,
+ mp, msg, am_system);
+ }
+}
+
+Eterm
+erts_proc_sig_send_rpc_request(Process *c_p,
+ Eterm to,
+ int reply,
+ Eterm (*func)(Process *, void *, int *, ErlHeapFragment **),
+ void *arg)
+{
+ Eterm res;
+ ErtsProcSigRPC *sig = erts_alloc(ERTS_ALC_T_SIG_DATA,
+ sizeof(ErtsProcSigRPC));
+ sig->common.tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_RPC,
+ ERTS_SIG_Q_TYPE_UNDEFINED,
+ 0);
+ sig->requester = reply ? c_p->common.id : NIL;
+ sig->func = func;
+ sig->arg = arg;
+
+ if (!reply) {
+ res = am_ok;
+ sig->ref = am_ok;
+ }
+ else {
+ res = erts_make_ref(c_p);
+
+ sys_memcpy((void *) &sig->oref_thing,
+ (void *) internal_ref_val(res),
+ sizeof(ErtsORefThing));
+
+ sig->ref = make_internal_ref(&sig->oref_thing);
+
+ ERTS_RECV_MARK_SAVE(c_p);
+ ERTS_RECV_MARK_SET(c_p);
+ }
+
+ if (proc_queue_signal(c_p, to, (ErtsSignal *) sig, ERTS_SIG_Q_OP_RPC))
+ (void) maybe_elevate_sig_handling_prio(c_p, to);
+ else {
+ erts_free(ERTS_ALC_T_SIG_DATA, sig);
+ res = THE_NON_VALUE;
+ if (reply)
+ JOIN_MESSAGE(c_p);
+ }
+
+ return res;
+}
+
+static int
+handle_rpc(Process *c_p, ErtsProcSigRPC *rpc, int cnt, int limit, int *yieldp)
+{
+ Process *rp;
+ ErlHeapFragment *bp = NULL;
+ Eterm res;
+ Uint hsz;
+ int reds, out_cnt;
+
+ /*
+ * reds in:
+ * Reductions left.
+ *
+ * reds out:
+ * Absolute value of reds out equals consumed
+ * amount of reds. If a negative value, force
+ * a yield.
+ */
+
+ reds = (limit - cnt) / ERTS_SIG_REDS_CNT_FACTOR;
+ if (reds <= 0)
+ reds = 1;
+
+ res = (*rpc->func)(c_p, rpc->arg, &reds, &bp);
+
+ if (reds < 0) {
+ /* Force yield... */
+ *yieldp = !0;
+ reds *= -1;
+ }
+
+ out_cnt = reds*ERTS_SIG_REDS_CNT_FACTOR;
+
+ hsz = 3 + sizeof(ErtsORefThing)/sizeof(Eterm);
+
+ rp = erts_proc_lookup(rpc->requester);
+ if (!rp) {
+ if (bp)
+ free_message_buffer(bp);
+ }
+ else {
+ Eterm *hp, msg, ref;
+ ErtsMessage *mp = erts_alloc_message(hsz, &hp);
+
+ sys_memcpy((void *) hp, (void *) &rpc->oref_thing,
+ sizeof(rpc->oref_thing));
+
+ ref = make_internal_ref(hp);
+ hp += sizeof(rpc->oref_thing)/sizeof(Eterm);
+ msg = TUPLE2(hp, ref, res);
+
+ mp->hfrag.next = bp;
+
+ erts_queue_proc_message(c_p, rp, 0, mp, msg);
+ }
+
+ erts_free(ERTS_ALC_T_SIG_DATA, rpc);
+
+ return out_cnt;
+}
static void
is_alive_response(Process *c_p, ErtsMessage *mp, int is_alive)
@@ -2643,6 +2843,155 @@ handle_process_info(Process *c_p, ErtsSigRecvTracing *tracing,
return ((int) reds)*4 + 8;
}
+static void
+handle_suspend(Process *c_p, ErtsMonitor *mon, int *yieldp)
+{
+ erts_aint32_t state = erts_atomic32_read_nob(&c_p->state);
+
+ ASSERT(mon->type == ERTS_MON_TYPE_SUSPEND);
+
+ if (!(state & ERTS_PSFLG_DIRTY_RUNNING)) {
+ ErtsMonitorSuspend *msp;
+ erts_aint_t mstate;
+
+ msp = (ErtsMonitorSuspend *) erts_monitor_to_data(mon);
+ mstate = erts_atomic_read_bor_acqb(&msp->state,
+ ERTS_MSUSPEND_STATE_FLG_ACTIVE);
+ ASSERT(!(mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE)); (void) mstate;
+ erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL);
+ *yieldp = !0;
+ }
+ else {
+ /* Executing dirty; delay suspend... */
+ ErtsProcSigPendingSuspend *psusp;
+ ErtsMonitorSuspend *msp;
+
+ psusp = ERTS_PROC_GET_PENDING_SUSPEND(c_p);
+ if (!psusp) {
+ psusp = erts_alloc(ERTS_ALC_T_SIG_DATA,
+ sizeof(ErtsProcSigPendingSuspend));
+ psusp->mon = NULL;
+ psusp->sync = NULL;
+ ERTS_PROC_SET_PENDING_SUSPEND(c_p, (void *) psusp);
+ }
+
+ msp = (ErtsMonitorSuspend *) erts_monitor_to_data(mon);
+
+ msp->next = psusp->mon;
+ psusp->mon = msp;
+
+ erts_atomic32_inc_nob(&msp->md.refc);
+ }
+}
+
+static void
+sync_suspend_reply(Process *c_p, ErtsMessage *mp, erts_aint32_t state)
+{
+ /*
+ * Sender prepared the message for us. Just patch
+ * the result if necessary. The default prepared
+ * result is 'false'.
+ */
+ Process *rp;
+ ErtsSyncSuspendRequest *ssusp;
+
+ ssusp = (ErtsSyncSuspendRequest *) (char *) (&mp->hfrag.mem[0]
+ + mp->hfrag.used_size);
+
+ ASSERT(ERTS_SIG_IS_NON_MSG(mp));
+ ASSERT(ERTS_PROC_SIG_OP(((ErtsSignal *) mp)->common.tag)
+ == ERTS_SIG_Q_OP_SYNC_SUSPEND);
+ ASSERT(mp->hfrag.alloc_size > mp->hfrag.used_size);
+ ASSERT((mp->hfrag.alloc_size - mp->hfrag.used_size)*sizeof(UWord)
+ >= sizeof(ErtsSyncSuspendRequest));
+ ASSERT(is_internal_pid(ssusp->requester));
+ ASSERT(ssusp->requester != c_p->common.id);
+ ASSERT(is_tuple_arity(ssusp->message, 2));
+ ASSERT(is_immed(tuple_val(ssusp->message)[2]));
+
+ ERL_MESSAGE_TERM(mp) = ssusp->message;
+ mp->data.attached = ERTS_MSG_COMBINED_HFRAG;
+ mp->next = NULL;
+
+ rp = erts_proc_lookup(ssusp->requester);
+ if (!rp)
+ erts_cleanup_messages(mp);
+ else {
+ if ((state & (ERTS_PSFLG_EXITING
+ | ERTS_PSFLG_SUSPENDED)) != ERTS_PSFLG_SUSPENDED) {
+ /* Not suspended -> patch result... */
+ if (state & ERTS_PSFLG_EXITING) {
+ Eterm *tp = tuple_val(ssusp->message);
+ tp[2] = ssusp->async ? am_exited : am_badarg;
+ }
+ else {
+ Eterm *tp = tuple_val(ssusp->message);
+ ASSERT(!(state & ERTS_PSFLG_SUSPENDED));
+ tp[2] = ssusp->async ? am_not_suspended : am_internal_error;
+ }
+ }
+ erts_queue_proc_message(c_p, rp, 0, mp, ssusp->message);
+ }
+}
+
+static void
+handle_sync_suspend(Process *c_p, ErtsMessage *mp)
+{
+ ErtsProcSigPendingSuspend *psusp;
+
+ psusp = (ErtsProcSigPendingSuspend *) ERTS_PROC_GET_PENDING_SUSPEND(c_p);
+ if (!psusp)
+ sync_suspend_reply(c_p, mp, erts_atomic32_read_nob(&c_p->state));
+ else {
+ mp->next = psusp->sync;
+ psusp->sync = mp;
+ }
+}
+
+void
+erts_proc_sig_handle_pending_suspend(Process *c_p)
+{
+ ErtsMonitorSuspend *msp;
+ ErtsMessage *sync;
+ ErtsProcSigPendingSuspend *psusp;
+ erts_aint32_t state = erts_atomic32_read_nob(&c_p->state);
+
+ psusp = (ErtsProcSigPendingSuspend *) ERTS_PROC_GET_PENDING_SUSPEND(c_p);
+
+ msp = psusp->mon;
+
+ while (msp) {
+ ErtsMonitorSuspend *next_msp = msp->next;
+ msp->next = NULL;
+ if (!(state & ERTS_PSFLG_EXITING)
+ && erts_monitor_is_in_table(&msp->md.target)) {
+ erts_aint_t mstate;
+
+ mstate = erts_atomic_read_bor_acqb(&msp->state,
+ ERTS_MSUSPEND_STATE_FLG_ACTIVE);
+ ASSERT(!(mstate & ERTS_MSUSPEND_STATE_FLG_ACTIVE)); (void) mstate;
+ erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL);
+ }
+
+ erts_monitor_release(&msp->md.target);
+
+ msp = next_msp;
+ }
+
+ sync = psusp->sync;
+
+ while (sync) {
+ ErtsMessage *next_sync = sync->next;
+ sync->next = NULL;
+ sync_suspend_reply(c_p, sync, state);
+ sync = next_sync;
+ }
+
+ erts_free(ERTS_ALC_T_SIG_DATA, psusp);
+
+ ERTS_PROC_SET_PENDING_SUSPEND(c_p, NULL);
+}
+
/*
* Called in order to handle incoming signals.
*/
@@ -2653,7 +3002,7 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep,
{
Eterm tag;
erts_aint32_t state;
- int cnt, limit, abs_lim, msg_tracing;
+ int yield, cnt, limit, abs_lim, msg_tracing;
ErtsMessage *sig, ***next_nm_sig;
ErtsSigRecvTracing tracing;
@@ -2673,6 +3022,7 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep,
limit = *redsp;
*redsp = 0;
+ yield = 0;
if (!c_p->sig_qs.cont) {
if (state == -1)
@@ -2786,6 +3136,18 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep,
cnt += handle_nodedown(c_p, sig, mdp, next_nm_sig);
}
break;
+ case ERTS_MON_TYPE_SUSPEND:
+ tmon = (ErtsMonitor *) sig;
+ ASSERT(erts_monitor_is_target(tmon));
+ ASSERT(!erts_monitor_is_in_table(tmon));
+ mdp = erts_monitor_to_data(tmon);
+ if (erts_monitor_is_in_table(&mdp->origin)) {
+ erts_monitor_tree_delete(&ERTS_P_MONITORS(c_p),
+ &mdp->origin);
+ omon = &mdp->origin;
+ }
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ break;
default:
ERTS_INTERNAL_ERROR("invalid monitor type");
break;
@@ -2849,9 +3211,13 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep,
if (mon->type == ERTS_MON_TYPE_DIST_PROC)
erts_monitor_tree_insert(&ERTS_P_MONITORS(c_p), mon);
- else
+ else {
erts_monitor_list_insert(&ERTS_P_LT_MONITORS(c_p), mon);
+ if (mon->type == ERTS_MON_TYPE_SUSPEND)
+ handle_suspend(c_p, mon, &yield);
+ }
ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ cnt += 2;
break;
}
@@ -2895,9 +3261,16 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep,
erts_monitor_tree_delete(&ERTS_P_MONITORS(c_p), tmon);
else {
erts_monitor_list_delete(&ERTS_P_LT_MONITORS(c_p), tmon);
- if (type == ERTS_MON_TYPE_RESOURCE) {
+ switch (type) {
+ case ERTS_MON_TYPE_RESOURCE:
erts_nif_demonitored((ErtsResource *) tmon->other.ptr);
cnt++;
+ break;
+ case ERTS_MON_TYPE_SUSPEND:
+ erts_resume(c_p, ERTS_PROC_LOCK_MAIN);
+ break;
+ default:
+ break;
}
}
erts_monitor_release_both(mdp);
@@ -3012,6 +3385,21 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep,
ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
break;
+ case ERTS_SIG_Q_OP_SYNC_SUSPEND:
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ handle_sync_suspend(c_p, sig);
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ break;
+
+ case ERTS_SIG_Q_OP_RPC:
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ remove_nm_sig(c_p, sig, next_nm_sig);
+ cnt += handle_rpc(c_p, (ErtsProcSigRPC *) sig, cnt,
+ limit, &yield);
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ break;
+
case ERTS_SIG_Q_OP_TRACE_CHANGE_STATE: {
Uint16 type = ERTS_PROC_SIG_TYPE(tag);
@@ -3169,6 +3557,15 @@ stop: {
*redsp = cnt/4 + 1;
+ if (yield) {
+ int vreds = max_reds - *redsp;
+ if (vreds > 0) {
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ esdp->virtual_reds += vreds;
+ }
+ *redsp = max_reds;
+ }
+
return res;
}
}
@@ -3277,6 +3674,8 @@ erts_proc_sig_handle_exit(Process *c_p, int *redsp)
case ERTS_MON_TYPE_PROC:
case ERTS_MON_TYPE_DIST_PROC:
case ERTS_MON_TYPE_NODE:
+ case ERTS_MON_TYPE_NODES:
+ case ERTS_MON_TYPE_SUSPEND:
erts_monitor_release((ErtsMonitor *) sig);
break;
default:
@@ -3332,6 +3731,17 @@ erts_proc_sig_handle_exit(Process *c_p, int *redsp)
handle_process_info(c_p, NULL, sig, next_nm_sig, 0);
break;
+ case ERTS_SIG_Q_OP_SYNC_SUSPEND:
+ handle_sync_suspend(c_p, sig);
+ break;
+
+ case ERTS_SIG_Q_OP_RPC: {
+ int yield = 0;
+ handle_rpc(c_p, (ErtsProcSigRPC *) sig,
+ cnt, limit, &yield);
+ break;
+ }
+
case ERTS_SIG_Q_OP_TRACE_CHANGE_STATE:
destroy_trace_info((ErtsSigTraceInfo *) sig);
break;
@@ -3467,6 +3877,7 @@ erts_proc_sig_signal_size(ErtsSignal *sig)
}
break;
+ case ERTS_SIG_Q_OP_SYNC_SUSPEND:
case ERTS_SIG_Q_OP_PERSISTENT_MON_MSG:
case ERTS_SIG_Q_OP_IS_ALIVE:
size = ((ErtsMessage *) sig)->hfrag.alloc_size;
@@ -3522,6 +3933,10 @@ erts_proc_sig_signal_size(ErtsSignal *sig)
break;
}
+ case ERTS_SIG_Q_OP_RPC:
+ size = sizeof(ErtsProcSigRPC);
+ break;
+
default:
ERTS_INTERNAL_ERROR("Unknown signal");
break;
@@ -3598,17 +4013,13 @@ erts_proc_sig_receive_helper(Process *c_p,
*/
*get_outp = 0;
*msgpp = NULL;
+
return consumed_reds;
}
erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
- if (left_reds <= 0) {
- *get_outp = -1; /* yield */
- *msgpp = NULL;
-
- ASSERT(consumed_reds >= (fcalls - neg_o_reds));
- return consumed_reds;
- }
+ if (left_reds <= 0)
+ break; /* Yield */
/* handle newly arrived signals... */
}
@@ -3629,19 +4040,27 @@ erts_proc_sig_receive_helper(Process *c_p,
max_reds, !0);
consumed_reds += reds;
left_reds -= reds;
- /* we may have exited by an incoming signal... */
- if (state & ERTS_PSFLG_EXITING) {
+
+ /* we may have exited or suspended by an incoming signal... */
+
+ if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_SUSPENDED)) {
+ if (state & ERTS_PSFLG_SUSPENDED)
+ break; /* Yield */
+
/*
* Process need to schedule out in order
* to terminate. Prepare this a bit...
*/
+ ASSERT(state & ERTS_PSFLG_EXITING);
ASSERT(c_p->flags & F_DELAY_GC);
c_p->flags &= ~F_DELAY_GC;
c_p->arity = 0;
c_p->current = NULL;
+
*get_outp = 1;
*msgpp = NULL;
+
return consumed_reds;
}
@@ -3652,17 +4071,20 @@ erts_proc_sig_receive_helper(Process *c_p,
return consumed_reds;
}
- if (left_reds <= 0) {
- *get_outp = -1; /* yield */
- *msgpp = NULL;
-
- ASSERT(consumed_reds >= (fcalls - neg_o_reds));
- return consumed_reds;
- }
+ if (left_reds <= 0)
+ break; /* yield */
ASSERT(!c_p->sig_qs.cont);
/* Go fetch again... */
}
+
+ /* Yield... */
+
+ *get_outp = -1;
+ *msgpp = NULL;
+
+ ASSERT(consumed_reds >= (fcalls - neg_o_reds));
+ return consumed_reds;
}
static int
diff --git a/erts/emulator/beam/erl_proc_sig_queue.h b/erts/emulator/beam/erl_proc_sig_queue.h
index 8b7cd35f61..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/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl
index 43807b4388..f93c637650 100644
--- a/erts/emulator/test/map_SUITE.erl
+++ b/erts/emulator/test/map_SUITE.erl
@@ -38,6 +38,7 @@
t_map_size/1,
t_map_get/1,
t_is_map/1,
+ t_is_map_key/1,
%% Specific Map BIFs
t_bif_map_get/1,
@@ -718,7 +719,47 @@ t_map_get(Config) when is_list(Config) ->
true = if map_get(a, M2) =:= 1 -> true; true -> false end,
false = if map_get(x, M2) =:= 1 -> true; true -> false end,
do_badmap(fun
- (T) when map_get(T, x) =:= 1 -> ok;
+ (T) when map_get(x, T) =:= 1 -> ok;
+ (T) -> false = is_map(T)
+ end),
+ ok.
+
+t_is_map_key(Config) when is_list(Config) ->
+ %% small map
+ true = is_map_key(a, id(#{a=>1})),
+ true = is_map_key(b, id(#{a=>1, b=>2})),
+ true = is_map_key("hello", id(#{a=>1, "hello"=>"hi"})),
+ true = is_map_key({1,1.0}, id(#{a=>a, {1,1.0}=>"tuple hi"})),
+
+ M0 = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }),
+ true = is_map_key(<<"k2">>, M0#{<<"k2">> => "v4"}),
+
+ %% large map
+ M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++
+ [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"},
+ {k1,"v1"},{<<"k2">>,"v3"}]),
+ true = is_map_key(a, M1),
+ true = is_map_key(b, M1),
+ true = is_map_key("hello", M1),
+ true = is_map_key({1,1.0}, M1),
+ true = is_map_key(<<"k2">>, M1),
+
+ %% error cases
+ do_badmap(fun(T) ->
+ {'EXIT',{{badmap,T},[{erlang,is_map_key,_,_}|_]}} =
+ (catch is_map_key(a, T))
+ end),
+
+ false = is_map_key({1,1}, id(#{{1,1.0}=>"tuple"})),
+ false = is_map_key(a, id(#{})),
+ false = is_map_key(a, id(#{b=>1, c=>2})),
+
+ %% in guards
+ M2 = id(#{a=>1}),
+ true = if is_map_key(a, M2) -> true; true -> false end,
+ false = if is_map_key(x, M2) -> true; true -> false end,
+ do_badmap(fun
+ (T) when is_map_key(T, x) =:= 1 -> ok;
(T) -> false = is_map(T)
end),
ok.
diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl
index c1bc01f01e..4415d8d1b9 100644
--- a/erts/emulator/test/match_spec_SUITE.erl
+++ b/erts/emulator/test/match_spec_SUITE.erl
@@ -898,6 +898,13 @@ maps(Config) when is_list(Config) ->
{ok,false,[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[{map_get,b,'$1'}],['$_']}], table),
{ok,true,[],[]} = erlang:match_spec_test(#{a => true}, [{'$1',[{map_get,a,'$1'}],[true]}], table),
+ {ok,true,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{is_map_key,a,'$1'}]}], table),
+ {ok,false,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{is_map_key,b,'$1'}]}], table),
+ {ok,'EXIT',[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[],[{is_map_key,a,'$1'}]}], table),
+ {ok,false,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[{is_map_key,b,'$1'}],['$_']}], table),
+ {ok,false,[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[{is_map_key,b,'$1'}],['$_']}], table),
+ {ok,true,[],[]} = erlang:match_spec_test(#{a => true}, [{'$1',[{is_map_key,a,'$1'}],[true]}], table),
+
%% large maps
Ls0 = [{I,<<I:32>>}||I <- lists:seq(1,415)],
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index df521311e3..100fa006e7 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -2663,16 +2663,23 @@ nif_term_to_binary(Config) ->
nif_binary_to_term(Config) ->
ensure_lib_loaded(Config),
- T = {#{ok => nok}, <<0:8096>>, lists:seq(1,100)},
+ BigMap = maps:from_list([{I,-I} || I <- lists:seq(1,100)]),
+ [nif_binary_to_term_do(T)
+ || T <- [{#{ok => nok}, <<0:8096>>, lists:seq(1,100)},
+ atom, 42, self(), BigMap]],
+ ok.
+
+nif_binary_to_term_do(T) ->
+ Dummy = [true|false],
Bin = term_to_binary(T),
Len = byte_size(Bin),
- {Len,T} = binary_to_term_nif(Bin, undefined, 0),
+ {Len,T,Dummy} = binary_to_term_nif(Bin, undefined, 0),
Len = binary_to_term_nif(Bin, self(), 0),
- T = receive M -> M after 1000 -> timeout end,
+ {T,Dummy} = receive M -> M after 1000 -> timeout end,
- {Len, T} = binary_to_term_nif(Bin, undefined, ?ERL_NIF_BIN2TERM_SAFE),
+ {Len,T,Dummy} = binary_to_term_nif(Bin, undefined, ?ERL_NIF_BIN2TERM_SAFE),
false = binary_to_term_nif(<<131,100,0,14,"undefined_atom">>,
- undefined, ?ERL_NIF_BIN2TERM_SAFE),
+ undefined, ?ERL_NIF_BIN2TERM_SAFE),
false = binary_to_term_nif(Bin, undefined, 1),
ok.
diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
index a0aef60cf1..155bda6df0 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
@@ -2405,7 +2405,7 @@ static ERL_NIF_TERM term_to_binary(ErlNifEnv* env, int argc, const ERL_NIF_TERM
static ERL_NIF_TERM binary_to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
ErlNifBinary bin;
- ERL_NIF_TERM term, ret_term;
+ ERL_NIF_TERM term, dummy, ret_term;
ErlNifPid pid;
ErlNifEnv *msg_env = env;
unsigned int opts;
@@ -2418,6 +2418,9 @@ static ERL_NIF_TERM binary_to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM
|| !enif_get_uint(env, argv[2], &opts))
return enif_make_badarg(env);
+ /* build dummy heap term first to provoke OTP-15080 */
+ dummy = enif_make_list_cell(msg_env, atom_true, atom_false);
+
ret = enif_binary_to_term(msg_env, bin.data, bin.size, &term,
(ErlNifBinaryToTerm)opts);
if (!ret)
@@ -2425,11 +2428,12 @@ static ERL_NIF_TERM binary_to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM
ret_term = enif_make_uint64(env, ret);
if (msg_env != env) {
- enif_send(env, &pid, msg_env, term);
+ enif_send(env, &pid, msg_env,
+ enif_make_tuple2(msg_env, term, dummy));
enif_free_env(msg_env);
return ret_term;
} else {
- return enif_make_tuple2(env, ret_term, term);
+ return enif_make_tuple3(env, ret_term, term, dummy);
}
}
diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl
index 5b39d05df8..eb9b94a316 100644
--- a/erts/emulator/test/port_SUITE.erl
+++ b/erts/emulator/test/port_SUITE.erl
@@ -965,7 +965,7 @@ env_slave(File, Env) ->
env_slave(File, Env, Body) ->
file:write_file(File, term_to_binary(Body)),
- Program = atom_to_list(lib:progname()),
+ Program = ct:get_progname(),
Dir = filename:dirname(code:which(?MODULE)),
Cmd = Program ++ " -pz " ++ Dir ++
" -noinput -run " ++ ?MODULE_STRING ++ " env_slave_main " ++
@@ -1129,7 +1129,7 @@ try_bad_args(Args) ->
cd(Config) when is_list(Config) ->
ct:timetrap({minutes, 1}),
- Program = atom_to_list(lib:progname()),
+ Program = ct:get_progname(),
DataDir = proplists:get_value(data_dir, Config),
TestDir = filename:join(DataDir, "dir"),
Cmd = Program ++ " -pz " ++ DataDir ++
@@ -1191,7 +1191,7 @@ cd(Config) when is_list(Config) ->
%% be relative the new cwd and not the original
cd_relative(Config) ->
- Program = atom_to_list(lib:progname()),
+ Program = ct:get_progname(),
DataDir = proplists:get_value(data_dir, Config),
TestDir = filename:join(DataDir, "dir"),
@@ -1214,7 +1214,7 @@ cd_relative(Config) ->
relative_cd() ->
- Program = atom_to_list(lib:progname()),
+ Program = ct:get_progname(),
ok = file:set_cwd(".."),
{ok, Cwd} = file:get_cwd(),
diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl
index c3e303bbd1..9b23a30e88 100644
--- a/erts/emulator/test/sensitive_SUITE.erl
+++ b/erts/emulator/test/sensitive_SUITE.erl
@@ -413,7 +413,7 @@ my_process_info(Pid, Tag) ->
t_process_display(Config) when is_list(Config) ->
Dir = filename:dirname(code:which(?MODULE)),
- Cmd = atom_to_list(lib:progname()) ++ " -noinput -pa " ++ Dir ++
+ Cmd = ct:get_progname() ++ " -noinput -pa " ++ Dir ++
" -run " ++ ?MODULE_STRING ++ " remote_process_display",
io:put_chars(Cmd),
P = open_port({spawn,Cmd}, [in,stderr_to_stdout,eof]),
diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl
index def25dba7d..138aefb29c 100644
--- a/erts/emulator/test/trace_SUITE.erl
+++ b/erts/emulator/test/trace_SUITE.erl
@@ -29,7 +29,7 @@
receive_trace/1, link_receive_call_correlation/1, self_send/1,
timeout_trace/1, send_trace/1,
procs_trace/1, dist_procs_trace/1, procs_new_trace/1,
- suspend/1, mutual_suspend/1, suspend_exit/1, suspender_exit/1,
+ suspend/1, suspend_exit/1, suspender_exit/1,
suspend_system_limit/1, suspend_opts/1, suspend_waiting/1,
new_clear/1, existing_clear/1, tracer_die/1,
set_on_spawn/1, set_on_first_spawn/1, cpu_timestamp/1,
@@ -53,7 +53,7 @@ all() ->
[cpu_timestamp, receive_trace, link_receive_call_correlation,
self_send, timeout_trace,
send_trace, procs_trace, dist_procs_trace, suspend,
- mutual_suspend, suspend_exit, suspender_exit,
+ suspend_exit, suspender_exit,
suspend_system_limit, suspend_opts, suspend_waiting,
new_clear, existing_clear, tracer_die, set_on_spawn,
set_on_first_spawn, set_on_link, set_on_first_link,
@@ -1234,55 +1234,6 @@ do_suspend(Pid, N) ->
erlang:yield(),
do_suspend(Pid, N-1).
-
-
-mutual_suspend(Config) when is_list(Config) ->
- TimeoutSecs = 5*60,
- ct:timetrap({seconds, TimeoutSecs}),
- Parent = self(),
- Fun = fun () ->
- receive
- {go, Pid} ->
- do_mutual_suspend(Pid, 100000)
- end,
- Parent ! {done, self()},
- receive after infinity -> ok end
- end,
- P1 = spawn_link(Fun),
- P2 = spawn_link(Fun),
- T1 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops),
- T2 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops),
- P1 ! {go, P2},
- P2 ! {go, P1},
- Res1 = receive
- {done, P1} -> done;
- {timeout,T1,_} -> timeout
- end,
- Res2 = receive
- {done, P2} -> done;
- {timeout,T2,_} -> timeout
- end,
- P1S = process_info(P1, status),
- P2S = process_info(P2, status),
- io:format("P1S=~p P2S=~p", [P1S, P2S]),
- false = {status, suspended} == P1S,
- false = {status, suspended} == P2S,
- unlink(P1), exit(P1, bang),
- unlink(P2), exit(P2, bang),
- done = Res1,
- done = Res2,
- ok.
-
-do_mutual_suspend(_Pid, 0) ->
- ok;
-do_mutual_suspend(Pid, N) ->
- %% Suspend a process and test that it is suspended.
- true = erlang:suspend_process(Pid),
- {status, suspended} = process_info(Pid, status),
- %% Unsuspend the process.
- true = erlang:resume_process(Pid),
- do_mutual_suspend(Pid, N-1).
-
suspend_exit(Config) when is_list(Config) ->
ct:timetrap({minutes, 2}),
rand:seed(exsplus, {4711,17,4711}),
@@ -1513,7 +1464,8 @@ suspend_opts(Config) when is_list(Config) ->
dbl_async = AA,
synced = S,
async_once = AO} = Acc) ->
- erlang:suspend_process(Tok, [asynchronous]),
+ Tag = {make_ref(), self()},
+ erlang:suspend_process(Tok, [{asynchronous, Tag}]),
Res = case {suspend_count(Tok), N rem 4} of
{0, 2} ->
erlang:suspend_process(Tok,
@@ -1549,7 +1501,11 @@ suspend_opts(Config) when is_list(Config) ->
_ ->
Acc
end,
- erlang:resume_process(Tok),
+ receive
+ {Tag, Result} ->
+ suspended = Result,
+ erlang:resume_process(Tok)
+ end,
erlang:yield(),
Res
end,
diff --git a/erts/emulator/test/tracer_SUITE.erl b/erts/emulator/test/tracer_SUITE.erl
index e1362ef07a..070462b0f1 100644
--- a/erts/emulator/test/tracer_SUITE.erl
+++ b/erts/emulator/test/tracer_SUITE.erl
@@ -623,7 +623,7 @@ test(Event, TraceFlag, Tc, Expect, _Removes, Dies) ->
Expect(Pid1, State1, Opts),
receive M11 -> ct:fail({unexpected, M11}) after 0 -> ok end,
- if not Dies ->
+ if not Dies andalso Event /= in ->
{flags, [TraceFlag]} = erlang:trace_info(Pid1, flags),
{tracer, {tracer_test, State1}} = erlang:trace_info(Pid1, tracer),
erlang:trace(Pid1, false, [TraceFlag]);
@@ -640,7 +640,7 @@ test(Event, TraceFlag, Tc, Expect, _Removes, Dies) ->
Expect(Pid1T, State1, Opts#{ scheduler_id => number,
timestamp => timestamp}),
receive M11T -> ct:fail({unexpected, M11T}) after 0 -> ok end,
- if not Dies ->
+ if not Dies andalso Event /= in ->
{flags, [scheduler_id, TraceFlag, timestamp]}
= erlang:trace_info(Pid1T, flags),
{tracer, {tracer_test, State1}} = erlang:trace_info(Pid1T, tracer),
@@ -655,7 +655,7 @@ test(Event, TraceFlag, Tc, Expect, _Removes, Dies) ->
Tc(Pid2),
ok = trace_delivered(Pid2),
receive M2 -> ct:fail({unexpected, M2}) after 0 -> ok end,
- if not Dies ->
+ if not Dies andalso Event /= in ->
{flags, [TraceFlag]} = erlang:trace_info(Pid2, flags),
{tracer, {tracer_test, State2}} = erlang:trace_info(Pid2, tracer),
erlang:trace(Pid2, false, [TraceFlag]);
diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in
index e5ef819444..39e378193a 100644
--- a/erts/etc/unix/etp-commands.in
+++ b/erts/etc/unix/etp-commands.in
@@ -1232,6 +1232,142 @@ end
# Commands for special term bunches.
#
+define etp-sig-int
+ set $etp_sig_is_message = 0
+ set $etp_sig_tag = ($arg0)->m[0]
+ if ($etp_sig_tag & 0x3) != 0 || $etp_sig_tag == etp_the_non_value
+ set $etp_sig_is_message = !0
+ # A message
+ if $etp_sig_tag != etp_the_non_value
+ etp-1 $etp_sig_tag 0
+ else
+ print "!ENCODED-DIST-MSG"
+ end
+ if ($arg0)->m[1] != $etp_nil
+ printf " @token= "
+ etp-1 ($arg0)->m[1] 0
+ end
+ printf " @from= "
+ etp-1 ($arg0)->m[2] 0
+ else
+ if ($etp_sig_tag & 0x3f) != 0x30
+ print "!INVALID-SIGNAL"
+ else
+ set $etp_sig_op = (($etp_sig_tag >> 6) & 0xff)
+ set $etp_sig_type = (($etp_sig_tag >> 14) & 0xff)
+ if $etp_sig_op == 0
+ printf "!EXIT[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 1
+ printf "!EXIT-LINKED[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 2
+ printf "!MONITOR-DOWN[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 3
+ printf "!MONITOR[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 4
+ printf "!DEMONITOR[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 5
+ printf "!LINK[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 6
+ printf "!UNLINK[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 7
+ printf "!GROUP-LEADER[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 8
+ printf "!TRACE-CHANGE-STATE[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 9
+ printf "!PERSISTENT-MONITOR-MESSAGE[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 10
+ printf "!IS-ALIVE[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 11
+ printf "!PROCESS-INFO[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 12
+ printf "!SYNC-SUSPEND[%d]", $etp_sig_type
+ else
+ if $etp_sig_op == 13
+ printf "!RPC[%d]", $etp_sig_type
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+end
+
+
+define etp-sigq-int
+# Args: ErlMessageQueue*
+#
+# Non-reentrant
+#
+ set $etp_sig = ($arg0)
+ set $etp_sig_save = ($arg1)
+ set $etp_sig_save_last = ($arg2)
+ set $etp_sigq_msig_len = 0
+ set $etp_sigq_nmsig_len = 0
+
+ printf " ["
+ while $etp_sig != (void *) 0
+ set $etp_sig_next = $etp_sig->next
+ if $etp_sig != ($arg0)
+ printf " "
+ end
+ etp-sig-int $etp_sig
+ if $etp_sig_is_message
+ set $etp_sigq_msig_len++
+ else
+ set $etp_sigq_nmsig_len++
+ end
+ if $etp_sig_next
+ printf ","
+ end
+ if $etp_sig_save && *$etp_sig_save == $etp_sig
+ printf " %% <== SAVE"
+ else
+ if $etp_sig_save_last && *$etp_sig_save_last == $etp_sig
+ printf " %% <== SAVED_LAST"
+ else
+ end
+ end
+ if $etp_sig_next
+ printf "\n"
+ end
+ set $etp_sig = $etp_sig_next
+ end
+ printf "]\n\n"
+ printf " Message signals: %d\n", $etp_sigq_msig_len
+ printf " Non-message signals: %d\n\n", $etp_sigq_nmsig_len
+end
+
+define etp-sigqs
+ printf " --- Inner signal queue (message queue) ---\n"
+ etp-sigq-int ($arg0)->sig_qs.first ($arg0)->sig_qs.save ($arg0)->sig_qs.saved_last
+ printf " --- Middle signal queue ---\n"
+ etp-sigq-int ($arg0)->sig_qs.cont ($arg0)->sig_qs.save ($arg0)->sig_qs.saved_last
+ printf " --- Outer queue ---\n"
+ etp-sigq-int ($arg0)->sig_inq.first ($arg0)->sig_qs.save ($arg0)->sig_qs.saved_last
+end
+
define etp-msgq
# Args: ErlMessageQueue*
#
@@ -1937,7 +2073,7 @@ document etp-proc-flags
%---------------------------------------------------------------------------
end
-define etp-process-info
+define etp-process-info-int
# Args: Process*
#
printf " Pid: "
@@ -2000,6 +2136,17 @@ define etp-process-info
etp-1 ((Eterm)($etp_proc->parent))
printf "\n Pointer: (Process *) %p\n", $etp_proc
end
+ if ($arg1)
+ etp-sigqs $etp_proc
+ end
+end
+
+define etp-process-info
+ etp-process-info-int ($arg0) 0
+end
+
+define etp-process-info-x
+ etp-process-info-int ($arg0) !0
end
document etp-process-info
@@ -2010,7 +2157,7 @@ document etp-process-info
%---------------------------------------------------------------------------
end
-define etp-processes
+define etp-processes-int
if (!erts_initialized)
printf "No processes, since system isn't initialized!\n"
else
@@ -2026,7 +2173,7 @@ define etp-processes
if ($proc != ((Process *) 0) && $proc != $invalid_proc)
printf "---\n"
printf " Pix: %d\n", $proc_ix
- etp-process-info $proc
+ etp-process-info-int $proc ($arg0)
set $proc_cnt--
end
if $proc_ix == $proc_printile
@@ -2039,6 +2186,14 @@ define etp-processes
end
end
+define etp-processes
+ etp-processes-int 0
+end
+
+define etp-processes-x
+ etp-processes-int !0
+end
+
document etp-processes
%---------------------------------------------------------------------------
% etp-processes
diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam
index 10545086b5..495d306a23 100644
--- a/erts/preloaded/ebin/erl_prim_loader.beam
+++ b/erts/preloaded/ebin/erl_prim_loader.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index d3fbc8eb61..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/ebin/init.beam b/erts/preloaded/ebin/init.beam
index 0473eda5fb..1b458fc5da 100644
--- a/erts/preloaded/ebin/init.beam
+++ b/erts/preloaded/ebin/init.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam
index d1b3f5dca4..b11e428229 100644
--- a/erts/preloaded/ebin/prim_file.beam
+++ b/erts/preloaded/ebin/prim_file.beam
Binary files differ
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index 53e90a4f2d..3a42e841e2 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -135,7 +135,7 @@
-export([insert_element/3]).
-export([integer_to_binary/1, integer_to_list/1]).
-export([iolist_size/1, iolist_to_binary/1, iolist_to_iovec/1]).
--export([is_alive/0, is_builtin/3, is_process_alive/1, length/1, link/1]).
+-export([is_alive/0, is_builtin/3, is_map_key/2, is_process_alive/1, length/1, link/1]).
-export([list_to_atom/1, list_to_binary/1]).
-export([list_to_bitstring/1, list_to_existing_atom/1, list_to_float/1]).
-export([list_to_integer/1, list_to_integer/2]).
@@ -1121,6 +1121,13 @@ is_alive() ->
is_builtin(_Module, _Function, _Arity) ->
erlang:nif_error(undefined).
+%% Shadowed by erl_bif_types: erlang:is_map_key/2
+-spec is_map_key(Key, Map) -> boolean() when
+ Key :: term(),
+ Map :: map().
+is_map_key(_,_) ->
+ erlang:nif_error(undef).
+
%% is_process_alive/1
-spec is_process_alive(Pid) -> boolean() when
Pid :: pid().
@@ -1514,8 +1521,21 @@ pre_loaded() ->
-spec erlang:process_display(Pid, Type) -> true when
Pid :: pid(),
Type :: backtrace.
-process_display(_Pid, _Type) ->
- erlang:nif_error(undefined).
+process_display(Pid, Type) ->
+ case case erts_internal:process_display(Pid, Type) of
+ Ref when erlang:is_reference(Ref) ->
+ receive
+ {Ref, Res} ->
+ Res
+ end;
+ Res ->
+ Res
+ end of
+ badarg ->
+ erlang:error(badarg, [Pid, Type]);
+ Result ->
+ Result
+ end.
%% process_flag/3
-spec process_flag(Pid, Flag, Value) -> OldValue when
@@ -1523,8 +1543,15 @@ process_display(_Pid, _Type) ->
Flag :: save_calls,
Value :: non_neg_integer(),
OldValue :: non_neg_integer().
-process_flag(_Pid, _Flag, _Value) ->
- erlang:nif_error(undefined).
+process_flag(Pid, Flag, Value) ->
+ case case erts_internal:process_flag(Pid, Flag, Value) of
+ Ref when erlang:is_reference(Ref) ->
+ receive {Ref, Res} -> Res end;
+ Res -> Res
+ end of
+ badarg -> erlang:error(badarg, [Pid, Flag, Value]);
+ Result -> Result
+ end.
%% process_info/1
-spec process_info(Pid) -> Info when
@@ -1678,12 +1705,26 @@ setnode(_P1, _P2) ->
erlang:nif_error(undefined).
%% setnode/3
--spec erlang:setnode(P1, P2, P3) -> dist_handle() when
- P1 :: atom(),
- P2 :: port(),
- P3 :: {term(), term(), term(), term()}.
-setnode(_P1, _P2, _P3) ->
- erlang:nif_error(undefined).
+-spec erlang:setnode(Node, DistCtrlr, Opts) -> dist_handle() when
+ Node :: atom(),
+ DistCtrlr :: port() | pid(),
+ Opts :: {integer(), integer(), atom(), atom()}.
+setnode(Node, DistCtrlr, {Flags, Ver, IC, OC} = Opts) when erlang:is_atom(IC),
+ erlang:is_atom(OC) ->
+ case case erts_internal:create_dist_channel(Node, DistCtrlr,
+ Flags, Ver) of
+ {ok, DH} -> DH;
+ {message, Ref} -> receive {Ref, Res} -> Res end;
+ Err -> Err
+ end of
+ Error when erlang:is_atom(Error) ->
+ erlang:error(Error, [Node, DistCtrlr, Opts]);
+ DHandle ->
+ DHandle
+ end;
+setnode(Node, DistCtrlr, Opts) ->
+ erlang:error(badarg, [Node, DistCtrlr, Opts]).
+
%% size/1
%% Shadowed by erl_bif_types: erlang:size/1
@@ -1742,9 +1783,32 @@ start_timer(_Time, _Dest, _Msg, _Options) ->
-spec erlang:suspend_process(Suspendee, OptList) -> boolean() when
Suspendee :: pid(),
OptList :: [Opt],
- Opt :: unless_suspending | asynchronous.
-suspend_process(_Suspendee, _OptList) ->
- erlang:nif_error(undefined).
+ Opt :: unless_suspending | asynchronous | {asynchronous, term()}.
+suspend_process(Suspendee, OptList) ->
+ case case erts_internal:suspend_process(Suspendee, OptList) of
+ Ref when erlang:is_reference(Ref) ->
+ receive {Ref, Res} -> Res end;
+ Res ->
+ Res
+ end of
+ true -> true;
+ false -> false;
+ Error -> erlang:error(Error, [Suspendee, OptList])
+ end.
+
+-spec erlang:suspend_process(Suspendee) -> 'true' when
+ Suspendee :: pid().
+suspend_process(Suspendee) ->
+ case case erts_internal:suspend_process(Suspendee, []) of
+ Ref when erlang:is_reference(Ref) ->
+ receive {Ref, Res} -> Res end;
+ Res ->
+ Res
+ end of
+ true -> true;
+ false -> erlang:error(internal_error, [Suspendee]);
+ Error -> erlang:error(Error, [Suspendee])
+ end.
%% system_monitor/0
-spec erlang:system_monitor() -> MonSettings when
@@ -3038,15 +3102,6 @@ send_nosuspend(Pid, Msg, Opts) ->
localtime_to_universaltime(Localtime) ->
erlang:localtime_to_universaltime(Localtime, undefined).
--spec erlang:suspend_process(Suspendee) -> 'true' when
- Suspendee :: pid().
-suspend_process(P) ->
- case catch erlang:suspend_process(P, []) of
- {'EXIT', {Reason, _}} -> erlang:error(Reason, [P]);
- {'EXIT', Reason} -> erlang:error(Reason, [P]);
- Res -> Res
- end.
-
%%
%% Port BIFs
%%
diff --git a/erts/preloaded/src/erts_dirty_process_signal_handler.erl b/erts/preloaded/src/erts_dirty_process_signal_handler.erl
index ab71790b9d..381f81ef14 100644
--- a/erts/preloaded/src/erts_dirty_process_signal_handler.erl
+++ b/erts/preloaded/src/erts_dirty_process_signal_handler.erl
@@ -50,10 +50,12 @@ handle_request(Pid) when is_pid(Pid) ->
handle_incoming_signals(Pid, 0);
handle_request({Requester, Target, Prio,
{SysTaskOp, ReqId, Arg} = Op} = Request) ->
- case handle_sys_task(Requester, Target, SysTaskOp, ReqId, Arg) of
- true ->
+ case handle_sys_task(Requester, Target, SysTaskOp, ReqId, Arg, 0) of
+ done ->
ok;
- false ->
+ busy ->
+ self() ! Request;
+ normal ->
%% Target has stopped executing dirty since the
%% initial request was made. Dispatch the
%% request to target and let it handle it itself...
@@ -83,15 +85,19 @@ handle_incoming_signals(Pid, N) ->
_Res -> ok
end.
-handle_sys_task(Requester, Target, check_process_code, ReqId, Module) ->
- case erts_internal:is_process_executing_dirty(Target) of
- false ->
- false;
- true ->
- _ = check_process(Requester, Target, ReqId, Module),
- true
+handle_sys_task(Requester, Target, check_process_code, ReqId, Module, N) ->
+ case erts_internal:check_dirty_process_code(Target, Module) of
+ Bool when Bool == true; Bool == false ->
+ Requester ! {check_process_code, ReqId, Bool},
+ done;
+ busy ->
+ case N > 5 of
+ true ->
+ busy;
+ false ->
+ handle_sys_task(Requester, Target, check_process_code,
+ ReqId, Module, N+1)
+ end;
+ Res ->
+ Res
end.
-
-check_process(Requester, Target, ReqId, Module) ->
- Result = erts_internal:check_dirty_process_code(Target, Module),
- Requester ! {check_process_code, ReqId, Result}.
diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl
index 79169b7d23..88f47e917b 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -82,6 +82,14 @@
-export([gather_alloc_histograms/1, gather_carrier_info/1]).
+-export([suspend_process/2]).
+
+-export([process_display/2]).
+
+-export([process_flag/3]).
+
+-export([create_dist_channel/4]).
+
%%
%% Await result of send to port
%%
@@ -303,7 +311,8 @@ get_cpc_opts([{allow_gc, AllowGC} | Options], Async) when AllowGC == true;
get_cpc_opts([], Async) ->
Async.
--spec check_dirty_process_code(Pid,Module) -> 'true' | 'false' when
+-spec check_dirty_process_code(Pid, Module) -> Result when
+ Result :: boolean() | 'normal' | 'busy',
Pid :: pid(),
Module :: module().
check_dirty_process_code(_Pid,_Module) ->
@@ -644,3 +653,41 @@ gather_alloc_histograms(_) ->
gather_carrier_info(_) ->
erlang:nif_error(undef).
+
+-spec suspend_process(Suspendee, OptList) -> Result when
+ Result :: boolean() | 'badarg' | reference(),
+ Suspendee :: pid(),
+ OptList :: [Opt],
+ Opt :: unless_suspending | asynchronous | {asynchronous, term()}.
+
+suspend_process(_Suspendee, _OptList) ->
+ erlang:nif_error(undefined).
+
+%% process_display/2
+-spec process_display(Pid, Type) -> 'true' | 'badarg' | reference() when
+ Pid :: pid(),
+ Type :: backtrace.
+process_display(_Pid, _Type) ->
+ erlang:nif_error(undefined).
+
+%% process_flag/3
+-spec process_flag(Pid, Flag, Value) -> OldValue | 'badarg' | reference() when
+ Pid :: pid(),
+ Flag :: save_calls,
+ Value :: non_neg_integer(),
+ OldValue :: non_neg_integer().
+process_flag(_Pid, _Flag, _Value) ->
+ erlang:nif_error(undefined).
+
+-spec create_dist_channel(Node, DistCtrlr, Flags, Ver) -> Result when
+ Node :: atom(),
+ DistCtrlr :: port() | pid(),
+ Flags :: integer(),
+ Ver :: integer(),
+ Result :: {'ok', erlang:dist_handle()}
+ | {'message', reference()}
+ | 'badarg'
+ | 'system_limit'.
+
+create_dist_channel(_Node, _DistCtrlr, _Flags, _Ver) ->
+ erlang:nif_error(undefined).
diff --git a/erts/test/erlc_SUITE.erl b/erts/test/erlc_SUITE.erl
index 394ecc8964..622c4ec06b 100644
--- a/erts/test/erlc_SUITE.erl
+++ b/erts/test/erlc_SUITE.erl
@@ -505,7 +505,7 @@ run_command(Dir, {win32, _}, Cmd) ->
{BatchFile,
Run,
["@echo off\r\n",
- "set ERLC_EMULATOR=", atom_to_list(lib:progname()), "\r\n",
+ "set ERLC_EMULATOR=", ct:get_progname(), "\r\n",
Cmd, "\r\n",
"if errorlevel 1 echo _ERROR_\r\n",
"if not errorlevel 1 echo _OK_\r\n"]};
@@ -514,7 +514,7 @@ run_command(Dir, {unix, _}, Cmd) ->
{Name,
"/bin/sh " ++ Name,
["#!/bin/sh\n",
- "ERLC_EMULATOR='", atom_to_list(lib:progname()), "'\n",
+ "ERLC_EMULATOR='", ct:get_progname(), "'\n",
"export ERLC_EMULATOR\n",
Cmd, "\n",
"case $? in\n",
diff --git a/lib/common_test/doc/src/ct.xml b/lib/common_test/doc/src/ct.xml
index afd8741cd1..3d35ae4f54 100644
--- a/lib/common_test/doc/src/ct.xml
+++ b/lib/common_test/doc/src/ct.xml
@@ -572,6 +572,16 @@
</func>
<func>
+ <name>get_progname() -&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/Makefile b/lib/common_test/src/Makefile
index 2a2a9cb5bc..9adcf2f13b 100644
--- a/lib/common_test/src/Makefile
+++ b/lib/common_test/src/Makefile
@@ -166,4 +166,4 @@ release_tests_spec: opt
release_docs_spec: docs
# Include dependencies -- list below added by Kostis Sagonas
-$(EBIN)/cth_log_redirect.beam: ../../kernel/include/logger.hrl
+$(EBIN)/cth_log_redirect.beam: ../../kernel/include/logger.hrl ../../kernel/src/logger_internal.hrl
diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl
index fd7fa07b81..14a9ec07cf 100644
--- a/lib/common_test/src/ct.erl
+++ b/lib/common_test/src/ct.erl
@@ -87,6 +87,7 @@
decrypt_config_file/2, decrypt_config_file/3]).
-export([get_target_name/1]).
+-export([get_progname/0]).
-export([parse_table/1, listenv/1]).
-export([remaining_test_procs/0]).
@@ -975,7 +976,20 @@ make_priv_dir() ->
%%% belongs to.
get_target_name(Handle) ->
ct_util:get_target_name(Handle).
-
+
+%%%-----------------------------------------------------------------
+%%% @doc Return the command used to start (this) erlang
+
+-spec get_progname() -> string().
+
+get_progname() ->
+ case init:get_argument(progname) of
+ {ok, [[Prog]]} ->
+ Prog;
+ _Other ->
+ "no_prog_name"
+ end.
+
%%%-----------------------------------------------------------------
%%% @spec parse_table(Data) -> {Heading,Table}
%%% Data = [string()]
@@ -1006,7 +1020,6 @@ parse_table(Data) ->
listenv(Telnet) ->
ct_util:listenv(Telnet).
-
%%%-----------------------------------------------------------------
%%% @spec testcases(TestDir, Suite) -> Testcases | {error,Reason}
%%% TestDir = string()
diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl
index 1ae6c8c7c7..67645cac08 100644
--- a/lib/common_test/src/test_server_ctrl.erl
+++ b/lib/common_test/src/test_server_ctrl.erl
@@ -4382,7 +4382,7 @@ do_format_exception(Reason={Error,Stack}) ->
PF = fun(Term, I) ->
io_lib:format("~." ++ integer_to_list(I) ++ "tp", [Term])
end,
- case catch lib:format_exception(1, error, Error, Stack, StackFun, PF, utf8) of
+ case catch erl_error:format_exception(1, error, Error, Stack, StackFun, PF, utf8) of
{'EXIT',_R} ->
{"~tp",Reason};
Formatted ->
diff --git a/lib/common_test/src/test_server_node.erl b/lib/common_test/src/test_server_node.erl
index b2d4f199c3..76588e6887 100644
--- a/lib/common_test/src/test_server_node.erl
+++ b/lib/common_test/src/test_server_node.erl
@@ -591,7 +591,7 @@ cast_to_list(X) -> lists:flatten(io_lib:format("~tw", [X])).
%%% this
%%%
pick_erl_program(default) ->
- cast_to_list(lib:progname());
+ ct:get_progname();
pick_erl_program(L) ->
P = random_element(L),
case P of
@@ -600,7 +600,7 @@ pick_erl_program(L) ->
{release, S} ->
find_release(S);
this ->
- cast_to_list(lib:progname())
+ ct:get_progname()
end.
%% This is an attempt to distinguish between spaces in the program
@@ -611,8 +611,8 @@ pick_erl_program(L) ->
%% ({prog,String}) or if the -program switch to beam is used and
%% includes arguments (typically done by cerl in OTP test environment
%% in order to ensure that slave/peer nodes are started with the same
-%% emulator and flags as the test node. The return from lib:progname()
-%% could then typically be '/<full_path_to>/cerl -gcov').
+%% emulator and flags as the test node. The return from ct:get_progname()
+%% could then typically be "/<full_path_to>/cerl -gcov").
quote_progname(Progname) ->
do_quote_progname(string:lexemes(Progname," ")).
diff --git a/lib/common_test/test_server/ts_erl_config.erl b/lib/common_test/test_server/ts_erl_config.erl
index c7fe4ccf83..e37fa844bb 100644
--- a/lib/common_test/test_server/ts_erl_config.erl
+++ b/lib/common_test/test_server/ts_erl_config.erl
@@ -358,7 +358,15 @@ link_library(_LibName,_Other) ->
%% Returns emulator specific variables.
emu_vars(Vars) ->
[{is_source_build, is_source_build()},
- {erl_name, atom_to_list(lib:progname())}|Vars].
+ {erl_name, get_progname()}|Vars].
+
+get_progname() ->
+ case init:get_argument(progname) of
+ {ok, [[Prog]]} ->
+ Prog;
+ _Other ->
+ "no_prog_name"
+ end.
is_source_build() ->
string:find(erlang:system_info(system_version), "source") =/= nomatch.
diff --git a/lib/common_test/test_server/ts_run.erl b/lib/common_test/test_server/ts_run.erl
index 3f594236bc..5dbbaca916 100644
--- a/lib/common_test/test_server/ts_run.erl
+++ b/lib/common_test/test_server/ts_run.erl
@@ -199,7 +199,7 @@ make_command(Vars, Spec, State) ->
TestPath = filename:nativename(TestDir),
Erl = case os:getenv("TS_RUN_VALGRIND") of
false ->
- atom_to_list(lib:progname());
+ ct:get_progname();
_ ->
case State#state.file of
Dir when is_list(Dir) ->
diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl
index dbbaae05eb..762c7bdf9e 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -392,6 +392,26 @@ backward([{bif,'or',{f,To0},[Dst,{atom,false}],Dst}=I|Is], D,
_ ->
backward(Is, D, [I|Acc])
end;
+backward([{bif,map_get,{f,FF},[Key,Map],_}=I0,
+ {test,has_map_fields,{f,FT}=F,[Map|Keys0]}=I1|Is], D, Acc) when FF =/= 0 ->
+ case shortcut_label(FF, D) of
+ FT ->
+ case lists:delete(Key, Keys0) of
+ [] ->
+ backward([I0|Is], D, Acc);
+ Keys ->
+ Test = {test,has_map_fields,F,[Map|Keys]},
+ backward([Test|Is], D, [I0|Acc])
+ end;
+ _ ->
+ backward([I1|Is], D, [I0|Acc])
+ end;
+backward([{bif,map_get,{f,FF},[_,Map],_}=I0,
+ {test,is_map,{f,FT},[Map]}=I1|Is], D, Acc) when FF =/= 0 ->
+ case shortcut_label(FF, D) of
+ FT -> backward([I0|Is], D, Acc);
+ _ -> backward([I1|Is], D, [I0|Acc])
+ end;
backward([I|Is], D, Acc) ->
backward(Is, D, [I|Acc]);
backward([], _D, Acc) -> Acc.
diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl
index eb3192fe8f..920fb00397 100644
--- a/lib/compiler/src/beam_peep.erl
+++ b/lib/compiler/src/beam_peep.erl
@@ -77,6 +77,12 @@ peep([{bif,tuple_size,_,[_]=Ops,Dst}=I|Is], SeenTests0, Acc) ->
%% Kill all remembered tests that depend on the destination register.
SeenTests = kill_seen(Dst, SeenTests1),
peep(Is, SeenTests, [I|Acc]);
+peep([{bif,map_get,_,[Key,Map],Dst}=I|Is], SeenTests0, Acc) ->
+ %% Pretend that we have seen {test,has_map_fields,_,[Map,Key]}
+ SeenTests1 = gb_sets:add({has_map_fields,[Map,Key]}, SeenTests0),
+ %% Kill all remembered tests that depend on the destination register.
+ SeenTests = kill_seen(Dst, SeenTests1),
+ peep(Is, SeenTests, [I|Acc]);
peep([{bif,_,_,_,Dst}=I|Is], SeenTests0, Acc) ->
%% Kill all remembered tests that depend on the destination register.
SeenTests = kill_seen(Dst, SeenTests0),
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index 28f36db399..12da8c9446 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -462,6 +462,9 @@ update({set,[D],[Index,Reg],{bif,element,_}}, Ts0) ->
end,
Ts = tdb_meet(Reg, {tuple,min_size,MinSize,[]}, Ts0),
tdb_store(D, any, Ts);
+update({set,[D],[_Key,Map],{bif,map_get,_}}, Ts0) ->
+ Ts = tdb_meet(Map, map, Ts0),
+ tdb_store(D, any, Ts);
update({set,[D],Args,{bif,N,_}}, Ts) ->
Ar = length(Args),
BoolOp = erl_internal:new_type_test(N, Ar) orelse
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index c7a129b42c..533c984221 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -351,10 +351,9 @@ mapfold(F, S0, T) ->
mapfold(fun(T0, A) -> {T0, A} end, F, S0, T).
-%% @spec mapfold(Pre, Post, Initial::term(), Tree::cerl()) ->
-%% {cerl(), term()}
-%%
-%% Pre = Post = (cerl(), term()) -> {cerl(), term()}
+%% @spec mapfold(Pre, Post, Initial::term(), Tree::cerl()) -> {cerl(), term()}
+%% Pre = (cerl(), term()) -> {cerl(), term()}
+%% Post = (cerl(), term()) -> {cerl(), term()}
%%
%% @doc Does a combined map/fold operation on the nodes of the
%% tree. It begins by calling <code>Pre</code> on the tree, using the
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index c6a0056a70..a37b2064b2 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -295,7 +295,7 @@ format_error_reason({Reason, Stack}) when is_list(Stack) ->
end,
FormatFun = fun (Term, _) -> io_lib:format("~tp", [Term]) end,
[io_lib:format("~tp", [Reason]),"\n\n",
- lib:format_stacktrace(1, Stack, StackFun, FormatFun)];
+ erl_error:format_stacktrace(1, Stack, StackFun, FormatFun)];
format_error_reason(Reason) ->
io_lib:format("~tp", [Reason]).
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index 70b36f029e..a7452aebc8 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -94,6 +94,7 @@ is_pure(erlang, is_function, 1) -> true;
is_pure(erlang, is_integer, 1) -> true;
is_pure(erlang, is_list, 1) -> true;
is_pure(erlang, is_map, 1) -> true;
+is_pure(erlang, is_map_key, 2) -> true;
is_pure(erlang, is_number, 1) -> true;
is_pure(erlang, is_pid, 1) -> true;
is_pure(erlang, is_port, 1) -> true;
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 8e73b613a0..9652a8476d 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -589,6 +589,7 @@ is_gc_bif(element, 2) -> false;
is_gc_bif(get, 1) -> false;
is_gc_bif(tuple_size, 1) -> false;
is_gc_bif(map_get, 2) -> false;
+is_gc_bif(is_map_key, 2) -> false;
is_gc_bif(Bif, Arity) ->
not (erl_internal:bool_op(Bif, Arity) orelse
erl_internal:new_type_test(Bif, Arity) orelse
@@ -1620,6 +1621,11 @@ test_cg(is_boolean, [#k_atom{val=Val}], Fail, I, Vdb, Bef, St) ->
false -> [{jump,{f,Fail}}]
end,
{Is,Aft,St};
+test_cg(is_map_key, As, Fail, I, Vdb, Bef, St) ->
+ [Key,Map] = cg_reg_args(As, Bef),
+ Aft = clear_dead(Bef, I, Vdb),
+ F = {f,Fail},
+ {[{test,is_map,F,[Map]},{test,has_map_fields,F,Map,{list,[Key]}}],Aft,St};
test_cg(Test, As, Fail, I, Vdb, Bef, St) ->
Args = cg_reg_args(As, Bef),
Aft = clear_dead(Bef, I, Vdb),
diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl
index e98c295da6..6badc7a8b8 100644
--- a/lib/compiler/test/map_SUITE.erl
+++ b/lib/compiler/test/map_SUITE.erl
@@ -1203,12 +1203,18 @@ t_guard_bifs(Config) when is_list(Config) ->
true = map_guard_empty_2(),
true = map_guard_head(#{a=>1}),
false = map_guard_head([]),
+ true = map_get_head(#{a=>1}),
+ false = map_get_head([]),
+ true = map_is_key_head(#{a=>1}),
+ false = map_is_key_head(#{}),
true = map_guard_body(#{a=>1}),
false = map_guard_body({}),
true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }),
false = map_guard_pattern("list"),
true = map_guard_tautology(),
true = map_guard_ill_map_size(),
+ true = map_field_check_sequence(#{a=>1}),
+ false = map_field_check_sequence(#{}),
ok.
map_guard_empty() when is_map(#{}); false -> true.
@@ -1218,6 +1224,12 @@ map_guard_empty_2() when true; #{} andalso false -> true.
map_guard_head(M) when is_map(M) -> true;
map_guard_head(_) -> false.
+map_get_head(M) when map_get(a, M) =:= 1 -> true;
+map_get_head(_) -> false.
+
+map_is_key_head(M) when is_map_key(a, M) -> true;
+map_is_key_head(M) -> false.
+
map_guard_body(M) -> is_map(M).
map_guard_pattern(#{}) -> true;
@@ -1227,6 +1239,12 @@ map_guard_tautology() when #{} =:= #{}; true -> true.
map_guard_ill_map_size() when true; map_size(0) -> true.
+map_field_check_sequence(M)
+ when is_map(M) andalso is_map_key(a, M) andalso (map_get(a, M) == 1) ->
+ true;
+map_field_check_sequence(_) ->
+ false.
+
t_guard_sequence(Config) when is_list(Config) ->
{1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}),
{2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}),
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index dbb6bf8135..df4e2245f4 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -60,7 +60,6 @@
#include <openssl/rand.h>
#include <openssl/evp.h>
#include <openssl/hmac.h>
-#include <openssl/engine.h>
#include <openssl/err.h>
/* Helper macro to construct a OPENSSL_VERSION_NUMBER.
@@ -102,8 +101,10 @@
# undef FIPS_SUPPORT
# endif
+# if LIBRESSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(2,7,0)
/* LibreSSL wants the 1.0.1 API */
# define NEED_EVP_COMPATIBILITY_FUNCTIONS
+# endif
#endif
@@ -112,8 +113,10 @@
#endif
-#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
-# define HAS_EVP_PKEY_CTX
+#ifndef HAS_LIBRESSL
+# if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
+# define HAS_EVP_PKEY_CTX
+# endif
#endif
@@ -121,10 +124,6 @@
#include <openssl/modes.h>
#endif
-#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,8,'h')
-#define HAS_ENGINE_SUPPORT
-#endif
-
#include "crypto_callback.h"
#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(0,9,8) \
@@ -185,6 +184,19 @@
# undef HAVE_RSA_SSLV23_PADDING
#endif
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,8,'h') \
+ && defined(HAVE_EC)
+/* If OPENSSL_NO_EC is set, there will be an error in ec.h included from engine.h
+ So if EC is disabled, you can't use Engine either....
+*/
+# define HAS_ENGINE_SUPPORT
+#endif
+
+
+#if defined(HAS_ENGINE_SUPPORT)
+# include <openssl/engine.h>
+#endif
+
#if defined(HAVE_CMAC)
#include <openssl/cmac.h>
#endif
@@ -500,7 +512,6 @@ static ERL_NIF_TERM aes_gcm_decrypt_NO_EVP(ErlNifEnv* env, int argc, const ERL_N
static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, char **cmds, int i);
static ERL_NIF_TERM engine_by_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM engine_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM engine_finish_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -528,6 +539,7 @@ static int term2point(ErlNifEnv* env, ERL_NIF_TERM term,
static ERL_NIF_TERM bin_from_bn(ErlNifEnv* env, const BIGNUM *bn);
#ifdef HAS_ENGINE_SUPPORT
+static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, char **cmds, int i);
static int zero_terminate(ErlNifBinary bin, char **buf);
#endif
@@ -5407,9 +5419,9 @@ static ERL_NIF_TERM engine_get_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE
#endif
}
+#ifdef HAS_ENGINE_SUPPORT
static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, char **cmds, int i)
{
-#ifdef HAS_ENGINE_SUPPORT
ERL_NIF_TERM head, tail;
const ERL_NIF_TERM *tmp_tuple;
ErlNifBinary tmpbin;
@@ -5454,10 +5466,8 @@ static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, cha
cmds[i] = NULL;
return 0;
}
-#else
- return atom_notsup;
-#endif
}
+#endif
static ERL_NIF_TERM engine_get_all_methods_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* () */
diff --git a/lib/crypto/c_src/otp_test_engine.c b/lib/crypto/c_src/otp_test_engine.c
index 5c6122c06a..d0e23a2a3e 100644
--- a/lib/crypto/c_src/otp_test_engine.c
+++ b/lib/crypto/c_src/otp_test_engine.c
@@ -24,10 +24,8 @@
#include <stdio.h>
#include <string.h>
-#include <openssl/engine.h>
#include <openssl/md5.h>
#include <openssl/rsa.h>
-#include <openssl/pem.h>
#define PACKED_OPENSSL_VERSION(MAJ, MIN, FIX, P) \
((((((((MAJ << 8) | MIN) << 8 ) | FIX) << 8) | (P-'a'+1)) << 4) | 0xf)
@@ -40,6 +38,21 @@
#define OLD
#endif
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,8,'o') \
+ && !defined(OPENSSL_NO_EC) \
+ && !defined(OPENSSL_NO_ECDH) \
+ && !defined(OPENSSL_NO_ECDSA)
+# define HAVE_EC
+#endif
+
+#if defined(HAVE_EC)
+/* If OPENSSL_NO_EC is set, there will be an error in ec.h included from engine.h
+ So if EC is disabled, you can't use Engine either....
+*/
+#include <openssl/engine.h>
+#include <openssl/pem.h>
+
+
static const char *test_engine_id = "MD5";
static const char *test_engine_name = "MD5 test engine";
@@ -262,3 +275,5 @@ int pem_passwd_cb_fun(char *buf, int size, int rwflag, void *password)
return 0;
}
}
+
+#endif
diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml
index 1f788a4e35..66619c9e11 100644
--- a/lib/crypto/doc/src/notes.xml
+++ b/lib/crypto/doc/src/notes.xml
@@ -31,6 +31,28 @@
</header>
<p>This document describes the changes made to the Crypto application.</p>
+<section><title>Crypto 4.2.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ If OPENSSL_NO_EC was set, the compilation of the crypto
+ nifs failed.</p>
+ <p>
+ Own Id: OTP-15073</p>
+ </item>
+ <item>
+ <p>
+ C-compile errors for LibreSSL 2.7.0 - 2.7.2 fixed</p>
+ <p>
+ Own Id: OTP-15074 Aux Id: ERL-618 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Crypto 4.2.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk
index 3432f00836..778aff9d13 100644
--- a/lib/crypto/vsn.mk
+++ b/lib/crypto/vsn.mk
@@ -1 +1 @@
-CRYPTO_VSN = 4.2.1
+CRYPTO_VSN = 4.2.2
diff --git a/lib/debugger/src/dbg_icmd.erl b/lib/debugger/src/dbg_icmd.erl
index 4cd3dce670..55cbada53b 100644
--- a/lib/debugger/src/dbg_icmd.erl
+++ b/lib/debugger/src/dbg_icmd.erl
@@ -467,7 +467,7 @@ mark_break(Cm, LineNo, Le) ->
parse_cmd(Cmd, LineNo) ->
{ok,Tokens,_} = erl_scan:string(Cmd, LineNo, [text]),
- {ok,Forms,Bs} = lib:extended_parse_exprs(Tokens),
+ {ok,Forms,Bs} = erl_eval:extended_parse_exprs(Tokens),
{Forms, Bs}.
%%====================================================================
diff --git a/lib/debugger/src/dbg_wx_win.erl b/lib/debugger/src/dbg_wx_win.erl
index f1298154ab..fea94156c1 100644
--- a/lib/debugger/src/dbg_wx_win.erl
+++ b/lib/debugger/src/dbg_wx_win.erl
@@ -275,7 +275,7 @@ entry(Parent, Title, Prompt, {Type, Value}) ->
verify(Type, Str) ->
case erl_scan:string(Str, 1, [text]) of
{ok, Tokens, _EndLine} when Type==term ->
- case lib:extended_parse_term(Tokens++[{dot, erl_anno:new(1)}]) of
+ case erl_eval:extended_parse_term(Tokens++[{dot, erl_anno:new(1)}]) of
{ok, Value} -> {edit, Value};
_Error ->
ignore
diff --git a/lib/dialyzer/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/edoc/src/edoc_doclet.erl b/lib/edoc/src/edoc_doclet.erl
index f55cffe158..6cb3095507 100644
--- a/lib/edoc/src/edoc_doclet.erl
+++ b/lib/edoc/src/edoc_doclet.erl
@@ -40,7 +40,7 @@
-import(edoc_report, [report/2, warning/2]).
-%% @headerfile "edoc_doclet.hrl"
+%% @headerfile "../include/edoc_doclet.hrl"
-include("../include/edoc_doclet.hrl").
-define(EDOC_APP, edoc).
diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
index fe6ab0659c..48ce641ab9 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -665,6 +665,8 @@ type(erlang, is_map, 1, Xs, Opaques) ->
check_guard(X, fun (Y) -> t_is_map(Y, Opaques) end,
t_map(), Opaques) end,
strict(erlang, is_map, 1, Xs, Fun, Opaques);
+type(erlang, is_map_key, 2, Xs, Opaques) ->
+ type(maps, is_key, 2, Xs, Opaques);
type(erlang, is_number, 1, Xs, Opaques) ->
Fun = fun (X) ->
check_guard(X, fun (Y) -> t_is_number(Y, Opaques) end,
@@ -2374,6 +2376,8 @@ arg_types(erlang, is_list, 1) ->
[t_any()];
arg_types(erlang, is_map, 1) ->
[t_any()];
+arg_types(erlang, is_map_key, 2) ->
+ [t_any(), t_map()];
arg_types(erlang, is_number, 1) ->
[t_any()];
arg_types(erlang, is_pid, 1) ->
@@ -2396,7 +2400,7 @@ arg_types(erlang, map_size, 1) ->
[t_map()];
%% Guard bif, needs to be here.
arg_types(erlang, map_get, 2) ->
- [t_map(), t_any()];
+ [t_any(), t_map()];
arg_types(erlang, make_fun, 3) ->
[t_atom(), t_atom(), t_arity()];
arg_types(erlang, make_tuple, 2) ->
diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl
index 97814fe217..5e6a60326d 100644
--- a/lib/hipe/main/hipe.erl
+++ b/lib/hipe/main/hipe.erl
@@ -852,8 +852,8 @@ finalize_fun_sequential({MFA, Icode}, Opts, Servers) ->
print_crash_message(What, Error, StackTrace) ->
StackFun = fun(_,_,_) -> false end,
FormatFun = fun (Term, _) -> io_lib:format("~p", [Term]) end,
- StackTrace = lib:format_stacktrace(1, StackTrace,
- StackFun, FormatFun),
+ StackTrace = erl_error:format_stacktrace(1, StackTrace,
+ StackFun, FormatFun),
WhatS = case What of
{M,F,A} -> io_lib:format("~w:~w/~w", [M,F,A]);
Mod -> io_lib:format("~w", [Mod])
diff --git a/lib/hipe/opt/hipe_schedule.erl b/lib/hipe/opt/hipe_schedule.erl
deleted file mode 100644
index 0f25940e3d..0000000000
--- a/lib/hipe/opt/hipe_schedule.erl
+++ /dev/null
@@ -1,1483 +0,0 @@
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% INSTRUCTION SCHEDULER
-%%
-%% This is a basic ILP cycle scheduler:
-%% * set cycle = 0
-%% * while ready[cycle] nonempty do
-%% - take x with greatest priority from ready[cycle]
-%% - try to schedule x;
-%% * if scheduling x was possible,
-%% - reserve resources
-%% - add x to schedule and delete x from dag
-%% - update earliest-time for all successor nodes
-%% as max[earliest[y],cycle+latency[x]]
-%% - if some node y now has no predecessors,
-%% add y to ready[earliest[y]]
-%% * if it was impossible, put x in ready[cycle+1]
-%% (= try again)
-%%
-%% We use the following data structures:
-%% 1. all nodes are numbered and indices used as array keys
-%% 2. priority per node can be computed statically or dynamically
-%% * statically: before scheduling, each node gets a priority value
-%% * dynamically: at each cycle, compute priorities for all ready nodes
-%% 3. earliest: earliest cycle of issue, starts at 0
-%% and is updated as predecessors issue
-%% 4. predecessors: number of predecessors (0 = ready to issue)
-%% 5. successors: list of {Latency,NodeID}
-%% 6. ready: an array indexed by cycle-time (integer), where
-%% ready nodes are kept.
-%% 7. resources: a resource representation (ADT) that answers
-%% certain queries, e.g., "can x be scheduled this cycle"
-%% and "reserve resources for x".
-%% 8. schedule: list of scheduled instructions {Instr,Cycle}
-%% in the order of issue
-%% 9. instructions: maps IDs back to instructions
-%%
-%% Inputs:
-%% - a list of {ID,Node} pairs (where ID is a unique key)
-%% - a dependence list {ID0,Latency,ID1}, which is used to
-%% build the DAG.
-%%
-%% Note that there is some leeway in how things are represented
-%% from here.
-%%
-%% MODIFICATIONS:
-%% - Some basic blocks are not worth scheduling (e.g., GC save/restore code)
-%% yet are pretty voluminous. How do we skip them?
-%% - Scheduling should be done at finalization time: when basic block is
-%% linearized and is definitely at Sparc assembly level, THEN reorder
-%% stuff.
-
--module(hipe_schedule).
--export([cfg/1, est_cfg/1, delete_node/5]).
-
--include("../sparc/hipe_sparc.hrl").
-
-%%-define(debug1,true).
-
--define(debug2(Str,Args),ok).
-%%-define(debug2(Str,Args),io:format(Str,Args)).
-
--define(debug3(Str,Args),ok).
-%%-define(debug3(Str,Args),io:format(Str,Args)).
-
--define(debug4(Str,Args),ok).
-%%-define(debug4(Str,Args),io:format(Str,Args)).
-
--define(debug5(Str,Args),ok).
-%%-define(debug5(Str,Args),io:format(Str,Args)).
-
--define(debug(Str,Args),ok).
-%%-define(debug(Str,Args),io:format(Str,Args)).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cfg
-%% Argument : CFG - the control flow graph
-%% Returns : CFG - A new cfg with scheduled blocks
-%% Description : Takes each basic block and schedules them one by one.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cfg(CFG) ->
- ?debug3("CFG: ~n~p", [CFG]),
- update_all( [ {L,
- hipe_bb:mk_bb(
- block(L,hipe_bb:code(hipe_sparc_cfg:bb(CFG,L))) )}
- || L <- hipe_sparc_cfg:labels(CFG) ], CFG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : update_all
-%% Argument : Blocks - [{Label, Block}] , a list with labels and new code
-%% used for updating the old CFG.
-%% CFG - The old controlflow graph
-%% Returns : An updated controlflow graph.
-%% Description : Just swappes the basic blocks in the CFG to the scheduled one.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-update_all([],CFG) -> CFG;
-update_all([{L,NewB}|Ls],CFG) ->
- update_all(Ls,hipe_sparc_cfg:bb_add(CFG,L,NewB)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-est_cfg(CFG) ->
- update_all([ {L, hipe_bb:mk_bb(est_block(hipe_bb:code(hipe_sparc_cfg:bb(CFG,L))))}
- || L <- hipe_sparc_cfg:labels(CFG) ], CFG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Provides an estimation of how quickly a block will execute.
-%% This is done by chaining all instructions in sequential order
-%% by 0-cycle dependences (which means they will never be reordered),
-%% then scheduling the mess.
-
-est_block([]) -> [];
-est_block([I]) -> [I];
-est_block(Blk) ->
- {IxBlk,DAG} = est_deps(Blk),
- Sch = bb(IxBlk,DAG),
- separate_block(Sch,IxBlk).
-
-est_deps(Blk) ->
- IxBlk = indexed_bb(Blk),
- DAG = deps(IxBlk),
- {IxBlk, chain_instrs(IxBlk,DAG)}.
-
-chain_instrs([{N,_}|Xs],DAG) ->
- chain_i(N,Xs,DAG).
-
-chain_i(_,[],DAG) -> DAG;
-chain_i(N,[{M,_}|Xs],DAG) ->
- NewDAG = dep_arc(N,zero_latency(),M,DAG),
- chain_i(M,Xs,NewDAG).
-
-zero_latency() -> 0.
-
-lookup_instr([{N,I}|_], N) -> I;
-lookup_instr([_|Xs], N) -> lookup_instr(Xs, N).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : block
-%% Argument : Instrs - [Instr], list of all the instructions in a basic
-%% block.
-%% Returns : A new scheduled block
-%% Description : Schedule a basic block
-%%
-%% Note: does not consider delay slots!
-%% (another argument for using only annulled delay slots?)
-%% * how do we add delay slots? somewhat tricky to
-%% reconcile with the sort of scheduling we consider.
-%% (as-early-as-possible)
-%% => rewrite scheduler into as-late-as-possible?
-%% (=> just reverse the dependence arcs??)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%% Don't fire up the scheduler if there's no work to do.
-block(_, []) ->
- [];
-block(_L, [I]) ->
- case hipe_sparc:is_any_branch(I) of
- true -> [hipe_sparc:nop_create(), I];
- false -> [I]
- end;
-block(_L, Blk) ->
- IxBlk = indexed_bb(Blk),
- case IxBlk of
- [{_N, I}] -> % comments and nops may have been removed.
- case hipe_sparc:is_any_branch(I) of
- true -> [hipe_sparc:nop_create(), I];
- false -> [I]
- end;
- _ ->
- Sch = bb(IxBlk, {DAG, _Preds} = deps(IxBlk)),
- {NewSch, NewIxBlk} = fill_delays(Sch, IxBlk, DAG),
- X = finalize_block(NewSch, NewIxBlk),
- debug1_stuff(Blk, DAG, IxBlk, Sch, X),
- X
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : fill_delays
-%% Argument : Sch - List of {{cycle, C}, {node, N}} : C = current cycle
-%% N = node index
-%% IxBlk - Indexed block [{N, Instr}]
-%% DAG - Dependence graph
-%% Returns : {NewSch, NewIxBlk} - vector with new schedule and vector
-%% with {N, Instr}
-%% Description : Goes through the schedule from back to front looking for
-%% branches/jumps. If one is found fill_del tries to find
-%% an instr to fill the delayslot.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-fill_delays(Sch, IxBlk, DAG) ->
- NewIxBlk = hipe_vectors:list_to_vector(IxBlk),
- %% NewSch = hipe_vectors:list_to_vector(Sch),
- NewSch = fill_del(length(Sch), hipe_vectors:list_to_vector(Sch),
- NewIxBlk, DAG),
- {NewSch, NewIxBlk}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : fill_del
-%% Argument : N - current index in the schedule
-%% Sch - schedule
-%% IxBlk - indexed block
-%% DAG - dependence graph
-%% Returns : Sch - New schedule with possibly a delay instr in the last
-%% position.
-%% Description : If a call/jump is found fill_branch_delay/fill_call_delay
-%% is called to find a delay-filler.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-fill_del(N, Sch, _IxBlk, _DAG) when N < 1 -> Sch;
-fill_del(N, Sch, IxBlk, DAG) ->
- Index = get_index(Sch, N),
- ?debug2("Index for ~p: ~p~nInstr: ~p~n",
- [N, Index, get_instr(IxBlk, Index)]),
- NewSch =
- case get_instr(IxBlk, Index) of
- #call_link{} ->
- fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
- #jmp_link{} ->
- fill_call_delay(N - 1, N, Sch, IxBlk, DAG);
- #jmp{} ->
- fill_call_delay(N - 1, N, Sch, IxBlk, DAG);
- #b{} ->
- fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
- #br{} ->
- fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
- #goto{} ->
- fill_branch_delay(N - 1, N, Sch, IxBlk, DAG);
- _Other ->
- Sch
- end,
- NewSch.
- %% fill_del(N - 1, NewSch, IxBlk, DAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : fill_call_delay
-%% Argument : Cand - index in schedule of delay-candidate
-%% Call - index in schedule of call
-%% Sch - schedule vector: < {{cycle,Ci},{node,Nj}}, ... >
-%% IxBlk - block vector: < {N, Instr1}, {N+1, Instr2} ... >
-%% DAG - dependence graph
-%% Returns : Sch - new updated schedule.
-%% Description : Searches backwards through the schedule trying to find an
-%% instr without conflicts with the Call-instr.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-fill_call_delay(Cand, _Call, Sch, _IxBlk, _DAG) when Cand < 1 -> Sch;
-fill_call_delay(Cand, Call, Sch, IxBlk, DAG) ->
- CandIndex = get_index(Sch, Cand),
- CallIndex = get_index(Sch, Call),
- CandI = get_instr(IxBlk, CandIndex),
- case move_or_alu(CandI) of
- true ->
- case single_depend(CandIndex, CallIndex, DAG) of
- false -> % Other instrs depends on Cand ...
- fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG);
-
- true ->
- CallI = get_instr(IxBlk, CallIndex),
-
- CandDefs = ordsets:from_list(hipe_sparc:defines(CandI)),
- %% CandUses = ordsets:from_list(hipe_sparc:uses(CandI)),
- %% CallDefs = ordsets:from_list(hipe_sparc:defines(CallI)),
- CallUses = ordsets:from_list(hipe_sparc:uses(CallI)),
-
- Args = case CallI of
- #jmp_link{} ->
- ordsets:from_list(
- hipe_sparc:jmp_link_args(CallI));
- #jmp{} ->
- ordsets:from_list(hipe_sparc:jmp_args(CallI));
- #call_link{} ->
- ordsets:from_list(
- hipe_sparc:call_link_args(CallI))
- end,
- CallUses2 = ordsets:subtract(CallUses, Args),
- Conflict = ordsets:intersection(CandDefs, CallUses2),
- %% io:format("single_depend -> true:~n ~p~n, ~p~n,~p~n",[CandI,CallI,DAG]),
- %% io:format("Cand = ~p~nCall = ~p~n",[CandI,CallI]),
- %% io:format("CandDefs = ~p~nCallDefs = ~p~n",[CandDefs,CallDefs]),
- %% io:format("CandUses = ~p~nCallUses = ~p~n",[CandUses,CallUses]),
- %% io:format("Args = ~p~nCallUses2 = ~p~n",[Args,CallUses2]),
- %% io:format("Conflict = ~p~n",[Conflict]),
-
- case Conflict of
- [] -> % No conflicts ==> Cand can fill delayslot after Call
- update_schedule(Cand, Call, Sch);
- _ -> % Conflict: try with preceeding instrs
- fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG)
- end
- end;
- false ->
- fill_call_delay(Cand - 1, Call, Sch, IxBlk, DAG)
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : fill_branch_delay
-%% Argument : Cand - index in schedule of delay-candidate
-%% Branch - index in schedule of branch
-%% Sch - schedule
-%% IxBlk - indexed block
-%% DAG - dependence graph
-%% Returns : Sch - new updated schedule.
-%% Description : Searches backwards through the schedule trying to find an
-%% instr without conflicts with the Branch-instr.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-fill_branch_delay(Cand, _Br, Sch, _IxBlk, _DAG) when Cand < 1 -> Sch;
-fill_branch_delay(Cand, Br, Sch, IxBlk, DAG) ->
- CandIndex = get_index(Sch, Cand),
- BrIndex = get_index(Sch, Br),
- CandI = get_instr(IxBlk, CandIndex),
- case move_or_alu(CandI) of
- true ->
- case single_depend(CandIndex, BrIndex, DAG) of
- false -> % Other instrs depends on Cand ...
- fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG);
-
- true ->
- BrI = get_instr(IxBlk, BrIndex),
- CandDefs = ordsets:from_list(hipe_sparc:defines(CandI)),
- %% CandUses = ordsets:from_list(hipe_sparc:uses(CandI)),
- %% BrDefs = ordsets:from_list(hipe_sparc:defines(BrI)),
- BrUses = ordsets:from_list(hipe_sparc:uses(BrI)),
-
- Conflict = ordsets:intersection(CandDefs, BrUses),
- %% io:format("single_depend -> true: ~p~n, ~p~n,~p~n", [CandI, BrI, DAG]),
- %% io:format("Cand = ~p~nBr = ~p~n",[CandI,BrI]),
- %% io:format("CandDefs = ~p~nBrDefs = ~p~n",[CandDefs,BrDefs]),
- %% io:format("CandUses = ~p~nBrUses = ~p~n",[CandUses,BrUses]),
- %% io:format("Conflict = ~p~n",[Conflict]);
-
- case Conflict of
- [] -> % No conflicts ==>
- % Cand can fill delayslot after Branch
- update_schedule(Cand, Br, Sch);
- _ -> % Conflict: try with preceeding instrs
- fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG)
- end
- end;
- false ->
- fill_branch_delay(Cand - 1, Br, Sch, IxBlk, DAG)
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : update_schedule
-%% Argument : From - the position from where to switch indexes in Sch
-%% To - the position to where to switch indexes in Sch
-%% Sch - schedule
-%% Returns : Sch - an updated schedule
-%% Description : If From is the delay-filler and To is the Call/jump, the
-%% schedule is updated so From gets index To, To gets index
-%% To - 1, and the nodes between From and To gets old_index - 1.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-update_schedule(To, To, Sch) ->
- {{cycle, C}, {node, _N} = Node} = hipe_vectors:get(Sch, To-1),
- hipe_vectors:set(Sch, To-1, {{cycle, C+1}, Node});
-update_schedule(From, To, Sch) ->
- Temp = hipe_vectors:get(Sch, From-1),
- Sch1 = hipe_vectors:set(Sch, From-1, hipe_vectors:get(Sch, From)),
- update_schedule(From + 1, To, hipe_vectors:set(Sch1, From, Temp)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : single_depend
-%% Argument : N - Index of the delayslot candidate
-%% M - Index of the node that N possibly has a single
-%% depend to.
-%% DAG - The dependence graph
-%% Returns : true if no other nodes than N os depending on N
-%% Description : Checks that no other nodes than M depends on N and that the
-%% latency between them is zero or 1.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-single_depend(N, M, DAG) ->
- Deps = hipe_vectors:get(DAG, N-1),
- single_depend(M, Deps).
-
-single_depend(_N, []) -> true;
-single_depend(N, [{0, N}]) -> true;
-single_depend(N, [{1, N}]) -> true;
-single_depend(_N, [{_Lat, _}|_]) -> false.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : get_index
-%% Argument : Sch - schedule
-%% N - index in schedule
-%% Returns : Index - index of the node
-%% Description : Returns the index of the node on position N in the schedule.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-get_index(Sch, N) ->
- {{cycle, _C}, {node, Index}} = hipe_vectors:get(Sch,N-1),
- Index.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : get_instr
-%% Argument : IxBlk - indexed block
-%% N - index in block
-%% Returns : Instr
-%% Description : Returns the instr on position N in the indexed block.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-get_instr(IxBlk, N) ->
- {_, Instr} = hipe_vectors:get(IxBlk, N-1),
- Instr.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : get_instr
-%% Argument : Sch - schedule
-%% IxBlk - indexed block
-%% N - index in schedule
-%% Returns : Instr
-%% Description : Returns the instr on position N in the schedule.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-get_instr(Sch, IxBlk, N) ->
- {{cycle, _C}, {node, Index}} = hipe_vectors:get(Sch, N-1),
- {_, Instr} = hipe_vectors:get(IxBlk, Index-1),
- Instr.
-
-separate_block(Sch,IxBlk) ->
- sep_comments([{C,lookup_instr(IxBlk,N)} || {{cycle,C},{node,N}} <- Sch]).
-
-sep_comments([]) -> [];
-sep_comments([{C,I}|Xs]) ->
- [hipe_sparc:comment_create({cycle,C}), I | sep_comments(Xs,C)].
-
-sep_comments([], _) -> [];
-sep_comments([{C1,I}|Xs], C0) ->
- if
- C1 > C0 ->
- [hipe_sparc:comment_create({cycle,C1}),I|sep_comments(Xs,C1)];
- true ->
- [I|sep_comments(Xs, C0)]
- end.
-
-finalize_block(Sch, IxBlk) ->
- ?debug5("Sch: ~p~nIxBlk: ~p~n",[Sch,IxBlk]),
- finalize_block(1, hipe_vectors:size(Sch), 1, Sch, IxBlk, []).
-
-finalize_block(N, End, _C, Sch, IxBlk, _Instrs) when N =:= End - 1 ->
- NextLast = get_instr(Sch, IxBlk, N),
- Last = get_instr(Sch, IxBlk, End),
- ?debug5("NextLast: ~p~nLast: ~p~n",[NextLast,Last]),
- case hipe_sparc:is_any_branch(Last) of
- true -> % Couldn't fill delayslot ==> add NOP
- [NextLast , hipe_sparc:nop_create(), Last];
- false -> % Last is a delayslot-filler ==> change order...
- [Last, NextLast]
- end;
-finalize_block(N, End, C0, Sch, IxBlk, Instrs) ->
- {{cycle, _C1}, {node, _M}} = hipe_vectors:get(Sch, N-1),
- Instr = get_instr(Sch, IxBlk, N),
- ?debug5("Instr: ~p~n~n",[Instr]),
- [Instr | finalize_block(N + 1, End, C0, Sch, IxBlk, Instrs)].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : bb
-%% Argument : IxBlk - indexed block
-%% DAG - {Dag, Preds} where Dag is dependence graph and
-%% Preds is number of predecessors for each node.
-%% Returns : Sch
-%% Description : Initializes earliest-list, ready-list, priorities, resources
-%% and so on, and calls the cycle_sched which does the scheduling
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-bb(IxBlk,DAG) ->
- bb(length(IxBlk), IxBlk, DAG).
-
-bb(N,IxBlk,{DAG, Preds}) ->
- Earliest = init_earliest(N),
- BigArray = N*10, % "nothing" is this big :-)
- Ready = hipe_schedule_prio:init_ready(BigArray,Preds),
- I_res = init_instr_resources(N, IxBlk),
-
- Prio = hipe_schedule_prio:init_instr_prio(N,DAG),
- Rsrc = init_resources(BigArray),
- ?debug4("I_res: ~n~p~nPrio: ~n~p~nRsrc: ~n~p~n", [I_res,Prio,Rsrc]),
- ?debug('cycle 1~n',[]),
- Sch = empty_schedule(),
- cycle_sched(1,Ready,DAG,Preds,Earliest,Rsrc,I_res,Prio,Sch,N,IxBlk).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cycle_sched
-%% Argument : - C is current cycle, 1 or more.
-%% - Ready is an array (Cycle -> [Node])
-%% yielding the collection of nodes ready to be
-%% scheduled in a cycle.
-%% - DAG is an array (Instr -> [{Latency,Instr}])
-%% represents the dependence DAG.
-%% - Preds is an array (Instr -> NumPreds)
-%% counts the number of predecessors
-%% (0 preds = ready to be scheduled).
-%% - Earl is an array (Instr -> EarliestCycle)
-%% holds the earliest cycle an instruction can be scheduled.
-%% - Rsrc is a 'resource ADT' that handles scheduler resource
-%% management checks whether instruction can be scheduled
-%% this cycle without a stall.
-%% - I_res is an array (Instr -> Required_resources)
-%% holds the resources required to schedule an instruction.
-%% - Sch is the representation of the schedule current schedule.
-%% - N is the number of nodes remaining to be scheduled
-%% tells us when to stop the scheduler.
-%% - IxBlk is the indexed block with instrs
-%% Returns : present schedule
-%% Description : Scheduler main loop.
-%% Pick next ready node in priority order for cycle C until
-%% none remain.
-%% * check each node if it can be scheduled w/o stalling
-%% * if so, schedule it
-%% * otherwise, bump the node to the next cycle
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cycle_sched(C,Ready,DAG,Preds,Earl,Rsrc,I_res,Prio,Sch,N,IxBlk) ->
- case hipe_schedule_prio:next_ready(C,Ready,Prio,IxBlk,DAG,Preds,Earl) of
-% case hipe_schedule_prio:next_ready(C,Ready,Prio,IxBlk) of
- {next,I,Ready1} ->
- ?debug('try ~p~n==> ready = ~p~n',[I, Ready1]),
- case resources_available(C,I,Rsrc,I_res) of
- {yes,NewRsrc} ->
- ?debug(' scheduled~n==> Rscrs = ~p~n',[NewRsrc]),
- NewSch = add_to_schedule(I,C,Sch),
- {ReadyNs,NewDAG,NewPreds,NewEarl} =
- delete_node(C,I,DAG,Preds,Earl),
- ?debug("NewPreds : ~p~n",[Preds]),
- ?debug(' ReadyNs: ~p~n',[ReadyNs]),
- NewReady = hipe_schedule_prio:add_ready_nodes(ReadyNs,
- Ready1),
- ?debug(' New ready: ~p~n',[NewReady]),
- cycle_sched(C,NewReady,NewDAG,NewPreds,NewEarl,
- NewRsrc,I_res,Prio,NewSch,N-1, IxBlk);
- no ->
- ?debug(' resource conflict~n',[]),
- NewReady = hipe_schedule_prio:insert_node(C+1,I,Ready1),
- cycle_sched(C,NewReady,DAG,Preds,Earl,Rsrc,
- I_res,Prio,Sch,N,IxBlk)
- end;
- none -> % schedule next cycle if some node remains
- if
- N > 0 ->
- ?debug('cycle ~p~n',[C+1]),
- cycle_sched(C+1,Ready,DAG,Preds,Earl,
- advance_cycle(Rsrc),
- I_res,Prio,Sch,N, IxBlk);
- true ->
- present_schedule(Sch)
- end
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : init_earliest
-%% Argument : N - number of instrs
-%% Returns :
-%% Description :
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-init_earliest(N) ->
- hipe_vectors:new(N,1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Schedule is kept reversed until the end.
-
--define(present_node(I,Cycle),{{cycle,Cycle},{node,I}}).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : empty_schedule
-%% Description : Returns an empty schedule.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-empty_schedule() -> [].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_to_schedule
-%% Argument : I - instr
-%% Cycle - cycle when I was placed
-%% Sch - schedule
-%% Description : Adds instr to schedule
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_to_schedule(I,Cycle,Sch) ->
- [?present_node(I,Cycle)|Sch].
-
-present_schedule(Sch) -> lists:reverse(Sch).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Interface to resource manager:
-%%
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : init_resources
-%% Description : Yields a 'big enough' array mapping (Cycle -> Resources);
-%% this array is called Rsrc below.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-init_resources(S) ->
- hipe_target_machine:init_resources(S).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : init_instr_resources
-%% Argument : Nodes - a list of the instructions
-%% N - is the number of nodes
-%% Description : return a vector (NodeID -> Resource_requirements)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-init_instr_resources(N,Nodes) ->
- hipe_target_machine:init_instr_resources(N,Nodes).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : resources_available
-%% Argument : Cycle - the current cycle
-%% I - the current instruction (index = NodeID)
-%% Rsrc - a map (Cycle -> Resources)
-%% I_res - maps (NodeID -> Resource_requirements)
-%% Description : returns {yes,NewResTab} | no
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-resources_available(Cycle,I,Rsrc,I_res) ->
- hipe_target_machine:resources_available(Cycle,I,Rsrc,I_res).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : advance_cycle
-%% Argument : Rsrc - resources
-%% Description : Returns an empty resources-state
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-advance_cycle(Rsrc) ->
- hipe_target_machine:advance_cycle(Rsrc).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : delete_node
-%% Argument : Cycle - current cycle
-%% I - index of instr
-%% DAG - dependence dag
-%% Preds - array with number of predecessors for nodes
-%% Earl - array with earliest-times for nodes
-%% Returns : {ReadyNs,NewDAG,NewPreds,NewEarl}
-%% Description : Deletes node I and updates earliest times for the rest.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-delete_node(Cycle,I,DAG,Preds,Earl) ->
- Succ = hipe_vectors:get(DAG,I-1),
- NewDAG = hipe_vectors:set(DAG,I-1,scheduled), % provides debug 'support'
- {ReadyNs,NewPreds,NewEarl} = update_earliest(Succ,Cycle,Preds,Earl,[]),
- ?debug('earliest after ~p: ~p~n',[I,[{Ix+1,V} || {Ix,V} <- hipe_vectors:list(NewEarl)]]),
- {ReadyNs,NewDAG,NewPreds,NewEarl}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : update_earliest
-%% Argument : Succ - successor list
-%% Cycle - current cycle
-%% Preds - predecessors
-%% Earl - earliest times for nodes
-%% Ready - array with readynodes for cycles
-%% Returns : {Ready,Preds,Earl}
-%% Description : Updates the earliest times for nodes and updates number of
-%% predecessors for nodes
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-update_earliest([],_Cycle,Preds,Earl,Ready) ->
- {Ready,Preds,Earl};
-update_earliest([{Lat,N}|Xs],Cycle,Preds,Earl,Ready) ->
- Old_earl = hipe_vectors:get(Earl,N-1),
- New_earl = erlang:max(Old_earl,Cycle+Lat),
- NewEarl = hipe_vectors:set(Earl,N-1,New_earl),
- Num_preds = hipe_vectors:get(Preds,N-1),
- NewPreds = hipe_vectors:set(Preds,N-1,Num_preds-1),
- if
- Num_preds =:= 0 ->
- ?debug('inconsistent DAG~n',[]),
- exit({update_earliest,N});
- Num_preds =:= 1 ->
- NewReady = [{New_earl,N}|Ready],
- NewPreds2 = hipe_vectors:set(NewPreds,N-1,0),
- update_earliest(Xs,Cycle,NewPreds2,NewEarl,NewReady);
- is_integer(Num_preds), Num_preds > 1 ->
- update_earliest(Xs,Cycle,NewPreds,NewEarl,Ready)
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Collect instruction dependences.
-%%
-%% Three forms:
-%% - data/register
-%% * insert RAW, WAR, WAW dependences
-%% - memory
-%% * stores serialize memory references
-%% * alias analysis may allow loads to bypass stores
-%% - control
-%% * unsafe operations are 'trapped' between branches
-%% * branches are ordered
-%%
-%% returns { [{Index,Instr}], DepDAG }
-%% DepDAG is defined below.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : deps
-%% Argument : BB - Basic block
-%% Returns : {IxBB,DAG} - indexed block and dependence graph. DAG consists
-%% of both Dag and Preds, where Preds is number
-%% of predecessors for nodes.
-%% Description : Collect instruction dependences.
-%%
-%% Three forms:
-%% - data/register
-%% * insert RAW, WAR, WAW dependences
-%% - memory
-%% * stores serialize memory references
-%% * alias analysis may allow loads to bypass stores
-%% - control
-%% * unsafe operations are 'trapped' between branches
-%% * branches are ordered
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-deps(IxBB) ->
- N = length(IxBB),
- DAG = empty_dag(N), % The DAG contains both dependence-arcs and
- % number of predeccessors...
- {_DepTab,DAG1} = dd(IxBB, DAG),
- DAG2 = md(IxBB, DAG1),
- cd(IxBB, DAG2).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : empty_dag
-%% Argument : N - number of nodes
-%% Returns : empty DAG
-%% Description : DAG consists of dependence graph and predeccessors
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-empty_dag(N) ->
- {hipe_vectors:new(N, []), hipe_vectors:new(N, 0)}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : indexed_bb
-%% Argument : BB - basic block
-%% Returns : [{N, Instr}]
-%% Description : Puts indexes to all instrs of a block, removes comments.
-%% NOP's are also removed because if both sparc_schedule and
-%% sparc_post_schedule options are used, the first pass will
-%% add nop's before the branch if necessary, and these are
-%% removed before scheduling the second pass.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-indexed_bb(BB) ->
- indexed_bb(BB,1).
-
-indexed_bb([],_N) -> [];
-indexed_bb([X|Xs],N) ->
- case X of
- #comment{} ->
- indexed_bb(Xs,N);
- #nop{} ->
- indexed_bb(Xs,N);
- _Other ->
- [{N,X}|indexed_bb(Xs,N+1)]
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : dep_arc
-%% Argument : N - Current node
-%% Lat - Latency from current node to M
-%% M - The dependent node
-%% DAG - The dependence graph. Consists of both DAG and
-%% predeccessors
-%% Returns : A new DAG with the arc added and number of predeccessors for
-%% M increased.
-%% Description : Adds a new arc to the graph, if an older arc goes from N to M
-%% it will be replaced with a new arc {max(OldLat, NewLat), M}.
-%% Number of predeccessors for node M is increased.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-dep_arc(N, Lat, M, {Dag,Preds}) ->
- OldDeps = hipe_vectors:get(Dag, N-1),
- %% io:format("{OldDeps} = {~p}~n",[OldDeps]),
- {NewDeps, Status} = add_arc(Lat, M, OldDeps),
- %% io:format("{NewDeps, Status} = {~p, ~p}~n",[NewDeps, Status]),
- NewDag = hipe_vectors:set(Dag, N-1, NewDeps),
- NewPreds = case Status of
- added -> % just increase preds if new arc was added
- OldPreds = hipe_vectors:get(Preds, M-1),
- hipe_vectors:set(Preds, M-1, OldPreds + 1);
- non_added ->
- Preds
- end,
- {NewDag, NewPreds}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_arc
-%% Argument : Lat - The latency from current node to To.
-%% To - The instr-id of the node which the dependence goes to
-%% Arcs - The dependecies that are already in the dep-graph
-%% Returns : A dependence graph sorted by To.
-%% Description : A new arc that is added is sorted in the right place, and if
-%% there is already an arc between nodes A and B, the one with
-%% the greatest latency is chosen.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_arc(Lat,To, []) -> {[{Lat, To}], added};
-add_arc(Lat1, To, [{Lat2, To} | Arcs]) ->
- {[{erlang:max(Lat1, Lat2), To} | Arcs], non_added};
-add_arc(Lat1,To1, [{Lat2, To2} | Arcs]) when To1 < To2 ->
- {[{Lat1, To1}, {Lat2, To2} | Arcs], added};
-add_arc(Lat1 ,To1, [{Lat2, To2} | Arcs]) ->
- {Arcs1, Status} = add_arc(Lat1, To1, Arcs),
- {[{Lat2, To2} | Arcs1], Status}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% The register/data dependence DAG of a block is represented
-%% as a mapping (Variable -> {NextWriter,NextReaders})
-%% where NextWriter is a pair {Ix,Type}
-%% and NextReaders is a list of pairs {Ix,Type}.
-%%
-%% Type is used to determine latencies of operations; on the UltraSparc,
-%% latencies of arcs (n -> m) are determined by both n and m. (E.g., if
-%% n is an integer op and m is a store, then latency is 0; if m is an
-%% integer op, it's 1.)
-
-dd([],DAG) -> { empty_deptab(), DAG };
-dd([{N,I}|Is],DAG0) ->
- {DepTab,DAG1} = dd(Is,DAG0),
- add_deps(N,I,DepTab,DAG1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_deps
-%% Argument : N - current node
-%% Instr - current instr
-%% DepTab - hashtable with {next-writer, next-readers} for reg
-%% DAG - dependence graph
-%% Returns : {DepTab, BlockInfo, DAG} - with new values
-%% Description : Adds dependencies for node N to the graph. The registers that
-%% node N defines and uses are used for computing the
-%% dependencies to the following nodes.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_deps(N,Instr,DepTab,DAG) ->
- {Ds,Us} = def_use(Instr),
- Type = dd_type(Instr),
- {DepTab1,DAG1} = add_write_deps(Ds,N,Type,DepTab,DAG),
- add_read_deps(Us,N,Type,DepTab1,DAG1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Instructions are classified into symbolic categories,
-%% which are subsequently used to determine operation latencies
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-dd_type(Instr) ->
- case Instr of
- #b{} -> branch;
- %% #br{} -> branch;
- #call_link{} -> branch;
- #jmp_link{} -> branch;
- #jmp{} -> branch;
- #goto{} -> branch;
- #load{} -> load;
- #store{} -> store;
- #alu{} -> alu;
- #move{} -> alu;
- #multimove{} ->
- Src = hipe_sparc:multimove_src(Instr),
- Lat = round(length(Src)/2),
- {mmove,Lat};
- #sethi{} -> alu;
- #alu_cc{} -> alu_cc;
- %% #cmov_cc{} -> cmov_cc;
- %% #cmov_r{} -> alu;
- #load_atom{} -> alu;
- #load_address{} -> alu;
- #pseudo_enter{} -> pseudo;
- #pseudo_pop{} -> pseudo;
- #pseudo_return{} -> pseudo;
- #pseudo_spill{} -> pseudo;
- #pseudo_unspill{} -> pseudo
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_write_deps
-%% Argument : Defs - registers that node N defines.
-%% N - current node
-%% Ty - the type of current instr
-%% DepTab - Dependence-table
-%% DAG - The dependence graph.
-%% Returns : {DepTab,DAG} - with new values
-%% Description : Adds dependencies to the graph for nodes that depends on the
-%% registers that N defines.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_write_deps([],_N,_Ty,DepTab,DAG) -> {DepTab,DAG};
-add_write_deps([D|Ds],N,Ty,DepTab,DAG) ->
- {NewDepTab,NewDAG} = add_write_dep(D,N,Ty,DepTab,DAG),
- add_write_deps(Ds,N,Ty,NewDepTab,NewDAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_write_dep
-%% Description : Updates the dependence table with N as next writer, and
-%% updates the DAG with the dependencies from N to subsequent
-%% nodes.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_write_dep(X,N,Ty,DepTab,DAG) ->
- {NxtWriter,NxtReaders} = lookup(X,DepTab),
- NewDepTab = writer(X,N,Ty,DepTab),
- NewDAG = write_deps(N,Ty,NxtWriter,NxtReaders,DAG),
- {NewDepTab, NewDAG}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : write_deps
-%% Argument : Instr - Current instr
-%% Ty - Type of current instr
-%% NxtWriter - The node that is the next writer of the ragister
-%% that Instr defines.
-%% NxtReaders - The nodes that are subsequent readers of the
-%% register that N defines.
-%% DAG - The dependence graph
-%% Returns : Calls raw_deps that finally returns a new DAG with the new
-%% dependence arcs added.
-%% Description : If a next writer exists a dependence arc for this node is
-%% added, and after this raw_deps is called to compute the
-%% arcs for read-after-write dependencies.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-write_deps(Instr,Ty,NxtWriter,NxtReaders,DAG) ->
- DAG1 = case NxtWriter of
- none ->
- DAG;
- {Instr,_} ->
- DAG;
- {Wr,WrTy} ->
- dep_arc(Instr,
- hipe_target_machine:waw_latency(Ty,WrTy),
- Wr, DAG)
- end,
- raw_deps(Instr,Ty,NxtReaders,DAG1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : raw_deps
-%% Argument : Instr - current instr
-%% Type - type of instr
-%% Readers - subsequent readers
-%% DAG - dependence graph
-%% Returns : DAG - A new DAG with read-after-write dependencies added
-%% Description : Updates the DAG with the dependence-arcs from Instr to the
-%% subsequent readers, with the appropriate latencies.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-raw_deps(_Instr,_Type,[],DAG) -> DAG;
-raw_deps(Instr,Ty,[{Rd,RdTy}|Xs],DAG) ->
- raw_deps(Instr,Ty,Xs,
- dep_arc(Instr,hipe_target_machine:raw_latency(Ty,RdTy),
- Rd,DAG)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_read_deps
-%% Argument : Uses - The registers that node N uses.
-%% N - Index of the current node.
-%% Ty - Type of current node.
-%% DepTab - Dependence table
-%% DAG - Dependence graph
-%% Returns : {DepTab, DAG} - with updated values.
-%% Description : Adds the read dependencies from node N to subsequent ones,
-%% according to the registers that N uses.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_read_deps([],_N,_Ty,DepTab,DAG) -> {DepTab,DAG};
-add_read_deps([U|Us],N,Ty,DepTab,DAG) ->
- {NewDepTab,NewDAG} = add_read_dep(U,N,Ty,DepTab,DAG),
- add_read_deps(Us,N,Ty,NewDepTab,NewDAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_read_dep
-%% Argument : X - Used register
-%% N - Index of checked instr
-%% Ty - Type of checked instr
-%% DepTab - Hashtable with {next-writer, next-readers}
-%% DAG - Dependence graph
-%% Returns : {DepTab, DAG} - with updated values
-%% Description : Looks up what the next-writer/next-readers are, and adjusts
-%% the table with current node as new reader. Finally
-%% read-dependencies are added to the DAG.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-add_read_dep(X,N,Ty,DepTab,DAG) ->
- {NxtWriter,_NxtReaders} = lookup(X,DepTab),
- NewDepTab = reader(X,N,Ty,DepTab),
- NewDAG = read_deps(N,Ty,NxtWriter,DAG),
- {NewDepTab, NewDAG}.
-
-% If NxtWriter is 'none', then this var is not written subsequently
-% Add WAR from Instr to NxtWriter (if it exists)
-% *** UNFINISHED ***
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : read_deps
-%% Argument : N - Index of current node
-%% Ty - Type of current node
-%% Writer - tuple {NextWriter, WrType} where NextWriter is the
-%% subsequent instr that writes this register next time,
-%% and WrType is the type of that instr.
-%% DAG - The dependence graph
-%% Returns : DAG
-%% Description : Returns a new DAG if a next-writer exists, otherwise the old
-%% DAG is returned.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-read_deps(_Instr,_Ty,none,DAG) ->
- DAG;
-read_deps(_Instr,_Ty,{_Instr,_},DAG) ->
- DAG;
-read_deps(Instr,Ty,{NxtWr,NxtWrTy},DAG) ->
- dep_arc(Instr,hipe_target_machine:war_latency(Ty,NxtWrTy),NxtWr,
- DAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : empty_deptab
-%% Description : Creates an empty dependence table (hash-table)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-empty_deptab() ->
- gb_trees:empty().
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : lookup
-%% Argument : X - key (register)
-%% DepTab - dependence table
-%% Returns : {NextWriter, NextReaders}
-%% Description : Returns next writer and a list of following readers on
-%% register X.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-lookup(X, DepTab) ->
- case gb_trees:lookup(X, DepTab) of
- none ->
- {none, []};
- {value, {W, Rs} = Val} ->
- Val
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : writer
-%% Argument : X - key (register)
-%% N - index of writer
-%% Ty - type of writer
-%% DepTab - dependence table to be updated
-%% Returns : DepTab - new dependence table
-%% Description : Sets N tobe next writer on X
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-writer(X, N, Ty, DepTab) ->
- gb_trees:enter(X, {{N, Ty}, []}, DepTab).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : reader
-%% Argument : X - key (register)
-%% N - index of reader
-%% Ty - type of reader
-%% DepTab - dependence table to be updated
-%% Returns : DepTab - new dependence table
-%% Description : Adds N to the dependence table as a reader.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-reader(X,N,Ty,DepTab) ->
- {W,Rs} = lookup(X,DepTab),
- gb_trees:enter(X,{W,[{N,Ty}|Rs]},DepTab).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% The following version of md/2 separates heap- and stack operations,
-%% which allows for greater reordering.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : md
-%% Argument : IxBB - indexed block
-%% DAG - dependence graph
-%% Returns : DAG - new dependence graph
-%% Description : Adds arcs for load/store dependencies to the DAG.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-md(IxBB, DAG) ->
- md(IxBB,empty_md_state(),DAG).
-
-md([],_,DAG) -> DAG;
-md([{N,I}|Is],St,DAG) ->
- case md_type(I) of
- other ->
- md(Is,St,DAG);
- {st,T} ->
- { WAW_nodes, WAR_nodes, NewSt } = st_overlap(N,T,St),
- md(Is,NewSt,
- md_war_deps(WAR_nodes,N,md_waw_deps(WAW_nodes,N,DAG)));
- {ld,T} ->
- { RAW_nodes, NewSt } = ld_overlap(N,T,St),
- md(Is,NewSt,
- md_raw_deps(RAW_nodes,N,DAG))
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : md_war_deps
-%% Argument : WAR_nodes - write-after-read nodes depending on N
-%% N - index of current instr
-%% DAG - dependence graph
-%% Returns : DAG - updated DAG
-%% Description : Adds arcs for write-after-read dependencies for N
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-md_war_deps([],_,DAG) -> DAG;
-md_war_deps([M|Ms],N,DAG) ->
- md_war_deps(Ms,N,dep_arc(M,hipe_target_machine:m_war_latency(),N,DAG)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : md_waw_deps
-%% Argument : WAW_nodes - write-after-write nodes depending on N
-%% N - index of current instr
-%% DAG - dependence graph
-%% Returns : DAG - updated DAG
-%% Description : Adds arcs for write-after-write dependencies for N
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-md_waw_deps([],_,DAG) -> DAG;
-md_waw_deps([M|Ms],N,DAG) ->
- md_waw_deps(Ms,N,dep_arc(M,hipe_target_machine:m_waw_latency(),N,DAG)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : md_raw_deps
-%% Argument : RAW_nodes - read-after-write nodes depending on N
-%% N - index of current instr
-%% DAG - dependence graph
-%% Returns : DAG - updated DAG
-%% Description : Adds arcs for read-after-write dependencies for N
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-md_raw_deps([],_,DAG) -> DAG;
-md_raw_deps([M|Ms],N,DAG) ->
- md_raw_deps(Ms,N,dep_arc(M,hipe_target_machine:m_raw_latency(),N,DAG)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : empty_md_state
-%% Description : Returns an empty memorydependence state, eg. 4 lists
-%% representing {StackStores, HeapStores, StackLoads, HeapLoads}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-empty_md_state() -> {[], [], [], []}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : md_type
-%% Argument : I - instr
-%% Description : Maps the instr-type to a simplified type, telling if it's
-%% store/load resp. heap or stack.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-md_type(I) ->
- case I of
- #load{} ->
- Sp = hipe_sparc_registers:stack_pointer(),
- Src = hipe_sparc:load_src(I),
- N = hipe_sparc:reg_nr(Src),
- Off = hipe_sparc:load_off(I),
- if
- N =:= Sp -> % operation on stack
- {ld,{sp,Off}};
- true ->
- {ld,{hp,Src,Off}}
- end;
- #store{} ->
- Sp = hipe_sparc_registers:stack_pointer(),
- Dst = hipe_sparc:store_dest(I),
- N = hipe_sparc:reg_nr(Dst),
- Off = hipe_sparc:store_off(I),
- if
- N =:= Sp ->
- {st,{sp,Off}};
- true ->
- {st,{hp,Dst,Off}}
- end;
- _ ->
- other
- end.
-
-%% Given a memory operation and a 'memory op state',
-%% overlap(N,MemOp,State) returns { Preceding_Dependent_Ops, NewState }.
-%% which are either a tuple { WAW_deps, WAR_deps } or a list RAW_deps.
-%%
-%% NOTES:
-%% Note that Erlang's semantics ("heap stores never overwrite existing data")
-%% means we can be quite free in reordering stores to the heap.
-%% Ld/St to the stack are simply handled by their offsets; since we do not
-%% rename the stack pointer, this is sufficient.
-%% *** We assume all memory ops have uniform size = 4 ***
-%%
-%% NOTES:
-%% The method mentioned above has now been changed because the assumption that
-%% "heap stores never overwrite existing data" caused a bug when the
-%% process-pointer was treated the same way as the heap. We were also told
-%% that the semantics can possibly change in the future, so it would be more
-%% safe to treat the heap store/loads as the stack.
-%% A future improvement can be to do an alias analysis to give more freedom
-%% in reordering stuff...
-%%
-%% Alias state:
-%% { [StackOp], [HeapOp], [StackOp], [HeapOp] }
-%% where StackOp = {InstrID, Offset}
-%% HeapOp = {InstrID, Reg, Offset}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : st_overlap
-%% Argument : N - Index of current node
-%% Type - {sp,Off} or {hp,Dst,Off}, store on stack or heap
-%% State - { [StackStrs], [HeapStrs], [StackLds], [HeapLds] }
-%% where StackStrs/StackLds = {InstrID, Offset}
-%% and HeapStrs/HeapLds = {InstrID, Reg, Offset}
-%% Returns : { DepStrs, DepLds, State } -
-%% where DepStrs/DepLds = [NodeId]
-%% and State is the new state
-%% Description : Adds dependencies for overlapping stores.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-st_overlap(N, {sp, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
- {DepSt, IndepSt_Sp} = st_sp_dep(St_Sp, Off),
- {DepLd, IndepLd_Sp} = ld_sp_dep(Ld_Sp, Off),
- {DepSt, DepLd, {[{N, Off}|IndepSt_Sp], St_Hp, IndepLd_Sp, Ld_Hp}};
-st_overlap(N, {hp, Dst, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
- DstOff = {Dst, Off},
- {DepSt,_IndepSt_Hp} = st_hp_dep(St_Hp, DstOff),
- {DepLd, IndepLd_Hp} = ld_hp_dep(Ld_Hp, DstOff),
- {DepSt, DepLd, {St_Sp, [{N, Dst, Off}|St_Hp], Ld_Sp, IndepLd_Hp}}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : ld_overlap
-%% Argument : N - Index of current node
-%% Type - {sp,Off} or {hp,Dst,Off}, store on stack or heap
-%% State - { [StackStrs], [HeapStrs], [StackLds], [HeapLds] }
-%% where StackStrs/StackLds = {InstrID, Offset}
-%% and HeapStrs/HeapLds = {InstrID, Reg, Offset}
-%% Returns : { DepStrs, State }
-%% Description : Adds dependencies for overlapping laods
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-ld_overlap(N, {sp, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
- DepSt = sp_dep_only(St_Sp, Off),
- {DepSt, {St_Sp, St_Hp, [{N, Off}|Ld_Sp], Ld_Hp}};
-ld_overlap(N, {hp, Src, Off}, {St_Sp, St_Hp, Ld_Sp, Ld_Hp}) ->
- DepSt = hp_dep_only(St_Hp, Src, Off),
- {DepSt, {St_Sp, St_Hp, Ld_Sp, [{N, Src, Off}|Ld_Hp]}}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : st_sp_dep
-%% Description : Adds dependencies that are depending on a stack store
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-st_sp_dep(Stores, Off) ->
- sp_dep(Stores, Off, [], []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : ld_sp_dep
-%% Description : Adds dependencies that are depending on a stack load
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-ld_sp_dep(Loads, Off) ->
- sp_dep(Loads, Off, [], []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : st_hp_dep
-%% Description : Adds dependencies that are depending on a heap store
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-st_hp_dep(Stores, {_Reg, _Off} = RegOff) ->
- hp_dep(Stores, RegOff, [], []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : ld_hp_dep
-%% Description : Adds dependencies that are depending on a heap load
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-ld_hp_dep(Loads, {_Reg, _Off} = RegOff) ->
- hp_dep(Loads, RegOff, [], []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : sp_dep
-%% Description : Returns {Dependent, Independent} which are lists of nodes
-%% that depends or not on a stack load/store
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-sp_dep([], _Off, Dep, Indep) -> {Dep, Indep};
-sp_dep([{N,Off}|Xs], Off, Dep, Indep) ->
- sp_dep(Xs, Off, [N|Dep], Indep);
-sp_dep([X|Xs], Off, Dep, Indep) ->
- sp_dep(Xs, Off, Dep, [X|Indep]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : hp_dep
-%% Description : Returns {Dependent, Independent} which are lists of nodes
-%% that depends or not on a heap load/store
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-hp_dep([], {_Reg,_Off}, Dep, Indep) -> {Dep,Indep};
-hp_dep([{N,Reg,Off1}|Xs], {Reg,Off}, Dep, Indep) when Off1 =/= Off ->
- hp_dep(Xs, {Reg,Off}, Dep, [{N,Reg,Off1}|Indep]);
-hp_dep([{N,_,_}|Xs], {Reg,Off}, Dep, Indep) ->
- hp_dep(Xs, {Reg,Off}, [N|Dep], Indep).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : sp_dep_only
-%% Description : Returns a list of nodes that are depending on a stack store
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-sp_dep_only(Stores, Off) ->
- [N || {N,Off0} <- Stores, Off =:= Off0].
-
-%% Dependences from heap stores to heap loads.
-%% *** UNFINISHED ***
-%% - but works
-%% This is somewhat subtle:
-%% - a heap load can only bypass a heap store if we KNOW it won't
-%% load the stored value
-%% - unfortunately, we do not know the relationships between registers
-%% at this point, so we can't say that store(p+4) is independent of
-%% load(q+0).
-%% (OR CAN WE? A bit closer reasoning might show that it's possible?)
-%% - We can ONLY say that st(p+c) and ld(p+c') are independent when c /= c'
-%%
-%% (As said before, it might be possible to lighten this restriction?)
-
-hp_dep_only([], _Reg, _Off) -> [];
-hp_dep_only([{_N,Reg,Off_1}|Xs], Reg, Off) when Off_1 =/= Off ->
- hp_dep_only(Xs, Reg, Off);
-hp_dep_only([{N,_,_}|Xs], Reg, Off) ->
- [N|hp_dep_only(Xs, Reg, Off)].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Control dependences:
-%% - add dependences so that
-%% * branches are performed in order
-%% * unsafe operations are 'fenced in' by surrounding branches
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd
-%% Argument : IxBB - indexed block
-%% DAG - dependence graph
-%% Returns : DAG - new dependence graph
-%% Description : Adds conditional dependencies to the DAG
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd(IxBB,DAG) ->
- cd(IxBB, DAG, none, [], []).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd
-%% Argument : IxBB - indexed block
-%% DAG - dependence graph
-%% PrevBr - previous branch
-%% PrevUnsafe - previous unsafe instr (mem-op)
-%% PrevOthers - previous other instrs, used to "fix" preceeding
-%% instrs so they don't bypass a branch.
-%% Returns : DAG - new dependence graph
-%% Description : Adds conditional dependencies to the graph.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd([], DAG, _PrevBr, _PrevUnsafe, _PrevOthers) ->
- DAG;
-cd([{N,I}|Xs], DAG, PrevBr, PrevUnsafe, PrevOthers) ->
- case cd_type(I) of
- {branch,Ty} ->
- DAG1 = cd_branch_to_other_deps(N, PrevOthers, DAG),
- NewDAG = cd_branch_deps(PrevBr, PrevUnsafe, N, Ty, DAG1),
- cd(Xs,NewDAG,{N,Ty},[],[]);
- {unsafe,Ty} ->
- NewDAG = cd_unsafe_deps(PrevBr,N,Ty,DAG),
- cd(Xs, NewDAG, PrevBr, [{N,Ty}|PrevUnsafe], PrevOthers);
- {other,_Ty} ->
- cd(Xs, DAG, PrevBr, PrevUnsafe, [N|PrevOthers])
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd_branch_to_other_deps
-%% Argument : N - index of branch
-%% Ms - list of indexes of "others" preceding instrs
-%% DAG - dependence graph
-%% Returns : DAG - new graph
-%% Description : Makes preceding instrs fixed so they don't bypass a branch
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd_branch_to_other_deps(_, [], DAG) ->
- DAG;
-cd_branch_to_other_deps(N, [M | Ms], DAG) ->
- cd_branch_to_other_deps(N, Ms, dep_arc(M, zero_latency(), N, DAG)).
-
-%% Is the operation a branch, an unspeculable op or something else?
-
-%% Returns
-%% {branch,BranchType}
-%% {unsafe,OpType}
-%% {other,OpType}
-
-%% *** UNFINISHED ***
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd_type
-%% Argument : I - instr
-%% Description : Maps instrs to a simpler type.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd_type(I) ->
- case I of
- #goto{} ->
- {branch,uncond};
- #br{} ->
- {branch,'cond'};
- #b{} ->
- {branch,'cond'};
- #call_link{} ->
- {branch,call};
- #jmp_link{} ->
- {branch,call};
- #jmp{} ->
- {branch,call};
- #load{} ->
- {unsafe,load};
- #store{} ->
- {unsafe,load};
- T ->
- {other,T}
- end.
-
-%% add dependences to keep order of branches + unspeculable ops:
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd_branch_deps
-%% Argument : PrevBr - preceeding branch
-%% PrevUnsafe - preceeding unsafe ops, eg, mem-ops
-%% N - current id.
-%% Ty - type of current instr
-%% DAG - dependence graph
-%% Returns : DAG - new DAG
-%% Description : Adds arcs between branches and calls deps_to_unsafe that adds
-%% arcs between branches and unsafe ops.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd_branch_deps(PrevBr, PrevUnsafe, N, Ty, DAG) ->
- DAG1 = case PrevBr of
- none ->
- DAG;
- {Br,BrTy} ->
- dep_arc(Br,
- hipe_target_machine:br_br_latency(BrTy,Ty),
- N, DAG)
- end,
- deps_to_unsafe(PrevUnsafe, N, Ty, DAG1).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : deps_to_unsafe
-%% Description : Adds dependencies between unsafe's and branches
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-deps_to_unsafe([], _, _, DAG) -> DAG;
-deps_to_unsafe([{M,UTy}|Us], N, Ty, DAG) ->
- deps_to_unsafe(Us,N,Ty,
- dep_arc(M, hipe_target_machine:unsafe_to_br_latency(UTy,Ty),
- N, DAG)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cd_unsafe_deps
-%% Description : Adds dependencies between branches and unsafe's
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-cd_unsafe_deps(none, _, _, DAG) ->
- DAG;
-cd_unsafe_deps({Br,BrTy}, N, Ty, DAG) ->
- dep_arc(Br, hipe_target_machine:br_to_unsafe_latency(BrTy, Ty), N, DAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : def_use
-%% Argument : Instr
-%% Description : Returns the registers that Instr defines resp. uses as 2 lists
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-def_use(Instr) ->
- {hipe_sparc:defines(Instr), hipe_sparc:uses(Instr)}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : move_or_alu
-%% Description : True if the instruction is a move or an alu; false otherwise
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-move_or_alu(#move{}) -> true;
-move_or_alu(#alu{}) -> true;
-move_or_alu(_) -> false.
-
-%% Debugging stuff below %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
--ifdef(debug1).
-debug1_stuff(Blk, DAG, IxBlk, Sch, X) ->
- io:format("Blk: ~p~n",[Blk]),
- io:format("DAG: ~n~p~n~p",[DAG,IxBlk]),
- io:format("~n"),
- print_instrs(IxBlk),
- print_sch(Sch, IxBlk),
- print_instrs2(X).
-
-print_instrs([]) ->
- io:format("~n");
-print_instrs([{N,Instr} | Instrs]) ->
- io:format("(~p): ",[N]),
- hipe_sparc_pp:pp_instr(Instr),
- io:format("~p~n",[element(1,Instr)]),
- print_instrs(Instrs).
-
-print_instrs2([]) ->
- io:format("~n");
-print_instrs2([Instr | Instrs]) ->
- hipe_sparc_pp:pp_instr(Instr),
- print_instrs2(Instrs).
-
-print_sch([],_) -> io:format("~n");
-print_sch([{{cycle,Cycle},{node,I}} | Rest], IxBlk) ->
- io:format("{C~p, N~p} ",[Cycle,I]),
- print_node(I, IxBlk),
- print_sch(Rest, IxBlk).
-
-print_node(_, []) ->
- io:format("~n");
-print_node(I, [{I, Instr} | _]) ->
- hipe_sparc_pp:pp_instr(Instr);
-print_node(I, [_ | IxBlk]) ->
- print_node(I, IxBlk).
--else.
-debug1_stuff(_Blk, _DAG, _IxBlk, _Sch, _X) ->
- ok.
--endif.
diff --git a/lib/hipe/opt/hipe_schedule_prio.erl b/lib/hipe/opt/hipe_schedule_prio.erl
deleted file mode 100644
index 339bb82aab..0000000000
--- a/lib/hipe/opt/hipe_schedule_prio.erl
+++ /dev/null
@@ -1,53 +0,0 @@
-%% -*- erlang-indent-level: 2 -*-
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% PRIORITY HANDLING AND PRIORITY CALCULATION
-%%
-%% Handling of ready nodes and priorities.
-%% - at present, all nodes have the same priority and so on.
-%%
-%% *** UNFINISHED ***
-%% - should compute a static priority estimate
-%% - should dynamically modify priorities + possibly insert NOPs
-%% (e.g., to separate branches, etc.)
-%% - thus, ought to be passed the current schedule and/or resources as well
-
--module(hipe_schedule_prio).
--export([init_ready/2,
- init_instr_prio/2,
- %% initial_ready_set/4,
- next_ready/7,
- add_ready_nodes/2,
- insert_node/3
- ]).
-
-init_ready(Size,Preds) ->
- hipe_ultra_prio:init_ready(Size,Preds).
-
-init_instr_prio(N,DAG) ->
- hipe_ultra_prio:init_instr_prio(N,DAG).
-
-%% initial_ready_set(M,N,Preds,Ready) ->
-%% hipe_ultra_prio:initial_ready_set(M,N,Preds,Ready).
-
-next_ready(C,Ready,Prio,Nodes,DAG,Preds,Earl) ->
- hipe_ultra_prio:next_ready(C,Ready,Prio,Nodes,DAG,Preds,Earl).
-
-add_ready_nodes(NodeLst,Ready) ->
- hipe_ultra_prio:add_ready_nodes(NodeLst,Ready).
-
-insert_node(C,I,Ready) ->
- hipe_ultra_prio:insert_node(C,I,Ready).
diff --git a/lib/hipe/opt/hipe_target_machine.erl b/lib/hipe/opt/hipe_target_machine.erl
deleted file mode 100644
index 75993cb95e..0000000000
--- a/lib/hipe/opt/hipe_target_machine.erl
+++ /dev/null
@@ -1,87 +0,0 @@
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% INTERFACE TO TARGET MACHINE MODEL
-%%
-%% Interfaces the instruction scheduler to the (resource) machine model.
-
--module(hipe_target_machine).
--export([init_resources/1,
- init_instr_resources/2,
- resources_available/4,
- advance_cycle/1
- ]).
--export([raw_latency/2,
- war_latency/2,
- waw_latency/2,
- %% m_raw_latency/2,
- %% m_war_latency/2,
- %% m_waw_latency/2,
- m_raw_latency/0,
- m_war_latency/0,
- m_waw_latency/0,
- br_to_unsafe_latency/2,
- unsafe_to_br_latency/2,
- br_br_latency/2
- ]).
-
--define(target,hipe_ultra_mod2).
-
-init_resources(X) ->
- ?target:init_resources(X).
-
-init_instr_resources(X,Y) ->
- ?target:init_instr_resources(X,Y).
-
-resources_available(X,Y,Z,W) ->
- ?target:resources_available(X,Y,Z,W).
-
-advance_cycle(X) ->
- ?target:advance_cycle(X).
-
-raw_latency(From,To) ->
- ?target:raw_latency(From,To).
-
-war_latency(From,To) ->
- ?target:war_latency(From,To).
-
-waw_latency(From,To) ->
- ?target:waw_latency(From,To).
-
-%% m_raw_latency(From,To) ->
-%% ?target:m_raw_latency(From,To).
-
-%% m_war_latency(From,To) ->
-%% ?target:m_war_latency(From,To).
-
-%% m_waw_latency(From,To) ->
-%% ?target:m_waw_latency(From,To).
-
-m_raw_latency() ->
- ?target:m_raw_latency().
-
-m_war_latency() ->
- ?target:m_war_latency().
-
-m_waw_latency() ->
- ?target:m_waw_latency().
-
-br_to_unsafe_latency(Br,U) ->
- ?target:br_to_unsafe_latency(Br,U).
-
-unsafe_to_br_latency(U,Br) ->
- ?target:unsafe_to_br_latency(U,Br).
-
-br_br_latency(Br1,Br2) ->
- ?target:br_br_latency(Br1,Br2).
diff --git a/lib/hipe/opt/hipe_ultra_mod2.erl b/lib/hipe/opt/hipe_ultra_mod2.erl
deleted file mode 100644
index cec9c56a1e..0000000000
--- a/lib/hipe/opt/hipe_ultra_mod2.erl
+++ /dev/null
@@ -1,233 +0,0 @@
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% ULTRASPARC MACHINE MODEL
-%%
-%% This module is used by the scheduler.
-%% The following interface is used:
-%% ...
-%%
-%% NOTES:
-%% - the machine model is simple (on the verge of simplistic)
-%% * all FUs are pipelined => model only one cycle at a time
-%% * instruction latencies are mostly 1
-%% * floating point is left for later (I _think_ it works, but ...)
-%% - conservative: instructions that require multiple resources are
-%% modelled as 'single'; instead, they could reserve IEU+BR or whatever
-%% - possibly inefficient: I think machine state model could be turned into
-%% a bitvector.
-
--module(hipe_ultra_mod2).
--export([init_resources/1,
- init_instr_resources/2,
- resources_available/4,
- advance_cycle/1
- ]).
--export([raw_latency/2,
- war_latency/2,
- waw_latency/2,
- %% m_raw_latency/2,
- %% m_war_latency/2,
- %% m_waw_latency/2,
- m_raw_latency/0,
- m_war_latency/0,
- m_waw_latency/0,
- br_to_unsafe_latency/2,
- unsafe_to_br_latency/2,
- br_br_latency/2
- ]).
-
--include("../sparc/hipe_sparc.hrl").
-
--define(debug(Str,Args),ok).
-%-define(debug(Str,Args),io:format(Str,Args)).
-
--define(debug_ultra(Str,Args),ok).
-%-define(debug_ultra(Str,Args),io:format(Str,Args)).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Straightforward and somewhat simplistic model for UltraSparc:
-%% - only one cycle at a time is modelled
-%% - resources are simplified:
-%% * ieu0, ieu1, ieu, mem, br, single
-%% * per-cycle state = done | { I0, I1, NumI, X, Mem, Br }
-%% * unoptimized representation (could be bit vector)
-
-init_resources(_Size) ->
- ?debug_ultra('init res ~p~n',[_Size]),
- empty_state().
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-init_instr_resources(N,Nodes) ->
- ultra_instr_rsrcs(Nodes,hipe_vectors:new(N, '')).
-
-ultra_instr_rsrcs([],I_res) -> I_res;
-ultra_instr_rsrcs([N|Ns],I_res) ->
- ultra_instr_rsrcs(Ns,ultra_instr_type(N,I_res)).
-
-ultra_instr_type({N,I},I_res) ->
- hipe_vectors:set(I_res,N-1,instr_type(I)).
-
-instr_type(I) ->
- case I of
- #move{} ->
- ieu;
- #multimove{} -> %% TODO: expand multimoves before scheduling
- ieu;
- #alu{} ->
- case hipe_sparc:alu_operator(I) of
- '>>' -> ieu0;
- '<<' -> ieu0;
- _ -> ieu
- end;
- #alu_cc{} ->
- ieu1;
- #sethi{} ->
- ieu;
- #load{} ->
- mem;
- #store{} ->
- mem;
- #b{} ->
- br;
- #br{} ->
- br;
- #goto{} ->
- br;
- #jmp_link{} -> % imprecise; should be mem+br?
- single;
- #jmp{} -> % imprecise
- br;
- #call_link{} -> % imprecise; should be mem+br?
- single;
- #cmov_cc{} -> % imprecise
- single;
- #cmov_r{} -> % imprecise
- single;
- #load_atom{} -> % should be resolved to sethi/or
- single;
- #load_address{} -> % should be resolved to sethi/or
- single;
- #load_word_index{} -> % should be resolved to sethi/or
- single;
- %% uncommon types:
- #label{} ->
- none;
- #nop{} ->
- none;
- #comment{} ->
- none;
- _ ->
- exit({ultrasparc_instr_type,{cant_schedule,I}})
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-resources_available(_Cycle, I, Rsrc, I_res) ->
- res_avail(instruction_resource(I_res, I), Rsrc).
-
-instruction_resource(I_res, I) ->
- hipe_vectors:get(I_res, I-1).
-
-%% The following function checks resource availability.
-%% * all function units are assumed to be fully pipelined, so only
-%% one cycle at a time is modelled.
-%% * for IEU0 and IEU1, these must precede all generic IEU instructions
-%% (handled by X bit)
-%% * at most 2 integer instructions can issue in a cycle
-%% * mem is straightforward
-%% * br closes the cycle (= returns done).
-%% * single requires an entirely empty state and closes the cycle
-
-res_avail(ieu0, { free, I1, NumI, free, Mem, Br })
- when is_integer(NumI), NumI < 2 ->
- { yes, { occ, I1, NumI+1, free, Mem, Br }};
-res_avail(ieu1, { _I0, free, NumI, free, Mem, Br })
- when is_integer(NumI), NumI < 2 ->
- { yes, { free, occ, NumI+1, free, Mem, Br }};
-res_avail(ieu, { I0, I1, NumI, _X, Mem, Br })
- when is_integer(NumI), NumI < 2 ->
- { yes, { I0, I1, NumI+1, occ, Mem, Br }};
-res_avail(mem, { I0, I1, NumI, X, free, Br }) ->
- { yes, { I0, I1, NumI, X, occ, Br }};
-res_avail(br, { _I0, _I1, _NumI, _X, _Mem, free }) ->
- { yes, done };
-res_avail(single, { free, free, 0, free, free, free }) ->
- { yes, done };
-res_avail(_, _) ->
- no.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-advance_cycle(_Rsrc) ->
- empty_state().
-
-empty_state() -> { free, free, 0, free, free, free }.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Latencies are taken from UltraSparc hardware manual
-%%
-%% *** UNFINISHED ***
-%% more precisely, they are taken from my memory of the US-manual
-%% at the moment.
-%%
-%% Note: all ld/st are assumed to hit in the L1 cache (D-cache),
-%% which is sort of imprecise.
-
-raw_latency(alu, store) -> 0;
-raw_latency(load, _) -> 2; % only if load is L1 hit
-raw_latency(alu_cc, b) -> 0;
-raw_latency(_I0, _I1) ->
- 1.
-
-war_latency(_I0, _I1) ->
- 0.
-
-waw_latency(_I0, _I1) ->
- 1.
-
-%% *** UNFINISHED ***
-%% At present, all load/stores are assumed to hit in the L1 cache,
-%% which isn't really satisfying.
-
-%% m_raw_latency(_St, _Ld) ->
-%% 1.
-%%
-%% m_war_latency(_Ld, _St) ->
-%% 1.
-%%
-%% m_waw_latency(_St1, _St2) ->
-%% 1.
-
-%% Use these for 'default latencies' = do not permit reordering.
-
-m_raw_latency() ->
- 1.
-
-m_war_latency() ->
- 1.
-
-m_waw_latency() ->
- 1.
-
-br_to_unsafe_latency(_BrTy, _UTy) ->
- 0.
-
-unsafe_to_br_latency(_UTy, _BrTy) ->
- 0.
-
-br_br_latency(_BrTy1, _BrTy2) ->
- 0.
diff --git a/lib/hipe/opt/hipe_ultra_prio.erl b/lib/hipe/opt/hipe_ultra_prio.erl
deleted file mode 100644
index 6dd240a33a..0000000000
--- a/lib/hipe/opt/hipe_ultra_prio.erl
+++ /dev/null
@@ -1,298 +0,0 @@
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% PRIORITY HANDLING AND PRIORITY CALCULATION
-%%
-%% Handling of ready nodes and priorities.
-%% Priorities are mainly from the critical path. More priorities are added.
-%% * One version is adding priorities just depending on the instr, so
-%% for example loads get higher priority than stores, and ordered
-%% after reg's and offset for better cache performance.
-%% * The other version gives higher priority to a node that adds more new
-%% nodes to the ready list. This one is maybe not so effectively
-%% implemented, but was added too late for smarter solutions.
-%% One version is commented away
-
--module(hipe_ultra_prio).
--export([init_ready/2,
- init_instr_prio/2,
- %% initial_ready_set/4,
- next_ready/7,
- add_ready_nodes/2,
- insert_node/3
- ]).
-
--include("../sparc/hipe_sparc.hrl").
-
-% At first, only nodes with no predecessors are selected.
-% - if R is empty, there is an error (unless BB itself is empty)
-
-%% Arguments : Size - size of ready-array
-%% Preds - array with number of predecessors for each node
-%% Returns : An array with list of ready-nodes for each cycle.
-
-init_ready(Size, Preds) ->
- P = hipe_vectors:size(Preds),
- Ready = hipe_vectors:new(Size, []),
- R = initial_ready_set(1, P, Preds, []),
- hipe_vectors:set(Ready, 0, R).
-
-init_instr_prio(N, DAG) ->
- critical_path(N, DAG).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : initial_ready_set
-%% Argument : M - current node-index
-%% N - where to stop
-%% Preds - array with number of predecessors for each node
-%% Ready - list with ready-nodes
-%% Returns : Ready - list with ready-nodes
-%% Description : Finds all nodes with no predecessors and adds them to ready.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-initial_ready_set(M, N, Preds, Ready) ->
- if
- M > N ->
- Ready;
- true ->
- case hipe_vectors:get(Preds, M-1) of
- 0 ->
- initial_ready_set(M+1, N, Preds, [M|Ready]);
- V when is_integer(V), V > 0 ->
- initial_ready_set(M+1, N, Preds, Ready)
- end
- end.
-
-%% The following handles the nodes ready to schedule:
-%% 1. select the ready queue of given cycle
-%% 2. if queue empty, return none
-%% 3. otherwise, remove entry with highest priority
-%% and return {next,Highest_Prio,NewReady}
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : next_ready
-%% Argument : C - current cycle
-%% Ready - array with ready nodes
-%% Prio - array with cpath-priorities for all nodes
-%% Nodes - indexed list [{N, Instr}]
-%% Returns : none / {next,Highest_Prio,NewReady}
-%% Description : 1. select the ready queue of given cycle
-%% 2. if queue empty, return none
-%% 3. otherwise, remove entry with highest priority
-%% and return {next,Highest_Prio,NewReady} where Highest_Prio
-%% = Id of instr and NewReady = updated ready-array.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-next_ready(C, Ready, Prio, Nodes, DAG, Preds, Earl) ->
- Curr = hipe_vectors:get(Ready, C-1),
- case Curr of
- [] ->
- none;
- Instrs ->
- {BestI,RestIs} =
- get_best_instr(Instrs, Prio, Nodes, DAG, Preds, Earl, C),
- {next,BestI,hipe_vectors:set(Ready,C-1,RestIs)}
- end.
-
-% next_ready(C,Ready,Prio,Nodes) ->
-% Curr = hipe_vectors:get(Ready,C-1),
-% case Curr of
-% [] ->
-% none;
-% Instrs ->
-% {BestInstr,RestInstrs} = get_best_instr(Instrs, Prio, Nodes),
-% {next,BestInstr,hipe_vectors:set(Ready,C-1,RestInstrs)}
-% end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : get_best_instr
-%% Argument : Instrs - list of node-id's
-%% Prio - array with cpath-priorities for the nodes
-%% Nodes - indexed list [{Id, Instr}]
-%% Returns : {BestSoFar, Rest} - Id of best instr and the rest of id's
-%% Description : Returns the id of the instr that is the best choice.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-get_best_instr([Instr|Instrs], Prio, Nodes, DAG, Preds, Earl, C) ->
- get_best_instr(Instrs, [], Instr, Prio, Nodes, DAG, Preds, Earl, C).
-
-get_best_instr([], Rest, BestSoFar, _Prio, _Nodes, _DAG, _Preds, _Earl, _C) ->
- {BestSoFar, Rest};
-get_best_instr([Instr|Instrs], PassedInstrs, BestSoFar, Prio, Nodes,
- DAG, Preds, Earl, C) ->
- case better(Instr, BestSoFar, Prio, Nodes, DAG, Preds, Earl, C) of
- true ->
- get_best_instr(Instrs, [BestSoFar|PassedInstrs],
- Instr, Prio, Nodes, DAG, Preds, Earl, C);
- false ->
- get_best_instr(Instrs, [Instr|PassedInstrs], BestSoFar, Prio,
- Nodes, DAG, Preds, Earl, C)
- end.
-
-% get_best_instr([Instr|Instrs], Prio, Nodes) ->
-% get_best_instr(Instrs, [], Instr, Prio, Nodes).
-
-% get_best_instr([], Rest, BestSoFar, Prio, Nodes) -> {BestSoFar, Rest};
-% get_best_instr([Instr|Instrs], PassedInstrs, BestSoFar, Prio, Nodes) ->
-% case better(Instr, BestSoFar, Prio, Nodes) of
-% true ->
-% get_best_instr(Instrs, [BestSoFar|PassedInstrs],
-% Instr, Prio, Nodes);
-% false ->
-% get_best_instr(Instrs, [Instr|PassedInstrs],BestSoFar, Prio, Nodes)
-% end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : better
-%% Argument : Instr1 - Id of instr 1
-%% Instr2 - Id of instr 2
-%% Prio - array with cpath-priorities for the nodes
-%% Nodes - indexed list [{Id, Instr}]
-%% Returns : true if Instr1 has higher priority than Instr2
-%% Description : Checks if Instr1 is a better choice than Instr2 for scheduling
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-better(Instr1, Instr2, Prio, Nodes, DAG, Preds, Earl, C) ->
- better_hlp(priority(Instr1, Prio, Nodes, DAG, Preds, Earl, C),
- priority(Instr2, Prio, Nodes, DAG, Preds, Earl, C)).
-
-better_hlp([], []) -> false;
-better_hlp([], [_|_]) -> false;
-better_hlp([_|_], []) -> true;
-better_hlp([X|Xs], [Y|Ys]) -> (X > Y) or ((X =:= Y) and better_hlp(Xs,Ys)).
-
-%%
-%% Returns the instr corresponding to id
-%%
-get_instr(InstrId, [{InstrId,Instr}|_]) -> Instr;
-get_instr(InstrId, [_|Xs]) -> get_instr(InstrId, Xs).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : priority
-%% Argument : InstrId - Id
-%% Prio - array with cpath-priorities for the nodes
-%% Nodes - indexed list [{Id, Instr}]
-%% Returns : PrioList - list of priorities [MostSignificant, LessSign, ...]
-%% Description : Returns a list of priorities where the first element is the
-%% cpath-priority and the rest are added depending on what kind
-%% of instr it is. Used to order loads/stores sequentially and
-%% there is possibility to add whatever stuff...
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-priority(InstrId, Prio, Nodes, DAG, Preds, Earl, C) ->
- {ReadyNodes,_,_,_} = hipe_schedule:delete_node(C,InstrId,DAG,Preds,Earl),
- Instr = get_instr(InstrId, Nodes),
- Prio1 = hipe_vectors:get(Prio, InstrId-1),
- Prio2 = length(ReadyNodes),
- PrioRest =
- case Instr of
- #load_atom{} ->
- [3];
- #move{} ->
- [3];
- #load{} ->
- Src = hipe_sparc:load_src(Instr),
- Off = hipe_sparc:load_off(Instr),
- case hipe_sparc:is_reg(Off) of
- false -> [3,
- -(hipe_sparc:reg_nr(Src)),
- -(hipe_sparc:imm_value(Off))];
- true -> [1]
- end;
- #store{} ->
- Src = hipe_sparc:store_dest(Instr),
- Off = hipe_sparc:store_off(Instr),
- case hipe_sparc:is_reg(Off) of
- false -> [2,
- -(hipe_sparc:reg_nr(Src)),
- -(hipe_sparc:imm_value(Off))];
- true -> [1]
- end;
- _ -> [0]
- end,
- [Prio1,Prio2|PrioRest].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : add_ready_nodes
-%% Argument : Nodes - list of [{Cycle,Id}]
-%% Ready - array of ready nodes for all cycles
-%% Returns : NewReady - updated ready-array
-%% Description : Gets a list of instrs and adds them to the ready-array
-%% to the corresponding cycle.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-add_ready_nodes([], Ready) -> Ready;
-add_ready_nodes([{C,I}|Xs], Ready) ->
- add_ready_nodes(Xs, insert_node(C, I, Ready)).
-
-insert_node(C, I, Ready) ->
- Old = hipe_vectors:get(Ready, C-1),
- hipe_vectors:set(Ready, C-1, [I|Old]).
-
-%%
-%% Computes the latency for the "most expensive" way through the graph
-%% for all nodes. Returns an array of priorities for all nodes.
-%%
-critical_path(N, DAG) ->
- critical_path(1, N, DAG, hipe_vectors:new(N, -1)).
-
-critical_path(M, N, DAG, Prio) ->
- if
- M > N ->
- Prio;
- true ->
- critical_path(M+1, N, DAG, cpath(M, DAG, Prio))
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Function : cpath
-%% Argument : M - current node id
-%% DAG - the dependence graph
-%% Prio - array of priorities for all nodes
-%% Returns : Prio - updated prio array
-%% Description : If node has prio -1, it has not been visited
-%% - otherwise, compute priority as max of priorities of
-%% successors (+ latency)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-cpath(M, DAG, Prio) ->
- InitPrio = hipe_vectors:get(Prio, M-1),
- if
- InitPrio =:= -1 ->
- cpath_node(M, DAG, Prio);
- true ->
- Prio
- end.
-
-cpath_node(N, DAG, Prio) ->
- SuccL = dag_succ(DAG, N),
- {Max, NewPrio} = cpath_succ(SuccL, DAG, Prio),
- hipe_vectors:set(NewPrio, N-1, Max).
-
-cpath_succ(SuccL, DAG, Prio) ->
- cpath_succ(SuccL, DAG, Prio, 0).
-
-%% performs an unnecessary lookup of priority of Succ, but that might
-%% not be such a big deal
-
-cpath_succ([], _DAG, Prio, NodePrio) -> {NodePrio,Prio};
-cpath_succ([{Lat,Succ}|Xs], DAG, Prio, NodePrio) ->
- NewPrio = cpath(Succ, DAG, Prio),
- NewNodePrio = erlang:max(hipe_vectors:get(NewPrio, Succ - 1) + Lat, NodePrio),
- cpath_succ(Xs, DAG, NewPrio, NewNodePrio).
-
-dag_succ(DAG, N) when is_integer(N) ->
- hipe_vectors:get(DAG, N-1).
-
diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl
index 3206d957d9..b49b3a7093 100644
--- a/lib/inets/src/http_server/mod_esi.erl
+++ b/lib/inets/src/http_server/mod_esi.erl
@@ -561,7 +561,7 @@ eval(#mod{method = Method} = ModData, ESIBody, Modules)
end.
generate_webpage(ESIBody) ->
- (catch lib:eval_str(string:concat(ESIBody,". "))).
+ (catch eval_str(string:concat(ESIBody,". "))).
is_authorized(_ESIBody, [all]) ->
true;
@@ -573,3 +573,45 @@ is_authorized(ESIBody, Modules) ->
nomatch ->
false
end.
+
+%% eval_str(InStr) -> {ok, OutStr} | {error, ErrStr'}
+%% InStr must represent a body
+%% Note: If InStr is a binary it has to be a Latin-1 string.
+%% If you have a UTF-8 encoded binary you have to call
+%% unicode:characters_to_list/1 before the call to eval_str().
+
+-define(result(F,D), lists:flatten(io_lib:format(F, D))).
+
+-spec eval_str(string()) ->
+ {'ok', string()} | {'error', string()}.
+
+eval_str(Str) when is_list(Str) ->
+ case erl_scan:tokens([], Str, 0) of
+ {more, _} ->
+ {error, "Incomplete form (missing .<cr>)??"};
+ {done, {ok, Toks, _}, Rest} ->
+ case all_white(Rest) of
+ true ->
+ case erl_parse:parse_exprs(Toks) of
+ {ok, Exprs} ->
+ case catch erl_eval:exprs(Exprs, erl_eval:new_bindings()) of
+ {value, Val, _} ->
+ {ok, Val};
+ Other ->
+ {error, ?result("*** eval: ~p", [Other])}
+ end;
+ {error, {_Line, Mod, Args}} ->
+ Msg = ?result("*** ~ts",[Mod:format_error(Args)]),
+ {error, Msg}
+ end;
+ false ->
+ {error, ?result("Non-white space found after "
+ "end-of-form :~ts", [Rest])}
+ end
+ end.
+
+all_white([$\s|T]) -> all_white(T);
+all_white([$\n|T]) -> all_white(T);
+all_white([$\t|T]) -> all_white(T);
+all_white([]) -> true;
+all_white(_) -> false.
diff --git a/lib/kernel/doc/src/Makefile b/lib/kernel/doc/src/Makefile
index 82869d7b15..29dc73a523 100644
--- a/lib/kernel/doc/src/Makefile
+++ b/lib/kernel/doc/src/Makefile
@@ -42,6 +42,7 @@ XML_REF3_FILES = application.xml \
disk_log.xml \
erl_boot_server.xml \
erl_ddll.xml \
+ erl_epmd.xml \
erl_prim_loader_stub.xml \
erlang_stub.xml \
error_handler.xml \
diff --git a/lib/kernel/doc/src/erl_epmd.xml b/lib/kernel/doc/src/erl_epmd.xml
new file mode 100644
index 0000000000..8b076cd2d7
--- /dev/null
+++ b/lib/kernel/doc/src/erl_epmd.xml
@@ -0,0 +1,104 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2018</year><year>2018</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+
+ </legalnotice>
+
+ <title>erl_epmd</title>
+ <prepared>Timmo Verlaan</prepared>
+ <docno>1</docno>
+ <date>2018-02-19</date>
+ <rev>A</rev>
+ </header>
+ <module>erl_epmd</module>
+ <modulesummary>
+ Erlang interface towards epmd
+ </modulesummary>
+ <description>
+ <p>This module communicates with the EPMD daemon, see <seealso
+ marker="erts:epmd">epmd</seealso>. To implement your own epmd module please
+ see <seealso marker="erts:alt_disco">ERTS User's Guide: How to Implement an
+ Alternative Service Discovery for Erlang Distribution</seealso></p>
+ </description>
+
+ <funcs>
+ <func>
+ <name name="start_link" arity="0"/>
+ <fsummary>Callback for erl_distribution supervisor.</fsummary>
+ <desc>
+ <p>This function is invoked as this module is added as a child of the
+ <c>erl_distribution</c> supervisor.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="register_node" arity="2"/>
+ <name name="register_node" arity="3"/>
+ <fsummary>Registers the node with <c>epmd</c>.</fsummary>
+ <desc>
+ <p>Registers the node with <c>epmd</c> and tells epmd what port will be
+ used for the current node. It returns a creation number. This number is
+ incremented on each register to help with identifying if a node is
+ reconnecting to epmd.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="port_please" arity="2"/>
+ <name name="port_please" arity="3"/>
+ <fsummary>Returns the port number for a given node.</fsummary>
+ <desc>
+ <p>Requests the distribution port for the given node of an EPMD
+ instance. Together with the port it returns a distribution protocol
+ version which has been 5 since Erlang/OTP R6.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="address_please" arity="3"/>
+ <fsummary>Returns address and port.</fsummary>
+ <desc>
+ <p>Called by the distribution module. Resolves the <c>Host</c> to an IP
+ address.</p>
+ <p>Another epmd module may return port and distribution protocol version
+ as well.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="names" arity="1"/>
+ <fsummary>Names of Erlang nodes at a host.</fsummary>
+ <desc>
+ <p>Called by <seealso marker="net_adm"><c>net_adm:names/0</c></seealso>.
+ <c>Host</c> defaults to the localhost. Returns the names and associated
+ port numbers of the Erlang nodes that <c>epmd</c> registered at the
+ specified host. Returns <c>{error, address}</c> if <c>epmd</c> is not
+ operational.</p>
+ <p><em>Example:</em></p>
+ <pre>
+(arne@dunn)1> <input>erl_epmd:names(localhost).</input>
+{ok,[{"arne",40262}]}</pre>
+ </desc>
+ </func>
+ </funcs>
+
+</erlref>
+
diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml
index 554d675383..7894600c21 100644
--- a/lib/kernel/doc/src/kernel_app.xml
+++ b/lib/kernel/doc/src/kernel_app.xml
@@ -122,21 +122,6 @@
application. For more information about configuration parameters,
see file <seealso marker="app"><c>app(4)</c></seealso>.</p>
<taglist>
- <tag><c>browser_cmd = string() | {M,F,A}</c></tag>
- <item>
- <p>When pressing the <em>Help</em> button in a tool such as Debugger,
- the help text (an HTML file <c>File</c>) is by default
- displayed in a Netscape browser, which is required to be
- operational. This parameter can be used to change the command for
- how to display the help text if another browser than Netscape
- is preferred, or if another platform than Unix or Windows is
- used.</p>
- <p>If set to a string <c>Command</c>, the command
- <c>"Command File"</c> is evaluated using
- <seealso marker="os#cmd/1"><c>os:cmd/1</c></seealso>.</p>
- <p>If set to a module-function-args tuple, <c>{M,F,A}</c>,
- the call <c>apply(M,F,[File|A])</c> is evaluated.</p>
- </item>
<tag><c>distributed = [Distrib]</c></tag>
<item>
<p>Specifies which applications that are distributed and on which
@@ -226,7 +211,7 @@
<p>This configuration parameter is used both for the global
logger level, and for the standard handler started by
the Kernel application (see <c>logger_dest</c> variable above).</p>
- <p>The default value is <c>info</c></p>
+ <p>The default value is <c>info</c>.</p>
</item>
<tag><marker id="disk_log_vars"/>
<c>logger_disk_log_type = halt | wrap</c></tag>
@@ -251,14 +236,14 @@ logger_disk_log_maxbytes = 1048576</code>
<item>
<p>If this parameter is set to true, then the logger handler
started by kernel will not log any progress-, crash-, or
- supervisor reports. If the SASL application is starated,
+ supervisor reports. If the SASL application is started,
these log events will be sent to a second handler instance
- named sasl_h, according to values of the SASL environment
- variables <c>sasl_error_logger</c>
+ named <c>sasl_h</c>, according to values of the SASL
+ environment variables <c>sasl_error_logger</c>
and <c>sasl_errlog_type</c>, see
<seealso marker="sasl:sasl_app#configuration">SASL(6)
</seealso></p>
- <p>The default value is <c>false</c></p>
+ <p>The default value is <c>false</c>.</p>
<p>See chapter <seealso marker="logger_chapter#compatibility">Backwards
compatibility with error_logger</seealso> for more
information about handling of the so called SASL reports.</p>
@@ -271,7 +256,7 @@ logger_disk_log_maxbytes = 1048576</code>
reports from <c>supervisor</c>
and <c>application_controller</c> shall be logged or
not.</p>
- <p>If <c>logger_sasl_compatible = false</c>,
+ <p>If <c>logger_sasl_compatible = true</c>,
then <c>logger_log_progress</c> is ignored.</p>
</item>
<tag><marker id="logger_format_depth"/>
@@ -280,14 +265,6 @@ logger_disk_log_maxbytes = 1048576</code>
<p>Can be used to limit the size of the
formatted output from the logger handlers.</p>
- <note><p>This configuration parameter was introduced in OTP 18.1
- and is experimental. Based on user feedback, it
- can be changed or improved in future releases, for example,
- to gain better control over how to limit the size of the
- formatted output. We have no plans to remove this
- new feature entirely, unless it turns out to be
- useless.</p></note>
-
<p><c>Depth</c> is a positive integer representing the maximum
depth to which terms are printed by the logger
handlers included in OTP. This
@@ -312,11 +289,11 @@ logger_disk_log_maxbytes = 1048576</code>
</item>
<tag><c>logger_max_size = integer() | unlimited</c></tag>
<item>
- <p>This parameter specifies the maximum size (bytes) each
- log event can have when printed by the standard logger
- handler. If the resulting string after formatting an event
- is bigger than this, it will be truncated before printed
- to the handler's destination.</p>
+ <p>This parameter specifies a hard maximum size limit (number
+ of characters) each log event can have when printed by the
+ default logger formatter. If the resulting string after
+ formatting an event is bigger than this, it will be
+ truncated before printed to the handler's destination.</p>
</item>
<tag><c>logger_utc = boolean()</c></tag>
<item>
diff --git a/lib/kernel/doc/src/logger.xml b/lib/kernel/doc/src/logger.xml
index 66e6e5c689..d901454e62 100644
--- a/lib/kernel/doc/src/logger.xml
+++ b/lib/kernel/doc/src/logger.xml
@@ -67,37 +67,86 @@
<datatype>
<name name="metadata"/>
<desc>
- <p>Metadata associated with the message to be logged.</p>
+ <p>Metadata for the log event.</p>
+ <p>Logger adds the following metadata to each log event:</p>
+ <list>
+ <item><c>pid => self()</c></item>
+ <item><c>gl => group_leader()</c></item>
+ <item><c>time => erlang:monotonic_time(microsecond)</c></item>
+ </list>
+ <p>When a log macro is used, Logger also inserts location
+ information:</p>
+ <list>
+ <item><c>mfa => {?MODULE,?FUNCTION_NAME,?FUNCTION_ARITY}</c></item>
+ <item><c>file => ?FILE</c></item>
+ <item><c>line => ?LINE</c></item>
+ </list>
+ <p>You can add custom metadata, either by specifying a map as
+ the last parameter to any of the log macros or the API
+ functions, or by setting process metadata
+ with <seealso marker="#set_process_metadata-1">
+ <c>set_process_metadata/1</c></seealso>
+ or <seealso marker="#update_process_metadata-1">
+ <c>update_process_metadata/1</c></seealso>.</p>
+ <p>Logger merges all the metadata maps before forwarding the
+ log event to the handlers. If the same keys occur, values
+ from the log call overwrites process metadata, which in turn
+ overwrites values set by Logger.</p>
</desc>
</datatype>
<datatype>
<name name="config"/>
<desc>
- <p></p>
+ <p>Configuration data for the logger part of Logger, or for a handler.</p>
+ <p>The following default values apply:</p>
+ <list>
+ <item><c>level => info</c></item>
+ <item><c>filter_default => log</c></item>
+ <item><c>filters => []</c></item>
+ <item><c>formatter => {logger_formatter,DefaultFormatterConfig</c>}</item>
+ </list>
+ <p>See the <seealso marker="logger_formatter#configuration">
+ <c>logger_formatter(3)</c></seealso> manual page for
+ information about the default configuration for this
+ formatter.</p>
</desc>
</datatype>
<datatype>
<name name="handler_id"/>
<desc>
- <p></p>
+ <p>A unique identifier for a handler instance.</p>
</desc>
</datatype>
<datatype>
<name name="filter_id"/>
<desc>
- <p></p>
+ <p>A unique identifier for a filter.</p>
</desc>
</datatype>
<datatype>
<name name="filter"/>
<desc>
- <p></p>
+ <p>A filter which can be installed for logger or for a handler.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="filter_arg"/>
+ <desc>
+ <p>The second argument to the filter fun.</p>
</desc>
</datatype>
<datatype>
<name name="filter_return"/>
<desc>
- <p></p>
+ <p>The return value from the filter fun.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="timestamp"/>
+ <desc>
+ <p>A timestamp produced
+ with <seealso marker="erts:erlang#monotonic_time-1">
+ <c>erlang:monotonic_time(microsecond)</c></seealso>.</p>
</desc>
</datatype>
</datatypes>
@@ -126,14 +175,10 @@
</list>
<p>All macros expand to a call to logger, where <c>Level</c> is
- taken from the macro name, and the following metadata is added,
- or merged with the given <c>Metadata</c>:</p>
-
- <code>
-#{mfa=>{?MODULE,?FUNCTION_NAME,?FUNCTION_ARITY},
- file=>?FILE,
- line=>?LINE}
- </code>
+ taken from the macro name, and location data is added. See the
+ description of
+ the <seealso marker="#type-metadata"><c>metadata()</c></seealso>
+ type for more information about the location data.</p>
<p>The call is wrapped in a case statement and will be evaluated
only if <c>Level</c> is equal to or below the configured log
@@ -267,7 +312,7 @@
<func>
<name name="i" arity="0"/>
- <fsummary>Get information about all logger configurations</fsummary>
+ <fsummary>Get all logger configurations</fsummary>
<desc>
<p>Same as <seealso marker="#i/1"><c>logger:i(term)</c></seealso></p>
</desc>
@@ -277,27 +322,30 @@
<name name="i" arity="1" clause_i="1"/>
<name name="i" arity="1" clause_i="2"/>
<name name="i" arity="1" clause_i="3"/>
- <fsummary>Get information about all logger configurations</fsummary>
+ <fsummary>Get all logger configurations</fsummary>
<desc>
- <p>The <c>logger:i/1</c> function can be used to get all
- current logger configuration. The way that the information
- is returned depends on the <c><anno>Action</anno></c></p>
+ <p>Display or return all current logger configuration.</p>
<taglist>
- <tag>string</tag>
- <item>Return the pretty printed current logger configuration
- as iodata.</item>
- <tag>term</tag>
- <item>Return the current logger configuration as a term. The
- format of this term may change inbetween releases. For a
- stable format use <seealso marker="#get_handler_config/1">
+ <tag><c><anno>Action</anno> = string</c></tag>
+ <item>
+ <p>Return the pretty printed current logger configuration
+ as iodata.</p>
+ </item>
+ <tag><c><anno>Action</anno> = term</c></tag>
+ <item>
+ <p>Return the current logger configuration as a term. The
+ format of this term may change inbetween releases. For a
+ stable format use <seealso marker="#get_handler_config/1">
<c>logger:get_handler_config/1</c></seealso>
- and <seealso marker="#get_logger_config/0">
+ and <seealso marker="#get_logger_config/0">
<c>logger:get_logger_config/0</c></seealso>.
- The same as calling <c>logger:i()</c>.</item>
- <tag>print</tag>
- <item>Pretty print all the current logger configuration to
- standard out. Example:
- <code><![CDATA[1> logger:i().
+ The same as calling <c>logger:i()</c>.</p>
+ </item>
+ <tag><c><anno>Action</anno> = print</c></tag>
+ <item>
+ <p>Pretty print all the current logger configuration to
+ standard out. Example:</p>
+ <code><![CDATA[1> logger:i(print).
Current logger configuration:
Level: info
FilterDefault: log
@@ -339,6 +387,39 @@ Current logger configuration:
<fsummary>Add a filter to the logger.</fsummary>
<desc>
<p>Add a filter to the logger.</p>
+ <p>The filter fun is called with the log event as the first
+ parameter, and the specified <c>filter_args()</c> as the
+ second parameter.</p>
+ <p>The return value of the fun specifies if a log event is to
+ be discarded or forwarded to the handlers:</p>
+ <taglist>
+ <tag><c>log()</c></tag>
+ <item>
+ <p>The filter <em>passed</em>. The next logger filter, if
+ any, is applied. If no more logger filters exist, the
+ log event is forwarded to the handler part of the
+ logger, where handler filters are applied.</p>
+ </item>
+ <tag><c>stop</c></tag>
+ <item>
+ <p>The filter <em>did not pass</em>, and the log event is
+ immediately discarded.</p>
+ </item>
+ <tag><c>ignore</c></tag>
+ <item>
+ <p>The filter has no knowledge of the log event. The next
+ logger filter, if any, is applied. If no more logger
+ filters exist, the value of the <c>filter_default</c>
+ configuration parameter for the logger specifies if the
+ log event shall be discarded or forwarded to the handler
+ part.</p>
+ </item>
+ </taglist>
+ <p>See section <seealso marker="logger_chapter#Filter">
+ Filter</seealso> in the User's Guide for more information
+ about filters.</p>
+ <p>Some built-in filters exist. These are defined
+ in <seealso marker="logger_filters"><c>logger_filters</c></seealso>.</p>
</desc>
</func>
@@ -347,6 +428,39 @@ Current logger configuration:
<fsummary>Add a filter to the specified handler.</fsummary>
<desc>
<p>Add a filter to the specified handler.</p>
+ <p>The filter fun is called with the log event as the first
+ parameter, and the specified <c>filter_args()</c> as the
+ second parameter.</p>
+ <p>The return value of the fun specifies if a log event is to
+ be discarded or forwarded to the handler callback:</p>
+ <taglist>
+ <tag><c>log()</c></tag>
+ <item>
+ <p>The filter <em>passed</em>. The next handler filter, if
+ any, is applied. If no more filters exist for this
+ handler, the log event is forwarded to the handler
+ callback.</p>
+ </item>
+ <tag><c>stop</c></tag>
+ <item>
+ <p>The filter <em>did not pass</em>, and the log event is
+ immediately discarded.</p>
+ </item>
+ <tag><c>ignore</c></tag>
+ <item>
+ <p>The filter has no knowledge of the log event. The next
+ handler filter, if any, is applied. If no more filters
+ exist for this handler, the value of
+ the <c>filter_default</c> configuration parameter for
+ the handler specifies if the log event shall be
+ discarded or forwarded to the handler callback.</p>
+ </item>
+ </taglist>
+ <p>See
+ section <seealso marker="logger_chapter#Filter">Filter</seealso>
+ in the User's Guide for more information about filters.</p>
+ <p>Some built-in filters exist. These are defined in
+ <seealso marker="logger_filters"><c>logger_filters</c></seealso>.</p>
</desc>
</func>
@@ -354,7 +468,8 @@ Current logger configuration:
<name name="remove_logger_filter" arity="1"/>
<fsummary>Remove a filter from the logger.</fsummary>
<desc>
- <p>Remove the filter with the specified identity from the logger.</p>
+ <p>Remove the filter identified
+ by <c><anno>FilterId</anno></c> from the logger.</p>
</desc>
</func>
@@ -362,7 +477,9 @@ Current logger configuration:
<name name="remove_handler_filter" arity="2"/>
<fsummary>Remove a filter from the specified handler.</fsummary>
<desc>
- <p>Remove the filter with the specified identity from the given handler.</p>
+ <p>Remove the filter identified
+ by <c><anno>FilterId</anno></c> from the handler identified
+ by <c><anno>HandlerId</anno></c>.</p>
</desc>
</func>
@@ -371,6 +488,9 @@ Current logger configuration:
<fsummary>Add a handler with the given configuration.</fsummary>
<desc>
<p>Add a handler with the given configuration.</p>
+ <p><c><anno>HandlerId</anno></c> is a unique identifier which
+ must be used in all subsequent calls reffering to this
+ handler.</p>
</desc>
</func>
@@ -378,7 +498,7 @@ Current logger configuration:
<name name="remove_handler" arity="1"/>
<fsummary>Remove the handler with the specified identity.</fsummary>
<desc>
- <p>Remove the handler with the specified identity.</p>
+ <p>Remove the handler identified by <c><anno>HandlerId</anno></c>.</p>
</desc>
</func>
@@ -386,10 +506,37 @@ Current logger configuration:
<name name="set_module_level" arity="2"/>
<fsummary>Set the log level for the specified module.</fsummary>
<desc>
- <p>Set the log level for the specified module.</p>
- <p>To change the logging level globally, use
- <seealso marker="#set_logger_config/2"><c>logger:set_logger_config(level, Level)</c></seealso>.
- </p>
+ <p>Set the log level for the
+ specified <c><anno>Module</anno></c>.</p>
+ <p>The log level for a module overrides the global log level
+ of the logger for log event originating from the module in
+ question. Notice, however, that it does not override the
+ level configuration for any handler.</p>
+ <p>For example: Assume that the global log level for the
+ logger is <c>info</c>, and there is one handler, <c>h1</c>,
+ with level <c>info</c> and one handler, <c>h2</c>, with
+ level <c>debug</c>.</p>
+ <p>With this configuration, no debug messages will be logged,
+ since they are all stopped by the global log level.</p>
+ <p>If the level for <c>mymodule</c> is set now set
+ to <c>debug</c>, then debug events from this module will be
+ logged by the handler <c>h2</c>, but not by
+ handler <c>h1</c>.</p>
+ <p>Debug events from other modules are still not logged.</p>
+ <p>To change the global log level for the logger, use
+ <seealso marker="#set_logger_config/2">
+ <c>logger:set_logger_config(level,Level)</c></seealso>.</p>
+ <p>To change the log level for a handler, use
+ <seealso marker="#set_handler_config/3">
+ <c>logger:set_handler_config(HandlerId,level,Level)</c></seealso>.</p>
+ <note>
+ <p>The originating module for a log event is only detected
+ if <c>mfa=>{Module,Function,Arity}</c> exists in the
+ metadata. When log macros are used, this association is
+ automatically added to all log events. If the logger API
+ is called directly, without using a macro, the logging
+ client must explicitly add this information.</p>
+ </note>
</desc>
</func>
@@ -404,21 +551,62 @@ Current logger configuration:
<func>
<name name="set_logger_config" arity="1"/>
+ <fsummary>Set configuration data for the logger.</fsummary>
+ <desc>
+ <p>Set configuration data for the logger. This overwrites the
+ current logger configuration.</p>
+ <p>To modify the existing configuration,
+ use <seealso marker="#set_logger_config-2"><c>set_logger_config/2</c>
+ </seealso>, or read the current configuration
+ with <seealso marker="#get_logger_config-0"><c>get_logger_config/0</c>
+ </seealso>, then merge in your added or updated
+ associations before writing it back.</p>
+ <p>If a key is removed compared to the current configuration,
+ the default value is used.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="set_logger_config" arity="2"/>
<fsummary>Add or update configuration data for the logger.</fsummary>
<desc>
- <p>Add or update configuration data for the logger.</p>
+ <p>Add or update configuration data for the logger. If the
+ given <c><anno>Key</anno></c> already exists, its associated
+ value will be changed to <c><anno>Value</anno></c>. If it
+ doesn't exist, it will be added.</p>
</desc>
</func>
<func>
<name name="set_handler_config" arity="2"/>
+ <fsummary>Set configuration data for the specified handler.</fsummary>
+ <desc>
+ <p>Set configuration data for the specified handler. This
+ overwrites the current handler configuration.</p>
+ <p>To modify the existing configuration,
+ use <seealso marker="#set_handler_config-3"><c>set_handler_config/3</c>
+ </seealso>, or read the current configuration
+ with <seealso marker="#get_handler_config-1"><c>get_handler_config/1</c>
+ </seealso>, then merge in your added or updated
+ associations before writing it back.</p>
+ <p>If a key is removed compared to the current configuration,
+ and the key is know by Logger, the default value is used. If
+ it is a custom key, then it is up to the handler
+ implementation if the value is removed or a default value is
+ inserted.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="set_handler_config" arity="3"/>
<fsummary>Add or update configuration data for the specified
handler.</fsummary>
<desc>
<p>Add or update configuration data for the specified
- handler.</p>
+ handler. If the given <c><anno>Key</anno></c> already
+ exists, its associated value will be changed
+ to <c><anno>Value</anno></c>. If it doesn't exist, it will
+ be added.</p>
</desc>
</func>
@@ -437,17 +625,37 @@ Current logger configuration:
<name name="set_process_metadata" arity="1"/>
<fsummary>Set metadata to use when logging from current process.</fsummary>
<desc>
- <p>Set metadata which <c>logger</c> automatically inserts it
- in all log events produced on the current
- process. Subsequent calls will overwrite previous data set
- by this function.</p>
- <p>When logging, location data produced by the log macros,
- and/or metadata given as argument to the log call (API
- function or macro), will be merged with the process
- metadata. If the same keys occur, values from the metadata
- argument to the log call will overwrite values in the
- process metadata, which in turn will overwrite values from
- the location data.</p>
+ <p>Set metadata which Logger shall automatically insert in
+ all log events produced on the current process.</p>
+ <p>Location data produced by the log macros, and/or metadata
+ given as argument to the log call (API function or macro),
+ are merged with the process metadata. If the same keys
+ occur, values from the metadata argument to the log call
+ overwrite values from the process metadata, which in turn
+ overwrite values from the location data.</p>
+ <p>Subsequent calls to this function overwrites previous data
+ set. To update existing data instead of overwriting it,
+ see <seealso marker="#update_process_metadata-1">
+ <c>update_process_metadata/1</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="update_process_metadata" arity="1"/>
+ <fsummary>Set or update metadata to use when logging from
+ current process.</fsummary>
+ <desc>
+ <p>Set or update metadata to use when logging from current
+ process</p>
+ <p>If process metadata exists for the current process, this
+ function behaves as if it was implemented as follows:</p>
+ <code type="erl">
+logger:set_process_metadata(maps:merge(logger:get_process_metadata(),Meta))
+ </code>
+ <p>If no process metadata exists, the function behaves as
+ <seealso marker="#set_process_metadata-1">
+ <c>set_process_metadata/1</c>
+ </seealso>.</p>
</desc>
</func>
@@ -457,7 +665,9 @@ Current logger configuration:
<desc>
<p>Retrieve data set
with <seealso marker="#set_process_metadata-1">
- <c>set_process_metadata/1</c></seealso>.</p>
+ <c>set_process_metadata/1</c></seealso> or
+ <seealso marker="#update_process_metadata-1">
+ <c>update_process_metadata/1</c></seealso>.</p>
</desc>
</func>
@@ -467,12 +677,103 @@ Current logger configuration:
<desc>
<p>Delete data set
with <seealso marker="#set_process_metadata-1">
- <c>set_process_metadata/1</c></seealso>.</p>
+ <c>set_process_metadata/1</c></seealso> or
+ <seealso marker="#update_process_metadata-1">
+ <c>update_process_metadata/1</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="format_report" arity="1"/>
+ <fsummary>Convert a log message on report form to {Format,Args}.</fsummary>
+ <desc>
+ <p>Convert a log message on report form to <c>{Format,Args}</c>.</p>
+ <p>This is the default report callback used
+ by <seealso marker="logger_formatter">
+ <c>logger_formatter</c></seealso> when no custom report
+ callback is found.</p>
+ <p>The function produces lines of <c>Key: Value</c> from
+ key-value lists. Strings are printed with <c>~ts</c> and
+ other terms with <c>~tp</c>.</p>
+ <p>If the <c><anno>Report</anno></c> is a map, it is
+ converted to a key-value list before formatting as such.</p>
</desc>
</func>
</funcs>
+ <section>
+ <title>Callback Functions</title>
+ <p>The following functions are to be exported from a handler
+ callback module.</p>
+ </section>
+
+ <funcs>
+ <func>
+ <name>Module:adding_handler(HandlerId,Config1) -> {ok,Config2} | {error,Reason}</name>
+ <fsummary>An instance of this handler is about to be added.</fsummary>
+ <type>
+ <v>HandlerId =
+ <seealso marker="#type-handler_id">handler_id()</seealso></v>
+ <v>Config1 = Config2 =
+ <seealso marker="#type-config">config()</seealso></v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>This callback function is optional.</p>
+ <p>The function is called when an new handler is about to be
+ added, and the purpose is to verify the configuration and
+ initiate all resourced needed by the handler.</p>
+ <p>If everything succeeds, the callback function can add
+ possible default values or internal state values to the
+ configuration, and return the adjusted map
+ in <c>{ok,Config2}</c>.</p>
+ <p>If the configuration is faulty, or if the initiation fails,
+ the callback function must return <c>{error,Reason}</c>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:removing_handler(HandlerId,Config) -> ok</name>
+ <fsummary>The given handler is about to be removed.</fsummary>
+ <type>
+ <v>HandlerId =
+ <seealso marker="#type-handler_id">handler_id()</seealso></v>
+ <v>Config =
+ <seealso marker="#type-config">config()</seealso></v>
+ </type>
+ <desc>
+ <p>This callback function is optional.</p>
+ <p>The function is called when a handler is about to be
+ removed, and the purpose is to release all resources used by
+ the handler. The return value is ignored by Logger.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>Module:changing_config(HandlerId,Config1,Config2) -> {ok,Config3} | {error,Reason}</name>
+ <fsummary>The configuration for this handler is about to change.</fsummary>
+ <type>
+ <v>HandlerId =
+ <seealso marker="#type-handler_id">handler_id()</seealso></v>
+ <v>Config1 = Config2 = Config3 =
+ <seealso marker="#type-config">config()</seealso></v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>This callback function is optional.</p>
+ <p>The function is called when the configuration for a handler
+ is about to change, and the purpose is to verify and act on
+ the new configuration.</p>
+ <p><c>Config1</c> is the existing configuration
+ and <c>Config2</c> is the new configuration.</p>
+ <p>If everything succeeds, the callback function must return a
+ possibly adjusted configuration in <c>{ok,Config3}</c>.</p>
+ <p>If the configuration is faulty, the callback function must
+ return <c>{error,Reason}</c>.</p>
+ </desc>
+ </func>
+ </funcs>
</erlref>
diff --git a/lib/kernel/doc/src/logger_chapter.xml b/lib/kernel/doc/src/logger_chapter.xml
index 88dcfbe8d9..519df2ba48 100644
--- a/lib/kernel/doc/src/logger_chapter.xml
+++ b/lib/kernel/doc/src/logger_chapter.xml
@@ -157,7 +157,7 @@
<p>A formatter is defined as a module exporting the following
function:</p>
- <code>format(Log,Extra) -> string()</code>
+ <code>format(Log,Extra) -> unicode:chardata()</code>
<p>The formatter plugin is called by each handler, and the
returned string can be printed to the handler's destination
@@ -322,19 +322,6 @@
return <c>ignore</c>.</p>
<p>Default is <c>log</c>.</p>
</item>
- <tag><c>depth = pos_integer() | unlimited</c></tag>
- <item>
- <p>Specifies if the depth of terms in the log events shall
- be limited by using control characters <c>~P</c>
- and <c>~W</c> instead of <c>~p</c> and <c>~w</c>,
- respectively. See
- <seealso marker="stdlib:io#format-1"><c>io:format</c></seealso>.</p>
- </item>
- <tag><c>max_size = pos_integer() | unlimited</c></tag>
- <item>
- <p>Specifies if the size of a log event shall be limited by
- truncating the formatted string.</p>
- </item>
<tag><c>formatter = {Module::module(),Extra::term()}</c></tag>
<item>
<p>See <seealso marker="#Formatter">Formatter</seealso> for more
@@ -347,10 +334,9 @@
<p>Note that <c>level</c> and <c>filters</c> are obeyed by
Logger itself before forwarding the log events to each
- handler, while <c>depth</c>, <c>max_size</c>
- and <c>formatter</c> are left to the handler
- implementation. All Logger's built-in handlers do apply these
- configuration parameters before printing.</p>
+ handler, while <c>formatter</c> is left to the handler
+ implementation. All Logger's built-in handlers will call the
+ given formatter before printing.</p>
</section>
</section>
@@ -488,8 +474,9 @@ error_logger:add_report_handler/1,2.
level => debug}
2> <input>logger:add_handler(debug_handler,logger_std_h,Config).</input>
ok</pre>
- <p>By default, the handler receives all events, so we need to add a filter
- to stop all non-debug events:</p>
+ <p>By default, the handler receives all events
+ (<c>filter_defalt=log</c>), so we need to add a filter to stop
+ all non-debug events:</p>
<pre>
3> <input>Fun = fun(#{level:=debug}=Log,_) -> Log; (_,_) -> stop end.</input>
#Fun&lt;erl_eval.12.98642416>
@@ -516,7 +503,7 @@ ok</pre>
<p>It may also implement the following callbacks:</p>
<code>
adding_handler(logger:handler_id(),logger:config()) -> {ok,logger:config()} | {error,term()}
-removing_handler(logger:handler_id()) -> ok
+removing_handler(logger:handler_id(),logger:config()) -> ok
changing_config(logger:handler_id(),logger:config(),logger:config()) -> {ok,logger:config()} | {error,term()}
</code>
<p>When logger:add_handler(Id,Module,Config) is called, logger
@@ -526,7 +513,7 @@ changing_config(logger:handler_id(),logger:config(),logger:config()) -> {ok,logg
events as calls to Module:log/2.</p>
<p>A handler can be removed by calling
logger:remove_handler(Id). logger will call
- Module:removing_handler(Id), and then remove the handler's
+ Module:removing_handler(Id,Config), and then remove the handler's
configuration from the configuration database.</p>
<p>When logger:set_handler_config is called, logger calls
Module:changing_config(Id,OldConfig,NewConfig). If this function
@@ -547,7 +534,7 @@ log(Log,#{formatter:={FModule,FConfig}) ->
this:</p>
<code>
-module(myhandler).
--export([adding_handler/2, removing_handler/1, log/2]).
+-export([adding_handler/2, removing_handler/2, log/2]).
-export([init/1, handle_call/3, handle_cast/2, terminate/2]).
adding_handler(Id,Config) ->
@@ -576,7 +563,7 @@ log(Log,#{myhandler_fd:=Fd,formatter:={FModule,FConfig}}) ->
single process.</p>
<code>
-module(myhandler).
--export([adding_handler/2, removing_handler/1, log/2]).
+-export([adding_handler/2, removing_handler/2, log/2]).
-export([init/1, handle_call/3, handle_cast/2, terminate/2]).
adding_handler(Id,Config) ->
diff --git a/lib/kernel/doc/src/logger_filters.xml b/lib/kernel/doc/src/logger_filters.xml
index d742391e35..c34ec7d14c 100644
--- a/lib/kernel/doc/src/logger_filters.xml
+++ b/lib/kernel/doc/src/logger_filters.xml
@@ -33,16 +33,20 @@
<file>logger_filters.xml</file>
</header>
<module>logger_filters</module>
- <modulesummary>Filters to use with logger.</modulesummary>
+ <modulesummary>Filters to use with Logger.</modulesummary>
<description>
- <p>Filters to use with logger. All functions exported from this
- module can be used as logger or handler
+ <p>All functions exported from this module can be used as logger
+ or handler
filters. See <seealso marker="logger#add_logger_filter-2">
<c>logger:add_logger_filter/2</c></seealso>
and <seealso marker="logger#add_handler_filter-3">
- <c>logger:add_handler_filter/3</c></seealso>
- for more information about how filters are added.</p>
+ <c>logger:add_handler_filter/3</c></seealso> for more information
+ about how filters are added.</p>
+ <p>Filters are removed with <seealso marker="logger#remove_logger_filter-1">
+ <c>logger:remove_logger_filter/1</c></seealso>
+ and <seealso marker="logger#remove_handler_filter-2">
+ <c>logger:remove_handler_filter/2</c></seealso>.</p>
</description>
<funcs>
diff --git a/lib/kernel/doc/src/logger_formatter.xml b/lib/kernel/doc/src/logger_formatter.xml
index 6a17e3641f..7df4c88f40 100644
--- a/lib/kernel/doc/src/logger_formatter.xml
+++ b/lib/kernel/doc/src/logger_formatter.xml
@@ -33,12 +33,187 @@
<file>logger_formatter.xml</file>
</header>
<module>logger_formatter</module>
- <modulesummary>Default formatter for the Logger application.</modulesummary>
+ <modulesummary>Default formatter for Logger.</modulesummary>
<description>
- <p>Default formatter for the Logger application.</p>
+ <p>Each log handler has a configured formatter specified as a
+ module and a configuration term. The purpose of the formatter is
+ to translate the log events to a final printable string
+ (<c>unicode:chardata()</c>) which can be written to the output
+ device of the handler.</p>
+ <p><c>logger_formatter</c> is the default formatter used by
+ Logger.</p>
</description>
+ <section>
+ <title>Configuration</title>
+ <p>The configuration term for <c>logger_formatter</c> is a map,
+ and the following keys can be set as configuration
+ parameters:</p>
+ <taglist>
+ <tag><c>chars_limit = pos_integer() | unlimited</c></tag>
+ <item>
+ <p>A positive integer representing the value of the option
+ with the same name to be used when calling
+ <seealso marker="stdlib:io_lib#format-3">io_lib:format/3</seealso>.
+ This value limits the total number of characters printed
+ for each log event. Notice that this is a soft limit. For a
+ hard truncation limit, see option <c>max_size</c>.</p>
+ <p>Default is <c>unlimited</c>.</p>
+ <note>
+ <p><c>chars_limit</c> has no effect on log messages on
+ string form. These are expected to be short, but can still
+ be truncated by the <c>max_size</c> parameter.</p>
+ </note>
+ </item>
+ <tag><c>depth = pos_integer() | unlimited</c></tag>
+ <item>
+ <p>A positive integer representing the maximum depth to
+ which terms shall be printed by this formatter. Format
+ strings passed to this formatter are rewritten. The format
+ controls ~p and ~w are replaced with ~P and ~W,
+ respectively, and the value is used as the depth
+ parameter. For details, see
+ <seealso marker="stdlib:io#format-2">io:format/2,3</seealso>
+ in STDLIB.</p>
+ <p>Default is <c>unlimited</c>.</p>
+ <note>
+ <p><c>depth</c> has no effect on log messages on string
+ form. These are expected to be short, but can still be
+ truncated by the <c>max_size</c> parameter.</p>
+ </note>
+ </item>
+ <tag><c>max_size = pos_integer() | unlimited</c></tag>
+ <item>
+ <p>A positive integer representing the absolute maximum size a
+ string returned from this formatter can have. If the
+ formatted string is longer, after possibly being limited
+ by <c>chars_limit</c> or <c>depth</c>, it is truncated.</p>
+ <p>Default is <c>unlimited</c>.</p>
+ </item>
+ <tag><c>single_line = boolean()</c></tag>
+ <item>
+ <p>If set to <c>true</c>, all newlines in the message are
+ replaced with <c>", "</c>, and whitespaces following
+ directly after newlines are removed. Note that newlines
+ added by the <c>template</c> parameter are not replaced.</p>
+ <p>Default is <c>true</c>.</p>
+ </item>
+ <tag><c>legacy_header = boolen()</c></tag>
+ <item>
+ <p>If set to <c>true</c> a header field is added to
+ logger_formatter's part of <c>Metadata</c>. The value of
+ this field is a string similar to the header created by the
+ old <c>error_logger</c> event handlers. It can be included
+ in the log event by adding the
+ tuple <c>{logger_formatter,header}</c> to the template. See
+ section <seealso marker="#default_templates">Default
+ Templates</seealso> for more information.</p>
+ <p>Default is <c>false</c>.</p>
+ </item>
+ <tag><c>report_cb = fun((</c><seealso marker="logger#type-report"><c>logger:report()</c></seealso><c>) -> {</c><seealso marker="stdlib:io#type-format"><c>io:format()</c></seealso><c>,[term()]})</c></tag>
+ <item>
+ <p>A report callback is used by the formatter to transform log
+ messages on report form to a format string and
+ arguments. The report callback can be specified in the
+ metadata for the log event. If no report callback exist in
+ metadata, <c>logger_formatter</c> will
+ use <seealso marker="logger#format_report-1">
+ <c>logger:format_report/1</c></seealso> as default
+ callback.</p>
+ <p>If this configuration parameter is set, it replaces both
+ the default report callback, and any report callback found
+ in metadata. That is, all reports are converted by this
+ configured function.</p>
+ <p>The value must be a function with arity 1,
+ returning <c>{Format,Args}</c>, and it will be called with a
+ report as only argument.</p>
+ </item>
+ <tag><c>template = </c><seealso marker="#type-template"><c>template()</c></seealso></tag>
+ <item>
+ <p>The template is a list of atoms, tuples and strings. The
+ atoms <c>level</c> or <c>msg</c>, are treated as
+ placeholders for the severity level and the log message,
+ repectively. Other atoms or tuples are interpreted as
+ placeholders for metadata, where atoms are expected to match
+ top level keys, and tuples represent paths to sub keys when
+ the metadata is a nested map. For example the
+ tuple <c>{key1,key2}</c> is replaced by the value of
+ the <c>key2</c> field in the nested map below. The
+ atom <c>key1</c> on its own is replaced by the complete
+ value of the <c>key1</c> field. The values are converted to
+ strings.</p>
+
+<code>
+#{key1=>#{key2=>my_value,
+ ...}
+ ...}</code>
+
+ <p>Strings in the template are printed literally.</p>
+ <p>The default template differs depending on the values
+ of <c>legacy_header</c>
+ and <c>single_line</c>. See <seealso marker="#default_templates">Default
+ Templates</seealso> for more information</p>
+ </item>
+ <tag><c>utc = boolean()</c></tag>
+ <item>
+ <p>If set to <c>true</c>, all dates are displayed in Universal
+ Coordinated Time.</p>
+ <p>Default is <c>false</c>.</p>
+ </item>
+ </taglist>
+ </section>
+
+ <section>
+ <marker id="default_templates"/>
+ <title>Default templates</title>
+
+ <p>The default value for the <c>template</c> configuration
+ parameter depends on the value of <c>single_line</c>
+ and <c>legacy_header</c> as follows.</p>
+
+ <p>The log event used in the examples is:</p>
+ <code>
+?LOG_ERROR("name: ~p~nexit_reason: ~p",[my_reg_name,"It crashed"])</code>
+
+ <taglist>
+ <tag><c>legacy_header=true</c></tag>
+ <item>
+ <p>Default template: <c>[{logger_formatter,header},"\n",msg,"\n"]</c></p>
+
+ <p>Example log entry:</p>
+ <code>
+=ERROR REPORT==== 29-Dec-2017::13:30:51.245123 ===
+name: my_reg_name
+exit_reason: "It crashed"</code>
+
+ <p>Notice that all eight levels might occur in the heading,
+ not only <c>ERROR</c>, <c>WARNING</c> or <c>INFO</c> as the
+ old <c>error_logger</c> produced. And microseconds are
+ added at the end of the timestamp.</p>
+ </item>
+
+ <tag><c>single_line=true</c></tag>
+ <item>
+ <p>Default template: <c>[time," ",level,": ",msg,"\n"]</c></p>
+
+ <p>Example log entry:</p>
+ <code>2017-12-29 13:31:49.640317 error: name: my_reg_name, exit_reason: "It crashed"</code>
+ </item>
+
+ <tag><c>legacy_header=false, single_line=false</c></tag>
+ <item>
+ <p>Default template: <c>[time," ",level,":\n",msg,"\n"]</c></p>
+
+ <p>Example log entry:</p>
+ <code>
+2017-12-29 13:32:25.191925 error:
+name: my_reg_name
+exit_reason: "It crashed"</code>
+ </item>
+ </taglist>
+ </section>
+
<datatypes>
<datatype>
<name name="template"/>
@@ -52,101 +227,22 @@
<name name="format" arity="2"/>
<fsummary>Formats the given message.</fsummary>
<desc>
- <p>Formats the given message.</p>
- <p>The template is a list of atoms, tuples and strings. Atoms
- can be <c>level</c> or <c>msg</c>, which are placeholders
- for the severity level and the log message,
- repectively. Tuples are interpreted as placeholders for
- metadata. Each element in the tuple must be an atom which
- matches a key in the nested metadata map, e.g. the
- tuple <c>{key1,key2}</c> will be replaced by the value of
- the key2 field in this nested map (the value vill be
- converted to a string):</p>
-
-<code>
-#{key1=>#{key2=>my_value,
- ...},
- ...}</code>
-
-
- <p> Strings are printed literally.</p>
-
- <p><c>depth</c> is a positive integer representing the maximum
- depth to which terms shall be printed by this
- formatter. Format strings passed to this formatter are
- rewritten. The format controls ~p and ~w are replaced with
- ~P and ~W, respectively, and the value is used as the depth
- parameter. For details, see
- <seealso marker="stdlib:io#format-2">io:format/2,3</seealso>
- in STDLIB.</p>
-
- <p><c>chars_limit</c> is a positive integer representing the
- value of the option with the same name to be used when calling
- <seealso marker="stdlib:io#format-3">io:format/3</seealso>. This
- value limits the total number of characters printed bu the
- formatter. Notes that this is a soft limit. For a hard
- truncation limit, see option <c>max_size</c>.</p>
-
- <p><c>max_size</c> is a positive integer representing the
- maximum size a string returned from this formatter can
- have. If the formatted string is longer, after possibly
- being limited by <c>depth</c> and/or <c>chars_limit</c>, it
- will be truncated.</p>
-
- <p><c>utc</c> is a boolean. If set to true, all dates are
- displayed in Universal Coordinated Time. Default
- is <c>false</c>.</p>
-
- <p><c>report_cb</c> must be a function with arity 1,
- returning <c>{Format,Args}</c>. This function will replace
- any <c>report_cb</c> found in metadata.</p>
-
- <p>If <c>single_line=true</c>, all newlines in the message are
- replaced with <c>", "</c>, and whitespaces following directly
- after newlines are removed. Note that newlines added by the
- formatter template are not replaced.</p>
-
- <p>If <c>legacy_header=true</c> a header field is added to
- logger_formatter's part of <c>Metadata</c>. The value of
- this field is a string similar to the header created by the
- old <c>error_logger</c> event handlers. It can be included
- in the log event by adding the
- tuple <c>{logger_formatter,header}</c> to the template.</p>
-
- <p>The default template when <c>legacy_header=true</c> is</p>
-
- <code>[{logger_formatter,header},"\n",msg,"\n"]</code>
-
- <p>which will cause log entries like this:</p>
-
- <code>=ERROR REPORT==== 29-Dec-2017::13:30:51.245123 ===
- process: &lt;0.74.0&gt;
- exit_reason: "Something went wrong"</code>
-
- <p>Note that all eight levels might occur here, not
- only <c>ERROR</c>, <c>WARNING</c> or <c>INFO</c>. And also
- that micro seconds are added at the end of the
- timestamp.</p>
-
- <p>The default template when <c>single_line=true</c> is</p>
-
- <code>[time," ",level,": ",msg,"\n"]</code>
-
- <p>which will cause log entries like this:</p>
-
- <code>2017-12-29 13:31:49.640317 error: process: &lt;0.74.0&gt;, exit_reason: "Something went wrong"</code>
-
- <p>The default template when both <c>legacy_header</c> and
- <c>single_line</c> are set to false is:</p>
-
- <code>[time," ",level,":\n",msg,"\n"]</code>
-
- <p>which will cause log entries like this:</p>
-
- <code>2017-12-29 13:32:25.191925 error:
- process: &lt;0.74.0&gt;
- exit_reason: "Something went wrong"</code>
-
+ <p>This the formatter callback function to be called from
+ handlers. The log event is processed as follows:</p>
+ <list>
+ <item>If the message is on report form, it is converted to
+ <c>{Format,Args}</c> by calling the report
+ callback.</item>
+ <item>The size is limited according to the values of
+ configuration parameters <c>chars_limit</c>
+ and <c>depth</c>. Notice that this does not apply to
+ messages on string form.</item>
+ <item>The full log entry is composed according to
+ the <c>template</c>.</item>
+ <item>If the final string is too long, it is truncated
+ according to the value of configuration
+ parameter <c>max_size</c>.</item>
+ </list>
</desc>
</func>
diff --git a/lib/kernel/doc/src/ref_man.xml b/lib/kernel/doc/src/ref_man.xml
index c06914d23d..a633ae4832 100644
--- a/lib/kernel/doc/src/ref_man.xml
+++ b/lib/kernel/doc/src/ref_man.xml
@@ -38,6 +38,7 @@
<xi:include href="disk_log.xml"/>
<xi:include href="erl_boot_server.xml"/>
<xi:include href="erl_ddll.xml"/>
+ <xi:include href="erl_epmd.xml"/>
<xi:include href="erl_prim_loader_stub.xml"/>
<xi:include href="erlang_stub.xml"/>
<xi:include href="error_handler.xml"/>
diff --git a/lib/kernel/doc/src/specs.xml b/lib/kernel/doc/src/specs.xml
index bcc422930e..b8c25ca53b 100644
--- a/lib/kernel/doc/src/specs.xml
+++ b/lib/kernel/doc/src/specs.xml
@@ -6,6 +6,7 @@
<xi:include href="../specs/specs_disk_log.xml"/>
<xi:include href="../specs/specs_erl_boot_server.xml"/>
<xi:include href="../specs/specs_erl_ddll.xml"/>
+ <xi:include href="../specs/specs_erl_epmd.xml"/>
<xi:include href="../specs/specs_erl_prim_loader_stub.xml"/>
<xi:include href="../specs/specs_erlang_stub.xml"/>
<xi:include href="../specs/specs_error_handler.xml"/>
diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl
index b9cb722575..ff5df667b5 100644
--- a/lib/kernel/src/application_controller.erl
+++ b/lib/kernel/src/application_controller.erl
@@ -1272,9 +1272,7 @@ load(S, {ApplData, ApplEnv, IncApps, Descr, Id, Vsn, Apps}) ->
NewEnv = merge_app_env(ApplEnv, ConfEnv),
CmdLineEnv = get_cmd_env(Name),
NewEnv2 = merge_app_env(NewEnv, CmdLineEnv),
- NewEnv3 = keyreplaceadd(included_applications, 1, NewEnv2,
- {included_applications, IncApps}),
- add_env(Name, NewEnv3),
+ add_env(Name, NewEnv2),
Appl = #appl{name = Name, descr = Descr, id = Id, vsn = Vsn,
appl_data = ApplData, inc_apps = IncApps, apps = Apps},
ets:insert(ac_tab, {{loaded, Name}, Appl}),
@@ -1292,7 +1290,7 @@ load(S, {ApplData, ApplEnv, IncApps, Descr, Id, Vsn, Apps}) ->
{ok, NewS}.
unload(AppName, S) ->
- {ok, IncApps} = get_env(AppName, included_applications),
+ {ok, IncApps} = get_key(AppName, included_applications),
del_env(AppName),
ets:delete(ac_tab, {loaded, AppName}),
foldl(fun(App, S1) ->
@@ -1583,13 +1581,9 @@ do_change_appl({ok, {ApplData, Env, IncApps, Descr, Id, Vsn, Apps}},
CmdLineEnv = get_cmd_env(AppName),
NewEnv2 = merge_app_env(NewEnv1, CmdLineEnv),
- %% included_apps is made into an env parameter as well
- NewEnv3 = keyreplaceadd(included_applications, 1, NewEnv2,
- {included_applications, IncApps}),
-
%% Update ets table with new application env
del_env(AppName),
- add_env(AppName, NewEnv3),
+ add_env(AppName, NewEnv2),
OldAppl#appl{appl_data=ApplData,
descr=Descr,
diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl
index f96bc88913..9a0939972d 100644
--- a/lib/kernel/src/erl_epmd.erl
+++ b/lib/kernel/src/erl_epmd.erl
@@ -29,10 +29,20 @@
-define(port_please_failure2(Term), noop).
-endif.
+-ifndef(erlang_daemon_port).
+-define(erlang_daemon_port, 4369).
+-endif.
+-ifndef(epmd_dist_high).
+-define(epmd_dist_high, 4370).
+-endif.
+-ifndef(epmd_dist_low).
+-define(epmd_dist_low, 4370).
+-endif.
+
%% External exports
-export([start/0, start_link/0, stop/0, port_please/2,
port_please/3, names/0, names/1,
- register_node/2, register_node/3, open/0, open/1, open/2]).
+ register_node/2, register_node/3, address_please/3, open/0, open/1, open/2]).
%% gen_server callbacks
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
@@ -53,7 +63,7 @@
start() ->
gen_server:start({local, erl_epmd}, ?MODULE, [], []).
-
+-spec start_link() -> {ok, pid()} | ignore | {error,term()}.
start_link() ->
gen_server:start_link({local, erl_epmd}, ?MODULE, [], []).
@@ -66,9 +76,22 @@ stop() ->
%% return {port, P, Version} | noport
%%
+-spec port_please(Name, Host) -> {ok, Port, Version} | noport when
+ Name :: string(),
+ Host :: inet:ip_address(),
+ Port :: non_neg_integer(),
+ Version :: non_neg_integer().
+
port_please(Node, Host) ->
port_please(Node, Host, infinity).
+-spec port_please(Name, Host, Timeout) -> {ok, Port, Version} | noport when
+ Name :: string(),
+ Host :: inet:ip_address(),
+ Timeout :: non_neg_integer() | infinity,
+ Port :: non_neg_integer(),
+ Version :: non_neg_integer().
+
port_please(Node,HostName, Timeout) when is_atom(HostName) ->
port_please1(Node,atom_to_list(HostName), Timeout);
port_please(Node,HostName, Timeout) when is_list(HostName) ->
@@ -92,10 +115,21 @@ port_please1(Node,HostName, Timeout) ->
Else
end.
+-spec names() -> {ok, [{Name, Port}]} | {error, Reason} when
+ Name :: string(),
+ Port :: non_neg_integer(),
+ Reason :: address | file:posix().
+
names() ->
{ok, H} = inet:gethostname(),
names(H).
+-spec names(Host) -> {ok, [{Name, Port}]} | {error, Reason} when
+ Host :: atom() | string() | inet:ip_address(),
+ Name :: string(),
+ Port :: non_neg_integer(),
+ Reason :: address | file:posix().
+
names(HostName) when is_atom(HostName); is_list(HostName) ->
case inet:gethostbyname(HostName) of
{ok,{hostent, _Name, _ , _Af, _Size, [EpmdAddr | _]}} ->
@@ -106,9 +140,22 @@ names(HostName) when is_atom(HostName); is_list(HostName) ->
names(EpmdAddr) ->
get_names(EpmdAddr).
+-spec register_node(Name, Port) -> Result when
+ Name :: string(),
+ Port :: non_neg_integer(),
+ Creation :: non_neg_integer(),
+ Result :: {ok, Creation} | {error, already_registered} | term().
register_node(Name, PortNo) ->
- register_node(Name, PortNo, inet).
+ register_node(Name, PortNo, inet).
+
+-spec register_node(Name, Port, Driver) -> Result when
+ Name :: string(),
+ Port :: non_neg_integer(),
+ Driver :: inet_tcp | inet6_tcp | inet | inet6,
+ Creation :: non_neg_integer(),
+ Result :: {ok, Creation} | {error, already_registered} | term().
+
register_node(Name, PortNo, inet_tcp) ->
register_node(Name, PortNo, inet);
register_node(Name, PortNo, inet6_tcp) ->
@@ -116,6 +163,17 @@ register_node(Name, PortNo, inet6_tcp) ->
register_node(Name, PortNo, Family) ->
gen_server:call(erl_epmd, {register, Name, PortNo, Family}, infinity).
+-spec address_please(Name, Host, AddressFamily) -> Success | {error, term()} when
+ Name :: string(),
+ Host :: string() | inet:ip_address(),
+ AddressFamily :: inet | inet6,
+ Port :: non_neg_integer(),
+ Version :: non_neg_integer(),
+ Success :: {ok, inet:ip_address()} | {ok, inet:ip_address(), Port, Version}.
+
+address_please(_Name, Host, AddressFamily) ->
+ inet:getaddr(Host, AddressFamily).
+
%%%----------------------------------------------------------------------
%%% Callback functions from gen_server
%%%----------------------------------------------------------------------
diff --git a/lib/kernel/src/erl_signal_handler.erl b/lib/kernel/src/erl_signal_handler.erl
index 22f235d4e4..b76c2a217a 100644
--- a/lib/kernel/src/erl_signal_handler.erl
+++ b/lib/kernel/src/erl_signal_handler.erl
@@ -19,12 +19,21 @@
-module(erl_signal_handler).
-behaviour(gen_event).
--export([init/1, format_status/2,
+-export([start/0, init/1, format_status/2,
handle_event/2, handle_call/2, handle_info/2,
terminate/2, code_change/3]).
-record(state,{}).
+start() ->
+ %% add signal handler
+ case whereis(erl_signal_server) of
+ %% in case of minimal mode
+ undefined -> ok;
+ _ ->
+ gen_event:add_handler(erl_signal_server, erl_signal_handler, [])
+ end.
+
init(_Args) ->
{ok, #state{}}.
diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl
index 0706220a94..47d0ca5ea3 100644
--- a/lib/kernel/src/error_logger.erl
+++ b/lib/kernel/src/error_logger.erl
@@ -32,7 +32,7 @@
which_report_handlers/0]).
%% logger callbacks
--export([adding_handler/2, removing_handler/1, log/2]).
+-export([adding_handler/2, removing_handler/2, log/2]).
-export([get_format_depth/0, limit_term/1]).
@@ -111,8 +111,8 @@ adding_handler(?MODULE,Config) ->
Error
end.
--spec removing_handler(logger:handler_id()) -> ok.
-removing_handler(?MODULE) ->
+-spec removing_handler(logger:handler_id(),logger:config()) -> ok.
+removing_handler(?MODULE,_Config) ->
stop(),
ok.
diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl
index fd06f0f7d8..5704cc79c2 100644
--- a/lib/kernel/src/hipe_unified_loader.erl
+++ b/lib/kernel/src/hipe_unified_loader.erl
@@ -453,7 +453,7 @@ make_beam_stub(Mod, LoaderState, MD5, Beam, FunDefs, ClosuresToPatch) ->
%%========================================================================
%% Patching
%% @spec patch(refs(), BaseAddress::integer(), ConstAndZone::term(),
-%% FunDefs::term(), TrampolineMap::term()) -> 'ok'.
+%% FunDefs::term(), TrampolineMap::term()) -> 'ok'
%% @type refs()=[{RefType::integer(), Reflist::reflist()} | refs()]
%%
%% @type reflist()= [{Data::term(), Offsets::offests()}|reflist()]
diff --git a/lib/kernel/src/inet_tcp_dist.erl b/lib/kernel/src/inet_tcp_dist.erl
index e3fdb1bb22..b4b50899f7 100644
--- a/lib/kernel/src/inet_tcp_dist.erl
+++ b/lib/kernel/src/inet_tcp_dist.erl
@@ -283,73 +283,22 @@ do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
?trace("~p~n",[{inet_tcp_dist,self(),setup,Node}]),
[Name, Address] = splitnode(Driver, Node, LongOrShortNames),
AddressFamily = Driver:family(),
- case inet:getaddr(Address, AddressFamily) of
+ ErlEpmd = net_kernel:epmd_module(),
+ {ARMod, ARFun} = get_address_resolver(ErlEpmd),
+ Timer = dist_util:start_timer(SetupTime),
+ case ARMod:ARFun(Name, Address, AddressFamily) of
+ {ok, Ip, TcpPort, Version} ->
+ ?trace("address_please(~p) -> version ~p~n",
+ [Node,Version]),
+ do_setup_connect(Driver, Kernel, Node, Address, AddressFamily,
+ Ip, TcpPort, Version, Type, MyNode, Timer);
{ok, Ip} ->
- Timer = dist_util:start_timer(SetupTime),
- ErlEpmd = net_kernel:epmd_module(),
case ErlEpmd:port_please(Name, Ip) of
{port, TcpPort, Version} ->
?trace("port_please(~p) -> version ~p~n",
[Node,Version]),
- dist_util:reset_timer(Timer),
- case
- Driver:connect(
- Ip, TcpPort,
- connect_options([{active, false}, {packet, 2}]))
- of
- {ok, Socket} ->
- HSData = #hs_data{
- kernel_pid = Kernel,
- other_node = Node,
- this_node = MyNode,
- socket = Socket,
- timer = Timer,
- this_flags = 0,
- other_version = Version,
- f_send = fun Driver:send/2,
- f_recv = fun Driver:recv/3,
- f_setopts_pre_nodeup =
- fun(S) ->
- inet:setopts
- (S,
- [{active, false},
- {packet, 4},
- nodelay()])
- end,
- f_setopts_post_nodeup =
- fun(S) ->
- inet:setopts
- (S,
- [{active, true},
- {deliver, port},
- {packet, 4},
- nodelay()])
- end,
-
- f_getll = fun inet:getll/1,
- f_address =
- fun(_,_) ->
- #net_address{
- address = {Ip,TcpPort},
- host = Address,
- protocol = tcp,
- family = AddressFamily}
- end,
- mf_tick = fun(S) -> ?MODULE:tick(Driver, S) end,
- mf_getstat = fun ?MODULE:getstat/1,
- request_type = Type,
- mf_setopts = fun ?MODULE:setopts/2,
- mf_getopts = fun ?MODULE:getopts/2
- },
- dist_util:handshake_we_started(HSData);
- _ ->
- %% Other Node may have closed since
- %% port_please !
- ?trace("other node (~p) "
- "closed since port_please.~n",
- [Node]),
- ?shutdown(Node)
- end;
+ do_setup_connect(Driver, Kernel, Node, Address, AddressFamily,
+ Ip, TcpPort, Version, Type, MyNode, Timer);
_ ->
?trace("port_please (~p) "
"failed.~n", [Node]),
@@ -361,6 +310,71 @@ do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
?shutdown(Node)
end.
+%%
+%% Actual setup of connection
+%%
+do_setup_connect(Driver, Kernel, Node, Address, AddressFamily,
+ Ip, TcpPort, Version, Type, MyNode, Timer) ->
+ dist_util:reset_timer(Timer),
+ case
+ Driver:connect(
+ Ip, TcpPort,
+ connect_options([{active, false}, {packet, 2}]))
+ of
+ {ok, Socket} ->
+ HSData = #hs_data{
+ kernel_pid = Kernel,
+ other_node = Node,
+ this_node = MyNode,
+ socket = Socket,
+ timer = Timer,
+ this_flags = 0,
+ other_version = Version,
+ f_send = fun Driver:send/2,
+ f_recv = fun Driver:recv/3,
+ f_setopts_pre_nodeup =
+ fun(S) ->
+ inet:setopts
+ (S,
+ [{active, false},
+ {packet, 4},
+ nodelay()])
+ end,
+ f_setopts_post_nodeup =
+ fun(S) ->
+ inet:setopts
+ (S,
+ [{active, true},
+ {deliver, port},
+ {packet, 4},
+ nodelay()])
+ end,
+
+ f_getll = fun inet:getll/1,
+ f_address =
+ fun(_,_) ->
+ #net_address{
+ address = {Ip,TcpPort},
+ host = Address,
+ protocol = tcp,
+ family = AddressFamily}
+ end,
+ mf_tick = fun(S) -> ?MODULE:tick(Driver, S) end,
+ mf_getstat = fun ?MODULE:getstat/1,
+ request_type = Type,
+ mf_setopts = fun ?MODULE:setopts/2,
+ mf_getopts = fun ?MODULE:getopts/2
+ },
+ dist_util:handshake_we_started(HSData);
+ _ ->
+ %% Other Node may have closed since
+ %% discovery !
+ ?trace("other node (~p) "
+ "closed since discovery (port_please).~n",
+ [Node]),
+ ?shutdown(Node)
+ end.
+
connect_options(Opts) ->
case application:get_env(kernel, inet_dist_connect_options) of
{ok,ConnectOpts} ->
@@ -430,6 +444,16 @@ get_tcp_address(Driver, Socket) ->
}.
%% ------------------------------------------------------------
+%% Determine if EPMD module supports address resolving. Default
+%% is to use inet:getaddr/2.
+%% ------------------------------------------------------------
+get_address_resolver(EpmdModule) ->
+ case erlang:function_exported(EpmdModule, address_please, 3) of
+ true -> {EpmdModule, address_please};
+ _ -> {inet, getaddr}
+ end.
+
+%% ------------------------------------------------------------
%% Do only accept new connection attempts from nodes at our
%% own LAN, if the check_ip environment parameter is true.
%% ------------------------------------------------------------
diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl
index 20aa47f602..ae982c1741 100644
--- a/lib/kernel/src/kernel.erl
+++ b/lib/kernel/src/kernel.erl
@@ -32,13 +32,7 @@
start(_, []) ->
case supervisor:start_link({local, kernel_sup}, kernel, []) of
{ok, Pid} ->
- %% add signal handler
- case whereis(erl_signal_server) of
- %% in case of minimal mode
- undefined -> ok;
- _ ->
- ok = gen_event:add_handler(erl_signal_server, erl_signal_handler, [])
- end,
+ ok = erl_signal_handler:start(),
%% add error handler
case logger:setup_standard_handler() of
ok -> {ok, Pid, []};
diff --git a/lib/kernel/src/kernel_config.erl b/lib/kernel/src/kernel_config.erl
index 535083ef27..c5ff1887c2 100644
--- a/lib/kernel/src/kernel_config.erl
+++ b/lib/kernel/src/kernel_config.erl
@@ -30,11 +30,8 @@
%%%-----------------------------------------------------------------
%%% This module implements a process that configures the kernel
%%% application.
-%%% Its purpose is that in the init phase add an error_logger
-%%% and when it dies (when the kernel application dies) deleting the
-%%% previously installed error_logger.
-%%% Also, this process waits for other nodes at startup, if
-%%% specified.
+%%% Its purpose is that in the init phase waits for other nodes at startup,
+%%% if specified.
%%%-----------------------------------------------------------------
start_link() -> gen_server:start_link(kernel_config, [], []).
diff --git a/lib/kernel/src/logger.erl b/lib/kernel/src/logger.erl
index 943ef8c2d1..98a9937111 100644
--- a/lib/kernel/src/logger.erl
+++ b/lib/kernel/src/logger.erl
@@ -44,8 +44,8 @@
%% Misc
-export([compare_levels/2]).
--export([set_process_metadata/1, unset_process_metadata/0,
- get_process_metadata/0]).
+-export([set_process_metadata/1, update_process_metadata/1,
+ unset_process_metadata/0, get_process_metadata/0]).
-export([i/0, i/1]).
-export([setup_standard_handler/0, replace_simple_handler/3]).
-export([limit_term/1, get_format_depth/0, get_max_size/0, get_utc_config/0]).
@@ -60,27 +60,41 @@
%%%-----------------------------------------------------------------
%%% Types
--type log() :: #{level=>level(),
- msg=>{io:format(),[term()]} |
+-type log() :: #{level:=level(),
+ msg:={io:format(),[term()]} |
{report,report()} |
{string,unicode:chardata()},
- meta=>metadata()}.
+ meta:=metadata()}.
-type level() :: emergency | alert | critical | error |
warning | notice | info | debug.
-type report() :: map() | [{atom(),term()}].
-type msg_fun() :: fun((term()) -> {io:format(),[term()]} |
report() |
unicode:chardata()).
--type metadata() :: map().
-
+-type metadata() :: #{pid => pid(),
+ gl => pid(),
+ time => timestamp(),
+ mfa => {module(),atom(),non_neg_integer()},
+ file => file:filename(),
+ line => non_neg_integer(),
+ term() => term()}.
+-type location() :: #{mfa := {module(),atom(),non_neg_integer()},
+ file := file:filename(),
+ line := non_neg_integer()}.
-type handler_id() :: atom().
-type filter_id() :: atom().
--type filter() :: {fun((log(),term()) -> filter_return()),term()}.
+-type filter() :: {fun((log(),filter_arg()) -> filter_return()),filter_arg()}.
+-type filter_arg() :: term().
-type filter_return() :: stop | ignore | log().
--type config() :: map().
+-type config() :: #{level => level(),
+ filter_default => log | stop,
+ filters => [{filter_id(),filter()}],
+ formatter => {module(),term()},
+ term() => term()}.
+-type timestamp() :: integer().
-export_type([log/0,level/0,report/0,msg_fun/0,metadata/0,config/0,handler_id/0,
- filter_id/0,filter/0,filter_return/0]).
+ filter_id/0,filter/0,filter_arg/0,filter_return/0]).
%%%-----------------------------------------------------------------
%%% API
@@ -185,24 +199,24 @@ allow(Level,Module) when ?IS_LEVEL(Level), is_atom(Module) ->
-spec macro_log(Location,Level,StringOrReport) -> ok when
- Location :: map(),
+ Location :: location(),
Level :: level(),
StringOrReport :: unicode:chardata() | report().
macro_log(Location,Level,StringOrReport) ->
log_allowed(Location,Level,StringOrReport,#{}).
-spec macro_log(Location,Level,StringOrReport,Meta) -> ok when
- Location :: map(),
+ Location :: location(),
Level :: level(),
StringOrReport :: unicode:chardata() | report(),
Meta :: metadata();
(Location,Level,Format,Args) -> ok when
- Location :: map(),
+ Location :: location(),
Level :: level(),
Format :: io:format(),
Args ::[term()];
(Location,Level,Fun,FunArgs) -> ok when
- Location :: map(),
+ Location :: location(),
Level :: level(),
Fun :: msg_fun(),
FunArgs :: term().
@@ -213,13 +227,13 @@ macro_log(Location,Level,FunOrFormat,Args) ->
log_allowed(Location,Level,{FunOrFormat,Args},#{}).
-spec macro_log(Location,Level,Format,Args,Meta) -> ok when
- Location :: map(),
+ Location :: location(),
Level :: level(),
Format :: io:format(),
Args ::[term()],
Meta :: metadata();
(Location,Level,Fun,FunArgs,Meta) -> ok when
- Location :: map(),
+ Location :: location(),
Level :: level(),
Fun :: msg_fun(),
FunArgs :: term(),
@@ -390,6 +404,19 @@ set_process_metadata(Meta) when is_map(Meta) ->
set_process_metadata(Meta) ->
erlang:error(badarg,[Meta]).
+-spec update_process_metadata(Meta) -> ok when
+ Meta :: metadata().
+update_process_metadata(Meta) when is_map(Meta) ->
+ case get_process_metadata() of
+ undefined ->
+ set_process_metadata(Meta);
+ Meta0 when is_map(Meta0) ->
+ set_process_metadata(maps:merge(Meta0,Meta)),
+ ok
+ end;
+update_process_metadata(Meta) ->
+ erlang:error(badarg,[Meta]).
+
-spec get_process_metadata() -> Meta | undefined when
Meta :: metadata().
get_process_metadata() ->
@@ -699,7 +726,7 @@ do_log_1(Level,Msg,Meta) ->
end.
-spec log_allowed(Location,Level,Msg,Meta) -> ok when
- Location :: map(),
+ Location :: location() | #{},
Level :: level(),
Msg :: {msg_fun(),term()} |
{io:format(),[term()]} |
diff --git a/lib/kernel/src/logger_disk_log_h.erl b/lib/kernel/src/logger_disk_log_h.erl
index 3b71f936d8..0150fa781a 100644
--- a/lib/kernel/src/logger_disk_log_h.erl
+++ b/lib/kernel/src/logger_disk_log_h.erl
@@ -34,7 +34,7 @@
%% logger callbacks
-export([log/2,
- adding_handler/2, removing_handler/1,
+ adding_handler/2, removing_handler/2,
changing_config/3, swap_buffer/2]).
%%%===================================================================
@@ -223,7 +223,7 @@ check_my_config([]) ->
%%%-----------------------------------------------------------------
%%% Handler being removed
-removing_handler(Name) ->
+removing_handler(Name, _Config) ->
stop(Name).
%%%-----------------------------------------------------------------
diff --git a/lib/kernel/src/logger_formatter.erl b/lib/kernel/src/logger_formatter.erl
index 386e7832e2..8e954f8d98 100644
--- a/lib/kernel/src/logger_formatter.erl
+++ b/lib/kernel/src/logger_formatter.erl
@@ -29,7 +29,7 @@
%%%-----------------------------------------------------------------
%%% API
--spec format(Log,Config) -> String when
+-spec format(Log,Config) -> unicode:chardata() when
Log :: logger:log(),
Config :: #{single_line=>boolean(),
legacy_header=>boolean(),
@@ -38,8 +38,7 @@
max_size=>pos_integer() | unlimited,
depth=>pos_integer() | unlimited,
template=>template(),
- utc=>boolean()},
- String :: string().
+ utc=>boolean()}.
format(#{level:=Level,msg:=Msg0,meta:=Meta},Config0)
when is_map(Config0) ->
Config = add_default_config(Config0),
@@ -263,7 +262,7 @@ utcstr(_) -> "".
add_default_config(#{utc:=_}=Config0) ->
Default =
#{legacy_header=>false,
- single_line=>false,
+ single_line=>true,
chars_limit=>unlimited},
MaxSize = get_max_size(maps:get(max_size,Config0,false)),
Depth = get_depth(maps:get(depth,Config0,false)),
diff --git a/lib/kernel/src/logger_internal.hrl b/lib/kernel/src/logger_internal.hrl
index 82df499c2b..8c0fc2725d 100644
--- a/lib/kernel/src/logger_internal.hrl
+++ b/lib/kernel/src/logger_internal.hrl
@@ -31,6 +31,7 @@
{no_domain,{fun logger_filters:domain/2,{log,no_domain,[]}}}]).
-define(DEFAULT_FORMATTER,logger_formatter).
-define(DEFAULT_FORMAT_CONFIG,#{legacy_header=>true,
+ single_line=>false,
template=>?DEFAULT_FORMAT_TEMPLATE_HEADER}).
-define(DEFAULT_FORMAT_TEMPLATE_HEADER,
[{logger_formatter,header},"\n",msg,"\n"]).
diff --git a/lib/kernel/src/logger_server.erl b/lib/kernel/src/logger_server.erl
index 6ef3b8582a..a7f302ac8f 100644
--- a/lib/kernel/src/logger_server.erl
+++ b/lib/kernel/src/logger_server.erl
@@ -158,7 +158,7 @@ handle_call({remove_handler,HandlerId}, _From, #state{tid=Tid}=State) ->
Handlers0 = maps:get(handlers,Config,[]),
Handlers = lists:delete(HandlerId,Handlers0),
%% inform the handler
- _ = call_h(Module,removing_handler,[HandlerId],ok),
+ _ = call_h(Module,removing_handler,[HandlerId,Config],ok),
do_set_config(Tid,logger,Config#{handlers=>Handlers}),
logger_config:delete(Tid,HandlerId),
ok;
@@ -234,7 +234,13 @@ handle_info({log,Level,Report,Meta}, State) ->
{noreply, State};
handle_info({Ref,_Reply},State) when is_reference(Ref) ->
%% Assuming this is a timed-out gen_server reply - ignoring
- {noreply, State}.
+ {noreply, State};
+handle_info(Unexpected,State) ->
+ ?LOG_INTERNAL(debug,
+ [{logger,got_unexpected_message},
+ {process,?SERVER},
+ {message,Unexpected}]),
+ {noreply,State}.
terminate(_Reason, _State) ->
ok.
diff --git a/lib/kernel/src/logger_simple.erl b/lib/kernel/src/logger_simple.erl
index 23ff6ccd2e..a1b427b96c 100644
--- a/lib/kernel/src/logger_simple.erl
+++ b/lib/kernel/src/logger_simple.erl
@@ -19,7 +19,7 @@
%%
-module(logger_simple).
--export([adding_handler/2, removing_handler/1, log/2]).
+-export([adding_handler/2, removing_handler/2, log/2]).
-export([get_buffer/0]).
%% This module implements a simple handler for logger. It is the
@@ -63,7 +63,7 @@ adding_handler(?MODULE,Config) ->
{error,{handler_process_name_already_exists,?MODULE}}
end.
-removing_handler(?MODULE) ->
+removing_handler(?MODULE,_Config) ->
case whereis(?MODULE) of
undefined ->
ok;
diff --git a/lib/kernel/src/logger_std_h.erl b/lib/kernel/src/logger_std_h.erl
index cbc9db372c..31edcfea8b 100644
--- a/lib/kernel/src/logger_std_h.erl
+++ b/lib/kernel/src/logger_std_h.erl
@@ -35,7 +35,7 @@
terminate/2, code_change/3]).
%% logger callbacks
--export([log/2, adding_handler/2, removing_handler/1,
+-export([log/2, adding_handler/2, removing_handler/2,
changing_config/3, swap_buffer/2]).
%%%===================================================================
@@ -207,7 +207,7 @@ check_my_config([]) ->
%%%-----------------------------------------------------------------
%%% Handler being removed
-removing_handler(Name) ->
+removing_handler(Name,_Config) ->
stop(Name).
%%%-----------------------------------------------------------------
diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl
index c00fb44c46..988f26280f 100644
--- a/lib/kernel/test/application_SUITE.erl
+++ b/lib/kernel/test/application_SUITE.erl
@@ -1603,8 +1603,7 @@ get_key(Conf) when is_list(Conf) ->
{ok, [{init, [kalle]}, {takeover, []}, {go, [sune]}]} =
rpc:call(Cp1, application, get_key, [appinc, start_phases]),
{ok, Env} = rpc:call(Cp1, application, get_key, [appinc ,env]),
- [{included_applications,[appinc1,appinc2]},
- {own2,val2},{own_env1,value1}] = lists:sort(Env),
+ [{own2,val2},{own_env1,value1}] = lists:sort(Env),
{ok, []} = rpc:call(Cp1, application, get_key, [appinc, modules]),
{ok, {application_starter, [ch_sup, {appinc, 41, 43}] }} =
rpc:call(Cp1, application, get_key, [appinc, mod]),
@@ -1625,8 +1624,7 @@ get_key(Conf) when is_list(Conf) ->
{mod, {application_starter, [ch_sup, {appinc, 41, 43}] }},
{start_phases, [{init, [kalle]}, {takeover, []}, {go, [sune]}]}]} =
rpc:call(Cp1, application, get_all_key, [appinc]),
- [{included_applications,[appinc1,appinc2]},
- {own2,val2},{own_env1,value1}] = lists:sort(Env),
+ [{own2,val2},{own_env1,value1}] = lists:sort(Env),
{ok, "Test of new app file, including appnew"} =
gen_server:call({global, {ch,41}}, {get_pid_key, description}),
@@ -1643,8 +1641,7 @@ get_key(Conf) when is_list(Conf) ->
{ok, [{init, [kalle]}, {takeover, []}, {go, [sune]}]} =
gen_server:call({global, {ch,41}}, {get_pid_key, start_phases}),
{ok, Env} = gen_server:call({global, {ch,41}}, {get_pid_key, env}),
- [{included_applications,[appinc1,appinc2]},
- {own2,val2},{own_env1,value1}] = lists:sort(Env),
+ [{own2,val2},{own_env1,value1}] = lists:sort(Env),
{ok, []} =
gen_server:call({global, {ch,41}}, {get_pid_key, modules}),
{ok, {application_starter, [ch_sup, {appinc, 41, 43}] }} =
@@ -1671,8 +1668,7 @@ get_key(Conf) when is_list(Conf) ->
{mod, {application_starter, [ch_sup, {appinc, 41, 43}] }},
{start_phases, [{init, [kalle]}, {takeover, []}, {go, [sune]}]}]} =
gen_server:call({global, {ch,41}}, get_pid_all_key),
- [{included_applications,[appinc1,appinc2]},
- {own2,val2},{own_env1,value1}] = lists:sort(Env),
+ [{own2,val2},{own_env1,value1}] = lists:sort(Env),
stop_node_nice(Cp1),
ok.
diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl
index 0470f09f29..9c6712ad74 100644
--- a/lib/kernel/test/erl_distribution_SUITE.erl
+++ b/lib/kernel/test/erl_distribution_SUITE.erl
@@ -244,7 +244,7 @@ illegal(Name) ->
test_node(Name) ->
test_node(Name, false).
test_node(Name, Illigal) ->
- ProgName = atom_to_list(lib:progname()),
+ ProgName = ct:get_progname(),
Command = ProgName ++ " -noinput " ++ long_or_short() ++ Name ++
" -eval \"net_adm:ping('" ++ atom_to_list(node()) ++ "')\"" ++
case Illigal of
diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl
index 22db24de5f..e95635b800 100644
--- a/lib/kernel/test/heart_SUITE.erl
+++ b/lib/kernel/test/heart_SUITE.erl
@@ -168,7 +168,7 @@ reboot(Config) when is_list(Config) ->
{ok, Node} = start_check(slave, ?UNIQ_NODE_NAME),
ok = rpc:call(Node, heart, set_cmd,
- [atom_to_list(lib:progname()) ++
+ [ct:get_progname() ++
" -noshell -heart " ++ name(Node) ++ "&"]),
rpc:call(Node, init, reboot, []),
receive
@@ -203,7 +203,7 @@ node_start_immediately_after_crash_test(Config) when is_list(Config) ->
[{"ERL_CRASH_DUMP_SECONDS", "0"}]),
ok = rpc:call(Node, heart, set_cmd,
- [atom_to_list(lib:progname()) ++
+ [ct:get_progname() ++
" -noshell -heart " ++ name(Node) ++ "&"]),
Mod = exhaust_atoms,
@@ -254,7 +254,7 @@ node_start_soon_after_crash_test(Config) when is_list(Config) ->
[{"ERL_CRASH_DUMP_SECONDS", "10"}]),
ok = rpc:call(Node, heart, set_cmd,
- [atom_to_list(lib:progname()) ++
+ [ct:get_progname() ++
" -noshell -heart " ++ name(Node) ++ "&"]),
Mod = exhaust_atoms,
@@ -309,7 +309,7 @@ set_cmd(Config) when is_list(Config) ->
clear_cmd(Config) when is_list(Config) ->
{ok, Node} = start_check(slave, ?UNIQ_NODE_NAME),
ok = rpc:call(Node, heart, set_cmd,
- [atom_to_list(lib:progname()) ++
+ [ct:get_progname() ++
" -noshell -heart " ++ name(Node) ++ "&"]),
rpc:call(Node, init, reboot, []),
receive
diff --git a/lib/kernel/test/kernel_config_SUITE.erl b/lib/kernel/test/kernel_config_SUITE.erl
index 9a4578917d..a21020ff97 100644
--- a/lib/kernel/test/kernel_config_SUITE.erl
+++ b/lib/kernel/test/kernel_config_SUITE.erl
@@ -76,7 +76,7 @@ sync(Conf) when is_list(Conf) ->
%% Reset wall_clock
{T1,_} = erlang:statistics(wall_clock),
io:format("~p~n", [{t1, T1}]),
- Command = lists:concat([lib:progname(),
+ Command = lists:append([ct:get_progname(),
" -detached -sname cp1 ",
"-config ", Config,
" -env ERL_CRASH_DUMP erl_crash_dump.cp1"]),
diff --git a/lib/kernel/test/logger_SUITE.erl b/lib/kernel/test/logger_SUITE.erl
index 0edce3e34c..f311a9c7ed 100644
--- a/lib/kernel/test/logger_SUITE.erl
+++ b/lib/kernel/test/logger_SUITE.erl
@@ -666,6 +666,9 @@ process_metadata(_Config) ->
check_logged(info,S3,#{time=>Time,line=>0,custom=>func}),
ProcMeta = logger:get_process_metadata(),
+ ok = logger:update_process_metadata(#{custom=>changed,custom2=>added}),
+ Expected = ProcMeta#{custom:=changed,custom2=>added},
+ Expected = logger:get_process_metadata(),
ok = logger:unset_process_metadata(),
undefined = logger:get_process_metadata(),
@@ -720,7 +723,7 @@ check_maps(Expected,Got,What) ->
adding_handler(_Id,Config) ->
maybe_send(add),
{ok,Config}.
-removing_handler(_Id) ->
+removing_handler(_Id,_Config) ->
maybe_send(remove),
ok.
changing_config(_Id,_Old,#{call:=Fun}) ->
diff --git a/lib/kernel/test/logger_disk_log_h_SUITE.erl b/lib/kernel/test/logger_disk_log_h_SUITE.erl
index c7c6137380..63e5b56021 100644
--- a/lib/kernel/test/logger_disk_log_h_SUITE.erl
+++ b/lib/kernel/test/logger_disk_log_h_SUITE.erl
@@ -497,24 +497,19 @@ disk_log_sync(Config) ->
filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
formatter=>{?MODULE,nl}}),
- start_tracer([{?MODULE,format,2},
- {disk_log,blog,2},
+ start_tracer([{disk_log,blog,2},
{disk_log,sync,1}],
- [{formatter,"first"},
- {disk_log,blog},
+ [{disk_log,blog,<<"first\n">>},
{disk_log,sync}]),
logger:info("first", ?domain),
%% wait for automatic disk_log_sync
check_tracer(?FILESYNC_REPEAT_INTERVAL*2),
- start_tracer([{?MODULE,format,2},
- {disk_log,blog,2},
+ start_tracer([{disk_log,blog,2},
{disk_log,sync,1}],
- [{formatter,"second"},
- {formatter,"third"},
- {disk_log,blog},
- {disk_log,blog},
+ [{disk_log,blog,<<"second\n">>},
+ {disk_log,blog,<<"third\n">>},
{disk_log,sync}]),
%% two log requests in fast succession will make the handler skip
%% an automatic disk log sync
@@ -531,13 +526,10 @@ disk_log_sync(Config) ->
no_repeat = maps:get(filesync_repeat_interval,
logger_disk_log_h:info(?MODULE)),
- start_tracer([{?MODULE,format,2},
- {disk_log,blog,2},
+ start_tracer([{disk_log,blog,2},
{disk_log,sync,1}],
- [{formatter,"fourth"},
- {disk_log,blog},
- {formatter,"fifth"},
- {disk_log,blog},
+ [{disk_log,blog,<<"fourth\n">>},
+ {disk_log,blog,<<"fifth\n">>},
{disk_log,sync}]),
logger:info("fourth", ?domain),
@@ -566,6 +558,7 @@ disk_log_sync(Config) ->
check_tracer(100),
ok.
disk_log_sync(cleanup,_Config) ->
+ dbg:stop_clear(),
logger:remove_handler(?MODULE).
disk_log_wrap(Config) ->
@@ -623,6 +616,7 @@ disk_log_wrap(Config) ->
ok.
disk_log_wrap(cleanup,_Config) ->
+ dbg:stop_clear(),
logger:remove_handler(?MODULE).
disk_log_full(Config) ->
@@ -668,6 +662,7 @@ disk_log_full(Config) ->
{trace,{error_status,{error,{full,_}}}}] = Received,
ok.
disk_log_full(cleanup, _Config) ->
+ dbg:stop_clear(),
logger:remove_handler(?MODULE).
disk_log_events(Config) ->
@@ -713,6 +708,7 @@ disk_log_events(Config) ->
end, Received),
ok.
disk_log_events(cleanup, _Config) ->
+ dbg:stop_clear(),
logger:remove_handler(?MODULE).
write_failure(Config) ->
@@ -763,7 +759,7 @@ sync_failure(Config) ->
Dir = ?config(priv_dir, Config),
FileName = lists:concat([?MODULE,"_",?FUNCTION_NAME]),
File = filename:join(Dir, FileName),
- Log = lists:concat([File,".1"]),
+
Node = start_h_on_new_node(Config, ?FUNCTION_NAME, File),
false = (undefined == rpc:call(Node, ets, whereis, [?TEST_HOOKS_TAB])),
@@ -832,10 +828,10 @@ log_on_remote_node(Node,Msg) ->
ok.
%% functions for test hook macros to be called by rpc
-set_internal_log(Mod, Func) ->
- ?set_internal_log({Mod,Func}).
-set_result(Op, Result) ->
- ?set_result(Op, Result).
+set_internal_log(_Mod, _Func) ->
+ ?set_internal_log({_Mod,_Func}).
+set_result(_Op, _Result) ->
+ ?set_result(_Op, _Result).
set_defaults() ->
?set_defaults().
@@ -885,7 +881,7 @@ op_switch_to_drop(cleanup, _Config) ->
ok = stop_handler(?MODULE).
op_switch_to_flush() ->
- [{timetrap,{seconds,60}}].
+ [{timetrap,{minutes,3}}].
op_switch_to_flush(Config) ->
{Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
@@ -988,7 +984,7 @@ kill_disabled(cleanup, _Config) ->
ok = stop_handler(?MODULE).
qlen_kill_new(Config) ->
- {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ {_Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
Pid0 = whereis(?MODULE),
{_,Mem0} = process_info(Pid0, memory),
RestartAfter = 2000,
@@ -1025,7 +1021,7 @@ qlen_kill_new(cleanup, _Config) ->
ok = stop_handler(?MODULE).
mem_kill_new(Config) ->
- {Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ {_Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
Pid0 = whereis(?MODULE),
{_,Mem0} = process_info(Pid0, memory),
RestartAfter = 2000,
@@ -1111,7 +1107,7 @@ restart_after(cleanup, _Config) ->
%% during high load to verify that sync, dropping and flushing is
%% handled correctly.
handler_requests_under_load() ->
- [{timetrap,{seconds,60}}].
+ [{timetrap,{minutes,3}}].
handler_requests_under_load(Config) ->
{Log,HConfig,DLHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
NewHConfig =
@@ -1140,7 +1136,7 @@ handler_requests_under_load(Config) ->
NoOfReqs = lists:foldl(fun({_,Res}, N) -> N + length(Res) end, 0, ReqResult),
ct:pal("~w requests made. Errors: ~n~p", [NoOfReqs,Errors]),
ok = file:delete(Log).
-handler_requests_under_load(cleanup, Config) ->
+handler_requests_under_load(cleanup, _Config) ->
ok = stop_handler(?MODULE).
send_requests(HName, TO, Reqs = [{Req,Res}|Rs]) ->
@@ -1369,7 +1365,6 @@ start_tracer(Trace,Expected) ->
Pid = self(),
dbg:tracer(process,{fun tracer/2,{Pid,Expected}}),
dbg:p(whereis(?MODULE),[c]),
- dbg:p(Pid,[c]),
tpl(Trace),
ok.
@@ -1387,13 +1382,14 @@ tpl([{M,F,A}|Trace]) ->
tpl([]) ->
ok.
-tracer({trace,_,call,{?MODULE,format,[#{msg:={string,Msg}}|_]}}, {Pid,[{formatter,Msg}|Expected]}) ->
- maybe_tracer_done(Pid,Expected,{formatter,Msg});
tracer({trace,_,call,{logger_disk_log_h,handle_cast,[{Op,_}|_]}}, {Pid,[{Mod,Func,Op}|Expected]}) ->
maybe_tracer_done(Pid,Expected,{Mod,Func,Op});
+tracer({trace,_,call,{Mod=disk_log,Func=blog,[_,Data]}}, {Pid,[{Mod,Func,Data}|Expected]}) ->
+ maybe_tracer_done(Pid,Expected,{Mod,Func,Data});
tracer({trace,_,call,{Mod,Func,_}}, {Pid,[{Mod,Func}|Expected]}) ->
maybe_tracer_done(Pid,Expected,{Mod,Func});
tracer({trace,_,call,Call}, {Pid,Expected}) ->
+ ct:log("Tracer got unexpected: ~p~nExpected: ~p~n",[Call,Expected]),
Pid ! {tracer_got_unexpected,Call,Expected},
{Pid,Expected}.
@@ -1413,5 +1409,6 @@ check_tracer(T) ->
dbg:stop_clear(),
ct:fail({tracer_got_unexpected,Got,Expected})
after T ->
+ dbg:stop_clear(),
ct:fail({timeout,tracer})
end.
diff --git a/lib/kernel/test/logger_formatter_SUITE.erl b/lib/kernel/test/logger_formatter_SUITE.erl
index ac1abba629..7d1f33746d 100644
--- a/lib/kernel/test/logger_formatter_SUITE.erl
+++ b/lib/kernel/test/logger_formatter_SUITE.erl
@@ -73,18 +73,19 @@ all() ->
default(_Config) ->
String1 = format(info,{"~p",[term]},#{},#{}),
ct:log(String1),
- [_Date,_Time,"info:\nterm\n"] = string:lexemes(String1," "),
+ [_Date,_Time,"info:","term\n"] = string:lexemes(String1," "),
Time = timestamp(),
ExpectedTimestamp = default_time_format(Time),
String2 = format(info,{"~p",[term]},#{time=>Time},#{}),
ct:log(String2),
- " info:\nterm\n" = string:prefix(String2,ExpectedTimestamp),
+ " info: term\n" = string:prefix(String2,ExpectedTimestamp),
ok.
legacy_header(_Config) ->
Time = timestamp(),
- String1 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>true}),
+ String1 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>true,
+ single_line=>false}),
ct:log(String1),
"=INFO REPORT==== "++Rest = String1,
[Timestamp,"\nterm\n"] = string:lexemes(Rest," ="),
@@ -98,12 +99,14 @@ legacy_header(_Config) ->
true = lists:member(M,["Jan","Feb","Mar","Apr","May","Jun",
"Jul","Aug","Sep","Oct","Nov","Dec"]),
- String2 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>false}),
+ String2 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>false,
+ single_line=>false}),
ct:log(String2),
ExpectedTimestamp = default_time_format(Time),
" info:\nterm\n" = string:prefix(String2,ExpectedTimestamp),
- String3 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>bad}),
+ String3 = format(info,{"~p",[term]},#{time=>Time},#{legacy_header=>bad,
+ single_line=>false}),
ct:log(String3),
String3 = String2,
@@ -114,7 +117,8 @@ legacy_header(_Config) ->
String4 = String1,
String5 = format(info,{"~p",[term]},#{}, % <--- no time
- #{legacy_header=>true}),
+ #{legacy_header=>true,
+ single_line=>false}),
ct:log(String5),
"=INFO REPORT==== "++_ = String5,
ok.
@@ -289,38 +293,36 @@ report_cb(_Config) ->
ok.
max_size(_Config) ->
- Template = [msg],
+ Cfg = #{template=>[msg],
+ single_line=>false},
"12345678901234567890" =
- format(info,{"12345678901234567890",[]},#{},#{template=>Template}),
+ format(info,{"12345678901234567890",[]},#{},Cfg),
application:set_env(kernel,logger_max_size,11),
"12345678901234567890" = % min value is 50, so this is not limited
- format(info,{"12345678901234567890",[]},#{},#{template=>Template}),
+ format(info,{"12345678901234567890",[]},#{},Cfg),
"12345678901234567890123456789012345678901234567..." = % 50
format(info,
{"123456789012345678901234567890123456789012345678901234567890",
[]},
#{},
- #{template=>Template}),
+ Cfg),
application:set_env(kernel,logger_max_size,53),
"12345678901234567890123456789012345678901234567890..." = %53
format(info,
{"123456789012345678901234567890123456789012345678901234567890",
[]},
#{},
- #{template=>Template}),
+ Cfg),
"123456789012..." =
- format(info,{"12345678901234567890",[]},#{},#{template=>Template,
- max_size=>15}),
+ format(info,{"12345678901234567890",[]},#{},Cfg#{max_size=>15}),
"12345678901234567890" =
- format(info,{"12345678901234567890",[]},#{},#{template=>Template,
- max_size=>unlimited}),
+ format(info,{"12345678901234567890",[]},#{},Cfg#{max_size=>unlimited}),
%% Check that one newline at the end of the line is kept (if it exists)
"12345678901...\n" =
- format(info,{"12345678901234567890\n",[]},#{},#{template=>Template,
- max_size=>15}),
+ format(info,{"12345678901234567890\n",[]},#{},Cfg#{max_size=>15}),
"12345678901...\n" =
- format(info,{"12345678901234567890",[]},#{},#{template=>[msg,"\n"],
- max_size=>15}),
+ format(info,{"12345678901234567890",[]},#{},Cfg#{template=>[msg,"\n"],
+ max_size=>15}),
ok.
max_size(cleanup,_Config) ->
application:unset_env(kernel,logger_max_size),
@@ -441,20 +443,20 @@ format_time(_Config) ->
ExpectedTimestamp1 = default_time_format(Time1),
String1 = format(info,{"~p",[term]},#{time=>Time1},#{}),
ct:log(String1),
- " info:\nterm\n" = string:prefix(String1,ExpectedTimestamp1),
+ " info: term\n" = string:prefix(String1,ExpectedTimestamp1),
Time2 = timestamp(),
ExpectedTimestamp2 = default_time_format(Time2,true),
String2 = format(info,{"~p",[term]},#{time=>Time2},#{utc=>true}),
ct:log(String2),
- " info:\nterm\n" = string:prefix(String2,ExpectedTimestamp2),
+ " info: term\n" = string:prefix(String2,ExpectedTimestamp2),
application:set_env(kernel,logger_utc,true),
Time3 = timestamp(),
ExpectedTimestamp3 = default_time_format(Time3,true),
String3 = format(info,{"~p",[term]},#{time=>Time3},#{}),
ct:log(String3),
- " info:\nterm\n" = string:prefix(String3,ExpectedTimestamp3),
+ " info: term\n" = string:prefix(String3,ExpectedTimestamp3),
ok.
diff --git a/lib/kernel/test/logger_std_h_SUITE.erl b/lib/kernel/test/logger_std_h_SUITE.erl
index e940e0a026..7c8d63cbbd 100644
--- a/lib/kernel/test/logger_std_h_SUITE.erl
+++ b/lib/kernel/test/logger_std_h_SUITE.erl
@@ -499,86 +499,79 @@ filesync(Config) ->
#{logger_std_h => #{type => Type},
filter_default=>log,
filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
- formatter=>{?MODULE,self()}}),
- Tester = self(),
- TraceFun = fun({trace,_,call,{Mod,Func,Details}}, Pid) ->
- Pid ! {trace,Mod,Func,Details},
- Pid;
- ({trace,TPid,'receive',Received}, Pid) ->
- Pid ! {trace,TPid,Received},
- Pid
- end,
- {ok,_} = dbg:tracer(process, {TraceFun, Tester}),
- FileCtrlPid = maps:get(file_ctrl_pid , logger_std_h:info(?MODULE)),
- {ok,_} = dbg:p(FileCtrlPid, [c]),
- {ok,_} = dbg:tpl(logger_std_h, write_to_dev, 5, []),
- {ok,_} = dbg:tpl(logger_std_h, sync_dev, 4, []),
- {ok,_} = dbg:tp(file, datasync, 1, []),
+ formatter=>{?MODULE,nl}}),
+
+ %% check repeated filesync happens
+ start_tracer([{logger_std_h, write_to_dev, 5},
+ {logger_std_h, sync_dev, 4},
+ {file, datasync, 1}],
+ [{logger_std_h, write_to_dev, <<"first\n">>},
+ {logger_std_h, sync_dev},
+ {file,datasync}]),
logger:info("first", ?domain),
%% wait for automatic filesync
- timer:sleep(?FILESYNC_REP_INT),
- Expected1 = [{log,"first"}, {trace,logger_std_h,write_to_dev},
- {trace,logger_std_h,sync_dev}, {trace,file,datasync}],
-
+ check_tracer(?FILESYNC_REP_INT*2),
+
+ %% check that explicit filesync is only done once
+ start_tracer([{logger_std_h, write_to_dev, 5},
+ {logger_std_h, sync_dev, 4},
+ {file, datasync, 1}],
+ [{logger_std_h, write_to_dev, <<"second\n">>},
+ {logger_std_h, sync_dev},
+ {file,datasync},
+ {no_more,500}
+ ]),
logger:info("second", ?domain),
%% do explicit filesync
logger_std_h:filesync(?MODULE),
%% a second filesync should be ignored
logger_std_h:filesync(?MODULE),
- Expected2 = [{log,"second"}, {trace,logger_std_h,write_to_dev},
- {trace,logger_std_h,sync_dev}, {trace,file,datasync}],
+ check_tracer(100),
%% check that if there's no repeated filesync active,
%% a filesync is still performed when handler goes idle
logger:set_handler_config(?MODULE, logger_std_h,
#{filesync_repeat_interval => no_repeat}),
no_repeat = maps:get(filesync_repeat_interval, logger_std_h:info(?MODULE)),
+ %% The following timer is to make sure the time from last log
+ %% ("second") to next ("third") is long enough, so the a flush is
+ %% triggered by the idle timeout between "thrid" and "fourth".
+ timer:sleep(?IDLE_DETECT_TIME_MSEC*2),
+ start_tracer([{logger_std_h, write_to_dev, 5},
+ {logger_std_h, sync_dev, 4},
+ {file, datasync, 1}],
+ [{logger_std_h, write_to_dev, <<"third\n">>},
+ {logger_std_h, sync_dev},
+ {file,datasync},
+ {logger_std_h, write_to_dev, <<"fourth\n">>},
+ {logger_std_h, sync_dev},
+ {file,datasync}]),
logger:info("third", ?domain),
+ %% wait for automatic filesync
timer:sleep(?IDLE_DETECT_TIME_MSEC*2),
logger:info("fourth", ?domain),
%% wait for automatic filesync
- timer:sleep(?IDLE_DETECT_TIME_MSEC*2),
- Expected3 = [{log,"third"}, {trace,logger_std_h,write_to_dev},
- {log,"fourth"}, {trace,logger_std_h,write_to_dev},
- {trace,logger_std_h,sync_dev}, {trace,file,datasync}],
-
- dbg:stop_clear(),
-
- %% verify that filesync has been performed as expected
- Received1 = lists:map(fun({trace,M,F,_}) -> {trace,M,F};
- (Other) -> Other
- end, test_server:messages_get()),
- ct:pal("Trace #1 =~n~p", [Received1]),
- Received1 = Expected1 ++ Expected2 ++ Expected3,
-
- try_read_file(Log, {ok,<<"first\nsecond\nthird\nfourth\n">>}, 1000),
-
- {ok,_} = dbg:tracer(process, {TraceFun, Tester}),
- {ok,_} = dbg:p(whereis(?MODULE), [c]),
- {ok,_} = dbg:tpl(logger_std_h, handle_cast, 2, []),
+ check_tracer(?IDLE_DETECT_TIME_MSEC*2),
%% switch repeated filesync on and verify that the looping works
SyncInt = 1000,
WaitT = 4500,
+ OneSync = {logger_std_h,handle_cast,repeated_filesync},
+ %% receive 1 initial repeated_filesync, then 1 per sec
+ start_tracer([{logger_std_h,handle_cast,2}],
+ [OneSync || _ <- lists:seq(1, 1 + trunc(WaitT/SyncInt))]),
+
logger:set_handler_config(?MODULE, logger_std_h,
#{filesync_repeat_interval => SyncInt}),
SyncInt = maps:get(filesync_repeat_interval, logger_std_h:info(?MODULE)),
timer:sleep(WaitT),
logger:set_handler_config(?MODULE, logger_std_h,
- #{filesync_repeat_interval => no_repeat}),
- dbg:stop_clear(),
-
- Received2 = lists:map(fun({trace,_M,handle_cast,[{Op,_},_]}) -> {trace,Op};
- (Other) -> Other
- end, test_server:messages_get()),
- ct:pal("Trace #2 =~n~p", [Received2]),
- OneSync = [{trace,repeated_filesync}],
- %% receive 1 initial repeated_filesync, then 1 per sec
- Received2 =
- lists:flatten([OneSync || _ <- lists:seq(1, 1 + trunc(WaitT/SyncInt))]),
+ #{filesync_repeat_interval => no_repeat}),
+ check_tracer(100),
ok.
filesync(cleanup, _Config) ->
+ dbg:stop_clear(),
logger:remove_handler(?MODULE).
write_failure(Config) ->
@@ -785,7 +778,7 @@ op_switch_to_drop_tty(cleanup, _Config) ->
ok = stop_handler(?MODULE).
op_switch_to_flush_file() ->
- [{timetrap,{seconds,60}}].
+ [{timetrap,{minutes,3}}].
op_switch_to_flush_file(Config) ->
{Log,HConfig,StdHConfig} = start_handler(?MODULE, ?FUNCTION_NAME, Config),
@@ -1052,7 +1045,7 @@ restart_after(cleanup, _Config) ->
%% during high load to verify that sync, dropping and flushing is
%% handled correctly.
handler_requests_under_load() ->
- [{timetrap,{seconds,60}}].
+ [{timetrap,{minutes,3}}].
handler_requests_under_load(Config) ->
{Log,HConfig,StdHConfig} =
start_handler(?MODULE, ?FUNCTION_NAME, Config),
@@ -1394,3 +1387,67 @@ analyse(Msgs) ->
From ! {result,self(),TestFun(Msgs)},
analyse(Msgs)
end.
+
+start_tracer(Trace,Expected) ->
+ Pid = self(),
+ FileCtrlPid = maps:get(file_ctrl_pid, logger_std_h:info(?MODULE)),
+ dbg:tracer(process,{fun tracer/2,{Pid,Expected}}),
+ dbg:p(whereis(?MODULE),[c]),
+ dbg:p(FileCtrlPid,[c]),
+ tpl(Trace),
+ ok.
+
+tpl([{M,F,A}|Trace]) ->
+ {ok,Match} = dbg:tpl(M,F,A,[]),
+ case lists:keyfind(matched,1,Match) of
+ {_,_,1} ->
+ ok;
+ _ ->
+ dbg:stop_clear(),
+ throw({skip,"Can't trace "++atom_to_list(M)++":"++
+ atom_to_list(F)++"/"++integer_to_list(A)})
+ end,
+ tpl(Trace);
+tpl([]) ->
+ ok.
+
+tracer({trace,_,call,{logger_std_h,handle_cast,[{Op,_}|_]}},
+ {Pid,[{Mod,Func,Op}|Expected]}) ->
+ maybe_tracer_done(Pid,Expected,{Mod,Func,Op});
+tracer({trace,_,call,{Mod=logger_std_h,Func=write_to_dev,[_,Data,_,_,_]}},
+ {Pid,[{Mod,Func,Data}|Expected]}) ->
+ maybe_tracer_done(Pid,Expected,{Mod,Func,Data});
+tracer({trace,_,call,{Mod,Func,_}}, {Pid,[{Mod,Func}|Expected]}) ->
+ maybe_tracer_done(Pid,Expected,{Mod,Func});
+tracer({trace,_,call,Call}, {Pid,Expected}) ->
+ ct:log("Tracer got unexpected: ~p~nExpected: ~p~n",[Call,Expected]),
+ Pid ! {tracer_got_unexpected,Call,Expected},
+ {Pid,Expected}.
+
+maybe_tracer_done(Pid,[]=Expected,Got) ->
+ ct:log("Tracer got: ~p~n",[Got]),
+ Pid ! {tracer_done,0},
+ {Pid,Expected};
+maybe_tracer_done(Pid,[{no_more,T}]=Expected,Got) ->
+ ct:log("Tracer got: ~p~n",[Got]),
+ Pid ! {tracer_done,T},
+ {Pid,Expected};
+maybe_tracer_done(Pid,Expected,Got) ->
+ ct:log("Tracer got: ~p~n",[Got]),
+ {Pid,Expected}.
+
+check_tracer(T) ->
+ check_tracer(T,fun() -> ct:fail({timeout,tracer}) end).
+check_tracer(T,TimeoutFun) ->
+ receive
+ {tracer_done,Delay} ->
+ %% Possibly wait Delay ms to check that no unexpected
+ %% traces are received
+ check_tracer(Delay,fun() -> ok end);
+ {tracer_got_unexpected,Got,Expected} ->
+ dbg:stop_clear(),
+ ct:fail({tracer_got_unexpected,Got,Expected})
+ after T ->
+ dbg:stop_clear(),
+ TimeoutFun()
+ end.
diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl
index 591fbb2125..abbc301360 100644
--- a/lib/kernel/test/os_SUITE.erl
+++ b/lib/kernel/test/os_SUITE.erl
@@ -227,8 +227,8 @@ find_executable(Config) when is_list(Config) ->
DataDir = proplists:get_value(data_dir, Config),
%% Smoke test.
- case lib:progname() of
- erl ->
+ case ct:get_progname() of
+ "erl" ->
ErlPath = os:find_executable("erl"),
true = is_list(ErlPath),
true = filelib:is_regular(ErlPath);
@@ -388,7 +388,7 @@ comp(Expected, Got) ->
ct:fail(failed)
end.
-%% Like lib:nonl/1, but strips \r as well as \n.
+%% strips \n and \r\n from end of string
strip_nl([$\r, $\n]) -> [];
strip_nl([$\n]) -> [];
diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl
index 0678b64134..718ef91942 100644
--- a/lib/observer/src/observer_lib.erl
+++ b/lib/observer/src/observer_lib.erl
@@ -682,7 +682,7 @@ parse_string(Str) ->
{error, {_SLine, SMod, SError}, _} ->
throw(io_lib:format("~ts", [SMod:format_error(SError)]))
end,
- case lib:extended_parse_term(Tokens) of
+ case erl_eval:extended_parse_term(Tokens) of
{error, {_PLine, PMod, PError}} ->
throw(io_lib:format("~ts", [PMod:format_error(PError)]));
Res -> Res
diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl
index b4e1cfe5e3..ce1b9468fd 100644
--- a/lib/parsetools/src/yecc.erl
+++ b/lib/parsetools/src/yecc.erl
@@ -455,10 +455,14 @@ os_process_size() ->
case os:type() of
{unix, sunos} ->
Size = os:cmd("ps -o vsz -p " ++ os:getpid() ++ " | tail -1"),
- list_to_integer(lib:nonl(Size));
+ list_to_integer(nonl(Size));
_ ->
0
- end.
+ end.
+
+nonl([$\n]) -> [];
+nonl([]) -> [];
+nonl([H|T]) -> [H|nonl(T)].
timeit(Name, Fun, St0) ->
Time = runtime,
diff --git a/lib/sasl/src/sasl.erl b/lib/sasl/src/sasl.erl
index 657eb6688a..2bf11bdcdf 100644
--- a/lib/sasl/src/sasl.erl
+++ b/lib/sasl/src/sasl.erl
@@ -130,6 +130,7 @@ add_sasl_logger(undefined, _Level) -> ok;
add_sasl_logger(std, undefined) -> ok;
add_sasl_logger(Dest, Level) ->
FC0 = #{legacy_header=>true,
+ single_line=>false,
template=>[{logger_formatter,header},"\n",msg,"\n"]},
FC = case application:get_env(sasl,utc_log) of
{ok,Bool} when is_boolean(Bool) ->
diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml
index d78309167a..d0ed674eee 100644
--- a/lib/ssh/doc/src/notes.xml
+++ b/lib/ssh/doc/src/notes.xml
@@ -30,6 +30,28 @@
<file>notes.xml</file>
</header>
+<section><title>Ssh 4.6.9</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Host key hash erroneously calculated for clients
+ following draft-00 of RFC 4419, for example PuTTY</p>
+ <p>
+ Own Id: OTP-15064</p>
+ </item>
+ <item>
+ <p>
+ Renegotiation could fail in some states</p>
+ <p>
+ Own Id: OTP-15066</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Ssh 4.6.8</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
@@ -487,6 +509,34 @@
</section>
+<section><title>Ssh 4.4.2.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix rare spurios shutdowns of ssh servers when receiveing
+ <c>{'EXIT',_,normal}</c> messages.</p>
+ <p>
+ Own Id: OTP-15018</p>
+ </item>
+ <item>
+ <p>
+ Host key hash erroneously calculated for clients
+ following draft-00 of RFC 4419, for example PuTTY</p>
+ <p>
+ Own Id: OTP-15064</p>
+ </item>
+ <item>
+ <p>
+ Renegotiation could fail in some states</p>
+ <p>
+ Own Id: OTP-15066</p>
+ </item>
+ </list>
+ </section>
+
+</section>
<section><title>Ssh 4.4.2.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index 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 b21c0337ad..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} ->
@@ -545,7 +528,7 @@ role({_,Role}) -> Role;
role({_,Role,_}) -> Role.
-spec renegotiation(state_name()) -> boolean().
-renegotiation({_,_,ReNeg}) -> ReNeg == renegotiation;
+renegotiation({_,_,ReNeg}) -> ReNeg == renegotiate;
renegotiation(_) -> false.
@@ -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/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl
index f5bba9f824..631c4d0213 100644
--- a/lib/ssh/src/ssh_transport.erl
+++ b/lib/ssh/src/ssh_transport.erl
@@ -1808,9 +1808,10 @@ kex_alg_dependent({E, F, K}) ->
%% diffie-hellman and ec diffie-hellman (with E = Q_c, F = Q_s)
<<?Empint(E), ?Empint(F), ?Empint(K)>>;
-kex_alg_dependent({-1, _, -1, _, _, E, F, K}) ->
+kex_alg_dependent({-1, NBits, -1, Prime, Gen, E, F, K}) ->
%% ssh_msg_kex_dh_gex_request_old
- <<?Empint(E), ?Empint(F), ?Empint(K)>>;
+ <<?Euint32(NBits),
+ ?Empint(Prime), ?Empint(Gen), ?Empint(E), ?Empint(F), ?Empint(K)>>;
kex_alg_dependent({Min, NBits, Max, Prime, Gen, E, F, K}) ->
%% diffie-hellman group exchange
@@ -1849,9 +1850,6 @@ public_algo({#'ECPoint'{},{namedCurve,OID}}) ->
Curve = public_key:oid2ssh_curvename(OID),
list_to_atom("ecdsa-sha2-" ++ binary_to_list(Curve)).
-
-
-
sha('ssh-rsa') -> sha;
sha('rsa-sha2-256') -> sha256;
sha('rsa-sha2-384') -> sha384;
diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl
index 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/ssh/vsn.mk b/lib/ssh/vsn.mk
index f327d2ec11..f10e7aa96a 100644
--- a/lib/ssh/vsn.mk
+++ b/lib/ssh/vsn.mk
@@ -1,4 +1,5 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
-SSH_VSN = 4.6.8
+SSH_VSN = 4.6.9
+
APP_VSN = "ssh-$(SSH_VSN)"
diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl
index 3e9828a2fe..d45f209838 100644
--- a/lib/ssl/src/inet_tls_dist.erl
+++ b/lib/ssl/src/inet_tls_dist.erl
@@ -518,51 +518,16 @@ gen_setup(Driver, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
{Name, Address} = split_node(Driver, Node, LongOrShortNames),
- case Driver:getaddr(Address) of
+ ErlEpmd = net_kernel:epmd_module(),
+ {ARMod, ARFun} = get_address_resolver(ErlEpmd, Driver),
+ Timer = trace(dist_util:start_timer(SetupTime)),
+ case ARMod:ARFun(Address) of
+ {ok, Ip, TcpPort, Version} ->
+ do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNode, Timer);
{ok, Ip} ->
- Timer = trace(dist_util:start_timer(SetupTime)),
- ErlEpmd = net_kernel:epmd_module(),
case ErlEpmd:port_please(Name, Ip) of
{port, TcpPort, Version} ->
- Opts =
- trace(
- connect_options(
- %%
- %% Use verify_server/3 to verify that
- %% the server's certificate is for Node
- %%
- setup_verify_server(
- get_ssl_options(client), Node))),
- dist_util:reset_timer(Timer),
- case ssl:connect(
- Address, TcpPort,
- [binary, {active, false}, {packet, 4},
- Driver:family(), nodelay()] ++ Opts,
- net_kernel:connecttime()) of
- {ok, #sslsocket{pid = DistCtrl} = SslSocket} ->
- _ = monitor_pid(DistCtrl),
- ok = ssl:controlling_process(SslSocket, self()),
- HSData0 = hs_data_common(SslSocket),
- HSData =
- HSData0#hs_data{
- kernel_pid = Kernel,
- other_node = Node,
- this_node = MyNode,
- socket = DistCtrl,
- timer = Timer,
- this_flags = 0,
- other_version = Version,
- request_type = Type},
- link(DistCtrl),
- dist_util:handshake_we_started(trace(HSData));
- Other ->
- %% Other Node may have closed since
- %% port_please !
- ?shutdown2(
- Node,
- trace(
- {ssl_connect_failed, Ip, TcpPort, Other}))
- end;
+ do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNode, Timer);
Other ->
?shutdown2(
Node,
@@ -575,6 +540,47 @@ do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
trace({getaddr_failed, Driver, Address, Other}))
end.
+do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNode, Timer) ->
+ Opts =
+ trace(
+ connect_options(
+ %%
+ %% Use verify_server/3 to verify that
+ %% the server's certificate is for Node
+ %%
+ setup_verify_server(
+ get_ssl_options(client), Node))),
+ dist_util:reset_timer(Timer),
+ case ssl:connect(
+ Address, TcpPort,
+ [binary, {active, false}, {packet, 4},
+ Driver:family(), nodelay()] ++ Opts,
+ net_kernel:connecttime()) of
+ {ok, #sslsocket{pid = DistCtrl} = SslSocket} ->
+ _ = monitor_pid(DistCtrl),
+ ok = ssl:controlling_process(SslSocket, self()),
+ HSData0 = hs_data_common(SslSocket),
+ HSData =
+ HSData0#hs_data{
+ kernel_pid = Kernel,
+ other_node = Node,
+ this_node = MyNode,
+ socket = DistCtrl,
+ timer = Timer,
+ this_flags = 0,
+ other_version = Version,
+ request_type = Type},
+ link(DistCtrl),
+ dist_util:handshake_we_started(trace(HSData));
+ Other ->
+ %% Other Node may have closed since
+ %% port_please !
+ ?shutdown2(
+ Node,
+ trace(
+ {ssl_connect_failed, Ip, TcpPort, Other}))
+ end.
+
close(Socket) ->
gen_close(inet, Socket).
@@ -644,6 +650,16 @@ verify_server(PeerCert, valid_peer, {CertNodesFun,Node} = S) ->
%% ------------------------------------------------------------
+%% Determine if EPMD module supports address resolving. Default
+%% is to use inet_tcp:getaddr/2.
+%% ------------------------------------------------------------
+get_address_resolver(EpmdModule, Driver) ->
+ case erlang:function_exported(EpmdModule, address_please, 3) of
+ true -> {EpmdModule, address_please};
+ _ -> {Driver, getaddr}
+ end.
+
+%% ------------------------------------------------------------
%% Do only accept new connection attempts from nodes at our
%% own LAN, if the check_ip environment parameter is true.
%% ------------------------------------------------------------
diff --git a/lib/ssl/src/ssl_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/doc/src/string.xml b/lib/stdlib/doc/src/string.xml
index c7772d63a3..4a3d37dcb6 100644
--- a/lib/stdlib/doc/src/string.xml
+++ b/lib/stdlib/doc/src/string.xml
@@ -641,7 +641,7 @@ ÖÄÅ</pre>
<note><p>
The functions are kept for backward compatibility, but are
not recommended.
- They will be deprecated in Erlang/OTP 21.
+ They will be deprecated in a future release.
</p>
<p>Any undocumented functions in <c>string</c> are not to be used.</p>
</note>
diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile
index dc3735055a..dfe6bf3e68 100644
--- a/lib/stdlib/src/Makefile
+++ b/lib/stdlib/src/Makefile
@@ -62,6 +62,7 @@ MODULES= \
erl_anno \
erl_bits \
erl_compile \
+ erl_error \
erl_eval \
erl_expand_records \
erl_internal \
@@ -91,7 +92,6 @@ MODULES= \
io_lib_format \
io_lib_fread \
io_lib_pretty \
- lib \
lists \
log_mf_h \
maps \
@@ -176,6 +176,7 @@ docs:
primary_bootstrap_compiler: \
$(BOOTSTRAP_COMPILER)/ebin/epp.beam \
$(BOOTSTRAP_COMPILER)/ebin/erl_anno.beam \
+ $(BOOTSTRAP_COMPILER)/ebin/erl_error.beam \
$(BOOTSTRAP_COMPILER)/ebin/erl_scan.beam \
$(BOOTSTRAP_COMPILER)/ebin/erl_parse.beam \
$(BOOTSTRAP_COMPILER)/ebin/erl_lint.beam \
diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/erl_error.erl
index 51e0c3f77e..fdcb9e824c 100644
--- a/lib/stdlib/src/lib.erl
+++ b/lib/stdlib/src/erl_error.erl
@@ -17,337 +17,12 @@
%%
%% %CopyrightEnd%
%%
--module(lib).
-
--export([flush_receive/0, error_message/2, progname/0, nonl/1, send/2,
- sendw/2, eval_str/1]).
-
--export([extended_parse_exprs/1, extended_parse_term/1,
- subst_values_for_vars/2]).
+-module(erl_error).
-export([format_exception/6, format_exception/7,
format_stacktrace/4, format_stacktrace/5,
format_call/4, format_call/5, format_fun/1, format_fun/2]).
--spec flush_receive() -> 'ok'.
-
-flush_receive() ->
- receive
- _Any ->
- flush_receive()
- after
- 0 ->
- ok
- end.
-
-%%
-%% Functions for doing standard system format i/o.
-%%
--spec error_message(Format, Args) -> 'ok' when
- Format :: io:format(),
- Args :: [term()].
-
-error_message(Format, Args) ->
- io:format(<<"** ~ts **\n">>, [io_lib:format(Format, Args)]).
-
-%% Return the name of the script that starts (this) erlang
-%%
--spec progname() -> atom().
-
-progname() ->
- case init:get_argument(progname) of
- {ok, [[Prog]]} ->
- list_to_atom(Prog);
- _Other ->
- no_prog_name
- end.
-
--spec nonl(String1) -> String2 when
- String1 :: string(),
- String2 :: string().
-
-nonl([10]) -> [];
-nonl([]) -> [];
-nonl([H|T]) -> [H|nonl(T)].
-
--spec send(To, Msg) -> Msg when
- To :: pid() | atom() | {atom(), node()},
- Msg :: term().
-
-send(To, Msg) -> To ! Msg.
-
--spec sendw(To, Msg) -> term() when
- To :: pid() | atom() | {atom(), node()},
- Msg :: term().
-
-sendw(To, Msg) ->
- To ! {self(), Msg},
- receive
- Reply -> Reply
- end.
-
-%% eval_str(InStr) -> {ok, OutStr} | {error, ErrStr'}
-%% InStr must represent a body
-%% Note: If InStr is a binary it has to be a Latin-1 string.
-%% If you have a UTF-8 encoded binary you have to call
-%% unicode:characters_to_list/1 before the call to eval_str().
-
--define(result(F,D), lists:flatten(io_lib:format(F, D))).
-
--spec eval_str(string() | unicode:latin1_binary()) ->
- {'ok', string()} | {'error', string()}.
-
-eval_str(Str) when is_list(Str) ->
- case erl_scan:tokens([], Str, 0) of
- {more, _} ->
- {error, "Incomplete form (missing .<cr>)??"};
- {done, {ok, Toks, _}, Rest} ->
- case all_white(Rest) of
- true ->
- case erl_parse:parse_exprs(Toks) of
- {ok, Exprs} ->
- case catch erl_eval:exprs(Exprs, erl_eval:new_bindings()) of
- {value, Val, _} ->
- {ok, Val};
- Other ->
- {error, ?result("*** eval: ~p", [Other])}
- end;
- {error, {_Line, Mod, Args}} ->
- Msg = ?result("*** ~ts",[Mod:format_error(Args)]),
- {error, Msg}
- end;
- false ->
- {error, ?result("Non-white space found after "
- "end-of-form :~ts", [Rest])}
- end
- end;
-eval_str(Bin) when is_binary(Bin) ->
- eval_str(binary_to_list(Bin)).
-
-all_white([$\s|T]) -> all_white(T);
-all_white([$\n|T]) -> all_white(T);
-all_white([$\t|T]) -> all_white(T);
-all_white([]) -> true;
-all_white(_) -> false.
-
-%% `Tokens' is assumed to have been scanned with the 'text' option.
-%% The annotations of the returned expressions are locations.
-%%
-%% Can handle pids, ports, references, and external funs ("items").
-%% Known items are represented by variables in the erl_parse tree, and
-%% the items themselves are stored in the returned bindings.
-
--spec extended_parse_exprs(Tokens) ->
- {'ok', ExprList, Bindings} | {'error', ErrorInfo} when
- Tokens :: [erl_scan:token()],
- ExprList :: [erl_parse:abstract_expr()],
- Bindings :: erl_eval:binding_struct(),
- ErrorInfo :: erl_parse:error_info().
-
-extended_parse_exprs(Tokens) ->
- Ts = tokens_fixup(Tokens),
- case erl_parse:parse_exprs(Ts) of
- {ok, Exprs0} ->
- {Exprs, Bs} = expr_fixup(Exprs0),
- {ok, reset_expr_anno(Exprs), Bs};
- _ErrorInfo ->
- erl_parse:parse_exprs(reset_token_anno(Ts))
- end.
-
-tokens_fixup([]) -> [];
-tokens_fixup([T|Ts]=Ts0) ->
- try token_fixup(Ts0) of
- {NewT, NewTs} ->
- [NewT|tokens_fixup(NewTs)]
- catch
- _:_ ->
- [T|tokens_fixup(Ts)]
- end.
-
-token_fixup(Ts) ->
- {AnnoL, NewTs, FixupTag} = unscannable(Ts),
- String = lists:append([erl_anno:text(A) || A <- AnnoL]),
- _ = (fixup_fun(FixupTag))(String),
- NewAnno = erl_anno:set_text(fixup_text(FixupTag), hd(AnnoL)),
- {{string, NewAnno, String}, NewTs}.
-
-unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _},
- {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) ->
- {[A1, A2, A3, A4, A5, A6, A7], Ts, function};
-unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _},
- {'.', A5}, {atom, A6, _}, {'.', A7}, {integer, A8, _},
- {'>', A9}|Ts]) ->
- {[A1, A2, A3, A4, A5, A6, A7, A8, A9], Ts, function};
-unscannable([{'<', A1}, {float, A2, _}, {'.', A3}, {integer, A4, _},
- {'>', A5}|Ts]) ->
- {[A1, A2, A3, A4, A5], Ts, pid};
-unscannable([{'#', A1}, {var, A2, 'Port'}, {'<', A3}, {float, A4, _},
- {'>', A5}|Ts]) ->
- {[A1, A2, A3, A4, A5], Ts, port};
-unscannable([{'#', A1}, {var, A2, 'Ref'}, {'<', A3}, {float, A4, _},
- {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) ->
- {[A1, A2, A3, A4, A5, A6, A7], Ts, reference}.
-
-expr_fixup(Expr0) ->
- {Expr, Bs, _} = expr_fixup(Expr0, erl_eval:new_bindings(), 1),
- {Expr, Bs}.
-
-expr_fixup({string,A,S}=T, Bs0, I) ->
- try string_fixup(A, S) of
- Value ->
- Var = new_var(I),
- Bs = erl_eval:add_binding(Var, Value, Bs0),
- {{var, A, Var}, Bs, I+1}
- catch
- _:_ ->
- {T, Bs0, I}
- end;
-expr_fixup(Tuple, Bs0, I0) when is_tuple(Tuple) ->
- {L, Bs, I} = expr_fixup(tuple_to_list(Tuple), Bs0, I0),
- {list_to_tuple(L), Bs, I};
-expr_fixup([E0|Es0], Bs0, I0) ->
- {E, Bs1, I1} = expr_fixup(E0, Bs0, I0),
- {Es, Bs, I} = expr_fixup(Es0, Bs1, I1),
- {[E|Es], Bs, I};
-expr_fixup(T, Bs, I) ->
- {T, Bs, I}.
-
-string_fixup(A, S) ->
- Text = erl_anno:text(A),
- FixupTag = fixup_tag(Text, S),
- (fixup_fun(FixupTag))(S).
-
-new_var(I) ->
- list_to_atom(lists:concat(['__ExtendedParseExprs_', I, '__'])).
-
-reset_token_anno(Tokens) ->
- [setelement(2, T, (reset_anno())(element(2, T))) || T <- Tokens].
-
-reset_expr_anno(Exprs) ->
- [erl_parse:map_anno(reset_anno(), E) || E <- Exprs].
-
-reset_anno() ->
- fun(A) -> erl_anno:new(erl_anno:location(A)) end.
-
-fixup_fun(function) -> fun function/1;
-fixup_fun(pid) -> fun erlang:list_to_pid/1;
-fixup_fun(port) -> fun erlang:list_to_port/1;
-fixup_fun(reference) -> fun erlang:list_to_ref/1.
-
-function(S) ->
- %% External function.
- {ok, [_, _, _,
- {atom, _, Module}, _,
- {atom, _, Function}, _,
- {integer, _, Arity}|_], _} = erl_scan:string(S),
- erlang:make_fun(Module, Function, Arity).
-
-fixup_text(function) -> "function";
-fixup_text(pid) -> "pid";
-fixup_text(port) -> "port";
-fixup_text(reference) -> "reference".
-
-fixup_tag("function", "#"++_) -> function;
-fixup_tag("pid", "<"++_) -> pid;
-fixup_tag("port", "#"++_) -> port;
-fixup_tag("reference", "#"++_) -> reference.
-
-%%% End of extended_parse_exprs.
-
-%% `Tokens' is assumed to have been scanned with the 'text' option.
-%%
-%% Can handle pids, ports, references, and external funs.
-
--spec extended_parse_term(Tokens) ->
- {'ok', Term} | {'error', ErrorInfo} when
- Tokens :: [erl_scan:token()],
- Term :: term(),
- ErrorInfo :: erl_parse:error_info().
-
-extended_parse_term(Tokens) ->
- case extended_parse_exprs(Tokens) of
- {ok, [Expr], Bindings} ->
- try normalise(Expr, Bindings) of
- Term ->
- {ok, Term}
- catch
- _:_ ->
- Loc = erl_anno:location(element(2, Expr)),
- {error,{Loc,?MODULE,"bad term"}}
- end;
- {ok, [_,Expr|_], _Bindings} ->
- Loc = erl_anno:location(element(2, Expr)),
- {error,{Loc,?MODULE,"bad term"}};
- {error, _} = Error ->
- Error
- end.
-
-%% From erl_parse.
-normalise({var, _, V}, Bs) ->
- {value, Value} = erl_eval:binding(V, Bs),
- Value;
-normalise({char,_,C}, _Bs) -> C;
-normalise({integer,_,I}, _Bs) -> I;
-normalise({float,_,F}, _Bs) -> F;
-normalise({atom,_,A}, _Bs) -> A;
-normalise({string,_,S}, _Bs) -> S;
-normalise({nil,_}, _Bs) -> [];
-normalise({bin,_,Fs}, Bs) ->
- {value, B, _} =
- eval_bits:expr_grp(Fs, [],
- fun(E, _) ->
- {value, normalise(E, Bs), []}
- end, [], true),
- B;
-normalise({cons,_,Head,Tail}, Bs) ->
- [normalise(Head, Bs)|normalise(Tail, Bs)];
-normalise({tuple,_,Args}, Bs) ->
- list_to_tuple(normalise_list(Args, Bs));
-normalise({map,_,Pairs}, Bs) ->
- maps:from_list(lists:map(fun
- %% only allow '=>'
- ({map_field_assoc,_,K,V}) ->
- {normalise(K, Bs),normalise(V, Bs)}
- end, Pairs));
-%% Special case for unary +/-.
-normalise({op,_,'+',{char,_,I}}, _Bs) -> I;
-normalise({op,_,'+',{integer,_,I}}, _Bs) -> I;
-normalise({op,_,'+',{float,_,F}}, _Bs) -> F;
-normalise({op,_,'-',{char,_,I}}, _Bs) -> -I; %Weird, but compatible!
-normalise({op,_,'-',{integer,_,I}}, _Bs) -> -I;
-normalise({op,_,'-',{float,_,F}}, _Bs) -> -F;
-normalise({'fun',_,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Bs) ->
- %% Since "#Fun<M.F.A>" is recognized, "fun M:F/A" should be too.
- fun M:F/A.
-
-normalise_list([H|T], Bs) ->
- [normalise(H, Bs)|normalise_list(T, Bs)];
-normalise_list([], _Bs) ->
- [].
-
-%% To be used on ExprList and Bindings returned from extended_parse_exprs().
-%% Substitute {value, A, Item} for {var, A, ExtendedParseVar}.
-%% {value, A, Item} is a shell/erl_eval convention, and for example
-%% the linter cannot handle it.
-
--spec subst_values_for_vars(ExprList, Bindings) -> [term()] when
- ExprList :: [erl_parse:abstract_expr()],
- Bindings :: erl_eval:binding_struct().
-
-subst_values_for_vars({var, A, V}=Var, Bs) ->
- case erl_eval:binding(V, Bs) of
- {value, Value} ->
- {value, A, Value};
- unbound ->
- Var
- end;
-subst_values_for_vars(L, Bs) when is_list(L) ->
- [subst_values_for_vars(E, Bs) || E <- L];
-subst_values_for_vars(T, Bs) when is_tuple(T) ->
- list_to_tuple(subst_values_for_vars(tuple_to_list(T), Bs));
-subst_values_for_vars(T, _Bs) ->
- T.
-
%%% Formatting of exceptions, mfa:s and funs.
%% -> iolist() (no \n at end)
diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl
index 4ee11383da..0f6d48b9a3 100644
--- a/lib/stdlib/src/erl_eval.erl
+++ b/lib/stdlib/src/erl_eval.erl
@@ -27,7 +27,8 @@
-export([exprs/2,exprs/3,exprs/4,expr/2,expr/3,expr/4,expr/5,
expr_list/2,expr_list/3,expr_list/4]).
-export([new_bindings/0,bindings/1,binding/2,add_binding/3,del_binding/2]).
-
+-export([extended_parse_exprs/1, extended_parse_term/1,
+ subst_values_for_vars/2]).
-export([is_constant_expr/1, partial_eval/1]).
%% Is used by standalone Erlang (escript).
@@ -1286,6 +1287,224 @@ merge_bindings(Bs1, Bs2) ->
%% error -> Bs
%% end
%% end, Bs2, Bs1).
+
+%% Substitute {value, A, Item} for {var, A, Var}, preserving A.
+%% {value, A, Item} is a shell/erl_eval convention, and for example
+%% the linter cannot handle it.
+
+-spec subst_values_for_vars(ExprList, Bindings) -> [term()] when
+ ExprList :: [erl_parse:abstract_expr()],
+ Bindings :: binding_struct().
+
+subst_values_for_vars({var, A, V}=Var, Bs) ->
+ case erl_eval:binding(V, Bs) of
+ {value, Value} ->
+ {value, A, Value};
+ unbound ->
+ Var
+ end;
+subst_values_for_vars(L, Bs) when is_list(L) ->
+ [subst_values_for_vars(E, Bs) || E <- L];
+subst_values_for_vars(T, Bs) when is_tuple(T) ->
+ list_to_tuple(subst_values_for_vars(tuple_to_list(T), Bs));
+subst_values_for_vars(T, _Bs) ->
+ T.
+
+%% `Tokens' is assumed to have been scanned with the 'text' option.
+%% The annotations of the returned expressions are locations.
+%%
+%% Can handle pids, ports, references, and external funs ("items").
+%% Known items are represented by variables in the erl_parse tree, and
+%% the items themselves are stored in the returned bindings.
+
+-spec extended_parse_exprs(Tokens) ->
+ {'ok', ExprList, Bindings} | {'error', ErrorInfo} when
+ Tokens :: [erl_scan:token()],
+ ExprList :: [erl_parse:abstract_expr()],
+ Bindings :: erl_eval:binding_struct(),
+ ErrorInfo :: erl_parse:error_info().
+
+extended_parse_exprs(Tokens) ->
+ Ts = tokens_fixup(Tokens),
+ case erl_parse:parse_exprs(Ts) of
+ {ok, Exprs0} ->
+ {Exprs, Bs} = expr_fixup(Exprs0),
+ {ok, reset_expr_anno(Exprs), Bs};
+ _ErrorInfo ->
+ erl_parse:parse_exprs(reset_token_anno(Ts))
+ end.
+
+tokens_fixup([]) -> [];
+tokens_fixup([T|Ts]=Ts0) ->
+ try token_fixup(Ts0) of
+ {NewT, NewTs} ->
+ [NewT|tokens_fixup(NewTs)]
+ catch
+ _:_ ->
+ [T|tokens_fixup(Ts)]
+ end.
+
+token_fixup(Ts) ->
+ {AnnoL, NewTs, FixupTag} = unscannable(Ts),
+ String = lists:append([erl_anno:text(A) || A <- AnnoL]),
+ _ = (fixup_fun(FixupTag))(String),
+ NewAnno = erl_anno:set_text(fixup_text(FixupTag), hd(AnnoL)),
+ {{string, NewAnno, String}, NewTs}.
+
+unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _},
+ {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) ->
+ {[A1, A2, A3, A4, A5, A6, A7], Ts, function};
+unscannable([{'#', A1}, {var, A2, 'Fun'}, {'<', A3}, {atom, A4, _},
+ {'.', A5}, {atom, A6, _}, {'.', A7}, {integer, A8, _},
+ {'>', A9}|Ts]) ->
+ {[A1, A2, A3, A4, A5, A6, A7, A8, A9], Ts, function};
+unscannable([{'<', A1}, {float, A2, _}, {'.', A3}, {integer, A4, _},
+ {'>', A5}|Ts]) ->
+ {[A1, A2, A3, A4, A5], Ts, pid};
+unscannable([{'#', A1}, {var, A2, 'Port'}, {'<', A3}, {float, A4, _},
+ {'>', A5}|Ts]) ->
+ {[A1, A2, A3, A4, A5], Ts, port};
+unscannable([{'#', A1}, {var, A2, 'Ref'}, {'<', A3}, {float, A4, _},
+ {'.', A5}, {float, A6, _}, {'>', A7}|Ts]) ->
+ {[A1, A2, A3, A4, A5, A6, A7], Ts, reference}.
+
+expr_fixup(Expr0) ->
+ {Expr, Bs, _} = expr_fixup(Expr0, erl_eval:new_bindings(), 1),
+ {Expr, Bs}.
+
+expr_fixup({string,A,S}=T, Bs0, I) ->
+ try string_fixup(A, S) of
+ Value ->
+ Var = new_var(I),
+ Bs = erl_eval:add_binding(Var, Value, Bs0),
+ {{var, A, Var}, Bs, I+1}
+ catch
+ _:_ ->
+ {T, Bs0, I}
+ end;
+expr_fixup(Tuple, Bs0, I0) when is_tuple(Tuple) ->
+ {L, Bs, I} = expr_fixup(tuple_to_list(Tuple), Bs0, I0),
+ {list_to_tuple(L), Bs, I};
+expr_fixup([E0|Es0], Bs0, I0) ->
+ {E, Bs1, I1} = expr_fixup(E0, Bs0, I0),
+ {Es, Bs, I} = expr_fixup(Es0, Bs1, I1),
+ {[E|Es], Bs, I};
+expr_fixup(T, Bs, I) ->
+ {T, Bs, I}.
+
+string_fixup(A, S) ->
+ Text = erl_anno:text(A),
+ FixupTag = fixup_tag(Text, S),
+ (fixup_fun(FixupTag))(S).
+
+new_var(I) ->
+ list_to_atom(lists:concat(['__ExtendedParseExprs_', I, '__'])).
+
+reset_token_anno(Tokens) ->
+ [setelement(2, T, (reset_anno())(element(2, T))) || T <- Tokens].
+
+reset_expr_anno(Exprs) ->
+ [erl_parse:map_anno(reset_anno(), E) || E <- Exprs].
+
+reset_anno() ->
+ fun(A) -> erl_anno:new(erl_anno:location(A)) end.
+
+fixup_fun(function) -> fun function/1;
+fixup_fun(pid) -> fun erlang:list_to_pid/1;
+fixup_fun(port) -> fun erlang:list_to_port/1;
+fixup_fun(reference) -> fun erlang:list_to_ref/1.
+
+function(S) ->
+ %% External function.
+ {ok, [_, _, _,
+ {atom, _, Module}, _,
+ {atom, _, Function}, _,
+ {integer, _, Arity}|_], _} = erl_scan:string(S),
+ erlang:make_fun(Module, Function, Arity).
+
+fixup_text(function) -> "function";
+fixup_text(pid) -> "pid";
+fixup_text(port) -> "port";
+fixup_text(reference) -> "reference".
+
+fixup_tag("function", "#"++_) -> function;
+fixup_tag("pid", "<"++_) -> pid;
+fixup_tag("port", "#"++_) -> port;
+fixup_tag("reference", "#"++_) -> reference.
+
+%%% End of extended_parse_exprs.
+
+%% `Tokens' is assumed to have been scanned with the 'text' option.
+%%
+%% Can handle pids, ports, references, and external funs.
+
+-spec extended_parse_term(Tokens) ->
+ {'ok', Term} | {'error', ErrorInfo} when
+ Tokens :: [erl_scan:token()],
+ Term :: term(),
+ ErrorInfo :: erl_parse:error_info().
+
+extended_parse_term(Tokens) ->
+ case extended_parse_exprs(Tokens) of
+ {ok, [Expr], Bindings} ->
+ try normalise(Expr, Bindings) of
+ Term ->
+ {ok, Term}
+ catch
+ _:_ ->
+ Loc = erl_anno:location(element(2, Expr)),
+ {error,{Loc,?MODULE,"bad term"}}
+ end;
+ {ok, [_,Expr|_], _Bindings} ->
+ Loc = erl_anno:location(element(2, Expr)),
+ {error,{Loc,?MODULE,"bad term"}};
+ {error, _} = Error ->
+ Error
+ end.
+
+%% From erl_parse.
+normalise({var, _, V}, Bs) ->
+ {value, Value} = erl_eval:binding(V, Bs),
+ Value;
+normalise({char,_,C}, _Bs) -> C;
+normalise({integer,_,I}, _Bs) -> I;
+normalise({float,_,F}, _Bs) -> F;
+normalise({atom,_,A}, _Bs) -> A;
+normalise({string,_,S}, _Bs) -> S;
+normalise({nil,_}, _Bs) -> [];
+normalise({bin,_,Fs}, Bs) ->
+ {value, B, _} =
+ eval_bits:expr_grp(Fs, [],
+ fun(E, _) ->
+ {value, normalise(E, Bs), []}
+ end, [], true),
+ B;
+normalise({cons,_,Head,Tail}, Bs) ->
+ [normalise(Head, Bs)|normalise(Tail, Bs)];
+normalise({tuple,_,Args}, Bs) ->
+ list_to_tuple(normalise_list(Args, Bs));
+normalise({map,_,Pairs}, Bs) ->
+ maps:from_list(lists:map(fun
+ %% only allow '=>'
+ ({map_field_assoc,_,K,V}) ->
+ {normalise(K, Bs),normalise(V, Bs)}
+ end, Pairs));
+%% Special case for unary +/-.
+normalise({op,_,'+',{char,_,I}}, _Bs) -> I;
+normalise({op,_,'+',{integer,_,I}}, _Bs) -> I;
+normalise({op,_,'+',{float,_,F}}, _Bs) -> F;
+normalise({op,_,'-',{char,_,I}}, _Bs) -> -I; %Weird, but compatible!
+normalise({op,_,'-',{integer,_,I}}, _Bs) -> -I;
+normalise({op,_,'-',{float,_,F}}, _Bs) -> -F;
+normalise({'fun',_,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Bs) ->
+ %% Since "#Fun<M.F.A>" is recognized, "fun M:F/A" should be too.
+ fun M:F/A.
+
+normalise_list([H|T], Bs) ->
+ [normalise(H, Bs)|normalise_list(T, Bs)];
+normalise_list([], _Bs) ->
+ [].
+
%%----------------------------------------------------------------------------
%%
%% Evaluate expressions:
diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl
index 6d3d5baa23..dd509191ef 100644
--- a/lib/stdlib/src/erl_internal.erl
+++ b/lib/stdlib/src/erl_internal.erl
@@ -109,6 +109,7 @@ new_type_test(is_function, 2) -> true;
new_type_test(is_integer, 1) -> true;
new_type_test(is_list, 1) -> true;
new_type_test(is_map, 1) -> true;
+new_type_test(is_map_key, 2) -> true;
new_type_test(is_number, 1) -> true;
new_type_test(is_pid, 1) -> true;
new_type_test(is_port, 1) -> true;
@@ -315,6 +316,7 @@ bif(is_function, 2) -> true;
bif(is_integer, 1) -> true;
bif(is_list, 1) -> true;
bif(is_map, 1) -> true;
+bif(is_map_key, 2) -> true;
bif(is_number, 1) -> true;
bif(is_pid, 1) -> true;
bif(is_port, 1) -> true;
diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl
index beea9927d2..89a81684f5 100644
--- a/lib/stdlib/src/escript.erl
+++ b/lib/stdlib/src/escript.erl
@@ -882,7 +882,7 @@ format_exception(Class, Reason, StackTrace) ->
io_lib:format("~." ++ integer_to_list(I) ++ P, [Term, 50])
end,
StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end,
- lib:format_exception(1, Class, Reason, StackTrace, StackFun, PF, Enc).
+ erl_error:format_exception(1, Class, Reason, StackTrace, StackFun, PF, Enc).
encoding() ->
[{encoding, Encoding}] = enc(),
diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl
index 53042251cc..3ee2031d02 100644
--- a/lib/stdlib/src/gen_event.erl
+++ b/lib/stdlib/src/gen_event.erl
@@ -122,7 +122,7 @@
-type add_handler_ret() :: ok | term() | {'EXIT',term()}.
-type del_handler_ret() :: ok | term() | {'EXIT',term()}.
--type emgr_name() :: {'local', atom()} | {'global', atom()}
+-type emgr_name() :: {'local', atom()} | {'global', term()}
| {'via', atom(), term()}.
-type debug_flag() :: 'trace' | 'log' | 'statistics' | 'debug'
| {'logfile', string()}.
@@ -130,7 +130,7 @@
| {'debug', [debug_flag()]}
| {'spawn_opt', [proc_lib:spawn_option()]}
| {'hibernate_after', timeout()}.
--type emgr_ref() :: atom() | {atom(), atom()} | {'global', atom()}
+-type emgr_ref() :: atom() | {atom(), atom()} | {'global', term()}
| {'via', atom(), term()} | pid().
-type start_ret() :: {'ok', pid()} | {'error', term()}.
@@ -146,7 +146,7 @@
%% start_link()
%% start_link(MgrName | Options)
%% start_link(MgrName, Options)
-%% MgrName ::= {local, atom()} | {global, atom()} | {via, atom(), term()}
+%% MgrName ::= {local, atom()} | {global, term()} | {via, atom(), term()}
%% Options ::= [{timeout, Timeout} | {debug, [Flag]} | {spawn_opt,SOpts}]
%% Flag ::= trace | log | {logfile, File} | statistics | debug
%% (debug == log && statistics)
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index f65ef78636..035dd871ff 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -166,7 +166,7 @@
%%% start(Name, Mod, Args, Options)
%%% start_link(Mod, Args, Options)
%%% start_link(Name, Mod, Args, Options) where:
-%%% Name ::= {local, atom()} | {global, atom()} | {via, atom(), term()}
+%%% Name ::= {local, atom()} | {global, term()} | {via, atom(), term()}
%%% Mod ::= atom(), callback module implementing the 'real' server
%%% Args ::= term(), init arguments (to Mod:init/1)
%%% Options ::= [{timeout, Timeout} | {debug, [Flag]}]
diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl
index ec8cfd56c2..428c23524b 100644
--- a/lib/stdlib/src/ms_transform.erl
+++ b/lib/stdlib/src/ms_transform.erl
@@ -929,6 +929,7 @@ bool_test(is_port,1) -> true;
bool_test(is_reference,1) -> true;
bool_test(is_tuple,1) -> true;
bool_test(is_map,1) -> true;
+bool_test(is_map_key, 2) -> true;
bool_test(is_binary,1) -> true;
bool_test(is_function,1) -> true;
bool_test(is_record,2) -> true;
diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl
index 8d01840313..9094e0c0cd 100644
--- a/lib/stdlib/src/proc_lib.erl
+++ b/lib/stdlib/src/proc_lib.erl
@@ -841,8 +841,8 @@ format_exception(Class, Reason, StackTrace, {Enc,_}=Extra) ->
StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end,
%% EI = " exception: ",
EI = " ",
- [EI, lib:format_exception(1+length(EI), Class, Reason,
- StackTrace, StackFun, PF, Enc), "\n"].
+ [EI, erl_error:format_exception(1+length(EI), Class, Reason,
+ StackTrace, StackFun, PF, Enc), "\n"].
to_string(A, latin1) ->
io_lib:write_atom_as_latin1(A);
diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl
index 3a66f6930b..4a0e976ba4 100644
--- a/lib/stdlib/src/qlc.erl
+++ b/lib/stdlib/src/qlc.erl
@@ -638,7 +638,7 @@ string_to_handle(Str, Options, Bindings) when is_list(Str) ->
case erl_scan:string(Str, 1, [text]) of
{ok, Tokens, _} ->
ScanRes =
- case lib:extended_parse_exprs(Tokens) of
+ case erl_eval:extended_parse_exprs(Tokens) of
{ok, [Expr0], SBs} ->
{ok, Expr0, SBs};
{ok, _ExprList, _SBs} ->
@@ -1196,8 +1196,8 @@ abstract1({table, TableDesc}, _NElements, _Depth, _A) ->
{ok, Tokens, _} =
erl_scan:string(lists:flatten(TableDesc++"."), 1, [text]),
{ok, Es, Bs} =
- lib:extended_parse_exprs(Tokens),
- [Expr] = lib:subst_values_for_vars(Es, Bs),
+ erl_eval:extended_parse_exprs(Tokens),
+ [Expr] = erl_eval:subst_values_for_vars(Es, Bs),
special(Expr);
false -> % abstract expression
TableDesc
@@ -3749,7 +3749,7 @@ maybe_error_logger(Name, Why) ->
expand_stacktrace(),
Trimmer = fun(M, _F, _A) -> M =:= erl_eval end,
Formater = fun(Term, I) -> io_lib:print(Term, I, 80, -1) end,
- X = lib:format_stacktrace(1, Stacktrace, Trimmer, Formater),
+ X = erl_error:format_stacktrace(1, Stacktrace, Trimmer, Formater),
error_logger:Name("qlc: temporary file was needed for ~w\n~ts\n",
[Why, lists:flatten(X)]).
diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl
index 1be37672e7..c73cf22943 100644
--- a/lib/stdlib/src/shell.erl
+++ b/lib/stdlib/src/shell.erl
@@ -230,7 +230,7 @@ server_loop(N0, Eval_0, Bs00, RT, Ds00, History0, Results0) ->
{Res,Eval0} = get_command(Prompt, Eval_1, Bs0, RT, Ds0),
case Res of
{ok,Es0,XBs} ->
- Es1 = lib:subst_values_for_vars(Es0, XBs),
+ Es1 = erl_eval:subst_values_for_vars(Es0, XBs),
case expand_hist(Es1, N) of
{ok,Es} ->
{V,Eval,Bs,Ds} = shell_cmd(Es, Eval0, Bs0, RT, Ds0, cmd),
@@ -280,7 +280,7 @@ get_command(Prompt, Eval, Bs, RT, Ds) ->
io:scan_erl_exprs(group_leader(), Prompt, 1, [text])
of
{ok,Toks,_EndPos} ->
- lib:extended_parse_exprs(Toks);
+ erl_eval:extended_parse_exprs(Toks);
{eof,_EndPos} ->
eof;
{error,ErrorInfo,_EndPos} ->
@@ -589,7 +589,7 @@ report_exception(Class, Severity, {Reason,Stacktrace}, RT) ->
PF = fun(Term, I1) -> pp(Term, I1, RT) end,
SF = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end,
Enc = encoding(),
- Str = lib:format_exception(I, Class, Reason, Stacktrace, SF, PF, Enc),
+ Str = erl_error:format_exception(I, Class, Reason, Stacktrace, SF, PF, Enc),
io:requests([{put_chars, latin1, Tag},
{put_chars, unicode, Str},
nl]).
diff --git a/lib/stdlib/src/slave.erl b/lib/stdlib/src/slave.erl
index b3f3206d67..37c1f6bfd9 100644
--- a/lib/stdlib/src/slave.erl
+++ b/lib/stdlib/src/slave.erl
@@ -187,7 +187,7 @@ start_link(Host, Name, Args) ->
start(Host, Name, Args, self()).
start(Host0, Name, Args, LinkTo) ->
- Prog = lib:progname(),
+ Prog = progname(),
start(Host0, Name, Args, LinkTo, Prog).
start(Host0, Name, Args, LinkTo, Prog) ->
@@ -296,7 +296,6 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) ->
" -s slave slave_start ", node(),
" ", Waiter,
" ", Args]),
-
case after_char($@, atom_to_list(node())) of
Host ->
{ok, BasicCmd};
@@ -309,6 +308,15 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) ->
end
end.
+%% Return the name of the script that starts (this) erlang
+progname() ->
+ case init:get_argument(progname) of
+ {ok, [[Prog]]} ->
+ Prog;
+ _Other ->
+ "no_prog_name"
+ end.
+
%% This is an attempt to distinguish between spaces in the program
%% path and spaces that separate arguments. The program is quoted to
%% allow spaces in the path.
@@ -317,7 +325,7 @@ mk_cmd(Host, Name, Args, Waiter, Prog0) ->
%% (through start/5) or if the -program switch to beam is used and
%% includes arguments (typically done by cerl in OTP test environment
%% in order to ensure that slave/peer nodes are started with the same
-%% emulator and flags as the test node. The return from lib:progname()
+%% emulator and flags as the test node. The result from progname()
%% could then typically be '/<full_path_to>/cerl -gcov').
quote_progname(Progname) ->
do_quote_progname(string:lexemes(to_list(Progname)," ")).
diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src
index 5fb48acfab..cd09872b87 100644
--- a/lib/stdlib/src/stdlib.app.src
+++ b/lib/stdlib/src/stdlib.app.src
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -43,6 +43,7 @@
erl_anno,
erl_bits,
erl_compile,
+ erl_error,
erl_eval,
erl_expand_records,
erl_internal,
@@ -71,7 +72,6 @@
io_lib_format,
io_lib_fread,
io_lib_pretty,
- lib,
lists,
log_mf_h,
maps,
diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl
index 0736374f21..f5d271c06d 100644
--- a/lib/stdlib/src/string.erl
+++ b/lib/stdlib/src/string.erl
@@ -323,16 +323,30 @@ take(Str, Sep0, true, trailing) ->
%% Uppercase all chars in Str
-spec uppercase(String::unicode:chardata()) -> unicode:chardata().
uppercase(CD) when is_list(CD) ->
- uppercase_list(CD);
-uppercase(CD) when is_binary(CD) ->
- uppercase_bin(CD,<<>>).
+ try uppercase_list(CD, false)
+ catch unchanged -> CD
+ end;
+uppercase(<<CP1/utf8, Rest/binary>>=Orig) ->
+ try uppercase_bin(CP1, Rest, false) of
+ List -> unicode:characters_to_binary(List)
+ catch unchanged -> Orig
+ end;
+uppercase(<<>>) ->
+ <<>>.
%% Lowercase all chars in Str
-spec lowercase(String::unicode:chardata()) -> unicode:chardata().
lowercase(CD) when is_list(CD) ->
- lowercase_list(CD);
-lowercase(CD) when is_binary(CD) ->
- lowercase_bin(CD,<<>>).
+ try lowercase_list(CD, false)
+ catch unchanged -> CD
+ end;
+lowercase(<<CP1/utf8, Rest/binary>>=Orig) ->
+ try lowercase_bin(CP1, Rest, false) of
+ List -> unicode:characters_to_binary(List)
+ catch unchanged -> Orig
+ end;
+lowercase(<<>>) ->
+ <<>>.
%% Make a titlecase of the first char in Str
-spec titlecase(String::unicode:chardata()) -> unicode:chardata().
@@ -352,9 +366,16 @@ titlecase(CD) when is_binary(CD) ->
%% Make a comparable string of the Str should be used for equality tests only
-spec casefold(String::unicode:chardata()) -> unicode:chardata().
casefold(CD) when is_list(CD) ->
- casefold_list(CD);
-casefold(CD) when is_binary(CD) ->
- casefold_bin(CD,<<>>).
+ try casefold_list(CD, false)
+ catch unchanged -> CD
+ end;
+casefold(<<CP1/utf8, Rest/binary>>=Orig) ->
+ try casefold_bin(CP1, Rest, false) of
+ List -> unicode:characters_to_binary(List)
+ catch unchanged -> Orig
+ end;
+casefold(<<>>) ->
+ <<>>.
-spec to_integer(String) -> {Int, Rest} | {'error', Reason} when
String :: unicode:chardata(),
@@ -652,52 +673,127 @@ slice_bin(CD, CP1, N) when N > 0 ->
slice_bin(CD, CP1, 0) ->
byte_size(CD)+byte_size(<<CP1/utf8>>).
-uppercase_list(CPs0) ->
+uppercase_list([CP1|[CP2|_]=Cont], _Changed) when $a =< CP1, CP1 =< $z, CP2 < 256 ->
+ [CP1-32|uppercase_list(Cont, true)];
+uppercase_list([CP1|[CP2|_]=Cont], Changed) when CP1 < 128, CP2 < 256 ->
+ [CP1|uppercase_list(Cont, Changed)];
+uppercase_list([], true) ->
+ [];
+uppercase_list([], false) ->
+ throw(unchanged);
+uppercase_list(CPs0, Changed) ->
case unicode_util:uppercase(CPs0) of
- [Char|CPs] -> append(Char,uppercase_list(CPs));
- [] -> []
+ [Char|CPs] when Char =:= hd(CPs0) -> [Char|uppercase_list(CPs, Changed)];
+ [Char|CPs] -> append(Char,uppercase_list(CPs, true));
+ [] -> uppercase_list([], Changed)
end.
-uppercase_bin(CPs0, Acc) ->
- case unicode_util:uppercase(CPs0) of
- [Char|CPs] when is_integer(Char) ->
- uppercase_bin(CPs, <<Acc/binary, Char/utf8>>);
- [Chars|CPs] ->
- uppercase_bin(CPs, <<Acc/binary,
- << <<CP/utf8>> || CP <- Chars>>/binary >>);
- [] -> Acc
+uppercase_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed)
+ when $a =< CP1, CP1 =< $z, CP2 < 256 ->
+ [CP1-32|uppercase_bin(CP2, Bin, true)];
+uppercase_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed)
+ when CP1 < 128, CP2 < 256 ->
+ [CP1|uppercase_bin(CP2, Bin, false)];
+uppercase_bin(CP1, Bin, Changed) ->
+ case unicode_util:uppercase([CP1|Bin]) of
+ [CP1|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [CP1|uppercase_bin(Next, Rest, Changed)];
+ [] when Changed ->
+ [CP1];
+ [] ->
+ throw(unchanged)
+ end;
+ [Char|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [Char|uppercase_bin(Next, Rest, true)];
+ [] ->
+ [Char]
+ end
end.
-lowercase_list(CPs0) ->
+lowercase_list([CP1|[CP2|_]=Cont], _Changed) when $A =< CP1, CP1 =< $Z, CP2 < 256 ->
+ [CP1+32|lowercase_list(Cont, true)];
+lowercase_list([CP1|[CP2|_]=Cont], Changed) when CP1 < 128, CP2 < 256 ->
+ [CP1|lowercase_list(Cont, Changed)];
+lowercase_list([], true) ->
+ [];
+lowercase_list([], false) ->
+ throw(unchanged);
+lowercase_list(CPs0, Changed) ->
case unicode_util:lowercase(CPs0) of
- [Char|CPs] -> append(Char,lowercase_list(CPs));
- [] -> []
+ [Char|CPs] when Char =:= hd(CPs0) -> [Char|lowercase_list(CPs, Changed)];
+ [Char|CPs] -> append(Char,lowercase_list(CPs, true));
+ [] -> lowercase_list([], Changed)
end.
-lowercase_bin(CPs0, Acc) ->
- case unicode_util:lowercase(CPs0) of
- [Char|CPs] when is_integer(Char) ->
- lowercase_bin(CPs, <<Acc/binary, Char/utf8>>);
- [Chars|CPs] ->
- lowercase_bin(CPs, <<Acc/binary,
- << <<CP/utf8>> || CP <- Chars>>/binary >>);
- [] -> Acc
+lowercase_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed)
+ when $A =< CP1, CP1 =< $Z, CP2 < 256 ->
+ [CP1+32|lowercase_bin(CP2, Bin, true)];
+lowercase_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed)
+ when CP1 < 128, CP2 < 256 ->
+ [CP1|lowercase_bin(CP2, Bin, false)];
+lowercase_bin(CP1, Bin, Changed) ->
+ case unicode_util:lowercase([CP1|Bin]) of
+ [CP1|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [CP1|lowercase_bin(Next, Rest, Changed)];
+ [] when Changed ->
+ [CP1];
+ [] ->
+ throw(unchanged)
+ end;
+ [Char|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [Char|lowercase_bin(Next, Rest, true)];
+ [] ->
+ [Char]
+ end
end.
-casefold_list(CPs0) ->
+casefold_list([CP1|[CP2|_]=Cont], _Changed) when $A =< CP1, CP1 =< $Z, CP2 < 256 ->
+ [CP1+32|casefold_list(Cont, true)];
+casefold_list([CP1|[CP2|_]=Cont], Changed) when CP1 < 128, CP2 < 256 ->
+ [CP1|casefold_list(Cont, Changed)];
+casefold_list([], true) ->
+ [];
+casefold_list([], false) ->
+ throw(unchanged);
+casefold_list(CPs0, Changed) ->
case unicode_util:casefold(CPs0) of
- [Char|CPs] -> append(Char, casefold_list(CPs));
- [] -> []
+ [Char|CPs] when Char =:= hd(CPs0) -> [Char|casefold_list(CPs, Changed)];
+ [Char|CPs] -> append(Char,casefold_list(CPs, true));
+ [] -> casefold_list([], Changed)
end.
-casefold_bin(CPs0, Acc) ->
- case unicode_util:casefold(CPs0) of
- [Char|CPs] when is_integer(Char) ->
- casefold_bin(CPs, <<Acc/binary, Char/utf8>>);
- [Chars|CPs] ->
- casefold_bin(CPs, <<Acc/binary,
- << <<CP/utf8>> || CP <- Chars>>/binary >>);
- [] -> Acc
+casefold_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed)
+ when $A =< CP1, CP1 =< $Z, CP2 < 256 ->
+ [CP1+32|casefold_bin(CP2, Bin, true)];
+casefold_bin(CP1, <<CP2/utf8, Bin/binary>>, _Changed)
+ when CP1 < 128, CP2 < 256 ->
+ [CP1|casefold_bin(CP2, Bin, false)];
+casefold_bin(CP1, Bin, Changed) ->
+ case unicode_util:casefold([CP1|Bin]) of
+ [CP1|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [CP1|casefold_bin(Next, Rest, Changed)];
+ [] when Changed ->
+ [CP1];
+ [] ->
+ throw(unchanged)
+ end;
+ [Char|CPs] ->
+ case unicode_util:cp(CPs) of
+ [Next|Rest] ->
+ [Char|casefold_bin(Next, Rest, true)];
+ [] ->
+ [Char]
+ end
end.
%% Fast path for ascii searching for one character in lists
diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl
index 9f48fbf5e3..13f2cbd27b 100644
--- a/lib/stdlib/test/io_SUITE.erl
+++ b/lib/stdlib/test/io_SUITE.erl
@@ -1808,7 +1808,7 @@ rpc_call_max(Node, M, F, Args) ->
%% Make sure that a bad specification for a printable range is rejected.
bad_printable_range(Config) when is_list(Config) ->
- Cmd = lists:concat([lib:progname()," +pcunnnnnicode -run erlang halt"]),
+ Cmd = ct:get_progname() ++ " +pcunnnnnicode -run erlang halt",
P = open_port({spawn, Cmd}, [stderr_to_stdout, {line, 200}]),
ok = receive
{P, {data, {eol , "bad range of printable characters" ++ _}}} ->
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index 8f8a0f6e73..5c189a6c73 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -7468,7 +7468,7 @@ strip_qlc_call(H) ->
strip_qlc_call2(H) ->
S = qlc:info(H, {flat, false}),
{ok, Tokens, _EndLine} = erl_scan:string(S++".", 1, [text]),
- {ok, [Expr], Bs} = lib:extended_parse_exprs(Tokens),
+ {ok, [Expr], Bs} = erl_eval:extended_parse_exprs(Tokens),
{case Expr of
{call,_,{remote,_,{atom,_,qlc},{atom,_,q}},[LC]} ->
{qlc, lists:flatten([erl_pp:expr(LC), "."]), []};
@@ -7489,7 +7489,7 @@ strip_qlc_call2(H) ->
join_info_count(H) ->
S = qlc:info(H, {flat, false}),
{ok, Tokens, _EndLine} = erl_scan:string(S++".", 1, [text]),
- {ok, [Expr], _Bs} = lib:extended_parse_exprs(Tokens),
+ {ok, [Expr], _Bs} = erl_eval:extended_parse_exprs(Tokens),
#ji{nmerge = Nmerge, nlookup = Nlookup,
nkeysort = NKeysort, nnested_loop = Nnested_loop} =
ji(Expr, #ji{}),
@@ -7533,7 +7533,7 @@ lookup_keys({generate,_,Q}, L) ->
lookup_keys(Q, L);
lookup_keys({table,Chars}, L) when is_list(Chars) ->
{ok, Tokens, _} = erl_scan:string(lists:flatten(Chars++"."), 1, [text]),
- {ok, [Expr], _Bs} = lib:extended_parse_exprs(Tokens),
+ {ok, [Expr], _Bs} = erl_eval:extended_parse_exprs(Tokens),
case Expr of
{call,_,_,[_fun,AKs]} ->
case erl_parse:normalise(AKs) of
diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl
index ca85314775..22136d687c 100644
--- a/lib/stdlib/test/shell_SUITE.erl
+++ b/lib/stdlib/test/shell_SUITE.erl
@@ -2780,7 +2780,7 @@ otp_10302(Config) when is_list(Config) ->
rpc:call(Node,shell, prompt_func, [default]),
_ = shell:prompt_func(default),
- %% Test lib:format_exception() (cf. OTP-6554)
+ %% Test erl_error:format_exception() (cf. OTP-6554)
Test6 =
<<"begin
A = <<\"\\xaa\">>,
@@ -2967,10 +2967,10 @@ otp_14296(Config) when is_list(Config) ->
R = t(S)
end(),
- %% Test lib:extended_parse_term/1
+ %% Test erl_eval:extended_parse_term/1
TF = fun(S) ->
{ok, Ts, _} = erl_scan:string(S++".", 1, [text]),
- case lib:extended_parse_term(Ts) of
+ case erl_eval:extended_parse_term(Ts) of
{ok, Term} -> Term;
{error, _}=Error -> Error
end
diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl
index fdff2d24b8..29fabb4583 100644
--- a/lib/stdlib/test/string_SUITE.erl
+++ b/lib/stdlib/test/string_SUITE.erl
@@ -810,6 +810,18 @@ do_measure(DataDir) ->
Do2(slice, repeat(fun() -> string:slice(S0, 20, 15) end), list),
Do2(slice, repeat(fun() -> string:slice(S0B, 20, 15) end), binary),
+ LCase = "areaa reare rerar earea reare reare",
+ LCaseB = unicode:characters_to_binary(LCase),
+ UCase = string:uppercase(LCase),
+ UCaseB = unicode:characters_to_binary(UCase),
+
+ Do2(to_upper_0, repeat(fun() -> string:to_upper(UCase) end), list),
+ Do2(uppercase_0, repeat(fun() -> string:uppercase(UCase) end), list),
+ Do2(uppercase_0, repeat(fun() -> string:uppercase(UCaseB) end), binary),
+ Do2(to_upper_a, repeat(fun() -> string:to_upper(LCase) end), list),
+ Do2(uppercase_a, repeat(fun() -> string:uppercase(LCase) end), list),
+ Do2(uppercase_a, repeat(fun() -> string:uppercase(LCaseB) end), binary),
+
io:format("--~n",[]),
NthTokens = {nth_lexemes, fun(Str) -> string:nth_lexeme(Str, 18000, [$\n,$\r]) end},
[Do(Name,Fun,Mode) || {Name,Fun} <- [NthTokens], Mode <- [list, binary]],
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index fd51aca861..e08db0ea79 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -804,6 +804,7 @@ resulting regexp is surrounded by \\_< and \\_>."
"is_integer"
"is_list"
"is_map"
+ "is_map_key"
"is_number"
"is_pid"
"is_port"
diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl
index d0152a4915..1db90c1d86 100644
--- a/lib/tools/src/lcnt.erl
+++ b/lib/tools/src/lcnt.erl
@@ -125,7 +125,7 @@
%% -------------------------------------------------------------------- %%
start() -> gen_server:start({local, ?MODULE}, ?MODULE, [], []).
-stop() -> gen_server:call(?MODULE, stop, infinity).
+stop() -> gen_server:stop(?MODULE, normal, infinity).
init([]) -> {ok, #state{ locks = [], duration = 0 } }.
start_internal() ->
@@ -442,9 +442,6 @@ handle_call({save, Filename}, _From, State) ->
{reply, {error, Error}, State}
end;
-handle_call(stop, _From, State) ->
- {stop, normal, ok, State};
-
handle_call(Command, _From, State) ->
{reply, {error, {undefined, Command}}, State}.
diff --git a/lib/tools/src/xref.erl b/lib/tools/src/xref.erl
index 32efa36fa2..466ec7d331 100644
--- a/lib/tools/src/xref.erl
+++ b/lib/tools/src/xref.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -182,7 +182,9 @@ split_args(Opts) ->
end.
stop(Name) ->
- gen_server:call(Name, stop, infinity).
+ try gen_server:call(Name, stop, infinity)
+ after catch unregister(Name) % ensure the name is gone
+ end.
add_release(Name, Dir) ->
gen_server:call(Name, {add_release, Dir}, infinity).
diff --git a/lib/tools/test/eprof_SUITE_data/eed.erl b/lib/tools/test/eprof_SUITE_data/eed.erl
index 5f2a21aa60..9fe49c6f5c 100644
--- a/lib/tools/test/eprof_SUITE_data/eed.erl
+++ b/lib/tools/test/eprof_SUITE_data/eed.erl
@@ -54,7 +54,7 @@ edit(Name) ->
loop(St0) ->
{ok, St1, Cmd} = get_line(St0),
- case catch command(lib:nonl(Cmd), St1) of
+ case catch command(nonl(Cmd), St1) of
{'EXIT', Reason} ->
%% XXX Should clear outstanding global command here.
loop(print_error({'EXIT', Reason}, St1));
@@ -66,6 +66,10 @@ loop(St0) ->
loop(St2)
end.
+nonl([$\n]) -> [];
+nonl([]) -> [];
+nonl([H|T]) -> [H|nonl(T)].
+
command(Cmd, St) ->
case parse_command(Cmd, St) of
quit ->
diff --git a/otp_versions.table b/otp_versions.table
index e47f6ccc34..c66a390f21 100644
--- a/otp_versions.table
+++ b/otp_versions.table
@@ -1,3 +1,4 @@
+OTP-20.3.6 : crypto-4.2.2 ssh-4.6.9 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.2 erts-9.3.1 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4 inets-6.5.1 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.10 ssl-8.2.6 stdlib-3.4.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 :
OTP-20.3.5 : erts-9.3.1 ssl-8.2.6 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.2 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4 inets-6.5.1 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.10 ssh-4.6.8 stdlib-3.4.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 :
OTP-20.3.4 : erl_interface-3.10.2 ic-4.4.4 inets-6.5.1 ssh-4.6.8 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erts-9.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.10 ssl-8.2.5 stdlib-3.4.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 :
OTP-20.3.3 : sasl-3.1.2 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.1 erts-9.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.3 inets-6.5 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 snmp-5.2.10 ssh-4.6.7 ssl-8.2.5 stdlib-3.4.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 :
@@ -24,6 +25,7 @@ OTP-20.0.3 : asn1-5.0.2 compiler-7.1.1 erts-9.0.3 ssh-4.5.1 # common_test-1.15.1
OTP-20.0.2 : asn1-5.0.1 erts-9.0.2 kernel-5.3.1 # common_test-1.15.1 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12.1 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4.1 syntax_tools-2.1.2 tools-2.10.1 wx-1.8.1 xmerl-1.3.15 :
OTP-20.0.1 : common_test-1.15.1 erts-9.0.1 runtime_tools-1.12.1 stdlib-3.4.1 tools-2.10.1 # asn1-5.0 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 syntax_tools-2.1.2 wx-1.8.1 xmerl-1.3.15 :
OTP-20.0 : asn1-5.0 common_test-1.15 compiler-7.1 cosProperty-1.2.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 erl_docgen-0.7 erl_interface-3.10 erts-9.0 eunit-2.3.3 hipe-3.16 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 orber-3.8.3 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4 syntax_tools-2.1.2 tools-2.10 wx-1.8.1 xmerl-1.3.15 # cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 eldap-1.2.2 et-1.6 ic-4.4.2 odbc-2.12 os_mon-2.4.2 otp_mibs-1.1.1 :
+OTP-19.3.6.9 : ssh-4.4.2.4 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.4 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2.0.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssl-8.1.3.1.1 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
OTP-19.3.6.8 : ssh-4.4.2.3 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.4 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2.0.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssl-8.1.3.1.1 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
OTP-19.3.6.7 : kernel-5.2.0.1 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.4 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2.2 ssl-8.1.3.1.1 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
OTP-19.3.6.6 : ssh-4.4.2.2 ssl-8.1.3.1.1 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.4 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3.1 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
diff --git a/system/doc/efficiency_guide/binaryhandling.xml b/system/doc/efficiency_guide/binaryhandling.xml
index 19f40c9abe..d07ff1325f 100644
--- a/system/doc/efficiency_guide/binaryhandling.xml
+++ b/system/doc/efficiency_guide/binaryhandling.xml
@@ -357,25 +357,8 @@ all_but_zeroes_to_list(<<Byte,T/binary>>, Acc, Remaining) ->
<c>Buffer</c> from a match context to a sub binary (or do nothing if
<c>Buffer</c> is a binary already).</p>
- <p>Before you begin to think that the compiler can optimize any binary
- patterns, the following function cannot be optimized by the compiler
- (currently, at least):</p>
-
- <code type="erl"><![CDATA[
-non_opt_eq([H|T1], <<H,T2/binary>>) ->
- non_opt_eq(T1, T2);
-non_opt_eq([_|_], <<_,_/binary>>) ->
- false;
-non_opt_eq([], <<>>) ->
- true.]]></code>
-
- <p>It was mentioned earlier that the compiler can only delay creation of
- sub binaries if it knows that the binary will not be shared. In this case,
- the compiler cannot know.</p>
-
- <p>Soon it is shown how to rewrite <c>non_opt_eq/2</c> so that the delayed
- sub binary optimization can be applied, and more importantly, it is shown
- how you can find out whether your code can be optimized.</p>
+ <p>But in more complicated code, how can one know whether the
+ optimization is applied or not?</p>
<section>
<marker id="bin_opt_info"></marker>
@@ -422,67 +405,6 @@ after_zero(<<>>) ->
binary cannot be delayed, because it will be returned.
The warning for the second clause says that a sub binary will not be
created (yet).</p>
-
- <p>Let us revisit the earlier example of the code that could not
- be optimized and find out why:</p>
-
- <code type="erl"><![CDATA[
-non_opt_eq([H|T1], <<H,T2/binary>>) ->
- %% INFO: matching anything else but a plain variable to
- %% the left of binary pattern will prevent delayed
- %% sub binary optimization;
- %% SUGGEST changing argument order
- %% NOT OPTIMIZED: called function non_opt_eq/2 does not
- %% begin with a suitable binary matching instruction
- non_opt_eq(T1, T2);
-non_opt_eq([_|_], <<_,_/binary>>) ->
- false;
-non_opt_eq([], <<>>) ->
- true.]]></code>
-
- <p>The compiler emitted two warnings. The <c>INFO</c> warning refers
- to the function <c>non_opt_eq/2</c> as a callee, indicating that any
- function that call <c>non_opt_eq/2</c> cannot make delayed sub binary
- optimization. There is also a suggestion to change argument order.
- The second warning (that happens to refer to the same line) refers to
- the construction of the sub binary itself.</p>
-
- <p>Soon another example will show the difference between the
- <c>INFO</c> and <c>NOT OPTIMIZED</c> warnings somewhat clearer, but
- let us first follow the suggestion to change argument order:</p>
-
- <code type="erl"><![CDATA[
-opt_eq(<<H,T1/binary>>, [H|T2]) ->
- %% OPTIMIZED: creation of sub binary delayed
- opt_eq(T1, T2);
-opt_eq(<<_,_/binary>>, [_|_]) ->
- false;
-opt_eq(<<>>, []) ->
- true.]]></code>
-
- <p>The compiler gives a warning for the following code fragment:</p>
-
- <code type="erl"><![CDATA[
-match_body([0|_], <<H,_/binary>>) ->
- %% INFO: matching anything else but a plain variable to
- %% the left of binary pattern will prevent delayed
- %% sub binary optimization;
- %% SUGGEST changing argument order
- done;
-...]]></code>
-
- <p>The warning means that <em>if</em> there is a call to <c>match_body/2</c>
- (from another clause in <c>match_body/2</c> or another function), the
- delayed sub binary optimization will not be possible. More warnings will
- occur for any place where a sub binary is matched out at the end of and
- passed as the second argument to <c>match_body/2</c>, for example:</p>
-
- <code type="erl"><![CDATA[
-match_head(List, <<_:10,Data/binary>>) ->
- %% NOT OPTIMIZED: called function match_body/2 does not
- %% begin with a suitable binary matching instruction
- match_body(List, Data).]]></code>
-
</section>
<section>
diff --git a/system/doc/efficiency_guide/efficiency_guide.erl b/system/doc/efficiency_guide/efficiency_guide.erl
index e982bdae65..c57785aaa3 100644
--- a/system/doc/efficiency_guide/efficiency_guide.erl
+++ b/system/doc/efficiency_guide/efficiency_guide.erl
@@ -1,5 +1,5 @@
-module(efficiency_guide).
--compile(export_all).
+-compile([export_all,nowarn_export_all).
%% DO NOT
naive_reverse([H|T]) ->
@@ -71,28 +71,6 @@ all_but_zeroes_to_list(<<0,T/binary>>, Acc, Remaining) ->
all_but_zeroes_to_list(<<Byte,T/binary>>, Acc, Remaining) ->
all_but_zeroes_to_list(T, [Byte|Acc], Remaining-1).
-non_opt_eq([H|T1], <<H,T2/binary>>) ->
- non_opt_eq(T1, T2);
-non_opt_eq([_|_], <<_,_/binary>>) ->
- false;
-non_opt_eq([], <<>>) ->
- true.
-
-opt_eq(<<H,T1/binary>>, [H|T2]) ->
- opt_eq(T1, T2);
-opt_eq(<<_,_/binary>>, [_|_]) ->
- false;
-opt_eq(<<>>, []) ->
- true.
-
-match_head(List, <<_:10,Data/binary>>) ->
- match_body(List, Data).
-
-match_body([0|_], <<H,_/binary>>) ->
- done;
-match_body([H|T1], <<H,T2/binary>>) ->
- {T1,T2}.
-
count1(<<_,T/binary>>, Count) -> count1(T, Count+1);
count1(<<>>, Count) -> Count.