aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--bootstrap/lib/compiler/ebin/beam_validator.beambin31688 -> 31728 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/core_lint.beambin12716 -> 12872 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/auth.beambin6312 -> 6332 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erts_debug.beambin5908 -> 8220 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_lint.beambin92288 -> 91496 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/otp_internal.beambin10208 -> 10284 bytes
-rw-r--r--erts/aclocal.m486
-rw-r--r--erts/configure.in78
-rw-r--r--erts/doc/src/erl.xml8
-rw-r--r--erts/doc/src/erts_alloc.xml36
-rw-r--r--erts/doc/src/match_spec.xml10
-rw-r--r--erts/emulator/Makefile.in2
-rw-r--r--erts/emulator/beam/beam_emu.c6
-rw-r--r--erts/emulator/beam/bif.c10
-rw-r--r--erts/emulator/beam/bif.h6
-rw-r--r--erts/emulator/beam/bif.tab2
-rw-r--r--erts/emulator/beam/bif_instrs.tab8
-rw-r--r--erts/emulator/beam/binary.c34
-rw-r--r--erts/emulator/beam/break.c20
-rw-r--r--erts/emulator/beam/erl_alloc.c98
-rw-r--r--erts/emulator/beam/erl_alloc_util.c1384
-rw-r--r--erts/emulator/beam/erl_alloc_util.h35
-rw-r--r--erts/emulator/beam/erl_bif_info.c1466
-rw-r--r--erts/emulator/beam/erl_db.c7
-rw-r--r--erts/emulator/beam/erl_db.h1
-rw-r--r--erts/emulator/beam/erl_db_hash.c62
-rw-r--r--erts/emulator/beam/erl_gc.c55
-rw-r--r--erts/emulator/beam/erl_gc.h2
-rw-r--r--erts/emulator/beam/erl_init.c2
-rw-r--r--erts/emulator/beam/erl_instrument.c1257
-rw-r--r--erts/emulator/beam/erl_instrument.h42
-rw-r--r--erts/emulator/beam/erl_lock_check.c786
-rw-r--r--erts/emulator/beam/erl_lock_check.h2
-rw-r--r--erts/emulator/beam/erl_message.c106
-rw-r--r--erts/emulator/beam/erl_message.h91
-rw-r--r--erts/emulator/beam/erl_nif.c10
-rw-r--r--erts/emulator/beam/erl_proc_sig_queue.c655
-rw-r--r--erts/emulator/beam/erl_proc_sig_queue.h206
-rw-r--r--erts/emulator/beam/erl_process.c50
-rw-r--r--erts/emulator/beam/erl_process.h12
-rw-r--r--erts/emulator/beam/erl_process_dict.c71
-rw-r--r--erts/emulator/beam/erl_process_dict.h2
-rw-r--r--erts/emulator/beam/erl_process_dump.c121
-rw-r--r--erts/emulator/beam/erl_time_sup.c2
-rw-r--r--erts/emulator/beam/erl_trace.c2
-rw-r--r--erts/emulator/beam/global.h4
-rw-r--r--erts/emulator/beam/io.c38
-rw-r--r--erts/emulator/beam/msg_instrs.tab4
-rw-r--r--erts/emulator/beam/utils.c17
-rw-r--r--erts/emulator/sys/common/erl_check_io.c2
-rw-r--r--erts/emulator/sys/common/erl_sys_common_misc.c13
-rw-r--r--erts/emulator/test/bif_SUITE.erl75
-rw-r--r--erts/emulator/test/dump_SUITE.erl4
-rw-r--r--erts/emulator/test/exception_SUITE.erl56
-rw-r--r--erts/emulator/test/lcnt_SUITE.erl17
-rw-r--r--erts/emulator/test/nif_SUITE.erl2
-rw-r--r--erts/emulator/test/process_SUITE.erl172
-rw-r--r--erts/emulator/test/tracer_SUITE.erl24
-rw-r--r--erts/emulator/test/z_SUITE.erl8
-rw-r--r--erts/etc/common/erlexec.c1
-rw-r--r--erts/lib_src/Makefile.in3
-rw-r--r--erts/preloaded/ebin/erlang.beambin102724 -> 102732 bytes
-rw-r--r--erts/preloaded/ebin/erts_internal.beambin15104 -> 15640 bytes
-rw-r--r--erts/preloaded/src/erlang.erl57
-rw-r--r--erts/preloaded/src/erts_internal.erl23
-rw-r--r--lib/asn1/src/asn1ct.erl9
-rw-r--r--lib/asn1/src/asn1ct_gen.erl3
-rw-r--r--lib/asn1/test/asn1_SUITE.erl5
-rw-r--r--lib/asn1/test/testUniqueObjectSets.erl3
-rw-r--r--lib/compiler/doc/src/compile.xml8
-rw-r--r--lib/compiler/src/Makefile1
-rw-r--r--lib/compiler/src/beam_validator.erl8
-rw-r--r--lib/compiler/src/core_lint.erl10
-rw-r--r--lib/compiler/test/compile_SUITE.erl24
-rw-r--r--lib/compiler/test/map_SUITE.erl19
-rw-r--r--lib/erl_docgen/priv/dtd/common.image.dtd4
-rw-r--r--lib/erl_docgen/priv/xsl/db_html.xsl13
-rw-r--r--lib/erl_docgen/priv/xsl/db_pdf.xsl12
-rw-r--r--lib/erl_docgen/priv/xsl/db_pdf_params.xsl3
-rw-r--r--lib/erl_interface/configure.in13
-rw-r--r--lib/erl_interface/doc/src/notes.xml23
-rw-r--r--lib/erl_interface/src/connect/ei_connect.c63
-rw-r--r--lib/erl_interface/src/connect/ei_resolve.c5
-rw-r--r--lib/erl_interface/src/decode/decode_atom.c62
-rw-r--r--lib/erl_interface/src/legacy/erl_marshal.c2
-rw-r--r--lib/erl_interface/vsn.mk2
-rw-r--r--lib/hipe/main/hipe.erl16
-rw-r--r--lib/ic/c_src/oe_ei_encode_atom.c43
-rw-r--r--lib/ic/doc/src/notes.xml17
-rw-r--r--lib/ic/vsn.mk2
-rw-r--r--lib/inets/doc/src/httpc.xml20
-rw-r--r--lib/inets/doc/src/notes.xml17
-rw-r--r--lib/inets/src/http_client/httpc_manager.erl32
-rw-r--r--lib/inets/src/http_client/httpc_request.erl67
-rw-r--r--lib/inets/src/http_server/httpd.erl29
-rw-r--r--lib/inets/src/http_server/mod_alias.erl22
-rw-r--r--lib/inets/test/httpc_SUITE.erl80
-rw-r--r--lib/inets/test/httpd_SUITE.erl86
-rw-r--r--lib/inets/vsn.mk2
-rw-r--r--lib/kernel/src/auth.erl6
-rw-r--r--lib/kernel/src/erts_debug.erl90
-rw-r--r--lib/kernel/test/Makefile3
-rw-r--r--lib/kernel/test/zzz_SUITE.erl (renamed from lib/ssh/src/ssh_server_key.erl)25
-rw-r--r--lib/observer/test/crashdump_viewer_SUITE.erl2
-rw-r--r--lib/runtime_tools/test/Makefile3
-rw-r--r--lib/runtime_tools/test/zzz_SUITE.erl (renamed from lib/ssh/src/ssh_client_key.erl)24
-rw-r--r--lib/sasl/doc/src/notes.xml20
-rw-r--r--lib/sasl/src/release_handler.erl14
-rw-r--r--lib/sasl/src/systools_make.erl193
-rw-r--r--lib/sasl/test/systools_SUITE.erl30
-rw-r--r--lib/sasl/vsn.mk2
-rw-r--r--lib/ssh/doc/src/notes.xml39
-rw-r--r--lib/ssh/doc/src/ssh.xml2
-rw-r--r--lib/ssh/doc/src/ssh_app.xml4
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl17
-rw-r--r--lib/ssh/test/ssh_algorithms_SUITE.erl4
-rw-r--r--lib/ssh/test/ssh_basic_SUITE.erl2
-rw-r--r--lib/ssh/test/ssh_compat_SUITE.erl3
-rw-r--r--lib/ssh/vsn.mk2
-rw-r--r--lib/stdlib/doc/src/gen_statem.xml219
-rw-r--r--lib/stdlib/src/erl_lint.erl60
-rw-r--r--lib/stdlib/src/gen_statem.erl120
-rw-r--r--lib/stdlib/src/otp_internal.erl3
-rw-r--r--lib/stdlib/test/Makefile3
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl80
-rw-r--r--lib/stdlib/test/ets_SUITE.erl36
-rw-r--r--lib/stdlib/test/gen_statem_SUITE.erl46
-rw-r--r--lib/stdlib/test/zzz_SUITE.erl37
-rw-r--r--lib/tools/doc/specs/.gitignore1
-rw-r--r--lib/tools/doc/src/Makefile14
-rw-r--r--lib/tools/doc/src/instrument.xml527
-rw-r--r--lib/tools/doc/src/specs.xml12
-rw-r--r--lib/tools/src/instrument.erl538
-rw-r--r--lib/tools/test/instrument_SUITE.erl391
-rw-r--r--lib/wx/api_gen/wx_extra/wxGraphicsRenderer.c_src58
-rw-r--r--lib/wx/api_gen/wx_gen.erl5
-rw-r--r--lib/wx/api_gen/wx_gen_cpp.erl9
-rw-r--r--lib/wx/api_gen/wx_gen_erl.erl7
-rw-r--r--lib/wx/api_gen/wxapi.conf25
-rw-r--r--lib/wx/c_src/gen/wxe_funcs.cpp34
-rw-r--r--lib/wx/c_src/gen/wxe_init.cpp116
-rw-r--r--lib/wx/include/wx.hrl18
-rw-r--r--otp_versions.table3
-rw-r--r--system/doc/design_principles/Makefile12
-rw-r--r--system/doc/design_principles/code_lock.diabin2945 -> 2605 bytes
-rw-r--r--system/doc/design_principles/code_lock.pngbin59827 -> 0 bytes
-rw-r--r--system/doc/design_principles/code_lock.svg132
-rw-r--r--system/doc/design_principles/code_lock_2.diabin2956 -> 2854 bytes
-rw-r--r--system/doc/design_principles/code_lock_2.pngbin55553 -> 0 bytes
-rw-r--r--system/doc/design_principles/code_lock_2.svg140
-rw-r--r--system/doc/design_principles/statem.xml1502
151 files changed, 7723 insertions, 4988 deletions
diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam
index 58f69e1c1d..237dcc3da1 100644
--- a/bootstrap/lib/compiler/ebin/beam_validator.beam
+++ b/bootstrap/lib/compiler/ebin/beam_validator.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam
index 41c6083337..e24a473a4c 100644
--- a/bootstrap/lib/compiler/ebin/core_lint.beam
+++ b/bootstrap/lib/compiler/ebin/core_lint.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/auth.beam b/bootstrap/lib/kernel/ebin/auth.beam
index e8904c142a..200a996f96 100644
--- a/bootstrap/lib/kernel/ebin/auth.beam
+++ b/bootstrap/lib/kernel/ebin/auth.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam
index 834f45ebfa..82641f173a 100644
--- a/bootstrap/lib/kernel/ebin/erts_debug.beam
+++ b/bootstrap/lib/kernel/ebin/erts_debug.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam
index 64caedd3ac..1af9f332e0 100644
--- a/bootstrap/lib/stdlib/ebin/erl_lint.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam
index 5532192e13..a64abac273 100644
--- a/bootstrap/lib/stdlib/ebin/otp_internal.beam
+++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam
Binary files differ
diff --git a/erts/aclocal.m4 b/erts/aclocal.m4
index 887babc13f..a4d09810bd 100644
--- a/erts/aclocal.m4
+++ b/erts/aclocal.m4
@@ -2770,3 +2770,89 @@ rm -f conftest*])
#define UNSAFE_MASK 0xc0000000 /* Mask for bits that must be constant */
+dnl ----------------------------------------------------------------------
+dnl
+dnl LM_HARDWARE_ARCH
+dnl
+dnl Determine target hardware in ARCH
+dnl
+AC_DEFUN([LM_HARDWARE_ARCH], [
+ AC_MSG_CHECKING([target hardware architecture])
+ if test "x$host_alias" != "x" -a "x$host_cpu" != "x"; then
+ chk_arch_=$host_cpu
+ else
+ chk_arch_=`uname -m`
+ fi
+
+ case $chk_arch_ in
+ sun4u) ARCH=ultrasparc;;
+ sparc64) ARCH=sparc64;;
+ sun4v) ARCH=ultrasparc;;
+ i86pc) ARCH=x86;;
+ i386) ARCH=x86;;
+ i486) ARCH=x86;;
+ i586) ARCH=x86;;
+ i686) ARCH=x86;;
+ x86_64) ARCH=amd64;;
+ amd64) ARCH=amd64;;
+ macppc) ARCH=ppc;;
+ powerpc) ARCH=ppc;;
+ ppc) ARCH=ppc;;
+ ppc64) ARCH=ppc64;;
+ ppc64le) ARCH=ppc64le;;
+ "Power Macintosh") ARCH=ppc;;
+ armv5b) ARCH=arm;;
+ armv5teb) ARCH=arm;;
+ armv5tel) ARCH=arm;;
+ armv5tejl) ARCH=arm;;
+ armv6l) ARCH=arm;;
+ armv6hl) ARCH=arm;;
+ armv7l) ARCH=arm;;
+ armv7hl) ARCH=arm;;
+ tile) ARCH=tile;;
+ e2k) ARCH=e2k;;
+ *) ARCH=noarch;;
+ esac
+ AC_MSG_RESULT($ARCH)
+
+ dnl
+ dnl Convert between x86 and amd64 based on the compiler's mode.
+ dnl Ditto between ultrasparc and sparc64.
+ dnl
+ AC_MSG_CHECKING(whether compilation mode forces ARCH adjustment)
+ case "$ARCH-$ac_cv_sizeof_void_p" in
+ x86-8)
+ AC_MSG_RESULT(yes: adjusting ARCH=x86 to ARCH=amd64)
+ ARCH=amd64
+ ;;
+ amd64-4)
+ AC_MSG_RESULT(yes: adjusting ARCH=amd64 to ARCH=x86)
+ ARCH=x86
+ ;;
+ ultrasparc-8)
+ AC_MSG_RESULT(yes: adjusting ARCH=ultrasparc to ARCH=sparc64)
+ ARCH=sparc64
+ ;;
+ sparc64-4)
+ AC_MSG_RESULT(yes: adjusting ARCH=sparc64 to ARCH=ultrasparc)
+ ARCH=ultrasparc
+ ;;
+ ppc64-4)
+ AC_MSG_RESULT(yes: adjusting ARCH=ppc64 to ARCH=ppc)
+ ARCH=ppc
+ ;;
+ ppc-8)
+ AC_MSG_RESULT(yes: adjusting ARCH=ppc to ARCH=ppc64)
+ ARCH=ppc64
+ ;;
+ arm-8)
+ AC_MSG_RESULT(yes: adjusting ARCH=arm to ARCH=noarch)
+ ARCH=noarch
+ ;;
+ *)
+ AC_MSG_RESULT(no: ARCH is $ARCH)
+ ;;
+ esac
+
+ AC_SUBST(ARCH)
+])
diff --git a/erts/configure.in b/erts/configure.in
index 820247b4b8..2d0d6c6444 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -658,83 +658,9 @@ case $chk_opsys_ in
*) OPSYS=noopsys
esac
-if test "x$host_alias" != "x" -a "x$host_cpu" != "x"; then
- chk_arch_=$host_cpu
-else
- chk_arch_=`uname -m`
-fi
-
-case $chk_arch_ in
- sun4u) ARCH=ultrasparc;;
- sparc64) ARCH=sparc64;;
- sun4v) ARCH=ultrasparc;;
- i86pc) ARCH=x86;;
- i386) ARCH=x86;;
- i486) ARCH=x86;;
- i586) ARCH=x86;;
- i686) ARCH=x86;;
- x86_64) ARCH=amd64;;
- amd64) ARCH=amd64;;
- macppc) ARCH=ppc;;
- powerpc) ARCH=ppc;;
- ppc) ARCH=ppc;;
- ppc64) ARCH=ppc64;;
- ppc64le) ARCH=ppc64le;;
- "Power Macintosh") ARCH=ppc;;
- armv5b) ARCH=arm;;
- armv5teb) ARCH=arm;;
- armv5tel) ARCH=arm;;
- armv5tejl) ARCH=arm;;
- armv6l) ARCH=arm;;
- armv6hl) ARCH=arm;;
- armv7l) ARCH=arm;;
- armv7hl) ARCH=arm;;
- tile) ARCH=tile;;
- e2k) ARCH=e2k;;
- *) ARCH=noarch;;
-esac
-
-dnl
-dnl Convert between x86 and amd64 based on the compiler's mode.
-dnl Ditto between ultrasparc and sparc64.
-dnl
-AC_MSG_CHECKING(whether compilation mode forces ARCH adjustment)
-case "$ARCH-$ac_cv_sizeof_void_p" in
-x86-8)
- AC_MSG_RESULT(yes: adjusting ARCH=x86 to ARCH=amd64)
- ARCH=amd64
- ;;
-amd64-4)
- AC_MSG_RESULT(yes: adjusting ARCH=amd64 to ARCH=x86)
- ARCH=x86
- ;;
-ultrasparc-8)
- AC_MSG_RESULT(yes: adjusting ARCH=ultrasparc to ARCH=sparc64)
- ARCH=sparc64
- ;;
-sparc64-4)
- AC_MSG_RESULT(yes: adjusting ARCH=sparc64 to ARCH=ultrasparc)
- ARCH=ultrasparc
- ;;
-ppc64-4)
- AC_MSG_RESULT(yes: adjusting ARCH=ppc64 to ARCH=ppc)
- ARCH=ppc
- ;;
-ppc-8)
- AC_MSG_RESULT(yes: adjusting ARCH=ppc to ARCH=ppc64)
- ARCH=ppc64
- ;;
-arm-8)
- AC_MSG_RESULT(yes: adjusting ARCH=arm to ARCH=noarch)
- ARCH=noarch
- ;;
-*)
- AC_MSG_RESULT(no)
- ;;
-esac
-
AC_SUBST(OPSYS)
-AC_SUBST(ARCH)
+
+LM_HARDWARE_ARCH
dnl Check consistency of os and darwin-switches
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml
index 5089d4e0ce..74654a295d 100644
--- a/erts/doc/src/erl.xml
+++ b/erts/doc/src/erl.xml
@@ -1158,7 +1158,7 @@
<tag><marker id="+sbwtdcpu"/>
<c>+sbwtdcpu none|very_short|short|medium|long|very_long</c></tag>
<item>
- <p>As <seealso marker="+sbwt"><c>+sbwt</c></seealso> but affects
+ <p>As <seealso marker="#+sbwt"><c>+sbwt</c></seealso> but affects
dirty CPU schedulers. Defaults to <c>short</c>.</p>
<note>
<p>This flag can be removed or changed at any time
@@ -1168,7 +1168,7 @@
<tag><marker id="+sbwtdio"/>
<c>+sbwtdio none|very_short|short|medium|long|very_long</c></tag>
<item>
- <p>As <seealso marker="+sbwt"><c>+sbwt</c></seealso> but affects
+ <p>As <seealso marker="#+sbwt"><c>+sbwt</c></seealso> but affects
dirty IO schedulers. Defaults to <c>short</c>.</p>
<note>
<p>This flag can be removed or changed at any time
@@ -1443,7 +1443,7 @@
<tag><marker id="+swtdcpu"/>
<c>+swtdcpu very_low|low|medium|high|very_high</c></tag>
<item>
- <p>As <seealso marker="+swt"><c>+swt</c></seealso> but
+ <p>As <seealso marker="#+swt"><c>+swt</c></seealso> but
affects dirty CPU schedulers. Defaults to <c>medium</c>.</p>
<note>
<p>This flag can be removed or changed at any time
@@ -1453,7 +1453,7 @@
<tag><marker id="+swtdio"/>
<c>+swtdio very_low|low|medium|high|very_high</c></tag>
<item>
- <p>As <seealso marker="+swt"><c>+swt</c></seealso> but affects
+ <p>As <seealso marker="#+swt"><c>+swt</c></seealso> but affects
dirty IO schedulers. Defaults to <c>medium</c>.</p>
<note>
<p>This flag can be removed or changed at any time
diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml
index 53e136d76c..0893eb291c 100644
--- a/erts/doc/src/erts_alloc.xml
+++ b/erts/doc/src/erts_alloc.xml
@@ -559,6 +559,20 @@
than this threshold, otherwise the carrier is shrunk.
See also <seealso marker="#M_rsbcst"><c>rsbcst</c></seealso>.</p>
</item>
+ <tag><marker id="M_atags"/><c><![CDATA[+M<S>atags true|false]]></c></tag>
+ <item>
+ <p>Adds a small tag to each allocated block that contains basic
+ information about what it is and who allocated it. Use the
+ <seealso marker="tools:instrument"><c>instrument</c></seealso>
+ module to inspect this information.</p>
+
+ <p>The runtime overhead is one word per allocation when enabled. This
+ may change at any time in the future.</p>
+
+ <p>The default is <c>true</c> for <c>binary_alloc</c> and
+ <c>driver_alloc</c>, and <c>false</c> for the other allocator
+ types.</p>
+ </item>
<tag><marker id="M_e"/><c><![CDATA[+M<S>e true|false]]></c></tag>
<item>
<p>Enables allocator <c><![CDATA[<S>]]></c>.</p>
@@ -724,22 +738,12 @@
<section>
<title>Instrumentation Flags</title>
<taglist>
- <tag><marker id="Mim"/><c>+Mim true|false</c></tag>
- <item>
- <p>A map over current allocations is kept by the emulator.
- The allocation map can be retrieved through module
- <seealso marker="tools:instrument">
- <c>instrument(3)</c></seealso>. <c>+Mim true</c>
- implies <c>+Mis true</c>. <c>+Mim true</c> is the same as flag
- <seealso marker="erl#instr"><c>-instr</c></seealso> in
- <c>erl(1)</c>.</p>
- </item>
- <tag><marker id="Mis"/><c>+Mis true|false</c></tag>
- <item>
- <p>Status over allocated memory is kept by the emulator.
- The allocation status can be retrieved through module
- <seealso marker="tools:instrument">
- <c>instrument(3)</c></seealso>.</p>
+ <tag><c>+M&lt;S&gt;atags</c></tag>
+ <item>
+ <p>Adds a small tag to each allocated block that contains basic
+ information about what it is and who allocated it. See
+ <seealso marker="#M_atags"><c>+M&lt;S&gt;atags</c></seealso> for a
+ more complete description.</p>
</item>
<tag><marker id="Mit"/><c>+Mit X</c></tag>
<item>
diff --git a/erts/doc/src/match_spec.xml b/erts/doc/src/match_spec.xml
index 644b989800..6cf0a0e677 100644
--- a/erts/doc/src/match_spec.xml
+++ b/erts/doc/src/match_spec.xml
@@ -169,10 +169,9 @@
<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['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
@@ -202,8 +201,7 @@
<c><![CDATA['>=']]></c> | <c><![CDATA['<']]></c> |
<c><![CDATA['=<']]></c> | <c><![CDATA['=:=']]></c> |
<c><![CDATA['==']]></c> | <c><![CDATA['=/=']]></c> |
- <c><![CDATA['/=']]></c> | <c><![CDATA[self]]></c> |
- <c><![CDATA[get_tcw]]></c>
+ <c><![CDATA['/=']]></c> | <c><![CDATA[self]]></c>
</item>
<item>MatchBody ::= [ ConditionExpression, ... ]
</item>
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 92cf40c1ae..5dfa60ee74 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -832,7 +832,7 @@ RUN_OBJS += \
$(OBJDIR)/erl_alloc.o $(OBJDIR)/erl_mtrace.o \
$(OBJDIR)/erl_alloc_util.o $(OBJDIR)/erl_goodfit_alloc.o \
$(OBJDIR)/erl_bestfit_alloc.o $(OBJDIR)/erl_afit_alloc.o \
- $(OBJDIR)/erl_instrument.o $(OBJDIR)/erl_init.o \
+ $(OBJDIR)/erl_init.o \
$(OBJDIR)/erl_atom_table.o $(OBJDIR)/erl_bif_table.o \
$(OBJDIR)/erl_bif_ddll.o $(OBJDIR)/erl_bif_guard.o \
$(OBJDIR)/erl_bif_info.o $(OBJDIR)/erl_bif_op.o \
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index fb87be3f17..ee287243a4 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -2420,8 +2420,7 @@ erts_hibernate(Process* c_p, Eterm* reg)
* shrink the heap.
*/
erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
- erts_proc_sig_fetch(c_p);
- if (!c_p->sig_qs.len) {
+ if (!erts_proc_sig_fetch(c_p)) {
erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
c_p->fvalue = NIL;
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2429,8 +2428,7 @@ erts_hibernate(Process* c_p, Eterm* reg)
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
- erts_proc_sig_fetch(c_p);
- if (!c_p->sig_qs.len)
+ if (!erts_proc_sig_fetch(c_p))
erts_atomic32_read_band_relb(&c_p->state, ~ERTS_PSFLG_ACTIVE);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
}
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 232597c5b6..79244b8544 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -1150,6 +1150,13 @@ BIF_RETTYPE raise_3(BIF_ALIST_3)
/* Create stacktrace and store */
if (erts_backtrace_depth < depth) {
depth = erts_backtrace_depth;
+ if (depth == 0) {
+ /*
+ * For consistency with stacktraces generated
+ * automatically, always include one element.
+ */
+ depth = 1;
+ }
must_copy = 1;
}
if (must_copy) {
@@ -4147,7 +4154,8 @@ BIF_RETTYPE erts_internal_group_leader_2(BIF_ALIST_2)
rp = BIF_P;
else {
rp = erts_try_lock_sig_free_proc(BIF_ARG_2,
- ERTS_PROC_LOCK_MAIN);
+ ERTS_PROC_LOCK_MAIN,
+ NULL);
if (!rp)
BIF_RET(am_badarg);
if (rp == ERTS_PROC_LOCK_BUSY)
diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h
index a33421d762..a47339253e 100644
--- a/erts/emulator/beam/bif.h
+++ b/erts/emulator/beam/bif.h
@@ -425,6 +425,12 @@ do { \
BIF_TRAP3((TRP), (P), (A0), (A1), (A2)); \
} while (0)
+#define ERTS_BIF_PREP_EXITED(RET, PROC) \
+do { \
+ KILL_CATCHES((PROC)); \
+ ERTS_BIF_PREP_ERROR((RET), (PROC), EXTAG_EXIT); \
+} while (0)
+
#define ERTS_BIF_EXITED(PROC) \
do { \
KILL_CATCHES((PROC)); \
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 687fd39d58..bcaf9277bf 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -693,3 +693,5 @@ bif erts_internal:new_connection/1
bif erts_internal:abort_connection/2
bif erts_internal:map_next/3
bif ets:whereis/1
+bif erts_internal:gather_alloc_histograms/1
+bif erts_internal:gather_carrier_info/1
diff --git a/erts/emulator/beam/bif_instrs.tab b/erts/emulator/beam/bif_instrs.tab
index 0932b8b985..0f074280db 100644
--- a/erts/emulator/beam/bif_instrs.tab
+++ b/erts/emulator/beam/bif_instrs.tab
@@ -432,9 +432,17 @@ nif_bif.call_nif() {
live_hf_end = c_p->mbuf;
ERTS_CHK_MBUF_SZ(c_p);
erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2], NULL);
+
+ ASSERT((c_p->scheduler_data)->current_nif == NULL);
+ (c_p->scheduler_data)->current_nif = &env;
+
nif_bif_result = (*fp)(&env, bif_nif_arity, reg);
if (env.exception_thrown)
nif_bif_result = THE_NON_VALUE;
+
+ ASSERT((c_p->scheduler_data)->current_nif == &env);
+ (c_p->scheduler_data)->current_nif = NULL;
+
erts_post_nif(&env);
ERTS_CHK_MBUF_SZ(c_p);
diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c
index 95d324d2c1..d53f75c279 100644
--- a/erts/emulator/beam/binary.c
+++ b/erts/emulator/beam/binary.c
@@ -113,6 +113,40 @@ new_binary(Process *p, byte *buf, Uint len)
return build_proc_bin(&MSO(p), HAlloc(p, PROC_BIN_SIZE), bptr);
}
+Eterm
+erts_heap_factory_new_binary(ErtsHeapFactory *hfact, byte *buf, Uint len,
+ Uint reserve_size)
+{
+ Eterm *hp;
+ Binary* bptr;
+
+ if (len <= ERL_ONHEAP_BIN_LIMIT) {
+ ErlHeapBin* hb;
+ hp = erts_produce_heap(hfact, heap_bin_size(len), reserve_size);
+ hb = (ErlHeapBin *) hp;
+ hb->thing_word = header_heap_bin(len);
+ hb->size = len;
+ if (buf != NULL) {
+ sys_memcpy(hb->data, buf, len);
+ }
+ return make_binary(hb);
+ }
+
+ /*
+ * Allocate the binary struct itself.
+ */
+ bptr = erts_bin_nrml_alloc(len);
+ if (buf != NULL) {
+ sys_memcpy(bptr->orig_bytes, buf, len);
+ }
+
+ hp = erts_produce_heap(hfact, PROC_BIN_SIZE, reserve_size);
+
+ return build_proc_bin(hfact->off_heap, hp, bptr);
+}
+
+
+
/*
* When heap binary is not desired...
*/
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index 4dabac3512..9ff52c92b8 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -36,7 +36,6 @@
#include "hash.h"
#include "atom.h"
#include "beam_load.h"
-#include "erl_instrument.h"
#include "erl_hl_timer.h"
#include "erl_thr_progress.h"
#include "erl_proc_sig_queue.h"
@@ -204,6 +203,7 @@ print_process_info(fmtfn_t to, void *to_arg, Process *p)
{
int garbing = 0;
int running = 0;
+ Sint len;
struct saved_calls *scb;
erts_aint32_t state;
@@ -252,9 +252,9 @@ print_process_info(fmtfn_t to, void *to_arg, Process *p)
erts_print(to, to_arg, "Spawned by: %T\n", p->parent);
erts_proc_lock(p, ERTS_PROC_LOCK_MSGQ);
- erts_proc_sig_fetch(p);
+ len = erts_proc_sig_fetch(p);
erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ);
- erts_print(to, to_arg, "Message queue length: %d\n", p->sig_qs.len);
+ erts_print(to, to_arg, "Message queue length: %d\n", len);
/* display the message queue only if there is anything in it */
if (!ERTS_IS_CRASH_DUMPING && p->sig_qs.first != NULL && !garbing) {
@@ -954,20 +954,6 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
erts_cbprintf(to, to_arg, "=atoms\n");
dump_atoms(to, to_arg);
- /* Keep the instrumentation data at the end of the dump */
- if (erts_instr_memory_map || erts_instr_stat) {
- erts_cbprintf(to, to_arg, "=instr_data\n");
-
- if (erts_instr_stat) {
- erts_cbprintf(to, to_arg, "=memory_status\n");
- erts_instr_dump_stat_to(to, to_arg, 0);
- }
- if (erts_instr_memory_map) {
- erts_cbprintf(to, to_arg, "=memory_map\n");
- erts_instr_dump_memory_map_to(to, to_arg);
- }
- }
-
erts_cbprintf(to, to_arg, "=end\n");
if (fp) {
fclose(fp);
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 061b9df627..d99d2ea57b 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -38,7 +38,7 @@
#include "erl_db.h"
#include "erl_binary.h"
#include "erl_bits.h"
-#include "erl_instrument.h"
+#include "erl_mtrace.h"
#include "erl_mseg.h"
#include "erl_monitor_link.h"
#include "erl_hl_timer.h"
@@ -202,8 +202,6 @@ typedef struct {
int top_pad;
AlcUInit_t alloc_util;
struct {
- int stat;
- int map;
char *mtrace;
char *nodename;
} instr;
@@ -428,6 +426,7 @@ set_default_binary_alloc_opts(struct au_init *ip)
#endif
ip->init.util.ts = ERTS_ALC_MTA_BINARY;
ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL;
+ ip->init.util.atags = 1;
}
static void
@@ -464,6 +463,7 @@ set_default_driver_alloc_opts(struct au_init *ip)
#endif
ip->init.util.ts = ERTS_ALC_MTA_DRIVER;
ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL;
+ ip->init.util.atags = 1;
}
static void
@@ -501,6 +501,7 @@ set_default_test_alloc_opts(struct au_init *ip)
ip->init.util.mmbcs = 0; /* Main carrier size */
ip->init.util.ts = ERTS_ALC_MTA_TEST;
ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL;
+ ip->init.util.atags = 1;
/* Use a constant minimal MBC size */
#if ERTS_SA_MB_CARRIERS
@@ -906,7 +907,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
&test_alloc_state);
erts_mtrace_install_wrapper_functions();
- extra_block_size += erts_instr_init(init.instr.stat, init.instr.map);
init_aireq_alloc();
@@ -1411,7 +1411,9 @@ handle_au_arg(struct au_init *auip,
}
if (!strategy_support_carrier_migration(auip))
auip->init.util.acul = 0;
- }
+ } else if (has_prefix("atags", sub_param)) {
+ auip->init.util.atags = get_bool_value(sub_param + 5, argv, ip);
+ }
else
goto bad_switch;
break;
@@ -1741,24 +1743,6 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
break;
case 'i':
switch (argv[i][3]) {
- case 's':
- arg = get_value(argv[i]+4, argv, &i);
- if (sys_strcmp("true", arg) == 0)
- init->instr.stat = 1;
- else if (sys_strcmp("false", arg) == 0)
- init->instr.stat = 0;
- else
- bad_value(param, param+3, arg);
- break;
- case 'm':
- arg = get_value(argv[i]+4, argv, &i);
- if (sys_strcmp("true", arg) == 0)
- init->instr.map = 1;
- else if (sys_strcmp("false", arg) == 0)
- init->instr.map = 0;
- else
- bad_value(param, param+3, arg);
- break;
case 't':
init->instr.mtrace = get_value(argv[i]+4, argv, &i);
break;
@@ -1817,9 +1801,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
case '-':
if (argv[i][2] == '\0') {
/* End of system flags reached */
- if (init->instr.mtrace
- /* || init->instr.stat
- || init->instr.map */) {
+ if (init->instr.mtrace) {
while (i < *argc) {
if(sys_strcmp(argv[i], "-sname") == 0
|| sys_strcmp(argv[i], "-name") == 0) {
@@ -2097,7 +2079,7 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
* NOTE! When updating this function, make sure to also update
* erlang:memory/[0,1] in $ERL_TOP/erts/preloaded/src/erlang.erl
*/
-#define ERTS_MEM_NEED_ALL_ALCU (!erts_instr_stat && want_tot_or_sys)
+#define ERTS_MEM_NEED_ALL_ALCU (want_tot_or_sys)
struct {
int total;
int processes;
@@ -2108,7 +2090,6 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
int binary;
int code;
int ets;
- int maximum;
} want = {0};
struct {
UWord total;
@@ -2120,7 +2101,6 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
UWord binary;
UWord code;
UWord ets;
- UWord maximum;
} size = {0};
Eterm atoms[sizeof(size)/sizeof(UWord)];
UWord *uintps[sizeof(size)/sizeof(UWord)];
@@ -2173,12 +2153,6 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
want.ets = 1;
atoms[length] = am_ets;
uintps[length++] = &size.ets;
-
- want.maximum = erts_instr_stat;
- if (want.maximum) {
- atoms[length] = am_maximum;
- uintps[length++] = &size.maximum;
- }
}
else {
DeclareTmpHeapNoproc(tmp_heap,2);
@@ -2260,18 +2234,6 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
uintps[length++] = &size.ets;
}
break;
- case am_maximum:
- if (erts_instr_stat) {
- if (!want.maximum) {
- want.maximum = 1;
- atoms[length] = am_maximum;
- uintps[length++] = &size.maximum;
- }
- } else {
- UnUseTmpHeapNoproc(2);
- return am_badarg;
- }
- break;
default:
UnUseTmpHeapNoproc(2);
return am_badarg;
@@ -2437,14 +2399,7 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg)
size.ets += erts_get_ets_misc_mem_size();
}
- if (erts_instr_stat && (want_tot_or_sys || want.maximum)) {
- if (want_tot_or_sys) {
- size.total = erts_instr_get_total();
- size.system = size.total - size.processes;
- }
- size.maximum = erts_instr_get_max_total();
- }
- else if (want_tot_or_sys) {
+ if (want_tot_or_sys) {
size.system = size.total - size.processes;
}
@@ -2522,18 +2477,6 @@ erts_allocated_areas(fmtfn_t *print_to_p, void *print_to_arg, void *proc)
i = 0;
- if (erts_instr_stat) {
- values[i].arity = 2;
- values[i].name = "total";
- values[i].ui[0] = erts_instr_get_total();
- i++;
-
- values[i].arity = 2;
- values[i].name = "maximum";
- values[i].ui[0] = erts_instr_get_max_total();
- i++;
- }
-
values[i].arity = 2;
values[i].name = "sys_misc";
values[i].ui[0] = erts_sys_misc_mem_sz();
@@ -2824,10 +2767,7 @@ erts_allocator_info(fmtfn_t to, void *arg)
erts_alcu_au_info_options(&to, arg, NULL, NULL);
erts_print(to, arg, "=allocator:instr\n");
- erts_print(to, arg, "option m: %s\n",
- erts_instr_memory_map ? "true" : "false");
- erts_print(to, arg, "option s: %s\n",
- erts_instr_stat ? "true" : "false");
+
erts_print(to, arg, "option t: %s\n",
erts_mtrace_enabled ? "true" : "false");
@@ -2933,16 +2873,12 @@ erts_allocator_options(void *proc)
NULL, hpp, szp);
#endif
{
- Eterm o[3], v[3];
- o[0] = am_atom_put("m", 1);
- v[0] = erts_instr_memory_map ? am_true : am_false;
- o[1] = am_atom_put("s", 1);
- v[1] = erts_instr_stat ? am_true : am_false;
- o[2] = am_atom_put("t", 1);
- v[2] = erts_mtrace_enabled ? am_true : am_false;
+ Eterm o[1], v[1];
+ o[0] = am_atom_put("t", 1);
+ v[0] = erts_mtrace_enabled ? am_true : am_false;
atoms[length] = am_atom_put("instr", 5);
- terms[length++] = erts_bld_2tup_list(hpp, szp, 3, o, v);
+ terms[length++] = erts_bld_2tup_list(hpp, szp, 1, o, v);
}
atoms[length] = am_atom_put("lock_physical_memory", 20);
@@ -3458,8 +3394,8 @@ badarg:
/*
* The allocator wrapper prelocking stuff below is about the locking order.
- * It only affects wrappers (erl_mtrace.c and erl_instrument.c) that keep locks
- * during alloc/realloc/free.
+ * It only affects wrappers (erl_mtrace.c) that keep locks during
+ * alloc/realloc/free.
*
* Some query functions in erl_alloc_util.c lock the allocator mutex and then
* use erts_printf that in turn may call the sys allocator through the wrappers.
diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c
index e148be7af6..fdf355d503 100644
--- a/erts/emulator/beam/erl_alloc_util.c
+++ b/erts/emulator/beam/erl_alloc_util.c
@@ -48,6 +48,8 @@
#include "erl_mseg.h"
#include "erl_threads.h"
#include "erl_thr_progress.h"
+#include "erl_bif_unique.h"
+#include "erl_nif.h"
#ifdef ERTS_ENABLE_LOCK_COUNT
#include "erl_lock_count.h"
@@ -139,6 +141,33 @@ MBC after deallocating first block:
[Carrier_t|pad|Block_t 111| udata... ]
*/
+/* Allocation tags ...
+ *
+ * These are added to the footer of every block when enabled. Currently they
+ * consist of the allocation type and an atom identifying the allocating
+ * driver/nif (or 'system' if that can't be determined), but the format is not
+ * supposed to be set in stone.
+ *
+ * The packing scheme requires that the atom values are small enough to fit
+ * into a word with ERTS_ALC_N_BITS to spare. Users must check for overflow
+ * before MAKE_ATAG(). */
+
+typedef UWord alcu_atag_t;
+
+#define MAKE_ATAG(IdAtom, Type) \
+ (ASSERT((Type) >= ERTS_ALC_N_MIN && (Type) <= ERTS_ALC_N_MAX), \
+ ASSERT(atom_val(IdAtom) <= MAX_ATAG_ATOM_ID), \
+ (atom_val(IdAtom) << ERTS_ALC_N_BITS) | (Type))
+
+#define ATAG_ID(AT) (make_atom((AT) >> ERTS_ALC_N_BITS))
+#define ATAG_TYPE(AT) ((AT) & ERTS_ALC_N_MASK)
+
+#define MAX_ATAG_ATOM_ID (ERTS_UWORD_MAX >> ERTS_ALC_N_BITS)
+
+#define DBG_IS_VALID_ATAG(Allocator, AT) \
+ (ATAG_TYPE(AT) >= ERTS_ALC_N_MIN && \
+ ATAG_TYPE(AT) <= ERTS_ALC_N_MAX && \
+ (Allocator)->alloc_no == ERTS_ALC_T2A(ERTS_ALC_N2T(ATAG_TYPE(AT))))
/* Blocks ... */
@@ -153,10 +182,17 @@ MBC after deallocating first block:
#endif
#define FBLK_FTR_SZ (sizeof(FreeBlkFtr_t))
+#define GET_BLK_ATAG(B) \
+ (((alcu_atag_t *) (((char *) (B)) + (BLK_SZ(B))))[-1])
+#define SET_BLK_ATAG(B, T) \
+ (((alcu_atag_t *) (((char *) (B)) + (BLK_SZ(B))))[-1] = (T))
+
+#define BLK_ATAG_SZ(AP) ((AP)->atags ? sizeof(alcu_atag_t) : 0)
+
#define UMEMSZ2BLKSZ(AP, SZ) \
- (ABLK_HDR_SZ + (SZ) <= (AP)->min_block_size \
+ (ABLK_HDR_SZ + BLK_ATAG_SZ(AP) + (SZ) <= (AP)->min_block_size \
? (AP)->min_block_size \
- : UNIT_CEILING(ABLK_HDR_SZ + (SZ)))
+ : UNIT_CEILING(ABLK_HDR_SZ + BLK_ATAG_SZ(AP) + (SZ)))
#define UMEM2BLK(P) ((Block_t *) (((char *) (P)) - ABLK_HDR_SZ))
#define BLK2UMEM(P) ((void *) (((char *) (P)) + ABLK_HDR_SZ))
@@ -688,6 +724,62 @@ static void destroy_carrier(Allctr_t *, Block_t *, Carrier_t **);
static void mbc_free(Allctr_t *allctr, void *p, Carrier_t **busy_pcrr_pp);
static void dealloc_block(Allctr_t *, void *, ErtsAlcFixList_t *, int);
+static alcu_atag_t determine_alloc_tag(Allctr_t *allocator, ErtsAlcType_t type)
+{
+ ErtsSchedulerData *esdp;
+ Eterm id;
+
+ ERTS_CT_ASSERT(_unchecked_atom_val(am_system) <= MAX_ATAG_ATOM_ID);
+ ASSERT(allocator->atags);
+
+ esdp = erts_get_scheduler_data();
+ id = am_system;
+
+ if (esdp) {
+ if (esdp->current_nif) {
+ Module *mod = erts_nif_get_module((esdp->current_nif)->mod_nif);
+
+ /* Mod can be NULL if a resource destructor allocates memory after
+ * the module has been unloaded. */
+ if (mod) {
+ id = make_atom(mod->module);
+ }
+ } else if (esdp->current_port) {
+ Port *p = esdp->current_port;
+ id = (p->drv_ptr)->name_atom;
+ }
+
+ /* We fall back to 'system' if we can't pack the driver/NIF name into
+ * the tag. This may be a bit misleading but we've made no promises
+ * that the information is complete.
+ *
+ * This can only happen on 32-bit emulators when a new driver/NIF has
+ * been loaded *after* 16 million atoms have been used, and supporting
+ * that fringe case is not worth an extra word. 64-bit emulators are
+ * unaffected since the atom cache limits atom indexes to 32 bits. */
+ if(MAX_ATOM_TABLE_SIZE > MAX_ATAG_ATOM_ID) {
+ if (atom_val(id) > MAX_ATAG_ATOM_ID) {
+ id = am_system;
+ }
+ }
+ }
+
+ return MAKE_ATAG(id, type);
+}
+
+static void set_alloc_tag(Allctr_t *allocator, void *p, alcu_atag_t tag)
+{
+ Block_t *block;
+
+ ASSERT(DBG_IS_VALID_ATAG(allocator, tag));
+ ASSERT(allocator->atags && p);
+ (void)allocator;
+
+ block = UMEM2BLK(p);
+
+ SET_BLK_ATAG(block, tag);
+}
+
/* internal data... */
#if 0
@@ -4242,6 +4334,7 @@ static struct {
Eterm e;
Eterm t;
Eterm ramv;
+ Eterm atags;
#if HAVE_ERTS_MSEG
Eterm asbcst;
Eterm rsbcst;
@@ -4311,7 +4404,7 @@ static struct {
#endif
} am;
-static Eterm fix_type_atoms[ERTS_ALC_NO_FIXED_SIZES];
+static Eterm alloc_type_atoms[ERTS_ALC_N_MAX + 1];
static ERTS_INLINE void atom_init(Eterm *atom, char *name)
{
@@ -4342,6 +4435,7 @@ init_atoms(Allctr_t *allctr)
AM_INIT(e);
AM_INIT(t);
AM_INIT(ramv);
+ AM_INIT(atags);
#if HAVE_ERTS_MSEG
AM_INIT(asbcst);
AM_INIT(rsbcst);
@@ -4413,12 +4507,12 @@ init_atoms(Allctr_t *allctr)
}
#endif
- for (ix = 0; ix < ERTS_ALC_NO_FIXED_SIZES; ix++) {
- ErtsAlcType_t n = ERTS_ALC_N_MIN_A_FIXED_SIZE + ix;
- char *name = (char *) ERTS_ALC_N2TD(n);
- size_t len = sys_strlen(name);
- fix_type_atoms[ix] = am_atom_put(name, len);
- }
+ for (ix = ERTS_ALC_N_MIN; ix <= ERTS_ALC_N_MAX; ix++) {
+ const char *name = ERTS_ALC_N2TD(ix);
+ size_t len = sys_strlen(name);
+
+ alloc_type_atoms[ix] = am_atom_put(name, len);
+ }
}
if (allctr && !allctr->atoms_initialized) {
@@ -4531,6 +4625,7 @@ sz_info_fix(Allctr_t *allctr,
ErtsAlcFixList_t *fix = &allctr->fix[ix];
UWord alloced = fix->type_size * fix->u.cpool.allocated;
UWord used = fix->type_size * fix->u.cpool.used;
+ ErtsAlcType_t n = ERTS_ALC_N_MIN_A_FIXED_SIZE + ix;
if (print_to_p) {
fmtfn_t to = *print_to_p;
@@ -4538,15 +4633,14 @@ sz_info_fix(Allctr_t *allctr,
erts_print(to,
arg,
"fix type internal: %s %bpu %bpu\n",
- (char *) ERTS_ALC_N2TD(ERTS_ALC_N_MIN_A_FIXED_SIZE
- + ix),
+ (char *) ERTS_ALC_N2TD(n),
alloced,
used);
}
if (hpp || szp) {
add_3tup(hpp, szp, &res,
- fix_type_atoms[ix],
+ alloc_type_atoms[n],
bld_unstable_uint(hpp, szp, alloced),
bld_unstable_uint(hpp, szp, used));
}
@@ -4559,6 +4653,7 @@ sz_info_fix(Allctr_t *allctr,
ErtsAlcFixList_t *fix = &allctr->fix[ix];
UWord alloced = fix->type_size * fix->u.nocpool.allocated;
UWord used = fix->type_size*fix->u.nocpool.used;
+ ErtsAlcType_t n = ERTS_ALC_N_MIN_A_FIXED_SIZE + ix;
if (print_to_p) {
fmtfn_t to = *print_to_p;
@@ -4566,15 +4661,14 @@ sz_info_fix(Allctr_t *allctr,
erts_print(to,
arg,
"fix type: %s %bpu %bpu\n",
- (char *) ERTS_ALC_N2TD(ERTS_ALC_N_MIN_A_FIXED_SIZE
- + ix),
+ (char *) ERTS_ALC_N2TD(n),
alloced,
used);
}
if (hpp || szp) {
add_3tup(hpp, szp, &res,
- fix_type_atoms[ix],
+ alloc_type_atoms[n],
bld_unstable_uint(hpp, szp, alloced),
bld_unstable_uint(hpp, szp, used));
}
@@ -5000,6 +5094,7 @@ info_options(Allctr_t *allctr,
"option e: true\n"
"option t: %s\n"
"option ramv: %s\n"
+ "option atags: %s\n"
"option sbct: %beu\n"
#if HAVE_ERTS_MSEG
"option asbcst: %bpu\n"
@@ -5018,6 +5113,7 @@ info_options(Allctr_t *allctr,
"option acul: %bpu\n",
topt,
allctr->ramv ? "true" : "false",
+ allctr->atags ? "true" : "false",
allctr->sbc_threshold,
#if HAVE_ERTS_MSEG
allctr->mseg_opt.abs_shrink_th,
@@ -5087,6 +5183,7 @@ info_options(Allctr_t *allctr,
am_sbct,
bld_uint(hpp, szp, allctr->sbc_threshold));
add_2tup(hpp, szp, &res, am.ramv, allctr->ramv ? am_true : am_false);
+ add_2tup(hpp, szp, &res, am.atags, allctr->atags ? am_true : am_false);
add_2tup(hpp, szp, &res, am.t, (allctr->t ? am_true : am_false));
add_2tup(hpp, szp, &res, am.e, am_true);
}
@@ -5408,9 +5505,8 @@ erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size, ErtsAlcUFixInfo_t *
/* ----------------------------------------------------------------------- */
static ERTS_INLINE void *
-do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
+do_erts_alcu_alloc(ErtsAlcType_t type, Allctr_t *allctr, Uint size)
{
- Allctr_t *allctr = (Allctr_t *) extra;
void *res;
ASSERT(initialized);
@@ -5449,10 +5545,19 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
void *erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
{
+ Allctr_t *allctr = (Allctr_t *) extra;
void *res;
+
ASSERT(!"This is not thread safe");
- res = do_erts_alcu_alloc(type, extra, size);
+
+ res = do_erts_alcu_alloc(type, allctr, size);
+
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, determine_alloc_tag(allctr, type));
+ }
+
DEBUG_CHECK_ALIGNMENT(res);
+
return res;
}
@@ -5462,13 +5567,25 @@ void *
erts_alcu_alloc_ts(ErtsAlcType_t type, void *extra, Uint size)
{
Allctr_t *allctr = (Allctr_t *) extra;
+ alcu_atag_t tag = 0;
void *res;
+
+ if (allctr->atags) {
+ tag = determine_alloc_tag(allctr, type);
+ }
+
erts_mtx_lock(&allctr->mutex);
- res = do_erts_alcu_alloc(type, extra, size);
- DEBUG_CHECK_ALIGNMENT(res);
+ res = do_erts_alcu_alloc(type, allctr, size);
+
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, tag);
+ }
erts_mtx_unlock(&allctr->mutex);
+
+ DEBUG_CHECK_ALIGNMENT(res);
+
return res;
}
@@ -5478,6 +5595,7 @@ erts_alcu_alloc_thr_spec(ErtsAlcType_t type, void *extra, Uint size)
{
ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
int ix;
+ alcu_atag_t tag = 0;
Allctr_t *allctr;
void *res;
@@ -5487,11 +5605,19 @@ erts_alcu_alloc_thr_spec(ErtsAlcType_t type, void *extra, Uint size)
allctr = tspec->allctr[ix];
+ if (allctr->atags) {
+ tag = determine_alloc_tag(allctr, type);
+ }
+
if (allctr->thread_safe)
erts_mtx_lock(&allctr->mutex);
res = do_erts_alcu_alloc(type, allctr, size);
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, tag);
+ }
+
if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
@@ -5504,10 +5630,15 @@ void *
erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size)
{
Allctr_t *pref_allctr;
+ alcu_atag_t tag = 0;
void *res;
pref_allctr = get_pref_allctr(extra);
+ if (pref_allctr->atags) {
+ tag = determine_alloc_tag(pref_allctr, type);
+ }
+
if (pref_allctr->thread_safe)
erts_mtx_lock(&pref_allctr->mutex);
@@ -5523,12 +5654,15 @@ erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size)
res = do_erts_alcu_alloc(type, pref_allctr, size);
}
+ if (pref_allctr->atags && res) {
+ set_alloc_tag(pref_allctr, res, tag);
+ }
+
if (pref_allctr->thread_safe)
erts_mtx_unlock(&pref_allctr->mutex);
DEBUG_CHECK_ALIGNMENT(res);
-
return res;
}
@@ -5537,10 +5671,9 @@ erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size)
/* ------------------------------------------------------------------------- */
static ERTS_INLINE void
-do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p,
+do_erts_alcu_free(ErtsAlcType_t type, Allctr_t *allctr, void *p,
Carrier_t **busy_pcrr_pp)
{
- Allctr_t *allctr = (Allctr_t *) extra;
ASSERT(initialized);
ASSERT(allctr);
@@ -5572,7 +5705,8 @@ do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p,
void erts_alcu_free(ErtsAlcType_t type, void *extra, void *p)
{
- do_erts_alcu_free(type, extra, p, NULL);
+ Allctr_t *allctr = (Allctr_t *) extra;
+ do_erts_alcu_free(type, allctr, p, NULL);
}
@@ -5581,7 +5715,7 @@ erts_alcu_free_ts(ErtsAlcType_t type, void *extra, void *p)
{
Allctr_t *allctr = (Allctr_t *) extra;
erts_mtx_lock(&allctr->mutex);
- do_erts_alcu_free(type, extra, p, NULL);
+ do_erts_alcu_free(type, allctr, p, NULL);
erts_mtx_unlock(&allctr->mutex);
}
@@ -5641,13 +5775,12 @@ erts_alcu_free_thr_pref(ErtsAlcType_t type, void *extra, void *p)
static ERTS_INLINE void *
do_erts_alcu_realloc(ErtsAlcType_t type,
- void *extra,
+ Allctr_t *allctr,
void *p,
Uint size,
Uint32 alcu_flgs,
Carrier_t **busy_pcrr_pp)
{
- Allctr_t *allctr = (Allctr_t *) extra;
Block_t *blk;
void *res;
@@ -5661,7 +5794,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
if (!p) {
- res = do_erts_alcu_alloc(type, extra, size);
+ res = do_erts_alcu_alloc(type, allctr, size);
INC_CC(allctr->calls.this_realloc);
DEC_CC(allctr->calls.this_alloc);
return res;
@@ -5670,7 +5803,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
#if ALLOC_ZERO_EQ_NULL
if (!size) {
ASSERT(p);
- do_erts_alcu_free(type, extra, p, busy_pcrr_pp);
+ do_erts_alcu_free(type, allctr, p, busy_pcrr_pp);
INC_CC(allctr->calls.this_realloc);
DEC_CC(allctr->calls.this_free);
return NULL;
@@ -5755,19 +5888,29 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
void *
erts_alcu_realloc(ErtsAlcType_t type, void *extra, void *p, Uint size)
{
+ Allctr_t *allctr = (Allctr_t *)extra;
void *res;
- res = do_erts_alcu_realloc(type, extra, p, size, 0, NULL);
+
+ res = do_erts_alcu_realloc(type, allctr, p, size, 0, NULL);
+
DEBUG_CHECK_ALIGNMENT(res);
+
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, determine_alloc_tag(allctr, type));
+ }
+
return res;
}
void *
erts_alcu_realloc_mv(ErtsAlcType_t type, void *extra, void *p, Uint size)
{
+ Allctr_t *allctr = (Allctr_t *)extra;
void *res;
- res = do_erts_alcu_alloc(type, extra, size);
+
+ res = do_erts_alcu_alloc(type, allctr, size);
if (!res)
- res = erts_alcu_realloc(type, extra, p, size);
+ res = do_erts_alcu_realloc(type, allctr, p, size, 0, NULL);
else {
Block_t *blk;
size_t cpy_size;
@@ -5777,23 +5920,42 @@ erts_alcu_realloc_mv(ErtsAlcType_t type, void *extra, void *p, Uint size)
if (cpy_size > size)
cpy_size = size;
sys_memcpy(res, p, cpy_size);
- do_erts_alcu_free(type, extra, p, NULL);
+ do_erts_alcu_free(type, allctr, p, NULL);
}
+
DEBUG_CHECK_ALIGNMENT(res);
+
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, determine_alloc_tag(allctr, type));
+ }
+
return res;
}
-
void *
erts_alcu_realloc_ts(ErtsAlcType_t type, void *extra, void *ptr, Uint size)
{
Allctr_t *allctr = (Allctr_t *) extra;
+ alcu_atag_t tag = 0;
void *res;
+
+ if (allctr->atags) {
+ tag = determine_alloc_tag(allctr, type);
+ }
+
erts_mtx_lock(&allctr->mutex);
- res = do_erts_alcu_realloc(type, extra, ptr, size, 0, NULL);
+
+ res = do_erts_alcu_realloc(type, allctr, ptr, size, 0, NULL);
+
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, tag);
+ }
+
erts_mtx_unlock(&allctr->mutex);
+
DEBUG_CHECK_ALIGNMENT(res);
+
return res;
}
@@ -5801,11 +5963,17 @@ void *
erts_alcu_realloc_mv_ts(ErtsAlcType_t type, void *extra, void *p, Uint size)
{
Allctr_t *allctr = (Allctr_t *) extra;
+ alcu_atag_t tag = 0;
void *res;
+
+ if (allctr->atags) {
+ tag = determine_alloc_tag(allctr, type);
+ }
+
erts_mtx_lock(&allctr->mutex);
- res = do_erts_alcu_alloc(type, extra, size);
+ res = do_erts_alcu_alloc(type, allctr, size);
if (!res)
- res = erts_alcu_realloc_ts(type, extra, p, size);
+ res = do_erts_alcu_realloc(type, allctr, p, size, 0, NULL);
else {
Block_t *blk;
size_t cpy_size;
@@ -5815,10 +5983,17 @@ erts_alcu_realloc_mv_ts(ErtsAlcType_t type, void *extra, void *p, Uint size)
if (cpy_size > size)
cpy_size = size;
sys_memcpy(res, p, cpy_size);
- do_erts_alcu_free(type, extra, p, NULL);
+ do_erts_alcu_free(type, allctr, p, NULL);
}
+
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, tag);
+ }
+
erts_mtx_unlock(&allctr->mutex);
+
DEBUG_CHECK_ALIGNMENT(res);
+
return res;
}
@@ -5829,6 +6004,7 @@ erts_alcu_realloc_thr_spec(ErtsAlcType_t type, void *extra,
{
ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
int ix;
+ alcu_atag_t tag = 0;
Allctr_t *allctr;
void *res;
@@ -5838,11 +6014,19 @@ erts_alcu_realloc_thr_spec(ErtsAlcType_t type, void *extra,
allctr = tspec->allctr[ix];
+ if (allctr->atags) {
+ tag = determine_alloc_tag(allctr, type);
+ }
+
if (allctr->thread_safe)
erts_mtx_lock(&allctr->mutex);
res = do_erts_alcu_realloc(type, allctr, ptr, size, 0, NULL);
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, tag);
+ }
+
if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
@@ -5857,6 +6041,7 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra,
{
ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
int ix;
+ alcu_atag_t tag = 0;
Allctr_t *allctr;
void *res;
@@ -5866,14 +6051,16 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra,
allctr = tspec->allctr[ix];
+ if (allctr->atags) {
+ tag = determine_alloc_tag(allctr, type);
+ }
+
if (allctr->thread_safe)
erts_mtx_lock(&allctr->mutex);
res = do_erts_alcu_alloc(type, allctr, size);
if (!res) {
- if (allctr->thread_safe)
- erts_mtx_unlock(&allctr->mutex);
- res = erts_alcu_realloc_thr_spec(type, allctr, ptr, size);
+ res = do_erts_alcu_realloc(type, allctr, ptr, size, 0, NULL);
}
else {
Block_t *blk;
@@ -5885,29 +6072,34 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra,
cpy_size = size;
sys_memcpy(res, ptr, cpy_size);
do_erts_alcu_free(type, allctr, ptr, NULL);
- if (allctr->thread_safe)
- erts_mtx_unlock(&allctr->mutex);
}
+ if (allctr->atags && res) {
+ set_alloc_tag(allctr, res, tag);
+ }
+
+ if (allctr->thread_safe)
+ erts_mtx_unlock(&allctr->mutex);
+
DEBUG_CHECK_ALIGNMENT(res);
return res;
}
static ERTS_INLINE void *
-realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size,
+realloc_thr_pref(ErtsAlcType_t type, Allctr_t *pref_allctr, void *p, Uint size,
int force_move)
{
void *res;
- Allctr_t *pref_allctr, *used_allctr;
+ Allctr_t *used_allctr;
UWord old_user_size;
Carrier_t *busy_pcrr_p;
+ alcu_atag_t tag = 0;
int retried;
- if (!p)
- return erts_alcu_alloc_thr_pref(type, extra, size);
-
- pref_allctr = get_pref_allctr(extra);
+ if (pref_allctr->atags) {
+ tag = determine_alloc_tag(pref_allctr, type);
+ }
if (pref_allctr->thread_safe)
erts_mtx_lock(&pref_allctr->mutex);
@@ -5936,6 +6128,11 @@ restart:
retried = 1;
goto restart;
}
+
+ if (pref_allctr->atags && res) {
+ set_alloc_tag(pref_allctr, res, tag);
+ }
+
if (pref_allctr->thread_safe)
erts_mtx_unlock(&pref_allctr->mutex);
}
@@ -5944,6 +6141,9 @@ restart:
if (!res)
goto unlock_ts_return;
else {
+ if (pref_allctr->atags) {
+ set_alloc_tag(pref_allctr, res, tag);
+ }
DEBUG_CHECK_ALIGNMENT(res);
@@ -5974,20 +6174,34 @@ restart:
}
}
+ DEBUG_CHECK_ALIGNMENT(res);
+
return res;
}
void *
erts_alcu_realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size)
{
- return realloc_thr_pref(type, extra, p, size, 0);
+ if (p) {
+ Allctr_t *pref_allctr = get_pref_allctr(extra);
+
+ return realloc_thr_pref(type, pref_allctr, p, size, 0);
+ }
+
+ return erts_alcu_alloc_thr_pref(type, extra, size);
}
void *
erts_alcu_realloc_mv_thr_pref(ErtsAlcType_t type, void *extra,
void *p, Uint size)
{
- return realloc_thr_pref(type, extra, p, size, 1);
+ if (p) {
+ Allctr_t *pref_allctr = get_pref_allctr(extra);
+
+ return realloc_thr_pref(type, pref_allctr, p, size, 1);
+ }
+
+ return erts_alcu_alloc_thr_pref(type, extra, size);
}
@@ -6071,6 +6285,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
allctr->t = 0;
allctr->ramv = init->ramv;
+ allctr->atags = init->atags;
allctr->main_carrier_size = init->mmbcs;
#if HAVE_ERTS_MSEG
@@ -6320,6 +6535,1072 @@ erts_alcu_init(AlcUInit_t *init)
initialized = 1;
}
+/* ------------------------------------------------------------------------- */
+
+/* Allocation histograms and carrier information is gathered by walking through
+ * all carriers associated with each allocator instance. This is done as
+ * aux_yield_work on the scheduler that owns each instance.
+ *
+ * Yielding is implemented by temporarily inserting a "dummy carrier" at the
+ * last position. It's permanently "busy" so it won't get picked up by someone
+ * else when in the carrier pool, and we never make the employer aware of it
+ * through callbacks so we can't accidentally allocate on it.
+ *
+ * Plain malloc/free is used to guarantee we won't allocate with the allocator
+ * we're scanning. */
+
+/* Yield between carriers once this many blocks have been processed. Note that
+ * a single carrier scan may exceed this figure. */
+#ifndef DEBUG
+ #define BLOCKSCAN_REDUCTIONS (8000)
+#else
+ #define BLOCKSCAN_REDUCTIONS (400)
+#endif
+
+/* Abort a single carrier scan after this many blocks to prevent really large
+ * MBCs from blocking forever. */
+#define BLOCKSCAN_BAILOUT_THRESHOLD (16000)
+
+typedef struct alcu_blockscan {
+ /* A per-scheduler list used when multiple scans have been queued. The
+ * current scanner will always run until completion/abort before moving on
+ * to the next. */
+ struct alcu_blockscan *scanner_queue;
+
+ Allctr_t *allocator;
+ Process *process;
+
+ int (*current_op)(struct alcu_blockscan *scanner);
+ int (*next_op)(struct alcu_blockscan *scanner);
+ int reductions;
+
+ ErtsAlcCPoolData_t *cpool_cursor;
+ CarrierList_t *current_clist;
+ Carrier_t *clist_cursor;
+ Carrier_t dummy_carrier;
+
+ /* Called if the process that started this job dies before we're done. */
+ void (*abort)(void *user_data);
+
+ /* Called on each carrier. The callback must return the number of blocks
+ * scanned to yield properly between carriers.
+ *
+ * Note that it's not possible to "yield back" into a carrier. */
+ int (*scan)(Allctr_t *, void *user_data, Carrier_t *);
+
+ /* Called when all carriers have been scanned. The callback may return
+ * non-zero to yield. */
+ int (*finish)(void *user_data);
+
+ void *user_data;
+} blockscan_t;
+
+static Carrier_t *blockscan_restore_clist_cursor(blockscan_t *state)
+{
+ Carrier_t *cursor = state->clist_cursor;
+
+ ASSERT(state->clist_cursor == (state->current_clist)->first ||
+ state->clist_cursor == &state->dummy_carrier);
+
+ if (cursor == &state->dummy_carrier) {
+ cursor = cursor->next;
+
+ unlink_carrier(state->current_clist, state->clist_cursor);
+ }
+
+ return cursor;
+}
+
+static void blockscan_save_clist_cursor(blockscan_t *state, Carrier_t *after)
+{
+ ASSERT(state->clist_cursor == (state->current_clist)->first ||
+ state->clist_cursor == &state->dummy_carrier);
+
+ state->clist_cursor = &state->dummy_carrier;
+
+ (state->clist_cursor)->next = after->next;
+ (state->clist_cursor)->prev = after;
+
+ relink_carrier(state->current_clist, state->clist_cursor);
+}
+
+static int blockscan_clist_yielding(blockscan_t *state)
+{
+ Carrier_t *cursor = blockscan_restore_clist_cursor(state);
+
+ if (ERTS_PROC_IS_EXITING(state->process)) {
+ return 0;
+ }
+
+ while (cursor) {
+ /* Skip dummy carriers inserted by another (concurrent) block scan.
+ * This can happen when scanning thread-safe allocators from multiple
+ * schedulers. */
+ if (CARRIER_SZ(cursor) > 0) {
+ int blocks_scanned = state->scan(state->allocator,
+ state->user_data,
+ cursor);
+
+ state->reductions -= blocks_scanned;
+
+ if (state->reductions <= 0) {
+ blockscan_save_clist_cursor(state, cursor);
+ return 1;
+ }
+ }
+
+ cursor = cursor->next;
+ }
+
+ return 0;
+}
+
+static ErtsAlcCPoolData_t *blockscan_restore_cpool_cursor(blockscan_t *state)
+{
+ ErtsAlcCPoolData_t *cursor;
+
+ cursor = cpool_aint2cpd(cpool_read(&(state->cpool_cursor)->next));
+
+ if (state->cpool_cursor == &state->dummy_carrier.cpool) {
+ cpool_delete(state->allocator, state->allocator, &state->dummy_carrier);
+ }
+
+ return cursor;
+}
+
+static void blockscan_save_cpool_cursor(blockscan_t *state,
+ ErtsAlcCPoolData_t *after)
+{
+ ErtsAlcCPoolData_t *dummy_carrier, *prev_carrier, *next_carrier;
+
+ dummy_carrier = &state->dummy_carrier.cpool;
+
+ next_carrier = cpool_aint2cpd(cpool_mod_mark(&after->next));
+ prev_carrier = cpool_aint2cpd(cpool_mod_mark(&next_carrier->prev));
+
+ cpool_init(&dummy_carrier->next, (erts_aint_t)next_carrier);
+ cpool_init(&dummy_carrier->prev, (erts_aint_t)prev_carrier);
+
+ cpool_set_mod_marked(&prev_carrier->next,
+ (erts_aint_t)dummy_carrier,
+ (erts_aint_t)next_carrier);
+ cpool_set_mod_marked(&next_carrier->prev,
+ (erts_aint_t)dummy_carrier,
+ (erts_aint_t)prev_carrier);
+
+ state->cpool_cursor = dummy_carrier;
+}
+
+static int blockscan_cpool_yielding(blockscan_t *state)
+{
+ ErtsAlcCPoolData_t *sentinel, *cursor;
+
+ sentinel = &carrier_pool[(state->allocator)->alloc_no].sentinel;
+ cursor = blockscan_restore_cpool_cursor(state);
+
+ if (ERTS_PROC_IS_EXITING(state->process)) {
+ return 0;
+ }
+
+ while (cursor != sentinel) {
+ Carrier_t *carrier;
+ erts_aint_t exp;
+
+ /* When a deallocation happens on a pooled carrier it will be routed to
+ * its owner, so the only way to be sure that it isn't modified while
+ * scanning is to skip all carriers that aren't ours. The deallocations
+ * deferred to us will get handled when we're done. */
+ while (cursor->orig_allctr != state->allocator) {
+ cursor = cpool_aint2cpd(cpool_read(&cursor->next));
+
+ if (cursor == sentinel) {
+ return 0;
+ }
+ }
+
+ carrier = ErtsContainerStruct(cursor, Carrier_t, cpool);
+ exp = erts_atomic_read_rb(&carrier->allctr);
+
+ if (exp & ERTS_CRR_ALCTR_FLG_IN_POOL) {
+ ASSERT(state->allocator == (Allctr_t*)(exp & ~ERTS_CRR_ALCTR_FLG_MASK));
+ ASSERT(!(exp & ERTS_CRR_ALCTR_FLG_BUSY));
+
+ if (erts_atomic_cmpxchg_acqb(&carrier->allctr,
+ exp | ERTS_CRR_ALCTR_FLG_BUSY,
+ exp) == exp) {
+ /* Skip dummy carriers inserted by another (concurrent) block
+ * scan. This can happen when scanning thread-safe allocators
+ * from multiple schedulers. */
+ if (CARRIER_SZ(carrier) > 0) {
+ int blocks_scanned = state->scan(state->allocator,
+ state->user_data,
+ carrier);
+
+ state->reductions -= blocks_scanned;
+
+ if (state->reductions <= 0) {
+ blockscan_save_cpool_cursor(state, cursor);
+ erts_atomic_set_relb(&carrier->allctr, exp);
+
+ return 1;
+ }
+ }
+
+ erts_atomic_set_relb(&carrier->allctr, exp);
+ }
+ }
+
+ cursor = cpool_aint2cpd(cpool_read(&cursor->next));
+ }
+
+ return 0;
+}
+
+static int blockscan_yield_helper(blockscan_t *state,
+ int (*yielding_op)(blockscan_t*))
+{
+ /* Note that we don't check whether to abort here; only yielding_op knows
+ * whether the carrier is still in the list/pool. */
+
+ if ((state->allocator)->thread_safe) {
+ /* Locked scans have to be as short as possible. */
+ state->reductions = 1;
+
+ erts_mtx_lock(&(state->allocator)->mutex);
+ } else {
+ state->reductions = BLOCKSCAN_REDUCTIONS;
+ }
+
+ if (yielding_op(state)) {
+ state->next_op = state->current_op;
+ }
+
+ if ((state->allocator)->thread_safe) {
+ erts_mtx_unlock(&(state->allocator)->mutex);
+ }
+
+ return 1;
+}
+
+/* */
+
+static int blockscan_finish(blockscan_t *state)
+{
+ if (ERTS_PROC_IS_EXITING(state->process)) {
+ state->abort(state->user_data);
+ return 0;
+ }
+
+ state->current_op = blockscan_finish;
+
+ return state->finish(state->user_data);
+}
+
+static int blockscan_sweep_sbcs(blockscan_t *state)
+{
+ if (state->current_op != blockscan_sweep_sbcs) {
+ SET_CARRIER_HDR(&state->dummy_carrier, 0, SCH_SBC, state->allocator);
+ state->current_clist = &(state->allocator)->sbc_list;
+ state->clist_cursor = (state->current_clist)->first;
+ }
+
+ state->current_op = blockscan_sweep_sbcs;
+ state->next_op = blockscan_finish;
+
+ return blockscan_yield_helper(state, blockscan_clist_yielding);
+}
+
+static int blockscan_sweep_mbcs(blockscan_t *state)
+{
+ if (state->current_op != blockscan_sweep_mbcs) {
+ SET_CARRIER_HDR(&state->dummy_carrier, 0, SCH_MBC, state->allocator);
+ state->current_clist = &(state->allocator)->mbc_list;
+ state->clist_cursor = (state->current_clist)->first;
+ }
+
+ state->current_op = blockscan_sweep_mbcs;
+ state->next_op = blockscan_sweep_sbcs;
+
+ return blockscan_yield_helper(state, blockscan_clist_yielding);
+}
+
+static int blockscan_sweep_cpool(blockscan_t *state)
+{
+ if (state->current_op != blockscan_sweep_cpool) {
+ ErtsAlcCPoolData_t *sentinel;
+
+ SET_CARRIER_HDR(&state->dummy_carrier, 0, SCH_MBC, state->allocator);
+ sentinel = &carrier_pool[(state->allocator)->alloc_no].sentinel;
+ state->cpool_cursor = sentinel;
+ }
+
+ state->current_op = blockscan_sweep_cpool;
+ state->next_op = blockscan_sweep_mbcs;
+
+ return blockscan_yield_helper(state, blockscan_cpool_yielding);
+}
+
+static int blockscan_get_specific_allocator(int allocator_num,
+ int sched_id,
+ Allctr_t **out)
+{
+ ErtsAllocatorInfo_t *ai;
+ Allctr_t *allocator;
+
+ ASSERT(allocator_num >= ERTS_ALC_A_MIN &&
+ allocator_num <= ERTS_ALC_A_MAX);
+ ASSERT(sched_id >= 0 && sched_id <= erts_no_schedulers);
+
+ ai = &erts_allctrs_info[allocator_num];
+
+ if (!ai->enabled || !ai->alloc_util) {
+ return 0;
+ }
+
+ if (!ai->thr_spec) {
+ if (sched_id != 0) {
+ /* Only thread-specific allocators can be scanned on a specific
+ * scheduler. */
+ return 0;
+ }
+
+ allocator = (Allctr_t*)ai->extra;
+ ASSERT(allocator->thread_safe);
+ } else {
+ ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t*)ai->extra;
+
+ ASSERT(sched_id < tspec->size);
+
+ allocator = tspec->allctr[sched_id];
+ }
+
+ *out = allocator;
+
+ return 1;
+}
+
+static void blockscan_sched_trampoline(void *arg)
+{
+ ErtsAlcuBlockscanYieldData *yield;
+ ErtsSchedulerData *esdp;
+ blockscan_t *scanner;
+
+ esdp = erts_get_scheduler_data();
+ scanner = (blockscan_t*)arg;
+
+ yield = ERTS_SCHED_AUX_YIELD_DATA(esdp, alcu_blockscan);
+
+ ASSERT((yield->last == NULL) == (yield->current == NULL));
+
+ if (yield->last != NULL) {
+ blockscan_t *prev_scanner = yield->last;
+
+ ASSERT(prev_scanner->scanner_queue == NULL);
+
+ prev_scanner->scanner_queue = scanner;
+ } else {
+ yield->current = scanner;
+ }
+
+ scanner->scanner_queue = NULL;
+ yield->last = scanner;
+
+ erts_notify_new_aux_yield_work(esdp);
+}
+
+static void blockscan_dispatch(blockscan_t *scanner, Process *owner,
+ Allctr_t *allocator, int sched_id)
+{
+ ASSERT(erts_get_scheduler_id() != 0);
+
+ if (sched_id == 0) {
+ /* Global instances are always handled on the current scheduler. */
+ sched_id = ERTS_ALC_GET_THR_IX();
+ ASSERT(allocator->thread_safe);
+ }
+
+ scanner->allocator = allocator;
+ scanner->process = owner;
+
+ erts_proc_inc_refc(scanner->process);
+
+ cpool_init_carrier_data(scanner->allocator, &scanner->dummy_carrier);
+ erts_atomic_init_nob(&(scanner->dummy_carrier).allctr,
+ (erts_aint_t)allocator | ERTS_CRR_ALCTR_FLG_BUSY);
+
+ if (ERTS_ALC_IS_CPOOL_ENABLED(scanner->allocator)) {
+ scanner->next_op = blockscan_sweep_cpool;
+ } else {
+ scanner->next_op = blockscan_sweep_mbcs;
+ }
+
+ /* Aux yield jobs can only be set up while running on the scheduler that
+ * services them, so we move there before continuing.
+ *
+ * We can't drive the scan itself through this since the scheduler will
+ * always finish *all* misc aux work in one go which makes it impossible to
+ * yield. */
+ erts_schedule_misc_aux_work(sched_id, blockscan_sched_trampoline, scanner);
+}
+
+int erts_handle_yielded_alcu_blockscan(ErtsSchedulerData *esdp,
+ ErtsAlcuBlockscanYieldData *yield)
+{
+ blockscan_t *scanner = yield->current;
+
+ (void)esdp;
+
+ ASSERT((yield->last == NULL) == (yield->current == NULL));
+
+ if (scanner) {
+ if (scanner->next_op(scanner)) {
+ return 1;
+ }
+
+ ASSERT(ERTS_PROC_IS_EXITING(scanner->process) ||
+ scanner->current_op == blockscan_finish);
+
+ yield->current = scanner->scanner_queue;
+
+ if (yield->current == NULL) {
+ ASSERT(scanner == yield->last);
+ yield->last = NULL;
+ }
+
+ erts_proc_dec_refc(scanner->process);
+
+ /* Plain free is intentional. */
+ free(scanner);
+
+ return yield->current != NULL;
+ }
+
+ return 0;
+}
+
+void erts_alcu_sched_spec_data_init(ErtsSchedulerData *esdp)
+{
+ ErtsAlcuBlockscanYieldData *yield;
+
+ yield = ERTS_SCHED_AUX_YIELD_DATA(esdp, alcu_blockscan);
+
+ yield->current = NULL;
+ yield->last = NULL;
+}
+
+/* ------------------------------------------------------------------------- */
+
+static ERTS_INLINE int u64_log2(Uint64 v)
+{
+ static const int log2_tab64[64] = {
+ 63, 0, 58, 1, 59, 47, 53, 2,
+ 60, 39, 48, 27, 54, 33, 42, 3,
+ 61, 51, 37, 40, 49, 18, 28, 20,
+ 55, 30, 34, 11, 43, 14, 22, 4,
+ 62, 57, 46, 52, 38, 26, 32, 41,
+ 50, 36, 17, 19, 29, 10, 13, 21,
+ 56, 45, 25, 31, 35, 16, 9, 12,
+ 44, 24, 15, 8, 23, 7, 6, 5};
+
+ v |= v >> 1;
+ v |= v >> 2;
+ v |= v >> 4;
+ v |= v >> 8;
+ v |= v >> 16;
+ v |= v >> 32;
+
+ return log2_tab64[((Uint64)((v - (v >> 1))*0x07EDD5E59A4E28C2)) >> 58];
+}
+
+/* ------------------------------------------------------------------------- */
+
+typedef struct hist_tree__ {
+ struct hist_tree__ *parent;
+ struct hist_tree__ *left;
+ struct hist_tree__ *right;
+
+ int is_red;
+
+ alcu_atag_t tag;
+ UWord histogram[1];
+} hist_tree_t;
+
+#define ERTS_RBT_PREFIX hist_tree
+#define ERTS_RBT_T hist_tree_t
+#define ERTS_RBT_KEY_T UWord
+#define ERTS_RBT_FLAGS_T int
+#define ERTS_RBT_INIT_EMPTY_TNODE(T) ((void)0)
+#define ERTS_RBT_IS_RED(T) ((T)->is_red)
+#define ERTS_RBT_SET_RED(T) ((T)->is_red = 1)
+#define ERTS_RBT_IS_BLACK(T) (!ERTS_RBT_IS_RED(T))
+#define ERTS_RBT_SET_BLACK(T) ((T)->is_red = 0)
+#define ERTS_RBT_GET_FLAGS(T) ((T)->is_red)
+#define ERTS_RBT_SET_FLAGS(T, F) ((T)->is_red = F)
+#define ERTS_RBT_GET_PARENT(T) ((T)->parent)
+#define ERTS_RBT_SET_PARENT(T, P) ((T)->parent = P)
+#define ERTS_RBT_GET_RIGHT(T) ((T)->right)
+#define ERTS_RBT_SET_RIGHT(T, R) ((T)->right = (R))
+#define ERTS_RBT_GET_LEFT(T) ((T)->left)
+#define ERTS_RBT_SET_LEFT(T, L) ((T)->left = (L))
+#define ERTS_RBT_GET_KEY(T) ((T)->tag)
+#define ERTS_RBT_IS_LT(KX, KY) (KX < KY)
+#define ERTS_RBT_IS_EQ(KX, KY) (KX == KY)
+#define ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING
+#define ERTS_RBT_WANT_FOREACH_DESTROY
+#define ERTS_RBT_WANT_INSERT
+#define ERTS_RBT_WANT_LOOKUP
+#define ERTS_RBT_UNDEF
+
+#include "erl_rbtree.h"
+
+typedef struct {
+ blockscan_t common;
+
+ ErtsIRefStorage iref;
+ Process *process;
+
+ hist_tree_rbt_yield_state_t hist_tree_yield;
+ hist_tree_t *hist_tree;
+ UWord hist_count;
+
+ UWord hist_slot_start;
+ int hist_slot_count;
+
+ UWord unscanned_size;
+
+ ErtsHeapFactory msg_factory;
+ int building_result;
+ Eterm result_list;
+} gather_ahist_t;
+
+static void gather_ahist_update(gather_ahist_t *state, UWord tag, UWord size)
+{
+ hist_tree_t *hist_node;
+ UWord size_interval;
+ int hist_slot;
+
+ hist_node = hist_tree_rbt_lookup(state->hist_tree, tag);
+
+ if (hist_node == NULL) {
+ /* Plain calloc is intentional. */
+ hist_node = (hist_tree_t*)calloc(1, sizeof(hist_tree_t) +
+ (state->hist_slot_count - 1) *
+ sizeof(hist_node->histogram[0]));
+ hist_node->tag = tag;
+
+ hist_tree_rbt_insert(&state->hist_tree, hist_node);
+ state->hist_count++;
+ }
+
+ size_interval = (size / state->hist_slot_start);
+ size_interval = u64_log2(size_interval + 1);
+
+ hist_slot = MIN(size_interval, state->hist_slot_count - 1);
+
+ hist_node->histogram[hist_slot]++;
+}
+
+static int gather_ahist_scan(Allctr_t *allocator,
+ void *user_data,
+ Carrier_t *carrier)
+{
+ gather_ahist_t *state;
+ int blocks_scanned;
+ Block_t *block;
+
+ state = (gather_ahist_t*)user_data;
+ blocks_scanned = 1;
+
+ if (IS_SB_CARRIER(carrier)) {
+ alcu_atag_t tag;
+
+ block = SBC2BLK(allocator, carrier);
+ tag = GET_BLK_ATAG(block);
+
+ ASSERT(DBG_IS_VALID_ATAG(allocator, tag));
+
+ gather_ahist_update(state, tag, SBC_BLK_SZ(block));
+ } else {
+ UWord scanned_bytes = MBC_HEADER_SIZE(allocator);
+
+ ASSERT(IS_MB_CARRIER(carrier));
+
+ block = MBC_TO_FIRST_BLK(allocator, carrier);
+
+ while (1) {
+ UWord block_size = MBC_BLK_SZ(block);
+
+ if (IS_ALLOCED_BLK(block)) {
+ alcu_atag_t tag = GET_BLK_ATAG(block);
+
+ ASSERT(DBG_IS_VALID_ATAG(allocator, tag));
+
+ gather_ahist_update(state, tag, block_size);
+ }
+
+ scanned_bytes += block_size;
+
+ if (blocks_scanned >= BLOCKSCAN_BAILOUT_THRESHOLD) {
+ state->unscanned_size += CARRIER_SZ(carrier) - scanned_bytes;
+ break;
+ } else if (IS_LAST_BLK(block)) {
+ break;
+ }
+
+ block = NXT_BLK(block);
+ blocks_scanned++;
+ }
+ }
+
+ return blocks_scanned;
+}
+
+static void gather_ahist_append_result(hist_tree_t *node, void *arg)
+{
+ gather_ahist_t *state = (gather_ahist_t*)arg;
+
+ Eterm histogram_tuple, tag_tuple;
+
+ Eterm *hp;
+ int ix;
+
+ ASSERT(state->building_result);
+
+ hp = erts_produce_heap(&state->msg_factory, 7 + state->hist_slot_count, 0);
+
+ hp[0] = make_arityval(state->hist_slot_count);
+
+ for (ix = 0; ix < state->hist_slot_count; ix++) {
+ hp[1 + ix] = make_small(node->histogram[ix]);
+ }
+
+ histogram_tuple = make_tuple(hp);
+ hp += 1 + state->hist_slot_count;
+
+ hp[0] = make_arityval(3);
+ hp[1] = ATAG_ID(node->tag);
+ hp[2] = alloc_type_atoms[ATAG_TYPE(node->tag)];
+ hp[3] = histogram_tuple;
+
+ tag_tuple = make_tuple(hp);
+ hp += 4;
+
+ state->result_list = CONS(hp, tag_tuple, state->result_list);
+
+ /* Plain free is intentional. */
+ free(node);
+}
+
+static void gather_ahist_send(gather_ahist_t *state)
+{
+ Eterm result_tuple, unscanned_size, task_ref;
+
+ Uint term_size;
+ Eterm *hp;
+
+ ASSERT((state->result_list == NIL) ^ (state->hist_count > 0));
+ ASSERT(state->building_result);
+
+ term_size = 4 + erts_iref_storage_heap_size(&state->iref);
+ term_size += IS_USMALL(0, state->unscanned_size) ? 0 : BIG_UINT_HEAP_SIZE;
+
+ hp = erts_produce_heap(&state->msg_factory, term_size, 0);
+
+ task_ref = erts_iref_storage_make_ref(&state->iref, &hp,
+ &(state->msg_factory.message)->hfrag.off_heap, 0);
+
+ unscanned_size = bld_unstable_uint(&hp, NULL, state->unscanned_size);
+
+ hp[0] = make_arityval(3);
+ hp[1] = task_ref;
+ hp[2] = unscanned_size;
+ hp[3] = state->result_list;
+
+ result_tuple = make_tuple(hp);
+
+ erts_factory_trim_and_close(&state->msg_factory, &result_tuple, 1);
+
+ erts_queue_message(state->process, 0, state->msg_factory.message,
+ result_tuple, am_system);
+}
+
+static int gather_ahist_finish(void *arg)
+{
+ gather_ahist_t *state = (gather_ahist_t*)arg;
+
+ if (!state->building_result) {
+ ErtsMessage *message;
+ Uint minimum_size;
+ Eterm *hp;
+
+ /* {Ref, unscanned size, [{Tag, {Histogram}} | Rest]} */
+ minimum_size = 4 + erts_iref_storage_heap_size(&state->iref) +
+ state->hist_count * (7 + state->hist_slot_count);
+
+ message = erts_alloc_message(minimum_size, &hp);
+ erts_factory_selfcontained_message_init(&state->msg_factory,
+ message, hp);
+
+ ERTS_RBT_YIELD_STAT_INIT(&state->hist_tree_yield);
+
+ state->result_list = NIL;
+ state->building_result = 1;
+ }
+
+ if (hist_tree_rbt_foreach_destroy_yielding(&state->hist_tree,
+ &gather_ahist_append_result,
+ state,
+ &state->hist_tree_yield,
+ BLOCKSCAN_REDUCTIONS)) {
+ return 1;
+ }
+
+ gather_ahist_send(state);
+
+ return 0;
+}
+
+static void gather_ahist_destroy_result(hist_tree_t *node, void *arg)
+{
+ (void)arg;
+ free(node);
+}
+
+static void gather_ahist_abort(void *arg)
+{
+ gather_ahist_t *state = (gather_ahist_t*)arg;
+
+ if (state->building_result) {
+ erts_factory_undo(&state->msg_factory);
+ }
+
+ hist_tree_rbt_foreach_destroy(&state->hist_tree,
+ &gather_ahist_destroy_result,
+ NULL);
+}
+
+int erts_alcu_gather_alloc_histograms(Process *p, int allocator_num,
+ int sched_id, int hist_width,
+ UWord hist_start, Eterm ref)
+{
+ gather_ahist_t *gather_state;
+ blockscan_t *scanner;
+ Allctr_t *allocator;
+
+ ASSERT(is_internal_ref(ref));
+
+ if (!blockscan_get_specific_allocator(allocator_num,
+ sched_id,
+ &allocator)) {
+ return 0;
+ } else if (!allocator->atags) {
+ return 0;
+ }
+
+ ensure_atoms_initialized(allocator);
+
+ /* Plain calloc is intentional. */
+ gather_state = (gather_ahist_t*)calloc(1, sizeof(gather_ahist_t));
+ scanner = &gather_state->common;
+
+ scanner->abort = gather_ahist_abort;
+ scanner->scan = gather_ahist_scan;
+ scanner->finish = gather_ahist_finish;
+ scanner->user_data = gather_state;
+
+ erts_iref_storage_save(&gather_state->iref, ref);
+ gather_state->hist_slot_start = hist_start;
+ gather_state->hist_slot_count = hist_width;
+ gather_state->process = p;
+
+ blockscan_dispatch(scanner, p, allocator, sched_id);
+
+ return 1;
+}
+
+/* ------------------------------------------------------------------------- */
+
+typedef struct chist_node__ {
+ struct chist_node__ *next;
+
+ UWord carrier_size;
+ UWord unscanned_size;
+ UWord allocated_size;
+
+ /* BLOCKSCAN_BAILOUT_THRESHOLD guarantees we won't overflow this or the
+ * counters in the free block histogram. */
+ int allocated_count;
+ int flags;
+
+ int histogram[1];
+} chist_node_t;
+
+typedef struct {
+ blockscan_t common;
+
+ ErtsIRefStorage iref;
+ Process *process;
+
+ Eterm allocator_desc;
+
+ chist_node_t *info_list;
+ UWord info_count;
+
+ UWord hist_slot_start;
+ int hist_slot_count;
+
+ ErtsHeapFactory msg_factory;
+ int building_result;
+ Eterm result_list;
+} gather_cinfo_t;
+
+static int gather_cinfo_scan(Allctr_t *allocator,
+ void *user_data,
+ Carrier_t *carrier)
+{
+ gather_cinfo_t *state;
+ chist_node_t *node;
+ int blocks_scanned;
+ Block_t *block;
+
+ state = (gather_cinfo_t*)user_data;
+ node = calloc(1, sizeof(chist_node_t) +
+ (state->hist_slot_count - 1) *
+ sizeof(node->histogram[0]));
+ blocks_scanned = 1;
+
+ /* ERTS_CRR_ALCTR_FLG_BUSY is ignored since we've set it ourselves and it
+ * would be misleading to include it. */
+ node->flags = erts_atomic_read_rb(&carrier->allctr) &
+ (ERTS_CRR_ALCTR_FLG_MASK & ~ERTS_CRR_ALCTR_FLG_BUSY);
+ node->carrier_size = CARRIER_SZ(carrier);
+
+ if (IS_SB_CARRIER(carrier)) {
+ UWord block_size;
+
+ block = SBC2BLK(allocator, carrier);
+ block_size = SBC_BLK_SZ(block);
+
+ node->allocated_size = block_size;
+ node->allocated_count = 1;
+ } else {
+ UWord scanned_bytes = MBC_HEADER_SIZE(allocator);
+
+ block = MBC_TO_FIRST_BLK(allocator, carrier);
+
+ while (1) {
+ UWord block_size = MBC_BLK_SZ(block);
+
+ scanned_bytes += block_size;
+
+ if (IS_ALLOCED_BLK(block)) {
+ node->allocated_size += block_size;
+ node->allocated_count++;
+ } else {
+ UWord size_interval;
+ int hist_slot;
+
+ size_interval = (block_size / state->hist_slot_start);
+ size_interval = u64_log2(size_interval + 1);
+
+ hist_slot = MIN(size_interval, state->hist_slot_count - 1);
+
+ node->histogram[hist_slot]++;
+ }
+
+ if (blocks_scanned >= BLOCKSCAN_BAILOUT_THRESHOLD) {
+ node->unscanned_size += CARRIER_SZ(carrier) - scanned_bytes;
+ break;
+ } else if (IS_LAST_BLK(block)) {
+ break;
+ }
+
+ block = NXT_BLK(block);
+ blocks_scanned++;
+ }
+ }
+
+ node->next = state->info_list;
+ state->info_list = node;
+ state->info_count++;
+
+ return blocks_scanned;
+}
+
+static void gather_cinfo_append_result(gather_cinfo_t *state,
+ chist_node_t *info)
+{
+ Eterm carrier_size, unscanned_size, allocated_size;
+ Eterm histogram_tuple, carrier_tuple;
+
+ Uint term_size;
+ Eterm *hp;
+ int ix;
+
+ ASSERT(state->building_result);
+
+ term_size = 11 + state->hist_slot_count;
+ term_size += IS_USMALL(0, info->carrier_size) ? 0 : BIG_UINT_HEAP_SIZE;
+ term_size += IS_USMALL(0, info->unscanned_size) ? 0 : BIG_UINT_HEAP_SIZE;
+ term_size += IS_USMALL(0, info->allocated_size) ? 0 : BIG_UINT_HEAP_SIZE;
+
+ hp = erts_produce_heap(&state->msg_factory, term_size, 0);
+
+ hp[0] = make_arityval(state->hist_slot_count);
+
+ for (ix = 0; ix < state->hist_slot_count; ix++) {
+ hp[1 + ix] = make_small(info->histogram[ix]);
+ }
+
+ histogram_tuple = make_tuple(hp);
+ hp += 1 + state->hist_slot_count;
+
+ carrier_size = bld_unstable_uint(&hp, NULL, info->carrier_size);
+ unscanned_size = bld_unstable_uint(&hp, NULL, info->unscanned_size);
+ allocated_size = bld_unstable_uint(&hp, NULL, info->allocated_size);
+
+ hp[0] = make_arityval(7);
+ hp[1] = state->allocator_desc;
+ hp[2] = carrier_size;
+ hp[3] = unscanned_size;
+ hp[4] = allocated_size;
+ hp[5] = make_small(info->allocated_count);
+ hp[6] = (info->flags & ERTS_CRR_ALCTR_FLG_IN_POOL) ? am_true : am_false;
+ hp[7] = histogram_tuple;
+
+ carrier_tuple = make_tuple(hp);
+ hp += 8;
+
+ state->result_list = CONS(hp, carrier_tuple, state->result_list);
+
+ free(info);
+}
+
+static void gather_cinfo_send(gather_cinfo_t *state)
+{
+ Eterm result_tuple, task_ref;
+
+ int term_size;
+ Eterm *hp;
+
+ ASSERT((state->result_list == NIL) ^ (state->info_count > 0));
+ ASSERT(state->building_result);
+
+ term_size = 3 + erts_iref_storage_heap_size(&state->iref);
+ hp = erts_produce_heap(&state->msg_factory, term_size, 0);
+
+ task_ref = erts_iref_storage_make_ref(&state->iref, &hp,
+ &(state->msg_factory.message)->hfrag.off_heap, 0);
+
+ hp[0] = make_arityval(2);
+ hp[1] = task_ref;
+ hp[2] = state->result_list;
+
+ result_tuple = make_tuple(hp);
+
+ erts_factory_trim_and_close(&state->msg_factory, &result_tuple, 1);
+
+ erts_queue_message(state->process, 0, state->msg_factory.message,
+ result_tuple, am_system);
+}
+
+static int gather_cinfo_finish(void *arg)
+{
+ gather_cinfo_t *state = (gather_cinfo_t*)arg;
+ int reductions = BLOCKSCAN_REDUCTIONS;
+
+ if (!state->building_result) {
+ ErtsMessage *message;
+ Uint minimum_size;
+ Eterm *hp;
+
+ /* {Ref, [{Carrier size, unscanned size, allocated size,
+ * allocated block count, {Free block histogram}} | Rest]} */
+ minimum_size = 3 + erts_iref_storage_heap_size(&state->iref) +
+ state->info_count * (11 + state->hist_slot_count);
+
+ message = erts_alloc_message(minimum_size, &hp);
+ erts_factory_selfcontained_message_init(&state->msg_factory,
+ message, hp);
+
+ state->result_list = NIL;
+ state->building_result = 1;
+ }
+
+ while (state->info_list) {
+ chist_node_t *current = state->info_list;
+ state->info_list = current->next;
+
+ gather_cinfo_append_result(state, current);
+
+ if (reductions-- <= 0) {
+ return 1;
+ }
+ }
+
+ gather_cinfo_send(state);
+
+ return 0;
+}
+
+static void gather_cinfo_abort(void *arg)
+{
+ gather_cinfo_t *state = (gather_cinfo_t*)arg;
+
+ if (state->building_result) {
+ erts_factory_undo(&state->msg_factory);
+ }
+
+ while (state->info_list) {
+ chist_node_t *current = state->info_list;
+ state->info_list = current->next;
+
+ free(current);
+ }
+}
+
+int erts_alcu_gather_carrier_info(struct process *p, int allocator_num,
+ int sched_id, int hist_width,
+ UWord hist_start, Eterm ref)
+{
+ gather_cinfo_t *gather_state;
+ blockscan_t *scanner;
+
+ const char *allocator_desc;
+ Allctr_t *allocator;
+
+ ASSERT(is_internal_ref(ref));
+
+ if (!blockscan_get_specific_allocator(allocator_num,
+ sched_id,
+ &allocator)) {
+ return 0;
+ }
+
+ allocator_desc = ERTS_ALC_A2AD(allocator_num);
+
+ /* Plain calloc is intentional. */
+ gather_state = (gather_cinfo_t*)calloc(1, sizeof(gather_cinfo_t));
+ scanner = &gather_state->common;
+
+ scanner->abort = gather_cinfo_abort;
+ scanner->scan = gather_cinfo_scan;
+ scanner->finish = gather_cinfo_finish;
+ scanner->user_data = gather_state;
+
+ gather_state->allocator_desc = erts_atom_put((byte *)allocator_desc,
+ sys_strlen(allocator_desc),
+ ERTS_ATOM_ENC_LATIN1, 1);
+ erts_iref_storage_save(&gather_state->iref, ref);
+ gather_state->hist_slot_start = hist_start * 2;
+ gather_state->hist_slot_count = hist_width;
+ gather_state->process = p;
+
+ blockscan_dispatch(scanner, p, allocator, sched_id);
+
+ return 1;
+}
+
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
* NOTE: erts_alcu_test() is only supposed to be used for testing. *
@@ -6441,6 +7722,7 @@ erts_alcu_verify_unused_ts(Allctr_t *allctr)
erts_mtx_unlock(&allctr->mutex);
}
+
#ifdef DEBUG
int is_sbc_blk(Block_t* blk)
{
diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h
index 05c8a0db3b..ff4d10b206 100644
--- a/erts/emulator/beam/erl_alloc_util.h
+++ b/erts/emulator/beam/erl_alloc_util.h
@@ -50,6 +50,7 @@ typedef struct {
int tspec;
int tpref;
int ramv;
+ int atags;
UWord sbct;
UWord asbcst;
UWord rsbcst;
@@ -106,6 +107,7 @@ typedef struct {
0, /* (bool) tspec: thread specific */\
0, /* (bool) tpref: thread preferred */\
0, /* (bool) ramv: realloc always moves */\
+ 0, /* (bool) atags: tagged allocations */\
512*1024, /* (bytes) sbct: sbc threshold */\
2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\
20, /* (%) rsbcst: rel sbc shrink threshold */\
@@ -142,6 +144,7 @@ typedef struct {
0, /* (bool) tspec: thread specific */\
0, /* (bool) tpref: thread preferred */\
0, /* (bool) ramv: realloc always moves */\
+ 0, /* (bool) atags: tagged allocations */\
64*1024, /* (bytes) sbct: sbc threshold */\
2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\
20, /* (%) rsbcst: rel sbc shrink threshold */\
@@ -224,6 +227,36 @@ void erts_lcnt_update_allocator_locks(int enable);
int erts_alcu_try_set_dyn_param(Allctr_t*, Eterm param, Uint value);
+/* Gathers per-tag allocation histograms from the given allocator number
+ * (ERTS_ALC_A_*) and scheduler id. An id of 0 means the global instance will
+ * be used.
+ *
+ * The results are sent to `p`, and it returns the number of messages to wait
+ * for. */
+int erts_alcu_gather_alloc_histograms(struct process *p, int allocator_num,
+ int sched_id, int hist_width,
+ UWord hist_start, Eterm ref);
+
+/* Gathers per-carrier info from the given allocator number (ERTS_ALC_A_*) and
+ * scheduler id. An id of 0 means the global instance will be used.
+ *
+ * The results are sent to `p`, and it returns the number of messages to wait
+ * for. */
+int erts_alcu_gather_carrier_info(struct process *p, int allocator_num,
+ int sched_id, int hist_width,
+ UWord hist_start, Eterm ref);
+
+struct alcu_blockscan;
+
+typedef struct {
+ struct alcu_blockscan *current;
+ struct alcu_blockscan *last;
+} ErtsAlcuBlockscanYieldData;
+
+int erts_handle_yielded_alcu_blockscan(struct ErtsSchedulerData_ *esdp,
+ ErtsAlcuBlockscanYieldData *yield);
+void erts_alcu_sched_spec_data_init(struct ErtsSchedulerData_ *esdp);
+
#endif /* !ERL_ALLOC_UTIL__ */
#if defined(GET_ERL_ALLOC_UTIL_IMPL) && !defined(ERL_ALLOC_UTIL_IMPL__)
@@ -548,6 +581,7 @@ struct Allctr_t_ {
/* Options */
int t;
int ramv;
+ int atags;
Uint sbc_threshold;
Uint sbc_move_threshold;
Uint mbc_move_threshold;
@@ -684,6 +718,7 @@ struct Allctr_t_ {
#endif
};
+
int erts_alcu_start(Allctr_t *, AllctrInit_t *);
void erts_alcu_stop(Allctr_t *);
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index bdca93428e..8687aefd78 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -38,7 +38,7 @@
#include "erl_message.h"
#include "erl_binary.h"
#include "erl_db.h"
-#include "erl_instrument.h"
+#include "erl_mtrace.h"
#include "dist.h"
#include "erl_gc.h"
#include "erl_cpu_topology.h"
@@ -51,6 +51,7 @@
#include "erl_ptab.h"
#include "erl_time.h"
#include "erl_proc_sig_queue.h"
+#include "erl_alloc_util.h"
#ifdef HIPE
#include "hipe_arch.h"
#endif
@@ -155,8 +156,10 @@ static Eterm os_type_tuple;
static Eterm os_version_tuple;
static Eterm
-current_function(Process* p, Process* rp, Eterm** hpp, int full_info);
-static Eterm current_stacktrace(Process* p, Process* rp, Eterm** hpp);
+current_function(Process* p, ErtsHeapFactory *hfact, Process* rp,
+ int full_info, Uint reserve_size, int flags);
+static Eterm current_stacktrace(ErtsHeapFactory *hfact, Process* rp,
+ Uint reserve_size);
static Eterm
bld_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh)
@@ -693,119 +696,222 @@ collect_one_suspend_monitor(ErtsMonitor *mon, void *vsmicp)
* process_info/[1,2]
*/
-#define ERTS_PI_FAIL_TYPE_BADARG 0
-#define ERTS_PI_FAIL_TYPE_YIELD 1
-#define ERTS_PI_FAIL_TYPE_EXITED 2
-
-static ERTS_INLINE ErtsProcLocks
-pi_locks(Eterm info)
-{
- switch (info) {
- case am_priority:
- case am_status:
- return 0;
- case am_suspended:
- return ERTS_PROC_LOCK_STATUS;
- case am_messages:
- case am_message_queue_len:
- case am_total_heap_size:
- return ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_MSGQ;
- default:
- return ERTS_PROC_LOCK_MAIN;
- }
-}
-
/*
* All valid process_info arguments.
*/
-static Eterm pi_args[] = {
- am_registered_name,
- am_current_function,
- am_initial_call,
- am_status,
- am_messages,
- am_message_queue_len,
- am_links,
- am_monitors,
- am_monitored_by,
- am_dictionary,
- am_trap_exit,
- am_error_handler,
- am_heap_size,
- am_stack_size,
- am_memory,
- am_garbage_collection,
- am_group_leader,
- am_reductions,
- am_priority,
- am_trace,
- am_binary,
- am_sequential_trace_token,
- am_catchlevel,
- am_backtrace,
- am_last_calls,
- am_total_heap_size,
- am_suspending,
- am_min_heap_size,
- am_min_bin_vheap_size,
- am_max_heap_size,
- am_current_location,
- am_current_stacktrace,
- am_message_queue_data,
- am_garbage_collection_info,
- am_magic_ref
+
+#define ERTS_PI_IX_REGISTERED_NAME 0
+#define ERTS_PI_IX_CURRENT_FUNCTION 1
+#define ERTS_PI_IX_INITIAL_CALL 2
+#define ERTS_PI_IX_STATUS 3
+#define ERTS_PI_IX_MESSAGES 4
+#define ERTS_PI_IX_MESSAGE_QUEUE_LEN 5
+#define ERTS_PI_IX_LINKS 6
+#define ERTS_PI_IX_MONITORS 7
+#define ERTS_PI_IX_MONITORED_BY 8
+#define ERTS_PI_IX_DICTIONARY 9
+#define ERTS_PI_IX_TRAP_EXIT 10
+#define ERTS_PI_IX_ERROR_HANDLER 11
+#define ERTS_PI_IX_HEAP_SIZE 12
+#define ERTS_PI_IX_STACK_SIZE 13
+#define ERTS_PI_IX_MEMORY 14
+#define ERTS_PI_IX_GARBAGE_COLLECTION 15
+#define ERTS_PI_IX_GROUP_LEADER 16
+#define ERTS_PI_IX_REDUCTIONS 17
+#define ERTS_PI_IX_PRIORITY 18
+#define ERTS_PI_IX_TRACE 19
+#define ERTS_PI_IX_BINARY 20
+#define ERTS_PI_IX_SEQUENTIAL_TRACE_TOKEN 21
+#define ERTS_PI_IX_CATCHLEVEL 22
+#define ERTS_PI_IX_BACKTRACE 23
+#define ERTS_PI_IX_LAST_CALLS 24
+#define ERTS_PI_IX_TOTAL_HEAP_SIZE 25
+#define ERTS_PI_IX_SUSPENDING 26
+#define ERTS_PI_IX_MIN_HEAP_SIZE 27
+#define ERTS_PI_IX_MIN_BIN_VHEAP_SIZE 28
+#define ERTS_PI_IX_MAX_HEAP_SIZE 29
+#define ERTS_PI_IX_CURRENT_LOCATION 30
+#define ERTS_PI_IX_CURRENT_STACKTRACE 31
+#define ERTS_PI_IX_MESSAGE_QUEUE_DATA 32
+#define ERTS_PI_IX_GARBAGE_COLLECTION_INFO 33
+#define ERTS_PI_IX_MAGIC_REF 34
+#define ERTS_PI_IX_FULLSWEEP_AFTER 35
+
+#define ERTS_PI_FLAG_SINGELTON (1 << 0)
+#define ERTS_PI_FLAG_ALWAYS_WRAP (1 << 1)
+#define ERTS_PI_FLAG_WANT_MSGS (1 << 2)
+#define ERTS_PI_FLAG_NEED_MSGQ_LEN (1 << 3)
+#define ERTS_PI_FLAG_FORCE_SIG_SEND (1 << 4)
+#define ERTS_PI_FLAG_REQUEST_FOR_OTHER (1 << 5)
+
+#define ERTS_PI_UNRESERVE(RS, SZ) \
+ (ASSERT((RS) >= (SZ)), (RS) -= (SZ))
+
+
+typedef struct {
+ Eterm name;
+ Uint reserve_size;
+ int flags;
+ ErtsProcLocks locks;
+} ErtsProcessInfoArgs;
+
+static ErtsProcessInfoArgs pi_args[] = {
+ {am_registered_name, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_current_function, 4, 0, ERTS_PROC_LOCK_MAIN},
+ {am_initial_call, 4, 0, ERTS_PROC_LOCK_MAIN},
+ {am_status, 0, 0, 0},
+ {am_messages, 0, ERTS_PI_FLAG_WANT_MSGS|ERTS_PI_FLAG_NEED_MSGQ_LEN|ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_message_queue_len, 0, ERTS_PI_FLAG_NEED_MSGQ_LEN, ERTS_PROC_LOCK_MAIN},
+ {am_links, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_monitors, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_monitored_by, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_dictionary, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_trap_exit, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_error_handler, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_heap_size, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_stack_size, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_memory, 0, ERTS_PI_FLAG_NEED_MSGQ_LEN|ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_garbage_collection, 3+2 + 3+2 + 3+2 + 3+2 + 3+2 + ERTS_MAX_HEAP_SIZE_MAP_SZ, 0, ERTS_PROC_LOCK_MAIN},
+ {am_group_leader, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_reductions, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_priority, 0, 0, 0},
+ {am_trace, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_binary, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_sequential_trace_token, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_catchlevel, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_backtrace, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_last_calls, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_total_heap_size, 0, ERTS_PI_FLAG_NEED_MSGQ_LEN|ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_suspending, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, 0},
+ {am_min_heap_size, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_min_bin_vheap_size, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_max_heap_size, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_current_location, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_current_stacktrace, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_message_queue_data, 0, 0, ERTS_PROC_LOCK_MAIN},
+ {am_garbage_collection_info, ERTS_PROCESS_GC_INFO_MAX_SIZE, 0, ERTS_PROC_LOCK_MAIN},
+ {am_magic_ref, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
+ {am_fullsweep_after, 0, 0, ERTS_PROC_LOCK_MAIN}
};
-#define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(Eterm)))
+#define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(pi_args[0])))
+
+#ifdef DEBUG
+# define ERTS_PI_DEF_ARR_SZ 2
+#else
+# define ERTS_PI_DEF_ARR_SZ ERTS_PI_ARGS
+#endif
static ERTS_INLINE Eterm
pi_ix2arg(int ix)
{
if (ix < 0 || ERTS_PI_ARGS <= ix)
return am_undefined;
- return pi_args[ix];
+ return pi_args[ix].name;
+}
+
+static ERTS_INLINE int
+pi_ix2flags(int ix)
+{
+ if (ix < 0 || ERTS_PI_ARGS <= ix)
+ return 0;
+ return pi_args[ix].flags;
+}
+
+static ERTS_INLINE Uint
+pi_ix2rsz(int ix)
+{
+ if (ix < 0 || ERTS_PI_ARGS <= ix)
+ return 0;
+ return pi_args[ix].reserve_size;
+}
+
+static ERTS_INLINE ErtsProcLocks
+pi_ix2locks(int ix)
+{
+ if (ix < 0 || ERTS_PI_ARGS <= ix)
+ return 0;
+ return pi_args[ix].locks;
}
static ERTS_INLINE int
pi_arg2ix(Eterm arg)
{
switch (arg) {
- case am_registered_name: return 0;
- case am_current_function: return 1;
- case am_initial_call: return 2;
- case am_status: return 3;
- case am_messages: return 4;
- case am_message_queue_len: return 5;
- case am_links: return 6;
- case am_monitors: return 7;
- case am_monitored_by: return 8;
- case am_dictionary: return 9;
- case am_trap_exit: return 10;
- case am_error_handler: return 11;
- case am_heap_size: return 12;
- case am_stack_size: return 13;
- case am_memory: return 14;
- case am_garbage_collection: return 15;
- case am_group_leader: return 16;
- case am_reductions: return 17;
- case am_priority: return 18;
- case am_trace: return 19;
- case am_binary: return 20;
- case am_sequential_trace_token: return 21;
- case am_catchlevel: return 22;
- case am_backtrace: return 23;
- case am_last_calls: return 24;
- case am_total_heap_size: return 25;
- case am_suspending: return 26;
- case am_min_heap_size: return 27;
- case am_min_bin_vheap_size: return 28;
- case am_max_heap_size: return 29;
- case am_current_location: return 30;
- case am_current_stacktrace: return 31;
- case am_message_queue_data: return 32;
- case am_garbage_collection_info: return 33;
- case am_magic_ref: return 34;
- default: return -1;
+ case am_registered_name:
+ return ERTS_PI_IX_REGISTERED_NAME;
+ case am_current_function:
+ return ERTS_PI_IX_CURRENT_FUNCTION;
+ case am_initial_call:
+ return ERTS_PI_IX_INITIAL_CALL;
+ case am_status:
+ return ERTS_PI_IX_STATUS;
+ case am_messages:
+ return ERTS_PI_IX_MESSAGES;
+ case am_message_queue_len:
+ return ERTS_PI_IX_MESSAGE_QUEUE_LEN;
+ case am_links:
+ return ERTS_PI_IX_LINKS;
+ case am_monitors:
+ return ERTS_PI_IX_MONITORS;
+ case am_monitored_by:
+ return ERTS_PI_IX_MONITORED_BY;
+ case am_dictionary:
+ return ERTS_PI_IX_DICTIONARY;
+ case am_trap_exit:
+ return ERTS_PI_IX_TRAP_EXIT;
+ case am_error_handler:
+ return ERTS_PI_IX_ERROR_HANDLER;
+ case am_heap_size:
+ return ERTS_PI_IX_HEAP_SIZE;
+ case am_stack_size:
+ return ERTS_PI_IX_STACK_SIZE;
+ case am_memory:
+ return ERTS_PI_IX_MEMORY;
+ case am_garbage_collection:
+ return ERTS_PI_IX_GARBAGE_COLLECTION;
+ case am_group_leader:
+ return ERTS_PI_IX_GROUP_LEADER;
+ case am_reductions:
+ return ERTS_PI_IX_REDUCTIONS;
+ case am_priority:
+ return ERTS_PI_IX_PRIORITY;
+ case am_trace:
+ return ERTS_PI_IX_TRACE;
+ case am_binary:
+ return ERTS_PI_IX_BINARY;
+ case am_sequential_trace_token:
+ return ERTS_PI_IX_SEQUENTIAL_TRACE_TOKEN;
+ case am_catchlevel:
+ return ERTS_PI_IX_CATCHLEVEL;
+ case am_backtrace:
+ return ERTS_PI_IX_BACKTRACE;
+ case am_last_calls:
+ return ERTS_PI_IX_LAST_CALLS;
+ case am_total_heap_size:
+ return ERTS_PI_IX_TOTAL_HEAP_SIZE;
+ case am_suspending:
+ return ERTS_PI_IX_SUSPENDING;
+ case am_min_heap_size:
+ return ERTS_PI_IX_MIN_HEAP_SIZE;
+ case am_min_bin_vheap_size:
+ return ERTS_PI_IX_MIN_BIN_VHEAP_SIZE;
+ case am_max_heap_size:
+ return ERTS_PI_IX_MAX_HEAP_SIZE;
+ case am_current_location:
+ return ERTS_PI_IX_CURRENT_LOCATION;
+ case am_current_stacktrace:
+ return ERTS_PI_IX_CURRENT_STACKTRACE;
+ case am_message_queue_data:
+ return ERTS_PI_IX_MESSAGE_QUEUE_DATA;
+ case am_garbage_collection_info:
+ return ERTS_PI_IX_GARBAGE_COLLECTION_INFO;
+ case am_magic_ref:
+ return ERTS_PI_IX_MAGIC_REF;
+ case am_fullsweep_after:
+ return ERTS_PI_IX_FULLSWEEP_AFTER;
+ default:
+ return -1;
}
}
@@ -858,186 +964,41 @@ process_info_init(void)
}
-static ERTS_INLINE Process *
-pi_lookup_proc(Process *c_p, Eterm pid, ErtsProcLocks *locks)
-{
- /*
- * If the main lock is needed, we use erts_pid2proc_not_running()
- * instead of erts_pid2proc() for two reasons:
- * * Current function of pid and possibly other information will
- * have been updated so that process_info() is consistent with an
- * info-request/info-response signal model.
- * * We avoid blocking the whole scheduler executing the
- * process that is calling process_info() for a long time
- * which will happen if pid is currently running.
- * The caller of process_info() may have to yield if pid
- * is currently running.
- */
-
- if ((*locks) & ERTS_PROC_LOCK_MAIN) {
- erts_aint32_t state;
- int local_only, done;
- Process *rp;
- ErtsProcLocks more_locks;
-
- rp = erts_pid2proc_not_running(c_p, ERTS_PROC_LOCK_MAIN,
- pid, ERTS_PROC_LOCK_MAIN);
-
- if (!rp || rp == ERTS_PROC_LOCK_BUSY)
- return rp;
-
- if ((*locks) & ERTS_PROC_LOCK_MSGQ) {
- /*
- * Move in queue into private queue and
- * release msgq lock, enabling others to
- * send messages to the process while it
- * is being inspected...
- */
- erts_proc_lock(rp, ERTS_PROC_LOCK_MSGQ);
- erts_proc_sig_fetch(rp);
- erts_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ);
- (*locks) &= ~ERTS_PROC_LOCK_MSGQ;
- }
-
- /*
- * Handle all signals received up to this point
- * in order to preserve signal order.
- *
- * FIX ME: Should be done yielding...
- */
- local_only = 0;
- do {
- int r = CONTEXT_REDS;
- done = erts_proc_sig_handle_incoming(rp, &state, &r,
- CONTEXT_REDS,
- local_only);
- local_only = !0;
- BUMP_REDS(c_p, r);
- } while (!done && !(state & ERTS_PSFLG_EXITING));
-
- if (state & ERTS_PSFLG_EXITING) {
- if (rp != c_p)
- erts_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
- return NULL;
- }
- more_locks = (*locks) & ~ERTS_PROC_LOCK_MAIN;
- if (more_locks)
- erts_proc_lock(rp, more_locks);
- return rp;
- }
-
- ASSERT(!((*locks) & ERTS_PROC_LOCK_MSGQ));
-
- if (*locks)
- return erts_pid2proc(c_p, ERTS_PROC_LOCK_MAIN,
- pid, *locks);
-
- return erts_proc_lookup(pid);
-}
-
-
-
-
-
static BIF_RETTYPE
-process_info_aux(Process *BIF_P,
+process_info_aux(Process *c_p,
+ ErtsHeapFactory *hfact,
Process *rp,
ErtsProcLocks rp_locks,
- Eterm rpid,
- Eterm item,
- int always_wrap,
- int *reds);
-
-#define ERTS_PI_RES_ELEM_IX_BUF_INC 1024
-#define ERTS_PI_DEF_RES_ELEM_IX_BUF_SZ ERTS_PI_ARGS
+ int item_ix,
+ int flags,
+ Uint *reserve_sizep,
+ Uint *reds);
-static Eterm
-process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap,
- int *fail_type)
+Eterm
+erts_process_info(Process *c_p,
+ ErtsHeapFactory *hfact,
+ Process *rp,
+ ErtsProcLocks rp_locks,
+ int *item_ix,
+ int item_ix_len,
+ int flags,
+ Uint reserve_size,
+ Uint *reds)
{
- int want_messages = 0;
- int def_res_elem_ix_buf[ERTS_PI_DEF_RES_ELEM_IX_BUF_SZ];
- int *res_elem_ix = &def_res_elem_ix_buf[0];
- int res_elem_ix_ix = -1;
- int res_elem_ix_sz = ERTS_PI_DEF_RES_ELEM_IX_BUF_SZ;
+ Eterm res;
Eterm part_res[ERTS_PI_ARGS];
- Eterm res, arg;
- Uint *hp, *hp_end;
- ErtsProcLocks locks = (ErtsProcLocks) 0;
- int res_len, ix;
- Process *rp = NULL;
- int reds = 0;
+ int item_ix_ix, ix;
- *fail_type = ERTS_PI_FAIL_TYPE_BADARG;
+ if (ERTS_PI_FLAG_SINGELTON & flags) {
+ ASSERT(item_ix_len == 1);
+ res = process_info_aux(c_p, hfact, rp, rp_locks, item_ix[0],
+ flags, &reserve_size, reds);
+ return res;
+ }
for (ix = 0; ix < ERTS_PI_ARGS; ix++)
part_res[ix] = THE_NON_VALUE;
- ASSERT(is_list(list));
-
- while (is_list(list)) {
- Eterm* consp = list_val(list);
-
- arg = CAR(consp);
- ix = pi_arg2ix(arg);
- if (ix < 0) {
- res = THE_NON_VALUE;
- goto done;
- }
- if (arg == am_messages)
- want_messages = 1;
- locks |= pi_locks(arg);
- res_elem_ix_ix++;
- if (res_elem_ix_ix >= res_elem_ix_sz) {
- if (res_elem_ix != &def_res_elem_ix_buf[0])
- res_elem_ix =
- erts_realloc(ERTS_ALC_T_TMP,
- res_elem_ix,
- sizeof(int)*(res_elem_ix_sz
- += ERTS_PI_RES_ELEM_IX_BUF_INC));
- else {
- int new_res_elem_ix_sz = ERTS_PI_RES_ELEM_IX_BUF_INC;
- int *new_res_elem_ix = erts_alloc(ERTS_ALC_T_TMP,
- sizeof(int)*new_res_elem_ix_sz);
- sys_memcpy((void *) new_res_elem_ix,
- (void *) res_elem_ix,
- sizeof(int)*res_elem_ix_sz);
- res_elem_ix = new_res_elem_ix;
- res_elem_ix_sz = new_res_elem_ix_sz;
- }
- }
- res_elem_ix[res_elem_ix_ix] = ix;
- list = CDR(consp);
- }
- if (is_not_nil(list)) {
- res = THE_NON_VALUE;
- goto done;
- }
-
- res_len = res_elem_ix_ix+1;
-
- ASSERT(res_len > 0);
-
- rp = pi_lookup_proc(c_p, pid, &locks);
- if (!rp) {
- if (c_p->common.id != pid)
- res = am_undefined;
- else {
- *fail_type = ERTS_PI_FAIL_TYPE_EXITED;
- res = THE_NON_VALUE;
- }
- goto done;
- }
- else if (rp == ERTS_PROC_LOCK_BUSY) {
- rp = NULL;
- res = THE_NON_VALUE;
- *fail_type = ERTS_PI_FAIL_TYPE_YIELD;
- goto done;
- }
-
- if (c_p == rp)
- locks |= ERTS_PROC_LOCK_MAIN;
-
/*
* We always handle 'messages' first if it should be part
* of the result. This since if both 'messages' and
@@ -1045,35 +1006,31 @@ process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap,
* change the result of 'message_queue_len' (in case
* the queue contain bad distribution messages).
*/
- if (want_messages) {
+ if (flags & ERTS_PI_FLAG_WANT_MSGS) {
ix = pi_arg2ix(am_messages);
ASSERT(part_res[ix] == THE_NON_VALUE);
- res = process_info_aux(c_p, rp, locks, pid, am_messages,
- always_wrap, &reds);
+ res = process_info_aux(c_p, hfact, rp, rp_locks, ix,
+ flags, &reserve_size, reds);
ASSERT(res != am_undefined);
ASSERT(res != THE_NON_VALUE);
part_res[ix] = res;
}
- for (; res_elem_ix_ix >= 0; res_elem_ix_ix--) {
- ix = res_elem_ix[res_elem_ix_ix];
+ for (item_ix_ix = item_ix_len - 1; item_ix_ix >= 0; item_ix_ix--) {
+ ix = item_ix[item_ix_ix];
if (part_res[ix] == THE_NON_VALUE) {
- arg = pi_ix2arg(ix);
- res = process_info_aux(c_p, rp, locks, pid, arg,
- always_wrap, &reds);
- if (res == am_undefined)
- goto done;
+ res = process_info_aux(c_p, hfact, rp, rp_locks, ix,
+ flags, &reserve_size, reds);
+ ASSERT(res != am_undefined);
ASSERT(res != THE_NON_VALUE);
part_res[ix] = res;
}
}
- hp = HAlloc(c_p, res_len*2);
- hp_end = hp + res_len*2;
res = NIL;
- for (res_elem_ix_ix = res_len - 1; res_elem_ix_ix >= 0; res_elem_ix_ix--) {
- ix = res_elem_ix[res_elem_ix_ix];
+ for (item_ix_ix = item_ix_len - 1; item_ix_ix >= 0; item_ix_ix--) {
+ ix = item_ix[item_ix_ix];
ASSERT(part_res[ix] != THE_NON_VALUE);
/*
* If we should ignore the value of registered_name,
@@ -1081,155 +1038,310 @@ process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap,
* beginning of process_info_aux().
*/
if (is_nil(part_res[ix])) {
- ASSERT(!always_wrap);
+ ASSERT(!(flags & ERTS_PI_FLAG_ALWAYS_WRAP));
ASSERT(pi_ix2arg(ix) == am_registered_name);
}
else {
+ Eterm *hp;
+ ERTS_PI_UNRESERVE(reserve_size, 2);
+ hp = erts_produce_heap(hfact, 2, reserve_size);
res = CONS(hp, part_res[ix], res);
- hp += 2;
}
}
- if (!always_wrap) {
- HRelease(c_p, hp_end, hp);
- }
+ return res;
+}
- done:
+static void
+pi_setup_grow(int **arr, int *def_arr, Uint *sz, int ix);
- if (c_p == rp)
- locks &= ~ERTS_PROC_LOCK_MAIN;
- if (locks && rp)
- erts_proc_unlock(rp, locks);
+static BIF_RETTYPE
+process_info_bif(Process *c_p, Eterm pid, Eterm opt, int always_wrap, int pi2)
+{
+ ErtsHeapFactory hfact;
+ int def_arr[ERTS_PI_DEF_ARR_SZ];
+ int *item_ix = &def_arr[0];
+ Process *rp = NULL;
+ erts_aint32_t state;
+ BIF_RETTYPE ret;
+ Uint reds = 0;
+ ErtsProcLocks locks = 0;
+ int flags;
+ Uint reserve_size;
+ int len;
+ Eterm res;
- if (res_elem_ix != &def_res_elem_ix_buf[0])
- erts_free(ERTS_ALC_T_TMP, res_elem_ix);
+ ERTS_CT_ASSERT(ERTS_PI_DEF_ARR_SZ > 0);
- BUMP_REDS(c_p, reds);
+ 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;
- return res;
-}
+ if (!local_only) {
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_sig_fetch(c_p);
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
+ }
-BIF_RETTYPE process_info_1(BIF_ALIST_1)
-{
- Eterm res;
- int fail_type;
+ sres = erts_proc_sig_handle_incoming(c_p, &state, &sreds, sreds, !0);
+ if (state & ERTS_PSFLG_EXITING) {
+ c_p->flags &= ~F_LOCAL_SIGS_ONLY;
+ goto exited;
+ }
+ if (!sres) {
+ /*
+ * More signals to handle; 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;
+ }
- if (is_external_pid(BIF_ARG_1)
- && external_pid_dist_entry(BIF_ARG_1) == erts_this_dist_entry)
- BIF_RET(am_undefined);
-
- if (is_not_internal_pid(BIF_ARG_1)) {
- BIF_ERROR(BIF_P, BADARG);
- }
-
- res = process_info_list(BIF_P, BIF_ARG_1, pi_1_keys_list, 0, &fail_type);
- if (is_non_value(res)) {
- switch (fail_type) {
- case ERTS_PI_FAIL_TYPE_BADARG:
- BIF_ERROR(BIF_P, BADARG);
- case ERTS_PI_FAIL_TYPE_YIELD:
- ERTS_BIF_YIELD1(bif_export[BIF_process_info_1], BIF_P, BIF_ARG_1);
- case ERTS_PI_FAIL_TYPE_EXITED:
- ERTS_BIF_EXITED(BIF_P);
- default:
- erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error", __FILE__, __LINE__);
- }
+ c_p->flags &= ~F_LOCAL_SIGS_ONLY;
}
- ASSERT(!(BIF_P->flags & F_P2PNR_RESCHED));
- BIF_RET(res);
-}
+ if (is_atom(opt)) {
+ int ix = pi_arg2ix(opt);
+ item_ix[0] = ix;
+ len = 1;
+ locks = pi_ix2locks(ix);
+ reserve_size = 3 + pi_ix2rsz(ix);
+ flags = ERTS_PI_FLAG_SINGELTON;
+ flags |= pi_ix2flags(ix);
+ if (ix < 0)
+ goto badarg;
+ }
+ else {
+ Eterm list = opt;
+ Uint size = ERTS_PI_DEF_ARR_SZ;
+ len = 0;
+ reserve_size = 0;
+ locks = 0;
+ flags = 0;
-BIF_RETTYPE process_info_2(BIF_ALIST_2)
-{
- Eterm res;
- Process *rp;
- Eterm pid = BIF_ARG_1;
- ErtsProcLocks info_locks;
- int fail_type, reds = 0;
+ while (is_list(list)) {
+ Eterm *consp = list_val(list);
+ Eterm arg = CAR(consp);
+ int ix = pi_arg2ix(arg);
+ if (ix < 0)
+ goto badarg;
+
+ if (len >= size)
+ pi_setup_grow(&item_ix, def_arr, &size, len);
+
+ item_ix[len++] = ix;
+
+ locks |= pi_ix2locks(ix);
+ flags |= pi_ix2flags(ix);
+ reserve_size += pi_ix2rsz(ix);
+ reserve_size += 3; /* 2-tuple */
+ reserve_size += 2; /* cons */
+
+ list = CDR(consp);
+ }
+
+ if (is_not_nil(list))
+ goto badarg;
+ }
- if (is_external_pid(pid)
- && external_pid_dist_entry(pid) == erts_this_dist_entry)
- BIF_RET(am_undefined);
-
if (is_not_internal_pid(pid)) {
- BIF_ERROR(BIF_P, BADARG);
+ if (is_external_pid(pid)
+ && external_pid_dist_entry(pid) == erts_this_dist_entry)
+ goto undefined;
+ goto badarg;
}
- if (is_nil(BIF_ARG_2))
- BIF_RET(NIL);
+ if (always_wrap)
+ flags |= ERTS_PI_FLAG_ALWAYS_WRAP;
- if (is_list(BIF_ARG_2)) {
- res = process_info_list(BIF_P, BIF_ARG_1, BIF_ARG_2, 1, &fail_type);
- if (is_non_value(res)) {
- switch (fail_type) {
- case ERTS_PI_FAIL_TYPE_BADARG:
- BIF_ERROR(BIF_P, BADARG);
- case ERTS_PI_FAIL_TYPE_YIELD:
- ERTS_BIF_YIELD2(bif_export[BIF_process_info_2], BIF_P,
- BIF_ARG_1, BIF_ARG_2);
- case ERTS_PI_FAIL_TYPE_EXITED:
- ERTS_BIF_EXITED(BIF_P);
- default:
- erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error",
- __FILE__, __LINE__);
- }
- }
- ASSERT(!(BIF_P->flags & F_P2PNR_RESCHED));
- BIF_RET(res);
+ if (c_p->common.id == pid) {
+ rp = c_p;
+ if (locks & ~ERTS_PROC_LOCK_MAIN)
+ erts_proc_lock(c_p, locks & ~ERTS_PROC_LOCK_MAIN);
+ locks |= ERTS_PROC_LOCK_MAIN;
+ }
+ else {
+ if (flags & ERTS_PI_FLAG_FORCE_SIG_SEND)
+ goto send_signal;
+ rp = erts_try_lock_sig_free_proc(pid, locks, &state);
+ if (!rp)
+ goto undefined;
+ if (rp == ERTS_PROC_LOCK_BUSY) {
+ rp = NULL;
+ goto send_signal;
+ }
+ if (state & ERTS_PSFLG_EXITING) {
+ if (locks)
+ erts_proc_unlock(rp, locks);
+ locks = 0;
+ /* wait for it to terminate properly... */
+ goto send_signal;
+ }
+ if (flags & ERTS_PI_FLAG_NEED_MSGQ_LEN) {
+ ASSERT(locks & ERTS_PROC_LOCK_MAIN);
+ erts_proc_lock(rp, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_sig_fetch(rp);
+ if (c_p->sig_qs.cont) {
+ erts_proc_unlock(rp, locks|ERTS_PROC_LOCK_MSGQ);
+ locks = 0;
+ goto send_signal;
+ }
+ erts_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ);
+ }
}
- if (pi_arg2ix(BIF_ARG_2) < 0)
- BIF_ERROR(BIF_P, BADARG);
+ erts_factory_proc_init(&hfact, c_p);
- info_locks = pi_locks(BIF_ARG_2);
+ res = erts_process_info(c_p, &hfact, rp, locks, item_ix, len,
+ flags, reserve_size, &reds);
- rp = pi_lookup_proc(BIF_P, pid, &info_locks);
- if (!rp) {
- if (BIF_P->common.id == pid)
- ERTS_BIF_EXITED(BIF_P);
- BIF_RET(am_undefined);
+ erts_factory_close(&hfact);
+
+ if (reds > INT_MAX/2)
+ reds = INT_MAX/2;
+ BUMP_REDS(c_p, (int) reds);
+
+ state = erts_atomic32_read_acqb(&rp->state);
+ if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_FREE)) {
+ if (state & ERTS_PSFLG_FREE) {
+ ASSERT(!locks);
+ goto undefined;
+ }
+ if (locks)
+ erts_proc_unlock(rp, locks);
+ locks = 0;
+ /* wait for it to terminate properly... */
+ goto send_signal;
}
- else if (rp == ERTS_PROC_LOCK_BUSY)
- ERTS_BIF_YIELD2(bif_export[BIF_process_info_2], BIF_P,
- BIF_ARG_1, BIF_ARG_2);
- if (BIF_P == rp)
- info_locks |= ERTS_PROC_LOCK_MAIN;
+ ERTS_BIF_PREP_RET(ret, res);
- res = process_info_aux(BIF_P, rp, info_locks, pid, BIF_ARG_2,
- 0, &reds);
+done:
+
+ if (c_p == rp)
+ locks &= ~ERTS_PROC_LOCK_MAIN;
+
+ if (locks && rp)
+ erts_proc_unlock(rp, locks);
- BUMP_REDS(BIF_P, reds);
+ if (item_ix != def_arr)
+ erts_free(ERTS_ALC_T_TMP, item_ix);
- if (BIF_P == rp)
- info_locks &= ~ERTS_PROC_LOCK_MAIN;
- if (rp && info_locks)
- erts_proc_unlock(rp, info_locks);
+ return ret;
+
+badarg:
+ ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
+ goto done;
+
+undefined:
+ ERTS_BIF_PREP_RET(ret, am_undefined);
+ goto done;
- ASSERT(!(BIF_P->flags & F_P2PNR_RESCHED));
- BIF_RET(res);
+exited:
+ ERTS_BIF_PREP_EXITED(ret, c_p);
+ goto done;
+
+yield:
+ if (pi2)
+ ERTS_BIF_PREP_YIELD2(ret, bif_export[BIF_process_info_2], c_p, pid, opt);
+ else
+ ERTS_BIF_PREP_YIELD1(ret, bif_export[BIF_process_info_1], c_p, pid);
+ goto done;
+
+send_signal: {
+ Eterm ref = erts_make_ref(c_p);
+ int enqueued, need_msgq_len;
+ flags |= ERTS_PI_FLAG_REQUEST_FOR_OTHER;
+ need_msgq_len = (flags & ERTS_PI_FLAG_NEED_MSGQ_LEN);
+ /*
+ * Set receive mark so we wont have to scan the whole
+ * message queue for the result. Note caller unconditionally
+ * has to enter a receive only matching messages containing
+ * 'ref', or restore save pointer.
+ */
+ ERTS_RECV_MARK_SAVE(c_p);
+ ERTS_RECV_MARK_SET(c_p);
+ enqueued = erts_proc_sig_send_process_info_request(c_p, pid, item_ix,
+ len, need_msgq_len,
+ flags, reserve_size,
+ ref);
+ if (!enqueued) {
+ /* Restore save pointer... */
+ JOIN_MESSAGE(c_p);
+ goto undefined;
+ }
+ ERTS_BIF_PREP_TRAP1(ret, erts_await_result, c_p, ref);
+ goto done;
+ }
+}
+
+static void
+pi_setup_grow(int **arr, int *def_arr, Uint *sz, int ix)
+{
+ *sz = (ix+1) + ERTS_PI_DEF_ARR_SZ;
+ if (*arr != def_arr)
+ *arr = erts_realloc(ERTS_ALC_T_TMP, *arr, (*sz)*sizeof(int));
+ else {
+ int *new_arr = erts_alloc(ERTS_ALC_T_TMP, (*sz)*sizeof(int));
+ sys_memcpy((void *) new_arr, (void *) def_arr,
+ sizeof(int)*ERTS_PI_DEF_ARR_SZ);
+ *arr = new_arr;
+ }
+}
+
+
+BIF_RETTYPE process_info_2(BIF_ALIST_2)
+{
+ return process_info_bif(BIF_P, BIF_ARG_1, BIF_ARG_2, !is_atom(BIF_ARG_2), !0);
+}
+
+BIF_RETTYPE process_info_1(BIF_ALIST_1)
+{
+ return process_info_bif(BIF_P, BIF_ARG_1, pi_1_keys_list, 0, 0);
}
Eterm
-process_info_aux(Process *BIF_P,
+process_info_aux(Process *c_p,
+ ErtsHeapFactory *hfact,
Process *rp,
ErtsProcLocks rp_locks,
- Eterm rpid,
- Eterm item,
- int always_wrap,
- int *reds)
+ int item_ix,
+ int flags,
+ Uint *reserve_sizep,
+ Uint *reds)
{
Eterm *hp;
Eterm res = NIL;
+ Uint reserved;
+ Uint reserve_size = *reserve_sizep;
+
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ ErtsProcLocks locks = erts_proc_lc_my_proc_locks(rp);
+
+ switch (item_ix) {
+ case ERTS_PI_IX_STATUS:
+ case ERTS_PI_IX_PRIORITY:
+ case ERTS_PI_IX_SUSPENDING:
+ ERTS_LC_ASSERT((locks & ~ERTS_PROC_LOCK_MAIN) == 0);
+ break;
+ default:
+ ERTS_LC_ASSERT(locks == ERTS_PROC_LOCK_MAIN);
+ break;
+ }
+#endif
+
+ reserved = pi_ix2rsz(item_ix);
+ ERTS_PI_UNRESERVE(reserve_size, reserved);
(*reds)++;
ASSERT(rp);
/*
- * Q: Why this always_wrap argument?
+ * Q: Why this ERTS_PI_FLAG_ALWAYS_WRAP flag?
*
* A: registered_name is strange. If process has no registered name,
* process_info(Pid, registered_name) returns [], and
@@ -1241,41 +1353,39 @@ process_info_aux(Process *BIF_P,
* registered_name behaves as it should, i.e. a
* {registered_name, []} will appear in the resulting list.
*
- * If always_wrap != 0, process_info_aux() always wrap the result
- * in a key two tuple.
+ * If ERTS_PI_FLAG_ALWAYS_WRAP is set, process_info_aux() always
+ * wrap the result in a key two tuple.
*/
- switch (item) {
+ switch (item_ix) {
- case am_registered_name:
- if (rp->common.u.alive.reg) {
- hp = HAlloc(BIF_P, 3);
+ case ERTS_PI_IX_REGISTERED_NAME:
+ if (rp->common.u.alive.reg)
res = rp->common.u.alive.reg->name;
- } else {
- if (always_wrap) {
- hp = HAlloc(BIF_P, 3);
+ else {
+ if (flags & ERTS_PI_FLAG_ALWAYS_WRAP)
res = NIL;
- }
- else {
+ else
return NIL;
- }
}
break;
- case am_current_function:
- res = current_function(BIF_P, rp, &hp, 0);
+ case ERTS_PI_IX_CURRENT_FUNCTION:
+ res = current_function(c_p, hfact, rp, 0,
+ reserve_size, flags);
break;
- case am_current_location:
- res = current_function(BIF_P, rp, &hp, 1);
+ case ERTS_PI_IX_CURRENT_LOCATION:
+ res = current_function(c_p, hfact, rp, 1,
+ reserve_size, flags);
break;
- case am_current_stacktrace:
- res = current_stacktrace(BIF_P, rp, &hp);
+ case ERTS_PI_IX_CURRENT_STACKTRACE:
+ res = current_stacktrace(hfact, rp, reserve_size);
break;
- case am_initial_call:
- hp = HAlloc(BIF_P, 3+4);
+ case ERTS_PI_IX_INITIAL_CALL:
+ hp = erts_produce_heap(hfact, 4, reserve_size);
res = TUPLE3(hp,
rp->u.initial.module,
rp->u.initial.function,
@@ -1283,24 +1393,37 @@ process_info_aux(Process *BIF_P,
hp += 4;
break;
- case am_status:
- res = erts_process_state2status(erts_atomic32_read_nob(&rp->state));
- if (res == am_exiting || res == am_free)
- return am_undefined;
- hp = HAlloc(BIF_P, 3);
+ case ERTS_PI_IX_STATUS: {
+ erts_aint32_t state = erts_atomic32_read_nob(&rp->state);
+ res = erts_process_state2status(state);
+ if (res == am_running && (state & ERTS_PSFLG_RUNNING_SYS)) {
+ ASSERT(c_p == rp);
+ ASSERT(flags & ERTS_PI_FLAG_REQUEST_FOR_OTHER);
+ if (!(state & (ERTS_PSFLG_SYS_TASKS
+ | ERTS_PSFLG_ACTIVE
+ | ERTS_PSFLG_SIG_Q
+ | ERTS_PSFLG_SIG_IN_Q))) {
+ /*
+ * We are servicing a process-info request from
+ * another process. If that other process could
+ * have inspected our state itself, we would have
+ * been in the 'waiting' state.
+ */
+ res = am_waiting;
+ }
+ }
break;
+ }
- case am_messages: {
-
- if (rp->sig_qs.len == 0 || ERTS_TRACE_FLAGS(rp) & F_SENSITIVE) {
- hp = HAlloc(BIF_P, 3);
- } else {
+ case ERTS_PI_IX_MESSAGES: {
+ ASSERT(flags & ERTS_PI_FLAG_NEED_MSGQ_LEN);
+ if (rp->sig_qs.len == 0 || (ERTS_TRACE_FLAGS(rp) & F_SENSITIVE))
+ res = NIL;
+ else {
+ int info_on_self = !(flags & ERTS_PI_FLAG_REQUEST_FOR_OTHER);
ErtsMessageInfo *mip;
- Sint i;
+ Sint i, len;
Uint heap_need;
-#ifdef DEBUG
- Eterm *hp_end;
-#endif
mip = erts_alloc(ERTS_ALC_T_TMP,
rp->sig_qs.len*sizeof(ErtsMessageInfo));
@@ -1310,46 +1433,52 @@ process_info_aux(Process *BIF_P,
* erts_proc_sig_prep_msgq_for_inspection() since it removes
* corrupt distribution messages.
*/
- heap_need = erts_proc_sig_prep_msgq_for_inspection(BIF_P, rp,
- rp_locks, mip);
- heap_need += 3; /* top 2-tuple */
- heap_need += rp->sig_qs.len*2; /* Cons cells */
+ heap_need = erts_proc_sig_prep_msgq_for_inspection(c_p, rp,
+ rp_locks,
+ info_on_self,
+ mip);
+ len = rp->sig_qs.len;
- hp = HAlloc(BIF_P, heap_need); /* heap_need is exact */
-#ifdef DEBUG
- hp_end = hp + heap_need;
-#endif
+ heap_need += len*2; /* Cons cells */
+
+ reserve_size += heap_need;
/* Build list of messages... */
- for (i = rp->sig_qs.len - 1, res = NIL; i >= 0; i--) {
+ for (i = len - 1, res = NIL; i >= 0; i--) {
Eterm msg = ERL_MESSAGE_TERM(mip[i].msgp);
Uint sz = mip[i].size;
+ ERTS_PI_UNRESERVE(reserve_size, sz+2);
+ hp = erts_produce_heap(hfact, sz+2, reserve_size);
+
if (sz != 0)
- msg = copy_struct(msg, sz, &hp, &BIF_P->off_heap);
+ msg = copy_struct(msg, sz, &hp, hfact->off_heap);
res = CONS(hp, msg, res);
hp += 2;
}
- ASSERT(hp_end == hp + 3);
-
- if (rp->sig_qs.len > CONTEXT_REDS*4)
- *reds += CONTEXT_REDS*4;
- else
- *reds += rp->sig_qs.len / 4;
+ *reds += (Uint) len / 4;
erts_free(ERTS_ALC_T_TMP, mip);
}
break;
}
- case am_message_queue_len:
- hp = HAlloc(BIF_P, 3);
- res = make_small(rp->sig_qs.len);
+ case ERTS_PI_IX_MESSAGE_QUEUE_LEN: {
+ Sint len = rp->sig_qs.len;
+ ASSERT(flags & ERTS_PI_FLAG_NEED_MSGQ_LEN);
+ ASSERT(len >= 0);
+ if (len <= MAX_SMALL)
+ res = make_small(len);
+ else {
+ hp = erts_produce_heap(hfact, BIG_UINT_HEAP_SIZE, reserve_size);
+ res = uint_to_big((Uint) len, hp);
+ }
break;
+ }
- case am_links: {
+ case ERTS_PI_IX_LINKS: {
MonitorInfoCollection mic;
int i;
Eterm item;
@@ -1358,24 +1487,24 @@ process_info_aux(Process *BIF_P,
erts_link_tree_foreach(ERTS_P_LINKS(rp), collect_one_link, (void *) &mic);
- hp = HAlloc(BIF_P, 3 + mic.sz);
+ reserve_size += mic.sz;
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
- item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity.term);
+ Eterm item_src = mic.mi[i].entity.term;
+ Uint sz = NC_HEAP_SIZE(item_src) + 2;
+ ERTS_PI_UNRESERVE(reserve_size, sz);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
+ item = STORE_NC(&hp, hfact->off_heap, item_src);
res = CONS(hp, item, res);
- hp += 2;
}
- if (mic.mi_i > CONTEXT_REDS*4)
- *reds += CONTEXT_REDS*4;
- else
- *reds += mic.mi_i / 4;
+ *reds += (Uint) mic.mi_i / 4;
DESTROY_MONITOR_INFOS(mic);
break;
}
- case am_monitors: {
+ case ERTS_PI_IX_MONITORS: {
MonitorInfoCollection mic;
int i;
@@ -1384,7 +1513,7 @@ process_info_aux(Process *BIF_P,
collect_one_origin_monitor,
(void *) &mic);
- hp = HAlloc(BIF_P, 3 + mic.sz);
+ reserve_size += mic.sz;
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
if (mic.mi[i].named) {
@@ -1399,23 +1528,30 @@ process_info_aux(Process *BIF_P,
|| is_port(mic.mi[i].pid)
|| is_atom(mic.mi[i].pid));
+ ERTS_PI_UNRESERVE(reserve_size, 3+3+2);
+ hp = erts_produce_heap(hfact, 3+3+2, reserve_size);
+
t1 = TUPLE2(hp, mic.mi[i].entity.term, mic.mi[i].node);
hp += 3;
t2 = TUPLE2(hp, m_type, t1);
hp += 3;
res = CONS(hp, t2, res);
- hp += 2;
}
else {
/* Build {process|port|time_offset, Pid|clock_service} and cons it. */
Eterm t;
Eterm pid;
Eterm m_type;
+ Eterm pid_src = mic.mi[i].entity.term;
+ Uint sz = is_atom(pid_src) ? 0 : NC_HEAP_SIZE(pid_src);
+ sz += 3 + 2;
- if (is_atom(mic.mi[i].entity.term))
- pid = mic.mi[i].entity.term;
- else
- pid = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity.term);
+ ERTS_PI_UNRESERVE(reserve_size, sz);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
+
+ pid = (is_atom(pid_src)
+ ? pid_src
+ : STORE_NC(&hp, hfact->off_heap, pid_src));
switch (mic.mi[i].type) {
case ERTS_MON_TYPE_PORT:
@@ -1435,20 +1571,16 @@ process_info_aux(Process *BIF_P,
t = TUPLE2(hp, m_type, pid);
hp += 3;
res = CONS(hp, t, res);
- hp += 2;
}
}
- if (mic.mi_i > CONTEXT_REDS*4)
- *reds += CONTEXT_REDS*4;
- else
- *reds += mic.mi_i / 4;
+ *reds += (Uint) mic.mi_i / 4;
DESTROY_MONITOR_INFOS(mic);
break;
}
- case am_monitored_by: {
+ case ERTS_PI_IX_MONITORED_BY: {
MonitorInfoCollection mic;
int i;
Eterm item;
@@ -1461,59 +1593,71 @@ process_info_aux(Process *BIF_P,
collect_one_target_monitor,
(void *) &mic);
- hp = HAlloc(BIF_P, 3 + mic.sz);
+ reserve_size += mic.sz;
res = NIL;
for (i = 0; i < mic.mi_i; ++i) {
+ Uint sz = 2;
+
+ if (mic.mi[i].type == ERTS_MON_TYPE_RESOURCE)
+ sz += erts_resource_ref_size(mic.mi[i].entity.resource);
+ else
+ sz += NC_HEAP_SIZE(mic.mi[i].entity.term);
+
+ ERTS_PI_UNRESERVE(reserve_size, sz);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
+
if (mic.mi[i].type == ERTS_MON_TYPE_RESOURCE)
item = erts_bld_resource_ref(&hp,
- &MSO(BIF_P),
+ hfact->off_heap,
mic.mi[i].entity.resource);
else
item = STORE_NC(&hp,
- &MSO(BIF_P),
+ hfact->off_heap,
mic.mi[i].entity.term);
res = CONS(hp, item, res);
- hp += 2;
}
- if (mic.mi_i > CONTEXT_REDS*4)
- *reds += CONTEXT_REDS*4;
- else
- *reds += mic.mi_i / 4;
+ *reds += (Uint) mic.mi_i / 4;
DESTROY_MONITOR_INFOS(mic);
break;
}
- case am_suspending: {
+ case ERTS_PI_IX_SUSPENDING: {
ErtsSuspendMonitorInfoCollection smic;
int i;
Eterm item;
-#ifdef DEBUG
- Eterm *hp_end;
-#endif
+
+ erts_proc_lock(rp, ERTS_PROC_LOCK_STATUS);
ERTS_INIT_SUSPEND_MONITOR_INFOS(smic,
- BIF_P,
- (BIF_P == rp
+ 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);
- hp = HAlloc(BIF_P, 3 + smic.sz);
-#ifdef DEBUG
- hp_end = hp + smic.sz;
-#endif
-
+
+ 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;
+ Uint sz = 4 + 2;
+ if (!IS_SSMALL(a))
+ sz += BIG_UINT_HEAP_SIZE;
+ if (!IS_SSMALL(p))
+ 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 {
@@ -1529,95 +1673,83 @@ process_info_aux(Process *BIF_P,
item = TUPLE3(hp, smic.smi[i]->mon.other.item, active, pending);
hp += 4;
res = CONS(hp, item, res);
- hp += 2;
}
- if (smic.smi_i > CONTEXT_REDS*4)
- *reds += CONTEXT_REDS*4;
- else
- *reds += smic.smi_i / 4;
+ erts_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
+
+ *reds += (Uint) smic.smi_i / 4;
ERTS_DESTROY_SUSPEND_MONITOR_INFOS(smic);
- ASSERT(hp == hp_end);
break;
}
- case am_dictionary:
+ case ERTS_PI_IX_DICTIONARY:
if (!rp->dictionary || (ERTS_TRACE_FLAGS(rp) & F_SENSITIVE)) {
res = NIL;
} else {
Uint num = rp->dictionary->numElements;
- res = erts_dictionary_copy(BIF_P, rp->dictionary);
- if (num > CONTEXT_REDS*4)
- *reds += CONTEXT_REDS*4;
- else
- *reds += (int) num / 4;
+ res = erts_dictionary_copy(hfact, rp->dictionary, reserve_size);
+ *reds += (Uint) num / 4;
}
- hp = HAlloc(BIF_P, 3);
+
break;
- case am_trap_exit: {
- hp = HAlloc(BIF_P, 3);
- if (rp->flags & F_TRAP_EXIT)
- res = am_true;
- else
- res = am_false;
+ case ERTS_PI_IX_TRAP_EXIT:
+ res = (rp->flags & F_TRAP_EXIT) ? am_true : am_false;
break;
- }
- case am_error_handler:
- hp = HAlloc(BIF_P, 3);
- res = erts_proc_get_error_handler(BIF_P);
+ case ERTS_PI_IX_ERROR_HANDLER:
+ res = erts_proc_get_error_handler(rp);
break;
- case am_heap_size: {
- Uint hsz = 3;
+ case ERTS_PI_IX_HEAP_SIZE: {
+ Uint hsz = 0;
(void) erts_bld_uint(NULL, &hsz, HEAP_SIZE(rp));
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, HEAP_SIZE(rp));
break;
}
- case am_fullsweep_after: {
- Uint hsz = 3;
+ case ERTS_PI_IX_FULLSWEEP_AFTER: {
+ Uint hsz = 0;
(void) erts_bld_uint(NULL, &hsz, MAX_GEN_GCS(rp));
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, MAX_GEN_GCS(rp));
break;
}
- case am_min_heap_size: {
- Uint hsz = 3;
+ case ERTS_PI_IX_MIN_HEAP_SIZE: {
+ Uint hsz = 0;
(void) erts_bld_uint(NULL, &hsz, MIN_HEAP_SIZE(rp));
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, MIN_HEAP_SIZE(rp));
break;
}
- case am_min_bin_vheap_size: {
- Uint hsz = 3;
+ case ERTS_PI_IX_MIN_BIN_VHEAP_SIZE: {
+ Uint hsz = 0;
(void) erts_bld_uint(NULL, &hsz, MIN_VHEAP_SIZE(rp));
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, MIN_VHEAP_SIZE(rp));
break;
}
- case am_max_heap_size: {
- Uint hsz = 3;
+ case ERTS_PI_IX_MAX_HEAP_SIZE: {
+ Uint hsz = 0;
(void) erts_max_heap_size_map(MAX_HEAP_SIZE_GET(rp),
MAX_HEAP_SIZE_FLAGS_GET(rp),
NULL, &hsz);
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_max_heap_size_map(MAX_HEAP_SIZE_GET(rp),
MAX_HEAP_SIZE_FLAGS_GET(rp),
&hp, NULL);
break;
}
- case am_total_heap_size: {
+ case ERTS_PI_IX_TOTAL_HEAP_SIZE: {
Uint total_heap_size;
- Uint hsz = 3;
+ Uint hsz = 0;
total_heap_size = rp->heap_sz;
if (rp->old_hend && rp->old_heap)
@@ -1626,58 +1758,52 @@ process_info_aux(Process *BIF_P,
total_heap_size += rp->mbuf_sz;
if (rp->flags & F_ON_HEAP_MSGQ) {
- ERTS_FOREACH_SIG_PRIVQS(
- rp, mp,
- {
- if (ERTS_SIG_IS_MSG(mp) && mp->data.attached)
- total_heap_size += erts_msg_attached_data_size(mp);
- });
-
- if (rp->sig_qs.len > CONTEXT_REDS*4)
- *reds += CONTEXT_REDS*4;
- else
- *reds += rp->sig_qs.len / 4;
+ ErtsMessage *mp;
+ ASSERT(flags & ERTS_PI_FLAG_NEED_MSGQ_LEN);
+ for (mp = rp->sig_qs.first; mp; mp = mp->next) {
+ ASSERT(ERTS_SIG_IS_MSG(mp));
+ if (mp->data.attached)
+ total_heap_size += erts_msg_attached_data_size(mp);
+ }
+ *reds += (Uint) rp->sig_qs.len / 4;
}
(void) erts_bld_uint(NULL, &hsz, total_heap_size);
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, total_heap_size);
break;
}
- case am_stack_size: {
+ case ERTS_PI_IX_STACK_SIZE: {
Uint stack_size = STACK_START(rp) - rp->stop;
- Uint hsz = 3;
+ Uint hsz = 0;
(void) erts_bld_uint(NULL, &hsz, stack_size);
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, stack_size);
break;
}
- case am_memory: { /* Memory consumed in bytes */
- Uint hsz = 3;
+ case ERTS_PI_IX_MEMORY: { /* Memory consumed in bytes */
+ Uint hsz = 0;
Uint size = erts_process_memory(rp, 0);
(void) erts_bld_uint(NULL, &hsz, size);
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, size);
- if (rp->sig_qs.len > CONTEXT_REDS*4)
- *reds += CONTEXT_REDS*4;
- else
- *reds += rp->sig_qs.len / 4;
+ ASSERT(flags & ERTS_PI_FLAG_NEED_MSGQ_LEN);
+ *reds += (Uint) rp->sig_qs.len / 4;
break;
}
- case am_garbage_collection: {
+ case ERTS_PI_IX_GARBAGE_COLLECTION: {
DECL_AM(minor_gcs);
Eterm t;
Uint map_sz = 0;
erts_max_heap_size_map(MAX_HEAP_SIZE_GET(rp), MAX_HEAP_SIZE_FLAGS_GET(rp), NULL, &map_sz);
- hp = HAlloc(BIF_P, 3+2 + 3+2 + 3+2 + 3+2 + 3+2 + map_sz + 3);
- /* last "3" is for outside tuple */
+ hp = erts_produce_heap(hfact, 3+2 + 3+2 + 3+2 + 3+2 + 3+2 + map_sz, reserve_size);
t = TUPLE2(hp, AM_minor_gcs, make_small(GEN_GCS(rp))); hp += 3;
res = CONS(hp, t, NIL); hp += 2;
@@ -1696,93 +1822,76 @@ process_info_aux(Process *BIF_P,
break;
}
- case am_garbage_collection_info: {
+ case ERTS_PI_IX_GARBAGE_COLLECTION_INFO: {
Uint sz = 0, actual_sz = 0;
- if (rp == BIF_P) {
- sz += ERTS_PROCESS_GC_INFO_MAX_SIZE;
- } else {
- erts_process_gc_info(rp, &sz, NULL, 0, 0);
- sz += 3;
- }
+ erts_process_gc_info(rp, &sz, NULL, 0, 0);
- hp = HAlloc(BIF_P, sz);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
res = erts_process_gc_info(rp, &actual_sz, &hp, 0, 0);
- /* We may have some extra space, fill with 0 tuples */
- if (actual_sz <= sz - 3) {
- for (; actual_sz < sz - 3; hp++, actual_sz++)
- hp[0] = make_arityval(0);
- } else {
- for (; actual_sz < sz; hp++, actual_sz++)
- hp[0] = make_arityval(0);
- hp = HAlloc(BIF_P, 3);
- }
-
break;
}
- case am_group_leader: {
+ case ERTS_PI_IX_GROUP_LEADER: {
int sz = NC_HEAP_SIZE(rp->group_leader);
- hp = HAlloc(BIF_P, 3 + sz);
- res = STORE_NC(&hp, &MSO(BIF_P), rp->group_leader);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
+ res = STORE_NC(&hp, hfact->off_heap, rp->group_leader);
break;
}
- case am_reductions: {
- Uint reds = rp->reds + erts_current_reductions(BIF_P, rp);
- Uint hsz = 3;
+ case ERTS_PI_IX_REDUCTIONS: {
+ Uint reds = rp->reds + erts_current_reductions(c_p, rp);
+ Uint hsz = 0;
(void) erts_bld_uint(NULL, &hsz, reds);
- hp = HAlloc(BIF_P, hsz);
+ hp = erts_produce_heap(hfact, hsz, reserve_size);
res = erts_bld_uint(&hp, NULL, reds);
break;
}
- case am_priority: {
+ case ERTS_PI_IX_PRIORITY: {
erts_aint32_t state = erts_atomic32_read_nob(&rp->state);
if (ERTS_PSFLG_EXITING & state)
return am_undefined;
- hp = HAlloc(BIF_P, 3);
res = erts_get_process_priority(state);
break;
}
- case am_trace:
- hp = HAlloc(BIF_P, 3);
+ case ERTS_PI_IX_TRACE:
res = make_small(ERTS_TRACE_FLAGS(rp) & TRACEE_FLAGS);
break;
- case am_binary: {
- Uint sz = 3;
+ case ERTS_PI_IX_BINARY: {
+ Uint sz = 0;
(void) bld_bin_list(NULL, &sz, &MSO(rp));
- hp = HAlloc(BIF_P, sz);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
res = bld_bin_list(&hp, NULL, &MSO(rp));
break;
}
- case am_sequential_trace_token:
- res = copy_object(rp->seq_trace_token, BIF_P);
- hp = HAlloc(BIF_P, 3);
+ case ERTS_PI_IX_SEQUENTIAL_TRACE_TOKEN: {
+ Uint sz = size_object(rp->seq_trace_token);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
+ res = copy_struct(rp->seq_trace_token, sz, &hp, hfact->off_heap);
break;
+ }
- case am_catchlevel:
- hp = HAlloc(BIF_P, 3);
- res = make_small(catchlevel(BIF_P));
+ case ERTS_PI_IX_CATCHLEVEL:
+ res = make_small(catchlevel(rp));
break;
- case am_backtrace: {
+ case ERTS_PI_IX_BACKTRACE: {
erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0);
erts_stack_dump(ERTS_PRINT_DSBUF, (void *) dsbufp, rp);
- res = new_binary(BIF_P, (byte *) dsbufp->str, dsbufp->str_len);
+ res = erts_heap_factory_new_binary(hfact, (byte *) dsbufp->str,
+ dsbufp->str_len, reserve_size);
erts_destroy_tmp_dsbuf(dsbufp);
- hp = HAlloc(BIF_P, 3);
break;
}
- case am_last_calls: {
+ case ERTS_PI_IX_LAST_CALLS: {
struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(rp);
if (!scb) {
- hp = HAlloc(BIF_P, 3);
res = am_false;
} else {
/*
@@ -1790,23 +1899,34 @@ process_info_aux(Process *BIF_P,
* Might be less than that, if there are sends, receives or timeouts,
* so we must do a HRelease() to avoid creating holes.
*/
- Uint needed = scb->n*(2+4) + 3;
- Eterm* limit;
+ Sint needed = scb->n*(2+4);
Eterm term, list;
int i, j;
+ Export *exp;
+
+ reserve_size += needed;
- hp = HAlloc(BIF_P, needed);
- limit = hp + needed;
list = NIL;
for (i = 0; i < scb->n; i++) {
+ Uint sz;
j = scb->cur - i - 1;
if (j < 0)
j += scb->len;
- if (scb->ct[j] == &exp_send)
+
+ sz = 2;
+ exp = scb->ct[j];
+ if (exp != &exp_send && exp != &exp_receive && exp != &exp_timeout)
+ sz += 4;
+
+ needed -= sz;
+ ERTS_PI_UNRESERVE(reserve_size, sz);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
+
+ if (exp == &exp_send)
term = am_send;
- else if (scb->ct[j] == &exp_receive)
+ else if (exp == &exp_receive)
term = am_receive;
- else if (scb->ct[j] == &exp_timeout)
+ else if (exp == &exp_timeout)
term = am_timeout;
else {
term = TUPLE3(hp,
@@ -1816,18 +1936,18 @@ process_info_aux(Process *BIF_P,
hp += 4;
}
list = CONS(hp, term, list);
- hp += 2;
}
+
+ ASSERT(needed >= 0);
+ if (needed > 0)
+ reserve_size -= needed;
+
res = list;
- res = TUPLE2(hp, item, res);
- hp += 3;
- HRelease(BIF_P,limit,hp);
- return res;
}
break;
}
- case am_message_queue_data:
+ case ERTS_PI_IX_MESSAGE_QUEUE_DATA:
switch (rp->flags & (F_OFF_HEAP_MSGQ|F_ON_HEAP_MSGQ)) {
case F_OFF_HEAP_MSGQ:
res = am_off_heap;
@@ -1840,16 +1960,15 @@ process_info_aux(Process *BIF_P,
ERTS_INTERNAL_ERROR("Inconsistent message queue management state");
break;
}
- hp = HAlloc(BIF_P, 3);
break;
- case am_magic_ref: {
- Uint sz = 3;
+ case ERTS_PI_IX_MAGIC_REF: {
+ Uint sz = 0;
(void) bld_magic_ref_bin_list(NULL, &sz, &MSO(rp));
- hp = HAlloc(BIF_P, sz);
+ hp = erts_produce_heap(hfact, sz, 0);
res = bld_magic_ref_bin_list(&hp, NULL, &MSO(rp));
- *reds += 10;
+ *reds += (Uint) 10;
break;
}
@@ -1858,12 +1977,17 @@ process_info_aux(Process *BIF_P,
}
- return TUPLE2(hp, item, res);
+ ERTS_PI_UNRESERVE(reserve_size, 3);
+ *reserve_sizep = reserve_size;
+ hp = erts_produce_heap(hfact, 3, reserve_size);
+
+ return TUPLE2(hp, pi_ix2arg(item_ix), res);
}
#undef MI_INC
static Eterm
-current_function(Process* BIF_P, Process* rp, Eterm** hpp, int full_info)
+current_function(Process *c_p, ErtsHeapFactory *hfact, Process* rp,
+ int full_info, Uint reserve_size, int flags)
{
Eterm* hp;
Eterm res;
@@ -1880,7 +2004,7 @@ current_function(Process* BIF_P, Process* rp, Eterm** hpp, int full_info)
}
}
- if (BIF_P == rp) {
+ if (c_p == rp && !(flags & ERTS_PI_FLAG_REQUEST_FOR_OTHER)) {
FunctionInfo fi2;
/*
@@ -1900,24 +2024,22 @@ current_function(Process* BIF_P, Process* rp, Eterm** hpp, int full_info)
* Return the result.
*/
if (rp->current == NULL) {
- hp = HAlloc(BIF_P, 3);
res = am_undefined;
} else if (full_info) {
- hp = HAlloc(BIF_P, 3+fi.needed);
- hp = erts_build_mfa_item(&fi, hp, am_true, &res);
+ hp = erts_produce_heap(hfact, fi.needed, reserve_size);
+ erts_build_mfa_item(&fi, hp, am_true, &res);
} else {
- hp = HAlloc(BIF_P, 3+4);
+ hp = erts_produce_heap(hfact, 4, reserve_size);
res = TUPLE3(hp, rp->current->module,
rp->current->function,
make_small(rp->current->arity));
- hp += 4;
}
- *hpp = hp;
return res;
}
static Eterm
-current_stacktrace(Process* p, Process* rp, Eterm** hpp)
+current_stacktrace(ErtsHeapFactory *hfact, Process* rp,
+ Uint reserve_size)
{
Uint sz;
struct StackTrace* s;
@@ -1926,7 +2048,7 @@ current_stacktrace(Process* p, Process* rp, Eterm** hpp)
FunctionInfo* stkp;
Uint heap_size;
int i;
- Eterm* hp = *hpp;
+ Eterm* hp;
Eterm mfa;
Eterm res = NIL;
@@ -1956,17 +2078,23 @@ current_stacktrace(Process* p, Process* rp, Eterm** hpp)
}
}
- hp = HAlloc(p, heap_size);
+ reserve_size += heap_size;
+
+ /*
+ * We intentionally produce heap in small chunks
+ * (for more info see process_info_aux()).
+ */
while (stkp > stk) {
stkp--;
+ sz = stkp->needed + 2;
+ ERTS_PI_UNRESERVE(reserve_size, sz);
+ hp = erts_produce_heap(hfact, sz, reserve_size);
hp = erts_build_mfa_item(stkp, hp, am_true, &mfa);
res = CONS(hp, mfa, res);
- hp += 2;
}
erts_free(ERTS_ALC_T_TMP, stk);
erts_free(ERTS_ALC_T_TMP, s);
- *hpp = hp;
return res;
}
@@ -2024,45 +2152,6 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */
return make_small(sizeof(UWord));
}
goto badarg;
- } else if (sel == am_allocated) {
- if (arity == 2) {
- Eterm res = THE_NON_VALUE;
- char *buf;
- Sint len = is_string(*tp);
- if (len <= 0)
- return res;
- buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1);
- if (intlist_to_buf(*tp, buf, len) != len)
- erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error\n", __FILE__, __LINE__);
- buf[len] = '\0';
- res = erts_instr_dump_memory_map(buf) ? am_true : am_false;
- erts_free(ERTS_ALC_T_TMP, (void *) buf);
- if (is_non_value(res))
- goto badarg;
- return res;
- }
- else if (arity == 3 && tp[0] == am_status) {
- if (is_atom(tp[1]))
- return erts_instr_get_stat(BIF_P, tp[1], 1);
- else {
- Eterm res = THE_NON_VALUE;
- char *buf;
- Sint len = is_string(tp[1]);
- if (len <= 0)
- return res;
- buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1);
- if (intlist_to_buf(tp[1], buf, len) != len)
- erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error\n", __FILE__, __LINE__);
- buf[len] = '\0';
- res = erts_instr_dump_stat(buf, 1) ? am_true : am_false;
- erts_free(ERTS_ALC_T_TMP, (void *) buf);
- if (is_non_value(res))
- goto badarg;
- return res;
- }
- }
- else
- goto badarg;
} else if (sel == am_allocator) {
switch (arity) {
case 2:
@@ -2430,8 +2519,6 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
} else if (BIF_ARG_1 == am_allocated_areas) {
res = erts_allocated_areas(NULL, NULL, BIF_P);
BIF_RET(res);
- } else if (BIF_ARG_1 == am_allocated) {
- BIF_RET(erts_instr_get_memory_map(BIF_P));
} else if (BIF_ARG_1 == am_hipe_architecture) {
#if defined(HIPE)
BIF_RET(hipe_arch_name);
@@ -2572,9 +2659,6 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
sizeof(ERLANG_ARCHITECTURE)-1,
NIL));
}
- else if (BIF_ARG_1 == am_memory_types) {
- return erts_instr_get_type_info(BIF_P);
- }
else if (BIF_ARG_1 == am_os_type) {
BIF_RET(os_type_tuple);
}
@@ -3838,7 +3922,7 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
Eterm res = NIL;
Uint *hp = HAlloc(BIF_P, 2*ERTS_PI_ARGS);
for (i = ERTS_PI_ARGS-1; i >= 0; i--) {
- res = CONS(hp, pi_args[i], res);
+ res = CONS(hp, pi_args[i].name, res);
hp += 2;
}
BIF_RET(res);
@@ -3928,6 +4012,15 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
BIF_RET(am_false);
#endif
}
+ else if (ERTS_IS_ATOM_STR("lc_graph", BIF_ARG_1)) {
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ Eterm res = erts_lc_dump_graph();
+ BIF_RET(res);
+#else
+ BIF_RET(am_notsup);
+#endif
+ }
+
}
else if (is_tuple(BIF_ARG_1)) {
Eterm* tp = tuple_val(BIF_ARG_1);
@@ -4601,6 +4694,55 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
BIF_ERROR(BIF_P, BADARG);
}
+static BIF_RETTYPE
+gather_histograms_helper(Process * c_p, Eterm arg_tuple,
+ int gather(Process *, int, int, int, UWord, Eterm))
+{
+ SWord hist_start, hist_width, sched_id;
+ int msg_count, alloc_num;
+ Eterm *args;
+
+ /* This is an internal BIF, so the error checking is mostly left to erlang
+ * code. */
+
+ ASSERT(is_tuple_arity(arg_tuple, 5));
+ args = tuple_val(arg_tuple);
+
+ for (alloc_num = ERTS_ALC_A_MIN; alloc_num <= ERTS_ALC_A_MAX; alloc_num++) {
+ if(erts_is_atom_str(ERTS_ALC_A2AD(alloc_num), args[1], 0)) {
+ break;
+ }
+ }
+
+ if (alloc_num > ERTS_ALC_A_MAX) {
+ BIF_ERROR(c_p, BADARG);
+ }
+
+ sched_id = signed_val(args[2]);
+ hist_width = signed_val(args[3]);
+ hist_start = signed_val(args[4]);
+
+ if (sched_id < 0 || sched_id > erts_no_schedulers) {
+ BIF_ERROR(c_p, BADARG);
+ }
+
+ msg_count = gather(c_p, alloc_num, sched_id, hist_width, hist_start, args[5]);
+
+ BIF_RET(make_small(msg_count));
+}
+
+BIF_RETTYPE erts_internal_gather_alloc_histograms_1(BIF_ALIST_1)
+{
+ return gather_histograms_helper(BIF_P, BIF_ARG_1,
+ erts_alcu_gather_alloc_histograms);
+}
+
+BIF_RETTYPE erts_internal_gather_carrier_info_1(BIF_ALIST_1)
+{
+ return gather_histograms_helper(BIF_P, BIF_ARG_1,
+ erts_alcu_gather_carrier_info);
+}
+
#ifdef ERTS_ENABLE_LOCK_COUNT
typedef struct {
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index a76d769283..f7ee408991 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -283,6 +283,13 @@ make_tid(Process *c_p, DbTable *tb)
return erts_mk_magic_ref(&hp, &c_p->off_heap, tb->common.btid);
}
+Eterm
+erts_db_make_tid(Process *c_p, DbTableCommon *tb)
+{
+ return make_tid(c_p, (DbTable*)tb);
+}
+
+
/*
** The meta hash table of all NAMED ets tables
diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h
index 318e90cb28..eb6da2c9fb 100644
--- a/erts/emulator/beam/erl_db.h
+++ b/erts/emulator/beam/erl_db.h
@@ -128,6 +128,7 @@ extern erts_atomic_t erts_ets_misc_mem_size;
Eterm erts_ets_colliding_names(Process*, Eterm name, Uint cnt);
Uint erts_db_get_max_tabs(void);
+Eterm erts_db_make_tid(Process *c_p, DbTableCommon *tb);
#ifdef ERTS_ENABLE_LOCK_COUNT
void erts_lcnt_enable_db_lock_count(DbTable *tb, int enable);
diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c
index 5d49b2ea14..cb5c496e90 100644
--- a/erts/emulator/beam/erl_db_hash.c
+++ b/erts/emulator/beam/erl_db_hash.c
@@ -340,8 +340,8 @@ typedef int (*extra_match_validator_t)(int keypos, Eterm match, Eterm guard, Ete
static struct ext_segtab* alloc_ext_segtab(DbTableHash* tb, unsigned seg_ix);
static void alloc_seg(DbTableHash *tb);
static int free_seg(DbTableHash *tb, int free_records);
-static HashDbTerm* next(DbTableHash *tb, Uint *iptr, erts_rwmtx_t** lck_ptr,
- HashDbTerm *list);
+static HashDbTerm* next_live(DbTableHash *tb, Uint *iptr, erts_rwmtx_t** lck_ptr,
+ HashDbTerm *list);
static HashDbTerm* search_list(DbTableHash* tb, Eterm key,
HashValue hval, HashDbTerm *list);
static void shrink(DbTableHash* tb, int nitems);
@@ -646,9 +646,9 @@ int db_create_hash(Process *p, DbTable *tbl)
rwmtx_opt.type = ERTS_RWMTX_TYPE_FREQUENT_READ;
if (erts_ets_rwmtx_spin_count >= 0)
rwmtx_opt.main_spincount = erts_ets_rwmtx_spin_count;
- tb->locks = (DbTableHashFineLocks*) erts_db_alloc_fnf(ERTS_ALC_T_DB_SEG, /* Other type maybe? */
- (DbTable *) tb,
- sizeof(DbTableHashFineLocks));
+ tb->locks = (DbTableHashFineLocks*) erts_db_alloc(ERTS_ALC_T_DB_SEG, /* Other type maybe? */
+ (DbTable *) tb,
+ sizeof(DbTableHashFineLocks));
for (i=0; i<DB_HASH_LOCK_CNT; ++i) {
erts_rwmtx_init_opt(&tb->locks->lck_vec[i].lck, &rwmtx_opt,
"db_hash_slot", tb->common.the_name, ERTS_LOCK_FLAGS_CATEGORY_DB);
@@ -672,19 +672,9 @@ static int db_first_hash(Process *p, DbTable *tbl, Eterm *ret)
erts_rwmtx_t* lck = RLOCK_HASH(tb,ix);
HashDbTerm* list;
- for (;;) {
- list = BUCKET(tb,ix);
- if (list != NULL) {
- if (list->hvalue == INVALID_HASH) {
- list = next(tb,&ix,&lck,list);
- }
- break;
- }
- if ((ix=next_slot(tb,ix,&lck)) == 0) {
- list = NULL;
- break;
- }
- }
+ list = BUCKET(tb,ix);
+ list = next_live(tb, &ix, &lck, list);
+
if (list != NULL) {
*ret = db_copy_key(p, tbl, &list->dbterm);
RUNLOCK_HASH(lck);
@@ -721,13 +711,13 @@ static int db_next_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
}
/* Key found */
- b = next(tb, &ix, &lck, b);
+ b = next_live(tb, &ix, &lck, b->next);
if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) {
while (b != 0) {
if (!has_live_key(tb, b, key, hval)) {
break;
}
- b = next(tb, &ix, &lck, b);
+ b = next_live(tb, &ix, &lck, b->next);
}
}
if (b == NULL) {
@@ -1463,20 +1453,24 @@ static ERTS_INLINE int on_mtraversal_simple_trap(Export* trap_function,
BUMP_ALL_REDS(p);
if (IS_USMALL(0, got)) {
- hp = HAlloc(p, base_halloc_sz + 5);
+ hp = HAllocX(p, base_halloc_sz + 5, ERTS_MAGIC_REF_THING_SIZE);
egot = make_small(got);
}
else {
- hp = HAlloc(p, base_halloc_sz + BIG_UINT_HEAP_SIZE + 5);
+ hp = HAllocX(p, base_halloc_sz + BIG_UINT_HEAP_SIZE + 5,
+ ERTS_MAGIC_REF_THING_SIZE);
egot = uint_to_big(got, hp);
hp += BIG_UINT_HEAP_SIZE;
}
if (is_first_trap) {
+ if (is_atom(tid))
+ tid = erts_db_make_tid(p, &tb->common);
mpb = erts_db_make_match_prog_ref(p, *mpp, &hp);
*mpp = NULL; /* otherwise the caller will destroy it */
}
else {
+ ASSERT(!is_atom(tid));
mpb = prev_continuation_tptr[3];
}
@@ -1590,11 +1584,17 @@ static int mtraversal_select_chunk_on_loop_ended(void* context_ptr, Sint slot_ix
been in 'user space' */
}
if (rest != NIL || slot_ix >= 0) { /* Need more calls */
- sc_context_ptr->hp = HAlloc(sc_context_ptr->p, 3 + 7 + ERTS_MAGIC_REF_THING_SIZE);
+ Eterm tid = sc_context_ptr->tid;
+ sc_context_ptr->hp = HAllocX(sc_context_ptr->p,
+ 3 + 7 + ERTS_MAGIC_REF_THING_SIZE,
+ ERTS_MAGIC_REF_THING_SIZE);
mpb = erts_db_make_match_prog_ref(sc_context_ptr->p, *mpp, &sc_context_ptr->hp);
+ if (is_atom(tid))
+ tid = erts_db_make_tid(sc_context_ptr->p,
+ &sc_context_ptr->tb->common);
continuation = TUPLE6(
sc_context_ptr->hp,
- sc_context_ptr->tid,
+ tid,
make_small(slot_ix),
make_small(sc_context_ptr->chunk_size),
mpb, rest,
@@ -1631,12 +1631,16 @@ static int mtraversal_select_chunk_on_trap(void* context_ptr, Sint slot_ix, Sint
BUMP_ALL_REDS(sc_context_ptr->p);
if (sc_context_ptr->prev_continuation_tptr == NULL) {
+ Eterm tid = sc_context_ptr->tid;
/* First time we're trapping */
- hp = HAlloc(sc_context_ptr->p, 7 + ERTS_MAGIC_REF_THING_SIZE);
+ hp = HAllocX(sc_context_ptr->p, 7 + ERTS_MAGIC_REF_THING_SIZE,
+ ERTS_MAGIC_REF_THING_SIZE);
+ if (is_atom(tid))
+ tid = erts_db_make_tid(sc_context_ptr->p, &sc_context_ptr->tb->common);
mpb = erts_db_make_match_prog_ref(sc_context_ptr->p, *mpp, &hp);
continuation = TUPLE6(
hp,
- sc_context_ptr->tid,
+ tid,
make_small(slot_ix),
make_small(sc_context_ptr->chunk_size),
mpb,
@@ -2905,14 +2909,14 @@ static HashDbTerm* search_list(DbTableHash* tb, Eterm key,
/* It return the next live object in a table, NULL if no more */
/* In-bucket: RLOCKED */
/* Out-bucket: RLOCKED unless NULL */
-static HashDbTerm* next(DbTableHash *tb, Uint *iptr, erts_rwmtx_t** lck_ptr,
- HashDbTerm *list)
+static HashDbTerm* next_live(DbTableHash *tb, Uint *iptr, erts_rwmtx_t** lck_ptr,
+ HashDbTerm *list)
{
int i;
ERTS_LC_ASSERT(IS_HASH_RLOCKED(tb,*iptr));
- for (list = list->next; list != NULL; list = list->next) {
+ for ( ; list != NULL; list = list->next) {
if (list->hvalue != INVALID_HASH)
return list;
}
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 5da8e3eda5..b498fd9cf9 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -61,7 +61,7 @@
# define ERTS_GC_ASSERT(B) ((void) 1)
#endif
-#if defined(DEBUG) && 0
+#if defined(DEBUG) && 1
# define HARDDEBUG 1
#endif
@@ -222,6 +222,24 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(gcireq,
ErtsGCInfoReq,
5,
ERTS_ALC_T_GC_INFO_REQ)
+
+static ERTS_INLINE void
+ensure_sigq_roots_available(Process *p)
+{
+ ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(p));
+ switch (p->flags & (F_OFF_HEAP_MSGQ|F_OFF_HEAP_MSGQ_CHNG)) {
+ case F_OFF_HEAP_MSGQ_CHNG:
+ case 0:
+ erts_proc_lock(p, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_sig_fetch(p);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ);
+ break;
+ default:
+ break;
+ }
+}
+
+
/*
* Initialize GC global data.
*/
@@ -420,11 +438,20 @@ erts_gc_after_bif_call_lhf(Process* p, ErlHeapFragment *live_hf_end,
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;
}
+ ensure_sigq_roots_available(p);
+
if (is_non_value(result)) {
if (p->freason == TRAP) {
#ifdef HIPE
@@ -642,7 +669,7 @@ check_for_possibly_long_gc(Process *p, Uint ygen_usage)
sz = ygen_usage;
sz += p->hend - p->stop;
if (p->flags & F_ON_HEAP_MSGQ)
- sz += p->sig_qs.len;
+ sz += erts_proc_sig_privqs_len(p);
if (major)
sz += p->old_htop - p->old_heap;
@@ -868,8 +895,11 @@ do_major_collection:
int
erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj, int fcalls)
{
- int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, fcalls, 0);
- int reds_left = ERTS_REDS_LEFT(p, fcalls);
+ int reds;
+ int reds_left;
+ ensure_sigq_roots_available(p);
+ reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, fcalls, 0);
+ reds_left = ERTS_REDS_LEFT(p, fcalls);
if (reds > reds_left)
reds = reds_left;
ASSERT(CONTEXT_REDS - (reds_left - reds) >= erts_proc_sched_data(p)->virtual_reds);
@@ -879,7 +909,9 @@ erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj, int fca
void
erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
{
- int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, p->fcalls, 0);
+ int reds;
+ ensure_sigq_roots_available(p);
+ reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, p->fcalls, 0);
BUMP_REDS(p, reds);
ASSERT(CONTEXT_REDS - ERTS_BIF_REDS_LEFT(p)
>= erts_proc_sched_data(p)->virtual_reds);
@@ -1105,6 +1137,8 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
* First an ordinary major collection...
*/
+ ensure_sigq_roots_available(p);
+
p->flags |= F_NEED_FULLSWEEP;
if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(p)))
@@ -2541,14 +2575,17 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
break;
case F_OFF_HEAP_MSGQ_CHNG:
case 0: {
+ Sint len;
/*
* We do not have off heap message queue enabled, i.e. we
- * need to add message queue to rootset...
+ * need to add signal queues to rootset...
*/
+ len = erts_proc_sig_privqs_len(p);
+
/* Ensure large enough rootset... */
- if (n + p->sig_qs.len > rootset->size) {
- Uint new_size = n + p->sig_qs.len;
+ if (n + len > rootset->size) {
+ Uint new_size = n + len;
ERTS_GC_ASSERT(roots == rootset->def);
roots = erts_alloc(ERTS_ALC_T_ROOTSET,
new_size*sizeof(Roots));
@@ -3448,7 +3485,7 @@ erts_max_heap_size_map(Sint max_heap_size, Uint max_heap_flags,
Eterm **hpp, Uint *sz)
{
if (!hpp) {
- *sz += (2*3 + 1 + MAP_HEADER_FLATMAP_SZ);
+ *sz += ERTS_MAX_HEAP_SIZE_MAP_SZ;
return THE_NON_VALUE;
} else {
Eterm *hp = *hpp;
diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h
index 63d03cdf8b..b9b1ed728c 100644
--- a/erts/emulator/beam/erl_gc.h
+++ b/erts/emulator/beam/erl_gc.h
@@ -154,6 +154,8 @@ typedef struct {
Uint64 garbage_cols;
} ErtsGCInfo;
+#define ERTS_MAX_HEAP_SIZE_MAP_SZ (2*3 + 1 + MAP_HEADER_FLATMAP_SZ)
+
#define ERTS_PROCESS_GC_INFO_MAX_TERMS (11) /* number of elements in process_gc_info*/
#define ERTS_PROCESS_GC_INFO_MAX_SIZE \
(ERTS_PROCESS_GC_INFO_MAX_TERMS * (2/*cons*/ + 3/*2-tuple*/ + BIG_UINT_HEAP_SIZE))
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index 179822cc0b..57c6c10c7f 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -37,7 +37,7 @@
#include "erl_mseg.h"
#include "erl_threads.h"
#include "erl_hl_timer.h"
-#include "erl_instrument.h"
+#include "erl_mtrace.h"
#include "erl_printf_term.h"
#include "erl_misc_utils.h"
#include "packet_parser.h"
diff --git a/erts/emulator/beam/erl_instrument.c b/erts/emulator/beam/erl_instrument.c
deleted file mode 100644
index 2f70e7996e..0000000000
--- a/erts/emulator/beam/erl_instrument.c
+++ /dev/null
@@ -1,1257 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2003-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "global.h"
-#include "big.h"
-#include "erl_instrument.h"
-#include "erl_threads.h"
-
-typedef union { long l; double d; } Align_t;
-
-typedef struct {
- Uint size;
-#ifdef VALGRIND
- void* valgrind_leak_suppressor;
-#endif
- Align_t mem[1];
-} StatBlock_t;
-
-#define STAT_BLOCK_HEADER_SIZE (sizeof(StatBlock_t) - sizeof(Align_t))
-
-typedef struct MapStatBlock_t_ MapStatBlock_t;
-struct MapStatBlock_t_ {
- Uint size;
- ErtsAlcType_t type_no;
- Eterm pid;
- MapStatBlock_t *prev;
- MapStatBlock_t *next;
- Align_t mem[1];
-};
-
-#define MAP_STAT_BLOCK_HEADER_SIZE (sizeof(MapStatBlock_t) - sizeof(Align_t))
-
-typedef struct {
- Uint size;
- Uint max_size;
- Uint max_size_ever;
-
- Uint blocks;
- Uint max_blocks;
- Uint max_blocks_ever;
-} Stat_t;
-
-static erts_mtx_t instr_mutex;
-static erts_mtx_t instr_x_mutex;
-
-int erts_instr_memory_map;
-int erts_instr_stat;
-
-static ErtsAllocatorFunctions_t real_allctrs[ERTS_ALC_A_MAX+1];
-
-struct stats_ {
- Stat_t tot;
- Stat_t a[ERTS_ALC_A_MAX+1];
- Stat_t *ap[ERTS_ALC_A_MAX+1];
- Stat_t c[ERTS_ALC_C_MAX+1];
- Stat_t n[ERTS_ALC_N_MAX+1];
-};
-
-static struct stats_ *stats;
-
-static MapStatBlock_t *mem_anchor;
-
-static Eterm *am_tot;
-static Eterm *am_n;
-static Eterm *am_a;
-static Eterm *am_c;
-
-static int atoms_initialized;
-
-static struct {
- Eterm total;
- Eterm allocators;
- Eterm classes;
- Eterm types;
- Eterm sizes;
- Eterm blocks;
- Eterm instr_hdr;
-#ifdef DEBUG
- Eterm end_of_atoms;
-#endif
-} am;
-
-static void ERTS_INLINE atom_init(Eterm *atom, const char *name)
-{
- *atom = am_atom_put((char *) name, sys_strlen(name));
-}
-#define AM_INIT(AM) atom_init(&am.AM, #AM)
-
-static void
-init_atoms(void)
-{
-#ifdef DEBUG
- Eterm *atom;
- for (atom = (Eterm *) &am; atom <= &am.end_of_atoms; atom++) {
- *atom = THE_NON_VALUE;
- }
-#endif
-
- AM_INIT(total);
- AM_INIT(allocators);
- AM_INIT(classes);
- AM_INIT(types);
- AM_INIT(sizes);
- AM_INIT(blocks);
- AM_INIT(instr_hdr);
-
-#ifdef DEBUG
- for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) {
- ASSERT(*atom != THE_NON_VALUE);
- }
-#endif
-
- atoms_initialized = 1;
-}
-
-#undef AM_INIT
-
-static void
-init_am_tot(void)
-{
- am_tot = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO,
- sizeof(Eterm));
- atom_init(am_tot, "total");
-}
-
-
-static void
-init_am_n(void)
-{
- int i;
- am_n = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO,
- (ERTS_ALC_N_MAX+1)*sizeof(Eterm));
-
- for (i = ERTS_ALC_N_MIN; i <= ERTS_ALC_N_MAX; i++) {
- atom_init(&am_n[i], ERTS_ALC_N2TD(i));
- }
-
-}
-
-static void
-init_am_c(void)
-{
- int i;
- am_c = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO,
- (ERTS_ALC_C_MAX+1)*sizeof(Eterm));
-
- for (i = ERTS_ALC_C_MIN; i <= ERTS_ALC_C_MAX; i++) {
- atom_init(&am_c[i], ERTS_ALC_C2CD(i));
- }
-
-}
-
-static void
-init_am_a(void)
-{
- int i;
- am_a = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO,
- (ERTS_ALC_A_MAX+1)*sizeof(Eterm));
-
- for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- atom_init(&am_a[i], ERTS_ALC_A2AD(i));
- }
-
-}
-
-static ERTS_INLINE void
-stat_upd_alloc(ErtsAlcType_t n, Uint size)
-{
- ErtsAlcType_t t = ERTS_ALC_N2T(n);
- ErtsAlcType_t a = ERTS_ALC_T2A(t);
- ErtsAlcType_t c = ERTS_ALC_T2C(t);
-
- stats->ap[a]->size += size;
- if (stats->ap[a]->max_size < stats->ap[a]->size)
- stats->ap[a]->max_size = stats->ap[a]->size;
-
- stats->c[c].size += size;
- if (stats->c[c].max_size < stats->c[c].size)
- stats->c[c].max_size = stats->c[c].size;
-
- stats->n[n].size += size;
- if (stats->n[n].max_size < stats->n[n].size)
- stats->n[n].max_size = stats->n[n].size;
-
- stats->tot.size += size;
- if (stats->tot.max_size < stats->tot.size)
- stats->tot.max_size = stats->tot.size;
-
- stats->ap[a]->blocks++;
- if (stats->ap[a]->max_blocks < stats->ap[a]->blocks)
- stats->ap[a]->max_blocks = stats->ap[a]->blocks;
-
- stats->c[c].blocks++;
- if (stats->c[c].max_blocks < stats->c[c].blocks)
- stats->c[c].max_blocks = stats->c[c].blocks;
-
- stats->n[n].blocks++;
- if (stats->n[n].max_blocks < stats->n[n].blocks)
- stats->n[n].max_blocks = stats->n[n].blocks;
-
- stats->tot.blocks++;
- if (stats->tot.max_blocks < stats->tot.blocks)
- stats->tot.max_blocks = stats->tot.blocks;
-
-}
-
-
-static ERTS_INLINE void
-stat_upd_free(ErtsAlcType_t n, Uint size)
-{
- ErtsAlcType_t t = ERTS_ALC_N2T(n);
- ErtsAlcType_t a = ERTS_ALC_T2A(t);
- ErtsAlcType_t c = ERTS_ALC_T2C(t);
-
- ASSERT(stats->ap[a]->size >= size);
- stats->ap[a]->size -= size;
-
- ASSERT(stats->c[c].size >= size);
- stats->c[c].size -= size;
-
- ASSERT(stats->n[n].size >= size);
- stats->n[n].size -= size;
-
- ASSERT(stats->tot.size >= size);
- stats->tot.size -= size;
-
- ASSERT(stats->ap[a]->blocks > 0);
- stats->ap[a]->blocks--;
-
- ASSERT(stats->c[c].blocks > 0);
- stats->c[c].blocks--;
-
- ASSERT(stats->n[n].blocks > 0);
- stats->n[n].blocks--;
-
- ASSERT(stats->tot.blocks > 0);
- stats->tot.blocks--;
-
-}
-
-
-static ERTS_INLINE void
-stat_upd_realloc(ErtsAlcType_t n, Uint size, Uint old_size)
-{
- if (old_size)
- stat_upd_free(n, old_size);
- stat_upd_alloc(n, size);
-}
-
-/*
- * stat instrumentation callback functions
- */
-
-static void stat_pre_lock(void)
-{
- erts_mtx_lock(&instr_mutex);
-}
-
-static void stat_pre_unlock(void)
-{
- erts_mtx_unlock(&instr_mutex);
-}
-
-static ErtsAllocatorWrapper_t instr_wrapper;
-
-static void *
-stat_alloc(ErtsAlcType_t n, void *extra, Uint size)
-{
- ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra;
- Uint ssize;
- void *res;
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_lock(&instr_mutex);
- }
-
- ssize = size + STAT_BLOCK_HEADER_SIZE;
- res = (*real_af->alloc)(n, real_af->extra, ssize);
- if (res) {
- stat_upd_alloc(n, size);
- ((StatBlock_t *) res)->size = size;
-#ifdef VALGRIND
- /* Suppress "possibly leaks" by storing an actual dummy pointer
- to the _start_ of the allocated block.*/
- ((StatBlock_t *) res)->valgrind_leak_suppressor = res;
-#endif
- res = (void *) ((StatBlock_t *) res)->mem;
- }
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_unlock(&instr_mutex);
- }
-
- return res;
-}
-
-static void *
-stat_realloc(ErtsAlcType_t n, void *extra, void *ptr, Uint size)
-{
- ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra;
- Uint old_size;
- Uint ssize;
- void *sptr;
- void *res;
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_lock(&instr_mutex);
- }
-
- if (ptr) {
- sptr = (void *) (((char *) ptr) - STAT_BLOCK_HEADER_SIZE);
- old_size = ((StatBlock_t *) sptr)->size;
- }
- else {
- sptr = NULL;
- old_size = 0;
- }
-
- ssize = size + STAT_BLOCK_HEADER_SIZE;
- res = (*real_af->realloc)(n, real_af->extra, sptr, ssize);
- if (res) {
- stat_upd_realloc(n, size, old_size);
- ((StatBlock_t *) res)->size = size;
-#ifdef VALGRIND
- ((StatBlock_t *) res)->valgrind_leak_suppressor = res;
-#endif
- res = (void *) ((StatBlock_t *) res)->mem;
- }
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_unlock(&instr_mutex);
- }
-
- return res;
-}
-
-static void
-stat_free(ErtsAlcType_t n, void *extra, void *ptr)
-{
- ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra;
- void *sptr;
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_lock(&instr_mutex);
- }
-
- if (ptr) {
- sptr = (void *) (((char *) ptr) - STAT_BLOCK_HEADER_SIZE);
- stat_upd_free(n, ((StatBlock_t *) sptr)->size);
- }
- else {
- sptr = NULL;
- }
-
- (*real_af->free)(n, real_af->extra, sptr);
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_unlock(&instr_mutex);
- }
-
-}
-
-/*
- * map stat instrumentation callback functions
- */
-
-static void map_stat_pre_lock(void)
-{
- erts_mtx_lock(&instr_x_mutex);
- erts_mtx_lock(&instr_mutex);
-}
-
-static void map_stat_pre_unlock(void)
-{
- erts_mtx_unlock(&instr_mutex);
- erts_mtx_unlock(&instr_x_mutex);
-}
-
-static void *
-map_stat_alloc(ErtsAlcType_t n, void *extra, Uint size)
-{
- ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra;
- Uint msize;
- void *res;
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_lock(&instr_mutex);
- }
-
- msize = size + MAP_STAT_BLOCK_HEADER_SIZE;
- res = (*real_af->alloc)(n, real_af->extra, msize);
- if (res) {
- MapStatBlock_t *mb = (MapStatBlock_t *) res;
- stat_upd_alloc(n, size);
-
- mb->size = size;
- mb->type_no = n;
- mb->pid = erts_get_current_pid();
-
- mb->prev = NULL;
- mb->next = mem_anchor;
- if (mem_anchor)
- mem_anchor->prev = mb;
- mem_anchor = mb;
-
- res = (void *) mb->mem;
- }
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_unlock(&instr_mutex);
- }
-
- return res;
-}
-
-static void *
-map_stat_realloc(ErtsAlcType_t n, void *extra, void *ptr, Uint size)
-{
- ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra;
- Uint old_size;
- Uint msize;
- void *mptr;
- void *res;
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_lock(&instr_x_mutex);
- erts_mtx_lock(&instr_mutex);
- }
-
- if (ptr) {
- mptr = (void *) (((char *) ptr) - MAP_STAT_BLOCK_HEADER_SIZE);
- old_size = ((MapStatBlock_t *) mptr)->size;
- }
- else {
- mptr = NULL;
- old_size = 0;
- }
-
- msize = size + MAP_STAT_BLOCK_HEADER_SIZE;
- res = (*real_af->realloc)(n, real_af->extra, mptr, msize);
- if (res) {
- MapStatBlock_t *mb = (MapStatBlock_t *) res;
-
- mb->size = size;
- mb->type_no = n;
- mb->pid = erts_get_current_pid();
-
- stat_upd_realloc(n, size, old_size);
-
- if (mptr != res) {
-
- if (mptr) {
- if (mb->prev)
- mb->prev->next = mb;
- else {
- ASSERT(mem_anchor == (MapStatBlock_t *) mptr);
- mem_anchor = mb;
- }
- if (mb->next)
- mb->next->prev = mb;
- }
- else {
- mb->prev = NULL;
- mb->next = mem_anchor;
- if (mem_anchor)
- mem_anchor->prev = mb;
- mem_anchor = mb;
- }
-
- }
-
- res = (void *) mb->mem;
- }
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_unlock(&instr_mutex);
- erts_mtx_unlock(&instr_x_mutex);
- }
-
- return res;
-}
-
-static void
-map_stat_free(ErtsAlcType_t n, void *extra, void *ptr)
-{
- ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra;
- void *mptr;
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_lock(&instr_x_mutex);
- erts_mtx_lock(&instr_mutex);
- }
-
- if (ptr) {
- MapStatBlock_t *mb;
-
- mptr = (void *) (((char *) ptr) - MAP_STAT_BLOCK_HEADER_SIZE);
- mb = (MapStatBlock_t *) mptr;
-
- stat_upd_free(n, mb->size);
-
- if (mb->prev)
- mb->prev->next = mb->next;
- else
- mem_anchor = mb->next;
- if (mb->next)
- mb->next->prev = mb->prev;
- }
- else {
- mptr = NULL;
- }
-
- (*real_af->free)(n, real_af->extra, mptr);
-
- if (!erts_is_allctr_wrapper_prelocked()) {
- erts_mtx_unlock(&instr_mutex);
- erts_mtx_unlock(&instr_x_mutex);
- }
-
-}
-
-static void dump_memory_map_to_stream(fmtfn_t to, void* to_arg)
-{
- ErtsAlcType_t n;
- MapStatBlock_t *bp;
- int lock = !ERTS_IS_CRASH_DUMPING;
- if (lock) {
- ASSERT(!erts_is_allctr_wrapper_prelocked());
- erts_mtx_lock(&instr_mutex);
- }
-
- /* Write header */
-
- erts_cbprintf(to, to_arg,
- "{instr_hdr,\n"
- " %lu,\n"
- " %lu,\n"
- " {",
- (unsigned long) ERTS_INSTR_VSN,
- (unsigned long) MAP_STAT_BLOCK_HEADER_SIZE);
-
-#if ERTS_ALC_N_MIN != 1
-#error ERTS_ALC_N_MIN is not 1
-#endif
-
- for (n = ERTS_ALC_N_MIN; n <= ERTS_ALC_N_MAX; n++) {
- ErtsAlcType_t t = ERTS_ALC_N2T(n);
- ErtsAlcType_t a = ERTS_ALC_T2A(t);
- ErtsAlcType_t c = ERTS_ALC_T2C(t);
- const char *astr;
-
- if (erts_allctrs_info[a].enabled)
- astr = ERTS_ALC_A2AD(a);
- else
- astr = ERTS_ALC_A2AD(ERTS_ALC_A_SYSTEM);
-
- erts_cbprintf(to, to_arg,
- "%s{%s,%s,%s}%s",
- (n == ERTS_ALC_N_MIN) ? "" : " ",
- ERTS_ALC_N2TD(n),
- astr,
- ERTS_ALC_C2CD(c),
- (n == ERTS_ALC_N_MAX) ? "" : ",\n");
- }
-
- erts_cbprintf(to, to_arg, "}}.\n");
-
- /* Write memory data */
- for (bp = mem_anchor; bp; bp = bp->next) {
- if (is_internal_pid(bp->pid))
- erts_cbprintf(to, to_arg,
- "{%lu, %lu, %lu, {%lu,%lu,%lu}}.\n",
- (UWord) bp->type_no,
- (UWord) bp->mem,
- (UWord) bp->size,
- (UWord) pid_channel_no(bp->pid),
- (UWord) pid_number(bp->pid),
- (UWord) pid_serial(bp->pid));
- else
- erts_cbprintf(to, to_arg,
- "{%lu, %lu, %lu, undefined}.\n",
- (UWord) bp->type_no,
- (UWord) bp->mem,
- (UWord) bp->size);
- }
-
- if (lock)
- erts_mtx_unlock(&instr_mutex);
-}
-
-int erts_instr_dump_memory_map_to(fmtfn_t to, void* to_arg)
-{
- if (!erts_instr_memory_map)
- return 0;
-
- dump_memory_map_to_stream(to, to_arg);
- return 1;
-}
-
-int erts_instr_dump_memory_map(const char *name)
-{
- int fd;
-
- if (!erts_instr_memory_map)
- return 0;
-
- fd = open(name, O_WRONLY | O_CREAT | O_TRUNC, 0640);
- if (fd < 0)
- return 0;
-
- dump_memory_map_to_stream(erts_write_fd, (void*)&fd);
-
- close(fd);
- return 1;
-}
-
-Eterm erts_instr_get_memory_map(Process *proc)
-{
- MapStatBlock_t *org_mem_anchor;
- Eterm hdr_tuple, md_list, res;
- Eterm *hp;
- Uint hsz;
- MapStatBlock_t *bp;
-#ifdef DEBUG
- Eterm *end_hp;
-#endif
-
- if (!erts_instr_memory_map)
- return am_false;
-
- if (!atoms_initialized)
- init_atoms();
- if (!am_n)
- init_am_n();
- if (!am_c)
- init_am_c();
- if (!am_a)
- init_am_a();
-
- erts_mtx_lock(&instr_x_mutex);
- erts_mtx_lock(&instr_mutex);
-
- /* Header size */
- hsz = 5 + 1 + (ERTS_ALC_N_MAX+1-ERTS_ALC_N_MIN)*(1 + 4);
-
- /* Memory data list */
- for (bp = mem_anchor; bp; bp = bp->next) {
- if (is_internal_pid(bp->pid)) {
-#if (_PID_NUM_SIZE - 1 > MAX_SMALL)
- if (internal_pid_number(bp->pid) > MAX_SMALL)
- hsz += BIG_UINT_HEAP_SIZE;
-#endif
-#if (_PID_SER_SIZE - 1 > MAX_SMALL)
- if (internal_pid_serial(bp->pid) > MAX_SMALL)
- hsz += BIG_UINT_HEAP_SIZE;
-#endif
- hsz += 4;
- }
-
- if ((UWord) bp->mem > MAX_SMALL)
- hsz += BIG_UINT_HEAP_SIZE;
- if (bp->size > MAX_SMALL)
- hsz += BIG_UINT_HEAP_SIZE;
-
- hsz += 5 + 2;
- }
-
- hsz += 3; /* Root tuple */
-
- org_mem_anchor = mem_anchor;
- mem_anchor = NULL;
-
- erts_mtx_unlock(&instr_mutex);
-
- hp = HAlloc(proc, hsz); /* May end up calling map_stat_alloc() */
-
- erts_mtx_lock(&instr_mutex);
-
-#ifdef DEBUG
- end_hp = hp + hsz;
-#endif
-
- { /* Build header */
- ErtsAlcType_t n;
- Eterm type_map;
- Uint *hp2 = hp;
-#ifdef DEBUG
- Uint *hp2_end;
-#endif
-
- hp += (ERTS_ALC_N_MAX + 1 - ERTS_ALC_N_MIN)*4;
-
-#ifdef DEBUG
- hp2_end = hp;
-#endif
-
- type_map = make_tuple(hp);
- *(hp++) = make_arityval(ERTS_ALC_N_MAX + 1 - ERTS_ALC_N_MIN);
-
- for (n = ERTS_ALC_N_MIN; n <= ERTS_ALC_N_MAX; n++) {
- ErtsAlcType_t t = ERTS_ALC_N2T(n);
- ErtsAlcType_t a = ERTS_ALC_T2A(t);
- ErtsAlcType_t c = ERTS_ALC_T2C(t);
-
- if (!erts_allctrs_info[a].enabled)
- a = ERTS_ALC_A_SYSTEM;
-
- *(hp++) = TUPLE3(hp2, am_n[n], am_a[a], am_c[c]);
- hp2 += 4;
- }
-
- ASSERT(hp2 == hp2_end);
-
- hdr_tuple = TUPLE4(hp,
- am.instr_hdr,
- make_small(ERTS_INSTR_VSN),
- make_small(MAP_STAT_BLOCK_HEADER_SIZE),
- type_map);
-
- hp += 5;
- }
-
- /* Build memory data list */
-
- for (md_list = NIL, bp = org_mem_anchor; bp; bp = bp->next) {
- Eterm tuple;
- Eterm type;
- Eterm ptr;
- Eterm size;
- Eterm pid;
-
- if (is_not_internal_pid(bp->pid))
- pid = am_undefined;
- else {
- Eterm c;
- Eterm n;
- Eterm s;
-
-#if (ERST_INTERNAL_CHANNEL_NO > MAX_SMALL)
-#error Oversized internal channel number
-#endif
- c = make_small(ERST_INTERNAL_CHANNEL_NO);
-
-#if (_PID_NUM_SIZE - 1 > MAX_SMALL)
- if (internal_pid_number(bp->pid) > MAX_SMALL) {
- n = uint_to_big(internal_pid_number(bp->pid), hp);
- hp += BIG_UINT_HEAP_SIZE;
- }
- else
-#endif
- n = make_small(internal_pid_number(bp->pid));
-
-#if (_PID_SER_SIZE - 1 > MAX_SMALL)
- if (internal_pid_serial(bp->pid) > MAX_SMALL) {
- s = uint_to_big(internal_pid_serial(bp->pid), hp);
- hp += BIG_UINT_HEAP_SIZE;
- }
- else
-#endif
- s = make_small(internal_pid_serial(bp->pid));
- pid = TUPLE3(hp, c, n, s);
- hp += 4;
- }
-
-
-#if ERTS_ALC_N_MAX > MAX_SMALL
-#error Oversized memory type number
-#endif
- type = make_small(bp->type_no);
-
- if ((UWord) bp->mem > MAX_SMALL) {
- ptr = uint_to_big((UWord) bp->mem, hp);
- hp += BIG_UINT_HEAP_SIZE;
- }
- else
- ptr = make_small((UWord) bp->mem);
-
- if (bp->size > MAX_SMALL) {
- size = uint_to_big(bp->size, hp);
- hp += BIG_UINT_HEAP_SIZE;
- }
- else
- size = make_small(bp->size);
-
- tuple = TUPLE4(hp, type, ptr, size, pid);
- hp += 5;
-
- md_list = CONS(hp, tuple, md_list);
- hp += 2;
- }
-
- res = TUPLE2(hp, hdr_tuple, md_list);
-
- ASSERT(hp + 3 == end_hp);
-
- if (mem_anchor) {
- for (bp = mem_anchor; bp->next; bp = bp->next)
- ;
- ASSERT(org_mem_anchor);
- org_mem_anchor->prev = bp;
- bp->next = org_mem_anchor;
- }
- else {
- mem_anchor = org_mem_anchor;
- }
-
- erts_mtx_unlock(&instr_mutex);
- erts_mtx_unlock(&instr_x_mutex);
-
- return res;
-}
-
-static ERTS_INLINE void
-begin_new_max_period(Stat_t *stat, int min, int max)
-{
- int i;
- for (i = min; i <= max; i++) {
- stat[i].max_size = stat[i].size;
- stat[i].max_blocks = stat[i].blocks;
- }
-}
-
-static ERTS_INLINE void
-update_max_ever_values(Stat_t *stat, int min, int max)
-{
- int i;
- for (i = min; i <= max; i++) {
- if (stat[i].max_size_ever < stat[i].max_size)
- stat[i].max_size_ever = stat[i].max_size;
- if (stat[i].max_blocks_ever < stat[i].max_blocks)
- stat[i].max_blocks_ever = stat[i].max_blocks;
- }
-}
-
-#define bld_string erts_bld_string
-#define bld_tuple erts_bld_tuple
-#define bld_tuplev erts_bld_tuplev
-#define bld_list erts_bld_list
-#define bld_2tup_list erts_bld_2tup_list
-#define bld_uint erts_bld_uint
-
-Eterm
-erts_instr_get_stat(Process *proc, Eterm what, int begin_max_period)
-{
- int i, len, max, min, allctr;
- Eterm *names, *values, res;
- Uint arr_size, stat_size, hsz, *hszp, *hp, **hpp;
- Stat_t *stat_src, *stat;
-
- if (!erts_instr_stat)
- return am_false;
-
- if (!atoms_initialized)
- init_atoms();
-
- if (what == am.total) {
- min = 0;
- max = 0;
- allctr = 0;
- stat_size = sizeof(Stat_t);
- stat_src = &stats->tot;
- if (!am_tot)
- init_am_tot();
- names = am_tot;
- }
- else if (what == am.allocators) {
- min = ERTS_ALC_A_MIN;
- max = ERTS_ALC_A_MAX;
- allctr = 1;
- stat_size = sizeof(Stat_t)*(ERTS_ALC_A_MAX+1);
- stat_src = stats->a;
- if (!am_a)
- init_am_a();
- names = am_a;
- }
- else if (what == am.classes) {
- min = ERTS_ALC_C_MIN;
- max = ERTS_ALC_C_MAX;
- allctr = 0;
- stat_size = sizeof(Stat_t)*(ERTS_ALC_C_MAX+1);
- stat_src = stats->c;
- if (!am_c)
- init_am_c();
- names = &am_c[ERTS_ALC_C_MIN];
- }
- else if (what == am.types) {
- min = ERTS_ALC_N_MIN;
- max = ERTS_ALC_N_MAX;
- allctr = 0;
- stat_size = sizeof(Stat_t)*(ERTS_ALC_N_MAX+1);
- stat_src = stats->n;
- if (!am_n)
- init_am_n();
- names = &am_n[ERTS_ALC_N_MIN];
- }
- else {
- return THE_NON_VALUE;
- }
-
- stat = (Stat_t *) erts_alloc(ERTS_ALC_T_TMP, stat_size);
-
- arr_size = (max - min + 1)*sizeof(Eterm);
-
- if (allctr)
- names = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, arr_size);
-
- values = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, arr_size);
-
- erts_mtx_lock(&instr_mutex);
-
- update_max_ever_values(stat_src, min, max);
-
- sys_memcpy((void *) stat, (void *) stat_src, stat_size);
-
- if (begin_max_period)
- begin_new_max_period(stat_src, min, max);
-
- erts_mtx_unlock(&instr_mutex);
-
- hsz = 0;
- hszp = &hsz;
- hpp = NULL;
-
- restart_bld:
-
- len = 0;
- for (i = min; i <= max; i++) {
- if (!allctr || erts_allctrs_info[i].enabled) {
- Eterm s[2];
-
- if (allctr)
- names[len] = am_a[i];
-
- s[0] = bld_tuple(hpp, hszp, 4,
- am.sizes,
- bld_uint(hpp, hszp, stat[i].size),
- bld_uint(hpp, hszp, stat[i].max_size),
- bld_uint(hpp, hszp, stat[i].max_size_ever));
-
- s[1] = bld_tuple(hpp, hszp, 4,
- am.blocks,
- bld_uint(hpp, hszp, stat[i].blocks),
- bld_uint(hpp, hszp, stat[i].max_blocks),
- bld_uint(hpp, hszp, stat[i].max_blocks_ever));
-
- values[len] = bld_list(hpp, hszp, 2, s);
-
- len++;
- }
- }
-
- res = bld_2tup_list(hpp, hszp, len, names, values);
-
- if (!hpp) {
- hp = HAlloc(proc, hsz);
- hszp = NULL;
- hpp = &hp;
- goto restart_bld;
- }
-
- erts_free(ERTS_ALC_T_TMP, (void *) stat);
- erts_free(ERTS_ALC_T_TMP, (void *) values);
- if (allctr)
- erts_free(ERTS_ALC_T_TMP, (void *) names);
-
- return res;
-}
-
-static void
-dump_stat_to_stream(fmtfn_t to, void* to_arg, int begin_max_period)
-{
- ErtsAlcType_t i, a_max, a_min;
-
- erts_mtx_lock(&instr_mutex);
-
- erts_cbprintf(to, to_arg,
- "{instr_vsn,%lu}.\n",
- (unsigned long) ERTS_INSTR_VSN);
-
- update_max_ever_values(&stats->tot, 0, 0);
-
- erts_cbprintf(to, to_arg,
- "{total,[{total,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}]}.\n",
- (UWord) stats->tot.size,
- (UWord) stats->tot.max_size,
- (UWord) stats->tot.max_size_ever,
- (UWord) stats->tot.blocks,
- (UWord) stats->tot.max_blocks,
- (UWord) stats->tot.max_blocks_ever);
-
- a_max = 0;
- a_min = ~0;
- for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- if (erts_allctrs_info[i].enabled) {
- if (a_min > i)
- a_min = i;
- if (a_max < i)
- a_max = i;
- }
- }
-
- ASSERT(ERTS_ALC_A_MIN <= a_min && a_min <= ERTS_ALC_A_MAX);
- ASSERT(ERTS_ALC_A_MIN <= a_max && a_max <= ERTS_ALC_A_MAX);
- ASSERT(a_min <= a_max);
-
- update_max_ever_values(stats->a, a_min, a_max);
-
- for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- if (erts_allctrs_info[i].enabled) {
- erts_cbprintf(to, to_arg,
- "%s{%s,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}%s",
- i == a_min ? "{allocators,\n [" : " ",
- ERTS_ALC_A2AD(i),
- (UWord) stats->a[i].size,
- (UWord) stats->a[i].max_size,
- (UWord) stats->a[i].max_size_ever,
- (UWord) stats->a[i].blocks,
- (UWord) stats->a[i].max_blocks,
- (UWord) stats->a[i].max_blocks_ever,
- i == a_max ? "]}.\n" : ",\n");
- }
- }
-
- update_max_ever_values(stats->c, ERTS_ALC_C_MIN, ERTS_ALC_C_MAX);
-
- for (i = ERTS_ALC_C_MIN; i <= ERTS_ALC_C_MAX; i++) {
- erts_cbprintf(to, to_arg,
- "%s{%s,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}%s",
- i == ERTS_ALC_C_MIN ? "{classes,\n [" : " ",
- ERTS_ALC_C2CD(i),
- (UWord) stats->c[i].size,
- (UWord) stats->c[i].max_size,
- (UWord) stats->c[i].max_size_ever,
- (UWord) stats->c[i].blocks,
- (UWord) stats->c[i].max_blocks,
- (UWord) stats->c[i].max_blocks_ever,
- i == ERTS_ALC_C_MAX ? "]}.\n" : ",\n" );
- }
-
- update_max_ever_values(stats->n, ERTS_ALC_N_MIN, ERTS_ALC_N_MAX);
-
- for (i = ERTS_ALC_N_MIN; i <= ERTS_ALC_N_MAX; i++) {
- erts_cbprintf(to, to_arg,
- "%s{%s,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}%s",
- i == ERTS_ALC_N_MIN ? "{types,\n [" : " ",
- ERTS_ALC_N2TD(i),
- (UWord) stats->n[i].size,
- (UWord) stats->n[i].max_size,
- (UWord) stats->n[i].max_size_ever,
- (UWord) stats->n[i].blocks,
- (UWord) stats->n[i].max_blocks,
- (UWord) stats->n[i].max_blocks_ever,
- i == ERTS_ALC_N_MAX ? "]}.\n" : ",\n" );
- }
-
- if (begin_max_period) {
- begin_new_max_period(&stats->tot, 0, 0);
- begin_new_max_period(stats->a, a_min, a_max);
- begin_new_max_period(stats->c, ERTS_ALC_C_MIN, ERTS_ALC_C_MAX);
- begin_new_max_period(stats->n, ERTS_ALC_N_MIN, ERTS_ALC_N_MAX);
- }
-
- erts_mtx_unlock(&instr_mutex);
-
-}
-
-int erts_instr_dump_stat_to(fmtfn_t to, void* to_arg, int begin_max_period)
-{
- if (!erts_instr_stat)
- return 0;
-
- dump_stat_to_stream(to, to_arg, begin_max_period);
- return 1;
-}
-
-int erts_instr_dump_stat(const char *name, int begin_max_period)
-{
- int fd;
-
- if (!erts_instr_stat)
- return 0;
-
- fd = open(name, O_WRONLY | O_CREAT | O_TRUNC,0640);
- if (fd < 0)
- return 0;
-
- dump_stat_to_stream(erts_write_fd, (void*)&fd, begin_max_period);
-
- close(fd);
- return 1;
-}
-
-
-Uint
-erts_instr_get_total(void)
-{
- return erts_instr_stat ? stats->tot.size : 0;
-}
-
-Uint
-erts_instr_get_max_total(void)
-{
- if (erts_instr_stat) {
- update_max_ever_values(&stats->tot, 0, 0);
- return stats->tot.max_size_ever;
- }
- return 0;
-}
-
-Eterm
-erts_instr_get_type_info(Process *proc)
-{
- Eterm res, *tpls;
- Uint hsz, *hszp, *hp, **hpp;
- ErtsAlcType_t n;
-
- if (!am_n)
- init_am_n();
- if (!am_a)
- init_am_a();
- if (!am_c)
- init_am_c();
-
- tpls = (Eterm *) erts_alloc(ERTS_ALC_T_TMP,
- (ERTS_ALC_N_MAX-ERTS_ALC_N_MIN+1)
- * sizeof(Eterm));
- hsz = 0;
- hszp = &hsz;
- hpp = NULL;
-
- restart_bld:
-
-#if ERTS_ALC_N_MIN != 1
-#error ERTS_ALC_N_MIN is not 1
-#endif
-
- for (n = ERTS_ALC_N_MIN; n <= ERTS_ALC_N_MAX; n++) {
- ErtsAlcType_t t = ERTS_ALC_N2T(n);
- ErtsAlcType_t a = ERTS_ALC_T2A(t);
- ErtsAlcType_t c = ERTS_ALC_T2C(t);
-
- if (!erts_allctrs_info[a].enabled)
- a = ERTS_ALC_A_SYSTEM;
-
- tpls[n - ERTS_ALC_N_MIN]
- = bld_tuple(hpp, hszp, 3, am_n[n], am_a[a], am_c[c]);
- }
-
- res = bld_tuplev(hpp, hszp, ERTS_ALC_N_MAX-ERTS_ALC_N_MIN+1, tpls);
-
- if (!hpp) {
- hp = HAlloc(proc, hsz);
- hszp = NULL;
- hpp = &hp;
- goto restart_bld;
- }
-
- erts_free(ERTS_ALC_T_TMP, tpls);
-
- return res;
-}
-
-Uint
-erts_instr_init(int stat, int map_stat)
-{
- Uint extra_sz;
- int i;
-
- am_tot = NULL;
- am_n = NULL;
- am_c = NULL;
- am_a = NULL;
-
- erts_instr_memory_map = 0;
- erts_instr_stat = 0;
- atoms_initialized = 0;
-
- if (!stat && !map_stat)
- return 0;
-
- stats = erts_alloc(ERTS_ALC_T_INSTR_INFO, sizeof(struct stats_));
-
- erts_mtx_init(&instr_mutex, "instr", NIL,
- ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
-
- mem_anchor = NULL;
-
- /* Install instrumentation functions */
- ERTS_CT_ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs));
-
- sys_memcpy((void *)real_allctrs,(void *)erts_allctrs,sizeof(erts_allctrs));
-
- sys_memzero((void *) &stats->tot, sizeof(Stat_t));
- sys_memzero((void *) stats->a, sizeof(Stat_t)*(ERTS_ALC_A_MAX+1));
- sys_memzero((void *) stats->c, sizeof(Stat_t)*(ERTS_ALC_C_MAX+1));
- sys_memzero((void *) stats->n, sizeof(Stat_t)*(ERTS_ALC_N_MAX+1));
-
- for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- if (erts_allctrs_info[i].enabled)
- stats->ap[i] = &stats->a[i];
- else
- stats->ap[i] = &stats->a[ERTS_ALC_A_SYSTEM];
- }
-
- if (map_stat) {
-
- erts_mtx_init(&instr_x_mutex, "instr_x", NIL,
- ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG);
-
- erts_instr_memory_map = 1;
- erts_instr_stat = 1;
- for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- erts_allctrs[i].alloc = map_stat_alloc;
- erts_allctrs[i].realloc = map_stat_realloc;
- erts_allctrs[i].free = map_stat_free;
- erts_allctrs[i].extra = (void *) &real_allctrs[i];
- }
- instr_wrapper.lock = map_stat_pre_lock;
- instr_wrapper.unlock = map_stat_pre_unlock;
- extra_sz = MAP_STAT_BLOCK_HEADER_SIZE;
- }
- else {
- erts_instr_stat = 1;
- for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- erts_allctrs[i].alloc = stat_alloc;
- erts_allctrs[i].realloc = stat_realloc;
- erts_allctrs[i].free = stat_free;
- erts_allctrs[i].extra = (void *) &real_allctrs[i];
- }
- instr_wrapper.lock = stat_pre_lock;
- instr_wrapper.unlock = stat_pre_unlock;
- extra_sz = STAT_BLOCK_HEADER_SIZE;
- }
- erts_allctr_wrapper_prelock_init(&instr_wrapper);
- return extra_sz;
-}
-
diff --git a/erts/emulator/beam/erl_instrument.h b/erts/emulator/beam/erl_instrument.h
deleted file mode 100644
index 351172b2fa..0000000000
--- a/erts/emulator/beam/erl_instrument.h
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2003-2016. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-#ifndef ERL_INSTRUMENT_H__
-#define ERL_INSTRUMENT_H__
-
-#include "erl_mtrace.h"
-
-#define ERTS_INSTR_VSN 2
-
-extern int erts_instr_memory_map;
-extern int erts_instr_stat;
-
-Uint erts_instr_init(int stat, int map_stat);
-int erts_instr_dump_memory_map_to(fmtfn_t to, void* to_arg);
-int erts_instr_dump_memory_map(const char *name);
-Eterm erts_instr_get_memory_map(Process *process);
-int erts_instr_dump_stat_to(fmtfn_t to, void* to_arg, int begin_max_period);
-int erts_instr_dump_stat(const char *name, int begin_max_period);
-Eterm erts_instr_get_stat(Process *proc, Eterm what, int begin_max_period);
-Eterm erts_instr_get_type_info(Process *proc);
-Uint erts_instr_get_total(void);
-Uint erts_instr_get_max_total(void);
-
-#endif
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index 0ced5ec310..d66410367b 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -41,6 +41,7 @@
#include "erl_lock_check.h"
#include "erl_term.h"
#include "erl_threads.h"
+#include "erl_atom_table.h"
typedef struct {
char *name;
@@ -75,10 +76,10 @@ static erts_lc_lock_order_t erts_lock_order[] = {
* if only one lock use
* the lock name)"
*/
+ { "NO LOCK", NULL },
{ "driver_lock", "driver_name" },
{ "port_lock", "port_id" },
{ "port_data_lock", "address" },
- { "bif_timers", NULL },
{ "reg_tab", NULL },
{ "proc_main", "pid" },
{ "old_code", "address" },
@@ -103,7 +104,6 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "node_table", NULL },
{ "dist_table", NULL },
{ "sys_tracers", NULL },
- { "module_tab", NULL },
{ "export_tab", NULL },
{ "fun_tab", NULL },
{ "environ", NULL },
@@ -111,7 +111,6 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "drv_ev_state_grow", NULL, },
{ "drv_ev_state", "address" },
{ "safe_hash", "address" },
- { "removed_fd_pre_alloc_lock", "address" },
{ "state_prealloc", NULL },
{ "schdlr_sspnd", NULL },
{ "migration_info_update", NULL },
@@ -134,10 +133,6 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "msacc_list_mutex", NULL },
{ "msacc_unmanaged_mutex", NULL },
{ "atom_tab", NULL },
- { "misc_op_list_pre_alloc_lock", "address" },
- { "message_pre_alloc_lock", "address" },
- { "ptimer_pre_alloc_lock", "address", },
- { "btm_pre_alloc_lock", NULL, },
{ "dist_entry_out_queue", "address" },
{ "port_sched_lock", "port_id" },
{ "sys_msg_q", NULL },
@@ -147,20 +142,12 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "mtrace_op", NULL },
{ "instr_x", NULL },
{ "instr", NULL },
- { "pollsets_lock", NULL },
{ "alcu_allocator", "index" },
{ "mseg", NULL },
- { "port_task_pre_alloc_lock", "address" },
- { "proclist_pre_alloc_lock", "address" },
- { "xports_list_pre_alloc_lock", "address" },
- { "inet_buffer_stack_lock", NULL },
- { "system_block", NULL },
{ "get_time", NULL },
{ "get_corrected_time", NULL },
{ "runtime", NULL },
- { "breakpoints", NULL },
{ "pix_lock", "address" },
- { "run_queues_lists", NULL },
{ "sched_stat", NULL },
{ "async_init_mtx", NULL },
#ifdef __WIN32__
@@ -194,10 +181,10 @@ static const char *rw_op_str(erts_lock_options_t options)
return erts_lock_options_get_short_desc(options);
}
-typedef struct erts_lc_locked_lock_t_ erts_lc_locked_lock_t;
-struct erts_lc_locked_lock_t_ {
- erts_lc_locked_lock_t *next;
- erts_lc_locked_lock_t *prev;
+typedef struct lc_locked_lock_t_ lc_locked_lock_t;
+struct lc_locked_lock_t_ {
+ lc_locked_lock_t *next;
+ lc_locked_lock_t *prev;
UWord extra;
Sint16 id;
char *file;
@@ -207,32 +194,47 @@ struct erts_lc_locked_lock_t_ {
};
typedef struct {
- erts_lc_locked_lock_t *first;
- erts_lc_locked_lock_t *last;
-} erts_lc_locked_lock_list_t;
+ lc_locked_lock_t *first;
+ lc_locked_lock_t *last;
+} lc_locked_lock_list_t;
+
+typedef union lc_free_block_t_ lc_free_block_t;
+union lc_free_block_t_ {
+ lc_free_block_t *next;
+ lc_locked_lock_t lock;
+};
+
+typedef struct {
+ /*
+ * m[X][Y] & 1 if we locked X directly after Y was locked.
+ * m[X][Y] & 2 if we locked X indirectly after Y was locked.
+ * m[X][0] = 1 if we locked X when nothing else was locked.
+ * m[0][] is unused as it would represent locking "NO LOCK"
+ */
+ char m[ERTS_LOCK_ORDER_SIZE][ERTS_LOCK_ORDER_SIZE];
+
+} lc_matrix_t;
-typedef struct erts_lc_locked_locks_t_ erts_lc_locked_locks_t;
-struct erts_lc_locked_locks_t_ {
+static lc_matrix_t tot_lc_matrix;
+
+typedef struct lc_thread_t_ lc_thread_t;
+struct lc_thread_t_ {
char *thread_name;
int emu_thread;
erts_tid_t tid;
- erts_lc_locked_locks_t *next;
- erts_lc_locked_locks_t *prev;
- erts_lc_locked_lock_list_t locked;
- erts_lc_locked_lock_list_t required;
-};
-
-typedef union erts_lc_free_block_t_ erts_lc_free_block_t;
-union erts_lc_free_block_t_ {
- erts_lc_free_block_t *next;
- erts_lc_locked_lock_t lock;
+ lc_thread_t *next;
+ lc_thread_t *prev;
+ lc_locked_lock_list_t locked;
+ lc_locked_lock_list_t required;
+ lc_free_block_t *free_blocks;
+ lc_matrix_t matrix;
};
static ethr_tsd_key locks_key;
-static erts_lc_locked_locks_t *erts_locked_locks = NULL;
+static lc_thread_t *lc_threads = NULL;
+static ethr_spinlock_t lc_threads_lock;
-static erts_lc_free_block_t *free_blocks = NULL;
#ifdef ERTS_LC_STATIC_ALLOC
#define ERTS_LC_FB_CHUNK_SIZE 10000
@@ -240,176 +242,165 @@ static erts_lc_free_block_t *free_blocks = NULL;
#define ERTS_LC_FB_CHUNK_SIZE 10
#endif
-static ethr_spinlock_t free_blocks_lock;
static ERTS_INLINE void
-lc_lock(void)
+lc_lock_threads(void)
{
- ethr_spin_lock(&free_blocks_lock);
+ ethr_spin_lock(&lc_threads_lock);
}
static ERTS_INLINE void
-lc_unlock(void)
+lc_unlock_threads(void)
{
- ethr_spin_unlock(&free_blocks_lock);
+ ethr_spin_unlock(&lc_threads_lock);
}
-static ERTS_INLINE void lc_free(void *p)
+static ERTS_INLINE void lc_free(lc_thread_t* thr, lc_locked_lock_t *p)
{
- erts_lc_free_block_t *fb = (erts_lc_free_block_t *) p;
+ lc_free_block_t *fb = (lc_free_block_t *) p;
#ifdef DEBUG
- sys_memset((void *) p, 0xdf, sizeof(erts_lc_free_block_t));
+ sys_memset((void *) p, 0xdf, sizeof(lc_free_block_t));
#endif
- lc_lock();
- fb->next = free_blocks;
- free_blocks = fb;
- lc_unlock();
+ fb->next = thr->free_blocks;
+ thr->free_blocks = fb;
}
-#ifdef ERTS_LC_STATIC_ALLOC
-
-static void *lc_core_alloc(void)
-{
- lc_unlock();
- ERTS_INTERNAL_ERROR("Lock checker out of memory!\n");
-}
-
-#else
-
-static void *lc_core_alloc(void)
+static lc_locked_lock_t *lc_core_alloc(lc_thread_t* thr)
{
int i;
- erts_lc_free_block_t *fbs;
- lc_unlock();
- fbs = (erts_lc_free_block_t *) malloc(sizeof(erts_lc_free_block_t)
+ lc_free_block_t *fbs;
+ fbs = (lc_free_block_t *) malloc(sizeof(lc_free_block_t)
* ERTS_LC_FB_CHUNK_SIZE);
if (!fbs) {
ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!");
}
for (i = 1; i < ERTS_LC_FB_CHUNK_SIZE - 1; i++) {
#ifdef DEBUG
- sys_memset((void *) &fbs[i], 0xdf, sizeof(erts_lc_free_block_t));
+ sys_memset((void *) &fbs[i], 0xdf, sizeof(lc_free_block_t));
#endif
fbs[i].next = &fbs[i+1];
}
#ifdef DEBUG
sys_memset((void *) &fbs[ERTS_LC_FB_CHUNK_SIZE-1],
- 0xdf, sizeof(erts_lc_free_block_t));
+ 0xdf, sizeof(lc_free_block_t));
#endif
- lc_lock();
- fbs[ERTS_LC_FB_CHUNK_SIZE-1].next = free_blocks;
- free_blocks = &fbs[1];
- return (void *) &fbs[0];
+ fbs[ERTS_LC_FB_CHUNK_SIZE-1].next = thr->free_blocks;
+ thr->free_blocks = &fbs[1];
+ return &fbs[0].lock;
}
-#endif
-
-static ERTS_INLINE void *lc_alloc(void)
+static ERTS_INLINE lc_locked_lock_t *lc_alloc(lc_thread_t* thr)
{
- void *res;
- lc_lock();
- if (!free_blocks)
- res = lc_core_alloc();
+ lc_locked_lock_t *res;
+ if (!thr->free_blocks)
+ res = lc_core_alloc(thr);
else {
- res = (void *) free_blocks;
- free_blocks = free_blocks->next;
+ res = &thr->free_blocks->lock;
+ thr->free_blocks = thr->free_blocks->next;
}
- lc_unlock();
return res;
}
-static erts_lc_locked_locks_t *
-create_locked_locks(char *thread_name)
+static lc_thread_t *
+create_thread_data(char *thread_name)
{
- erts_lc_locked_locks_t *l_lcks = malloc(sizeof(erts_lc_locked_locks_t));
- if (!l_lcks)
+ lc_thread_t *thr = malloc(sizeof(lc_thread_t));
+ if (!thr)
ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!");
- l_lcks->thread_name = strdup(thread_name ? thread_name : "unknown");
- if (!l_lcks->thread_name)
+ thr->thread_name = strdup(thread_name ? thread_name : "unknown");
+ if (!thr->thread_name)
ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!");
- l_lcks->emu_thread = 0;
- l_lcks->tid = erts_thr_self();
- l_lcks->required.first = NULL;
- l_lcks->required.last = NULL;
- l_lcks->locked.first = NULL;
- l_lcks->locked.last = NULL;
- l_lcks->prev = NULL;
- lc_lock();
- l_lcks->next = erts_locked_locks;
- if (erts_locked_locks)
- erts_locked_locks->prev = l_lcks;
- erts_locked_locks = l_lcks;
- lc_unlock();
- erts_tsd_set(locks_key, (void *) l_lcks);
- return l_lcks;
+ thr->emu_thread = 0;
+ thr->tid = erts_thr_self();
+ thr->required.first = NULL;
+ thr->required.last = NULL;
+ thr->locked.first = NULL;
+ thr->locked.last = NULL;
+ thr->prev = NULL;
+ thr->free_blocks = NULL;
+ sys_memzero(&thr->matrix, sizeof(thr->matrix));
+
+ lc_lock_threads();
+ thr->next = lc_threads;
+ if (lc_threads)
+ lc_threads->prev = thr;
+ lc_threads = thr;
+ lc_unlock_threads();
+ erts_tsd_set(locks_key, (void *) thr);
+ return thr;
}
+static void collect_matrix(lc_matrix_t*);
+
static void
-destroy_locked_locks(erts_lc_locked_locks_t *l_lcks)
-{
- ASSERT(l_lcks->thread_name);
- free((void *) l_lcks->thread_name);
- ASSERT(l_lcks->required.first == NULL);
- ASSERT(l_lcks->required.last == NULL);
- ASSERT(l_lcks->locked.first == NULL);
- ASSERT(l_lcks->locked.last == NULL);
-
- lc_lock();
- if (l_lcks->prev)
- l_lcks->prev->next = l_lcks->next;
+destroy_locked_locks(lc_thread_t *thr)
+{
+ ASSERT(thr->thread_name);
+ free((void *) thr->thread_name);
+ ASSERT(thr->required.first == NULL);
+ ASSERT(thr->required.last == NULL);
+ ASSERT(thr->locked.first == NULL);
+ ASSERT(thr->locked.last == NULL);
+
+ lc_lock_threads();
+ if (thr->prev)
+ thr->prev->next = thr->next;
else {
- ASSERT(erts_locked_locks == l_lcks);
- erts_locked_locks = l_lcks->next;
+ ASSERT(lc_threads == thr);
+ lc_threads = thr->next;
}
+ if (thr->next)
+ thr->next->prev = thr->prev;
+
+ collect_matrix(&thr->matrix);
- if (l_lcks->next)
- l_lcks->next->prev = l_lcks->prev;
- lc_unlock();
+ lc_unlock_threads();
- free((void *) l_lcks);
+ free((void *) thr);
}
-static ERTS_INLINE erts_lc_locked_locks_t *
+static ERTS_INLINE lc_thread_t *
get_my_locked_locks(void)
{
return erts_tsd_get(locks_key);
}
-static ERTS_INLINE erts_lc_locked_locks_t *
+static ERTS_INLINE lc_thread_t *
make_my_locked_locks(void)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
- if (l_lcks)
- return l_lcks;
+ lc_thread_t *thr = get_my_locked_locks();
+ if (thr)
+ return thr;
else
- return create_locked_locks(NULL);
+ return create_thread_data(NULL);
}
-static ERTS_INLINE erts_lc_locked_lock_t *
-new_locked_lock(erts_lc_lock_t *lck, erts_lock_options_t options,
+static ERTS_INLINE lc_locked_lock_t *
+new_locked_lock(lc_thread_t* thr,
+ erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
- erts_lc_locked_lock_t *l_lck = (erts_lc_locked_lock_t *) lc_alloc();
- l_lck->next = NULL;
- l_lck->prev = NULL;
- l_lck->id = lck->id;
- l_lck->extra = lck->extra;
- l_lck->file = file;
- l_lck->line = line;
- l_lck->flags = lck->flags;
- l_lck->taken_options = options;
- return l_lck;
+ lc_locked_lock_t *ll = lc_alloc(thr);
+ ll->next = NULL;
+ ll->prev = NULL;
+ ll->id = lck->id;
+ ll->extra = lck->extra;
+ ll->file = file;
+ ll->line = line;
+ ll->flags = lck->flags;
+ ll->taken_options = options;
+ return ll;
}
static void
raw_print_lock(char *prefix, Sint16 id, Wterm extra, erts_lock_flags_t flags,
char* file, unsigned int line, char *suffix)
{
- char *lname = (0 <= id && id < ERTS_LOCK_ORDER_SIZE
+ char *lname = (1 <= id && id < ERTS_LOCK_ORDER_SIZE
? erts_lock_order[id].name
: "unknown");
erts_fprintf(stderr,"%s'%s:",prefix,lname);
@@ -439,20 +430,20 @@ print_lock(char *prefix, erts_lc_lock_t *lck, char *suffix)
}
static void
-print_curr_locks(erts_lc_locked_locks_t *l_lcks)
+print_curr_locks(lc_thread_t *thr)
{
- erts_lc_locked_lock_t *l_lck;
- if (!l_lcks || !l_lcks->locked.first)
+ lc_locked_lock_t *ll;
+ if (!thr || !thr->locked.first)
erts_fprintf(stderr,
"Currently no locks are locked by the %s thread.\n",
- l_lcks->thread_name);
+ thr->thread_name);
else {
erts_fprintf(stderr,
"Currently these locks are locked by the %s thread:\n",
- l_lcks->thread_name);
- for (l_lck = l_lcks->locked.first; l_lck; l_lck = l_lck->next)
- raw_print_lock(" ", l_lck->id, l_lck->extra, l_lck->flags,
- l_lck->file, l_lck->line, "\n");
+ thr->thread_name);
+ for (ll = thr->locked.first; ll; ll = ll->next)
+ raw_print_lock(" ", ll->id, ll->extra, ll->flags,
+ ll->file, ll->line, "\n");
}
}
@@ -481,55 +472,55 @@ uninitialized_lock(void)
}
static void
-lock_twice(char *prefix, erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck,
+lock_twice(char *prefix, lc_thread_t *thr, erts_lc_lock_t *lck,
erts_lock_options_t options)
{
erts_fprintf(stderr, "%s (%s)", prefix, rw_op_str(options));
print_lock(" ", lck, " lock which is already locked by thread!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
static void
-unlock_op_mismatch(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck,
+unlock_op_mismatch(lc_thread_t *thr, erts_lc_lock_t *lck,
erts_lock_options_t options)
{
erts_fprintf(stderr, "Unlocking (%s) ", rw_op_str(options));
print_lock("", lck, " lock which mismatch previous lock operation!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
static void
-unlock_of_not_locked(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck)
+unlock_of_not_locked(lc_thread_t *thr, erts_lc_lock_t *lck)
{
print_lock("Unlocking ", lck, " lock which is not locked by thread!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
static void
-lock_order_violation(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck)
+lock_order_violation(lc_thread_t *thr, erts_lc_lock_t *lck)
{
print_lock("Lock order violation occured when locking ", lck, "!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
print_lock_order();
lc_abort();
}
static void
-type_order_violation(char *op, erts_lc_locked_locks_t *l_lcks,
+type_order_violation(char *op, lc_thread_t *thr,
erts_lc_lock_t *lck)
{
erts_fprintf(stderr, "Lock type order violation occured when ");
print_lock(op, lck, "!\n");
- ASSERT(l_lcks);
- print_curr_locks(l_lcks);
+ ASSERT(thr);
+ print_curr_locks(thr);
lc_abort();
}
static void
-lock_mismatch(erts_lc_locked_locks_t *l_lcks, int exact,
+lock_mismatch(lc_thread_t *thr, int exact,
int failed_have, erts_lc_lock_t *have, int have_len,
int failed_have_not, erts_lc_lock_t *have_not, int have_not_len)
{
@@ -576,39 +567,39 @@ lock_mismatch(erts_lc_locked_locks_t *l_lcks, int exact,
print_lock2(" ", have_not[i].id, have_not[i].extra, 0, "\n");
}
}
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
static void
-unlock_of_required_lock(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck)
+unlock_of_required_lock(lc_thread_t *thr, erts_lc_lock_t *lck)
{
print_lock("Unlocking required ", lck, " lock!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
static void
-unrequire_of_not_required_lock(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck)
+unrequire_of_not_required_lock(lc_thread_t *thr, erts_lc_lock_t *lck)
{
print_lock("Unrequire on ", lck, " lock not required!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
static void
-require_twice(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck)
+require_twice(lc_thread_t *thr, erts_lc_lock_t *lck)
{
print_lock("Require on ", lck, " lock already required!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
static void
-required_not_locked(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck)
+required_not_locked(lc_thread_t *thr, erts_lc_lock_t *lck)
{
print_lock("Required ", lck, " lock not locked!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
@@ -616,15 +607,15 @@ required_not_locked(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck)
static void
thread_exit_handler(void)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
- if (l_lcks) {
- if (l_lcks->locked.first) {
+ lc_thread_t *thr = get_my_locked_locks();
+ if (thr) {
+ if (thr->locked.first) {
erts_fprintf(stderr,
"Thread exiting while having locked locks!\n");
- print_curr_locks(l_lcks);
+ print_curr_locks(thr);
lc_abort();
}
- destroy_locked_locks(l_lcks);
+ destroy_locked_locks(thr);
/* erts_tsd_set(locks_key, NULL); */
}
}
@@ -642,24 +633,24 @@ lc_abort(void)
void
erts_lc_set_thread_name(char *thread_name)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
- if (!l_lcks)
- l_lcks = create_locked_locks(thread_name);
+ lc_thread_t *thr = get_my_locked_locks();
+ if (!thr)
+ thr = create_thread_data(thread_name);
else {
- ASSERT(l_lcks->thread_name);
- free((void *) l_lcks->thread_name);
- l_lcks->thread_name = strdup(thread_name ? thread_name : "unknown");
- if (!l_lcks->thread_name)
+ ASSERT(thr->thread_name);
+ free((void *) thr->thread_name);
+ thr->thread_name = strdup(thread_name ? thread_name : "unknown");
+ if (!thr->thread_name)
ERTS_INTERNAL_ERROR("strdup failed");
}
- l_lcks->emu_thread = 1;
+ thr->emu_thread = 1;
}
int
erts_lc_is_emu_thr(void)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
- return l_lcks->emu_thread;
+ lc_thread_t *thr = get_my_locked_locks();
+ return thr->emu_thread;
}
int
@@ -705,7 +696,7 @@ erts_lc_get_lock_order_id(char *name)
return (Sint16) -1;
}
-static int compare_locked_by_id(erts_lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand)
+static int compare_locked_by_id(lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand)
{
if(locked_lock->id < comparand->id) {
return -1;
@@ -716,7 +707,7 @@ static int compare_locked_by_id(erts_lc_locked_lock_t *locked_lock, erts_lc_lock
return 0;
}
-static int compare_locked_by_id_extra(erts_lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand)
+static int compare_locked_by_id_extra(lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand)
{
int order = compare_locked_by_id(locked_lock, comparand);
@@ -731,18 +722,18 @@ static int compare_locked_by_id_extra(erts_lc_locked_lock_t *locked_lock, erts_l
return 0;
}
-typedef int (*locked_compare_func)(erts_lc_locked_lock_t *, erts_lc_lock_t *);
+typedef int (*locked_compare_func)(lc_locked_lock_t *, erts_lc_lock_t *);
/* Searches through a list of taken locks, bailing when it hits an entry whose
* order relative to the search template is the opposite of the one at the
* start of the search. (*closest_neighbor) is either set to the exact match,
* or the one closest to it in the sort order. */
static int search_locked_list(locked_compare_func compare,
- erts_lc_locked_lock_t *locked_locks,
+ lc_locked_lock_t *locked_locks,
erts_lc_lock_t *search_template,
- erts_lc_locked_lock_t **closest_neighbor)
+ lc_locked_lock_t **closest_neighbor)
{
- erts_lc_locked_lock_t *iterator = locked_locks;
+ lc_locked_lock_t *iterator = locked_locks;
(*closest_neighbor) = iterator;
@@ -778,9 +769,9 @@ static int search_locked_list(locked_compare_func compare,
/* Searches for a lock in the given list that matches search_template, and sets
* (*locked_locks) to the closest lock in the sort order. */
static int
-find_lock(erts_lc_locked_lock_t **locked_locks, erts_lc_lock_t *search_template)
+find_lock(lc_locked_lock_t **locked_locks, erts_lc_lock_t *search_template)
{
- erts_lc_locked_lock_t *closest_neighbor;
+ lc_locked_lock_t *closest_neighbor;
int found_lock;
found_lock = search_locked_list(compare_locked_by_id_extra,
@@ -809,9 +800,9 @@ find_lock(erts_lc_locked_lock_t **locked_locks, erts_lc_lock_t *search_template)
/* Searches for a lock in the given list by id, and sets (*locked_locks) to the
* closest lock in the sort order. */
static int
-find_id(erts_lc_locked_lock_t **locked_locks, Sint16 id)
+find_id(lc_locked_lock_t **locked_locks, Sint16 id)
{
- erts_lc_locked_lock_t *closest_neighbor;
+ lc_locked_lock_t *closest_neighbor;
erts_lc_lock_t search_template;
int found_lock;
@@ -830,34 +821,34 @@ find_id(erts_lc_locked_lock_t **locked_locks, Sint16 id)
void
erts_lc_have_locks(int *resv, erts_lc_lock_t *locks, int len)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
+ lc_thread_t *thr = get_my_locked_locks();
int i;
- if (!l_lcks) {
+ if (!thr) {
for (i = 0; i < len; i++)
resv[i] = 0;
}
else {
- erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
+ lc_locked_lock_t *ll = thr->locked.first;
for (i = 0; i < len; i++)
- resv[i] = find_lock(&l_lck, &locks[i]);
+ resv[i] = find_lock(&ll, &locks[i]);
}
}
void
erts_lc_have_lock_ids(int *resv, int *ids, int len)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
+ lc_thread_t *thr = get_my_locked_locks();
int i;
- if (!l_lcks) {
+ if (!thr) {
for (i = 0; i < len; i++)
resv[i] = 0;
}
else {
- erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
+ lc_locked_lock_t *ll = thr->locked.first;
for (i = 0; i < len; i++)
- resv[i] = find_id(&l_lck, ids[i]);
+ resv[i] = find_id(&ll, ids[i]);
}
}
@@ -866,27 +857,27 @@ erts_lc_check(erts_lc_lock_t *have, int have_len,
erts_lc_lock_t *have_not, int have_not_len)
{
int i;
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
- erts_lc_locked_lock_t *l_lck;
+ lc_thread_t *thr = get_my_locked_locks();
+ lc_locked_lock_t *ll;
if (have && have_len > 0) {
- if (!l_lcks)
+ if (!thr)
lock_mismatch(NULL, 0,
-1, have, have_len,
-1, have_not, have_not_len);
- l_lck = l_lcks->locked.first;
+ ll = thr->locked.first;
for (i = 0; i < have_len; i++) {
- if (!find_lock(&l_lck, &have[i]))
- lock_mismatch(l_lcks, 0,
+ if (!find_lock(&ll, &have[i]))
+ lock_mismatch(thr, 0,
i, have, have_len,
-1, have_not, have_not_len);
}
}
- if (have_not && have_not_len > 0 && l_lcks) {
- l_lck = l_lcks->locked.first;
+ if (have_not && have_not_len > 0 && thr) {
+ ll = thr->locked.first;
for (i = 0; i < have_not_len; i++) {
- if (find_lock(&l_lck, &have_not[i]))
- lock_mismatch(l_lcks, 0,
+ if (find_lock(&ll, &have_not[i]))
+ lock_mismatch(thr, 0,
-1, have, have_len,
i, have_not, have_not_len);
}
@@ -896,8 +887,8 @@ erts_lc_check(erts_lc_lock_t *have, int have_len,
void
erts_lc_check_exact(erts_lc_lock_t *have, int have_len)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
- if (!l_lcks) {
+ lc_thread_t *thr = get_my_locked_locks();
+ if (!thr) {
if (have && have_len > 0)
lock_mismatch(NULL, 1,
-1, have, have_len,
@@ -905,17 +896,17 @@ erts_lc_check_exact(erts_lc_lock_t *have, int have_len)
}
else {
int i;
- erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
+ lc_locked_lock_t *ll = thr->locked.first;
for (i = 0; i < have_len; i++) {
- if (!find_lock(&l_lck, &have[i]))
- lock_mismatch(l_lcks, 1,
+ if (!find_lock(&ll, &have[i]))
+ lock_mismatch(thr, 1,
i, have, have_len,
-1, NULL, 0);
}
- for (i = 0, l_lck = l_lcks->locked.first; l_lck; l_lck = l_lck->next)
+ for (i = 0, ll = thr->locked.first; ll; ll = ll->next)
i++;
if (i != have_len)
- lock_mismatch(l_lcks, 1,
+ lock_mismatch(thr, 1,
-1, have, have_len,
-1, NULL, 0);
}
@@ -924,16 +915,16 @@ erts_lc_check_exact(erts_lc_lock_t *have, int have_len)
void
erts_lc_check_no_locked_of_type(erts_lock_flags_t type)
{
- erts_lc_locked_locks_t *l_lcks = get_my_locked_locks();
- if (l_lcks) {
- erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
- for (l_lck = l_lcks->locked.first; l_lck; l_lck = l_lck->next) {
- if ((l_lck->flags & ERTS_LOCK_FLAGS_MASK_TYPE) == type) {
+ lc_thread_t *thr = get_my_locked_locks();
+ if (thr) {
+ lc_locked_lock_t *ll = thr->locked.first;
+ for (ll = thr->locked.first; ll; ll = ll->next) {
+ if ((ll->flags & ERTS_LOCK_FLAGS_MASK_TYPE) == type) {
erts_fprintf(stderr,
"Locked lock of type %s found which isn't "
"allowed here!\n",
- erts_lock_flags_get_type_name(l_lck->flags));
- print_curr_locks(l_lcks);
+ erts_lock_flags_get_type_name(ll->flags));
+ print_curr_locks(thr);
lc_abort();
}
}
@@ -951,7 +942,7 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
* This in order to make sure that caller can handle
* the situation without causing a lock order violation.
*/
- erts_lc_locked_locks_t *l_lcks;
+ lc_thread_t *thr;
if (lck->inited != ERTS_LC_INITITALIZED)
uninitialized_lock();
@@ -959,25 +950,25 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
if (lck->id < 0)
return 0;
- l_lcks = get_my_locked_locks();
+ thr = get_my_locked_locks();
- if (!l_lcks || !l_lcks->locked.first) {
- ASSERT(!l_lcks || !l_lcks->locked.last);
+ if (!thr || !thr->locked.first) {
+ ASSERT(!thr || !thr->locked.last);
return 0;
}
else {
- erts_lc_locked_lock_t *tl_lck;
+ lc_locked_lock_t *tl_lck;
- ASSERT(l_lcks->locked.last);
+ ASSERT(thr->locked.last);
#if 0 /* Ok when trylocking I guess... */
- if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, l_lcks->locked.last->flags))
- type_order_violation("trylocking ", l_lcks, lck);
+ if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, thr->locked.last->flags))
+ type_order_violation("trylocking ", thr, lck);
#endif
- if (l_lcks->locked.last->id < lck->id
- || (l_lcks->locked.last->id == lck->id
- && l_lcks->locked.last->extra < lck->extra))
+ if (thr->locked.last->id < lck->id
+ || (thr->locked.last->id == lck->id
+ && thr->locked.last->extra < lck->extra))
return 0;
/*
@@ -986,11 +977,11 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
/* Check that we are not trying to lock this lock twice */
- for (tl_lck = l_lcks->locked.last; tl_lck; tl_lck = tl_lck->prev) {
+ for (tl_lck = thr->locked.last; tl_lck; tl_lck = tl_lck->prev) {
if (tl_lck->id < lck->id
|| (tl_lck->id == lck->id && tl_lck->extra <= lck->extra)) {
if (tl_lck->id == lck->id && tl_lck->extra == lck->extra)
- lock_twice("Trylocking", l_lcks, lck, options);
+ lock_twice("Trylocking", thr, lck, options);
break;
}
}
@@ -1015,8 +1006,8 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
- erts_lc_locked_locks_t *l_lcks;
- erts_lc_locked_lock_t *l_lck;
+ lc_thread_t *thr;
+ lc_locked_lock_t *ll;
if (lck->inited != ERTS_LC_INITITALIZED)
uninitialized_lock();
@@ -1024,43 +1015,43 @@ void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t
if (lck->id < 0)
return;
- l_lcks = make_my_locked_locks();
- l_lck = locked ? new_locked_lock(lck, options, file, line) : NULL;
+ thr = make_my_locked_locks();
+ ll = locked ? new_locked_lock(thr, lck, options, file, line) : NULL;
- if (!l_lcks->locked.last) {
- ASSERT(!l_lcks->locked.first);
+ if (!thr->locked.last) {
+ ASSERT(!thr->locked.first);
if (locked)
- l_lcks->locked.first = l_lcks->locked.last = l_lck;
+ thr->locked.first = thr->locked.last = ll;
}
else {
- erts_lc_locked_lock_t *tl_lck;
+ lc_locked_lock_t *tl_lck;
#if 0 /* Ok when trylocking I guess... */
- if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, l_lcks->locked.last->flags))
- type_order_violation("trylocking ", l_lcks, lck);
+ if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, thr->locked.last->flags))
+ type_order_violation("trylocking ", thr, lck);
#endif
- for (tl_lck = l_lcks->locked.last; tl_lck; tl_lck = tl_lck->prev) {
+ for (tl_lck = thr->locked.last; tl_lck; tl_lck = tl_lck->prev) {
if (tl_lck->id < lck->id
|| (tl_lck->id == lck->id && tl_lck->extra <= lck->extra)) {
if (tl_lck->id == lck->id && tl_lck->extra == lck->extra)
- lock_twice("Trylocking", l_lcks, lck, options);
+ lock_twice("Trylocking", thr, lck, options);
if (locked) {
- l_lck->next = tl_lck->next;
- l_lck->prev = tl_lck;
+ ll->next = tl_lck->next;
+ ll->prev = tl_lck;
if (tl_lck->next)
- tl_lck->next->prev = l_lck;
+ tl_lck->next->prev = ll;
else
- l_lcks->locked.last = l_lck;
- tl_lck->next = l_lck;
+ thr->locked.last = ll;
+ tl_lck->next = ll;
}
return;
}
}
if (locked) {
- l_lck->next = l_lcks->locked.first;
- l_lcks->locked.first->prev = l_lck;
- l_lcks->locked.first = l_lck;
+ ll->next = thr->locked.first;
+ thr->locked.first->prev = ll;
+ thr->locked.first = ll;
}
}
@@ -1069,83 +1060,83 @@ void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t
void erts_lc_require_lock_flg(erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
- erts_lc_locked_locks_t *l_lcks = make_my_locked_locks();
- erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
- if (!find_lock(&l_lck, lck))
- required_not_locked(l_lcks, lck);
- l_lck = new_locked_lock(lck, options, file, line);
- if (!l_lcks->required.last) {
- ASSERT(!l_lcks->required.first);
- l_lck->next = l_lck->prev = NULL;
- l_lcks->required.first = l_lcks->required.last = l_lck;
+ lc_thread_t *thr = make_my_locked_locks();
+ lc_locked_lock_t *ll = thr->locked.first;
+ if (!find_lock(&ll, lck))
+ required_not_locked(thr, lck);
+ ll = new_locked_lock(thr, lck, options, file, line);
+ if (!thr->required.last) {
+ ASSERT(!thr->required.first);
+ ll->next = ll->prev = NULL;
+ thr->required.first = thr->required.last = ll;
}
else {
- erts_lc_locked_lock_t *l_lck2;
- ASSERT(l_lcks->required.first);
- for (l_lck2 = l_lcks->required.last;
+ lc_locked_lock_t *l_lck2;
+ ASSERT(thr->required.first);
+ for (l_lck2 = thr->required.last;
l_lck2;
l_lck2 = l_lck2->prev) {
if (l_lck2->id < lck->id
|| (l_lck2->id == lck->id && l_lck2->extra < lck->extra))
break;
else if (l_lck2->id == lck->id && l_lck2->extra == lck->extra)
- require_twice(l_lcks, lck);
+ require_twice(thr, lck);
}
if (!l_lck2) {
- l_lck->next = l_lcks->required.first;
- l_lck->prev = NULL;
- l_lcks->required.first->prev = l_lck;
- l_lcks->required.first = l_lck;
+ ll->next = thr->required.first;
+ ll->prev = NULL;
+ thr->required.first->prev = ll;
+ thr->required.first = ll;
}
else {
- l_lck->next = l_lck2->next;
- if (l_lck->next) {
- ASSERT(l_lcks->required.last != l_lck2);
- l_lck->next->prev = l_lck;
+ ll->next = l_lck2->next;
+ if (ll->next) {
+ ASSERT(thr->required.last != l_lck2);
+ ll->next->prev = ll;
}
else {
- ASSERT(l_lcks->required.last == l_lck2);
- l_lcks->required.last = l_lck;
+ ASSERT(thr->required.last == l_lck2);
+ thr->required.last = ll;
}
- l_lck->prev = l_lck2;
- l_lck2->next = l_lck;
+ ll->prev = l_lck2;
+ l_lck2->next = ll;
}
}
}
void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
{
- erts_lc_locked_locks_t *l_lcks = make_my_locked_locks();
- erts_lc_locked_lock_t *l_lck = l_lcks->locked.first;
- if (!find_lock(&l_lck, lck))
- required_not_locked(l_lcks, lck);
- l_lck = l_lcks->required.first;
- if (!find_lock(&l_lck, lck))
- unrequire_of_not_required_lock(l_lcks, lck);
- if (l_lck->prev) {
- ASSERT(l_lcks->required.first != l_lck);
- l_lck->prev->next = l_lck->next;
+ lc_thread_t *thr = make_my_locked_locks();
+ lc_locked_lock_t *ll = thr->locked.first;
+ if (!find_lock(&ll, lck))
+ required_not_locked(thr, lck);
+ ll = thr->required.first;
+ if (!find_lock(&ll, lck))
+ unrequire_of_not_required_lock(thr, lck);
+ if (ll->prev) {
+ ASSERT(thr->required.first != ll);
+ ll->prev->next = ll->next;
}
else {
- ASSERT(l_lcks->required.first == l_lck);
- l_lcks->required.first = l_lck->next;
+ ASSERT(thr->required.first == ll);
+ thr->required.first = ll->next;
}
- if (l_lck->next) {
- ASSERT(l_lcks->required.last != l_lck);
- l_lck->next->prev = l_lck->prev;
+ if (ll->next) {
+ ASSERT(thr->required.last != ll);
+ ll->next->prev = ll->prev;
}
else {
- ASSERT(l_lcks->required.last == l_lck);
- l_lcks->required.last = l_lck->prev;
+ ASSERT(thr->required.last == ll);
+ thr->required.last = ll->prev;
}
- lc_free((void *) l_lck);
+ lc_free(thr, ll);
}
void erts_lc_lock_flg_x(erts_lc_lock_t *lck, erts_lock_options_t options,
char *file, unsigned int line)
{
- erts_lc_locked_locks_t *l_lcks;
- erts_lc_locked_lock_t *l_lck;
+ lc_thread_t *thr;
+ lc_locked_lock_t *new_ll;
if (lck->inited != ERTS_LC_INITITALIZED)
uninitialized_lock();
@@ -1153,32 +1144,45 @@ void erts_lc_lock_flg_x(erts_lc_lock_t *lck, erts_lock_options_t options,
if (lck->id < 0)
return;
- l_lcks = make_my_locked_locks();
- l_lck = new_locked_lock(lck, options, file, line);
+ thr = make_my_locked_locks();
+ new_ll = new_locked_lock(thr, lck, options, file, line);
- if (!l_lcks->locked.last) {
- ASSERT(!l_lcks->locked.first);
- l_lcks->locked.last = l_lcks->locked.first = l_lck;
+ if (!thr->locked.last) {
+ ASSERT(!thr->locked.first);
+ thr->locked.last = thr->locked.first = new_ll;
+ ASSERT(0 < lck->id && lck->id < ERTS_LOCK_ORDER_SIZE);
+ thr->matrix.m[lck->id][0] = 1;
}
- else if (l_lcks->locked.last->id < lck->id
- || (l_lcks->locked.last->id == lck->id
- && l_lcks->locked.last->extra < lck->extra)) {
- if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, l_lcks->locked.last->flags))
- type_order_violation("locking ", l_lcks, lck);
- l_lck->prev = l_lcks->locked.last;
- l_lcks->locked.last->next = l_lck;
- l_lcks->locked.last = l_lck;
+ else if (thr->locked.last->id < lck->id
+ || (thr->locked.last->id == lck->id
+ && thr->locked.last->extra < lck->extra)) {
+ lc_locked_lock_t* ll;
+ if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, thr->locked.last->flags)) {
+ type_order_violation("locking ", thr, lck);
+ }
+
+ ASSERT(0 < lck->id && lck->id < ERTS_LOCK_ORDER_SIZE);
+ ll = thr->locked.last;
+ thr->matrix.m[lck->id][ll->id] |= 1;
+ for (ll = ll->prev; ll; ll = ll->prev) {
+ ASSERT(0 < ll->id && ll->id < ERTS_LOCK_ORDER_SIZE);
+ thr->matrix.m[lck->id][ll->id] |= 2;
+ }
+
+ new_ll->prev = thr->locked.last;
+ thr->locked.last->next = new_ll;
+ thr->locked.last = new_ll;
}
- else if (l_lcks->locked.last->id == lck->id && l_lcks->locked.last->extra == lck->extra)
- lock_twice("Locking", l_lcks, lck, options);
+ else if (thr->locked.last->id == lck->id && thr->locked.last->extra == lck->extra)
+ lock_twice("Locking", thr, lck, options);
else
- lock_order_violation(l_lcks, lck);
+ lock_order_violation(thr, lck);
}
void erts_lc_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
{
- erts_lc_locked_locks_t *l_lcks;
- erts_lc_locked_lock_t *l_lck;
+ lc_thread_t *thr;
+ lc_locked_lock_t *ll;
if (lck->inited != ERTS_LC_INITITALIZED)
uninitialized_lock();
@@ -1186,38 +1190,38 @@ void erts_lc_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
if (lck->id < 0)
return;
- l_lcks = get_my_locked_locks();
+ thr = get_my_locked_locks();
- if (l_lcks) {
- l_lck = l_lcks->required.first;
- if (find_lock(&l_lck, lck))
- unlock_of_required_lock(l_lcks, lck);
+ if (thr) {
+ ll = thr->required.first;
+ if (find_lock(&ll, lck))
+ unlock_of_required_lock(thr, lck);
}
- for (l_lck = l_lcks ? l_lcks->locked.last : NULL; l_lck; l_lck = l_lck->prev) {
- if (l_lck->id == lck->id && l_lck->extra == lck->extra) {
- if ((l_lck->taken_options & ERTS_LOCK_OPTIONS_RDWR) != options)
- unlock_op_mismatch(l_lcks, lck, options);
- if (l_lck->prev)
- l_lck->prev->next = l_lck->next;
+ for (ll = thr ? thr->locked.last : NULL; ll; ll = ll->prev) {
+ if (ll->id == lck->id && ll->extra == lck->extra) {
+ if ((ll->taken_options & ERTS_LOCK_OPTIONS_RDWR) != options)
+ unlock_op_mismatch(thr, lck, options);
+ if (ll->prev)
+ ll->prev->next = ll->next;
else
- l_lcks->locked.first = l_lck->next;
- if (l_lck->next)
- l_lck->next->prev = l_lck->prev;
+ thr->locked.first = ll->next;
+ if (ll->next)
+ ll->next->prev = ll->prev;
else
- l_lcks->locked.last = l_lck->prev;
- lc_free((void *) l_lck);
+ thr->locked.last = ll->prev;
+ lc_free(thr, ll);
return;
}
}
- unlock_of_not_locked(l_lcks, lck);
+ unlock_of_not_locked(thr, lck);
}
void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
{
- erts_lc_locked_locks_t *l_lcks;
- erts_lc_locked_lock_t *l_lck;
+ lc_thread_t *thr;
+ lc_locked_lock_t *ll;
if (lck->inited != ERTS_LC_INITITALIZED)
uninitialized_lock();
@@ -1225,17 +1229,17 @@ void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options)
if (lck->id < 0)
return;
- l_lcks = get_my_locked_locks();
+ thr = get_my_locked_locks();
- if (l_lcks) {
- l_lck = l_lcks->required.first;
- if (find_lock(&l_lck, lck))
- unlock_of_required_lock(l_lcks, lck);
+ if (thr) {
+ ll = thr->required.first;
+ if (find_lock(&ll, lck))
+ unlock_of_required_lock(thr, lck);
}
- l_lck = l_lcks->locked.first;
- if (!find_lock(&l_lck, lck))
- unlock_of_not_locked(l_lcks, lck);
+ ll = thr->locked.first;
+ if (!find_lock(&ll, lck))
+ unlock_of_not_locked(thr, lck);
}
int
@@ -1316,26 +1320,7 @@ erts_lc_destroy_lock(erts_lc_lock_t *lck)
void
erts_lc_init(void)
{
-#ifdef ERTS_LC_STATIC_ALLOC
- int i;
- static erts_lc_free_block_t fbs[ERTS_LC_FB_CHUNK_SIZE];
- for (i = 0; i < ERTS_LC_FB_CHUNK_SIZE - 1; i++) {
-#ifdef DEBUG
- sys_memset((void *) &fbs[i], 0xdf, sizeof(erts_lc_free_block_t));
-#endif
- fbs[i].next = &fbs[i+1];
- }
-#ifdef DEBUG
- sys_memset((void *) &fbs[ERTS_LC_FB_CHUNK_SIZE-1],
- 0xdf, sizeof(erts_lc_free_block_t));
-#endif
- fbs[ERTS_LC_FB_CHUNK_SIZE-1].next = NULL;
- free_blocks = &fbs[0];
-#else /* #ifdef ERTS_LC_STATIC_ALLOC */
- free_blocks = NULL;
-#endif /* #ifdef ERTS_LC_STATIC_ALLOC */
-
- if (ethr_spinlock_init(&free_blocks_lock) != 0)
+ if (ethr_spinlock_init(&lc_threads_lock) != 0)
ERTS_INTERNAL_ERROR("spinlock_init failed");
erts_tsd_key_create(&locks_key,"erts_lock_check_key");
@@ -1357,5 +1342,76 @@ erts_lc_pll(void)
print_curr_locks(get_my_locked_locks());
}
+static void collect_matrix(lc_matrix_t* matrix)
+{
+ int i, j;
+ for (i = 1; i < ERTS_LOCK_ORDER_SIZE; i++) {
+ for (j = 0; j <= i; j++) {
+ tot_lc_matrix.m[i][j] |= matrix->m[i][j];
+ }
+#ifdef DEBUG
+ for ( ; j < ERTS_LOCK_ORDER_SIZE; j++) {
+ ASSERT(matrix->m[i][j] == 0);
+ }
+#endif
+ }
+}
+
+Eterm
+erts_lc_dump_graph(void)
+{
+ const char* basename = "lc_graph.";
+ char filename[40];
+ lc_matrix_t* tot = &tot_lc_matrix;
+ lc_thread_t* thr;
+ int i, j, name_max = 0;
+ FILE* ff;
+
+ lc_lock_threads();
+ for (thr = lc_threads; thr; thr = thr->next) {
+ collect_matrix(&thr->matrix);
+ }
+ lc_unlock_threads();
+
+ sys_strcpy(filename, basename);
+ sys_get_pid(filename + strlen(basename),
+ sizeof(filename) - strlen(basename));
+ ff = fopen(filename, "w");
+ if (!ff)
+ return am_error;
+
+ for (i = 1; i < ERTS_LOCK_ORDER_SIZE; i++) {
+ int len = strlen(erts_lock_order[i].name);
+ if (name_max < len)
+ name_max = len;
+ }
+ fputs("%This file was generated by erts_debug:lc_graph()\n\n", ff);
+ fputs("%{ThisLockName, ThisLockId, LockedDirectlyBeforeThis, LockedIndirectlyBeforeThis}\n", ff);
+ fprintf(ff, "[{%*s, %2d}", name_max, "\"NO LOCK\"", 0);
+ for (i = 1; i < ERTS_LOCK_ORDER_SIZE; i++) {
+ char* delim = "";
+ fprintf(ff, ",\n {%*s, %2d, [", name_max, erts_lock_order[i].name, i);
+ for (j = 0; j < ERTS_LOCK_ORDER_SIZE; j++) {
+ if (tot->m[i][j] & 1) {
+ fprintf(ff, "%s%d", delim, j);
+ delim = ",";
+ }
+ }
+ fprintf(ff, "], [");
+ delim = "";
+ for (j = 0; j < ERTS_LOCK_ORDER_SIZE; j++) {
+ if (tot->m[i][j] == 2) {
+ fprintf(ff, "%s%d", delim, j);
+ delim = ",";
+ }
+ }
+ fputs("]}", ff);
+ }
+ fputs("].", ff);
+ fclose(ff);
+ erts_fprintf(stderr, "Created file '%s' in current working directory\n",
+ filename);
+ return am_ok;
+}
#endif /* #ifdef ERTS_ENABLE_LOCK_CHECK */
diff --git a/erts/emulator/beam/erl_lock_check.h b/erts/emulator/beam/erl_lock_check.h
index 5c2c38e8f2..138bc810bd 100644
--- a/erts/emulator/beam/erl_lock_check.h
+++ b/erts/emulator/beam/erl_lock_check.h
@@ -94,6 +94,8 @@ void erts_lc_unrequire_lock(erts_lc_lock_t *lck);
int erts_lc_is_emu_thr(void);
+Eterm erts_lc_dump_graph(void);
+
#define ERTS_LC_ASSERT(A) \
((void) (((A) || ERTS_SOMEONE_IS_CRASH_DUMPING) ? 1 : erts_lc_assert_failed(__FILE__, __LINE__, #A)))
#else /* #ifdef ERTS_ENABLE_LOCK_CHECK */
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index 51b7865c0b..34bd11d87c 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -264,11 +264,6 @@ erts_queue_dist_message(Process *rcvr,
Eterm from)
{
ErtsMessage* mp;
-#ifdef USE_VM_PROBES
- Sint tok_label = 0;
- Sint tok_lastcnt = 0;
- Sint tok_serial = 0;
-#endif
erts_aint_t state;
ERTS_LC_ASSERT(rcvr_locks == erts_proc_lc_my_proc_locks(rcvr));
@@ -309,25 +304,6 @@ erts_queue_dist_message(Process *rcvr,
}
else {
-#ifdef USE_VM_PROBES
- if (DTRACE_ENABLED(message_queued)) {
- DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE);
-
- dtrace_proc_str(rcvr, receiver_name);
- if (have_seqtrace(token)) {
- tok_label = SEQ_TRACE_T_DTRACE_LABEL(token);
- tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
- tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
- }
- /*
- * TODO: We don't know the real size of the external message here.
- * -1 will appear to a D script as 4294967295.
- */
- DTRACE6(message_queued, receiver_name, -1, rcvr->sig_qs.len + 1,
- tok_label, tok_lastcnt, tok_serial);
- }
-#endif
-
LINK_MESSAGE(rcvr, mp, &mp->next, 1);
if (!(rcvr_locks & ERTS_PROC_LOCK_MSGQ))
@@ -346,7 +322,6 @@ queue_messages(Process* receiver,
ErtsMessage** last,
Uint len)
{
- Sint res;
int locked_msgq = 0;
erts_aint32_t state;
@@ -394,31 +369,14 @@ queue_messages(Process* receiver,
return 0;
}
- res = receiver->sig_qs.len;
- if (receiver_locks & ERTS_PROC_LOCK_MAIN) {
- /*
- * We move 'in queue' to 'private queue' and place
- * message at the end of 'private queue' in order
- * to ensure that the 'in queue' doesn't contain
- * references into the heap. By ensuring this,
- * we don't need to include the 'in queue' in
- * the root set when garbage collecting.
- */
- res += receiver->sig_inq.len;
- erts_proc_sig_fetch(receiver);
- LINK_MESSAGE_PRIVQ(receiver, first, last, len);
- }
- else
- {
- LINK_MESSAGE(receiver, first, last, len);
- }
+ LINK_MESSAGE(receiver, first, last, len);
if (locked_msgq) {
erts_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ);
}
erts_proc_notify_new_message(receiver, receiver_locks);
- return res;
+ return 0;
}
static Sint
@@ -870,7 +828,7 @@ erts_move_messages_off_heap(Process *c_p)
* it...
*/
- reds += c_p->sig_qs.len / 10;
+ reds += erts_proc_sig_privqs_len(c_p) / 10;
ASSERT(erts_atomic32_read_nob(&c_p->state)
& ERTS_PSFLG_OFF_HEAP_MSGQ);
@@ -1361,32 +1319,18 @@ void erts_factory_dummy_init(ErtsHeapFactory* factory)
factory->mode = FACTORY_CLOSED;
}
-static void reserve_heap(ErtsHeapFactory*, Uint need, Uint xtra);
-
-Eterm* erts_produce_heap(ErtsHeapFactory* factory, Uint need, Uint xtra)
-{
- Eterm* res;
-
- ASSERT((unsigned int)factory->mode > (unsigned int)FACTORY_CLOSED);
- if (factory->hp + need > factory->hp_end) {
- reserve_heap(factory, need, xtra);
- }
- res = factory->hp;
- factory->hp += need;
- return res;
-}
-
Eterm* erts_reserve_heap(ErtsHeapFactory* factory, Uint need)
{
ASSERT((unsigned int)factory->mode > (unsigned int)FACTORY_CLOSED);
if (factory->hp + need > factory->hp_end) {
- reserve_heap(factory, need, 200);
+ erts_reserve_heap__(factory, need, 200);
}
return factory->hp;
}
-static void reserve_heap(ErtsHeapFactory* factory, Uint need, Uint xtra)
+void erts_reserve_heap__(ErtsHeapFactory* factory, Uint need, Uint xtra)
{
+ /* internal... */
ErlHeapFragment* bp;
switch (factory->mode) {
@@ -1396,7 +1340,9 @@ static void reserve_heap(ErtsHeapFactory* factory, Uint need, Uint xtra)
factory->hp_end = factory->hp + need;
return;
- case FACTORY_MESSAGE:
+ case FACTORY_MESSAGE: {
+ int replace_oh;
+ int replace_msg_hfrag;
if (!factory->heap_frags) {
ASSERT(factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG);
bp = &factory->message->hfrag;
@@ -1408,25 +1354,45 @@ static void reserve_heap(ErtsHeapFactory* factory, Uint need, Uint xtra)
bp = factory->heap_frags;
}
+ replace_oh = 0;
+ replace_msg_hfrag = 0;
+
if (bp) {
- ASSERT(factory->hp > bp->mem);
+ ASSERT(factory->hp >= bp->mem);
ASSERT(factory->hp <= factory->hp_end);
ASSERT(factory->hp_end == bp->mem + bp->alloc_size);
bp->used_size = factory->hp - bp->mem;
+ if (!bp->used_size && factory->heap_frags) {
+ factory->heap_frags = bp->next;
+ bp->next = NULL;
+ ASSERT(!bp->off_heap.first);
+ if (factory->off_heap == &bp->off_heap)
+ replace_oh = !0;
+ if (factory->message && factory->message->data.heap_frag == bp)
+ replace_msg_hfrag = !0;
+ free_message_buffer(bp);
+ }
}
bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(factory->alloc_type,
ERTS_HEAP_FRAG_SIZE(need+xtra));
bp->next = factory->heap_frags;
factory->heap_frags = bp;
bp->alloc_size = need + xtra;
- bp->used_size = need;
+ bp->used_size = need + xtra;
bp->off_heap.first = NULL;
bp->off_heap.overhead = 0;
-
+ if (replace_oh) {
+ factory->off_heap = &bp->off_heap;
+ factory->off_heap_saved.first = factory->off_heap->first;
+ factory->off_heap_saved.overhead = factory->off_heap->overhead;
+ }
+ if (replace_msg_hfrag)
+ factory->message->data.heap_frag = bp;
factory->hp = bp->mem;
factory->hp_end = bp->mem + bp->alloc_size;
return;
+ }
case FACTORY_STATIC:
case FACTORY_CLOSED:
@@ -1509,9 +1475,11 @@ void erts_factory_trim_and_close(ErtsHeapFactory* factory,
if (bp->next == NULL) {
Uint used_sz = factory->hp - bp->mem;
ASSERT(used_sz <= bp->alloc_size);
- if (used_sz > 0)
- bp = erts_resize_message_buffer(bp, used_sz,
- brefs, brefs_size);
+ if (used_sz > 0) {
+ if (used_sz != bp->alloc_size)
+ bp = erts_resize_message_buffer(bp, used_sz,
+ brefs, brefs_size);
+ }
else {
free_message_buffer(bp);
bp = NULL;
diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h
index f56a252aef..ee87297ba4 100644
--- a/erts/emulator/beam/erl_message.h
+++ b/erts/emulator/beam/erl_message.h
@@ -89,12 +89,33 @@ void erts_factory_static_init(ErtsHeapFactory*, Eterm* hp, Uint size, ErlOffHeap
void erts_factory_tmp_init(ErtsHeapFactory*, Eterm* hp, Uint size, Uint32 atype);
void erts_factory_dummy_init(ErtsHeapFactory*);
-Eterm* erts_produce_heap(ErtsHeapFactory*, Uint need, Uint xtra);
+ERTS_GLB_INLINE Eterm* erts_produce_heap(ErtsHeapFactory*, Uint need, Uint xtra);
+
Eterm* erts_reserve_heap(ErtsHeapFactory*, Uint need);
void erts_factory_close(ErtsHeapFactory*);
void erts_factory_trim_and_close(ErtsHeapFactory*,Eterm *brefs, Uint brefs_size);
void erts_factory_undo(ErtsHeapFactory*);
+void erts_reserve_heap__(ErtsHeapFactory*, Uint need, Uint xtra); /* internal */
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE Eterm *
+erts_produce_heap(ErtsHeapFactory* factory, Uint need, Uint xtra)
+{
+ Eterm* res;
+
+ ASSERT((unsigned int)factory->mode > (unsigned int)FACTORY_CLOSED);
+ if (factory->hp + need > factory->hp_end) {
+ erts_reserve_heap__(factory, need, xtra);
+ }
+ res = factory->hp;
+ factory->hp += need;
+ return res;
+}
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
#ifdef CHECK_FOR_HOLES
# define ERTS_FACTORY_HOLE_CHECK(f) do { \
/*if ((f)->p) erts_check_for_holes((f)->p);*/ \
@@ -215,6 +236,48 @@ typedef struct {
#define ERL_MESSAGE_BUF_SZ 500
typedef struct {
+ /*
+ * ** The signal queues private to a process. **
+ *
+ * These are:
+ * - an inner queue which only consists of
+ * message signals
+ * - a middle queue which contains a mixture
+ * of message and non-message signals
+ *
+ * When the process isn't processing signals in
+ * erts_proc_sig_handle_incoming():
+ * - the message queue corresponds to the inner
+ * queue. Messages in the middle queue (and
+ * in the outer queue) are in transit and
+ * have NOT been received yet!
+ *
+ * When the process is processing signals in
+ * erts_proc_sig_handle_incoming():
+ * - the message queue corresponds to the inner
+ * queue plus the head of the middle queue up
+ * to the signal currently being processed.
+ * Any messages further back in the middle queue
+ * (and in the outer queue) are still in transit
+ * and have NOT been received yet!
+ *
+ * In the general case the 'len' field of this
+ * structure does NOT correspond to the message
+ * queue length. When the process is inspected
+ * via process info it does however correspond
+ * to the message queue length, but this is a
+ * special case!
+ *
+ * When no process-info request is in transit to
+ * the process the 'len' field corresponds to
+ * the total amount of messages in inner and
+ * middle queues (which does NOT correspond to
+ * the message queue length). When process-info
+ * requests are in transit to the process, the
+ * usage of the 'len' field changes and is used
+ * as an offset which even might be negative.
+ */
+
/* inner queue */
ErtsMessage *first;
ErtsMessage **last; /* point to the last next pointer */
@@ -227,7 +290,7 @@ typedef struct {
/* Common for inner and middle queue */
ErtsMessage **saved_last; /* saved last pointer */
- Sint len; /* message queue length (inner+middle) */
+ Sint len; /* NOT message queue length (see above) */
} ErtsSignalPrivQueues;
typedef struct {
@@ -248,8 +311,7 @@ typedef struct erl_trace_message_queue__ {
#define ERTS_RECV_MARK_SAVE(P) \
do { \
erts_proc_lock((P), ERTS_PROC_LOCK_MSGQ); \
- if ((P)->sig_inq.first) \
- erts_proc_sig_fetch((P)); \
+ erts_proc_sig_fetch((P)); \
erts_proc_unlock((P), ERTS_PROC_LOCK_MSGQ); \
if ((P)->sig_qs.cont) { \
(P)->sig_qs.saved_last = (P)->sig_qs.cont_last; \
@@ -302,23 +364,6 @@ typedef struct erl_trace_message_queue__ {
#endif
-
-/* Add message last in private message queue */
-#define LINK_MESSAGE_PRIVQ(p, first_msg, last_msg, num_msgs) \
- do { \
- ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__((p), "before"); \
- if ((p)->sig_qs.cont || ERTS_MSG_RECV_TRACED((p))) { \
- *(p)->sig_qs.cont_last = (first_msg); \
- (p)->sig_qs.cont_last = (last_msg); \
- } \
- else { \
- *(p)->sig_qs.last = (first_msg); \
- (p)->sig_qs.last = (last_msg); \
- } \
- (p)->sig_qs.len += (num_msgs); \
- ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__((p), "after"); \
- } while (0)
-
/* Add message last_msg in message queue */
#define LINK_MESSAGE(p, first_msg, last_msg, num_msgs) \
do { \
@@ -333,12 +378,12 @@ typedef struct erl_trace_message_queue__ {
#define UNLINK_MESSAGE(p,msgp) \
do { \
ErtsMessage *mp__ = (msgp)->next; \
- ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__((p), "before"); \
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__((p), 0, "before"); \
*(p)->sig_qs.save = mp__; \
(p)->sig_qs.len--; \
if (mp__ == NULL) \
(p)->sig_qs.last = (p)->sig_qs.save; \
- ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__((p), "after"); \
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__((p), 0, "after"); \
} while(0)
/*
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index 0e0013e8a4..260656e2d3 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -388,12 +388,18 @@ erts_call_dirty_nif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm *
erts_atomic32_read_band_mb(&c_p->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC
| ERTS_PSFLG_DIRTY_IO_PROC));
+ ASSERT(esdp->current_nif == NULL);
+ esdp->current_nif = &env;
+
erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
result = (*dirty_nif)(&env, codemfa->arity, argv); /* Call dirty NIF */
erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+ ASSERT(esdp->current_nif == &env);
+ esdp->current_nif = NULL;
+
ASSERT(env.proc->static_flags & ERTS_STC_FLG_SHADOW_PROC);
ASSERT(env.proc->next == c_p);
@@ -4258,6 +4264,10 @@ int erts_nif_get_funcs(struct erl_module_nif* mod,
return mod->entry.num_of_funcs;
}
+Module *erts_nif_get_module(struct erl_module_nif *nif_mod) {
+ return nif_mod->mod;
+}
+
Eterm erts_nif_call_function(Process *p, Process *tracee,
struct erl_module_nif* mod,
ErlNifFunc *fun, int argc, Eterm *argv)
diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c
index b32ba1b2e6..bcc4fc6d9b 100644
--- a/erts/emulator/beam/erl_proc_sig_queue.c
+++ b/erts/emulator/beam/erl_proc_sig_queue.c
@@ -49,7 +49,7 @@
* Note that not all signal are handled using this functionality!
*/
-#define ERTS_SIG_Q_OP_MAX 10
+#define ERTS_SIG_Q_OP_MAX 11
#define ERTS_SIG_Q_OP_EXIT 0
#define ERTS_SIG_Q_OP_EXIT_LINKED 1
@@ -61,7 +61,8 @@
#define ERTS_SIG_Q_OP_GROUP_LEADER 7
#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 ERTS_SIG_Q_OP_MAX
+#define ERTS_SIG_Q_OP_IS_ALIVE 10
+#define ERTS_SIG_Q_OP_PROCESS_INFO ERTS_SIG_Q_OP_MAX
#define ERTS_SIG_Q_TYPE_MAX (ERTS_MON_LNK_TYPE_MAX + 5)
@@ -76,46 +77,6 @@
#define ERTS_SIG_Q_TYPE_ADJUST_TRACE_INFO \
ERTS_SIG_Q_TYPE_MAX
-
-#define ERTS_SIG_Q_OP_BITS 8
-#define ERTS_SIG_Q_OP_SHIFT 0
-#define ERTS_SIG_Q_OP_MASK ((1 << ERTS_SIG_Q_OP_BITS) - 1)
-
-#define ERTS_SIG_Q_TYPE_BITS 8
-#define ERTS_SIG_Q_TYPE_SHIFT ERTS_SIG_Q_OP_BITS
-#define ERTS_SIG_Q_TYPE_MASK ((1 << ERTS_SIG_Q_TYPE_BITS) - 1)
-
-#define ERTS_SIG_Q_NON_X_BITS__ (_HEADER_ARITY_OFFS \
- + ERTS_SIG_Q_OP_BITS \
- + ERTS_SIG_Q_TYPE_BITS)
-
-#define ERTS_SIG_Q_XTRA_BITS (32 - ERTS_SIG_Q_NON_X_BITS__)
-#define ERTS_SIG_Q_XTRA_SHIFT (ERTS_SIG_Q_OP_BITS \
- + ERTS_SIG_Q_TYPE_BITS)
-#define ERTS_SIG_Q_XTRA_MASK ((1 << ERTS_SIG_Q_XTRA_BITS) - 1)
-
-#define ERTS_PROC_SIG_OP(Tag) \
- ((int) (_unchecked_thing_arityval((Tag)) \
- >> ERTS_SIG_Q_OP_SHIFT) & ERTS_SIG_Q_OP_MASK)
-
-#define ERTS_PROC_SIG_TYPE(Tag) \
- ((Uint16) (_unchecked_thing_arityval((Tag)) \
- >> ERTS_SIG_Q_TYPE_SHIFT) & ERTS_SIG_Q_TYPE_MASK)
-
-#define ERTS_PROC_SIG_XTRA(Tag) \
- ((Uint32) (_unchecked_thing_arityval((Tag)) \
- >> ERTS_SIG_Q_XTRA_SHIFT) & ERTS_SIG_Q_XTRA_MASK)
-
-#define ERTS_PROC_SIG_MAKE_TAG(Op, Type, Xtra) \
- (ASSERT(0 <= (Xtra) && (Xtra) <= ERTS_SIG_Q_XTRA_MASK), \
- _make_header((((Type) & ERTS_SIG_Q_TYPE_MASK) \
- << ERTS_SIG_Q_TYPE_SHIFT) \
- | (((Op) & ERTS_SIG_Q_OP_MASK) \
- << ERTS_SIG_Q_OP_SHIFT) \
- | (((Xtra) & ERTS_SIG_Q_XTRA_MASK) \
- << ERTS_SIG_Q_XTRA_SHIFT), \
- _TAG_HEADER_EXTERNAL_PID))
-
Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler);
Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler_high);
Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler_max);
@@ -123,7 +84,8 @@ Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler_max);
void
erts_proc_sig_queue_init(void)
{
- ERTS_CT_ASSERT(ERTS_SIG_Q_OP_MASK >= ERTS_SIG_Q_OP_MAX);
+ ERTS_CT_ASSERT(ERTS_SIG_Q_OP_MASK > ERTS_SIG_Q_OP_MAX);
+ ERTS_CT_ASSERT(ERTS_SIG_Q_OP_MSGQ_LEN_OFFS_MARK > ERTS_SIG_Q_OP_MAX);
ERTS_CT_ASSERT(ERTS_SIG_Q_TYPE_MASK >= ERTS_SIG_Q_TYPE_MAX);
}
@@ -191,6 +153,29 @@ typedef struct {
Eterm requester;
} ErtsIsAliveRequest;
+typedef struct {
+ ErtsSignalCommon common;
+ Sint refc;
+ Sint delayed_len;
+ Sint len_offset;
+} ErtsProcSigMsgQLenOffsetMarker;
+
+typedef struct {
+ ErtsSignalCommon common;
+ ErtsProcSigMsgQLenOffsetMarker marker;
+ Sint msgq_len_offset;
+ Eterm requester;
+ Eterm ref;
+ ErtsORefThing oref_thing;
+ Uint reserve_size;
+ Uint len;
+ int flags;
+ int item_ix[1]; /* of len size in reality... */
+} ErtsProcessInfoSig;
+
+#define ERTS_PROC_SIG_PI_MSGQ_LEN_IGNORE ((Sint) -1)
+#define ERTS_PROC_SIG_PI_MSGQ_LEN_SYNC ((Sint) -2)
+
static int handle_msg_tracing(Process *c_p,
ErtsSigRecvTracing *tracing,
ErtsMessage ***next_nm_sig);
@@ -523,6 +508,9 @@ ensure_dirty_proc_handled(Eterm pid,
}
}
+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)
{
@@ -559,6 +547,8 @@ proc_queue_signal(Process *c_p, Eterm pid, ErtsSignal *sig, int op)
res = 0;
else {
state = enqueue_signals(rp, first, last, last_next, state);
+ if (ERTS_UNLIKELY(op == ERTS_SIG_Q_OP_PROCESS_INFO))
+ check_push_msgq_len_offs_marker(rp, sig);
res = !0;
}
@@ -620,31 +610,14 @@ maybe_elevate_sig_handling_prio(Process *c_p, Eterm other)
}
void
-erts_proc_sig_fetch(Process *proc)
+erts_proc_sig_fetch__(Process *proc)
{
#ifdef ERTS_PROC_SIG_HARD_DEBUG
ErtsSignalPrivQueues sig_qs = proc->sig_qs;
ErtsSignalInQueue sig_inq = proc->sig_inq;
#endif
- ERTS_LC_ASSERT(erts_thr_progress_is_blocking()
- || ERTS_PROC_IS_EXITING(proc)
- || ((erts_proc_lc_my_proc_locks(proc)
- & (ERTS_PROC_LOCK_MAIN
- | ERTS_PROC_LOCK_MSGQ))
- == (ERTS_PROC_LOCK_MAIN
- | ERTS_PROC_LOCK_MSGQ)));
-
- if (!proc->sig_inq.first) {
- ASSERT(proc->sig_inq.last == &proc->sig_inq.first);
- ASSERT(proc->sig_inq.len == 0);
- ASSERT(!proc->sig_inq.nmsigs.next);
- ASSERT(!proc->sig_inq.nmsigs.last);
- return;
- }
-
- ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE(proc);
- ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(proc);
+ ASSERT(proc->sig_inq.first);
if (!proc->sig_inq.nmsigs.next) {
ASSERT(!(ERTS_PSFLG_SIG_IN_Q
@@ -720,7 +693,102 @@ erts_proc_sig_fetch(Process *proc)
proc->sig_inq.last = &proc->sig_inq.first;
proc->sig_inq.len = 0;
- ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(proc);
+}
+
+Sint
+erts_proc_sig_fetch_msgq_len_offs__(Process *proc)
+{
+ ErtsProcSigMsgQLenOffsetMarker *marker
+ = (ErtsProcSigMsgQLenOffsetMarker *) proc->sig_inq.first;
+
+ ASSERT(marker->common.tag == ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK);
+
+ if (marker->common.next) {
+ Sint len;
+
+ proc->flags |= F_DELAYED_PSIGQS_LEN;
+
+ /*
+ * Prevent update of sig_qs.len in fetch. These
+ * updates are done via process-info signal(s)
+ * instead...
+ */
+ len = proc->sig_inq.len;
+ marker->delayed_len += len;
+ marker->len_offset -= len;
+ proc->sig_inq.len = 0;
+
+ /*
+ * Temorarily remove marker during fetch...
+ */
+
+ proc->sig_inq.first = marker->common.next;
+ if (proc->sig_inq.last == &marker->common.next)
+ proc->sig_inq.last = &proc->sig_inq.first;
+ if (proc->sig_inq.nmsigs.next == &marker->common.next)
+ proc->sig_inq.nmsigs.next = &proc->sig_inq.first;
+ if (proc->sig_inq.nmsigs.last == &marker->common.next)
+ proc->sig_inq.nmsigs.last = &proc->sig_inq.first;
+
+ erts_proc_sig_fetch__(proc);
+
+ marker->common.next = NULL;
+ proc->sig_inq.first = (ErtsMessage *) marker;
+ proc->sig_inq.last = &marker->common.next;
+
+ }
+
+ return marker->delayed_len;
+}
+
+static ERTS_INLINE Sint
+proc_sig_privqs_len(Process *c_p, int have_qlock)
+{
+ Sint res = c_p->sig_qs.len;
+
+ ERTS_LC_ASSERT(!have_qlock
+ ? (ERTS_PROC_LOCK_MAIN
+ == erts_proc_lc_my_proc_locks(c_p))
+ : ((ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_MAIN)
+ == ((ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_MAIN)
+ & erts_proc_lc_my_proc_locks(c_p))));
+
+ if (c_p->flags & F_DELAYED_PSIGQS_LEN) {
+ ErtsProcSigMsgQLenOffsetMarker *marker;
+
+ if (!have_qlock)
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
+
+ marker = (ErtsProcSigMsgQLenOffsetMarker *) c_p->sig_inq.first;
+ ASSERT(marker);
+ ASSERT(marker->common.tag == ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK);
+
+ res += marker->delayed_len;
+
+ if (!have_qlock)
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
+ }
+
+#ifdef ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+ {
+ Sint len = 0;
+ ERTS_FOREACH_SIG_PRIVQS(
+ c_p, mp,
+ {
+ if (ERTS_SIG_IS_MSG(mp))
+ len++;
+ });
+ ERTS_ASSERT(res == len);
+ }
+#endif
+
+ return res;
+}
+
+Sint
+erts_proc_sig_privqs_len(Process *c_p)
+{
+ return proc_sig_privqs_len(c_p, 0);
}
static void do_seq_trace_output(Eterm to, Eterm token, Eterm msg);
@@ -1354,6 +1422,59 @@ erts_proc_sig_send_is_alive_request(Process *c_p, Eterm to, Eterm ref)
}
}
+int
+erts_proc_sig_send_process_info_request(Process *c_p,
+ Eterm to,
+ int *item_ix,
+ int len,
+ int need_msgq_len,
+ int flags,
+ Uint reserve_size,
+ Eterm ref)
+{
+ Uint size = sizeof(ErtsProcessInfoSig) + (len - 1) * sizeof(int);
+ ErtsProcessInfoSig *pis = erts_alloc(ERTS_ALC_T_SIG_DATA, size);
+ int res;
+
+ ASSERT(c_p);
+ ASSERT(item_ix);
+ ASSERT(len > 0);
+ ASSERT(is_internal_ordinary_ref(ref));
+
+ pis->common.tag = ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_PROCESS_INFO,
+ 0, 0);
+
+ if (!need_msgq_len)
+ pis->msgq_len_offset = ERTS_PROC_SIG_PI_MSGQ_LEN_IGNORE;
+ else {
+ pis->msgq_len_offset = ERTS_PROC_SIG_PI_MSGQ_LEN_SYNC;
+ pis->marker.common.next = NULL;
+ pis->marker.common.specific.next = NULL;
+ pis->marker.common.tag = ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK;
+ pis->marker.refc = 0;
+ pis->marker.delayed_len = 0;
+ pis->marker.len_offset = 0;
+ }
+ pis->requester = c_p->common.id;
+ sys_memcpy((void *) &pis->oref_thing,
+ (void *) internal_ref_val(ref),
+ sizeof(ErtsORefThing));
+ pis->ref = make_internal_ref((char *) &pis->oref_thing);
+ pis->reserve_size = reserve_size;
+ pis->len = len;
+ pis->flags = flags;
+ sys_memcpy((void *) &pis->item_ix[0],
+ (void *) item_ix,
+ sizeof(int)*len);
+ res = proc_queue_signal(c_p, to, (ErtsSignal *) pis,
+ ERTS_SIG_Q_OP_PROCESS_INFO);
+ if (res)
+ (void) maybe_elevate_sig_handling_prio(c_p, to);
+ else
+ erts_free(ERTS_ALC_T_SIG_DATA, pis);
+ return res;
+}
+
static void
is_alive_response(Process *c_p, ErtsMessage *mp, int is_alive)
{
@@ -1554,7 +1675,6 @@ remove_mq_m_sig(Process *c_p, ErtsMessage *sig, ErtsMessage **next_sig, ErtsMess
{
/* Removing message... */
ASSERT(!ERTS_SIG_IS_NON_MSG(sig));
- ASSERT(c_p->sig_qs.len > 0);
c_p->sig_qs.len--;
remove_mq_sig(c_p, sig, next_sig, next_nm_sig);
}
@@ -1564,7 +1684,6 @@ remove_iq_m_sig(Process *c_p, ErtsMessage *sig, ErtsMessage **next_sig)
{
/* Removing message... */
ASSERT(!ERTS_SIG_IS_NON_MSG(sig));
- ASSERT(c_p->sig_qs.len > 0);
c_p->sig_qs.len--;
remove_iq_sig(c_p, sig, next_sig);
}
@@ -2140,6 +2259,258 @@ handle_group_leader(Process *c_p, ErtsSigGroupLeader *sgl)
destroy_sig_group_leader(sgl);
}
+static void
+check_push_msgq_len_offs_marker(Process *rp, ErtsSignal *sig)
+{
+ ErtsProcessInfoSig *pisig = (ErtsProcessInfoSig *) sig;
+
+ ASSERT(ERTS_PROC_SIG_OP(sig->common.tag) == ERTS_SIG_Q_OP_PROCESS_INFO);
+
+ if (pisig->msgq_len_offset == ERTS_PROC_SIG_PI_MSGQ_LEN_SYNC) {
+ ErtsProcSigMsgQLenOffsetMarker *mrkr;
+ Sint len, msgq_len_offset;
+ ErtsMessage *first = rp->sig_inq.first;
+ ASSERT(first);
+ if (((ErtsSignal *) first)->common.tag == ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK)
+ mrkr = (ErtsProcSigMsgQLenOffsetMarker *) first;
+ else {
+ mrkr = &pisig->marker;
+
+ ASSERT(mrkr->common.tag == ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK);
+
+ mrkr->common.next = first;
+ ASSERT(rp->sig_inq.last != &rp->sig_inq.first);
+ if (rp->sig_inq.nmsigs.next == &rp->sig_inq.first)
+ rp->sig_inq.nmsigs.next = &mrkr->common.next;
+ if (rp->sig_inq.nmsigs.last == &rp->sig_inq.first)
+ rp->sig_inq.nmsigs.last = &mrkr->common.next;
+ rp->sig_inq.first = (ErtsMessage *) mrkr;
+ }
+
+ len = rp->sig_inq.len;
+ msgq_len_offset = len - mrkr->len_offset;
+
+ mrkr->len_offset = len;
+ mrkr->refc++;
+
+ pisig->msgq_len_offset = msgq_len_offset;
+
+#ifdef DEBUG
+ /* save pointer to used marker... */
+ pisig->marker.common.specific.attachment = (void *) mrkr;
+#endif
+
+ }
+}
+
+static void
+destroy_process_info_request(Process *c_p, ErtsProcessInfoSig *pisig)
+{
+ int dealloc_pisig = !0;
+
+ if (pisig->msgq_len_offset != ERTS_PROC_SIG_PI_MSGQ_LEN_IGNORE) {
+ Sint refc;
+ int dealloc_marker = 0;
+ ErtsProcSigMsgQLenOffsetMarker *marker;
+#ifdef ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+ Sint delayed_len;
+#endif
+
+ ASSERT(pisig->msgq_len_offset >= 0);
+
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
+ marker = (ErtsProcSigMsgQLenOffsetMarker *) c_p->sig_inq.first;
+ ASSERT(marker);
+ ASSERT(marker->refc > 0);
+ ASSERT(pisig->marker.common.specific.attachment == (void *) marker);
+
+ marker->delayed_len -= pisig->msgq_len_offset;
+#ifdef ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+ delayed_len = marker->delayed_len;
+#endif
+
+ refc = --marker->refc;
+ if (refc) {
+ if (marker == &pisig->marker) {
+ /* Another signal using our marker... */
+ dealloc_pisig = 0;
+ }
+ }
+ else {
+ /* Marker unused; remove it... */
+ ASSERT(marker->delayed_len + marker->len_offset == 0);
+#ifdef ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+ delayed_len += marker->len_offset;
+#endif
+ if (marker != &pisig->marker)
+ dealloc_marker = !0; /* used another signals marker... */
+ c_p->sig_inq.first = marker->common.next;
+ if (c_p->sig_inq.last == &marker->common.next)
+ c_p->sig_inq.last = &c_p->sig_inq.first;
+ if (c_p->sig_inq.nmsigs.next == &marker->common.next)
+ c_p->sig_inq.nmsigs.next = &c_p->sig_inq.first;
+ if (c_p->sig_inq.nmsigs.last == &marker->common.next)
+ c_p->sig_inq.nmsigs.last = &c_p->sig_inq.first;
+ }
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
+
+ if (!refc) {
+ c_p->flags &= ~F_DELAYED_PSIGQS_LEN;
+ /* Adjust msg len of inner+middle queue */
+ ASSERT(marker->len_offset <= 0);
+ c_p->sig_qs.len -= marker->len_offset;
+
+ ASSERT(c_p->sig_qs.len >= 0);
+ }
+
+#ifdef ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+ {
+ Sint len = 0;
+ ERTS_FOREACH_SIG_PRIVQS(
+ c_p, mp,
+ {
+ if (ERTS_SIG_IS_MSG(mp))
+ len++;
+ });
+ ERTS_ASSERT(c_p->sig_qs.len + delayed_len == len);
+ }
+#endif
+
+
+ if (dealloc_marker) {
+ ErtsProcessInfoSig *pisig2
+ = (ErtsProcessInfoSig *) (((char *) marker)
+ - offsetof(ErtsProcessInfoSig,
+ marker));
+ erts_free(ERTS_ALC_T_SIG_DATA, pisig2);
+ }
+ }
+
+ if (dealloc_pisig)
+ erts_free(ERTS_ALC_T_SIG_DATA, pisig);
+}
+
+static int
+handle_process_info(Process *c_p, ErtsMessage *sig,
+ ErtsMessage ***next_nm_sig, int is_alive)
+{
+ ErtsProcessInfoSig *pisig = (ErtsProcessInfoSig *) sig;
+ Uint reds = 0;
+ Process *rp;
+
+ if (pisig->msgq_len_offset != ERTS_PROC_SIG_PI_MSGQ_LEN_IGNORE) {
+ /*
+ * Request requires message queue data to be updated
+ * before inspection...
+ */
+
+ ASSERT(pisig->msgq_len_offset >= 0);
+ /*
+ * Update sig_qs.len to reflect the length
+ * of the message queue...
+ */
+ c_p->sig_qs.len += pisig->msgq_len_offset;
+
+ if (is_alive) {
+ /*
+ * Move messages part of message queue into inner
+ * signal queue...
+ */
+ if (*next_nm_sig != &c_p->sig_qs.cont) {
+ *c_p->sig_qs.last = c_p->sig_qs.cont;
+ c_p->sig_qs.last = *next_nm_sig;
+
+ c_p->sig_qs.cont = **next_nm_sig;
+ if (c_p->sig_qs.nmsigs.last == *next_nm_sig)
+ c_p->sig_qs.nmsigs.last = &c_p->sig_qs.cont;
+ *next_nm_sig = &c_p->sig_qs.cont;
+ *c_p->sig_qs.last = NULL;
+ }
+
+ if (!pisig->common.specific.next) {
+ /*
+ * No more signals in middle queue...
+ *
+ * Process-info 'status' needs sig-q
+ * process flag to be updated in order
+ * to show accurate result...
+ */
+ erts_atomic32_read_band_nob(&c_p->state,
+ ~ERTS_PSFLG_SIG_Q);
+ }
+
+#ifdef ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+ {
+ Sint len;
+ ErtsMessage *mp;
+ for (mp = c_p->sig_qs.first, len = 0; mp; mp = mp->next) {
+ ERTS_ASSERT(ERTS_SIG_IS_MSG(mp));
+ len++;
+ }
+ ERTS_ASSERT(c_p->sig_qs.len == len);
+ }
+#endif
+ }
+ }
+ if (is_alive)
+ remove_nm_sig(c_p, sig, next_nm_sig);
+
+ rp = erts_proc_lookup(pisig->requester);
+ ASSERT(c_p != rp);
+ if (rp) {
+ Eterm msg, res, ref, *hp;
+ ErtsProcLocks locks = 0;
+ ErtsHeapFactory hfact;
+ ErtsMessage *mp;
+ Uint reserve_size = 3 + sizeof(pisig->oref_thing)/sizeof(Eterm);
+
+ if (!is_alive) {
+ ErlOffHeap *ohp;
+ mp = erts_alloc_message_heap(rp, &locks, reserve_size, &hp, &ohp);
+ res = am_undefined;
+ }
+ else {
+ ErlHeapFragment *hfrag;
+
+ reserve_size += pisig->reserve_size;
+
+ mp = erts_alloc_message(0, NULL);
+ hfrag = new_message_buffer(reserve_size);
+ mp->data.heap_frag = hfrag;
+ erts_factory_selfcontained_message_init(&hfact, mp, &hfrag->mem[0]);
+
+ res = erts_process_info(c_p, &hfact, c_p, ERTS_PROC_LOCK_MAIN,
+ pisig->item_ix, pisig->len,
+ pisig->flags, reserve_size, &reds);
+
+ hp = erts_produce_heap(&hfact,
+ 3 + sizeof(pisig->oref_thing)/sizeof(Eterm),
+ 0);
+ }
+
+ sys_memcpy((void *) hp, (void *) &pisig->oref_thing,
+ sizeof(pisig->oref_thing));
+ ref = make_internal_ref(hp);
+ hp += sizeof(pisig->oref_thing)/sizeof(Eterm);
+
+ msg = TUPLE2(hp, ref, res);
+
+ if (is_alive)
+ erts_factory_trim_and_close(&hfact, &msg, 1);
+
+ erts_queue_message(rp, locks, mp, msg, c_p->common.id);
+
+ if (!is_alive && locks)
+ erts_proc_unlock(rp, locks);
+ }
+
+ destroy_process_info_request(c_p, pisig);
+
+ if (reds > INT_MAX/8)
+ reds = INT_MAX/8;
+
+ return ((int) reds)*4 + 8;
+}
/*
* Called in order to handle incoming signals.
@@ -2155,7 +2526,7 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep,
ErtsMessage *sig, ***next_nm_sig;
ErtsSigRecvTracing tracing;
- ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p);
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p, 0);
ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p));
if (local_only)
@@ -2504,6 +2875,12 @@ 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_PROCESS_INFO:
+ ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ handle_process_info(c_p, sig, next_nm_sig, !0);
+ 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);
@@ -2657,7 +3034,7 @@ stop: {
c_p->sig_qs.save = c_p->sig_qs.saved_last;
}
- ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p);
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p, 0);
*redsp = cnt/4 + 1;
@@ -2709,8 +3086,8 @@ erts_proc_sig_handle_exit(Process *c_p, int *redsp)
int cnt, limit;
ErtsMessage *sig, ***next_nm_sig;
- ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p);
- ERTS_LC_ASSERT(!erts_proc_lc_my_proc_locks(c_p));
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p, 0);
+ ERTS_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN);
ASSERT(!(ERTS_PSFLG_SIG_IN_Q & erts_atomic32_read_nob(&c_p->state)));
@@ -2817,9 +3194,11 @@ erts_proc_sig_handle_exit(Process *c_p, int *redsp)
}
case ERTS_SIG_Q_OP_IS_ALIVE:
- ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
is_alive_response(c_p, sig, 0);
- ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig);
+ break;
+
+ case ERTS_SIG_Q_OP_PROCESS_INFO:
+ handle_process_info(c_p, sig, next_nm_sig, 0);
break;
case ERTS_SIG_Q_OP_TRACE_CHANGE_STATE:
@@ -3005,6 +3384,13 @@ erts_proc_sig_signal_size(ErtsSignal *sig)
size = sizeof(ErtsSigTraceInfo);
break;
+ case ERTS_SIG_Q_OP_PROCESS_INFO: {
+ ErtsProcessInfoSig *pisig = (ErtsProcessInfoSig *) sig;
+ size = sizeof(ErtsProcessInfoSig);
+ size += (pisig->len - 1) * sizeof(int);
+ break;
+ }
+
default:
ERTS_INTERNAL_ERROR("Unknown signal");
break;
@@ -3060,8 +3446,7 @@ erts_proc_sig_receive_helper(Process *c_p,
consumed_reds += 4;
left_reds -= 4;
erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
- if (c_p->sig_inq.first)
- erts_proc_sig_fetch(c_p);
+ erts_proc_sig_fetch(c_p);
/*
* Messages may have been moved directly to
* inner queue...
@@ -3222,6 +3607,7 @@ handle_message_enqueued_tracing(Process *c_p,
Sint tok_label = 0;
Sint tok_lastcnt = 0;
Sint tok_serial = 0;
+ Sint len = erts_proc_sig_privqs_len(c_p);
Eterm seq_trace_token = ERL_MESSAGE_TOKEN(msg);
if (seq_trace_token != NIL && is_tuple(seq_trace_token)) {
@@ -3233,7 +3619,7 @@ handle_message_enqueued_tracing(Process *c_p,
DTRACE6(message_queued,
tracing->messages.receiver_name,
size_object(ERL_MESSAGE_TERM(msg)),
- c_p->sig_qs.len,
+ len, /* This is NOT message queue len, but its something... */
tok_label, tok_lastcnt, tok_serial);
}
#endif
@@ -3305,24 +3691,11 @@ handle_msg_tracing(Process *c_p, ErtsSigRecvTracing *tracing,
return 0;
}
-/*
- * ERTS_INSPECT_MSGQ_KEEP_OH_MSGS == 0 will move off heap messages
- * into the heap of the inspected process if off_heap_message_queue
- * is false when process_info(_, messages) is called. That is, the
- * following GC will have more data in the rootset compared to the
- * scenario when process_info(_, messages) had not been called.
- *
- * ERTS_INSPECT_MSGQ_KEEP_OH_MSGS != 0 will keep off heap messages
- * off heap when process_info(_, messages) is called regardless of
- * the off_heap_message_queue setting of the process. That is, it
- * will change the following execution of the process as little as
- * possible.
- */
-#define ERTS_INSPECT_MSGQ_KEEP_OH_MSGS 1
-
Uint
-erts_proc_sig_prep_msgq_for_inspection(Process *c_p, Process *rp,
+erts_proc_sig_prep_msgq_for_inspection(Process *c_p,
+ Process *rp,
ErtsProcLocks rp_locks,
+ int info_on_self,
ErtsMessageInfo *mip)
{
Uint tot_heap_size;
@@ -3331,9 +3704,8 @@ erts_proc_sig_prep_msgq_for_inspection(Process *c_p, Process *rp,
int self_on_heap;
/*
- * Prepare the message queue for inspection
- * by process_info().
- *
+ * Prepare the message queue (inner signal queue)
+ * for inspection by process_info().
*
* - Decode all messages on external format
* - Remove all corrupt dist messages from queue
@@ -3342,20 +3714,11 @@ erts_proc_sig_prep_msgq_for_inspection(Process *c_p, Process *rp,
* - Return total heap size need for all messages
* that needs to be copied.
*
- * If ERTS_INSPECT_MSGQ_KEEP_OH_MSGS == 0:
- * - In case off heap messages is disabled and
- * we are inspecting our own queue, move all
- * off heap data into the heap.
*/
- /*
- * All non-message signals *need* to have been
- * handled before calling this functions...
- */
- ASSERT(!rp->sig_qs.cont);
- ASSERT(!rp->sig_qs.nmsigs.next && !rp->sig_qs.nmsigs.last);
+ ASSERT(!info_on_self || c_p == rp);
- self_on_heap = c_p == rp && !(c_p->flags & F_OFF_HEAP_MSGQ);
+ self_on_heap = info_on_self && !(c_p->flags & F_OFF_HEAP_MSGQ);
tot_heap_size = 0;
i = 0;
@@ -3369,8 +3732,7 @@ erts_proc_sig_prep_msgq_for_inspection(Process *c_p, Process *rp,
if (ERTS_SIG_IS_EXTERNAL_MSG(mp)) {
/* decode it... */
if (mp->data.attached)
- erts_decode_dist_message(rp, rp_locks, mp,
- ERTS_INSPECT_MSGQ_KEEP_OH_MSGS);
+ erts_decode_dist_message(rp, rp_locks, mp, !0);
msg = ERL_MESSAGE_TERM(mp);
@@ -3396,44 +3758,11 @@ erts_proc_sig_prep_msgq_for_inspection(Process *c_p, Process *rp,
ASSERT(is_value(msg));
-#if ERTS_INSPECT_MSGQ_KEEP_OH_MSGS
if (is_not_immed(msg) && (!self_on_heap || mp->data.attached)) {
Uint sz = size_object(msg);
mip[i].size = sz;
tot_heap_size += sz;
}
-#else
- if (self_on_heap) {
- if (mp->data.attached) {
- ErtsMessage *tmp = NULL;
- if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG) {
- erts_link_mbuf_to_proc(rp, mp->data.heap_frag);
- mp->data.attached = NULL;
- }
- else {
- /*
- * Need to replace the message reference since
- * we will get references to the message data
- * from the heap...
- */
- ErtsMessage **mpp;
- tmp = erts_alloc_message(0, NULL);
- sys_memcpy((void *) tmp->m, (void *) mp->m,
- sizeof(Eterm)*ERL_MESSAGE_REF_ARRAY_SZ);
- mpp = i == 0 ? &rp->sig_qs.first : &mip[i-1].msgp->next;
- erts_msgq_replace_msg_ref(&rp->msg, tmp, mpp);
- erts_save_message_in_proc(rp, mp);
- mp = tmp;
- }
- }
- }
- else if (is_not_immed(msg)) {
- Uint sz = size_object(msg);
- mip[i].size = sz;
- tot_heap_size += sz;
- }
-
-#endif
mip[i].msgp = mp;
i++;
@@ -3441,6 +3770,8 @@ erts_proc_sig_prep_msgq_for_inspection(Process *c_p, Process *rp,
mp = mp->next;
}
+ ASSERT(c_p->sig_qs.len == i);
+
return tot_heap_size;
}
@@ -3477,11 +3808,11 @@ move_msg_to_heap(Process *c_p, ErtsMessage *mp)
void
erts_proc_sig_move_msgs_to_heap(Process *c_p)
{
- ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p);
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p, 0);
ERTS_FOREACH_SIG_PRIVQS(c_p, sig, move_msg_to_heap(c_p, sig));
- ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p);
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p, 0);
}
@@ -3672,6 +4003,7 @@ erts_proc_sig_debug_foreach_sig(Process *c_p,
case ERTS_SIG_Q_OP_IS_ALIVE:
case ERTS_SIG_Q_OP_TRACE_CHANGE_STATE:
+ case ERTS_SIG_Q_OP_PROCESS_INFO:
break;
default:
@@ -3716,10 +4048,8 @@ chk_eterm(Process *c_p, int privq, ErtsMessage *mp, Eterm term)
for (bp = erts_message_to_heap_frag(mp); bp; bp = bp->next) {
if (bp->mem <= ptr && ptr < bp->mem + bp->used_size)
return;
- bp = bp->next;
}
- ERTS_ASSERT(privq);
ASSERT(erts_dbg_within_proc(ptr, c_p, NULL));
}
@@ -3742,6 +4072,12 @@ proc_sig_hdbg_check_queue(Process *proc,
ErtsMessage **save = proc->sig_qs.save;
ErtsMessage **saved_last = proc->sig_qs.saved_last;
+ if (!privq) {
+ ErtsSignal *sig = (ErtsSignal *) *sig_next;
+ if (sig->common.tag == ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK) {
+
+ }
+ }
nm_next = sig_nm_next;
nm_last = sig_nm_last;
@@ -3806,21 +4142,29 @@ proc_sig_hdbg_check_queue(Process *proc,
if (!sig)
break;
- nm_sigs++;
+ nm_sig = (ErtsSignal *) sig;
- ERTS_ASSERT(!last_nm_sig_found);
- ERTS_ASSERT(ERTS_SIG_IS_NON_MSG(sig));
+ if (nm_sig->common.tag == ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK) {
+ ERTS_ASSERT(!privq);
+ ERTS_ASSERT(sig == *sig_next);
+ }
+ else {
+ nm_sigs++;
- nm_sig = (ErtsSignal *) sig;
+ ERTS_ASSERT(!last_nm_sig_found);
+ ERTS_ASSERT(ERTS_SIG_IS_NON_MSG(sig));
+
+ ERTS_ASSERT(nm_next == next);
+
+ if (nm_last == next) {
+ ASSERT(!nm_sig->common.specific.next);
+ last_nm_sig_found = 1;
+ }
- ERTS_ASSERT(nm_next == next);
+ nm_next = nm_sig->common.specific.next;
- if (nm_last == next) {
- ASSERT(!nm_sig->common.specific.next);
- last_nm_sig_found = 1;
}
- nm_next = nm_sig->common.specific.next;
next = &nm_sig->common.next;
sig = nm_sig->common.next;
@@ -3875,10 +4219,10 @@ proc_sig_hdbg_check_queue(Process *proc,
}
void
-erts_proc_sig_hdbg_check_priv_queue(Process *p, char *what, char *file, int line)
+erts_proc_sig_hdbg_check_priv_queue(Process *p, int qlock, char *what, char *file, int line)
{
int found_saved_last = 0;
- Sint len1, len2;
+ Sint len, len1, len2;
ERTS_LC_ASSERT(erts_thr_progress_is_blocking()
|| ERTS_PROC_IS_EXITING(p)
|| (ERTS_PROC_LOCK_MAIN
@@ -3903,7 +4247,8 @@ erts_proc_sig_hdbg_check_priv_queue(Process *p, char *what, char *file, int line
ERTS_PSFLG_SIG_Q);
if (p->sig_qs.saved_last)
ERTS_ASSERT(found_saved_last);
- ERTS_ASSERT(p->sig_qs.len == len1 + len2);
+ len = proc_sig_privqs_len(p, qlock);
+ ERTS_ASSERT(len == len1 + len2);
}
void
diff --git a/erts/emulator/beam/erl_proc_sig_queue.h b/erts/emulator/beam/erl_proc_sig_queue.h
index 56fe3e683e..d250ad820f 100644
--- a/erts/emulator/beam/erl_proc_sig_queue.h
+++ b/erts/emulator/beam/erl_proc_sig_queue.h
@@ -32,6 +32,7 @@
* - Unlink
* - Group leader
* - Is process alive
+ * - Process info request
* - Trace change
*
* The signal queue consists of three parts:
@@ -78,6 +79,9 @@
#if 0
# define ERTS_PROC_SIG_HARD_DEBUG
#endif
+#if 0
+# define ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+#endif
struct erl_mesg;
@@ -95,22 +99,22 @@ typedef struct {
#ifdef ERTS_PROC_SIG_HARD_DEBUG
# define ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE(P) \
ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE__((P), "")
-# define ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(P) \
- ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__((P), "")
+# define ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(P, QL) \
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__((P), (QL), "")
# define ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE__(P, What) \
erts_proc_sig_hdbg_check_in_queue((P), (What), __FILE__, __LINE__)
-# define ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__(P, What) \
- erts_proc_sig_hdbg_check_priv_queue((P), (What), __FILE__, __LINE__)
+# define ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__(P, QL, What) \
+ erts_proc_sig_hdbg_check_priv_queue((P), (QL), (What), __FILE__, __LINE__)
struct process;
-void erts_proc_sig_hdbg_check_priv_queue(struct process *c_p, char *what,
- char *file, int line);
+void erts_proc_sig_hdbg_check_priv_queue(struct process *c_p, int qlock,
+ char *what, char *file, int line);
void erts_proc_sig_hdbg_check_in_queue(struct process *c_p, char *what,
char *file, int line);
#else
# define ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE(P)
-# define ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(P)
+# define ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(P, QL)
# define ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE__(P, What)
-#define ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__(P, What)
+#define ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE__(P, QL, What)
#endif
#endif
@@ -118,6 +122,57 @@ void erts_proc_sig_hdbg_check_in_queue(struct process *c_p, char *what,
#if !defined(ERTS_PROC_SIG_QUEUE_H__) && !defined(ERTS_PROC_SIG_QUEUE_TYPE_ONLY)
#define ERTS_PROC_SIG_QUEUE_H__
+#define ERTS_SIG_Q_OP_BITS 8
+#define ERTS_SIG_Q_OP_SHIFT 0
+#define ERTS_SIG_Q_OP_MASK ((1 << ERTS_SIG_Q_OP_BITS) - 1)
+
+#define ERTS_SIG_Q_TYPE_BITS 8
+#define ERTS_SIG_Q_TYPE_SHIFT ERTS_SIG_Q_OP_BITS
+#define ERTS_SIG_Q_TYPE_MASK ((1 << ERTS_SIG_Q_TYPE_BITS) - 1)
+
+#define ERTS_SIG_Q_NON_X_BITS__ (_HEADER_ARITY_OFFS \
+ + ERTS_SIG_Q_OP_BITS \
+ + ERTS_SIG_Q_TYPE_BITS)
+
+#define ERTS_SIG_Q_XTRA_BITS (32 - ERTS_SIG_Q_NON_X_BITS__)
+#define ERTS_SIG_Q_XTRA_SHIFT (ERTS_SIG_Q_OP_BITS \
+ + ERTS_SIG_Q_TYPE_BITS)
+#define ERTS_SIG_Q_XTRA_MASK ((1 << ERTS_SIG_Q_XTRA_BITS) - 1)
+
+
+#define ERTS_PROC_SIG_OP(Tag) \
+ ((int) (_unchecked_thing_arityval((Tag)) \
+ >> ERTS_SIG_Q_OP_SHIFT) & ERTS_SIG_Q_OP_MASK)
+
+#define ERTS_PROC_SIG_TYPE(Tag) \
+ ((Uint16) (_unchecked_thing_arityval((Tag)) \
+ >> ERTS_SIG_Q_TYPE_SHIFT) & ERTS_SIG_Q_TYPE_MASK)
+
+#define ERTS_PROC_SIG_XTRA(Tag) \
+ ((Uint32) (_unchecked_thing_arityval((Tag)) \
+ >> ERTS_SIG_Q_XTRA_SHIFT) & ERTS_SIG_Q_XTRA_MASK)
+
+#define ERTS_PROC_SIG_MAKE_TAG(Op, Type, Xtra) \
+ (ASSERT(0 <= (Xtra) && (Xtra) <= ERTS_SIG_Q_XTRA_MASK), \
+ _make_header((((Type) & ERTS_SIG_Q_TYPE_MASK) \
+ << ERTS_SIG_Q_TYPE_SHIFT) \
+ | (((Op) & ERTS_SIG_Q_OP_MASK) \
+ << ERTS_SIG_Q_OP_SHIFT) \
+ | (((Xtra) & ERTS_SIG_Q_XTRA_MASK) \
+ << ERTS_SIG_Q_XTRA_SHIFT), \
+ _TAG_HEADER_EXTERNAL_PID))
+
+
+/*
+ * ERTS_SIG_Q_OP_MSGQ_LEN_OFFS_MARK is not an actual
+ * operation. We keep it at the top of the OP range,
+ * larger than ERTS_SIG_Q_OP_MAX.
+ */
+#define ERTS_SIG_Q_OP_MSGQ_LEN_OFFS_MARK ERTS_SIG_Q_OP_MASK
+
+#define ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK \
+ ERTS_PROC_SIG_MAKE_TAG(ERTS_SIG_Q_OP_MSGQ_LEN_OFFS_MARK,0,0)
+
struct dist_entry_;
/*
@@ -451,6 +506,58 @@ void
erts_proc_sig_send_is_alive_request(Process *c_p, Eterm to,
Eterm ref);
+/**
+ *
+ * @brief Send a 'process info request' signal to a process.
+ *
+ * A response message '{Ref, Result}' is sent to the
+ * sender when performed where Ref is the reference passed
+ * as 'ref' argument, and Result corresponds to return result
+ * from erlang:process_info/[1,2].
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
+ * NULL if signal arrived via
+ * distribution.
+ *
+ * @param[in] to Identifier of receiver.
+ *
+ * @param[in] item_ix Info index array to pass to
+ * erts_process_info()
+ *
+ * @param[in] len Lenght of info index array
+ *
+ * @param[in] need_msgq_len Non-zero if message queue
+ * length is needed; otherwise,
+ * zero. If non-zero, sig_qs.len
+ * will be set to correspond
+ * to the message queue length
+ * before call to
+ * erts_process_info()
+ *
+ * @param[in] flags Flags to pass to
+ * erts_process_info()
+ *
+ * @param[in] reserve_size Heap size that is known to
+ * be needed. May not be correct
+ * though.
+ *
+ * @param[in] ref Reference to use in response
+ * message to the sending
+ * process (i.e., c_p).
+ *
+ */
+int
+erts_proc_sig_send_process_info_request(Process *c_p,
+ Eterm to,
+ int *item_ix,
+ int len,
+ int need_msgq_len,
+ int flags,
+ Uint reserve_size,
+ Eterm ref);
+
+
/*
* End of send operations of currently supported process signals.
*/
@@ -601,9 +708,30 @@ erts_proc_sig_receive_helper(Process *c_p, int fcalls,
*
* @param[in] c_p Pointer to process struct of
* currently executing process.
+ * @returns Amount of message signals in
+ * inner plus middle signal
+ * queues after fetch completed
+ * (NOT the message queue
+ * length).
+ */
+ERTS_GLB_INLINE Sint erts_proc_sig_fetch(Process *p);
+
+/**
+ *
+ * @brief Get amount of messages in private queues
+ *
+ * @param[in] c_p Pointer to process struct of
+ * currently executing process.
*
+ * @returns Amount of message signals in
+ * inner plus middle signal
+ * queues after fetch completed
+ * (NOT the message queue
+ * length).
*/
-void erts_proc_sig_fetch(Process *p);
+Sint
+erts_proc_sig_privqs_len(Process *c_p);
+
typedef struct {
Uint size;
@@ -623,17 +751,19 @@ typedef struct {
*
* @param[in] rp_locks Process locks held on 'rp'.
*
+ * @param[in] info_on_self Integer set to non-zero value
+ * if caller is inspecting itself;
+ * otherwise, zero.
+ *
* @param[in] mip Pointer to array of
* ErtsMessageInfo structures.
- *
*/
-
Uint erts_proc_sig_prep_msgq_for_inspection(Process *c_p,
Process *rp,
ErtsProcLocks rp_locks,
+ int info_on_self,
ErtsMessageInfo *mip);
-
/**
*
* @brief Move message data of messages in private queues to heap
@@ -687,4 +817,56 @@ extern Process *erts_dirty_process_signal_handler;
extern Process *erts_dirty_process_signal_handler_high;
extern Process *erts_dirty_process_signal_handler_max;
+void erts_proc_sig_fetch__(Process *proc);
+Sint erts_proc_sig_fetch_msgq_len_offs__(Process *proc);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE Sint
+erts_proc_sig_fetch(Process *proc)
+{
+ Sint res = 0;
+ ErtsSignal *sig;
+
+ ERTS_LC_ASSERT(erts_thr_progress_is_blocking()
+ || ERTS_PROC_IS_EXITING(proc)
+ || ((erts_proc_lc_my_proc_locks(proc)
+ & (ERTS_PROC_LOCK_MAIN
+ | ERTS_PROC_LOCK_MSGQ))
+ == (ERTS_PROC_LOCK_MAIN
+ | ERTS_PROC_LOCK_MSGQ)));
+
+ ERTS_HDBG_CHECK_SIGNAL_IN_QUEUE(proc);
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(proc, !0);
+
+ sig = (ErtsSignal *) proc->sig_inq.first;
+ if (sig) {
+ if (ERTS_LIKELY(sig->common.tag != ERTS_PROC_SIG_MSGQ_LEN_OFFS_MARK))
+ erts_proc_sig_fetch__(proc);
+ else
+ res = erts_proc_sig_fetch_msgq_len_offs__(proc);
+ }
+
+ res += proc->sig_qs.len;
+
+ ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(proc, !0);
+
+#ifdef ERTS_PROC_SIG_HARD_DEBUG_SIGQ_MSG_LEN
+ {
+ Sint len = 0;
+ ERTS_FOREACH_SIG_PRIVQS(
+ proc, mp,
+ {
+ if (ERTS_SIG_IS_MSG(mp))
+ len++;
+ });
+ ERTS_ASSERT(res == len);
+ }
+#endif
+
+ return res;
+}
+
+#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 ba0a9fbc79..650ec0958c 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -36,7 +36,6 @@
#include "erl_db.h"
#include "dist.h"
#include "beam_catches.h"
-#include "erl_instrument.h"
#include "erl_threads.h"
#include "erl_binary.h"
#include "beam_bp.h"
@@ -2508,6 +2507,8 @@ handle_yield(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
yield |= erts_handle_yielded_ets_all_request(awdp->esdp,
&awdp->yield.ets_all);
+ yield |= erts_handle_yielded_alcu_blockscan(awdp->esdp,
+ &awdp->yield.alcu_blockscan);
/*
* Other yielding operations...
@@ -5698,6 +5699,7 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num,
esdp->ssi = ssi;
esdp->current_process = NULL;
esdp->current_port = NULL;
+ esdp->current_nif = NULL;
esdp->virtual_reds = 0;
esdp->cpu_id = -1;
@@ -6093,7 +6095,7 @@ make_proxy_proc(Process *prev_proxy, Process *proc, erts_aint32_t prio)
proxy = prev_proxy;
ASSERT(erts_atomic32_read_nob(&proxy->state) & ERTS_PSFLG_PROXY);
erts_atomic32_set_nob(&proxy->state, state);
- (void) erts_set_runq_proc(proc, rq, &bound);
+ (void) erts_set_runq_proc(proxy, rq, &bound);
}
else {
proxy = erts_alloc(ERTS_ALC_T_PROC, sizeof(Process));
@@ -6106,7 +6108,7 @@ make_proxy_proc(Process *prev_proxy, Process *proc, erts_aint32_t prio)
}
#endif
erts_atomic32_init_nob(&proxy->state, state);
- erts_init_runq_proc(proc, rq, bound);
+ erts_init_runq_proc(proxy, rq, bound);
}
proxy->common.id = proc->common.id;
@@ -8333,6 +8335,7 @@ sched_thread_func(void *vesdp)
ERTS_VERIFY_UNUSED_TEMP_ALLOC(NULL);
#endif
+ erts_alcu_sched_spec_data_init(esdp);
erts_ets_sched_spec_data_init(esdp);
process_main(esdp->x_reg_array, esdp->f_reg_array);
@@ -10830,8 +10833,7 @@ erts_execute_dirty_system_task(Process *c_p)
if (c_p->flags & F_DIRTY_GC_HIBERNATE) {
erts_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
- erts_proc_sig_fetch(c_p);
- if (c_p->sig_qs.len)
+ if (erts_proc_sig_fetch(c_p))
c_p->flags &= ~F_DIRTY_GC_HIBERNATE; /* operation aborted... */
else {
erts_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
@@ -12411,12 +12413,14 @@ erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt)
case ERTS_MON_TYPE_PORT: {
Port *prt;
ASSERT(is_internal_port(mon->other.item));
+ erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
prt = erts_id2port(mon->other.item);
if (prt) {
erts_fire_port_monitor(prt, mon);
erts_port_release(prt);
mon = NULL;
}
+ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
break;
}
case ERTS_MON_TYPE_RESOURCE:
@@ -12495,10 +12499,8 @@ erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt)
ASSERT(is_internal_port(mon->other.item));
prt = erts_port_lookup_raw(mon->other.item);
if (prt) {
- erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
if (erts_port_demonitor(c_p, prt, mon) != ERTS_PORT_OP_DROPPED)
mon = NULL;
- erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
}
break;
}
@@ -12601,7 +12603,6 @@ erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt)
if (!erts_link_dist_delete(dlnk))
ldp = NULL;
- erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
code = erts_dsig_prepare(&dsd, dep, c_p, 0, ERTS_DSP_NO_LOCK, 0, 0);
switch (code) {
case ERTS_DSIG_PREP_CONNECTED:
@@ -12615,7 +12616,6 @@ erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt)
ASSERT(code == ERTS_DSIG_SEND_OK);
}
}
- erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
break;
}
default:
@@ -12677,8 +12677,6 @@ erts_do_exit_process(Process* p, Eterm reason)
cancel_suspend_of_suspendee(p, ERTS_PROC_LOCKS_ALL);
- erts_proc_sig_fetch(p);
-
if (IS_TRACED(p)) {
if (IS_TRACED_FL(p, F_TRACE_CALLS))
erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_EXITING);
@@ -12945,6 +12943,12 @@ erts_continue_exit_process(Process *p)
pectxt.c_p = p;
pectxt.reason = reason;
+ erts_proc_lock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_MSGQ);
+
+ erts_proc_sig_fetch(p);
+
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ);
+
if (links) {
erts_link_tree_foreach_delete(&links,
erts_proc_exit_handle_link,
@@ -12966,7 +12970,6 @@ erts_continue_exit_process(Process *p)
ASSERT(!lt_monitors);
}
- erts_proc_sig_fetch(p);
/*
* erts_proc_sig_handle_exit() implements yielding.
* However, this function cannot handle it yet... loop
@@ -12978,7 +12981,6 @@ erts_continue_exit_process(Process *p)
break;
}
- erts_proc_lock(p, ERTS_PROC_LOCK_MAIN);
ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
erts_flush_trace_messages(p, ERTS_PROC_LOCK_MAIN);
@@ -13015,27 +13017,41 @@ erts_continue_exit_process(Process *p)
}
Process *
-erts_try_lock_sig_free_proc(Eterm pid, ErtsProcLocks locks)
+erts_try_lock_sig_free_proc(Eterm pid, ErtsProcLocks locks,
+ erts_aint32_t *statep)
{
Process *rp = erts_proc_lookup_raw(pid);
erts_aint32_t state;
- if (!rp)
+ if (!rp) {
+ if (statep)
+ *statep = ERTS_PSFLG_EXITING|ERTS_PSFLG_FREE;
return NULL;
+ }
ERTS_LC_ASSERT(!erts_proc_lc_my_proc_locks(rp));
state = erts_atomic32_read_nob(&rp->state);
- if (state & ERTS_PSFLG_EXITING)
+ if (statep)
+ *statep = state;
+
+ if (state & ERTS_PSFLG_FREE)
return NULL;
if (state & (ERTS_PSFLG_SIG_IN_Q|ERTS_PSFLG_SIG_Q))
return ERTS_PROC_LOCK_BUSY;
+
+ if (!locks)
+ return rp;
+
if (erts_proc_trylock(rp, locks) == EBUSY)
return ERTS_PROC_LOCK_BUSY;
state = erts_atomic32_read_nob(&rp->state);
- if (state & ERTS_PSFLG_EXITING) {
+ if (statep)
+ *statep = state;
+
+ if (state & ERTS_PSFLG_FREE) {
erts_proc_unlock(rp, locks);
return NULL;
}
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index f7c6c3435b..e2aa1d9f84 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -593,6 +593,7 @@ typedef struct {
ErtsDelayedAuxWorkWakeupJob *job;
} delayed_wakeup;
struct {
+ ErtsAlcuBlockscanYieldData alcu_blockscan;
ErtsEtsAllYieldData ets_all;
/* Other yielding operations... */
} yield;
@@ -637,6 +638,7 @@ struct ErtsSchedulerData_ {
ErtsSchedType type;
Uint no; /* Scheduler number for normal schedulers */
Uint dirty_no; /* Scheduler number for dirty schedulers */
+ struct enif_environment_t *current_nif;
Process *dirty_shadow_process;
Port *current_port;
ErtsRunQueue *run_queue;
@@ -1391,6 +1393,7 @@ extern int erts_system_profile_ts_type;
#define F_LOCAL_SIGS_ONLY (1 << 26)
#define F_TRAP_EXIT (1 << 27) /* Trapping exit */
#define F_DEFERRED_SAVED_LAST (1 << 28)
+#define F_DELAYED_PSIGQS_LEN (1 << 29)
/*
* F_DISABLE_GC and F_DELAY_GC are similar. Both will prevent
@@ -1817,6 +1820,10 @@ void erts_print_scheduler_info(fmtfn_t to, void *to_arg, ErtsSchedulerData *esdp
void erts_print_run_queue_info(fmtfn_t, void *to_arg, ErtsRunQueue*);
void erts_dump_extended_process_state(fmtfn_t to, void *to_arg, erts_aint32_t psflg);
void erts_dump_process_state(fmtfn_t to, void *to_arg, erts_aint32_t psflg);
+Eterm erts_process_info(Process *c_p, ErtsHeapFactory *hfact,
+ Process *rp, ErtsProcLocks rp_locks,
+ int *item_ix, int item_ix_len,
+ int flags, Uint reserve_size, Uint *reds);
typedef struct {
Process *c_p;
@@ -1855,7 +1862,7 @@ Uint erts_debug_nbalance(void);
int erts_debug_wait_completed(Process *c_p, int flags);
-Uint erts_process_memory(Process *c_p, int incl_msg_inq);
+Uint erts_process_memory(Process *c_p, int include_sigs_in_transit);
#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC
# define ERTS_VERIFY_UNUSED_TEMP_ALLOC(P) \
@@ -2595,7 +2602,8 @@ ERTS_TIME2REDS_IMPL__(ErtsMonotonicTime start, ErtsMonotonicTime end)
#endif
Process *erts_try_lock_sig_free_proc(Eterm pid,
- ErtsProcLocks locks);
+ ErtsProcLocks locks,
+ erts_aint32_t *statep);
Process *erts_pid2proc_not_running(Process *,
ErtsProcLocks,
diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c
index aee88841ae..38be3938cd 100644
--- a/erts/emulator/beam/erl_process_dict.c
+++ b/erts/emulator/beam/erl_process_dict.c
@@ -239,39 +239,70 @@ erts_erase_dicts(Process *p)
/*
* Called from process_info/1,2.
*/
-Eterm erts_dictionary_copy(Process *p, ProcDict *pd)
+Eterm erts_dictionary_copy(ErtsHeapFactory *hfact, ProcDict *pd, Uint reserve_size)
{
- Eterm* hp;
- Eterm* heap_start;
- Eterm res = NIL;
- Eterm tmp, tmp2;
+ Eterm res;
unsigned int i, num;
+ Uint *sz;
+ Uint szi, rsz = reserve_size;
- if (pd == NULL) {
- return res;
- }
+ if (pd == NULL)
+ return NIL;
PD_CHECK(pd);
num = HASH_RANGE(pd);
- heap_start = hp = (Eterm *) erts_alloc(ERTS_ALC_T_TMP,
- sizeof(Eterm) * pd->numElements * 2);
- for (i = 0; i < num; ++i) {
- tmp = ARRAY_GET(pd, i);
+ sz = (Uint *) erts_alloc(ERTS_ALC_T_TMP, sizeof(Uint) * pd->numElements);
+
+ for (i = 0, szi = 0; i < num; ++i) {
+ Eterm tmp = ARRAY_GET(pd, i);
if (is_boxed(tmp)) {
+ Uint size;
ASSERT(is_tuple(tmp));
- res = CONS(hp, tmp, res);
- hp += 2;
- } else if (is_list(tmp)) {
+ size = size_object(tmp) + 2;
+ sz[szi++] = size;
+ rsz += size;
+ }
+ else if (is_list(tmp)) {
while (tmp != NIL) {
- tmp2 = TCAR(tmp);
- res = CONS(hp, tmp2, res);
- hp += 2;
+ Uint size = size_object(TCAR(tmp)) + 2;
+ sz[szi++] = size;
+ rsz += size;
+ tmp = TCDR(tmp);
+ }
+ }
+ }
+
+ res = NIL;
+
+ for (i = 0, szi = 0; i < num; ++i) {
+ Eterm tmp = ARRAY_GET(pd, i);
+ if (is_boxed(tmp)) {
+ Uint size;
+ Eterm el, *hp;
+ ASSERT(is_tuple(tmp));
+ size = sz[szi++];
+ rsz -= size;
+ hp = erts_produce_heap(hfact, size, rsz);
+ el = copy_struct(tmp, size-2, &hp, hfact->off_heap);
+ res = CONS(hp, el, res);
+ }
+ else if (is_list(tmp)) {
+ while (tmp != NIL) {
+ Uint size = sz[szi++];
+ Eterm el, *hp;
+ rsz -= size;
+ hp = erts_produce_heap(hfact, size, rsz);
+ el = copy_struct(TCAR(tmp), size-2, &hp, hfact->off_heap);
+ res = CONS(hp, el, res);
tmp = TCDR(tmp);
}
}
}
- res = copy_object(res, p);
- erts_free(ERTS_ALC_T_TMP, (void *) heap_start);
+
+ ASSERT(rsz == reserve_size);
+
+ erts_free(ERTS_ALC_T_TMP, sz);
+
return res;
}
diff --git a/erts/emulator/beam/erl_process_dict.h b/erts/emulator/beam/erl_process_dict.h
index ab58f3c239..b89b387f5a 100644
--- a/erts/emulator/beam/erl_process_dict.h
+++ b/erts/emulator/beam/erl_process_dict.h
@@ -40,7 +40,7 @@ void erts_erase_dicts(struct process *p);
void erts_dictionary_dump(fmtfn_t to, void *to_arg, ProcDict *pd);
void erts_deep_dictionary_dump(fmtfn_t to, void *to_arg,
ProcDict* pd, void (*cb)(fmtfn_t, void *, Eterm obj));
-Eterm erts_dictionary_copy(struct process *p, ProcDict *pd);
+Eterm erts_dictionary_copy(ErtsHeapFactory *hfact, ProcDict *pd, Uint reserve_size);
Eterm erts_pd_hash_get(struct process *p, Eterm id);
Uint32 erts_pd_make_hx(Eterm key);
diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c
index 5db276ec7f..243db4c734 100644
--- a/erts/emulator/beam/erl_process_dump.c
+++ b/erts/emulator/beam/erl_process_dump.c
@@ -109,56 +109,77 @@ link_size(ErtsMonitor *lnk, void *vsize)
*((Uint *) vsize) += erts_link_size(lnk);
}
-Uint erts_process_memory(Process *p, int incl_msg_inq) {
- Uint size = 0;
- struct saved_calls *scb;
- size += sizeof(Process);
-
- if (incl_msg_inq) {
- erts_proc_lock(p, ERTS_PROC_LOCK_MSGQ);
- erts_proc_sig_fetch(p);
- erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ);
- }
-
- erts_link_tree_foreach(ERTS_P_LINKS(p),
- link_size, (void *) &size);
- erts_monitor_tree_foreach(ERTS_P_MONITORS(p),
- monitor_size, (void *) &size);
- erts_monitor_list_foreach(ERTS_P_LT_MONITORS(p),
- monitor_size, (void *) &size);
- size += (p->heap_sz + p->mbuf_sz) * sizeof(Eterm);
- if (p->abandoned_heap)
- size += (p->hend - p->heap) * sizeof(Eterm);
- if (p->old_hend && p->old_heap)
- size += (p->old_hend - p->old_heap) * sizeof(Eterm);
-
-
- size += p->sig_qs.len * sizeof(ErtsMessage);
-
- ERTS_FOREACH_SIG_PRIVQS(
- p, mp,
- {
- if (ERTS_SIG_IS_NON_MSG((ErtsSignal *) mp))
- size += erts_proc_sig_signal_size((ErtsSignal *) mp);
- else if (mp->data.attached)
- size += erts_msg_attached_data_size(mp) * sizeof(Eterm);
- });
-
- if (p->arg_reg != p->def_arg_reg) {
- size += p->arity * sizeof(p->arg_reg[0]);
- }
-
- if (erts_atomic_read_nob(&p->psd) != (erts_aint_t) NULL)
- size += sizeof(ErtsPSD);
-
- scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p);
- if (scb) {
- size += (sizeof(struct saved_calls)
- + (scb->len-1) * sizeof(scb->ct[0]));
- }
-
- size += erts_dicts_mem_size(p);
- return size;
+Uint erts_process_memory(Process *p, int include_sigs_in_transit)
+{
+ Uint size = 0;
+ struct saved_calls *scb;
+
+ size += sizeof(Process);
+
+ erts_link_tree_foreach(ERTS_P_LINKS(p),
+ link_size, (void *) &size);
+ erts_monitor_tree_foreach(ERTS_P_MONITORS(p),
+ monitor_size, (void *) &size);
+ erts_monitor_list_foreach(ERTS_P_LT_MONITORS(p),
+ monitor_size, (void *) &size);
+ size += (p->heap_sz + p->mbuf_sz) * sizeof(Eterm);
+ if (p->abandoned_heap)
+ size += (p->hend - p->heap) * sizeof(Eterm);
+ if (p->old_hend && p->old_heap)
+ size += (p->old_hend - p->old_heap) * sizeof(Eterm);
+
+ if (!include_sigs_in_transit) {
+ /*
+ * Size of message queue!
+ *
+ * Note that this assumes that any part of message
+ * queue located in middle queue have been moved
+ * into the inner queue prior to this call.
+ * process_info() management ensures this is done-
+ */
+ ErtsMessage *mp;
+ for (mp = p->sig_qs.first; mp; mp = mp->next) {
+ ASSERT(ERTS_SIG_IS_MSG((ErtsSignal *) mp));
+ size += sizeof(ErtsMessage);
+ if (mp->data.attached)
+ size += erts_msg_attached_data_size(mp) * sizeof(Eterm);
+ }
+ }
+ else {
+ /*
+ * Size of message queue plus size of all signals
+ * in transit to the process!
+ */
+ erts_proc_lock(p, ERTS_PROC_LOCK_MSGQ);
+ erts_proc_sig_fetch(p);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ);
+
+ ERTS_FOREACH_SIG_PRIVQS(
+ p, mp,
+ {
+ size += sizeof(ErtsMessage);
+ if (ERTS_SIG_IS_NON_MSG((ErtsSignal *) mp))
+ size += erts_proc_sig_signal_size((ErtsSignal *) mp);
+ else if (mp->data.attached)
+ size += erts_msg_attached_data_size(mp) * sizeof(Eterm);
+ });
+ }
+
+ if (p->arg_reg != p->def_arg_reg) {
+ size += p->arity * sizeof(p->arg_reg[0]);
+ }
+
+ if (erts_atomic_read_nob(&p->psd) != (erts_aint_t) NULL)
+ size += sizeof(ErtsPSD);
+
+ scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p);
+ if (scb) {
+ size += (sizeof(struct saved_calls)
+ + (scb->len-1) * sizeof(scb->ct[0]));
+ }
+
+ size += erts_dicts_mem_size(p);
+ return size;
}
static ERTS_INLINE void
diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c
index e5bb3cc15f..4f91d9ad07 100644
--- a/erts/emulator/beam/erl_time_sup.c
+++ b/erts/emulator/beam/erl_time_sup.c
@@ -2204,6 +2204,8 @@ time_unit_conversion(Process *c_p, Eterm term, ErtsMonotonicTime val, ErtsMonoto
ERTS_BIF_PREP_RET(ret, make_time_val(c_p, result));
break;
#endif
+ case am_perf_counter:
+ goto trap_to_erlang_code;
default: {
Eterm value, native_res;
#ifndef ARCH_64
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index 018894f685..1e833539b3 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -2593,7 +2593,7 @@ erts_term_to_tracer(Eterm prefix, Eterm t)
state = tp[3];
}
} else {
- if (arityval(tp[0]) == 2 && is_atom(tp[2])) {
+ if (arityval(tp[0]) == 2 && is_atom(tp[1])) {
module = tp[1];
state = tp[2];
}
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 7724231cd5..2cf268162d 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -123,6 +123,7 @@ void erts_unload_nif(struct erl_module_nif* nif);
extern void erl_nif_init(void);
extern int erts_nif_get_funcs(struct erl_module_nif*,
struct enif_func_t **funcs);
+extern Module *erts_nif_get_module(struct erl_module_nif*);
extern Eterm erts_nif_call_function(Process *p, Process *tracee,
struct erl_module_nif*,
struct enif_func_t *,
@@ -200,6 +201,7 @@ typedef struct {
struct erts_driver_t_ {
erts_driver_t *next;
erts_driver_t *prev;
+ Eterm name_atom;
char *name;
struct {
int major;
@@ -860,6 +862,8 @@ void erts_emasculate_writable_binary(ProcBin* pb);
Eterm erts_new_heap_binary(Process *p, byte *buf, int len, byte** datap);
Eterm erts_new_mso_binary(Process*, byte*, Uint);
Eterm new_binary(Process*, byte*, Uint);
+Eterm erts_heap_factory_new_binary(ErtsHeapFactory *hfact, byte *buf,
+ Uint len, Uint reserve_size);
Eterm erts_realloc_binary(Eterm bin, size_t size);
Eterm erts_build_proc_bin(ErlOffHeap*, Eterm*, Binary*);
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index 66b8005975..2446b3c074 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -956,6 +956,9 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp)
reds_left_in = ERTS_BIF_REDS_LEFT(c_p);
erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+
+ ASSERT((c_p->scheduler_data)->current_port == NULL);
+ (c_p->scheduler_data)->current_port = prt;
}
ASSERT(0 <= reds_left_in && reds_left_in <= CONTEXT_REDS);
@@ -1017,6 +1020,9 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp)
erts_port_release(prt);
if (c_p) {
+ ASSERT((c_p->scheduler_data)->current_port == prt);
+ (c_p->scheduler_data)->current_port = NULL;
+
erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
if (reds != (CONTEXT_REDS - sp->reds_left_in)) {
@@ -2906,11 +2912,8 @@ static void lcnt_enable_driver_lock_count(erts_driver_t *dp, int enable)
{
if (dp->lock) {
if (enable) {
- Eterm name_as_atom = erts_atom_put((byte*)dp->name, sys_strlen(dp->name),
- ERTS_ATOM_ENC_LATIN1, 1);
-
- erts_lcnt_install_new_lock_info(&dp->lock->lcnt, "driver_lock", name_as_atom,
- ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
+ erts_lcnt_install_new_lock_info(&dp->lock->lcnt, "driver_lock",
+ dp->name_atom, ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO);
} else {
erts_lcnt_uninstall(&dp->lock->lcnt);
}
@@ -7357,7 +7360,11 @@ no_stop_select_callback(ErlDrvEvent event, void* private)
static int
init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle)
{
+ drv->name_atom = erts_atom_put((byte*)de->driver_name,
+ sys_strlen(de->driver_name),
+ ERTS_ATOM_ENC_LATIN1, 1);
drv->name = de->driver_name;
+
ASSERT(de->extended_marker == ERL_DRV_EXTENDED_MARKER);
ASSERT(de->major_version >= 2);
drv->version.major = de->major_version;
@@ -7367,13 +7374,10 @@ init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle)
if (drv->flags & ERL_DRV_FLAG_USE_PORT_LOCKING) {
drv->lock = NULL;
} else {
- Eterm driver_id = erts_atom_put((byte *) drv->name,
- sys_strlen(drv->name),
- ERTS_ATOM_ENC_LATIN1, 1);
-
drv->lock = erts_alloc(ERTS_ALC_T_DRIVER_LOCK, sizeof(erts_mtx_t));
- erts_mtx_init(drv->lock, "driver_lock", driver_id, ERTS_LOCK_FLAGS_CATEGORY_IO);
+ erts_mtx_init(drv->lock, "driver_lock", drv->name_atom,
+ ERTS_LOCK_FLAGS_CATEGORY_IO);
}
drv->entry = de;
@@ -7459,18 +7463,12 @@ int erts_add_driver_entry(ErlDrvEntry *de, DE_Handle *handle,
erts_tsd_set(driver_list_lock_status_key, (void *) 1);
}
- if (taint) {
- Eterm name_atom = erts_atom_put((byte*)de->driver_name,
- sys_strlen(de->driver_name),
- ERTS_ATOM_ENC_LATIN1, 0);
- if (is_atom(name_atom))
- erts_add_taint(name_atom);
- else
- err = 1;
- }
-
if (!err) {
err = init_driver(dp, de, handle);
+
+ if (taint) {
+ erts_add_taint(dp->name_atom);
+ }
}
if (err) {
diff --git a/erts/emulator/beam/msg_instrs.tab b/erts/emulator/beam/msg_instrs.tab
index 289436da6f..26bea0efc6 100644
--- a/erts/emulator/beam/msg_instrs.tab
+++ b/erts/emulator/beam/msg_instrs.tab
@@ -225,6 +225,7 @@ remove_message() {
Sint tok_label = 0;
Sint tok_lastcnt = 0;
Sint tok_serial = 0;
+ Sint len = erts_proc_sig_privqs_len(c_p);
dtrace_proc_str(c_p, receiver_name);
token2 = SEQ_TRACE_TOKEN(c_p);
@@ -235,7 +236,8 @@ remove_message() {
}
DTRACE6(message_receive,
receiver_name, size_object(ERL_MESSAGE_TERM(msgp)),
- c_p->sig_qs.len - 1, tok_label, tok_lastcnt, tok_serial);
+ len, /* This is NOT message queue len, but its something... */
+ tok_label, tok_lastcnt, tok_serial);
}
#endif
UNLINK_MESSAGE(c_p, msgp);
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 4bf60619ba..2e22130524 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -59,6 +59,7 @@
#endif
#define ERTS_WANT_NFUNC_SCHED_INTERNALS__
#include "erl_nfunc_sched.h"
+#include "erl_proc_sig_queue.h"
#undef M_TRIM_THRESHOLD
#undef M_TOP_PAD
@@ -139,7 +140,7 @@ Eterm*
erts_set_hole_marker(Eterm* ptr, Uint sz)
{
Eterm* p = ptr;
- int i;
+ Uint i;
for (i = 0; i < sz; i++) {
*p++ = ERTS_HOLE_MARKER;
@@ -1960,7 +1961,7 @@ static void do_send_logger_message(Eterm *hp, ErlOffHeap *ohp, ErlHeapFragment *
{notify,{info_msg,gleader,{emulator,format,[args]}}} |
{notify,{error,gleader,{emulator,format,[args]}}} |
{notify,{warning_msg,gleader,{emulator,format,[args}]}} */
-static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len)
+static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, size_t len)
{
Uint sz;
Eterm gl;
@@ -1973,7 +1974,7 @@ static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len)
ASSERT(is_atom(tag));
- if (len <= 0) {
+ if (len == 0) {
return -1;
}
@@ -2006,7 +2007,7 @@ static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len)
}
static int do_send_term_to_logger(Eterm tag, Eterm gleader,
- char *buf, int len, Eterm args)
+ char *buf, size_t len, Eterm args)
{
Uint sz;
Eterm gl;
@@ -2047,13 +2048,13 @@ static int do_send_term_to_logger(Eterm tag, Eterm gleader,
}
static ERTS_INLINE int
-send_info_to_logger(Eterm gleader, char *buf, int len)
+send_info_to_logger(Eterm gleader, char *buf, size_t len)
{
return do_send_to_logger(am_info_msg, gleader, buf, len);
}
static ERTS_INLINE int
-send_warning_to_logger(Eterm gleader, char *buf, int len)
+send_warning_to_logger(Eterm gleader, char *buf, size_t len)
{
Eterm tag;
switch (erts_error_logger_warnings) {
@@ -2065,13 +2066,13 @@ send_warning_to_logger(Eterm gleader, char *buf, int len)
}
static ERTS_INLINE int
-send_error_to_logger(Eterm gleader, char *buf, int len)
+send_error_to_logger(Eterm gleader, char *buf, size_t len)
{
return do_send_to_logger(am_error, gleader, buf, len);
}
static ERTS_INLINE int
-send_error_term_to_logger(Eterm gleader, char *buf, int len, Eterm args)
+send_error_term_to_logger(Eterm gleader, char *buf, size_t len, Eterm args)
{
return do_send_term_to_logger(am_error, gleader, buf, len, args);
}
diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c
index 6d531fdb76..3e77dce1cd 100644
--- a/erts/emulator/sys/common/erl_check_io.c
+++ b/erts/emulator/sys/common/erl_check_io.c
@@ -1736,7 +1736,7 @@ erts_check_io(ErtsPollThread *psi)
}
}
if (resource) {
- erts_resource_stop(resource, (ErlNifEvent)fd, 1);
+ erts_resource_stop(resource, (ErlNifEvent)fd, 0);
enif_release_resource(resource->data);
}
if (free_select)
diff --git a/erts/emulator/sys/common/erl_sys_common_misc.c b/erts/emulator/sys/common/erl_sys_common_misc.c
index 826307c077..41a6fcb7e1 100644
--- a/erts/emulator/sys/common/erl_sys_common_misc.c
+++ b/erts/emulator/sys/common/erl_sys_common_misc.c
@@ -217,14 +217,16 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals,
}
do {
+ Uint64 n;
if (!frac_part) {
do {
*p++ = '0';
} while (--decimals);
break;
}
- *p++ = (char)((frac_part % 10) + '0');
- frac_part /= 10;
+ n = frac_part / 10;
+ *p++ = (char)((frac_part - n*10) + '0');
+ frac_part = n;
} while (--decimals);
*p++ = '.';
@@ -236,9 +238,10 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals,
*p++ = '0';
} else {
do {
- *p++ = (char)((int_part % 10) + '0');
- int_part /= 10;
- }while (int_part);
+ Uint64 n = int_part / 10;
+ *p++ = (char)((int_part - n*10) + '0');
+ int_part = n;
+ } while (int_part);
}
if (neg)
*p++ = '-';
diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl
index 22706ae8b1..32bfcd5520 100644
--- a/erts/emulator/test/bif_SUITE.erl
+++ b/erts/emulator/test/bif_SUITE.erl
@@ -35,7 +35,8 @@
is_builtin/1, error_stacktrace/1,
error_stacktrace_during_call_trace/1,
group_leader_prio/1, group_leader_prio_dirty/1,
- is_process_alive/1]).
+ is_process_alive/1,
+ process_info_blast/1]).
suite() ->
[{ct_hooks,[ts_install_cth]},
@@ -50,7 +51,7 @@ all() ->
erl_crash_dump_bytes, min_max, erlang_halt, is_builtin,
error_stacktrace, error_stacktrace_during_call_trace,
group_leader_prio, group_leader_prio_dirty,
- is_process_alive].
+ is_process_alive, process_info_blast].
%% Uses erlang:display to test that erts_printf does not do deep recursion
display(Config) when is_list(Config) ->
@@ -1099,6 +1100,76 @@ is_process_alive(Config) when is_list(Config) ->
Ps),
ok.
+process_info_blast(Config) when is_list(Config) ->
+ Tester = self(),
+ NoAttackers = 1000,
+ NoAL = lists:seq(1, NoAttackers),
+ Consume = make_ref(),
+ Victim = spawn_link(fun () ->
+ receive
+ Consume ->
+ ok
+ end,
+ consume_msgs()
+ end),
+ AFun = fun () ->
+ Victim ! hej,
+ Res = process_info(Victim, message_queue_len),
+ Tester ! {self(), Res}
+ end,
+ Attackers0 = lists:map(fun (_) ->
+ spawn_link(AFun)
+ end,
+ NoAL),
+ lists:foreach(fun (A) ->
+ receive
+ {A, Res} ->
+ case Res of
+ {message_queue_len, Len} when Len > 0, Len =< NoAttackers ->
+ Len;
+ Error ->
+ exit({unexpected, Error})
+ end
+ end
+ end,
+ Attackers0),
+ Attackers1 = lists:map(fun (_) ->
+ spawn_link(AFun)
+ end,
+ NoAL),
+ Victim ! Consume,
+ lists:foreach(fun (A) ->
+ receive
+ {A, Res} ->
+ case Res of
+ {message_queue_len, Len} when Len >= 0, Len =< 2*NoAttackers+1 ->
+ ok;
+ undefined ->
+ ok;
+ Error ->
+ exit({unexpected, Error})
+ end
+ end
+ end,
+ Attackers1),
+ KillFun = fun (P) ->
+ unlink(P),
+ exit(P, kill),
+ false = erlang:is_process_alive(P)
+ end,
+ lists:foreach(fun (A) -> KillFun(A) end, Attackers0),
+ lists:foreach(fun (A) -> KillFun(A) end, Attackers1),
+ KillFun(Victim),
+ ok.
+
+consume_msgs() ->
+ receive
+ _ ->
+ consume_msgs()
+ after 0 ->
+ ok
+ end.
+
%% helpers
id(I) -> I.
diff --git a/erts/emulator/test/dump_SUITE.erl b/erts/emulator/test/dump_SUITE.erl
index 38fa198ea6..8d18d46d92 100644
--- a/erts/emulator/test/dump_SUITE.erl
+++ b/erts/emulator/test/dump_SUITE.erl
@@ -96,12 +96,12 @@ get_dump_when_done(Dump) ->
{ok, #file_info{ size = Sz }} ->
get_dump_when_done(Dump, Sz);
{error, enoent} ->
- timer:sleep(100),
+ timer:sleep(1000),
get_dump_when_done(Dump)
end.
get_dump_when_done(Dump, Sz) ->
- timer:sleep(100),
+ timer:sleep(1000),
case file:read_file_info(Dump) of
{ok, #file_info{ size = Sz }} ->
file:read_file(Dump);
diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl
index da0292f385..60d14ce841 100644
--- a/erts/emulator/test/exception_SUITE.erl
+++ b/erts/emulator/test/exception_SUITE.erl
@@ -23,7 +23,8 @@
-export([all/0, suite/0,
badmatch/1, pending_errors/1, nil_arith/1, top_of_stacktrace/1,
stacktrace/1, nested_stacktrace/1, raise/1, gunilla/1, per/1,
- exception_with_heap_frag/1, line_numbers/1]).
+ exception_with_heap_frag/1, backtrace_depth/1,
+ line_numbers/1]).
-export([bad_guy/2]).
-export([crash/1]).
@@ -42,7 +43,7 @@ suite() ->
all() ->
[badmatch, pending_errors, nil_arith, top_of_stacktrace,
stacktrace, nested_stacktrace, raise, gunilla, per,
- exception_with_heap_frag, line_numbers].
+ exception_with_heap_frag, backtrace_depth, line_numbers].
-define(try_match(E),
catch ?MODULE:bar(),
@@ -572,6 +573,57 @@ do_exception_with_heap_frag(Bin, [Sz|Sizes]) ->
do_exception_with_heap_frag(Bin, Sizes);
do_exception_with_heap_frag(_, []) -> ok.
+backtrace_depth(Config) when is_list(Config) ->
+ _ = [do_backtrace_depth(D) || D <- lists:seq(0, 8)],
+ ok.
+
+do_backtrace_depth(D) ->
+ Old = erlang:system_flag(backtrace_depth, D),
+ try
+ Expected = max(1, D),
+ do_backtrace_depth_1(Expected)
+ after
+ _ = erlang:system_flag(backtrace_depth, Old)
+ end.
+
+do_backtrace_depth_1(D) ->
+ Exit = fun() ->
+ error(reason)
+ end,
+ HandCrafted = fun() ->
+ {'EXIT',{_,Stk0}} = (catch error(get_stacktrace)),
+ %% Fool the compiler to force a hand-crafted
+ %% stacktrace.
+ Stk = [hd(Stk0)|tl(Stk0)],
+ erlang:raise(error, reason, Stk)
+ end,
+ PassedOn = fun() ->
+ try error(get_stacktrace)
+ catch error:_:Stk ->
+ %% Just pass on the given stacktrace.
+ erlang:raise(error, reason, Stk)
+ end
+ end,
+ do_backtrace_depth_2(D, Exit),
+ do_backtrace_depth_2(D, HandCrafted),
+ do_backtrace_depth_2(D, PassedOn),
+ ok.
+
+do_backtrace_depth_2(D, Exc) ->
+ try
+ Exc()
+ catch
+ error:reason:Stk ->
+ if
+ length(Stk) =/= D ->
+ io:format("Expected depth: ~p\n", [D]),
+ io:format("~p\n", [Stk]),
+ error(bad_depth);
+ true ->
+ ok
+ end
+ end.
+
line_numbers(Config) when is_list(Config) ->
{'EXIT',{{case_clause,bad_tag},
[{?MODULE,line1,2,
diff --git a/erts/emulator/test/lcnt_SUITE.erl b/erts/emulator/test/lcnt_SUITE.erl
index 4e52c2813c..dfffd662e2 100644
--- a/erts/emulator/test/lcnt_SUITE.erl
+++ b/erts/emulator/test/lcnt_SUITE.erl
@@ -87,8 +87,9 @@ wait_for_empty_lock_list() ->
wait_for_empty_lock_list(10).
wait_for_empty_lock_list(Tries) when Tries > 0 ->
try_flush_cleanup_ops(),
- case erts_debug:lcnt_collect() of
- [{duration, _}, {locks, []}] ->
+ [{duration, _}, {locks, Locks}] = erts_debug:lcnt_collect(),
+ case remove_untoggleable_locks(Locks) of
+ [] ->
ok;
_ ->
timer:sleep(50),
@@ -124,7 +125,7 @@ toggle_lock_counting(Config) when is_list(Config) ->
get_lock_info_for(Categories) when is_list(Categories) ->
ok = erts_debug:lcnt_control(mask, Categories),
[{duration, _}, {locks, Locks}] = erts_debug:lcnt_collect(),
- Locks;
+ remove_untoggleable_locks(Locks);
get_lock_info_for(Category) when is_atom(Category) ->
get_lock_info_for([Category]).
@@ -178,3 +179,13 @@ registered_db_tables(Config) when is_list(Config) ->
(_Lock) -> false
end, DbLocks),
ok.
+
+%% Not all locks can be toggled on or off due to technical limitations, so we
+%% need to filter them out when checking whether we successfully disabled lock
+%% counting.
+remove_untoggleable_locks([]) ->
+ [];
+remove_untoggleable_locks([{resource_monitors, _, _, _} | T]) ->
+ remove_untoggleable_locks(T);
+remove_untoggleable_locks([H | T]) ->
+ [H | remove_untoggleable_locks(T)].
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index a9eb4b2768..df521311e3 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -653,7 +653,7 @@ select_steal(Config) when is_list(Config) ->
check_stop_ret(select_nif(RFd, ?ERL_NIF_SELECT_STOP, RFd, null, Ref)),
?assertMatch([{fd_resource_stop, RPtr, _}], flush()),
- {1, {RPtr, 1}} = last_fd_stop_call(),
+ {1, {RPtr, _DirectCall}} = last_fd_stop_call(),
?assert(is_closed_nif(WFd)),
diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl
index 7eff786e8b..585c5a1871 100644
--- a/erts/emulator/test/process_SUITE.erl
+++ b/erts/emulator/test/process_SUITE.erl
@@ -42,6 +42,8 @@
process_info_lock_reschedule2/1,
process_info_lock_reschedule3/1,
process_info_garbage_collection/1,
+ process_info_smoke_all/1,
+ process_info_status_handled_signal/1,
bump_reductions/1, low_prio/1, binary_owner/1, yield/1, yield2/1,
otp_4725/1, bad_register/1, garbage_collect/1, otp_6237/1,
process_info_messages/1, process_flag_badarg/1, process_flag_heap_size/1,
@@ -79,6 +81,8 @@ all() ->
process_info_lock_reschedule2,
process_info_lock_reschedule3,
process_info_garbage_collection,
+ process_info_smoke_all,
+ process_info_status_handled_signal,
bump_reductions, low_prio, yield, yield2, otp_4725,
bad_register, garbage_collect, process_info_messages,
process_flag_badarg, process_flag_heap_size,
@@ -510,14 +514,20 @@ pio_current_location(N, Pid, Pi, Looper) ->
case Where of
{erlang,process_info,2,[]} ->
pio_current_location(N-1, Pid, Pi+1, Looper);
+ {erts_internal,await_result,1, Loc} when is_list(Loc) ->
+ pio_current_location(N-1, Pid, Pi+1, Looper);
{?MODULE,process_info_looper,1,Loc} when is_list(Loc) ->
- pio_current_location(N-1, Pid, Pi, Looper+1)
+ pio_current_location(N-1, Pid, Pi, Looper+1);
+ _ ->
+ exit({unexpected_location, Where})
end.
pio_current_stacktrace() ->
L = [begin
- {current_stacktrace,Stk} = process_info(P, current_stacktrace),
- {P,Stk}
+ case process_info(P, current_stacktrace) of
+ {current_stacktrace, Stk} -> {P,Stk};
+ undefined -> {P, []}
+ end
end || P <- processes()],
[erlang:garbage_collect(P) || {P,_} <- L],
erlang:garbage_collect(),
@@ -973,6 +983,106 @@ process_info_garbage_collection(_Config) ->
gv(Key,List) ->
proplists:get_value(Key,List).
+process_info_smoke_all_tester() ->
+ register(process_info_smoke_all_tester, self()),
+ put(ets_ref, ets:new(blupp, [])),
+ put(binary, [list_to_binary(lists:duplicate(1000, 1)),
+ list_to_binary(lists:duplicate(1000, 2))]),
+ process_info_smoke_all_tester_loop().
+
+process_info_smoke_all_tester_loop() ->
+ receive
+ {other_process, Pid} ->
+ case get(procs) of
+ undefined -> put(procs, [Pid]);
+ Procs -> put(procs, [Pid|Procs])
+ end,
+ erlang:monitor(process, Pid),
+ link(Pid),
+ process_info_smoke_all_tester_loop()
+ end.
+
+process_info_smoke_all(Config) when is_list(Config) ->
+ AllPIOptions = [registered_name,
+ current_function,
+ initial_call,
+ messages,
+ message_queue_len,
+ links,
+ monitors,
+ monitored_by,
+ dictionary,
+ trap_exit,
+ error_handler,
+ heap_size,
+ stack_size,
+ memory,
+ garbage_collection,
+ group_leader,
+ reductions,
+ priority,
+ trace,
+ binary,
+ sequential_trace_token,
+ catchlevel,
+ backtrace,
+ last_calls,
+ total_heap_size,
+ suspending,
+ min_heap_size,
+ min_bin_vheap_size,
+ max_heap_size,
+ current_location,
+ current_stacktrace,
+ message_queue_data,
+ garbage_collection_info,
+ magic_ref,
+ fullsweep_after],
+
+ {ok, Node} = start_node(Config, ""),
+ RP = spawn_link(Node, fun process_info_smoke_all_tester/0),
+ LP = spawn_link(fun process_info_smoke_all_tester/0),
+ RP ! {other_process, LP},
+ LP ! {other_process, RP},
+ LP ! {other_process, self()},
+ LP ! ets:new(blapp, []),
+ LP ! ets:new(blipp, []),
+ LP ! list_to_binary(lists:duplicate(1000, 3)),
+ receive after 1000 -> ok end,
+ _MLP = erlang:monitor(process, LP),
+ true = is_process_alive(LP),
+ PI = process_info(LP, AllPIOptions),
+ io:format("~p~n", [PI]),
+ garbage_collect(),
+ unlink(RP),
+ unlink(LP),
+ exit(RP, kill),
+ exit(LP, kill),
+ false = is_process_alive(LP),
+ stop_node(Node),
+ ok.
+
+process_info_status_handled_signal(Config) when is_list(Config) ->
+ P = spawn_link(fun () ->
+ receive after infinity -> ok end
+ end),
+ wait_until(fun () ->
+ process_info(P, status) == {status, waiting}
+ end),
+ %%
+ %% The 'messages' option will force a process-info-request
+ %% signal to be scheduled on the process. Ensure that status
+ %% 'waiting' is reported even though it is actually running
+ %% when handling the request. We want it to report the status
+ %% it would have had if it had not been handling the
+ %% process-info-request...
+ %%
+ [{status, waiting}, {messages, []}] = process_info(P, [status, messages]),
+ unlink(P),
+ exit(P, kill),
+ false = erlang:is_process_alive(P),
+ ok.
+
%% Tests erlang:bump_reductions/1.
bump_reductions(Config) when is_list(Config) ->
erlang:garbage_collect(),
@@ -2107,36 +2217,44 @@ handle_event(Event, Pid) ->
processes_term_proc_list(Config) when is_list(Config) ->
Tester = self(),
- as_expected = processes_term_proc_list_test(false),
- {ok, Node} = start_node(Config, "+Mis true"),
- RT = spawn_link(Node, fun () ->
- receive after 1000 -> ok end,
- processes_term_proc_list_test(false),
- Tester ! {it_worked, self()}
- end),
- receive {it_worked, RT} -> ok end,
- stop_node(Node),
+
+ Run = fun(Args) ->
+ {ok, Node} = start_node(Config, Args),
+ RT = spawn_link(Node, fun () ->
+ receive after 1000 -> ok end,
+ as_expected = processes_term_proc_list_test(false),
+ Tester ! {it_worked, self()}
+ end),
+ receive {it_worked, RT} -> ok end,
+ stop_node(Node)
+ end,
+
+ %% We have to run this test case with +S1 since instrument:allocations()
+ %% will report a free()'d block as present until it's actually deallocated
+ %% by its employer.
+ Run("+MSe true +MSatags false +S1"),
+ Run("+MSe true +MSatags true +S1"),
+
ok.
-
+
-define(CHK_TERM_PROC_LIST(MC, XB),
chk_term_proc_list(?LINE, MC, XB)).
chk_term_proc_list(Line, MustChk, ExpectBlks) ->
- case {MustChk, instrument:memory_status(types)} of
- {false, false} ->
+ Allocs = instrument:allocations(#{ allocator_types => [sl_alloc] }),
+ case {MustChk, Allocs} of
+ {false, {error, not_enabled}} ->
not_enabled;
- {_, MS} ->
- {value,
- {ptab_list_deleted_el,
- DL}} = lists:keysearch(ptab_list_deleted_el, 1, MS),
- case lists:keysearch(blocks, 1, DL) of
- {value, {blocks, ExpectBlks, _, _}} ->
- ok;
- {value, {blocks, Blks, _, _}} ->
- exit({line, Line,
- mismatch, expected, ExpectBlks, actual, Blks});
- Unexpected ->
- exit(Unexpected)
+ {_, {ok, {_Shift, _Unscanned, ByOrigin}}} ->
+ ByType = maps:get(system, ByOrigin, #{}),
+ Hist = maps:get(ptab_list_deleted_el, ByType, {}),
+ case lists:sum(tuple_to_list(Hist)) of
+ ExpectBlks ->
+ ok;
+ Blks ->
+ exit({line, Line, mismatch,
+ expected, ExpectBlks,
+ actual, Blks})
end
end,
ok.
diff --git a/erts/emulator/test/tracer_SUITE.erl b/erts/emulator/test/tracer_SUITE.erl
index ab7d047bc3..e1362ef07a 100644
--- a/erts/emulator/test/tracer_SUITE.erl
+++ b/erts/emulator/test/tracer_SUITE.erl
@@ -30,7 +30,8 @@
-export([load/1, unload/1, reload/1, invalid_tracers/1]).
-export([send/1, recv/1, call/1, call_return/1, spawn/1, exit/1,
link/1, unlink/1, getting_linked/1, getting_unlinked/1,
- register/1, unregister/1, in/1, out/1, gc_start/1, gc_end/1]).
+ register/1, unregister/1, in/1, out/1, gc_start/1, gc_end/1,
+ seq_trace/1]).
suite() -> [{ct_hooks,[ts_install_cth]},
{timetrap, {minutes, 1}}].
@@ -41,7 +42,8 @@ all() ->
groups() ->
[{ basic, [], [send, recv, call, call_return, spawn, exit,
link, unlink, getting_linked, getting_unlinked,
- register, unregister, in, out, gc_start, gc_end]}].
+ register, unregister, in, out, gc_start, gc_end,
+ seq_trace]}].
init_per_suite(Config) ->
erlang:trace_pattern({'_','_','_'}, false, [local]),
@@ -583,6 +585,24 @@ gc_end(_Config) ->
test(gc_major_end, garbage_collection, Tc, Expect, false).
+seq_trace(_Config) ->
+
+ seq_trace:set_system_tracer({tracer_test,
+ {#{ seq_trace => trace }, self(), []}}),
+ erlang:spawn(fun() ->
+ seq_trace:set_token(label,17),
+ seq_trace:set_token(print,true),
+ seq_trace:print(17,"**** Trace Started ****")
+ end),
+ receive
+ {seq_trace, _, 17, {print, _, _, _, _}, _} ->
+ ok;
+ M ->
+ ct:fail("~p~n",[M])
+ after 100 ->
+ ct:fail(timeout)
+ end.
+
test(Event, Tc, Expect) ->
test(Event, Tc, Expect, false).
test(Event, Tc, Expect, Removes) ->
diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl
index ac3df8bfbf..103f9f1550 100644
--- a/erts/emulator/test/z_SUITE.erl
+++ b/erts/emulator/test/z_SUITE.erl
@@ -37,6 +37,7 @@
-export([schedulers_alive/1, node_container_refc_check/1,
long_timers/1, pollset_size/1,
check_io_debug/1, get_check_io_info/0,
+ lc_graph/1,
leaked_processes/1]).
suite() ->
@@ -46,6 +47,7 @@ suite() ->
all() ->
[schedulers_alive, node_container_refc_check,
long_timers, pollset_size, check_io_debug,
+ lc_graph,
%% Make sure that the leaked_processes/1 is always
%% run last.
leaked_processes].
@@ -289,6 +291,12 @@ has_gethost([P|T]) ->
has_gethost([]) ->
false.
+lc_graph(Config) when is_list(Config) ->
+ %% Create "lc_graph" file in current working dir
+ %% if lock checker is enabled
+ erts_debug:lc_graph(),
+ ok.
+
leaked_processes(Config) when is_list(Config) ->
%% Replace the defualt timetrap with a timetrap with
%% known pid.
diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c
index cf6d1bacca..21a3f40c97 100644
--- a/erts/etc/common/erlexec.c
+++ b/erts/etc/common/erlexec.c
@@ -79,6 +79,7 @@ static const char plusM_au_allocs[]= {
static char *plusM_au_alloc_switches[] = {
"as",
"asbcst",
+ "atags",
"acul",
"acnl",
"acfml",
diff --git a/erts/lib_src/Makefile.in b/erts/lib_src/Makefile.in
index 601f3917a8..48660f7c71 100644
--- a/erts/lib_src/Makefile.in
+++ b/erts/lib_src/Makefile.in
@@ -334,7 +334,10 @@ ETHREAD_LIB=
endif
+ifneq ($(CREATE_DIRS),)
_create_dirs := $(shell mkdir -p $(CREATE_DIRS))
+endif
+
#
# Everything to build
#
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index e93f053e01..3ef5ad0646 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam
index f5967780ad..d1bc4ecd2c 100644
--- a/erts/preloaded/ebin/erts_internal.beam
+++ b/erts/preloaded/ebin/erts_internal.beam
Binary files differ
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index bffa59338e..6fad5adde8 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -50,7 +50,7 @@
dist_ctrl_get_data_notification/1,
dist_get_stat/1]).
--deprecated([now/0]).
+-deprecated([get_stacktrace/0,now/0]).
%% Get rid of autoimports of spawn to avoid clashes with ourselves.
-compile({no_auto_import,[spawn_link/1]}).
@@ -3552,11 +3552,9 @@ max(A, _) -> A.
%%
-type memory_type() :: 'total' | 'processes' | 'processes_used' | 'system'
- | 'atom' | 'atom_used' | 'binary' | 'code' | 'ets'
- | 'low' | 'maximum'.
+ | 'atom' | 'atom_used' | 'binary' | 'code' | 'ets'.
-define(CARRIER_ALLOCS, [mseg_alloc]).
--define(LOW_ALLOCS, [ll_low_alloc, std_low_alloc]).
-define(ALL_NEEDED_ALLOCS, (erlang:system_info(alloc_util_allocators)
-- ?CARRIER_ALLOCS)).
@@ -3568,9 +3566,7 @@ max(A, _) -> A.
atom_used = 0,
binary = 0,
code = 0,
- ets = 0,
- low = 0,
- maximum = 0}).
+ ets = 0}).
-spec erlang:memory() -> [{Type, Size}] when
Type :: memory_type(),
@@ -3580,14 +3576,6 @@ memory() ->
notsup ->
erlang:error(notsup);
Mem ->
- InstrTail = case Mem#memory.maximum of
- 0 -> [];
- _ -> [{maximum, Mem#memory.maximum}]
- end,
- Tail = case Mem#memory.low of
- 0 -> InstrTail;
- _ -> [{low, Mem#memory.low} | InstrTail]
- end,
[{total, Mem#memory.total},
{processes, Mem#memory.processes},
{processes_used, Mem#memory.processes_used},
@@ -3596,7 +3584,7 @@ memory() ->
{atom_used, Mem#memory.atom_used},
{binary, Mem#memory.binary},
{code, Mem#memory.code},
- {ets, Mem#memory.ets} | Tail]
+ {ets, Mem#memory.ets}]
end.
-spec erlang:memory(Type :: memory_type()) -> non_neg_integer();
@@ -3684,16 +3672,6 @@ need_mem_info(binary) ->
{false, [binary_alloc], true, false};
need_mem_info(ets) ->
{true, [ets_alloc], true, false};
-need_mem_info(low) ->
- LowAllocs = ?LOW_ALLOCS -- ?CARRIER_ALLOCS,
- {_, _, FeatureList, _} = erlang:system_info(allocator),
- AlcUAllocs = case LowAllocs -- FeatureList of
- [] -> LowAllocs;
- _ -> []
- end,
- {false, AlcUAllocs, true, true};
-need_mem_info(maximum) ->
- {true, [], true, true};
need_mem_info(_) ->
{false, [], false, true}.
@@ -3706,8 +3684,6 @@ get_memval(atom_used, #memory{atom_used = V}) -> V;
get_memval(binary, #memory{binary = V}) -> V;
get_memval(code, #memory{code = V}) -> V;
get_memval(ets, #memory{ets = V}) -> V;
-get_memval(low, #memory{low = V}) -> V;
-get_memval(maximum, #memory{maximum = V}) -> V;
get_memval(_, #memory{}) -> 0.
memory_is_supported() ->
@@ -3762,16 +3738,6 @@ fix_proc([_ | Rest], Acc) ->
fix_proc([], Acc) ->
Acc.
-is_low_alloc(_A, []) ->
- false;
-is_low_alloc(A, [A|_As]) ->
- true;
-is_low_alloc(A, [_A|As]) ->
- is_low_alloc(A, As).
-
-is_low_alloc(A) ->
- is_low_alloc(A, ?LOW_ALLOCS).
-
au_mem_data(notsup, _) ->
notsup;
au_mem_data(_, [{_, false} | _]) ->
@@ -3824,16 +3790,11 @@ au_mem_data(#memory{total = Tot,
Rest)
end;
au_mem_data(#memory{total = Tot,
- system = Sys,
- low = Low} = Mem,
- [{A, _, Data} | Rest]) ->
+ system = Sys} = Mem,
+ [{_, _, Data} | Rest]) ->
Sz = blocks_size(Data, 0),
au_mem_data(Mem#memory{total = Tot+Sz,
- system = Sys+Sz,
- low = case is_low_alloc(A) of
- true -> Low+Sz;
- false -> Low
- end},
+ system = Sys+Sz},
Rest);
au_mem_data(EMD, []) ->
EMD.
@@ -3855,10 +3816,6 @@ receive_emd(Ref) ->
receive_emd(Ref, #memory{}, erlang:system_info(schedulers)).
aa_mem_data(#memory{} = Mem,
- [{maximum, Max} | Rest]) ->
- aa_mem_data(Mem#memory{maximum = Max},
- Rest);
-aa_mem_data(#memory{} = Mem,
[{total, Tot} | Rest]) ->
aa_mem_data(Mem#memory{total = Tot,
system = 0}, % system will be adjusted later
diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl
index da5c9c68ed..79169b7d23 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -80,6 +80,8 @@
-export([is_process_alive/1, is_process_alive/2]).
+-export([gather_alloc_histograms/1, gather_carrier_info/1]).
+
%%
%% Await result of send to port
%%
@@ -621,3 +623,24 @@ is_process_alive(Pid) ->
Res
end.
+-spec gather_alloc_histograms({Type, SchedId, HistWidth, HistStart, Ref}) -> MsgCount when
+ Type :: atom(),
+ SchedId :: non_neg_integer(),
+ HistWidth :: non_neg_integer(),
+ HistStart :: non_neg_integer(),
+ Ref :: reference(),
+ MsgCount :: non_neg_integer().
+
+gather_alloc_histograms(_) ->
+ erlang:nif_error(undef).
+
+-spec gather_carrier_info({Type, SchedId, HistWidth, HistStart, Ref}) -> MsgCount when
+ Type :: atom(),
+ SchedId :: non_neg_integer(),
+ HistWidth :: non_neg_integer(),
+ HistStart :: non_neg_integer(),
+ Ref :: reference(),
+ MsgCount :: non_neg_integer().
+
+gather_carrier_info(_) ->
+ erlang:nif_error(undef).
diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl
index 81a2735a0d..e9e9f6eb42 100644
--- a/lib/asn1/src/asn1ct.erl
+++ b/lib/asn1/src/asn1ct.erl
@@ -292,8 +292,7 @@ run_passes_1([{pass,Name,Pass}|Passes], #st{run=Run}=St0)
done ->
ok
catch
- Class:Error ->
- Stk = erlang:get_stacktrace(),
+ Class:Error:Stk ->
io:format("Internal error: ~p:~p\n~p\n",
[Class,Error,Stk]),
{error,{internal_error,{Class,Error}}}
@@ -2390,13 +2389,13 @@ in_process(Fun) ->
receive
{Pid, Result} -> Result;
{Pid, Class, Reason, Stack} ->
- ST = try throw(x) catch throw:x -> erlang:get_stacktrace() end,
+ ST = try throw(x) catch throw:x:Stk -> Stk end,
erlang:raise(Class, Reason, Stack ++ ST)
end.
process(Parent, Fun) ->
try
Parent ! {self(), Fun()}
- catch Class:Reason ->
- Parent ! {self(), Class, Reason, erlang:get_stacktrace()}
+ catch Class:Reason:Stack ->
+ Parent ! {self(), Class, Reason, Stack}
end.
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl
index efbc6d6380..ee039dfbab 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -815,8 +815,7 @@ result_line_1(Items) ->
try_catch() ->
[" catch",nl,
- " Class:Exception when Class =:= error; Class =:= exit ->",nl,
- " Stk = erlang:get_stacktrace(),",nl,
+ " Class:Exception:Stk when Class =:= error; Class =:= exit ->",nl,
" case Exception of",nl,
" {error,{asn1,Reason}} ->",nl,
" {error,{asn1,{Reason,Stk}}};",nl,
diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl
index bfeffa969f..8cf6745103 100644
--- a/lib/asn1/test/asn1_SUITE.erl
+++ b/lib/asn1/test/asn1_SUITE.erl
@@ -227,10 +227,9 @@ test(Config, TestF, Rules) ->
try
TestF(C, R, O)
catch
- Class:Reason ->
+ Class:Reason:Stk ->
NewReason = {Reason, [{rule, R}, {options, O}]},
- erlang:raise(Class, NewReason,
- erlang:get_stacktrace())
+ erlang:raise(Class, NewReason, Stk)
end
end,
Result = [run_case(Config, Fun, rule(Rule), opts(Rule)) || Rule <- Rules],
diff --git a/lib/asn1/test/testUniqueObjectSets.erl b/lib/asn1/test/testUniqueObjectSets.erl
index cabdb44a0c..c75a673c4b 100644
--- a/lib/asn1/test/testUniqueObjectSets.erl
+++ b/lib/asn1/test/testUniqueObjectSets.erl
@@ -30,8 +30,7 @@ seq_roundtrip(I, D0) ->
asn1_test_lib:map_roundtrip(M, 'Seq', Enc),
{ok,{'Seq',I,D}} = M:decode('Seq', Enc),
D
- catch C:E ->
- Stk = erlang:get_stacktrace(),
+ catch C:E:Stk ->
io:format("FAILED: ~p ~p\n", [I,D0]),
erlang:raise(C, E, Stk)
end.
diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml
index 06afc55c07..e4491288a6 100644
--- a/lib/compiler/doc/src/compile.xml
+++ b/lib/compiler/doc/src/compile.xml
@@ -649,14 +649,6 @@ module.beam: module.erl \
<p>Turns off warnings for unused record types. Default is to
emit warnings for unused locally defined record types.</p>
</item>
-
- <tag><c>nowarn_get_stacktrace</c></tag>
- <item>
- <p>Turns off warnings for using <c>get_stacktrace/0</c> in a context
- where it will probably not work in a future release. For example,
- by default there will be a warning if <c>get_stacktrace/0</c> is
- used following a <c>catch</c> expression.</p>
- </item>
</taglist>
<p>Another class of warnings is generated by the compiler
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index 9e96147787..c81b81e82b 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -186,7 +186,6 @@ release_docs_spec:
$(EBIN)/beam_disasm.beam: $(EGEN)/beam_opcodes.hrl beam_disasm.hrl
$(EBIN)/beam_listing.beam: core_parse.hrl v3_kernel.hrl
-$(EBIN)/beam_validator.beam: beam_disasm.hrl
$(EBIN)/cerl.beam: core_parse.hrl
$(EBIN)/compile.beam: core_parse.hrl ../../stdlib/include/erl_compile.hrl
$(EBIN)/core_lib.beam: core_parse.hrl
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index ee0011d397..d5aef51dfa 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -27,8 +27,6 @@
%% Interface for compiler.
-export([module/2, format_error/1]).
--include("beam_disasm.hrl").
-
-import(lists, [any/2,dropwhile/2,foldl/3,foreach/2,reverse/1]).
%% To be called by the compiler.
@@ -569,7 +567,7 @@ valfun_4({loop_rec,{f,Fail},Dst}, Vst0) ->
Vst = branch_state(Fail, Vst0),
%% This term may not be part of the root set until
%% remove_message/0 is executed. If control transfers
- %% to the loop_rec_end/1 instruction, no part of this
+ %% to the loop_rec_end/1 instruction, no part of
%% this term must be stored in a Y register.
set_type_reg({fragile,term}, Dst, Vst);
valfun_4({wait,_}, Vst) ->
@@ -618,6 +616,7 @@ valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) ->
%% is OK as input.
CtxType = get_move_term_type(Ctx, Vst0),
verify_live(Live, Vst0),
+ verify_y_init(Vst0),
Vst1 = prune_x_regs(Live, Vst0),
BranchVst = case CtxType of
#ms{} ->
@@ -634,6 +633,7 @@ valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) ->
valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst0) ->
assert_term(Src, Vst0),
verify_live(Live, Vst0),
+ verify_y_init(Vst0),
Vst1 = prune_x_regs(Live, Vst0),
Vst = branch_state(Fail, Vst1),
set_type_reg(bsm_match_state(Slots), Src, Dst, Vst);
@@ -836,6 +836,7 @@ verify_put_map(Fail, Src, Dst, Live, List, Vst0) ->
validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst0) ->
bsm_validate_context(Ctx, Vst0),
verify_live(Live, Vst0),
+ verify_y_init(Vst0),
Vst1 = prune_x_regs(Live, Vst0),
Vst = branch_state(Fail, Vst1),
set_type_reg(Type, Dst, Vst).
@@ -845,6 +846,7 @@ validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst0) ->
%%
validate_bs_skip_utf(Fail, Ctx, Live, Vst0) ->
bsm_validate_context(Ctx, Vst0),
+ verify_y_init(Vst0),
verify_live(Live, Vst0),
Vst = prune_x_regs(Live, Vst0),
branch_state(Fail, Vst).
diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl
index 6e2114be56..6ded8fe78f 100644
--- a/lib/compiler/src/core_lint.erl
+++ b/lib/compiler/src/core_lint.erl
@@ -491,8 +491,10 @@ pattern(#c_tuple{es=Es}, Def, Ps, St) ->
pattern_list(Es, Def, Ps, St);
pattern(#c_map{es=Es}, Def, Ps, St) ->
pattern_list(Es, Def, Ps, St);
-pattern(#c_map_pair{op=#c_literal{val=exact},key=K,val=V},Def,Ps,St) ->
- pattern_list([K,V],Def,Ps,St);
+pattern(#c_map_pair{op=#c_literal{val=exact},key=K,val=V}, Def, Ps, St) ->
+ %% The key is an input.
+ pat_map_expr(K, Def, St),
+ pattern_list([V],Def,Ps,St);
pattern(#c_binary{segments=Ss}, Def, Ps, St0) ->
St = pat_bin_tail_check(Ss, St0),
pat_bin(Ss, Def, Ps, St);
@@ -555,6 +557,10 @@ pat_bit_expr(#c_binary{}, _, _Def, St) ->
pat_bit_expr(_, _, _, St) ->
add_error({illegal_expr,St#lint.func}, St).
+pat_map_expr(#c_var{name=N}, Def, St) -> expr_var(N, Def, St);
+pat_map_expr(#c_literal{}, _Def, St) -> St;
+pat_map_expr(_, _, St) -> add_error({illegal_expr,St#lint.func}, St).
+
%% pattern_list([Var], Defined, State) -> {[PatVar],State}.
%% pattern_list([Var], Defined, [PatVar], State) -> {[PatVar],State}.
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index eee5bc733f..a1de8961bd 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -1111,10 +1111,30 @@ remove_compiler_gen(M) ->
remove_compiler_gen_1(Pair) ->
Op0 = cerl:map_pair_op(Pair),
Op = cerl:set_ann(Op0, []),
- K = cerl:map_pair_key(Pair),
- V = cerl:map_pair_val(Pair),
+ K = map_var(cerl:map_pair_key(Pair)),
+ V = map_var(cerl:map_pair_val(Pair)),
cerl:update_c_map_pair(Pair, Op, K, V).
+map_var(Var) ->
+ case cerl:is_c_var(Var) of
+ true ->
+ case cerl:var_name(Var) of
+ Name when is_atom(Name) ->
+ L = atom_to_list(Name),
+ try list_to_integer(L) of
+ Int ->
+ cerl:update_c_var(Var, Int)
+ catch
+ error:_ ->
+ Var
+ end;
+ _ ->
+ Var
+ end;
+ false ->
+ Var
+ end.
+
%% Compile to Beam assembly language (.S) and then try to
%% run .S through the compiler again.
diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl
index f15917e3cb..3146c31c21 100644
--- a/lib/compiler/test/map_SUITE.erl
+++ b/lib/compiler/test/map_SUITE.erl
@@ -67,8 +67,10 @@
%% errors in 18
t_register_corruption/1,
- t_bad_update/1
+ t_bad_update/1,
+ %% new in OTP 21
+ t_reused_key_variable/1
]).
suite() -> [].
@@ -120,7 +122,10 @@ all() ->
%% errors in 18
t_register_corruption,
- t_bad_update
+ t_bad_update,
+
+ %% new in OTP 21
+ t_reused_key_variable
].
groups() -> [].
@@ -1980,6 +1985,16 @@ properly(Item) ->
increase(Allows) ->
catch fun() -> Allows end#{[] => +Allows, "warranty" => fun id/1}.
+t_reused_key_variable(Config) when is_list(Config) ->
+ Key = id(key),
+ Map1 = id(#{Key=>Config}),
+ Map2 = id(#{Key=>Config}),
+ case {Map1,Map2} of
+ %% core_lint treated Key as pattern variables, not input variables,
+ %% and complained about the variable being duplicated.
+ {#{Key:=Same},#{Key:=Same}} ->
+ ok
+ end.
%% aux
diff --git a/lib/erl_docgen/priv/dtd/common.image.dtd b/lib/erl_docgen/priv/dtd/common.image.dtd
index d97057590e..138da3609b 100644
--- a/lib/erl_docgen/priv/dtd/common.image.dtd
+++ b/lib/erl_docgen/priv/dtd/common.image.dtd
@@ -18,5 +18,7 @@
$Id$
-->
<!ELEMENT image (icaption) >
-<!ATTLIST image file CDATA #REQUIRED >
+<!ATTLIST image
+ file CDATA #REQUIRED
+ width CDATA #IMPLIED >
<!ELEMENT icaption (#PCDATA) >
diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl
index b6ebcc0c67..a0a922216b 100644
--- a/lib/erl_docgen/priv/xsl/db_html.xsl
+++ b/lib/erl_docgen/priv/xsl/db_html.xsl
@@ -3,7 +3,7 @@
#
# %CopyrightBegin%
#
- # Copyright Ericsson AB 2009-2017. All Rights Reserved.
+ # Copyright Ericsson AB 2009-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.
@@ -69,7 +69,7 @@
<func:function name="erl:to-link">
<xsl:param name="text"/>
- <func:result select="translate(erl:lower-case($text),': /()&quot;&#10;','-------')"/>
+ <func:result select="translate(erl:lower-case($text),'?: /()&quot;&#10;','--------')"/>
</func:function>
<!-- Used from template menu.funcs to sort a module's functions for the lefthand index list,
@@ -1264,7 +1264,14 @@
</xsl:variable>
<div class="doc-image-wrapper">
- <img alt="IMAGE MISSING" src="{@file}" class="doc-image"/>
+ <xsl:choose>
+ <xsl:when test="@width">
+ <img alt="IMAGE MISSING" width="{@width}" src="{@file}" class="doc-image"/>
+ </xsl:when>
+ <xsl:otherwise>
+ <img alt="IMAGE MISSING" src="{@file}" class="doc-image"/>
+ </xsl:otherwise>
+ </xsl:choose>
<xsl:apply-templates>
<xsl:with-param name="chapnum" select="$chapnum"/>
diff --git a/lib/erl_docgen/priv/xsl/db_pdf.xsl b/lib/erl_docgen/priv/xsl/db_pdf.xsl
index 05fc79ed71..1b91d768e3 100644
--- a/lib/erl_docgen/priv/xsl/db_pdf.xsl
+++ b/lib/erl_docgen/priv/xsl/db_pdf.xsl
@@ -3,7 +3,7 @@
#
# %CopyrightBegin%
#
- # Copyright Ericsson AB 2009-2016. All Rights Reserved.
+ # Copyright Ericsson AB 2009-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.
@@ -1656,8 +1656,14 @@
</xsl:variable>
<fo:block xsl:use-attribute-sets="image">
- <fo:external-graphic content-width="scale-down-to-fit" inline-progression-dimension.maximum="100%" src="{@file}"/>
-
+ <xsl:choose>
+ <xsl:when test="@width">
+ <fo:external-graphic content-width="scale-to-fit" width="{@width}" inline-progression-dimension.maximum="100%" src="{@file}"/>
+ </xsl:when>
+ <xsl:otherwise>
+ <fo:external-graphic content-width="scale-down-to-fit" inline-progression-dimension.maximum="100%" src="{@file}"/>
+ </xsl:otherwise>
+ </xsl:choose>
<xsl:apply-templates>
<xsl:with-param name="chapnum" select="$chapnum"/>
<xsl:with-param name="fignum" select="$fignum"/>
diff --git a/lib/erl_docgen/priv/xsl/db_pdf_params.xsl b/lib/erl_docgen/priv/xsl/db_pdf_params.xsl
index 99da29c2ac..9bfa991b54 100644
--- a/lib/erl_docgen/priv/xsl/db_pdf_params.xsl
+++ b/lib/erl_docgen/priv/xsl/db_pdf_params.xsl
@@ -3,7 +3,7 @@
#
# %CopyrightBegin%
#
- # Copyright Ericsson AB 2009-2017. All Rights Reserved.
+ # Copyright Ericsson AB 2009-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.
@@ -139,6 +139,7 @@
<xsl:attribute-set name="image">
<xsl:attribute name="space-after">0.5em</xsl:attribute>
<xsl:attribute name="space-before">0.5em</xsl:attribute>
+ <xsl:attribute name="text-align">center</xsl:attribute>
</xsl:attribute-set>
<xsl:attribute-set name="listblock">
diff --git a/lib/erl_interface/configure.in b/lib/erl_interface/configure.in
index 0a8fbf513c..696ebf5ca0 100644
--- a/lib/erl_interface/configure.in
+++ b/lib/erl_interface/configure.in
@@ -106,6 +106,19 @@ if test $ac_cv_sizeof_long = 8; then
CFLAGS="$CFLAGS -DEI_64BIT"
fi
+LM_HARDWARE_ARCH
+
+AC_MSG_CHECKING(for unaligned word access)
+case "$ARCH" in
+ x86|amd64)
+ AC_MSG_RESULT(yes: x86 or amd64)
+ AC_DEFINE(HAVE_UNALIGNED_WORD_ACCESS, 1, [Define if hw supports unaligned word access])
+ ;;
+ *)
+ AC_MSG_RESULT(no)
+ ;;
+esac
+
AC_CHECK_TOOL(AR, ar, false)
if test "$AR" = false; then
AC_MSG_ERROR([No 'ar' command found in PATH])
diff --git a/lib/erl_interface/doc/src/notes.xml b/lib/erl_interface/doc/src/notes.xml
index 641a3de13f..f165dde259 100644
--- a/lib/erl_interface/doc/src/notes.xml
+++ b/lib/erl_interface/doc/src/notes.xml
@@ -31,6 +31,29 @@
</header>
<p>This document describes the changes made to the Erl_interface application.</p>
+<section><title>Erl_Interface 3.10.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix bug in <c>ei_connect</c> functions that may cause
+ failure due to insufficient buffer space for
+ gethostbyname_r.</p>
+ <p>
+ Own Id: OTP-15022 Aux Id: ERIERL-163 </p>
+ </item>
+ <item>
+ <p>
+ Optimize encoding/decoding for pure 7-bit ascii atoms.</p>
+ <p>
+ Own Id: OTP-15023 Aux Id: ERIERL-150 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Erl_Interface 3.10.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c
index ea9ecb31d5..5c01223e3d 100644
--- a/lib/erl_interface/src/connect/ei_connect.c
+++ b/lib/erl_interface/src/connect/ei_connect.c
@@ -583,6 +583,54 @@ static int cnct(uint16 port, struct in_addr *ip_addr, int addr_len, unsigned ms)
return s;
} /* cnct */
+
+/*
+ * Same as ei_gethostbyname_r, but also handles ERANGE error
+ * and may allocate larger buffer with malloc.
+ */
+static
+struct hostent *dyn_gethostbyname_r(const char *name,
+ struct hostent *hostp,
+ char **buffer_p,
+ int buflen,
+ int *h_errnop)
+{
+ char* buf = *buffer_p;
+ struct hostent *hp;
+
+ while (1) {
+ hp = ei_gethostbyname_r(name, hostp, buf, buflen, h_errnop);
+ if (hp) {
+ *buffer_p = buf;
+ break;
+ }
+
+ if (*h_errnop != ERANGE) {
+ if (buf != *buffer_p)
+ free(buf);
+ break;
+ }
+
+ buflen *= 2;
+ if (buf == *buffer_p)
+ buf = malloc(buflen);
+ else {
+ char* buf2 = realloc(buf, buflen);
+ if (buf2)
+ buf = buf2;
+ else {
+ free(buf);
+ buf = NULL;
+ }
+ }
+ if (!buf) {
+ *h_errnop = ENOMEM;
+ break;
+ }
+ }
+ return hp;
+}
+
/*
* Set up a connection to a given Node, and
* interchange hand shake messages with it.
@@ -597,8 +645,10 @@ int ei_connect_tmo(ei_cnode* ec, char *nodename, unsigned ms)
/* these are needed for the call to gethostbyname_r */
struct hostent host;
char buffer[1024];
+ char *buf = buffer;
int ei_h_errno;
#endif /* !win32 */
+ int res;
/* extract the host and alive parts from nodename */
if (!(hostname = strchr(nodename,'@'))) {
@@ -611,7 +661,7 @@ int ei_connect_tmo(ei_cnode* ec, char *nodename, unsigned ms)
}
#ifndef __WIN32__
- hp = ei_gethostbyname_r(hostname,&host,buffer,1024,&ei_h_errno);
+ hp = dyn_gethostbyname_r(hostname,&host,&buf,sizeof(buffer),&ei_h_errno);
if (hp == NULL) {
char thishostname[EI_MAXHOSTNAMELEN+1];
/* gethostname requies len to be max(hostname) + 1*/
@@ -627,7 +677,7 @@ int ei_connect_tmo(ei_cnode* ec, char *nodename, unsigned ms)
}
if (strcmp(hostname,thishostname) == 0)
/* Both nodes on same standalone host, use loopback */
- hp = ei_gethostbyname_r("localhost",&host,buffer,1024,&ei_h_errno);
+ hp = dyn_gethostbyname_r("localhost",&host,&buf,sizeof(buffer),&ei_h_errno);
if (hp == NULL) {
EI_TRACE_ERR2("ei_connect",
"Can't find host for %s: %d\n",nodename,ei_h_errno);
@@ -663,7 +713,14 @@ int ei_connect_tmo(ei_cnode* ec, char *nodename, unsigned ms)
}
}
#endif /* win32 */
- return ei_xconnect_tmo(ec, (Erl_IpAddr) *hp->h_addr_list, alivename, ms);
+
+ res = ei_xconnect_tmo(ec, (Erl_IpAddr) *hp->h_addr_list, alivename, ms);
+
+#ifndef __WIN32__
+ if (buf != buffer)
+ free(buf);
+#endif
+ return res;
} /* ei_connect */
int ei_connect(ei_cnode* ec, char *nodename)
diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c
index fd0c659373..2757735d39 100644
--- a/lib/erl_interface/src/connect/ei_resolve.c
+++ b/lib/erl_interface/src/connect/ei_resolve.c
@@ -645,8 +645,11 @@ struct hostent *ei_gethostbyname_r(const char *name,
#else
#if (defined(__GLIBC__) || defined(__linux__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__) || defined(__ANDROID__))
struct hostent *result;
+ int err;
- gethostbyname_r(name, hostp, buffer, buflen, &result, h_errnop);
+ err = gethostbyname_r(name, hostp, buffer, buflen, &result, h_errnop);
+ if (err == ERANGE)
+ *h_errnop = err;
return result;
#else
diff --git a/lib/erl_interface/src/decode/decode_atom.c b/lib/erl_interface/src/decode/decode_atom.c
index b3bba82434..87cd75b1be 100644
--- a/lib/erl_interface/src/decode/decode_atom.c
+++ b/lib/erl_interface/src/decode/decode_atom.c
@@ -92,6 +92,51 @@ int ei_decode_atom_as(const char *buf, int *index, char* p, int destlen,
}
+
+#ifdef HAVE_UNALIGNED_WORD_ACCESS
+
+#if SIZEOF_VOID_P == SIZEOF_LONG
+typedef unsigned long AsciiWord;
+#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG
+typedef unsigned long long AsciiWord;
+#else
+# error "Uknown word type"
+#endif
+
+#if SIZEOF_VOID_P == 4
+# define ASCII_CHECK_MASK ((AsciiWord)0x80808080U)
+#elif SIZEOF_VOID_P == 8
+# define ASCII_CHECK_MASK ((AsciiWord)0x8080808080808080U)
+#endif
+
+static int ascii_fast_track(char* dst, const char* src, int slen, int destlen)
+{
+ const AsciiWord* src_word = (AsciiWord*) src;
+ const AsciiWord* const src_word_end = src_word + (slen / sizeof(AsciiWord));
+
+ if (destlen < slen)
+ return 0;
+
+ if (dst) {
+ AsciiWord* dst_word = (AsciiWord*)dst;
+
+ while (src_word < src_word_end) {
+ if ((*src_word & ASCII_CHECK_MASK) != 0)
+ break;
+ *dst_word++ = *src_word++;
+ }
+ }
+ else {
+ while (src_word < src_word_end) {
+ if ((*src_word & ASCII_CHECK_MASK) != 0)
+ break;
+ src_word++;
+ }
+ }
+ return (char*)src_word - src;
+}
+#endif /* HAVE_UNALIGNED_WORD_ACCESS */
+
int utf8_to_latin1(char* dst, const char* src, int slen, int destlen,
erlang_char_encoding* res_encp)
{
@@ -99,6 +144,15 @@ int utf8_to_latin1(char* dst, const char* src, int slen, int destlen,
const char* const dst_end = dst + destlen;
int found_non_ascii = 0;
+#ifdef HAVE_UNALIGNED_WORD_ACCESS
+ {
+ int aft = ascii_fast_track(dst, src, slen, destlen);
+ src += aft;
+ slen -= aft;
+ dst += aft;
+ }
+#endif
+
while (slen > 0) {
if (dst >= dst_end) return -1;
if ((src[0] & 0x80) == 0) {
@@ -136,6 +190,14 @@ int latin1_to_utf8(char* dst, const char* src, int slen, int destlen,
const char* const dst_end = dst + destlen;
int found_non_ascii = 0;
+#ifdef HAVE_UNALIGNED_WORD_ACCESS
+ {
+ int aft = ascii_fast_track(dst, src, slen, destlen);
+ dst += aft;
+ src += aft;
+ }
+#endif
+
while (src < src_end) {
if (dst >= dst_end) return -1;
if ((src[0] & 0x80) == 0) {
diff --git a/lib/erl_interface/src/legacy/erl_marshal.c b/lib/erl_interface/src/legacy/erl_marshal.c
index caa171858d..6435754823 100644
--- a/lib/erl_interface/src/legacy/erl_marshal.c
+++ b/lib/erl_interface/src/legacy/erl_marshal.c
@@ -107,7 +107,7 @@ static int init_cmp_num_class_p=1; /* initialize array, the first time */
void erl_init_marshal(void)
{
if (init_cmp_array_p) {
- memset(cmp_array, 0, CMP_ARRAY_SIZE);
+ memset(cmp_array, 0, sizeof cmp_array);
cmp_array[ERL_SMALL_INTEGER_EXT] = ERL_NUM_CMP;
cmp_array[ERL_INTEGER_EXT] = ERL_NUM_CMP;
cmp_array[ERL_FLOAT_EXT] = ERL_NUM_CMP;
diff --git a/lib/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk
index d76d110afd..8b6e91757d 100644
--- a/lib/erl_interface/vsn.mk
+++ b/lib/erl_interface/vsn.mk
@@ -1,2 +1,2 @@
-EI_VSN = 3.10.1
+EI_VSN = 3.10.2
ERL_INTERFACE_VSN = $(EI_VSN)
diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl
index acb9b7b062..97814fe217 100644
--- a/lib/hipe/main/hipe.erl
+++ b/lib/hipe/main/hipe.erl
@@ -669,8 +669,8 @@ run_compiler_1(Name, DisasmFun, IcodeFun, Options) ->
{Icode, WholeModule} = IcodeFun(Code, Opts),
CompRes = compile_finish(Icode, WholeModule, Opts),
compiler_return(CompRes, Parent)
- catch error:Error ->
- print_crash_message(Name, Error),
+ catch error:Error:StackTrace ->
+ print_crash_message(Name, Error, StackTrace),
exit(Error)
end
end),
@@ -757,8 +757,8 @@ finalize(OrigList, Mod, Exports, WholeModule, Opts) ->
TargetArch = get(hipe_target_arch),
{ok, {TargetArch,Bin}}
catch
- error:Error ->
- {error,Error,erlang:get_stacktrace()}
+ error:Error:StackTrace ->
+ {error,Error,StackTrace}
end
end.
@@ -843,16 +843,16 @@ finalize_fun_sequential({MFA, Icode}, Opts, Servers) ->
{llvm_binary, Binary} ->
{MFA, Binary}
catch
- error:Error ->
+ error:Error:StackTrace ->
?when_option(verbose, Opts, ?debug_untagged_msg("\n", [])),
- print_crash_message(MFA, Error),
+ print_crash_message(MFA, Error, StackTrace),
exit(Error)
end.
-print_crash_message(What, Error) ->
+print_crash_message(What, Error, StackTrace) ->
StackFun = fun(_,_,_) -> false end,
FormatFun = fun (Term, _) -> io_lib:format("~p", [Term]) end,
- StackTrace = lib:format_stacktrace(1, erlang:get_stacktrace(),
+ StackTrace = lib:format_stacktrace(1, StackTrace,
StackFun, FormatFun),
WhatS = case What of
{M,F,A} -> io_lib:format("~w:~w/~w", [M,F,A]);
diff --git a/lib/ic/c_src/oe_ei_encode_atom.c b/lib/ic/c_src/oe_ei_encode_atom.c
index 758586d1d4..99a9fe26f0 100644
--- a/lib/ic/c_src/oe_ei_encode_atom.c
+++ b/lib/ic/c_src/oe_ei_encode_atom.c
@@ -20,28 +20,37 @@
*/
#include <ic.h>
+#include <string.h>
+
+
+#define DIRTY_ATOM_ENC_MAX(LATIN1_CHARS) ((LATIN1_CHARS)*2 + 3)
+
int oe_ei_encode_atom(CORBA_Environment *ev, const char *p) {
int size = ev->_iout;
+ size_t len = strlen(p);
+
+ if (DIRTY_ATOM_ENC_MAX(len) >= ev->_outbufsz) {
+
+ ei_encode_atom_len(0,&size,p,len);
+
+ if (size >= ev->_outbufsz) {
+ char *buf = ev->_outbuf;
+ int bufsz = ev->_outbufsz + ev->_memchunk;
+
+ while (size >= bufsz)
+ bufsz += ev->_memchunk;
+
+ if ((buf = realloc(buf, bufsz)) == NULL) {
+ CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
+ return -1; /* OUT OF MEMORY */
+ }
- ei_encode_atom(0,&size,p);
-
- if (size >= ev->_outbufsz) {
- char *buf = ev->_outbuf;
- int bufsz = ev->_outbufsz + ev->_memchunk;
-
- while (size >= bufsz)
- bufsz += ev->_memchunk;
-
- if ((buf = realloc(buf, bufsz)) == NULL) {
- CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding");
- return -1; /* OUT OF MEMORY */
- }
-
- ev->_outbuf = buf;
- ev->_outbufsz = bufsz;
+ ev->_outbuf = buf;
+ ev->_outbufsz = bufsz;
+ }
}
- return ei_encode_atom(ev->_outbuf,&ev->_iout,p);
+ return ei_encode_atom_len(ev->_outbuf,&ev->_iout,p,len);
}
diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml
index fc68ec386c..38cc77ca98 100644
--- a/lib/ic/doc/src/notes.xml
+++ b/lib/ic/doc/src/notes.xml
@@ -31,7 +31,22 @@
<file>notes.xml</file>
</header>
- <section><title>IC 4.4.3</title>
+ <section><title>IC 4.4.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Optimize encoding/decoding for pure 7-bit ascii atoms.</p>
+ <p>
+ Own Id: OTP-15023 Aux Id: ERIERL-150 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>IC 4.4.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk
index b9f1ef7f20..d35d1dce1e 100644
--- a/lib/ic/vsn.mk
+++ b/lib/ic/vsn.mk
@@ -1 +1 @@
-IC_VSN = 4.4.3
+IC_VSN = 4.4.4
diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml
index ffc6fec518..521ad6a015 100644
--- a/lib/inets/doc/src/httpc.xml
+++ b/lib/inets/doc/src/httpc.xml
@@ -441,17 +441,22 @@
<tag><c><![CDATA[socket_opts]]></c></tag>
<item>
- <p>Socket options to be used for this and subsequent
- requests.</p>
+ <p>Socket options to be used for this request.</p>
<p>Overrides any value set by function
<seealso marker="#set_options-1">set_options</seealso>.</p>
<p>The validity of the options is <em>not</em> checked by
the HTTP client they are assumed to be correct and passed
on to ssl application and inet driver, which may reject
- them if they are not correct. Note that the current
- implementation assumes the requests to the same host, port
- combination will use the same socket options.
+ them if they are not correct.
</p>
+ <note>
+ <p>
+ Persistent connections are not supported when setting the
+ <c>socket_opts</c> option. When <c>socket_opts</c> is not
+ set the current implementation assumes the requests to the
+ same host, port combination will use the same socket options.
+ </p>
+ </note>
<p>By default the socket options set by function
<seealso marker="#set_options-1">set_options/[1,2]</seealso>
@@ -624,8 +629,11 @@
to complete. The HTTP/1.1 specification suggests a
limit of two persistent connections per server, which is the
default value of option <c>max_sessions</c>.</p>
+ <p>
+ The current implementation assumes the requests to the same host, port
+ combination will use the same socket options.
+ </p>
</note>
-
<marker id="get_options"></marker>
</desc>
</func>
diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml
index ca37a54691..10dd26322c 100644
--- a/lib/inets/doc/src/notes.xml
+++ b/lib/inets/doc/src/notes.xml
@@ -33,7 +33,22 @@
<file>notes.xml</file>
</header>
- <section><title>Inets 6.5</title>
+ <section><title>Inets 6.5.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix broken options handling in httpc (ERL-441).</p>
+ <p>
+ Own Id: OTP-15007</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Inets 6.5</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl
index 7b8d7875de..c3404dbb37 100644
--- a/lib/inets/src/http_client/httpc_manager.erl
+++ b/lib/inets/src/http_client/httpc_manager.erl
@@ -750,8 +750,26 @@ handle_request(#request{settings =
start_handler(NewRequest#request{headers = NewHeaders}, State),
{reply, {ok, NewRequest#request.id}, State};
-handle_request(Request, State = #state{options = Options}) ->
+%% Simple socket options handling (ERL-441).
+%%
+%% TODO: Refactor httpc to enable sending socket options in requests
+%% using persistent connections. This workaround opens a new
+%% connection for each request with non-empty socket_opts.
+handle_request(Request0 = #request{socket_opts = SocketOpts},
+ State0 = #state{options = Options0})
+ when is_list(SocketOpts) andalso length(SocketOpts) > 0 ->
+ Request = handle_cookies(generate_request_id(Request0), State0),
+ Options = convert_options(SocketOpts, Options0),
+ State = State0#state{options = Options},
+ Headers =
+ (Request#request.headers)#http_request_h{connection
+ = "close"},
+ %% Reset socket_opts to avoid setopts failure.
+ start_handler(Request#request{headers = Headers, socket_opts = []}, State),
+ %% Do not change the state
+ {reply, {ok, Request#request.id}, State0};
+handle_request(Request, State = #state{options = Options}) ->
NewRequest = handle_cookies(generate_request_id(Request), State),
SessionType = session_type(Options),
case select_session(Request#request.method,
@@ -775,6 +793,18 @@ handle_request(Request, State = #state{options = Options}) ->
{reply, {ok, NewRequest#request.id}, State}.
+%% Convert Request options to State options
+convert_options([], Options) ->
+ Options;
+convert_options([{ipfamily, Value}|T], Options) ->
+ convert_options(T, Options#options{ipfamily = Value});
+convert_options([{ip, Value}|T], Options) ->
+ convert_options(T, Options#options{ip = Value});
+convert_options([{port, Value}|T], Options) ->
+ convert_options(T, Options#options{port = Value});
+convert_options([Option|T], Options = #options{socket_opts = SocketOpts}) ->
+ convert_options(T, Options#options{socket_opts = SocketOpts ++ [Option]}).
+
start_handler(#request{id = Id,
from = From} = Request,
#state{profile_name = ProfileName,
diff --git a/lib/inets/src/http_client/httpc_request.erl b/lib/inets/src/http_client/httpc_request.erl
index 89872a3831..641b6559de 100644
--- a/lib/inets/src/http_client/httpc_request.erl
+++ b/lib/inets/src/http_client/httpc_request.erl
@@ -190,35 +190,11 @@ is_client_closing(Headers) ->
%%%========================================================================
post_data(Method, Headers, {ContentType, Body}, HeadersAsIs)
when (Method =:= post)
- orelse (Method =:= put)
- orelse (Method =:= patch)
- orelse (Method =:= delete) ->
-
- NewBody = case Headers#http_request_h.expect of
- "100-continue" ->
- "";
- _ ->
- Body
- end,
-
- NewHeaders = case HeadersAsIs of
- [] ->
- Headers#http_request_h{
- 'content-type' = ContentType,
- 'content-length' = case body_length(Body) of
- undefined ->
- % on upload streaming the caller must give a
- % value to the Content-Length header
- % (or use chunked Transfer-Encoding)
- Headers#http_request_h.'content-length';
- Len when is_list(Len) ->
- Len
- end
- };
- _ ->
- HeadersAsIs
- end,
-
+ orelse (Method =:= put)
+ orelse (Method =:= patch)
+ orelse (Method =:= delete) ->
+ NewBody = update_body(Headers, Body),
+ NewHeaders = update_headers(Headers, ContentType, Body, HeadersAsIs),
{NewHeaders, NewBody};
post_data(_, Headers, _, []) ->
@@ -226,14 +202,39 @@ post_data(_, Headers, _, []) ->
post_data(_, _, _, HeadersAsIs = [_|_]) ->
{HeadersAsIs, ""}.
+update_body(Headers, Body) ->
+ case Headers#http_request_h.expect of
+ "100-continue" ->
+ "";
+ _ ->
+ Body
+ end.
+
+update_headers(Headers, ContentType, Body, []) ->
+ case Body of
+ [] ->
+ Headers#http_request_h{'content-length' = "0"};
+ <<>> ->
+ Headers#http_request_h{'content-length' = "0"};
+ {Fun, _Acc} when is_function(Fun, 1) ->
+ %% A client MUST NOT generate a 100-continue expectation in a request
+ %% that does not include a message body. This implies that either the
+ %% Content-Length or the Transfer-Encoding header MUST be present.
+ %% DO NOT send content-type when Body is empty.
+ Headers#http_request_h{'content-type' = ContentType};
+ _ ->
+ Headers#http_request_h{
+ 'content-length' = body_length(Body),
+ 'content-type' = ContentType}
+ end;
+update_headers(_, _, _, HeadersAsIs) ->
+ HeadersAsIs.
+
body_length(Body) when is_binary(Body) ->
integer_to_list(size(Body));
body_length(Body) when is_list(Body) ->
- integer_to_list(length(Body));
-
-body_length({DataFun, _Acc}) when is_function(DataFun, 1) ->
- undefined.
+ integer_to_list(length(Body)).
method(Method) ->
http_util:to_upper(atom_to_list(Method)).
diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl
index 540e68e749..1eaa1c930a 100644
--- a/lib/inets/src/http_server/httpd.erl
+++ b/lib/inets/src/http_server/httpd.erl
@@ -36,7 +36,13 @@
]).
%% API
--export([parse_query/1, reload_config/2, info/1, info/2, info/3]).
+-export([
+ parse_query/1,
+ reload_config/2,
+ info/1,
+ info/2,
+ info/3
+ ]).
%%%========================================================================
%%% API
@@ -49,13 +55,24 @@ parse_query(String) ->
reload_config(Config = [Value| _], Mode) when is_tuple(Value) ->
do_reload_config(Config, Mode);
reload_config(ConfigFile, Mode) ->
- case httpd_conf:load(ConfigFile) of
- {ok, ConfigList} ->
- do_reload_config(ConfigList, Mode);
- Error ->
- Error
+ try file:consult(ConfigFile) of
+ {ok, [PropList]} ->
+ %% Erlang terms format
+ do_reload_config(PropList, Mode);
+ {error, _ } ->
+ %% Apache format
+ case httpd_conf:load(ConfigFile) of
+ {ok, ConfigList} ->
+ do_reload_config(ConfigList, Mode);
+ Error ->
+ Error
+ end
+ catch
+ exit:_ ->
+ throw({error, {could_not_consult_proplist_file, ConfigFile}})
end.
+
info(Pid) when is_pid(Pid) ->
info(Pid, []).
diff --git a/lib/inets/src/http_server/mod_alias.erl b/lib/inets/src/http_server/mod_alias.erl
index 0333076546..8f0b92710e 100644
--- a/lib/inets/src/http_server/mod_alias.erl
+++ b/lib/inets/src/http_server/mod_alias.erl
@@ -163,28 +163,24 @@ longest_match([], _RequestURI, _LongestNo, LongestAlias) ->
real_script_name(_ConfigDB, _RequestURI, []) ->
not_a_script;
-
-real_script_name(ConfigDB, RequestURI, [{MP,Replacement} | Rest])
- when element(1, MP) =:= re_pattern ->
- case re:run(RequestURI, MP, [{capture, none}]) of
- match ->
- ActualName =
- re:replace(RequestURI, MP, Replacement, [{return,list}]),
- httpd_util:split_script_path(default_index(ConfigDB, ActualName));
- nomatch ->
- real_script_name(ConfigDB, RequestURI, Rest)
- end;
-
real_script_name(ConfigDB, RequestURI, [{FakeName,RealName} | Rest]) ->
case re:run(RequestURI, "^" ++ FakeName, [{capture, none}]) of
match ->
- ActualName =
+ ActualName0 =
re:replace(RequestURI, "^" ++ FakeName, RealName, [{return,list}]),
+ ActualName = abs_script_path(ConfigDB, ActualName0),
httpd_util:split_script_path(default_index(ConfigDB, ActualName));
nomatch ->
real_script_name(ConfigDB, RequestURI, Rest)
end.
+%% ERL-574: relative path in script_alias property results in malformed url
+abs_script_path(ConfigDB, [$.|_] = RelPath) ->
+ Root = httpd_util:lookup(ConfigDB, server_root),
+ Root ++ "/" ++ RelPath;
+abs_script_path(_, RelPath) ->
+ RelPath.
+
%% default_index
default_index(ConfigDB, Path) ->
diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl
index 1116fdb1b6..47c7ffd190 100644
--- a/lib/inets/test/httpc_SUITE.erl
+++ b/lib/inets/test/httpc_SUITE.erl
@@ -53,6 +53,7 @@ suite() ->
all() ->
[
{group, http},
+ {group, http_ipv6},
{group, sim_http},
{group, http_internal},
{group, http_unix_socket},
@@ -64,6 +65,7 @@ all() ->
groups() ->
[
{http, [], real_requests()},
+ {http_ipv6, [], [request_options]},
%% process_leak_on_keepalive is depending on stream_fun_server_close
%% and it shall be the last test case in the suite otherwise cookie
%% will fail.
@@ -151,6 +153,7 @@ only_simulated() ->
relaxed,
multipart_chunks,
get_space,
+ delete_no_body,
stream_fun_server_close
].
@@ -213,6 +216,16 @@ init_per_group(http_unix_socket = Group, Config0) ->
Port = server_start(Group, server_config(Group, Config)),
[{port, Port} | Config]
end;
+init_per_group(http_ipv6 = Group, Config0) ->
+ case is_ipv6_supported() of
+ true ->
+ start_apps(Group),
+ Config = proplists:delete(port, Config0),
+ Port = server_start(Group, server_config(Group, Config)),
+ [{port, Port} | Config];
+ false ->
+ {skip, "Host does not support IPv6"}
+ end;
init_per_group(Group, Config0) ->
start_apps(Group),
Config = proplists:delete(port, Config0),
@@ -280,6 +293,16 @@ end_per_testcase(Case, Config)
end_per_testcase(_Case, _Config) ->
ok.
+is_ipv6_supported() ->
+ case gen_udp:open(0, [inet6]) of
+ {ok, Socket} ->
+ gen_udp:close(Socket),
+ true;
+ _ ->
+ false
+ end.
+
+
%%--------------------------------------------------------------------
%% Test Cases --------------------------------------------------------
%%--------------------------------------------------------------------
@@ -1376,6 +1399,26 @@ unix_domain_socket(Config) when is_list(Config) ->
{ok, {{_,200,_}, [_ | _], _}}
= httpc:request(get, {URL, []}, [], []).
+%%-------------------------------------------------------------------------
+delete_no_body(doc) ->
+ ["Test that a DELETE request without Body does not send a Content-Type header - Solves ERL-536"];
+delete_no_body(Config) when is_list(Config) ->
+ URL = url(group_name(Config), "/delete_no_body.html", Config),
+ %% Simulated server replies 500 if 'Content-Type' header is present
+ {ok, {{_,200,_}, _, _}} =
+ httpc:request(delete, {URL, []}, [], []),
+ {ok, {{_,500,_}, _, _}} =
+ httpc:request(delete, {URL, [], "text/plain", "TEST"}, [], []).
+
+%%--------------------------------------------------------------------
+request_options() ->
+ [{doc, "Test http get request with socket options against local server (IPv6)"}].
+request_options(Config) when is_list(Config) ->
+ Request = {url(group_name(Config), "/dummy.html", Config), []},
+ {ok, {{_,200,_}, [_ | _], _ = [_ | _]}} = httpc:request(get, Request, [],
+ [{socket_opts,[{ipfamily, inet6}]}]),
+ {error,{failed_connect,_ }} = httpc:request(get, Request, [], []).
+
%%--------------------------------------------------------------------
@@ -1465,6 +1508,9 @@ url(http, End, Config) ->
Port = proplists:get_value(port, Config),
{ok,Host} = inet:gethostname(),
?URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ End;
+url(http_ipv6, End, Config) ->
+ Port = proplists:get_value(port, Config),
+ ?URL_START ++ "[::1]" ++ ":" ++ integer_to_list(Port) ++ End;
url(https, End, Config) ->
Port = proplists:get_value(port, Config),
{ok,Host} = inet:gethostname(),
@@ -1509,7 +1555,11 @@ server_start(http_unix_socket, Config) ->
{_Pid, Port} = http_test_lib:dummy_server(unix_socket, Inet, [{content_cb, ?MODULE},
{unix_socket, Socket}]),
Port;
-
+server_start(http_ipv6, HttpdConfig) ->
+ {ok, Pid} = inets:start(httpd, HttpdConfig),
+ Serv = inets:services_info(),
+ {value, {_, _, Info}} = lists:keysearch(Pid, 2, Serv),
+ proplists:get_value(port, Info);
server_start(_, HttpdConfig) ->
{ok, Pid} = inets:start(httpd, HttpdConfig),
Serv = inets:services_info(),
@@ -1528,6 +1578,17 @@ server_config(http, Config) ->
{mime_type, "text/plain"},
{script_alias, {"/cgi-bin/", filename:join(ServerRoot, "cgi-bin") ++ "/"}}
];
+server_config(http_ipv6, Config) ->
+ ServerRoot = proplists:get_value(server_root, Config),
+ [{port, 0},
+ {server_name,"httpc_test"},
+ {server_root, ServerRoot},
+ {document_root, proplists:get_value(doc_root, Config)},
+ {bind_address, {0,0,0,0,0,0,0,1}},
+ {ipfamily, inet6},
+ {mime_type, "text/plain"},
+ {script_alias, {"/cgi-bin/", filename:join(ServerRoot, "cgi-bin") ++ "/"}}
+ ];
server_config(http_internal, Config) ->
ServerRoot = proplists:get_value(server_root, Config),
[{port, 0},
@@ -1882,6 +1943,13 @@ auth_header([{"authorization", Value} | _]) ->
auth_header([_ | Tail]) ->
auth_header(Tail).
+content_type_header([]) ->
+ not_found;
+content_type_header([{"content-type", Value}|_]) ->
+ {ok, string:strip(Value)};
+content_type_header([_|T]) ->
+ content_type_header(T).
+
handle_auth("Basic " ++ UserInfo, Challange, DefaultResponse) ->
case string:tokens(base64:decode_to_string(UserInfo), ":") of
["alladin", "sesame"] = Auth ->
@@ -2312,7 +2380,15 @@ handle_uri(_,"/http_1_1_send_oct_and_connection_close.html",_,_,Socket,_) ->
"X-Socket-Stat-Send-Oct: " ++ integer_to_list(get_stat(Socket, send_oct)) ++ "\r\n" ++
"Connection: close\r\n" ++
"\r\n";
-
+handle_uri(_,"/delete_no_body.html", _,Headers,_, DefaultResponse) ->
+ Error = "HTTP/1.1 500 Internal Server Error\r\n" ++
+ "Content-Length:0\r\n\r\n",
+ case content_type_header(Headers) of
+ {ok, _} ->
+ Error;
+ not_found ->
+ DefaultResponse
+ end;
handle_uri(_,_,_,_,_,DefaultResponse) ->
DefaultResponse.
diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl
index 9a85c51d24..5020b5a802 100644
--- a/lib/inets/test/httpd_SUITE.erl
+++ b/lib/inets/test/httpd_SUITE.erl
@@ -75,6 +75,7 @@ all() ->
{group, http_mime_types},
{group, http_logging},
{group, http_post},
+ {group, http_rel_path_script_alias},
mime_types_format
].
@@ -112,7 +113,8 @@ groups() ->
non_disturbing_0_9,
disturbing_1_1,
disturbing_1_0,
- disturbing_0_9
+ disturbing_0_9,
+ reload_config_file
]},
{post, [], [chunked_post, chunked_chunked_encoded_post]},
{basic_auth, [], [basic_auth_1_1, basic_auth_1_0, basic_auth_0_9]},
@@ -131,7 +133,8 @@ groups() ->
trace, range, if_modified_since, mod_esi_chunk_timeout,
esi_put, esi_post] ++ http_head() ++ http_get() ++ load()},
{http_1_0, [], [host, cgi, trace] ++ http_head() ++ http_get() ++ load()},
- {http_0_9, [], http_head() ++ http_get() ++ load()}
+ {http_0_9, [], http_head() ++ http_get() ++ load()},
+ {http_rel_path_script_alias, [], [cgi]}
].
basic_groups ()->
@@ -168,6 +171,7 @@ init_per_suite(Config) ->
ServerRoot = filename:join(PrivDir, "server_root"),
inets_test_lib:del_dirs(ServerRoot),
DocRoot = filename:join(ServerRoot, "htdocs"),
+ setup_tmp_dir(PrivDir),
setup_server_dirs(ServerRoot, DocRoot, DataDir),
{ok, Hostname0} = inet:gethostname(),
Inet =
@@ -268,6 +272,9 @@ init_per_group(http_logging, Config) ->
ServerRoot = proplists:get_value(server_root, Config1),
Path = ServerRoot ++ "/httpd_log_transfer",
[{transfer_log, Path} | Config1];
+init_per_group(http_rel_path_script_alias = Group, Config) ->
+ ok = start_apps(Group),
+ init_httpd(Group, [{type, ip_comm},{http_version, "HTTP/1.1"}| Config]);
init_per_group(_, Config) ->
Config.
@@ -1536,6 +1543,45 @@ non_disturbing(Config) when is_list(Config)->
end,
inets_test_lib:close(Type, Socket),
[{server_name, "httpd_non_disturbing_" ++ Version}] = httpd:info(Server, [server_name]).
+%%-------------------------------------------------------------------------
+reload_config_file(Config) when is_list(Config) ->
+ ServerRoot = proplists:get_value(server_root, Config),
+ HttpdConf = filename:join(get_tmp_dir(Config), "inets_httpd_server.conf"),
+ ServerConfig =
+ "[\n" ++
+ "{bind_address, \"localhost\"}," ++
+ "{port,0}," ++
+ "{server_name,\"httpd_test\"}," ++
+ "{server_root,\"" ++ ServerRoot ++ "\"}," ++
+ "{document_root,\"" ++ proplists:get_value(doc_root, Config) ++ "\"}" ++
+ "].",
+ ok = file:write_file(HttpdConf, ServerConfig),
+ {ok, Server} = inets:start(httpd, [{proplist_file, HttpdConf}]),
+ Port = proplists:get_value(port, httpd:info(Server)),
+ NewConfig =
+ "[\n" ++
+ "{bind_address, \"localhost\"}," ++
+ "{port," ++ integer_to_list(Port) ++ "}," ++
+ "{server_name,\"httpd_test_new\"}," ++
+ "{server_root,\"" ++ ServerRoot ++ "\"}," ++
+ "{document_root,\"" ++ proplists:get_value(doc_root, Config) ++ "\"}" ++
+ "].",
+ NewConfigApache =
+ "BindAddress localhost\n" ++
+ "Port " ++ integer_to_list(Port) ++ "\n" ++
+ "ServerName httpd_test_new_apache\n" ++
+ "ServerRoot " ++ ServerRoot ++ "\n" ++
+ "DocumentRoot " ++ proplists:get_value(doc_root, Config) ++ "\n",
+
+ %% Test Erlang term format
+ ok = file:write_file(HttpdConf, NewConfig),
+ ok = httpd:reload_config(HttpdConf, non_disturbing),
+ "httpd_test_new" = proplists:get_value(server_name, httpd:info(Server)),
+
+ %% Test Apache format
+ ok = file:write_file(HttpdConf, NewConfigApache),
+ ok = httpd:reload_config(HttpdConf, non_disturbing),
+ "httpd_test_new_apache" = proplists:get_value(server_name, httpd:info(Server)).
%%-------------------------------------------------------------------------
mime_types_format(Config) when is_list(Config) ->
@@ -1647,6 +1693,7 @@ mime_types_format(Config) when is_list(Config) ->
{"cpt","application/mac-compactpro"},
{"hqx","application/mac-binhex40"}]} = httpd_conf:load_mime_types(MimeTypes).
+
%%--------------------------------------------------------------------
%% Internal functions -----------------------------------
%%--------------------------------------------------------------------
@@ -1728,7 +1775,15 @@ setup_server_dirs(ServerRoot, DocRoot, DataDir) ->
{ok, FileInfo1} = file:read_file_info(EnvCGI),
ok = file:write_file_info(EnvCGI,
FileInfo1#file_info{mode = 8#00755}).
-
+
+setup_tmp_dir(PrivDir) ->
+ TmpDir = filename:join(PrivDir, "tmp"),
+ ok = file:make_dir(TmpDir).
+
+get_tmp_dir(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ filename:join(PrivDir, "tmp").
+
start_apps(Group) when Group == https_basic;
Group == https_limit;
Group == https_custom;
@@ -1753,7 +1808,8 @@ start_apps(Group) when Group == http_basic;
Group == http_logging;
Group == http_reload;
Group == http_post;
- Group == http_mime_types->
+ Group == http_mime_types;
+ Group == http_rel_path_script_alias ->
inets_test_lib:start_apps([inets]).
server_start(_, HttpdConfig) ->
@@ -1878,7 +1934,27 @@ server_config(http, Config) ->
{erl_script_alias, {"/cgi-bin/erl", [httpd_example, io]}},
{eval_script_alias, {"/eval", [httpd_example, io]}}
];
-
+server_config(http_rel_path_script_alias, Config) ->
+ ServerRoot = proplists:get_value(server_root, Config),
+ [{port, 0},
+ {socket_type, {ip_comm, [{nodelay, true}]}},
+ {server_name,"httpd_test"},
+ {server_root, ServerRoot},
+ {document_root, proplists:get_value(doc_root, Config)},
+ {bind_address, any},
+ {ipfamily, proplists:get_value(ipfamily, Config)},
+ {max_header_size, 256},
+ {max_header_action, close},
+ {directory_index, ["index.html", "welcome.html"]},
+ {mime_types, [{"html","text/html"},{"htm","text/html"}, {"shtml","text/html"},
+ {"gif", "image/gif"}]},
+ {alias, {"/icons/", filename:join(ServerRoot,"icons") ++ "/"}},
+ {alias, {"/pics/", filename:join(ServerRoot,"icons") ++ "/"}},
+ {script_alias, {"/cgi-bin/", "./cgi-bin/"}},
+ {script_alias, {"/htbin/", "./cgi-bin/"}},
+ {erl_script_alias, {"/cgi-bin/erl", [httpd_example, io]}},
+ {eval_script_alias, {"/eval", [httpd_example, io]}}
+ ];
server_config(https, Config) ->
PrivDir = proplists:get_value(priv_dir, Config),
[{socket_type, {essl,
diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk
index 1fad9afe33..3a489357ff 100644
--- a/lib/inets/vsn.mk
+++ b/lib/inets/vsn.mk
@@ -19,6 +19,6 @@
# %CopyrightEnd%
APPLICATION = inets
-INETS_VSN = 6.5
+INETS_VSN = 6.5.1
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)"
diff --git a/lib/kernel/src/auth.erl b/lib/kernel/src/auth.erl
index 40feee6bf0..a2116d8e8a 100644
--- a/lib/kernel/src/auth.erl
+++ b/lib/kernel/src/auth.erl
@@ -107,7 +107,7 @@ get_cookie() ->
get_cookie(_Node) when node() =:= nonode@nohost ->
nocookie;
get_cookie(Node) ->
- gen_server:call(auth, {get_cookie, Node}).
+ gen_server:call(auth, {get_cookie, Node}, infinity).
-spec set_cookie(Cookie :: cookie()) -> 'true'.
@@ -119,12 +119,12 @@ set_cookie(Cookie) ->
set_cookie(_Node, _Cookie) when node() =:= nonode@nohost ->
erlang:error(distribution_not_started);
set_cookie(Node, Cookie) ->
- gen_server:call(auth, {set_cookie, Node, Cookie}).
+ gen_server:call(auth, {set_cookie, Node, Cookie}, infinity).
-spec sync_cookie() -> any().
sync_cookie() ->
- gen_server:call(auth, sync_cookie).
+ gen_server:call(auth, sync_cookie, infinity).
-spec print(Node :: node(), Format :: string(), Args :: [_]) -> 'ok'.
diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl
index 6f248626ca..1270de4144 100644
--- a/lib/kernel/src/erts_debug.erl
+++ b/lib/kernel/src/erts_debug.erl
@@ -35,7 +35,8 @@
flat_size/1, get_internal_state/1, instructions/0,
map_info/1, same/2, set_internal_state/2,
size_shared/1, copy_shared/1, dirty_cpu/2, dirty_io/2, dirty/3,
- lcnt_control/1, lcnt_control/2, lcnt_collect/0, lcnt_clear/0]).
+ lcnt_control/1, lcnt_control/2, lcnt_collect/0, lcnt_clear/0,
+ lc_graph/0, lc_graph_to_dot/2, lc_graph_merge/2]).
-spec breakpoint(MFA, Flag) -> non_neg_integer() when
MFA :: {Module :: module(),
@@ -407,3 +408,90 @@ cont_dis(_, {_,_,_}, _) -> ok.
map_info(_) ->
erlang:nif_error(undef).
+
+%% Create file "lc_graph.<pid>" with all actual lock dependencies
+%% recorded so far by the VM.
+%% Needs debug VM or --enable-lock-checking config, returns 'notsup' otherwise.
+lc_graph() ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ erts_debug:get_internal_state(lc_graph).
+
+%% Convert "lc_graph.<pid>" file to https://www.graphviz.org dot format.
+lc_graph_to_dot(OutFile, InFile) ->
+ {ok, [LL0]} = file:consult(InFile),
+
+ [{"NO LOCK",0} | LL] = LL0,
+ Map = maps:from_list([{Id, Name} || {Name, Id, _, _} <- LL]),
+
+ case file:open(OutFile, [exclusive]) of
+ {ok, Out} ->
+ ok = file:write(Out, "digraph G {\n"),
+
+ [dot_print_lock(Out, Lck, Map) || Lck <- LL],
+
+ ok = file:write(Out, "}\n"),
+ ok = file:close(Out);
+
+ {error,eexist} ->
+ {"File already exists", OutFile}
+ end.
+
+dot_print_lock(Out, {_Name, Id, Lst, _}, Map) ->
+ [dot_print_edge(Out, From, Id, Map) || From <- Lst],
+ ok.
+
+dot_print_edge(_, 0, _, _) ->
+ ignore; % "NO LOCK"
+dot_print_edge(Out, From, To, Map) ->
+ io:format(Out, "~p -> ~p;\n", [maps:get(From,Map), maps:get(To,Map)]).
+
+
+%% Merge several "lc_graph" files into one file.
+lc_graph_merge(OutFile, InFiles) ->
+ LLs = lists:map(fun(InFile) ->
+ {ok, [LL]} = file:consult(InFile),
+ LL
+ end,
+ InFiles),
+
+ Res = lists:foldl(fun(A, B) -> lcg_merge(A, B) end,
+ hd(LLs),
+ tl(LLs)),
+ case file:open(OutFile, [exclusive]) of
+ {ok, Out} ->
+ try
+ lcg_print(Out, Res)
+ after
+ file:close(Out)
+ end,
+ ok;
+ {error, eexist} ->
+ {"File already exists", OutFile}
+ end.
+
+lcg_merge(A, B) ->
+ lists:zipwith(fun(LA, LB) -> lcg_merge_locks(LA, LB) end,
+ A, B).
+
+lcg_merge_locks(L, L) ->
+ L;
+lcg_merge_locks({Name, Id, DA, IA}, {Name, Id, DB, IB}) ->
+ Direct = lists:umerge(DA, DB),
+ Indirect = lists:umerge(IA, IB),
+ {Name, Id, Direct, Indirect -- Direct}.
+
+
+lcg_print(Out, LL) ->
+ io:format(Out, "[", []),
+ lcg_print_locks(Out, LL),
+ io:format(Out, "].\n", []),
+ ok.
+
+lcg_print_locks(Out, [{_,_}=NoLock | Rest]) ->
+ io:format(Out, "~p,\n", [NoLock]),
+ lcg_print_locks(Out, Rest);
+lcg_print_locks(Out, [LastLock]) ->
+ io:format(Out, "~w", [LastLock]);
+lcg_print_locks(Out, [Lock | Rest]) ->
+ io:format(Out, "~w,\n", [Lock]),
+ lcg_print_locks(Out, Rest).
diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile
index efe3a68531..03b6355056 100644
--- a/lib/kernel/test/Makefile
+++ b/lib/kernel/test/Makefile
@@ -80,7 +80,8 @@ MODULES= \
loose_node \
sendfile_SUITE \
standard_error_SUITE \
- multi_load_SUITE
+ multi_load_SUITE \
+ zzz_SUITE
APP_FILES = \
appinc.app \
diff --git a/lib/ssh/src/ssh_server_key.erl b/lib/kernel/test/zzz_SUITE.erl
index 2ce0c7e3fe..59c7fd7404 100644
--- a/lib/ssh/src/ssh_server_key.erl
+++ b/lib/kernel/test/zzz_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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.
@@ -17,18 +17,21 @@
%%
%% %CopyrightEnd%
%%
+-module(zzz_SUITE).
--module(ssh_server_key).
+%% The sole purpose of this test suite is for things we want to run last
+%% before the VM terminates.
--include_lib("public_key/include/public_key.hrl").
--include("ssh.hrl").
+-export([all/0]).
--type ssh_algorithm() :: string().
+-export([lc_graph/1]).
--callback host_key(Algorithm :: ssh_algorithm(), Options :: list()) ->
- {ok, [{public_key(), Attributes::list()}]} | public_key()
- | {error, string()}.
--callback is_auth_key(Key :: public_key(), User :: string(),
- Algorithm :: ssh_algorithm(), Options :: list()) ->
- boolean().
+all() ->
+ [lc_graph].
+
+lc_graph(_Config) ->
+ %% Create "lc_graph" file in current working dir
+ %% if lock checker is enabled.
+ erts_debug:lc_graph(),
+ ok.
diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl
index 41ca3f3ce9..8bd7ad387b 100644
--- a/lib/observer/test/crashdump_viewer_SUITE.erl
+++ b/lib/observer/test/crashdump_viewer_SUITE.erl
@@ -674,7 +674,7 @@ do_create_dumps(DataDir,Rel) ->
end,
case Rel of
current ->
- CD3 = dump_with_args(DataDir,Rel,"instr","+Mim true"),
+ CD3 = dump_with_args(DataDir,Rel,"instr","+Muatags true"),
CD4 = dump_with_strange_module_name(DataDir,Rel,"strangemodname"),
CD5 = dump_with_size_limit_reached(DataDir,Rel,"trunc_bytes"),
CD6 = dump_with_unicode_atoms(DataDir,Rel,"unicode"),
diff --git a/lib/runtime_tools/test/Makefile b/lib/runtime_tools/test/Makefile
index de37b2570d..29cf7545c9 100644
--- a/lib/runtime_tools/test/Makefile
+++ b/lib/runtime_tools/test/Makefile
@@ -10,7 +10,8 @@ MODULES = \
dbg_SUITE \
erts_alloc_config_SUITE \
scheduler_SUITE \
- msacc_SUITE
+ msacc_SUITE \
+ zzz_SUITE
ERL_FILES= $(MODULES:%=%.erl)
diff --git a/lib/ssh/src/ssh_client_key.erl b/lib/runtime_tools/test/zzz_SUITE.erl
index 5296ac2a02..59c7fd7404 100644
--- a/lib/ssh/src/ssh_client_key.erl
+++ b/lib/runtime_tools/test/zzz_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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.
@@ -17,19 +17,21 @@
%%
%% %CopyrightEnd%
%%
+-module(zzz_SUITE).
--module(ssh_client_key).
+%% The sole purpose of this test suite is for things we want to run last
+%% before the VM terminates.
--include_lib("public_key/include/public_key.hrl").
--include("ssh.hrl").
+-export([all/0]).
--callback is_host_key(Key :: public_key(), Host :: string(),
- Algorithm :: 'ssh-rsa'| 'ssh-dsa'| atom(), Options :: proplists:proplist()) ->
- boolean().
+-export([lc_graph/1]).
--callback user_key(Algorithm :: 'ssh-rsa'| 'ssh-dsa'| atom(), Options :: list()) ->
- {ok, PrivateKey :: term()} | {error, string()}.
+all() ->
+ [lc_graph].
--callback add_host_key(Host :: string(), PublicKey :: term(), Options :: list()) ->
- ok | {error, Error::term()}.
+lc_graph(_Config) ->
+ %% Create "lc_graph" file in current working dir
+ %% if lock checker is enabled.
+ erts_debug:lc_graph(),
+ ok.
diff --git a/lib/sasl/doc/src/notes.xml b/lib/sasl/doc/src/notes.xml
index e532c3cd6f..791e9c063a 100644
--- a/lib/sasl/doc/src/notes.xml
+++ b/lib/sasl/doc/src/notes.xml
@@ -31,6 +31,26 @@
</header>
<p>This document describes the changes made to the SASL application.</p>
+<section><title>SASL 3.1.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ When upgrading with instruction 'restart_new_emulator',
+ the generated temporary boot file used 'kernelProcess'
+ statements from the old release instead of the new
+ release. This is now corrected.</p>
+ <p>
+ This correction is needed for upgrade to OTP-21.</p>
+ <p>
+ Own Id: OTP-15017</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>SASL 3.1.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl
index bfa49fc05d..4fd3fc0d36 100644
--- a/lib/sasl/src/release_handler.erl
+++ b/lib/sasl/src/release_handler.erl
@@ -1052,8 +1052,8 @@ new_emulator_make_tmp_release(CurrentRelease,ToRelease,RelDir,Opts,Masters) ->
ToVsn = ToRelease#release.vsn,
TmpVsn = ?tmp_vsn(CurrentVsn),
case get_base_libs(ToRelease#release.libs) of
- {ok,{Kernel,Stdlib,Sasl}=BaseLibs,_} ->
- case get_base_libs(ToRelease#release.libs) of
+ {ok,{Kernel,Stdlib,Sasl},_} ->
+ case get_base_libs(CurrentRelease#release.libs) of
{ok,_,RestLibs} ->
TmpErtsVsn = ToRelease#release.erts_vsn,
TmpLibs = [Kernel,Stdlib,Sasl|RestLibs],
@@ -1062,7 +1062,7 @@ new_emulator_make_tmp_release(CurrentRelease,ToRelease,RelDir,Opts,Masters) ->
libs = TmpLibs,
status = unpacked},
new_emulator_make_hybrid_boot(CurrentVsn,ToVsn,TmpVsn,
- BaseLibs,RelDir,Opts,Masters),
+ RelDir,Opts,Masters),
new_emulator_make_hybrid_config(CurrentVsn,ToVsn,TmpVsn,
RelDir,Masters),
{TmpVsn,TmpRelease};
@@ -1095,7 +1095,7 @@ get_base_libs([],_Kernel,_Stdlib,undefined,_Rest) ->
get_base_libs([],Kernel,Stdlib,Sasl,Rest) ->
{ok,{Kernel,Stdlib,Sasl},lists:reverse(Rest)}.
-new_emulator_make_hybrid_boot(CurrentVsn,ToVsn,TmpVsn,BaseLibs,RelDir,Opts,Masters) ->
+new_emulator_make_hybrid_boot(CurrentVsn,ToVsn,TmpVsn,RelDir,Opts,Masters) ->
FromBootFile = filename:join([RelDir,CurrentVsn,"start.boot"]),
ToBootFile = filename:join([RelDir,ToVsn,"start.boot"]),
TmpBootFile = filename:join([RelDir,TmpVsn,"start.boot"]),
@@ -1103,11 +1103,7 @@ new_emulator_make_hybrid_boot(CurrentVsn,ToVsn,TmpVsn,BaseLibs,RelDir,Opts,Maste
Args = [ToVsn,Opts],
{ok,FromBoot} = read_file(FromBootFile,Masters),
{ok,ToBoot} = read_file(ToBootFile,Masters),
- {{_,_,KernelPath},{_,_,StdlibPath},{_,_,SaslPath}} = BaseLibs,
- Paths = {filename:join(KernelPath,"ebin"),
- filename:join(StdlibPath,"ebin"),
- filename:join(SaslPath,"ebin")},
- case systools_make:make_hybrid_boot(TmpVsn,FromBoot,ToBoot,Paths,Args) of
+ case systools_make:make_hybrid_boot(TmpVsn,FromBoot,ToBoot,Args) of
{ok,TmpBoot} ->
write_file(TmpBootFile,TmpBoot,Masters);
{error,Reason} ->
diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl
index 4c2ad8dfef..a9e8bcecfa 100644
--- a/lib/sasl/src/systools_make.erl
+++ b/lib/sasl/src/systools_make.erl
@@ -32,7 +32,7 @@
-export([read_application/4]).
--export([make_hybrid_boot/5]).
+-export([make_hybrid_boot/4]).
-import(lists, [filter/2, keysort/2, keysearch/3, map/2, reverse/1,
append/1, foldl/3, member/2, foreach/2]).
@@ -178,94 +178,153 @@ return({error,Mod,Error},_,Flags) ->
%% and sasl.
%%
%% TmpVsn = string(),
-%% Paths = {KernelPath,StdlibPath,SaslPath}
%% Returns {ok,Boot} | {error,Reason}
%% Boot1 = Boot2 = Boot = binary()
%% Reason = {app_not_found,App} | {app_not_replaced,App}
-%% App = kernel | stdlib | sasl
-make_hybrid_boot(TmpVsn, Boot1, Boot2, Paths, Args) ->
- catch do_make_hybrid_boot(TmpVsn, Boot1, Boot2, Paths, Args).
-do_make_hybrid_boot(TmpVsn, Boot1, Boot2, Paths, Args) ->
- {script,{_RelName1,_RelVsn1},Script1} = binary_to_term(Boot1),
- {script,{RelName2,_RelVsn2},Script2} = binary_to_term(Boot2),
- MatchPaths = get_regexp_path(Paths),
- NewScript1 = replace_paths(Script1,MatchPaths),
- {Kernel,Stdlib,Sasl} = get_apps(Script2,undefined,undefined,undefined),
- NewScript2 = replace_apps(NewScript1,Kernel,Stdlib,Sasl),
- NewScript3 = add_apply_upgrade(NewScript2,Args),
- Boot = term_to_binary({script,{RelName2,TmpVsn},NewScript3}),
+%% App = stdlib | sasl
+make_hybrid_boot(TmpVsn, Boot1, Boot2, Args) ->
+ catch do_make_hybrid_boot(TmpVsn, Boot1, Boot2, Args).
+do_make_hybrid_boot(TmpVsn, OldBoot, NewBoot, Args) ->
+ {script,{_RelName1,_RelVsn1},OldScript} = binary_to_term(OldBoot),
+ {script,{NewRelName,_RelVsn2},NewScript} = binary_to_term(NewBoot),
+
+ %% Everyting upto kernel_load_completed must come from the new script
+ Fun1 = fun({progress,kernel_load_completed}) -> false;
+ (_) -> true
+ end,
+ {_OldKernelLoad,OldRest1} = lists:splitwith(Fun1,OldScript),
+ {NewKernelLoad,NewRest1} = lists:splitwith(Fun1,NewScript),
+
+ Fun2 = fun({progress,modules_loaded}) -> false;
+ (_) -> true
+ end,
+ {OldModLoad,OldRest2} = lists:splitwith(Fun2,OldRest1),
+ {NewModLoad,NewRest2} = lists:splitwith(Fun2,NewRest1),
+
+ Fun3 = fun({kernelProcess,_,_}) -> false;
+ (_) -> true
+ end,
+ {OldPaths,OldRest3} = lists:splitwith(Fun3,OldRest2),
+ {NewPaths,NewRest3} = lists:splitwith(Fun3,NewRest2),
+
+ Fun4 = fun({progress,init_kernel_started}) -> false;
+ (_) -> true
+ end,
+ {_OldKernelProcs,OldApps} = lists:splitwith(Fun4,OldRest3),
+ {NewKernelProcs,NewApps} = lists:splitwith(Fun4,NewRest3),
+
+ %% Then comes all module load, which for each app consist of:
+ %% {path,[AppPath]},
+ %% {primLoad,ModuleList}
+ %% Replace kernel, stdlib and sasl here
+ MatchPaths = get_regexp_path(),
+ ModLoad = replace_module_load(OldModLoad,NewModLoad,MatchPaths),
+ Paths = replace_paths(OldPaths,NewPaths,MatchPaths),
+
+ {Stdlib,Sasl} = get_apps(NewApps,undefined,undefined),
+ Apps0 = replace_apps(OldApps,Stdlib,Sasl),
+ Apps = add_apply_upgrade(Apps0,Args),
+
+ Script = NewKernelLoad++ModLoad++Paths++NewKernelProcs++Apps,
+ Boot = term_to_binary({script,{NewRelName,TmpVsn},Script}),
{ok,Boot}.
%% For each app, compile a regexp that can be used for finding its path
-get_regexp_path({KernelPath,StdlibPath,SaslPath}) ->
+get_regexp_path() ->
{ok,KernelMP} = re:compile("kernel-[0-9\.]+",[unicode]),
{ok,StdlibMP} = re:compile("stdlib-[0-9\.]+",[unicode]),
{ok,SaslMP} = re:compile("sasl-[0-9\.]+",[unicode]),
- [{KernelMP,KernelPath},{StdlibMP,StdlibPath},{SaslMP,SaslPath}].
-
-%% For each path in the script, check if it matches any of the MPs
-%% found above, and if so replace it with the correct new path.
-replace_paths([{path,Path}|Script],MatchPaths) ->
- [{path,replace_path(Path,MatchPaths)}|replace_paths(Script,MatchPaths)];
-replace_paths([Stuff|Script],MatchPaths) ->
- [Stuff|replace_paths(Script,MatchPaths)];
-replace_paths([],_) ->
+ [KernelMP,StdlibMP,SaslMP].
+
+replace_module_load(Old,New,[MP|MatchPaths]) ->
+ replace_module_load(do_replace_module_load(Old,New,MP),New,MatchPaths);
+replace_module_load(Script,_,[]) ->
+ Script.
+
+do_replace_module_load([{path,[OldAppPath]},{primLoad,OldMods}|OldRest],New,MP) ->
+ case re:run(OldAppPath,MP,[{capture,none}]) of
+ nomatch ->
+ [{path,[OldAppPath]},{primLoad,OldMods}|
+ do_replace_module_load(OldRest,New,MP)];
+ match ->
+ get_module_load(New,MP) ++ OldRest
+ end;
+do_replace_module_load([Other|Rest],New,MP) ->
+ [Other|do_replace_module_load(Rest,New,MP)];
+do_replace_module_load([],_,_) ->
+ [].
+
+get_module_load([{path,[AppPath]},{primLoad,Mods}|Rest],MP) ->
+ case re:run(AppPath,MP,[{capture,none}]) of
+ nomatch ->
+ get_module_load(Rest,MP);
+ match ->
+ [{path,[AppPath]},{primLoad,Mods}]
+ end;
+get_module_load([_|Rest],MP) ->
+ get_module_load(Rest,MP);
+get_module_load([],_) ->
[].
-replace_path([Path|Paths],MatchPaths) ->
- [do_replace_path(Path,MatchPaths)|replace_path(Paths,MatchPaths)];
-replace_path([],_) ->
+replace_paths([{path,OldPaths}|Old],New,MatchPaths) ->
+ {path,NewPath} = lists:keyfind(path,1,New),
+ [{path,do_replace_paths(OldPaths,NewPath,MatchPaths)}|Old];
+replace_paths([Other|Old],New,MatchPaths) ->
+ [Other|replace_paths(Old,New,MatchPaths)].
+
+do_replace_paths(Old,New,[MP|MatchPaths]) ->
+ do_replace_paths(do_replace_paths1(Old,New,MP),New,MatchPaths);
+do_replace_paths(Paths,_,[]) ->
+ Paths.
+
+do_replace_paths1([P|Ps],New,MP) ->
+ case re:run(P,MP,[{capture,none}]) of
+ nomatch ->
+ [P|do_replace_paths1(Ps,New,MP)];
+ match ->
+ get_path(New,MP) ++ Ps
+ end;
+do_replace_paths1([],_,_) ->
[].
-do_replace_path(Path,[{MP,ReplacePath}|MatchPaths]) ->
- case re:run(Path,MP,[{capture,none}]) of
- nomatch -> do_replace_path(Path,MatchPaths);
- match -> ReplacePath
+get_path([P|Ps],MP) ->
+ case re:run(P,MP,[{capture,none}]) of
+ nomatch ->
+ get_path(Ps,MP);
+ match ->
+ [P]
end;
-do_replace_path(Path,[]) ->
- Path.
-
-%% Return the entries for loading the three base applications
-get_apps([{kernelProcess,application_controller,
- {application_controller,start,[{application,kernel,_}]}}=Kernel|
- Script],_,Stdlib,Sasl) ->
- get_apps(Script,Kernel,Stdlib,Sasl);
+get_path([],_) ->
+ [].
+
+
+%% Return the entries for loading stdlib and sasl
get_apps([{apply,{application,load,[{application,stdlib,_}]}}=Stdlib|Script],
- Kernel,_,Sasl) ->
- get_apps(Script,Kernel,Stdlib,Sasl);
+ _,Sasl) ->
+ get_apps(Script,Stdlib,Sasl);
get_apps([{apply,{application,load,[{application,sasl,_}]}}=Sasl|_Script],
- Kernel,Stdlib,_) ->
- {Kernel,Stdlib,Sasl};
-get_apps([_|Script],Kernel,Stdlib,Sasl) ->
- get_apps(Script,Kernel,Stdlib,Sasl);
-get_apps([],undefined,_,_) ->
- throw({error,{app_not_found,kernel}});
-get_apps([],_,undefined,_) ->
+ Stdlib,_) ->
+ {Stdlib,Sasl};
+get_apps([_|Script],Stdlib,Sasl) ->
+ get_apps(Script,Stdlib,Sasl);
+get_apps([],undefined,_) ->
throw({error,{app_not_found,stdlib}});
-get_apps([],_,_,undefined) ->
+get_apps([],_,undefined) ->
throw({error,{app_not_found,sasl}}).
-
-%% Replace the entries for loading the base applications
-replace_apps([{kernelProcess,application_controller,
- {application_controller,start,[{application,kernel,_}]}}|
- Script],Kernel,Stdlib,Sasl) ->
- [Kernel|replace_apps(Script,undefined,Stdlib,Sasl)];
+%% Replace the entries for loading the stdlib and sasl
replace_apps([{apply,{application,load,[{application,stdlib,_}]}}|Script],
- Kernel,Stdlib,Sasl) ->
- [Stdlib|replace_apps(Script,Kernel,undefined,Sasl)];
+ Stdlib,Sasl) ->
+ [Stdlib|replace_apps(Script,undefined,Sasl)];
replace_apps([{apply,{application,load,[{application,sasl,_}]}}|Script],
- _Kernel,_Stdlib,Sasl) ->
+ _Stdlib,Sasl) ->
[Sasl|Script];
-replace_apps([Stuff|Script],Kernel,Stdlib,Sasl) ->
- [Stuff|replace_apps(Script,Kernel,Stdlib,Sasl)];
-replace_apps([],undefined,undefined,_) ->
+replace_apps([Stuff|Script],Stdlib,Sasl) ->
+ [Stuff|replace_apps(Script,Stdlib,Sasl)];
+replace_apps([],undefined,_) ->
throw({error,{app_not_replaced,sasl}});
-replace_apps([],undefined,_,_) ->
- throw({error,{app_not_replaced,stdlib}});
-replace_apps([],_,_,_) ->
- throw({error,{app_not_replaced,kernel}}).
-
+replace_apps([],_,_) ->
+ throw({error,{app_not_replaced,stdlib}}).
%% Finally add an apply of release_handler:new_emulator_upgrade - which will
%% complete the execution of the upgrade script (relup).
@@ -275,8 +334,6 @@ add_apply_upgrade(Script,Args) ->
{apply,{release_handler,new_emulator_upgrade,Args}} |
RevScript]).
-
-
%%-----------------------------------------------------------------
%% Create a release package from a release file.
%% Options is a list of {path, Path} | silent |
diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl
index c8b2f31120..ad61186921 100644
--- a/lib/sasl/test/systools_SUITE.erl
+++ b/lib/sasl/test/systools_SUITE.erl
@@ -1795,27 +1795,28 @@ normal_hybrid(Config) ->
ok = file:set_cwd(OldDir),
- BasePaths = {"testkernelpath","teststdlibpath","testsaslpath"},
{ok,Hybrid} = systools_make:make_hybrid_boot("tmp_vsn",Boot1,Boot2,
- BasePaths, [dummy,args]),
+ [dummy,args]),
{script,{"Test release","tmp_vsn"},Script} = binary_to_term(Hybrid),
ct:log("~p.~n",[Script]),
%% Check that all paths to base apps are replaced by paths from BaseLib
Boot1Str = io_lib:format("~p~n",[binary_to_term(Boot1)]),
+ Boot2Str = io_lib:format("~p~n",[binary_to_term(Boot2)]),
HybridStr = io_lib:format("~p~n",[binary_to_term(Hybrid)]),
ReOpts = [global,{capture,first,list},unicode],
{match,OldKernelMatch} = re:run(Boot1Str,"kernel-[0-9\.]+",ReOpts),
{match,OldStdlibMatch} = re:run(Boot1Str,"stdlib-[0-9\.]+",ReOpts),
{match,OldSaslMatch} = re:run(Boot1Str,"sasl-[0-9\.]+",ReOpts),
- nomatch = re:run(HybridStr,"kernel-[0-9\.]+",ReOpts),
- nomatch = re:run(HybridStr,"stdlib-[0-9\.]+",ReOpts),
- nomatch = re:run(HybridStr,"sasl-[0-9\.]+",ReOpts),
- {match,NewKernelMatch} = re:run(HybridStr,"testkernelpath",ReOpts),
- {match,NewStdlibMatch} = re:run(HybridStr,"teststdlibpath",ReOpts),
- {match,NewSaslMatch} = re:run(HybridStr,"testsaslpath",ReOpts),
+ {match,NewKernelMatch} = re:run(Boot2Str,"kernel-[0-9\.]+",ReOpts),
+ {match,NewStdlibMatch} = re:run(Boot2Str,"stdlib-[0-9\.]+",ReOpts),
+ {match,NewSaslMatch} = re:run(Boot2Str,"sasl-[0-9\.]+",ReOpts),
+
+ {match,NewKernelMatch} = re:run(HybridStr,"kernel-[0-9\.]+",ReOpts),
+ {match,NewStdlibMatch} = re:run(HybridStr,"stdlib-[0-9\.]+",ReOpts),
+ {match,NewSaslMatch} = re:run(HybridStr,"sasl-[0-9\.]+",ReOpts),
NewKernelN = length(NewKernelMatch),
NewKernelN = length(OldKernelMatch),
@@ -1824,6 +1825,11 @@ normal_hybrid(Config) ->
NewSaslN = length(NewSaslMatch),
NewSaslN = length(OldSaslMatch),
+ %% Check that kernelProcesses are taken from new boot script
+ {script,_,Script2} = binary_to_term(Boot2),
+ NewKernelProcs = [KP || KP={kernelProcess,_,_} <- Script2],
+ NewKernelProcs = [KP || KP={kernelProcess,_,_} <- Script],
+
%% Check that application load instruction has correct versions
Apps = application:loaded_applications(),
{_,_,KernelVsn} = lists:keyfind(kernel,1,Apps),
@@ -1894,10 +1900,8 @@ hybrid_no_old_sasl(Config) ->
{ok,Boot1} = file:read_file(Name1 ++ ".boot"),
{ok,Boot2} = file:read_file(Name2 ++ ".boot"),
- BasePaths = {"testkernelpath","teststdlibpath","testsaslpath"},
{error,{app_not_replaced,sasl}} =
- systools_make:make_hybrid_boot("tmp_vsn",Boot1,Boot2,
- BasePaths,[dummy,args]),
+ systools_make:make_hybrid_boot("tmp_vsn",Boot1,Boot2,[dummy,args]),
ok = file:set_cwd(OldDir),
ok.
@@ -1927,10 +1931,8 @@ hybrid_no_new_sasl(Config) ->
{ok,Boot1} = file:read_file(Name1 ++ ".boot"),
{ok,Boot2} = file:read_file(Name2 ++ ".boot"),
- BasePaths = {"testkernelpath","teststdlibpath","testsaslpath"},
{error,{app_not_found,sasl}} =
- systools_make:make_hybrid_boot("tmp_vsn",Boot1,Boot2,
- BasePaths,[dummy,args]),
+ systools_make:make_hybrid_boot("tmp_vsn",Boot1,Boot2,[dummy,args]),
ok = file:set_cwd(OldDir),
ok.
diff --git a/lib/sasl/vsn.mk b/lib/sasl/vsn.mk
index 2488197ec5..52b168598a 100644
--- a/lib/sasl/vsn.mk
+++ b/lib/sasl/vsn.mk
@@ -1 +1 @@
-SASL_VSN = 3.1.1
+SASL_VSN = 3.1.2
diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml
index 1bba667f0f..d78309167a 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.8</title>
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ An ssh_sftp server (running version 6) could fail if it
+ is told to remove a file which in fact is a directory.</p>
+ <p>
+ Own Id: OTP-15004</p>
+ </item>
+ <item>
+ <p>
+ Fix rare spurios shutdowns of ssh servers when receiveing
+ <c>{'EXIT',_,normal}</c> messages.</p>
+ <p>
+ Own Id: OTP-15018</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Ssh 4.6.7</title>
<section><title>Fixed Bugs and Malfunctions</title>
@@ -59,8 +81,6 @@
</item>
</list>
</section>
-
-
<section><title>Improvements and New Features</title>
<list>
<item>
@@ -885,6 +905,21 @@
</section>
+<section><title>Ssh 4.2.2.6</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>
+ </list>
+ </section>
+</section>
+
+
<section><title>Ssh 4.2.2.5</title>
<section><title>Improvements and New Features</title>
<list>
diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index d36be8431c..c641badd9a 100644
--- a/lib/ssh/doc/src/ssh.xml
+++ b/lib/ssh/doc/src/ssh.xml
@@ -107,7 +107,7 @@
<p><c>atom() | {atom(), list()}</c></p>
<p><c>atom()</c> - Name of the erlang module implementing the behaviours
<seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> or
- <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> as the
+ <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso> as the
case maybe.</p>
<p><c>list()</c> - List of options that can be passed to the callback module.</p>
</item>
diff --git a/lib/ssh/doc/src/ssh_app.xml b/lib/ssh/doc/src/ssh_app.xml
index 1cbbdfcf38..faee9ef992 100644
--- a/lib/ssh/doc/src/ssh_app.xml
+++ b/lib/ssh/doc/src/ssh_app.xml
@@ -330,10 +330,10 @@
<p/>
</item>
- <item><url href="https://tools.ietf.org/html/draft-ietf-curdle-rsa-sha2">Draft-ietf-curdle-rsa-sha2 (work in progress)</url>, Use of RSA Keys with SHA-2 256 and 512 in Secure Shell (SSH).
+ <item><url href="https://tools.ietf.org/html/rfc8332">RFC 8332</url>, Use of RSA Keys with SHA-256 and SHA-512 in the Secure Shell (SSH) Protocol.
</item>
- <item><url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url>, Extension Negotiation in Secure Shell (SSH).
+ <item><url href="https://tools.ietf.org/html/rfc8308">RFC 8308</url>, Extension Negotiation in the Secure Shell (SSH) Protocol.
<p>Implemented are:</p>
<list type="bulleted">
<item>The Extension Negotiation Mechanism</item>
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index 4261e5bf13..033f11f4a1 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -1420,8 +1420,21 @@ handle_event(info, {'DOWN', _Ref, process, ChannelPid, _Reason}, _, D0) ->
{keep_state, handle_channel_down(ChannelPid, D0)};
%%% So that terminate will be run when supervisor is shutdown
-handle_event(info, {'EXIT', _Sup, Reason}, _, _) ->
- {stop, {shutdown, Reason}};
+handle_event(info, {'EXIT', _Sup, Reason}, StateName, _) ->
+ Role = role(StateName),
+ if
+ Role == client ->
+ %% OTP-8111 tells this function clause fixes a problem in
+ %% clients, but there were no check for that role.
+ {stop, {shutdown, Reason}};
+
+ Reason == normal ->
+ %% An exit normal should not cause a server to crash. This has happend...
+ keep_state_and_data;
+
+ true ->
+ {stop, {shutdown, Reason}}
+ end;
handle_event(info, check_cache, _, D) ->
{keep_state, cache_check_set_idle_timer(D)};
diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl
index 0b18bee9d7..0ce4bd8699 100644
--- a/lib/ssh/test/ssh_algorithms_SUITE.erl
+++ b/lib/ssh/test/ssh_algorithms_SUITE.erl
@@ -35,7 +35,7 @@
suite() ->
[{ct_hooks,[ts_install_cth]},
- {timetrap,{seconds,round(1.5*?TIMEOUT/1000)}}].
+ {timetrap,{seconds,60}}].
all() ->
%% [{group,kex},{group,cipher}... etc
@@ -264,7 +264,7 @@ try_exec_simple_group(Group, Config) ->
%% Testing all default groups
simple_exec_groups() ->
- [{timetrap,{seconds,120}}].
+ [{timetrap,{seconds,180}}].
simple_exec_groups(Config) ->
Sizes = interpolate( public_key:dh_gex_group_sizes() ),
diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl
index d3f93c7382..1fa94bef11 100644
--- a/lib/ssh/test/ssh_basic_SUITE.erl
+++ b/lib/ssh/test/ssh_basic_SUITE.erl
@@ -106,12 +106,12 @@ groups() ->
]},
{basic, [], [{group,p_basic},
+ shell, shell_no_unicode, shell_unicode_string,
close,
known_hosts
]},
{p_basic, [parallel], [send, peername_sockname,
exec, exec_compressed,
- shell, shell_no_unicode, shell_unicode_string,
cli,
idle_time_client, idle_time_server, openssh_zlib_basic_test,
misc_ssh_options, inet_option, inet6_option]}
diff --git a/lib/ssh/test/ssh_compat_SUITE.erl b/lib/ssh/test/ssh_compat_SUITE.erl
index f7eda1dc08..6c0e010bf5 100644
--- a/lib/ssh/test/ssh_compat_SUITE.erl
+++ b/lib/ssh/test/ssh_compat_SUITE.erl
@@ -41,8 +41,7 @@
%%--------------------------------------------------------------------
suite() ->
- [%%{ct_hooks,[ts_install_cth]},
- {timetrap,{seconds,40}}].
+ [{timetrap,{seconds,60}}].
all() ->
%% [check_docker_present] ++
diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk
index d5eed0b087..f327d2ec11 100644
--- a/lib/ssh/vsn.mk
+++ b/lib/ssh/vsn.mk
@@ -1,4 +1,4 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
-SSH_VSN = 4.6.7
+SSH_VSN = 4.6.8
APP_VSN = "ssh-$(SSH_VSN)"
diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml
index be0d64feba..e918e83df7 100644
--- a/lib/stdlib/doc/src/gen_statem.xml
+++ b/lib/stdlib/doc/src/gen_statem.xml
@@ -32,7 +32,68 @@
<modulesummary>Generic state machine behavior.</modulesummary>
<description>
<p>
- This behavior module provides a state machine. Two
+ <c>gen_statem</c> provides a generic state machine behaviour
+ and replaces its predecessor
+ <seealso marker="gen_fsm"><c>gen_fsm</c></seealso>
+ since Erlang/OTP 20.0.
+ </p>
+ <p>
+ This reference manual describes types generated from the types
+ in the <c>gen_statem</c> source code, so they are correct.
+ However, the generated descriptions also reflect the type hiearchy,
+ which makes them kind of hard to read.
+ </p>
+ <p>
+ To get an overview of the concepts and operation of <c>gen_statem</c>,
+ do read the
+ <seealso marker="doc/design_principles:statem">
+ <c>gen_statem</c>&nbsp;Behaviour
+ </seealso>
+ in
+ <seealso marker="doc/design_principles:users_guide">
+ OTP Design Principles
+ </seealso>
+ which frequently links back to this reference manual to avoid
+ containing detailed facts that may rot by age.
+ </p>
+ <note>
+ <p>
+ This behavior appeared in Erlang/OTP 19.0.
+ In OTP 19.1 a backwards incompatible change of
+ the return tuple from
+ <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso>
+ was made and the mandatory callback function
+ <seealso marker="#Module:callback_mode/0">
+ <c>Module:callback_mode/0</c>
+ </seealso>
+ was introduced. In OTP 20.0 the
+ <seealso marker="#type-generic_timeout"><c>generic timeouts</c></seealso>
+ were added.
+ </p>
+ </note>
+ <p>
+ <c>gen_statem</c> has got the same features that
+ <seealso marker="gen_fsm"><c>gen_fsm</c></seealso>
+ had and adds some really useful:
+ </p>
+ <list type="bulleted">
+ <item>Co-located state code</item>
+ <item>Arbitrary term state</item>
+ <item>Event postponing</item>
+ <item>Self-generated events</item>
+ <item>State time-out</item>
+ <item>Multiple generic named time-outs</item>
+ <item>Absolute time-out time</item>
+ <item>Automatic state enter calls</item>
+ <item>
+ Reply from other state than the request, <c>sys</c> traceable
+ </item>
+ <item>Multiple <c>sys</c> traceable replies</item>
+ </list>
+
+
+ <p>
+ Two
<seealso marker="#type-callback_mode"><em>callback modes</em></seealso>
are supported:
</p>
@@ -50,34 +111,6 @@
</p>
</item>
</list>
- <note>
- <p>
- This is a new behavior in Erlang/OTP 19.0.
- It has been thoroughly reviewed, is stable enough
- to be used by at least two heavy OTP applications,
- and is here to stay.
- Depending on user feedback, we do not expect
- but can find it necessary to make minor
- not backward compatible changes into Erlang/OTP 20.0.
- </p>
- </note>
- <p>
- The <c>gen_statem</c> behavior replaces
- <seealso marker="gen_fsm"><c>gen_fsm</c> </seealso> in Erlang/OTP 20.0.
- It has the same features and adds some really useful:
- </p>
- <list type="bulleted">
- <item>Gathered state code.</item>
- <item>Arbitrary term state.</item>
- <item>Event postponing.</item>
- <item>Self-generated events.</item>
- <item>State time-out.</item>
- <item>Multiple generic named time-outs.</item>
- <item>Absolute time-out time.</item>
- <item>Automatic state enter calls.</item>
- <item>Reply from other state than the request.</item>
- <item>Multiple <c>sys</c> traceable replies.</item>
- </list>
<p>
The callback model(s) for <c>gen_statem</c> differs from
the one for <seealso marker="gen_fsm"><c>gen_fsm</c></seealso>,
@@ -148,7 +181,7 @@ erlang:'!' -----> Module:StateName/3
is <c>state_functions</c>, the state must be an atom and
is used as the state callback name; see
<seealso marker="#Module:StateName/3"><c>Module:StateName/3</c></seealso>.
- This gathers all code for a specific state
+ This co-locates all code for a specific state
in one function as the <c>gen_statem</c> engine
branches depending on state name.
Note the fact that the callback function
@@ -207,8 +240,10 @@ erlang:'!' -----> Module:StateName/3
whenever a new state is entered; see
<seealso marker="#type-state_enter"><c>state_enter()</c></seealso>.
This is for writing code common to all state entries.
- Another way to do it is to insert events at state transitions,
- but you have to do so everywhere it is needed.
+ Another way to do it is to insert an event at the state transition,
+ and/or to use a dedicated state transition function,
+ but that is something you will have to remember
+ at every state transition to the state(s) that need it.
</p>
<note>
<p>If you in <c>gen_statem</c>, for example, postpone
@@ -252,6 +287,16 @@ erlang:'!' -----> Module:StateName/3
to use after every event; see
<seealso marker="erts:erlang#hibernate/3"><c>erlang:hibernate/3</c></seealso>.
</p>
+ <p>
+ There is also a server start option
+ <seealso marker="#type-hibernate_after_opt">
+ <c>{hibernate_after, Timeout}</c>
+ </seealso>
+ for
+ <seealso marker="#start/3"><c>start/3,4</c></seealso> or
+ <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>
+ that may be used to automatically hibernate the server.
+ </p>
</description>
<section>
@@ -668,9 +713,9 @@ handle_event(_, _, State, Data) ->
<p>
If
<seealso marker="#Module:code_change/4"><c>Module:code_change/4</c></seealso>
- should transform the state to a state with a different
- name it is still regarded as the same state so this
- does not cause a state enter call.
+ should transform the state,
+ it is regarded as a state rename and not a state change,
+ which will not cause a state enter call.
</p>
<p>
Note that a state enter call <em>will</em> be done
@@ -688,12 +733,19 @@ handle_event(_, _, State, Data) ->
<p>
Transition options can be set by
<seealso marker="#type-action">actions</seealso>
- and they modify how the state transition is done:
+ and modify the state transition.
+ Here are the sequence of steps for a state transition:
</p>
<list type="ordered">
<item>
<p>
- If the state changes, is the initial state,
+ If
+ <seealso marker="#type-state_enter">
+ <em>state enter calls</em>
+ </seealso>
+ are used, and either:
+ the state changes, it is the initial state,
+ or one of the callback results
<seealso marker="#type-state_callback_result">
<c>repeat_state</c>
</seealso>
@@ -701,16 +753,21 @@ handle_event(_, _, State, Data) ->
<seealso marker="#type-state_callback_result">
<c>repeat_state_and_data</c>
</seealso>
- is used, and also
- <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>
- are used, the <c>gen_statem</c> calls
+ is used; the <c>gen_statem</c> calls
the new state callback with arguments
- <seealso marker="#type-state_enter">(enter, OldState, Data)</seealso>.
+ <seealso marker="#type-state_enter"><c>(enter, OldState, Data)</c></seealso>.
+ </p>
+ <p>
Any
- <seealso marker="#type-enter_action"><c>actions</c></seealso>
+ <seealso marker="#type-enter_action">actions</seealso>
returned from this call are handled as if they were
- appended to the actions
- returned by the state callback that changed states.
+ appended to the actions
+ returned by the state callback that caused the state entry.
+ </p>
+ <p>
+ Should this state enter call return any of
+ the mentioned <c>repeat_*</c> callback results
+ it is repeated again, with the updated <c>Data</c>.
</p>
</item>
<item>
@@ -739,7 +796,7 @@ handle_event(_, _, State, Data) ->
All events stored with
<seealso marker="#type-action"><c>action()</c></seealso>
<c>next_event</c>
- are inserted to be processed before the other queued events.
+ are inserted to be processed before previously queued events.
</p>
</item>
<item>
@@ -753,7 +810,9 @@ handle_event(_, _, State, Data) ->
delivered to the state machine before any external
not yet received event so if there is such a time-out requested,
the corresponding time-out zero event is enqueued as
- the newest event.
+ the newest received event;
+ that is after already queued events
+ such as inserted and postponed events.
</p>
<p>
Any event cancels an
@@ -791,7 +850,7 @@ handle_event(_, _, State, Data) ->
When a new message arrives the
<seealso marker="#state callback">state callback</seealso>
is called with the corresponding event,
- and we start again from the top of this list.
+ and we start again from the top of this sequence.
</p>
</item>
</list>
@@ -816,13 +875,19 @@ handle_event(_, _, State, Data) ->
<seealso marker="proc_lib#hibernate/3"><c>proc_lib:hibernate/3</c></seealso>
before going into <c>receive</c>
to wait for a new external event.
- If there are enqueued events,
- to prevent receiving any new event, an
- <seealso marker="erts:erlang#garbage_collect/0"><c>erlang:garbage_collect/0</c></seealso>
- is done instead to simulate
- that the <c>gen_statem</c> entered hibernation
- and immediately got awakened by the oldest enqueued event.
</p>
+ <note>
+ <p>
+ If there are enqueued events to process
+ when hibrnation is requested,
+ this is optimized by not hibernating but instead calling
+ <seealso marker="erts:erlang#garbage_collect/0">
+ <c>erlang:garbage_collect/0</c>
+ </seealso>
+ to simulate that the <c>gen_statem</c> entered hibernation
+ and immediately got awakened by an enqueued event.
+ </p>
+ </note>
</desc>
</datatype>
<datatype>
@@ -857,7 +922,7 @@ handle_event(_, _, State, Data) ->
no timer is actually started,
instead the the time-out event is enqueued to ensure
that it gets processed before any not yet
- received external event.
+ received external event, but after already queued events.
</p>
<p>
Note that it is not possible nor needed to cancel this time-out,
@@ -943,7 +1008,9 @@ handle_event(_, _, State, Data) ->
If <c>Abs</c> is <c>true</c> an absolute timer is started,
and if it is <c>false</c> a relative, which is the default.
See
- <seealso marker="erts:erlang#start_timer/4"><c>erlang:start_timer/4</c></seealso>
+ <seealso marker="erts:erlang#start_timer/4">
+ <c>erlang:start_timer/4</c>
+ </seealso>
for details.
</p>
<p>
@@ -969,7 +1036,9 @@ handle_event(_, _, State, Data) ->
</p>
<p>
Actions that set
- <seealso marker="#type-transition_option">transition options</seealso>
+ <seealso marker="#type-transition_option">
+ transition options
+ </seealso>
override any previous of the same type,
so the last in the containing list wins.
For example, the last
@@ -981,7 +1050,9 @@ handle_event(_, _, State, Data) ->
<item>
<p>
Sets the
- <seealso marker="#type-transition_option"><c>transition_option()</c></seealso>
+ <seealso marker="#type-transition_option">
+ <c>transition_option()</c>
+ </seealso>
<seealso marker="#type-postpone"><c>postpone()</c></seealso>
for this state transition.
This action is ignored when returned from
@@ -994,7 +1065,11 @@ handle_event(_, _, State, Data) ->
<tag><c>next_event</c></tag>
<item>
<p>
- Stores the specified <c><anno>EventType</anno></c>
+ This action does not set any
+ <seealso marker="#type-transition_option">
+ <c>transition_option()</c>
+ </seealso>
+ but instead stores the specified <c><anno>EventType</anno></c>
and <c><anno>EventContent</anno></c> for insertion after all
actions have been executed.
</p>
@@ -1066,15 +1141,15 @@ handle_event(_, _, State, Data) ->
<seealso marker="#type-transition_option">transition options</seealso>.
</p>
<taglist>
- <tag><c>Timeout</c></tag>
+ <tag><c>Time</c></tag>
<item>
<p>
- Short for <c>{timeout,Timeout,Timeout}</c>, that is,
+ Short for <c>{timeout,Time,Time}</c>, that is,
the time-out message is the time-out time.
This form exists to make the
<seealso marker="#state callback">state callback</seealso>
- return value <c>{next_state,NextState,NewData,Timeout}</c>
- allowed like for <c>gen_fsm</c>'s
+ return value <c>{next_state,NextState,NewData,Time}</c>
+ allowed like for <c>gen_fsm</c>.
</p>
</item>
<tag><c>timeout</c></tag>
@@ -1126,7 +1201,11 @@ handle_event(_, _, State, Data) ->
<seealso marker="#enter_loop/5"><c>enter_loop/5,6</c></seealso>.
</p>
<p>
- It replies to a caller waiting for a reply in
+ It does not set any
+ <seealso marker="#type-transition_option">
+ <c>transition_option()</c>
+ </seealso>
+ but instead replies to a caller waiting for a reply in
<seealso marker="#call/2"><c>call/2</c></seealso>.
<c><anno>From</anno></c> must be the term from argument
<seealso marker="#type-event_type"><c>{call,<anno>From</anno>}</c></seealso>
@@ -2109,16 +2188,20 @@ init(Args) -> erlang:error(not_implemented, [Args]).</pre>
You may also not change states from this call.
Should you return <c>{next_state,NextState, ...}</c>
with <c>NextState =/= State</c> the <c>gen_statem</c> crashes.
- It is possible to use <c>{repeat_state, ...}</c>,
- <c>{repeat_state_and_data,_}</c> or
- <c>repeat_state_and_data</c> but all of them makes little
+ Note that it is actually allowed to use
+ <c>{repeat_state, NewData, ...}</c> although it makes little
sense since you immediately will be called again with a new
<em>state enter call</em> making this just a weird way
of looping, and there are better ways to loop in Erlang.
+ If you do not update <c>NewData</c> and have some
+ loop termination condition, or if you use
+ <c>{repeat_state_and_data, _}</c> or
+ <c>repeat_state_and_data</c> you have an infinite loop!
You are advised to use <c>{keep_state,...}</c>,
<c>{keep_state_and_data,_}</c> or
- <c>keep_state_and_data</c> since you can not change states
- from a <em>state enter call</em> anyway.
+ <c>keep_state_and_data</c>
+ since changing states from a <em>state enter call</em>
+ is not possible anyway.
</p>
<p>
Note the fact that you can use
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index 9a62d21d34..79dc6ce180 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -93,13 +93,6 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) ->
}).
-%% Are we outside or inside a catch or try/catch?
--type catch_scope() :: 'none'
- | 'after_old_catch'
- | 'after_try'
- | 'wrong_part_of_try'
- | 'try_catch'.
-
%% Define the lint state record.
%% 'called' and 'exports' contain {Line, {Function, Arity}},
%% the other function collections contain {Function, Arity}.
@@ -144,9 +137,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) ->
:: dict:dict(ta(), #typeinfo{}),
exp_types=gb_sets:empty() %Exported types
:: gb_sets:set(ta()),
- in_try_head=false :: boolean(), %In a try head.
- catch_scope = none %Inside/outside try or catch
- :: catch_scope()
+ in_try_head=false :: boolean() %In a try head.
}).
-type lint_state() :: #lint{}.
@@ -233,15 +224,6 @@ format_error({redefine_old_bif_import,{F,A}}) ->
format_error({redefine_bif_import,{F,A}}) ->
io_lib:format("import directive overrides auto-imported BIF ~w/~w~n"
" - use \"-compile({no_auto_import,[~w/~w]}).\" to resolve name clash", [F,A,F,A]);
-format_error({get_stacktrace,wrong_part_of_try}) ->
- "erlang:get_stacktrace/0 used in the wrong part of 'try' expression. "
- "(Use it in the block between 'catch' and 'end'.)";
-format_error({get_stacktrace,after_old_catch}) ->
- "erlang:get_stacktrace/0 used following an old-style 'catch' "
- "may stop working in a future release. (Use it inside 'try'.)";
-format_error({get_stacktrace,after_try}) ->
- "erlang:get_stacktrace/0 used following a 'try' expression "
- "may stop working in a future release. (Use it inside 'try'.)";
format_error({deprecated, MFA, ReplacementMFA, Rel}) ->
io_lib:format("~s is deprecated and will be removed in ~s; use ~s",
[format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]);
@@ -591,10 +573,7 @@ start(File, Opts) ->
false, Opts)},
{missing_spec_all,
bool_option(warn_missing_spec_all, nowarn_missing_spec_all,
- false, Opts)},
- {get_stacktrace,
- bool_option(warn_get_stacktrace, nowarn_get_stacktrace,
- true, Opts)}
+ false, Opts)}
],
Enabled1 = [Category || {Category,true} <- Enabled0],
Enabled = ordsets:from_list(Enabled1),
@@ -1426,7 +1405,7 @@ call_function(Line, F, A, #lint{usage=Usage0,called=Cd,func=Func,file=File}=St)
%% function(Line, Name, Arity, Clauses, State) -> State.
function(Line, Name, Arity, Cs, St0) ->
- St1 = St0#lint{func={Name,Arity},catch_scope=none},
+ St1 = St0#lint{func={Name,Arity}},
St2 = define_function(Line, Name, Arity, St1),
clauses(Cs, St2).
@@ -2367,7 +2346,7 @@ expr({call,Line,F,As}, Vt, St0) ->
expr({'try',Line,Es,Scs,Ccs,As}, Vt, St0) ->
%% Currently, we don't allow any exports because later
%% passes cannot handle exports in combination with 'after'.
- {Evt0,St1} = exprs(Es, Vt, St0#lint{catch_scope=wrong_part_of_try}),
+ {Evt0,St1} = exprs(Es, Vt, St0),
TryLine = {'try',Line},
Uvt = vtunsafe(TryLine, Evt0, Vt),
Evt1 = vtupdate(Uvt, Evt0),
@@ -2379,12 +2358,11 @@ expr({'try',Line,Es,Scs,Ccs,As}, Vt, St0) ->
{Avt0,St} = exprs(As, vtupdate(Evt2, Vt), St2),
Avt1 = vtupdate(vtunsafe(TryLine, Avt0, Vt), Avt0),
Avt = vtmerge(Evt2, Avt1),
- {Avt,St#lint{catch_scope=after_try}};
+ {Avt,St};
expr({'catch',Line,E}, Vt, St0) ->
%% No new variables added, flag new variables as unsafe.
{Evt,St} = expr(E, Vt, St0),
- {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt),
- St#lint{catch_scope=after_old_catch}};
+ {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt),St};
expr({match,_Line,P,E}, Vt, St0) ->
{Evt,St1} = expr(E, Vt, St0),
{Pvt,Bvt,St2} = pattern(P, vtupdate(Evt, Vt), St1),
@@ -3223,7 +3201,7 @@ is_module_dialyzer_option(Option) ->
try_clauses(Scs, Ccs, In, Vt, St0) ->
{Csvt0,St1} = icrt_clauses(Scs, Vt, St0),
- St2 = St1#lint{catch_scope=try_catch,in_try_head=true},
+ St2 = St1#lint{in_try_head=true},
{Csvt1,St3} = icrt_clauses(Ccs, Vt, St2),
Csvt = Csvt0 ++ Csvt1,
UpdVt = icrt_export(Csvt, Vt, In, St3),
@@ -3243,7 +3221,7 @@ icrt_clauses(Cs, In, Vt, St0) ->
icrt_clauses(Cs, Vt, St) ->
mapfoldl(fun (C, St0) -> icrt_clause(C, Vt, St0) end, St, Cs).
-icrt_clause({clause,_Line,H,G,B}, Vt0, #lint{catch_scope=Scope}=St0) ->
+icrt_clause({clause,_Line,H,G,B}, Vt0, St0) ->
Vt1 = taint_stack_var(Vt0, H, St0),
{Hvt,Binvt,St1} = head(H, Vt1, St0),
Vt2 = vtupdate(Hvt, Binvt),
@@ -3251,7 +3229,7 @@ icrt_clause({clause,_Line,H,G,B}, Vt0, #lint{catch_scope=Scope}=St0) ->
{Gvt,St2} = guard(G, vtupdate(Vt3, Vt0), St1#lint{in_try_head=false}),
Vt4 = vtupdate(Gvt, Vt2),
{Bvt,St3} = exprs(B, vtupdate(Vt4, Vt0), St2),
- {vtupdate(Bvt, Vt4),St3#lint{catch_scope=Scope}}.
+ {vtupdate(Bvt, Vt4),St3}.
taint_stack_var(Vt, Pat, #lint{in_try_head=true}) ->
[{tuple,_,[_,_,{var,_,Stk}]}] = Pat,
@@ -3736,8 +3714,7 @@ has_wildcard_field([]) -> false.
check_remote_function(Line, M, F, As, St0) ->
St1 = deprecated_function(Line, M, F, As, St0),
St2 = check_qlc_hrl(Line, M, F, As, St1),
- St3 = check_get_stacktrace(Line, M, F, As, St2),
- format_function(Line, M, F, As, St3).
+ format_function(Line, M, F, As, St2).
%% check_qlc_hrl(Line, ModName, FuncName, [Arg], State) -> State
%% Add warning if qlc:q/1,2 has been called but qlc.hrl has not
@@ -3786,23 +3763,6 @@ deprecated_function(Line, M, F, As, St) ->
St
end.
-check_get_stacktrace(Line, erlang, get_stacktrace, [], St) ->
- case St of
- #lint{catch_scope=none} ->
- St;
- #lint{catch_scope=try_catch} ->
- St;
- #lint{catch_scope=Scope} ->
- case is_warn_enabled(get_stacktrace, St) of
- false ->
- St;
- true ->
- add_warning(Line, {get_stacktrace,Scope}, St)
- end
- end;
-check_get_stacktrace(_, _, _, _, St) ->
- St.
-
-dialyzer({no_match, deprecated_type/5}).
deprecated_type(L, M, N, As, St) ->
diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl
index 7f5d82cc21..f7dc0050b3 100644
--- a/lib/stdlib/src/gen_statem.erl
+++ b/lib/stdlib/src/gen_statem.erl
@@ -143,7 +143,7 @@
timeout_action() |
reply_action().
-type timeout_action() ::
- (Timeout :: event_timeout()) | % {timeout,Timeout}
+ (Time :: event_timeout()) | % {timeout,Time,Time}
{'timeout', % Set the event_timeout option
Time :: event_timeout(), EventContent :: term()} |
{'timeout', % Set the event_timeout option
@@ -327,7 +327,8 @@
%% Type validation functions
-compile(
{inline,
- [callback_mode/1, state_enter/1, from/1, event_type/1]}).
+ [callback_mode/1, state_enter/1,
+ event_type/1, from/1, timeout_event_type/1]}).
%%
callback_mode(CallbackMode) ->
case CallbackMode of
@@ -344,23 +345,26 @@ state_enter(StateEnter) ->
false
end.
%%
-from({Pid,_}) when is_pid(Pid) -> true;
-from(_) -> false.
-%%
-event_type({call,From}) ->
- from(From);
event_type(Type) ->
case Type of
{call,From} -> from(From);
+ %%
cast -> true;
info -> true;
- timeout -> true;
- state_timeout -> true;
internal -> true;
- {timeout,_} -> true;
- _ -> false
+ _ -> timeout_event_type(Type)
+ end.
+%%
+from({Pid,_}) when is_pid(Pid) -> true;
+from(_) -> false.
+%%
+timeout_event_type(Type) ->
+ case Type of
+ timeout -> true;
+ state_timeout -> true;
+ {timeout,_Name} -> true;
+ _ -> false
end.
-
-define(
@@ -1056,6 +1060,15 @@ loop_event_result(
Parent, Debug, S,
Events, Event, NextState, NewData, TransOpts,
[], true);
+ {next_state,_NextState,_NewData} ->
+ terminate(
+ error,
+ {bad_state_enter_return_from_state_function,Result},
+ ?STACKTRACE(), Debug,
+ S#state{
+ state = State, data = Data,
+ hibernate = hibernate_in_trans_opts(TransOpts)},
+ [Event|Events]);
{next_state,State,NewData,Actions} ->
loop_event_actions(
Parent, Debug, S,
@@ -1067,6 +1080,15 @@ loop_event_result(
Parent, Debug, S,
Events, Event, NextState, NewData, TransOpts,
Actions, true);
+ {next_state,_NextState,_NewData,_Actions} ->
+ terminate(
+ error,
+ {bad_state_enter_return_from_state_function,Result},
+ ?STACKTRACE(), Debug,
+ S#state{
+ state = State, data = Data,
+ hibernate = hibernate_in_trans_opts(TransOpts)},
+ [Event|Events]);
%%
{keep_state,NewData} ->
loop_event_actions(
@@ -1160,12 +1182,6 @@ loop_event_result(
[Event|Events])
end.
--compile({inline, [hibernate_in_trans_opts/1]}).
-hibernate_in_trans_opts(false) ->
- (#trans_opts{})#trans_opts.hibernate;
-hibernate_in_trans_opts(#trans_opts{hibernate = Hibernate}) ->
- Hibernate.
-
%% Ensure that Actions are a list
loop_event_actions(
Parent, Debug, S,
@@ -1198,10 +1214,16 @@ loop_event_actions_list(
S#state{
state = NextState,
data = NewerData,
- hibernate = TransOpts#trans_opts.hibernate},
+ hibernate = hibernate_in_trans_opts(TransOpts)},
[Event|Events])
end.
+-compile({inline, [hibernate_in_trans_opts/1]}).
+hibernate_in_trans_opts(false) ->
+ (#trans_opts{})#trans_opts.hibernate;
+hibernate_in_trans_opts(#trans_opts{hibernate = Hibernate}) ->
+ Hibernate.
+
parse_actions(false, Debug, S, Actions) ->
parse_actions(true, Debug, S, Actions, #trans_opts{});
parse_actions(TransOpts, Debug, S, Actions) ->
@@ -1234,6 +1256,11 @@ parse_actions(StateCall, Debug, S, [Action|Actions], TransOpts) ->
parse_actions(
StateCall, Debug, S, Actions,
TransOpts#trans_opts{postpone = true});
+ postpone ->
+ [error,
+ {bad_state_enter_action_from_state_function,Action},
+ ?STACKTRACE(),
+ Debug];
%%
{next_event,Type,Content} ->
parse_actions_next_event(
@@ -1286,7 +1313,8 @@ parse_actions_next_event(
next_events_r = [{Type,Content}|NextEventsR]});
_ ->
[error,
- {bad_action_from_state_function,{next_event,Type,Content}},
+ {bad_state_enter_action_from_state_function,
+ {next_event,Type,Content}},
?STACKTRACE(),
?not_sys_debug]
end;
@@ -1303,22 +1331,23 @@ parse_actions_next_event(
next_events_r = [{Type,Content}|NextEventsR]});
_ ->
[error,
- {bad_action_from_state_function,{next_event,Type,Content}},
+ {bad_state_enter_action_from_state_function,
+ {next_event,Type,Content}},
?STACKTRACE(),
Debug]
end.
parse_actions_timeout(
StateCall, Debug, S, Actions, TransOpts,
- {TimerType,Time,TimerMsg,TimerOpts} = AbsoluteTimeout) ->
+ {TimeoutType,Time,TimerMsg,TimerOpts} = AbsoluteTimeout) ->
%%
- case classify_timer(Time, listify(TimerOpts)) of
+ case classify_timeout(TimeoutType, Time, listify(TimerOpts)) of
absolute ->
parse_actions_timeout_add(
StateCall, Debug, S, Actions,
TransOpts, AbsoluteTimeout);
relative ->
- RelativeTimeout = {TimerType,Time,TimerMsg},
+ RelativeTimeout = {TimeoutType,Time,TimerMsg},
parse_actions_timeout_add(
StateCall, Debug, S, Actions,
TransOpts, RelativeTimeout);
@@ -1330,8 +1359,8 @@ parse_actions_timeout(
end;
parse_actions_timeout(
StateCall, Debug, S, Actions, TransOpts,
- {_,Time,_} = RelativeTimeout) ->
- case classify_timer(Time, []) of
+ {TimeoutType,Time,_} = RelativeTimeout) ->
+ case classify_timeout(TimeoutType, Time, []) of
relative ->
parse_actions_timeout_add(
StateCall, Debug, S, Actions,
@@ -1344,14 +1373,16 @@ parse_actions_timeout(
end;
parse_actions_timeout(
StateCall, Debug, S, Actions, TransOpts,
- Timeout) ->
- case classify_timer(Timeout, []) of
+ Time) ->
+ case classify_timeout(timeout, Time, []) of
relative ->
+ RelativeTimeout = {timeout,Time,Time},
parse_actions_timeout_add(
- StateCall, Debug, S, Actions, TransOpts, Timeout);
+ StateCall, Debug, S, Actions,
+ TransOpts, RelativeTimeout);
badarg ->
[error,
- {bad_action_from_state_function,Timeout},
+ {bad_action_from_state_function,Time},
?STACKTRACE(),
Debug]
end.
@@ -1637,10 +1668,15 @@ call_state_function(
%% -> absolute | relative | badarg
-classify_timer(Time, Opts) ->
- classify_timer(Time, Opts, false).
-%%
-classify_timer(Time, [], Abs) ->
+classify_timeout(TimeoutType, Time, Opts) ->
+ case timeout_event_type(TimeoutType) of
+ true ->
+ classify_time(false, Time, Opts);
+ false ->
+ badarg
+ end.
+
+classify_time(Abs, Time, []) ->
case Abs of
true when
is_integer(Time);
@@ -1653,9 +1689,9 @@ classify_timer(Time, [], Abs) ->
_ ->
badarg
end;
-classify_timer(Time, [{abs,Abs}|Opts], _) when is_boolean(Abs) ->
- classify_timer(Time, Opts, Abs);
-classify_timer(_, Opts, _) when is_list(Opts) ->
+classify_time(_, Time, [{abs,Abs}|Opts]) when is_boolean(Abs) ->
+ classify_time(Abs, Time, Opts);
+classify_time(_, _, Opts) when is_list(Opts) ->
badarg.
%% Stop and start timers as well as create timeout zero events
@@ -1686,15 +1722,7 @@ parse_timers(
{TimerType,Time,TimerMsg} ->
parse_timers(
TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents,
- TimerType, Time, TimerMsg, []);
- 0 ->
- parse_timers(
- TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents,
- timeout, zero, 0, []);
- Time ->
- parse_timers(
- TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents,
- timeout, Time, Time, [])
+ TimerType, Time, TimerMsg, [])
end.
parse_timers(
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 5b488cc677..a17addcc42 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -604,6 +604,9 @@ obsolete_1(filename, find_src, 1) ->
obsolete_1(filename, find_src, 2) ->
{deprecated, "deprecated; use filelib:find_source/3 instead"};
+obsolete_1(erlang, get_stacktrace, 0) ->
+ {deprecated, "deprecated; use the new try/catch syntax for retrieving the stack backtrace"};
+
%% Removed in OTP 20.
obsolete_1(erlang, hash, 2) ->
diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile
index 8490770f3d..ae2e3d0e2b 100644
--- a/lib/stdlib/test/Makefile
+++ b/lib/stdlib/test/Makefile
@@ -95,7 +95,8 @@ MODULES= \
random_unicode_list \
random_iolist \
error_logger_forwarder \
- maps_SUITE
+ maps_SUITE \
+ zzz_SUITE
ERL_FILES= $(MODULES:%=%.erl)
diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index e40f5e9a5d..f9ab83a120 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -66,7 +66,7 @@
otp_11851/1,otp_11879/1,otp_13230/1,
record_errors/1, otp_11879_cont/1,
non_latin1_module/1, otp_14323/1,
- get_stacktrace/1, stacktrace_syntax/1,
+ stacktrace_syntax/1,
otp_14285/1, otp_14378/1]).
suite() ->
@@ -88,7 +88,7 @@ all() ->
maps, maps_type, maps_parallel_match,
otp_11851, otp_11879, otp_13230,
record_errors, otp_11879_cont, non_latin1_module, otp_14323,
- get_stacktrace, stacktrace_syntax, otp_14285, otp_14378].
+ stacktrace_syntax, otp_14285, otp_14378].
groups() ->
[{unused_vars_warn, [],
@@ -4055,82 +4055,6 @@ otp_14323(Config) ->
[] = run(Config, Ts),
ok.
-get_stacktrace(Config) ->
- Ts = [{old_catch,
- <<"t1() ->
- catch error(foo),
- erlang:get_stacktrace().
- ">>,
- [],
- {warnings,[{3,erl_lint,{get_stacktrace,after_old_catch}}]}},
- {nowarn_get_stacktrace,
- <<"t1() ->
- catch error(foo),
- erlang:get_stacktrace().
- ">>,
- [nowarn_get_stacktrace],
- []},
- {try_catch,
- <<"t1(X) ->
- try abs(X) of
- _ ->
- erlang:get_stacktrace()
- catch
- _:_ -> ok
- end.
-
- t2() ->
- try error(foo)
- catch _:_ -> ok
- end,
- erlang:get_stacktrace().
-
- t3() ->
- try error(foo)
- catch _:_ ->
- try error(bar)
- catch _:_ ->
- ok
- end,
- erlang:get_stacktrace()
- end.
-
- no_warning(X) ->
- try
- abs(X)
- catch
- _:_ ->
- erlang:get_stacktrace()
- end.
- ">>,
- [],
- {warnings,[{4,erl_lint,{get_stacktrace,wrong_part_of_try}},
- {13,erl_lint,{get_stacktrace,after_try}},
- {22,erl_lint,{get_stacktrace,after_try}}]}},
- {multiple_catch_clauses,
- <<"maybe_error(Arg) ->
- try 5 / Arg
- catch
- error:badarith ->
- _Stacktrace = erlang:get_stacktrace(),
- try io:nl()
- catch
- error:_ -> io:format('internal error')
- end;
- error:badarg ->
- _Stacktrace = erlang:get_stacktrace(),
- try io:format(qwe)
- catch
- error:_ -> io:format('internal error')
- end
- end.
- ">>,
- [],
- []}],
-
- run(Config, Ts),
- ok.
-
stacktrace_syntax(Config) ->
Ts = [{guard,
<<"t1() ->
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index ec4a16b510..02211fa8df 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -55,6 +55,7 @@
-export([t_repair_continuation/1]).
-export([t_match_spec_run/1]).
-export([t_bucket_disappears/1]).
+-export([t_named_select/1]).
-export([otp_5340/1]).
-export([otp_6338/1]).
-export([otp_6842_select_1000/1]).
@@ -124,6 +125,7 @@ all() ->
t_init_table, t_whitebox, t_delete_all_objects,
t_insert_list, t_test_ms, t_select_delete, t_select_replace,
t_ets_dets, memory, t_select_reverse, t_bucket_disappears,
+ t_named_select,
select_fail, t_insert_new, t_repair_continuation,
otp_5340, otp_6338, otp_6842_select_1000, otp_7665,
otp_8732, meta_wb, grow_shrink, grow_pseudo_deleted,
@@ -205,6 +207,38 @@ t_bucket_disappears_do(Opts) ->
true = ets:delete(abcd),
verify_etsmem(EtsMem).
+%% OTP-21: Test that select/1 fails if named table was deleted and recreated
+%% and succeeds if table was renamed.
+t_named_select(_Config) ->
+ repeat_for_opts(fun t_named_select_do/1).
+
+t_named_select_do(Opts) ->
+ EtsMem = etsmem(),
+ T = t_name_tid_select,
+ ets_new(T, [named_table | Opts]),
+ ets:insert(T, {1,11}),
+ ets:insert(T, {2,22}),
+ ets:insert(T, {3,33}),
+ MS = [{{'$1', 22}, [], ['$1']}],
+ {[2], Cont1} = ets:select(T, MS, 1),
+ ets:delete(T),
+ {'EXIT',{badarg,_}} = (catch ets:select(Cont1)),
+ ets_new(T, [named_table | Opts]),
+ {'EXIT',{badarg,_}} = (catch ets:select(Cont1)),
+
+ true = ets:insert_new(T, {1,22}),
+ true = ets:insert_new(T, {2,22}),
+ true = ets:insert_new(T, {4,22}),
+ {[A,B], Cont2} = ets:select(T, MS, 2),
+ ets:rename(T, abcd),
+ {[C], '$end_of_table'} = ets:select(Cont2),
+ 7 = A + B + C,
+
+ true = ets:delete(abcd),
+ verify_etsmem(EtsMem).
+
+
+
%% Check ets:match_spec_run/2.
t_match_spec_run(Config) when is_list(Config) ->
@@ -700,7 +734,7 @@ whitebox_2(Opts) ->
ets:delete(T2),
ok.
-select_bound_chunk(Config) ->
+select_bound_chunk(_Config) ->
repeat_for_opts(fun select_bound_chunk_do/1, [all_types]).
select_bound_chunk_do(Opts) ->
diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl
index 3f48fe1590..053233df9b 100644
--- a/lib/stdlib/test/gen_statem_SUITE.erl
+++ b/lib/stdlib/test/gen_statem_SUITE.erl
@@ -60,7 +60,8 @@ tcs(start) ->
tcs(stop) ->
[stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10];
tcs(abnormal) ->
- [abnormal1, abnormal1clean, abnormal1dirty, abnormal2];
+ [abnormal1, abnormal1clean, abnormal1dirty,
+ abnormal2, abnormal3, abnormal4];
tcs(sys) ->
[sys1, call_format_status,
error_format_status, terminate_crash_format,
@@ -524,6 +525,43 @@ abnormal2(Config) ->
process_flag(trap_exit, OldFl),
ok = verify_empty_msgq().
+%% Check that bad return actions makes the stm crash. Note that we must
+%% trap exit since we must link to get the real bad_return_ error
+abnormal3(Config) ->
+ OldFl = process_flag(trap_exit, true),
+ {ok,Pid} = gen_statem:start_link(?MODULE, start_arg(Config, []), []),
+
+ %% bad return value in the gen_statem loop
+ {{{bad_action_from_state_function,badaction},_},_} =
+ ?EXPECT_FAILURE(gen_statem:call(Pid, badaction), Reason),
+ receive
+ {'EXIT',Pid,{{bad_action_from_state_function,badaction},_}} -> ok
+ after 5000 ->
+ ct:fail(gen_statem_did_not_die)
+ end,
+
+ process_flag(trap_exit, OldFl),
+ ok = verify_empty_msgq().
+
+%% Check that bad timeout actions makes the stm crash. Note that we must
+%% trap exit since we must link to get the real bad_return_ error
+abnormal4(Config) ->
+ OldFl = process_flag(trap_exit, true),
+ {ok,Pid} = gen_statem:start_link(?MODULE, start_arg(Config, []), []),
+
+ %% bad return value in the gen_statem loop
+ BadTimeout = {badtimeout,4711,ouch},
+ {{{bad_action_from_state_function,BadTimeout},_},_} =
+ ?EXPECT_FAILURE(gen_statem:call(Pid, BadTimeout), Reason),
+ receive
+ {'EXIT',Pid,{{bad_action_from_state_function,BadTimeout},_}} -> ok
+ after 5000 ->
+ ct:fail(gen_statem_did_not_die)
+ end,
+
+ process_flag(trap_exit, OldFl),
+ ok = verify_empty_msgq().
+
shutdown(Config) ->
process_flag(trap_exit, true),
@@ -1806,10 +1844,12 @@ idle(cast, {connect,Pid}, Data) ->
idle({call,From}, connect, Data) ->
gen_statem:reply(From, accept),
{next_state,wfor_conf,Data,infinity}; % NoOp timeout just to test API
-idle(cast, badreturn, _Data) ->
- badreturn;
idle({call,_From}, badreturn, _Data) ->
badreturn;
+idle({call,_From}, badaction, Data) ->
+ {keep_state, Data, [badaction]};
+idle({call,_From}, {badtimeout,_,_} = BadTimeout, Data) ->
+ {keep_state, Data, BadTimeout};
idle({call,From}, {delayed_answer,T}, Data) ->
receive
after T ->
diff --git a/lib/stdlib/test/zzz_SUITE.erl b/lib/stdlib/test/zzz_SUITE.erl
new file mode 100644
index 0000000000..59c7fd7404
--- /dev/null
+++ b/lib/stdlib/test/zzz_SUITE.erl
@@ -0,0 +1,37 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2006-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.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(zzz_SUITE).
+
+%% The sole purpose of this test suite is for things we want to run last
+%% before the VM terminates.
+
+-export([all/0]).
+
+-export([lc_graph/1]).
+
+
+all() ->
+ [lc_graph].
+
+lc_graph(_Config) ->
+ %% Create "lc_graph" file in current working dir
+ %% if lock checker is enabled.
+ erts_debug:lc_graph(),
+ ok.
diff --git a/lib/tools/doc/specs/.gitignore b/lib/tools/doc/specs/.gitignore
new file mode 100644
index 0000000000..322eebcb06
--- /dev/null
+++ b/lib/tools/doc/specs/.gitignore
@@ -0,0 +1 @@
+specs_*.xml
diff --git a/lib/tools/doc/src/Makefile b/lib/tools/doc/src/Makefile
index b554781382..4b663106a0 100644
--- a/lib/tools/doc/src/Makefile
+++ b/lib/tools/doc/src/Makefile
@@ -84,11 +84,20 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html
TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf
+SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml)
+
+TOP_SPECS_FILE = specs.xml
+
# ----------------------------------------------------
# FLAGS
# ----------------------------------------------------
XML_FLAGS +=
+TOOLS_SRC=$(ERL_TOP)/lib/tools/src
+TOOLS_INCLUDE=$(ERL_TOP)/lib/tools/include
+
+SPECS_FLAGS = -I$(TOOLS_SRC) -I$(TOOLS_INCLUDE)
+
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
@@ -113,8 +122,13 @@ clean clean_docs:
rm -rf $(HTMLDIR)/*
rm -f $(MAN3DIR)/*
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
+ rm -f $(SPECDIR)/*
rm -f errs core *~
+# erlang_mode doesn't have erlang source so we generate a dummy file for it.
+$(SPECDIR)/specs_erlang_mode.xml:
+ echo '<module name="erlang_mode"/>' > $(SPECDIR)/specs_erlang_mode.xml
+
# ----------------------------------------------------
# Release Target
# ----------------------------------------------------
diff --git a/lib/tools/doc/src/instrument.xml b/lib/tools/doc/src/instrument.xml
index bb6f9b6100..9fd9332373 100644
--- a/lib/tools/doc/src/instrument.xml
+++ b/lib/tools/doc/src/instrument.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1998</year><year>2016</year>
+ <year>1998</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -41,387 +41,190 @@
<note>
<p>Note that this whole module is experimental, and the representations
used as well as the functionality is likely to change in the future.</p>
- <p>The <c>instrument</c> module interface was slightly changed in
- Erlang/OTP R9C.</p>
</note>
- <p>To start an Erlang runtime system with instrumentation, use the
- <c>+Mi*</c> set of command-line arguments to the <c>erl</c> command (see
- the erts_alloc(3) and erl(1) man pages).</p>
- <p>The basic object of study in the case of memory allocation is a memory
- allocation map. A memory allocation map contains a list of descriptors
- for each allocated memory block. Currently, a descriptor is a 4-tuple</p>
- <pre>
- {TypeNo, Address, Size, PidDesc} </pre>
- <p>where <c>TypeNo</c> is the memory block type number, <c>Address</c>
- is its place in memory, and <c>Size</c> is its size, in bytes.
- <c>PidDesc</c> is either a tuple <c>{X,Y,Z}</c> identifying the
- process which was executing when the block was allocated, or
- <c>undefined</c> if no process was executing. The pid tuple
- <c>{X,Y,Z}</c> can be transformed into a real pid by usage of the
- <c>c:pid/3</c> function.</p>
- <p>Various details about memory allocation:</p>
- <p>Memory blocks are allocated both on the heap segment and on other memory
- segments. This can cause the instrumentation functionality to report
- very large holes. Currently the instrumentation functionality doesn't
- provide any support for distinguishing between holes between memory
- segments, and holes between allocated blocks inside memory segments.
- The current size of the process cannot be obtained from within Erlang,
- but can be seen with one of the system statistics tools, e.g.,
- <c>ps</c> or <c>top</c>. The Solaris utility <c>pmap</c> can be
- useful. It reports currently mapped memory segments. </p>
- <p>Overhead for instrumentation: When the emulator has been started with
- the <seealso marker="erts:erts_alloc#Mim">"+Mim true"</seealso>
- flag, each block is preceded by a 24 bytes large
- header on a 32-bit machine and a 48 bytes large header on a 64-bit
- machine. When the emulator has been started with the
- <seealso marker="erts:erts_alloc#Mis">"+Mis true"</seealso>
- flag, each block is preceded by an 8 bytes large header. These are the header
- sizes used by the Erlang 5.3/OTP R9C emulator. Other versions of the
- emulator may use other header sizes. The function
- <seealso marker="#block_header_size/1">block_header_size/1</seealso>
- can be used for retrieving the header size used for a specific memory
- allocation map. The time overhead for managing the instrumentation
- data is small.</p>
- <p>Sizes presented by the instrumentation functionality are (by the
- emulator) requested sizes, i.e. neither instrumentation headers nor
- headers used by allocators are included.</p>
</description>
+ <datatypes>
+ <datatype>
+ <name name="block_histogram"/>
+ <desc>
+ <p>A histogram of block sizes where each interval's upper bound is
+ twice as high as the one before it.</p>
+ <p>The upper bound of the first interval is provided by the function
+ that returned the histogram, and the last interval has no upper
+ bound.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="allocation_summary"/>
+ <desc>
+ <p>A summary of allocated block sizes (including their headers) grouped
+ by their <c><anno>Origin</anno></c> and <c><anno>Type</anno></c>.</p>
+ <p><c><anno>Origin</anno></c> is generally which NIF or driver that
+ allocated the blocks, or 'system' if it could not be determined.</p>
+ <p><c><anno>Type</anno></c> is the allocation category that the blocks
+ belong to, e.g. <c>db_term</c>, <c>message</c> or <c>binary</c>.</p>
+ <p>If one or more carriers could not be scanned in full without harming
+ the responsiveness of the system, <c><anno>UnscannedSize</anno></c>
+ is the number of bytes that had to be skipped.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="carrier_info_list"/>
+ <desc>
+ <p><c><anno>AllocatorType</anno></c> is the type of the allocator that
+ employs this carrier.</p>
+ <p><c><anno>TotalSize</anno></c> is the total size of the carrier,
+ including its header.</p>
+ <p><c><anno>AllocatedSize</anno></c> is the combined size of the
+ carrier's allocated blocks, including their headers.</p>
+ <p><c><anno>AllocatedCount</anno></c> is the number of allocated
+ blocks in the carrier.</p>
+ <p><c><anno>InPool</anno></c> is whether the carrier is in the
+ migration pool.</p>
+ <p><c><anno>FreeBlocks</anno></c> is a histogram of the free block
+ sizes in the carrier.</p>
+ <p>If the carrier could not be scanned in full without harming the
+ responsiveness of the system, <c><anno>UnscannedSize</anno></c> is
+ the number of bytes that had to be skipped.</p>
+ </desc>
+ </datatype>
+ </datatypes>
<funcs>
+
<func>
- <name>allocator_descr(MemoryData, TypeNo) -> AllocDescr | invalid_type | "unknown"</name>
- <fsummary>Returns a allocator description</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- <v>TypeNo = int()</v>
- <v>AllocDescr = atom() | string()</v>
- </type>
- <desc>
- <p>Returns the allocator description of the allocator that
- manages memory blocks of type number <c>TypeNo</c> used in
- <c>MemoryData</c>.
- Valid <c>TypeNo</c>s are in the range returned by
- <seealso marker="#type_no_range/1">type_no_range/1</seealso> on
- this specific memory allocation map. If <c>TypeNo</c> is an
- invalid integer, <c>invalid_type</c> is returned.</p>
- </desc>
- </func>
- <func>
- <name>block_header_size(MemoryData) -> int()</name>
- <fsummary>Returns the memory block header size used by the emulator that generated the memory allocation map</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- </type>
- <desc>
- <marker id="block_header_size_1"></marker>
- <p>Returns the memory block header size used by the
- emulator that generated the memory allocation map. The block
- header size may differ between different emulators.</p>
- </desc>
- </func>
- <func>
- <name>class_descr(MemoryData, TypeNo) -> ClassDescr | invalid_type | "unknown"</name>
- <fsummary>Returns a allocator description</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- <v>TypeNo = int()</v>
- <v>ClassDescr = atom() | string()</v>
- </type>
- <desc>
- <p>Returns the class description of the class that
- the type number <c>TypeNo</c> used in <c>MemoryData</c> belongs
- to.
- Valid <c>TypeNo</c>s are in the range returned by
- <seealso marker="#type_no_range/1">type_no_range/1</seealso> on
- this specific memory allocation map. If <c>TypeNo</c> is an
- invalid integer, <c>invalid_type</c> is returned.</p>
- </desc>
- </func>
- <func>
- <name>descr(MemoryData) -> DescrMemoryData</name>
- <fsummary>Replace type numbers in memory allocation map with type descriptions</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- <v>DescrMemoryData = {term(), DescrAllocList}</v>
- <v>DescrAllocList = [DescrDesc]</v>
- <v>DescrDesc = {TypeDescr, int(), int(), DescrPidDesc}</v>
- <v>TypeDescr = atom() | string()</v>
- <v>DescrPidDesc = pid() | undefined</v>
- </type>
- <desc>
- <p>Returns a memory allocation map where the type numbers (first
- element of <c>Desc</c>) have been replaced by type descriptions,
- and pid tuples (fourth element of <c>Desc</c>) have been
- replaced by real pids.</p>
- </desc>
- </func>
- <func>
- <name>holes(MemoryData) -> ok</name>
- <fsummary>Print out the sizes of unused memory blocks</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- </type>
- <desc>
- <p>Prints out the size of each hole (i.e., the space between
- allocated blocks) on the terminal. <em>NOTE:</em> Really large holes
- are probably holes between memory segments.
- The memory allocation map has to be sorted (see
- <seealso marker="#sort/1">sort/1</seealso>).</p>
- </desc>
- </func>
- <func>
- <name>mem_limits(MemoryData) -> {Low, High}</name>
- <fsummary>Return lowest and highest memory address used</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- <v>Low = High = int()</v>
- </type>
- <desc>
- <p>Returns a tuple <c>{Low, High}</c> indicating
- the lowest and highest address used.
- The memory allocation map has to be sorted (see
- <seealso marker="#sort/1">sort/1</seealso>).</p>
- </desc>
- </func>
- <func>
- <name>memory_data() -> MemoryData | false</name>
- <fsummary>Return the current memory allocation map</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- </type>
- <desc>
- <p>Returns <c>MemoryData</c> (a the memory allocation map)
- if the emulator has been started with the "<c>+Mim true</c>"
- command-line argument; otherwise, <c>false</c>. <em>NOTE:</em><c>memory_data/0</c> blocks execution of other processes while
- the data is collected. The time it takes to collect the data can
- be substantial.</p>
- </desc>
- </func>
- <func>
- <name>memory_status(StatusType) -> [StatusInfo] | false</name>
- <fsummary>Return current memory allocation status</fsummary>
- <type>
- <v>StatusType = total | allocators | classes | types</v>
- <v>StatusInfo = {About, [Info]}</v>
- <v>About = atom()</v>
- <v>Info = {InfoName, Current, MaxSinceLast, MaxEver}</v>
- <v>InfoName = sizes|blocks</v>
- <v>Current = int()</v>
- <v>MaxSinceLast = int()</v>
- <v>MaxEver = int()</v>
- </type>
- <desc>
- <p>Returns a list of <c>StatusInfo</c> if the emulator has been
- started with the "<c>+Mis true</c>" or "<c>+Mim true</c>"
- command-line argument; otherwise, <c>false</c>. </p>
- <p>See the
- <seealso marker="#read_memory_status/1">read_memory_status/1</seealso>
- function for a description of the <c>StatusInfo</c> term.</p>
- </desc>
- </func>
- <func>
- <name>read_memory_data(File) -> MemoryData | {error, Reason}</name>
- <fsummary>Read memory allocation map</fsummary>
- <type>
- <v>File = string()</v>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- </type>
+ <name name="allocations" arity="0"/>
+ <fsummary>Return a summary of all allocations in the system.</fsummary>
<desc>
- <marker id="read_memory_data_1"></marker>
- <p>Reads a memory allocation map from the file <c>File</c> and
- returns it. The file is assumed to have been created by
- <c>store_memory_data/1</c>. The error codes are the same as for
- <c>file:consult/1</c>.</p>
+ <p>Shorthand for
+ <seealso marker="#allocations/1"><c>allocations(#{})</c>.</seealso></p>
</desc>
</func>
+
<func>
- <name>read_memory_status(File) -> MemoryStatus | {error, Reason}</name>
- <fsummary>Read memory allocation status from a file</fsummary>
- <type>
- <v>File = string()</v>
- <v>MemoryStatus = [{StatusType, [StatusInfo]}]</v>
- <v>StatusType = total | allocators | classes | types</v>
- <v>StatusInfo = {About, [Info]}</v>
- <v>About = atom()</v>
- <v>Info = {InfoName, Current, MaxSinceLast, MaxEver}</v>
- <v>InfoName = sizes|blocks</v>
- <v>Current = int()</v>
- <v>MaxSinceLast = int()</v>
- <v>MaxEver = int()</v>
- </type>
- <desc>
- <marker id="read_memory_status_1"></marker>
- <p>Reads memory allocation status from the file <c>File</c> and
- returns it. The file is assumed to have been created by
- <c>store_memory_status/1</c>. The error codes are the same as
- for <c>file:consult/1</c>.</p>
- <p>When <c>StatusType</c> is <c>allocators</c>, <c>About</c> is
- the allocator that the information is about. When
- <c>StatusType</c> is <c>types</c>, <c>About</c> is
- the memory block type that the information is about. Memory
- block types are not described other than by their name and may
- vary between emulators. When <c>StatusType</c> is <c>classes</c>,
- <c>About</c> is the memory block type class that information is
- presented about. Memory block types are classified after their
- use. Currently the following classes exist:</p>
+ <name name="allocations" arity="1"/>
+ <fsummary>Return a summary of all allocations filtered by allocator type
+ and scheduler id.</fsummary>
+ <desc>
+ <p>Returns a summary of all tagged allocations in the system,
+ optionally filtered by allocator type and scheduler id.</p>
+ <p>Only binaries and allocations made by NIFs and drivers are tagged by
+ default, but this can be configured an a per-allocator basis with the
+ <seealso marker="erts:erts_alloc#M_atags"><c>+M&lt;S&gt;atags</c>
+ </seealso> emulator option.</p>
+ <p>If tagged allocations are not enabled on any of the specified
+ allocator types, the call will fail with
+ <c>{error, not_enabled}</c>.</p>
+ <p>The following options can be used:</p>
<taglist>
- <tag><c>process_data</c></tag>
- <item>Erlang process specific data.</item>
- <tag><c>binary_data</c></tag>
- <item>Erlang binaries.</item>
- <tag><c>atom_data</c></tag>
- <item>Erlang atoms.</item>
- <tag><c>code_data</c></tag>
- <item>Erlang code.</item>
- <tag><c>system_data</c></tag>
- <item>Other data used by the system</item>
+ <tag><c>allocator_types</c></tag>
+ <item>
+ <p>The allocator types that will be searched. Defaults to all
+ <c>alloc_util</c> allocators.</p>
+ </item>
+ <tag><c>scheduler_ids</c></tag>
+ <item>
+ <p>The scheduler ids whose allocator instances will be searched. A
+ scheduler id of 0 will refer to the global instance that is not
+ tied to any particular scheduler. Defaults to all schedulers and
+ the global instance.</p>
+ </item>
+ <tag><c>histogram_start</c></tag>
+ <item>
+ <p>The upper bound of the first interval in the allocated block
+ size histograms. Defaults to 128.</p>
+ </item>
+ <tag><c>histogram_width</c></tag>
+ <item>
+ <p>The number of intervals in the allocated block size histograms.
+ Defaults to 18.</p>
+ </item>
</taglist>
- <p>When <c>InfoName</c> is <c>sizes</c>, <c>Current</c>,
- <c>MaxSinceLast</c>, and <c>MaxEver</c> are, respectively, current
- size, maximum size since last call to
- <c>store_memory_status/1</c> or <c>memory_status/1</c> with the
- specific <c>StatusType</c>, and maximum size since the emulator
- was started. When <c>InfoName</c> is <c>blocks</c>, <c>Current</c>,
- <c>MaxSinceLast</c>, and <c>MaxEver</c> are, respectively, current
- number of blocks, maximum number of blocks since last call to
- <c>store_memory_status/1</c> or <c>memory_status/1</c> with the
- specific <c>StatusType</c>, and maximum number of blocks since the
- emulator was started. </p>
- <p><em>NOTE:</em>A memory block is accounted for at
- "the first level" allocator. E.g. <c>fix_alloc</c> allocates its
- memory pools via <c>ll_alloc</c>. When a <c>fix_alloc</c> block
- is allocated, neither the block nor the pool in which it resides
- are accounted for as memory allocated via <c>ll_alloc</c> even
- though it is.</p>
- </desc>
- </func>
- <func>
- <name>sort(MemoryData) -> MemoryData</name>
- <fsummary>Sort the memory allocation list</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- </type>
- <desc>
- <marker id="sort_1"></marker>
- <p>Sorts a memory allocation map so that the addresses are in
- ascending order.</p>
- </desc>
- </func>
- <func>
- <name>store_memory_data(File) -> true|false</name>
- <fsummary>Store the current memory allocation map on a file</fsummary>
- <type>
- <v>File = string()</v>
- </type>
- <desc>
- <p>Stores the current memory allocation map on the file
- <c>File</c>. Returns <c>true</c> if the emulator has been
- started with the "<c>+Mim true</c>" command-line argument, and
- the map was successfully stored; otherwise, <c>false</c>. The
- contents of the file can later be read using
- <seealso marker="#read_memory_data/1">read_memory_data/1</seealso>.
- <em>NOTE:</em><c>store_memory_data/0</c> blocks execution of
- other processes while the data is collected. The time it takes
- to collect the data can be substantial.</p>
- </desc>
- </func>
- <func>
- <name>store_memory_status(File) -> true|false</name>
- <fsummary>Store the current memory allocation status on a file</fsummary>
- <type>
- <v>File = string()</v>
- </type>
- <desc>
- <p>Stores the current memory status on the file
- <c>File</c>. Returns <c>true</c> if the emulator has been
- started with the "<c>+Mis true</c>", or "<c>+Mim true</c>"
- command-line arguments, and the data was successfully stored;
- otherwise, <c>false</c>. The contents of the file can later be
- read using
- <seealso marker="#read_memory_status/1">read_memory_status/1</seealso>.</p>
- </desc>
- </func>
- <func>
- <name>sum_blocks(MemoryData) -> int()</name>
- <fsummary>Return the total amount of memory used</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- </type>
- <desc>
- <p>Returns the total size of the memory blocks in the list.</p>
+ <p><em>Example:</em></p>
+ <code type="none"><![CDATA[
+> instrument:allocations(#{ histogram_start => 128, histogram_width => 15 }).
+{ok,{128,0,
+ #{udp_inet =>
+ #{driver_event_state => {0,0,0,0,0,0,0,0,0,1,0,0,0,0,0}},
+ system =>
+ #{heap => {0,0,0,0,20,4,2,2,2,3,0,1,0,0,1},
+ db_term => {271,3,1,52,80,1,0,0,0,0,0,0,0,0,0},
+ code => {0,0,0,5,3,6,11,22,19,20,10,2,1,0,0},
+ binary => {18,0,0,0,7,0,0,1,0,0,0,0,0,0,0},
+ message => {0,40,78,2,2,0,0,0,0,0,0,0,0,0,0},
+ ... }
+ spawn_forker =>
+ #{driver_select_data_state =>
+ {1,0,0,0,0,0,0,0,0,0,0,0,0,0,0}},
+ ram_file_drv => #{drv_binary => {0,0,0,0,0,0,1,0,0,0,0,0,0,0,0}},
+ prim_file =>
+ #{process_specific_data => {2,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
+ nif_trap_export_entry => {0,4,0,0,0,0,0,0,0,0,0,0,0,0,0},
+ monitor_extended => {0,1,0,0,0,0,0,0,0,0,0,0,0,0,0},
+ drv_binary => {0,0,0,0,0,0,1,0,3,5,0,0,0,1,0},
+ binary => {0,4,0,0,0,0,0,0,0,0,0,0,0,0,0}},
+ prim_buffer =>
+ #{nif_internal => {0,4,0,0,0,0,0,0,0,0,0,0,0,0,0},
+ binary => {0,4,0,0,0,0,0,0,0,0,0,0,0,0,0}}}}}
+ ]]></code>
</desc>
</func>
+
<func>
- <name>type_descr(MemoryData, TypeNo) -> TypeDescr | invalid_type</name>
- <fsummary>Returns a type description</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- <v>TypeNo = int()</v>
- <v>TypeDescr = atom() | string()</v>
- </type>
+ <name name="carriers" arity="0"/>
+ <fsummary>Return a list of all carriers in the system.</fsummary>
<desc>
- <p>Returns the type description of a type number used in
- <c>MemoryData</c>.
- Valid <c>TypeNo</c>s are in the range returned by
- <seealso marker="#type_no_range/1">type_no_range/1</seealso> on
- this specific memory allocation map. If <c>TypeNo</c> is an
- invalid integer, <c>invalid_type</c> is returned.</p>
+ <p>Shorthand for
+ <seealso marker="#carriers/1"><c>carriers(#{})</c>.</seealso></p>
</desc>
</func>
+
<func>
- <name>type_no_range(MemoryData) -> {Min, Max}</name>
- <fsummary>Returns the memory block type numbers</fsummary>
- <type>
- <v>MemoryData = {term(), AllocList}</v>
- <v>AllocList = [Desc]</v>
- <v>Desc = {int(), int(), int(), PidDesc}</v>
- <v>PidDesc = {int(), int(), int()} | undefined</v>
- <v>Min = int()</v>
- <v>Max = int()</v>
- </type>
+ <name name="carriers" arity="1"/>
+ <fsummary>Return a list of all carriers filtered by allocator type and
+ scheduler id.</fsummary>
<desc>
- <marker id="type_no_range_1"></marker>
- <p>Returns the memory block type number range used in
- <c>MemoryData</c>. When the memory allocation map was generated
- by an Erlang 5.3/OTP R9C or newer emulator, all integers <c>T</c>
- that satisfy <c>Min</c> &lt;= <c>T</c> &lt;= <c>Max</c> are
- valid type numbers. When the memory allocation map was generated
- by a pre Erlang 5.3/OTP R9C emulator, all integers in the
- range are <em>not</em> valid type numbers.</p>
+ <p>Returns a summary of all carriers in the system, optionally filtered
+ by allocator type and scheduler id.</p>
+ <p>If the specified allocator types are not enabled, the call will fail
+ with <c>{error, not_enabled}</c>.</p>
+ <p>The following options can be used:</p>
+ <taglist>
+ <tag><c>allocator_types</c></tag>
+ <item>
+ <p>The allocator types that will be searched. Defaults to all
+ <c>alloc_util</c> allocators.</p>
+ </item>
+ <tag><c>scheduler_ids</c></tag>
+ <item>
+ <p>The scheduler ids whose allocator instances will be searched. A
+ scheduler id of 0 will refer to the global instance that is not
+ tied to any particular scheduler. Defaults to all schedulers and
+ the global instance.</p>
+ </item>
+ <tag><c>histogram_start</c></tag>
+ <item>
+ <p>The upper bound of the first interval in the free block size
+ histograms. Defaults to 512.</p>
+ </item>
+ <tag><c>histogram_width</c></tag>
+ <item>
+ <p>The number of intervals in the free block size histograms.
+ Defaults to 14.</p>
+ </item>
+ </taglist>
+ <p><em>Example:</em></p>
+ <code type="none"><![CDATA[
+> instrument:carriers(#{ histogram_start => 512, histogram_width => 8 }).
+{ok,{512,
+ [{ll_alloc,1048576,0,1048344,71,false,{0,0,0,0,0,0,0,0}},
+ {binary_alloc,1048576,0,324640,13,false,{3,0,0,1,0,0,0,2}},
+ {eheap_alloc,2097152,0,1037200,45,false,{2,1,1,3,4,3,2,2}},
+ {fix_alloc,32768,0,29544,82,false,{22,0,0,0,0,0,0,0}},
+ {...}|...]}}
+ ]]></code>
</desc>
</func>
+
</funcs>
<section>
diff --git a/lib/tools/doc/src/specs.xml b/lib/tools/doc/src/specs.xml
new file mode 100644
index 0000000000..0b5b7b171c
--- /dev/null
+++ b/lib/tools/doc/src/specs.xml
@@ -0,0 +1,12 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<specs xmlns:xi="http://www.w3.org/2001/XInclude">
+ <xi:include href="../specs/specs_fprof.xml"/>
+ <xi:include href="../specs/specs_make.xml"/>
+ <xi:include href="../specs/specs_lcnt.xml"/>
+ <xi:include href="../specs/specs_eprof.xml"/>
+ <xi:include href="../specs/specs_tags.xml"/>
+ <xi:include href="../specs/specs_cover.xml"/>
+ <xi:include href="../specs/specs_xref.xml"/>
+ <xi:include href="../specs/specs_instrument.xml"/>
+ <xi:include href="../specs/specs_erlang_mode.xml"/>
+</specs>
diff --git a/lib/tools/src/instrument.erl b/lib/tools/src/instrument.erl
index 055f4a7afb..0203fefe13 100644
--- a/lib/tools/src/instrument.erl
+++ b/lib/tools/src/instrument.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1998-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.
@@ -19,410 +19,140 @@
%%
-module(instrument).
--export([holes/1, mem_limits/1, memory_data/0, read_memory_data/1,
- sort/1, store_memory_data/1, sum_blocks/1,
- descr/1, type_descr/2, allocator_descr/2, class_descr/2,
- type_no_range/1, block_header_size/1, store_memory_status/1,
- read_memory_status/1, memory_status/1]).
-
-
--define(OLD_INFO_SIZE, 32). %% (sizeof(mem_link) in pre R9C utils.c)
-
--define(IHMARKER(H), element(1, H)).
--define(VSN(H), element(2, H)).
--define(INFO_SIZE(H), element(3, H)).
--define(TYPEMAP(H), element(4, H)).
-
--define(IHDR(H), is_tuple(H), ?IHMARKER(H) =:= instr_hdr).
--define(IHDRVSN(H, V), ?IHDR(H), ?VSN(H) =:= V).
-
-memory_data() ->
- case catch erlang:system_info(allocated) of
- {'EXIT',{Error,_}} ->
- erlang:error(Error, []);
- {'EXIT',Error} ->
- erlang:error(Error, []);
- Res ->
- Res
+-export([allocations/0, allocations/1,
+ carriers/0, carriers/1]).
+
+-type block_histogram() :: tuple().
+
+-type allocation_summary() ::
+ {HistogramStart :: non_neg_integer(),
+ UnscannedSize :: non_neg_integer(),
+ Allocations :: #{ Origin :: atom() =>
+ #{ Type :: atom() => block_histogram() }}}.
+
+-spec allocations() -> {ok, Result} | {error, Reason} when
+ Result :: allocation_summary(),
+ Reason :: not_enabled.
+allocations() ->
+ allocations(#{}).
+
+-spec allocations(Options) -> {ok, Result} | {error, Reason} when
+ Result :: allocation_summary(),
+ Reason :: not_enabled,
+ Options :: #{ scheduler_ids => list(non_neg_integer()),
+ allocator_types => list(atom()),
+ histogram_start => pos_integer(),
+ histogram_width => pos_integer() }.
+allocations(Options) ->
+ Ref = make_ref(),
+
+ Defaults = #{ scheduler_ids => lists:seq(0, erlang:system_info(schedulers)),
+ allocator_types => erlang:system_info(alloc_util_allocators),
+ histogram_start => 128,
+ histogram_width => 18 },
+
+ {HistStart, MsgCount} =
+ dispatch_gather(maps:merge(Defaults, Options), Ref,
+ fun erts_internal:gather_alloc_histograms/1),
+
+ alloc_hist_receive(HistStart, MsgCount, Ref).
+
+alloc_hist_receive(_HistStart, 0, _Ref) ->
+ {error, not_enabled};
+alloc_hist_receive(HistStart, MsgCount, Ref) when MsgCount > 0 ->
+ {Unscanned, Histograms} = alloc_hist_receive_1(MsgCount, Ref, 0, #{}),
+ {ok, {HistStart, Unscanned, Histograms}}.
+
+alloc_hist_receive_1(0, _Ref, Unscanned, Result) ->
+ {Unscanned, Result};
+alloc_hist_receive_1(MsgCount, Ref, Unscanned0, Result0) ->
+ receive
+ {Ref, Unscanned, Tags} ->
+ Result = lists:foldl(fun alloc_hist_fold_result/2, Result0, Tags),
+ alloc_hist_receive_1(MsgCount - 1, Ref, Unscanned0 + Unscanned, Result)
end.
-store_memory_data(File) ->
- case catch erlang:system_info({allocated, File}) of
- {'EXIT',{Error,_}} ->
- erlang:error(Error, [File]);
- {'EXIT',Error} ->
- erlang:error(Error, [File]);
- Res ->
- Res
+alloc_hist_fold_result({Id, Type, BlockHist}, Result0) ->
+ IdAllocs0 = maps:get(Id, Result0, #{}),
+ MergedHists = case maps:find(Type, IdAllocs0) of
+ {ok, PrevHist} ->
+ alloc_hist_merge_hist(tuple_size(BlockHist),
+ BlockHist,
+ PrevHist);
+ error ->
+ BlockHist
+ end,
+ IdAllocs = IdAllocs0#{ Type => MergedHists },
+ Result0#{ Id => IdAllocs }.
+
+alloc_hist_merge_hist(0, A, _B) ->
+ A;
+alloc_hist_merge_hist(Index, A, B) ->
+ Merged = setelement(Index, A, element(Index, A) + element(Index, B)),
+ alloc_hist_merge_hist(Index - 1, Merged, B).
+
+-type carrier_info_list() ::
+ {HistogramStart :: non_neg_integer(),
+ Carriers :: [{AllocatorType :: atom(),
+ TotalSize :: non_neg_integer(),
+ UnscannedSize :: non_neg_integer(),
+ AllocatedSize :: non_neg_integer(),
+ AllocatedCount :: non_neg_integer(),
+ InPool :: boolean(),
+ FreeBlocks :: block_histogram()}]}.
+
+-spec carriers() -> {ok, Result} | {error, Reason} when
+ Result :: carrier_info_list(),
+ Reason :: not_enabled.
+carriers() ->
+ carriers(#{}).
+
+-spec carriers(Options) -> {ok, Result} | {error, Reason} when
+ Result :: carrier_info_list(),
+ Reason :: not_enabled,
+ Options :: #{ scheduler_ids => list(non_neg_integer()),
+ allocator_types => list(atom()),
+ histogram_start => pos_integer(),
+ histogram_width => pos_integer() }.
+carriers(Options) ->
+ Ref = make_ref(),
+
+ Defaults = #{ scheduler_ids => lists:seq(0, erlang:system_info(schedulers)),
+ allocator_types => erlang:system_info(alloc_util_allocators),
+ histogram_start => 512,
+ histogram_width => 14 },
+
+ {HistStart, MsgCount} =
+ dispatch_gather(maps:merge(Defaults, Options), Ref,
+ fun erts_internal:gather_carrier_info/1),
+
+ carrier_info_receive(HistStart, MsgCount, Ref).
+
+carrier_info_receive(_HistStart, 0, _Ref) ->
+ {error, not_enabled};
+carrier_info_receive(HistStart, MsgCount, Ref) ->
+ {ok, {HistStart, carrier_info_receive_1(MsgCount, Ref, [])}}.
+
+carrier_info_receive_1(0, _Ref, Result) ->
+ lists:flatten(Result);
+carrier_info_receive_1(MsgCount, Ref, Result0) ->
+ receive
+ {Ref, Carriers} ->
+ carrier_info_receive_1(MsgCount - 1, Ref, [Carriers, Result0])
end.
-memory_status(Type) when is_atom(Type) ->
- case catch erlang:system_info({allocated, status, Type}) of
- {'EXIT',{Error,_}} ->
- erlang:error(Error, [Type]);
- {'EXIT',Error} ->
- erlang:error(Error, [Type]);
- Res ->
- Res
- end;
-memory_status(Type) ->
- erlang:error(badarg, [Type]).
-
-store_memory_status(File) when is_list(File) ->
- case catch erlang:system_info({allocated, status, File}) of
- {'EXIT',{Error,_}} ->
- erlang:error(Error, [File]);
- {'EXIT',Error} ->
- erlang:error(Error, [File]);
- Res ->
- Res
- end;
-store_memory_status(File) ->
- erlang:error(badarg, [File]).
-
-read_memory_data(File) when is_list(File) ->
- case file:consult(File) of
- {ok, [Hdr|MD]} when ?IHDR(Hdr) ->
- {Hdr, MD};
- {ok, [{T,A,S,undefined}|_] = MD} when is_integer(T),
- is_integer(A),
- is_integer(S) ->
- {{instr_hdr, 1, ?OLD_INFO_SIZE}, MD};
- {ok, [{T,A,S,{X,Y,Z}}|_] = MD} when is_integer(T),
- is_integer(A),
- is_integer(S),
- is_integer(X),
- is_integer(Y),
- is_integer(Z) ->
- {{instr_hdr, 1, ?OLD_INFO_SIZE}, MD};
- {ok, _} ->
- {error, eio};
- Error ->
- Error
- end;
-read_memory_data(File) ->
- erlang:error(badarg, [File]).
-
-read_memory_status(File) when is_list(File) ->
- case file:consult(File) of
- {ok, [{instr_vsn, _}|Stat]} ->
- Stat;
- {ok, _} ->
- {error, eio};
- Error ->
- Error
- end;
-read_memory_status(File) ->
- erlang:error(badarg, [File]).
-
-holes({Hdr, MD}) when ?IHDR(Hdr) ->
- check_holes(?INFO_SIZE(Hdr), MD).
-
-check_holes(_ISz, []) ->
- ok;
-check_holes(ISz, [E | L]) ->
- check_holes(ISz, E, L).
-
-check_holes(_ISz, _E1, []) ->
- io:format("~n");
-check_holes(ISz, E1, [E2 | Rest]) ->
- check_hole(ISz, E1, E2),
- check_holes(ISz, E2, Rest).
-
-check_hole(ISz, {_,P1,S1,_}, {_,P2,_,_}) ->
- End = P1+S1,
- Hole = P2 - (End + ISz),
- if
- Hole =< 7 ->
- ok;
- true ->
- io:format(" ~p", [Hole])
- end.
-
-sum_blocks({Hdr, L}) when ?IHDR(Hdr) ->
- lists:foldl(fun({_,_,S,_}, Sum) -> S+Sum end,
- 0,
- L).
-
-mem_limits({Hdr, L}) when ?IHDR(Hdr) ->
- {_, P1, _, _} = hd(L),
- {_, P2, S2, _} = lists:last(L),
- {P1, P2+S2}.
-
-sort({Hdr, MD}) when ?IHDR(Hdr) ->
- {Hdr, lists:keysort(2, MD)}.
-
-descr({Hdr, MD} = ID) when ?IHDR(Hdr) ->
- {Hdr, lists:map(fun ({TN, Addr, Sz, {0, N, S}}) ->
- {type_descr(ID, TN),
- Addr,
- Sz,
- list_to_pid("<0."
- ++ integer_to_list(N)
- ++ "."
- ++ integer_to_list(S)
- ++ ">")};
- ({TN, Addr, Sz, undefined}) ->
- {type_descr(ID, TN),
- Addr,
- Sz,
- undefined}
- end,
- MD)}.
-
-block_header_size({Hdr, _}) when ?IHDR(Hdr) ->
- ?INFO_SIZE(Hdr).
-
-type_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 2),
- is_integer(TypeNo) ->
- case catch element(1, element(TypeNo, ?TYPEMAP(Hdr))) of
- {'EXIT', _} -> invalid_type;
- Type -> Type
- end;
-type_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 1),
- is_integer(TypeNo) ->
- type_string(TypeNo).
-
-
-allocator_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 2), is_integer(TypeNo) ->
- case catch element(2, element(TypeNo, ?TYPEMAP(Hdr))) of
- {'EXIT', _} -> invalid_type;
- Type -> Type
- end;
-allocator_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 1), is_integer(TypeNo) ->
- "unknown".
-
-class_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 2), is_integer(TypeNo) ->
- case catch element(3, element(TypeNo, ?TYPEMAP(Hdr))) of
- {'EXIT', _} -> invalid_type;
- Type -> Type
- end;
-class_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 1), is_integer(TypeNo) ->
- "unknown".
-
-type_no_range({Hdr, _}) when ?IHDRVSN(Hdr, 2) ->
- {1, tuple_size(?TYPEMAP(Hdr))};
-type_no_range({Hdr, _}) when ?IHDRVSN(Hdr, 1) ->
- {-1, 1000}.
-
-type_string(-1) ->
- "unknown";
-type_string(1) ->
- "atom text";
-type_string(11) ->
- "atom desc";
-type_string(2) ->
- "bignum (big_to_list)";
-type_string(31) ->
- "fixalloc";
-type_string(32) ->
- "unknown fixalloc block";
-type_string(33) ->
- "message buffer";
-type_string(34) ->
- "message link";
-type_string(4) ->
- "estack";
-type_string(40) ->
- "db table vec";
-type_string(41) ->
- "db tree select buffer";
-type_string(43) ->
- "db hash select buffer";
-type_string(44) ->
- "db hash select list";
-type_string(45) ->
- "db match prog stack";
-type_string(46) ->
- "db match prog heap data";
-type_string(47) ->
- "db temp buffer";
-type_string(48) ->
- "db error";
-type_string(49) ->
- "db error info";
-type_string(50) ->
- "db trans tab";
-type_string(51) ->
- "db segment";
-type_string(52) ->
- "db term";
-type_string(53) ->
- "db add_counter";
-type_string(54) ->
- "db segment table";
-type_string(55) ->
- "db table (fix)";
-type_string(56) ->
- "db bindings";
-type_string(57) ->
- "db counter";
-type_string(58) ->
- "db trace vec";
-type_string(59) ->
- "db fixed deletion";
-type_string(60) ->
- "binary (external.c)";
-type_string(61) ->
- "binary";
-type_string(62) ->
- "procbin (fix)";
-type_string(70) ->
- "driver alloc (io.c)";
-type_string(71) ->
- "binary (io.c)";
-type_string(72) ->
- "binary vec (io.c)";
-type_string(73) ->
- "binary vec 2 (io.c)";
-type_string(74) ->
- "io vec (io.c)";
-type_string(75) ->
- "io vec 2 (io.c)";
-type_string(76) ->
- "temp io buffer (io.c)";
-type_string(77) ->
- "temp io buffer 2 (io.c)";
-type_string(78) ->
- "line buffer (io.c)";
-type_string(8) ->
- "heap";
-type_string(801) ->
- "heap (1)";
-type_string(802) ->
- "heap (2)";
-type_string(803) ->
- "heap (3)";
-type_string(804) ->
- "heap (4)";
-type_string(805) ->
- "heap (5)";
-type_string(821) ->
- "heap fragment (1)";
-type_string(822) ->
- "heap fragment (2)";
-type_string(830) ->
- "sequential store buffer (for vectors)";
-type_string(91) ->
- "process table";
-type_string(92) ->
- "process desc";
-type_string(110) ->
- "hash buckets";
-type_string(111) ->
- "hash table";
-type_string(120) ->
- "index init";
-type_string(121) ->
- "index table";
-type_string(130) ->
- "temp buffer";
-type_string(140) ->
- "timer wheel";
-type_string(150) ->
- "distribution cache";
-type_string(151) ->
- "dmem";
-type_string(152) ->
- "distribution table";
-type_string(153) ->
- "distribution table buckets";
-type_string(154) ->
- "distribution table entry";
-type_string(155) ->
- "node table";
-type_string(156) ->
- "node table buckets";
-type_string(157) ->
- "node table entry";
-type_string(160) ->
- "port table";
-type_string(161) ->
- "driver entry";
-type_string(162) ->
- "port setup";
-type_string(163) ->
- "port wait";
-type_string(170) ->
- "module";
-type_string(171) ->
- "fundef";
-type_string(180) ->
- "file table";
-type_string(181) ->
- "driver table";
-type_string(182) ->
- "poll struct";
-type_string(190) ->
- "inet driver";
-type_string(200) ->
- "efile driver";
-type_string(210) ->
- "gc root set";
-type_string(220) ->
- "breakpoint data";
-type_string(230) ->
- "async queue";
-type_string(231) ->
- "async (exit)";
-type_string(232) ->
- "async (driver)";
-type_string(240) ->
- "bits buffer";
-type_string(241) ->
- "bits temp buffer";
-type_string(250) ->
- "modules (loader)";
-type_string(251) ->
- "code (loader)";
-type_string(252) ->
- "atom tab (loader)";
-type_string(253) ->
- "import tab (loader)";
-type_string(254) ->
- "export tab (loader)";
-type_string(255) ->
- "lable tab (loader)";
-type_string(256) ->
- "gen op (loader)";
-type_string(257) ->
- "gen op args (loader)";
-type_string(258) ->
- "gen op args 2 (loader)";
-type_string(259) ->
- "gen op args 3 (loader)";
-type_string(260) ->
- "lambdas (loader)";
-type_string(261) ->
- "temp int buffer (loader)";
-type_string(262) ->
- "temp heap (loader)";
-type_string(280) ->
- "dist ctrl msg buffer";
-type_string(281) ->
- "dist_buf";
-type_string(290) ->
- "call trace buffer";
-type_string(300) ->
- "bif timer rec";
-type_string(310) ->
- "argument registers";
-type_string(320) ->
- "compressed binary temp buffer";
-type_string(330) ->
- "term_to_binary temp buffer";
-type_string(340) ->
- "proc dict";
-type_string(350) ->
- "trace to port temp buffer";
-type_string(360) ->
- "lists subtract temp buffer";
-type_string(370) ->
- "link (lh)";
-type_string(380) ->
- "port call buffer";
-type_string(400) ->
- "definite_alloc block";
-type_string(_) ->
- invalid_type.
-
+dispatch_gather(#{ allocator_types := AllocatorTypes,
+ scheduler_ids := SchedulerIds,
+ histogram_start := HistStart,
+ histogram_width := HistWidth }, Ref, Gather)
+ when is_list(AllocatorTypes),
+ is_list(SchedulerIds),
+ HistStart >= 1, HistStart =< (1 bsl 28),
+ HistWidth >= 1, HistWidth =< 32 ->
+ MsgCount = lists:sum(
+ [Gather({AllocatorType, SchedId, HistWidth, HistStart, Ref}) ||
+ SchedId <- SchedulerIds,
+ AllocatorType <- AllocatorTypes]),
+ {HistStart, MsgCount};
+dispatch_gather(_, _, _) ->
+ error(badarg).
diff --git a/lib/tools/test/instrument_SUITE.erl b/lib/tools/test/instrument_SUITE.erl
index f37d28c277..8c521b2e1a 100644
--- a/lib/tools/test/instrument_SUITE.erl
+++ b/lib/tools/test/instrument_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1998-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.
@@ -20,89 +20,274 @@
-module(instrument_SUITE).
-export([all/0, suite/0]).
--export(['+Mim true'/1, '+Mis true'/1]).
+
+-export([allocations_enabled/1, allocations_disabled/1, allocations_ramv/1,
+ carriers_enabled/1, carriers_disabled/1]).
+
+-export([test_all_alloc/2, test_per_alloc/2, test_format/3, test_abort/1,
+ generate_test_blocks/0, churn_memory/0]).
-include_lib("common_test/include/ct.hrl").
suite() ->
[{ct_hooks,[ts_install_cth]},
- {timetrap,{seconds,10}}].
+ {timetrap,{minutes,5}}].
all() ->
- ['+Mim true', '+Mis true'].
-
-
-%% Check that memory data can be read and processed
-'+Mim true'(Config) when is_list(Config) ->
- Node = start_slave("+Mim true"),
- MD = rpc:call(Node, instrument, memory_data, []),
- [{total,[{sizes,S1,S2,S3},{blocks,B1,B2,B3}]}]
- = rpc:call(Node, instrument, memory_status, [total]),
- stop_slave(Node),
- true = S1 =< S2,
- true = S2 =< S3,
- true = B1 =< B2,
- true = B2 =< B3,
- MDS = instrument:sort(MD),
- {Low, High} = instrument:mem_limits(MDS),
- true = Low < High,
- {_, AL} = MDS,
- SumBlocks = instrument:sum_blocks(MD),
- case SumBlocks of
- N when is_integer(N) ->
- N = lists:foldl(fun ({_,_,Size,_}, Sum) ->
- Size+Sum
- end, 0, AL),
- true = N =< S3;
- Other ->
- ct:fail(Other)
+ [allocations_enabled, allocations_disabled, allocations_ramv,
+ carriers_enabled, carriers_disabled].
+
+-define(GENERATED_SBC_BLOCK_COUNT, 1000).
+-define(GENERATED_MBC_BLOCK_COUNT, ?GENERATED_SBC_BLOCK_COUNT).
+
+-define(GENERATED_BLOCK_COUNT, (?GENERATED_SBC_BLOCK_COUNT +
+ ?GENERATED_MBC_BLOCK_COUNT)).
+-define(GENERATED_CARRIER_COUNT, ?GENERATED_SBC_BLOCK_COUNT).
+
+allocations_test(Args, Plain, PerAlloc) ->
+ run_test(Args, fun(Node) ->
+ ok = rpc:call(Node, ?MODULE, test_all_alloc,
+ [fun instrument:allocations/0, Plain]),
+ ok = rpc:call(Node, ?MODULE, test_per_alloc,
+ [fun instrument:allocations/1, PerAlloc]),
+ ok = rpc:call(Node, ?MODULE, test_format,
+ [#{ histogram_start => 512,
+ histogram_width => 4 },
+ fun instrument:allocations/1,
+ fun verify_allocations_output/2]),
+ ok = rpc:call(Node, ?MODULE, test_abort,
+ [fun erts_internal:gather_alloc_histograms/1])
+ end).
+
+allocations_enabled(Config) when is_list(Config) ->
+ allocations_test("+Meamax +Muatags true",
+ fun verify_allocations_enabled/1,
+ fun verify_allocations_enabled/2).
+
+allocations_disabled(Config) when is_list(Config) ->
+ allocations_test("+Meamax +Muatags false",
+ fun verify_allocations_disabled/1,
+ fun verify_allocations_disabled/2).
+
+allocations_ramv(Config) when is_list(Config) ->
+ allocations_test("+Meamax +Muatags true +Muramv true",
+ fun verify_allocations_enabled/1,
+ fun verify_allocations_enabled/2).
+
+verify_allocations_disabled(_AllocType, Result) ->
+ verify_allocations_disabled(Result).
+
+verify_allocations_disabled({error, not_enabled}) ->
+ ok.
+
+%% Skip types that have unstable results or are unaffected by +Muatags
+verify_allocations_enabled(literal_alloc, _Result) -> ok;
+verify_allocations_enabled(exec_alloc, _Result) -> ok;
+verify_allocations_enabled(temp_alloc, _Result) -> ok;
+verify_allocations_enabled(sl_alloc, _Result) -> ok;
+verify_allocations_enabled(_AllocType, Result) ->
+ verify_allocations_enabled(Result).
+
+verify_allocations_enabled({ok, {_HistStart, _UnscannedBytes, Allocs}}) ->
+ true = Allocs =/= #{}.
+
+verify_allocations_output(#{ histogram_start := HistStart,
+ histogram_width := HistWidth },
+ {ok, {HistStart, _UnscannedBytes, ByOrigin}}) ->
+ AllHistograms = lists:flatten([maps:values(ByType) ||
+ ByType <- maps:values(ByOrigin)]),
+
+ %% Do the histograms look alright?
+ HistogramSet = ordsets:from_list(AllHistograms),
+ Verified = [H || H <- HistogramSet,
+ tuple_size(H) =:= HistWidth,
+ hist_sum(H) >= 1],
+ [] = ordsets:subtract(HistogramSet, Verified),
+
+ %% Do we have at least as many blocks as we've generated?
+ BlockCount = lists:foldl(fun(Hist, Acc) ->
+ hist_sum(Hist) + Acc
+ end, 0, AllHistograms),
+ GenTotalBlockCount = ?GENERATED_BLOCK_COUNT,
+ GenSBCBlockCount = ?GENERATED_SBC_BLOCK_COUNT,
+ if
+ BlockCount < GenSBCBlockCount ->
+ ct:fail("Found ~p blocks, required at least ~p (SB)." ,
+ [BlockCount, GenSBCBlockCount]);
+ BlockCount >= GenTotalBlockCount ->
+ ct:pal("Found ~p blocks, expected at least ~p (SB + MB).",
+ [BlockCount, GenTotalBlockCount]);
+ BlockCount < GenTotalBlockCount ->
+ ct:pal("Found ~p blocks, expected at least ~p (SB + MB), but this "
+ "may be due to MBCs being skipped if they're about to be "
+ "scanned just as they're fetched from the carrier pool.",
+ [BlockCount, GenTotalBlockCount])
+ end,
+
+ ok;
+verify_allocations_output(#{}, {error, not_enabled}) ->
+ ok.
+
+%% %% %% %% %% %%
+
+carriers_test(Args, Plain, PerAlloc) ->
+ run_test(Args, fun(Node) ->
+ ok = rpc:call(Node, ?MODULE, test_all_alloc,
+ [fun instrument:carriers/0, Plain]),
+ ok = rpc:call(Node, ?MODULE, test_per_alloc,
+ [fun instrument:carriers/1, PerAlloc]),
+ ok = rpc:call(Node, ?MODULE, test_format,
+ [#{ histogram_start => 1024,
+ histogram_width => 4 },
+ fun instrument:carriers/1,
+ fun verify_carriers_output/2]),
+ ok = rpc:call(Node, ?MODULE, test_abort,
+ [fun erts_internal:gather_carrier_info/1])
+ end).
+
+carriers_enabled(Config) when is_list(Config) ->
+ carriers_test("+Meamax",
+ fun verify_carriers_enabled/1,
+ fun verify_carriers_enabled/2).
+
+carriers_disabled(Config) when is_list(Config) ->
+ carriers_test("+Meamin",
+ fun verify_carriers_disabled/1,
+ fun verify_carriers_disabled/2).
+
+verify_carriers_disabled(_AllocType, Result) ->
+ verify_carriers_disabled(Result).
+
+verify_carriers_disabled({error, not_enabled}) ->
+ ok;
+verify_carriers_disabled({ok, {_HistStart, Carriers}}) ->
+ verify_carriers_disabled_1(Carriers).
+
+verify_carriers_disabled_1([]) ->
+ ok;
+%% literal_alloc, exec_alloc, and temp_alloc can't be disabled, so we have to
+%% accept their presence in carriers_disabled/test_all_alloc.
+verify_carriers_disabled_1([Carrier | Rest]) when
+ element(1, Carrier) =:= literal_alloc;
+ element(1, Carrier) =:= exec_alloc;
+ element(1, Carrier) =:= temp_alloc ->
+ verify_carriers_disabled_1(Rest).
+
+%% exec_alloc only has a carrier if it's actually used.
+verify_carriers_enabled(exec_alloc, _Result) -> ok;
+verify_carriers_enabled(_AllocType, Result) -> verify_carriers_enabled(Result).
+
+verify_carriers_enabled({ok, {_HistStart, Carriers}}) when Carriers =/= [] ->
+ ok.
+
+verify_carriers_output(#{ histogram_start := HistStart,
+ histogram_width := HistWidth },
+ {ok, {HistStart, AllCarriers}}) ->
+
+ %% Do the carriers look alright?
+ CarrierSet = ordsets:from_list(AllCarriers),
+ Verified = [C || {AllocType,
+ TotalSize,
+ UnscannedSize,
+ AllocatedSize,
+ AllocatedCount,
+ InPool,
+ FreeBlockHist} = C <- CarrierSet,
+ is_atom(AllocType),
+ is_integer(TotalSize), TotalSize >= 1,
+ is_integer(UnscannedSize), UnscannedSize < TotalSize,
+ UnscannedSize >= 0,
+ is_integer(AllocatedSize), AllocatedSize < TotalSize,
+ AllocatedSize >= 0,
+ is_integer(AllocatedCount), AllocatedCount =< AllocatedSize,
+ AllocatedCount >= 0,
+ is_boolean(InPool),
+ tuple_size(FreeBlockHist) =:= HistWidth,
+ carrier_block_check(AllocatedCount, FreeBlockHist)],
+ [] = ordsets:subtract(CarrierSet, Verified),
+
+ %% Do we have at least as many carriers as we've generated?
+ CarrierCount = length(AllCarriers),
+ GenSBCCount = ?GENERATED_SBC_BLOCK_COUNT,
+ if
+ CarrierCount < GenSBCCount ->
+ ct:fail("Carrier count is ~p, expected at least ~p (SBC).",
+ [CarrierCount, GenSBCCount]);
+ CarrierCount >= GenSBCCount ->
+ ok
end,
- lists:foldl(
- fun ({TDescr,Addr,Size,Proc}, MinAddr) ->
- true = TDescr /= invalid_type,
- true = is_integer(TDescr),
- true = is_integer(Addr),
- true = is_integer(Size),
- true = Addr >= MinAddr,
- case Proc of
- {0, Number, Serial} ->
- true = is_integer(Number),
- true = is_integer(Serial);
- undefined ->
- ok;
- BadProc ->
- ct:fail({badproc, BadProc})
- end,
- NextMinAddr = Addr+Size,
- true = NextMinAddr =< High,
- NextMinAddr
- end, Low, AL),
- {_, DAL} = instrument:descr(MDS),
- lists:foreach(
- fun ({TDescr,_,_,Proc}) ->
- true = TDescr /= invalid_type,
- true = is_atom(TDescr) orelse is_list(TDescr),
- true = is_pid(Proc) orelse Proc == undefined
- end, DAL),
- ASL = lists:map(fun ({_,A,S,_}) -> {A,S} end, AL),
- ASL = lists:map(fun ({_,A,S,_}) -> {A,S} end, DAL),
- instrument:holes(MDS),
- {comment, "total status - sum of blocks = " ++ integer_to_list(S1-SumBlocks)}.
-
-%% Check that memory data can be read and processed
-'+Mis true'(Config) when is_list(Config) ->
- Node = start_slave("+Mis true"),
- [{total,[{sizes,S1,S2,S3},{blocks,B1,B2,B3}]}]
- = rpc:call(Node, instrument, memory_status, [total]),
- true = S1 =< S2,
- true = S2 =< S3,
- true = B1 =< B2,
- true = B2 =< B3,
- true = is_list(rpc:call(Node,instrument,memory_status,[allocators])),
- true = is_list(rpc:call(Node,instrument,memory_status,[classes])),
- true = is_list(rpc:call(Node,instrument,memory_status,[types])),
+
+ ok;
+verify_carriers_output(#{}, {error, not_enabled}) ->
+ ok.
+
+carrier_block_check(AllocCount, FreeHist) ->
+ %% A carrier must contain at least one block, and th. number of free blocks
+ %% must not exceed the number of allocated blocks + 1.
+ FreeCount = hist_sum(FreeHist),
+
+ (AllocCount + FreeCount) >= 1 andalso FreeCount =< (AllocCount + 1).
+
+%% %% %% %% %% %%
+
+test_all_alloc(Gather, Verify) ->
+ Verify(Gather()),
ok.
+test_per_alloc(Gather, Verify) ->
+ [begin
+ Verify(T, Gather(#{ allocator_types => [T] }))
+ end || T <- erlang:system_info(alloc_util_allocators)],
+ ok.
+
+test_format(#{ allocator_types := _ }, _, _) ->
+ error(badarg);
+test_format(Options0, Gather, Verify) ->
+ %% We limit format checking to binary_alloc since we generated the test
+ %% vectors there.
+ Options = Options0#{ allocator_types => [binary_alloc] },
+ Verify(Options, Gather(Options)),
+ ok.
+
+test_abort(Gather) ->
+ %% There's no way for us to tell whether this actually aborted or ran to
+ %% completion, but it might catch a few segfaults.
+ Runner = self(),
+ Ref = make_ref(),
+ spawn_opt(fun() ->
+ [Gather({Type, SchedId, 1, 1, Ref}) ||
+ Type <- erlang:system_info(alloc_util_allocators),
+ SchedId <- lists:seq(0, erlang:system_info(schedulers))],
+ Runner ! Ref
+ end, [{priority, max}]),
+ receive
+ Ref -> ok
+ end.
+
+hist_sum(H) -> hist_sum_1(H, tuple_size(H), 0).
+hist_sum_1(_H, 0, A) -> A;
+hist_sum_1(H, N, A) -> hist_sum_1(H, N - 1, element(N, H) + A).
+
+%%
+
+run_test(Args0, Test) ->
+ %% Override single-block carrier threshold for binaries to ensure we have
+ %% coverage for that path. generate_test_blocks builds a few binaries that
+ %% crosses this threshold.
+ %%
+ %% We also set the abandon carrier threshold to 70% to provoke more
+ %% activity in the carrier pool.
+ Args = Args0 ++ " +MBsbct 1 +Muacul 70",
+ Node = start_slave(Args),
+
+ ok = rpc:call(Node, ?MODULE, generate_test_blocks, []),
+ ok = Test(Node),
+
+ ok = rpc:call(Node, ?MODULE, churn_memory, []),
+ ok = Test(Node),
+
+ true = test_server:stop_node(Node).
+
start_slave(Args) ->
MicroSecs = erlang:monotonic_time(),
Name = "instr" ++ integer_to_list(MicroSecs),
@@ -112,6 +297,60 @@ start_slave(Args) ->
[{args, "-pa " ++ Pa ++ " " ++ Args}]),
Node.
+generate_test_blocks() ->
+ Runner = self(),
+ Ref = make_ref(),
+ spawn(fun() ->
+ %% We've set the single-block carrier threshold to 1KB so one
+ %% ought to land in a SBC and the other in a MBC. Both are kept
+ %% alive forever.
+ SBCs = [<<I, 0:(1 bsl 10)/unit:8>> ||
+ I <- lists:seq(1, ?GENERATED_SBC_BLOCK_COUNT)],
+ MBCs = [<<I, 0:64/unit:8>> ||
+ I <- lists:seq(1, ?GENERATED_MBC_BLOCK_COUNT)],
+ Runner ! Ref,
+ receive after infinity -> ok end,
+ unreachable ! {SBCs, MBCs}
+ end),
+ receive
+ Ref -> ok
+ end.
-stop_slave(Node) ->
- true = test_server:stop_node(Node).
+churn_memory() ->
+ %% All processes spawned from here on have 'low' priority to avoid starving
+ %% others (e.g. the rpc process) which could cause the test to time out.
+ [begin
+ churn_list_to_binary(),
+ churn_processes(),
+ churn_ets()
+ end || _ <- lists:seq(1, erlang:system_info(schedulers))],
+ ok.
+
+churn_processes() ->
+ Pid = spawn_opt(fun churn_processes/0, [{priority, low}]),
+ [Pid ! <<I, 0:128/unit:8>> || I <- lists:seq(1, 128)].
+
+%% Nearly all types have a few allocations at all times but sl_alloc is
+%% often empty. list_to_binary on large inputs will yield and spill the
+%% state into an 'estack' which is allocated through sl_alloc.
+%%
+%% This is inherently unstable so we skip the verification step for this
+%% type, but there's still a point to hammering it.
+churn_list_to_binary() ->
+ List = binary_to_list(<<0:(1 bsl 20)/unit:8>>),
+ spawn_opt(fun() -> churn_list_to_binary_1(List) end, [{priority, low}]).
+
+churn_list_to_binary_1(List) ->
+ _ = id(list_to_binary(List)),
+ churn_list_to_binary_1(List).
+
+churn_ets() ->
+ spawn_opt(fun() -> churn_ets_1(ets:new(gurka, [])) end, [{priority, low}]).
+
+churn_ets_1(Tab) ->
+ ets:insert(Tab, {gaffel, lists:seq(1, 16)}),
+ ets:delete_all_objects(Tab),
+ churn_ets_1(Tab).
+
+id(I) ->
+ I.
diff --git a/lib/wx/api_gen/wx_extra/wxGraphicsRenderer.c_src b/lib/wx/api_gen/wx_extra/wxGraphicsRenderer.c_src
new file mode 100644
index 0000000000..4718525dd6
--- /dev/null
+++ b/lib/wx/api_gen/wx_extra/wxGraphicsRenderer.c_src
@@ -0,0 +1,58 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 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.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+
+<<CreatePen
+case ~s: { // wxGraphicsRenderer::CreatePen taylormade
+ wxGraphicsRenderer *This = (wxGraphicsRenderer *) getPtr(bp,memenv); bp += 4;
+ wxPen *pen = (wxPen *) getPtr(bp,memenv); bp += 4;
+ if(!This) throw wxe_badarg(0);
+#if !wxCHECK_VERSION(3,1,1)
+ wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(*pen)); newPtr((void *) Result,4, memenv);
+ rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPen");
+ break;
+#else
+ wxGraphicsPenInfo info = wxGraphicsPenInfo()
+ .Colour(pen->GetColour())
+ .Width(pen->GetWidth())
+ .Style(pen->GetStyle())
+ .Join(pen->GetJoin())
+ .Cap(pen->GetCap())
+ ;
+
+ if ( info.GetStyle() == wxPENSTYLE_USER_DASH )
+ {
+ wxDash *dashes;
+ if ( int nb_dashes = pen->GetDashes(&dashes) )
+ info.Dashes(nb_dashes, dashes);
+ }
+
+ if ( info.GetStyle() == wxPENSTYLE_STIPPLE )
+ {
+ if ( wxBitmap* const stipple = pen->GetStipple() )
+ info.Stipple(*stipple);
+ }
+ wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(info));
+ newPtr((void *) Result,4, memenv);
+ rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPen");
+ break;
+#endif
+}
+CreatePen>>
diff --git a/lib/wx/api_gen/wx_gen.erl b/lib/wx/api_gen/wx_gen.erl
index ab70a588ab..4ba57501a5 100644
--- a/lib/wx/api_gen/wx_gen.erl
+++ b/lib/wx/api_gen/wx_gen.erl
@@ -93,9 +93,10 @@ mangle_info(E={not_const,List}) ->
put(not_const, [atom_to_list(M) || M <- List]),
E;
mangle_info(E={gvars,List}) ->
- A2L = fun({N,{T,C}}) -> {atom_to_list(N), {T,atom_to_list(C)}};
+ A2L = fun({N,{test_if,C}}) -> {atom_to_list(N), {test_if,C}};
+ ({N,{T,C}}) -> {atom_to_list(N), {T,atom_to_list(C)}};
({N,C}) -> {atom_to_list(N), atom_to_list(C)}
- end,
+ end,
put(gvars, map(A2L,List)),
E;
mangle_info({class,CN,P,O,FL}) ->
diff --git a/lib/wx/api_gen/wx_gen_cpp.erl b/lib/wx/api_gen/wx_gen_cpp.erl
index 573abfa9b8..cc4e1b5301 100644
--- a/lib/wx/api_gen/wx_gen_cpp.erl
+++ b/lib/wx/api_gen/wx_gen_cpp.erl
@@ -1127,6 +1127,15 @@ build_gvar({Name, {address,Class}, _Id}, Cnt) ->
w(" rt.addAtom(\"~s\"); rt.addRef(getRef((void *)&~s,memenv), \"~s\");~n",[Name,Name,Class]),
w(" rt.addTupleCount(2);~n"),
Cnt+1;
+build_gvar({Name, {test_if,Test}, _Id}, Cnt) ->
+ w("#if ~s~n", [Test]),
+ w(" rt.addAtom(\"~s\"); rt.addInt(~s);~n", [Name, Name]),
+ w(" rt.addTupleCount(2);~n"),
+ w("#else~n", []),
+ w(" rt.addAtom(\"~s\"); rt.addAtom(\"undefined\");~n", [Name]),
+ w(" rt.addTupleCount(2);~n"),
+ w("#endif~n", []),
+ Cnt+1;
build_gvar({Name, Class, _Id}, Cnt) ->
w(" rt.addAtom(\"~s\"); rt.addRef(getRef((void *)~s,memenv),\"~s\");~n",[Name,Name,Class]),
w(" rt.addTupleCount(2);~n"),
diff --git a/lib/wx/api_gen/wx_gen_erl.erl b/lib/wx/api_gen/wx_gen_erl.erl
index e272c08d90..dfee7270b4 100644
--- a/lib/wx/api_gen/wx_gen_erl.erl
+++ b/lib/wx/api_gen/wx_gen_erl.erl
@@ -1106,7 +1106,7 @@ gen_enums_ints() ->
w("-define(wxDefaultSize, {-1,-1}).~n", []),
w("-define(wxDefaultPosition, {-1,-1}).~n", []),
w("~n%% Global Variables~n", []),
- [w("-define(~s, wxe_util:get_const(~s)).~n", [Gvar, Gvar]) ||
+ [w("-define(~s, wxe_util:get_const(~s)).~n", [qoute_atom(Gvar), qoute_atom(Gvar)]) ||
{Gvar,_,_Id} <- get(gvars)],
w("~n%% Enum and defines~n", []),
foldl(fun(Enum= #enum{vals=Vals}, Done) when Vals =/= [] ->
@@ -1115,6 +1115,11 @@ gen_enums_ints() ->
end, gb_sets:empty(), lists:sort(Enums)),
close().
+qoute_atom([Char|_]=Str) when Char < $a ->
+ "'" ++ Str ++ "'";
+qoute_atom(Str) ->
+ Str.
+
build_enum_ints(#enum{from=From, vals=Vals},Done) ->
case From of
{File, undefined, [$@|_]} ->
diff --git a/lib/wx/api_gen/wxapi.conf b/lib/wx/api_gen/wxapi.conf
index 146c9fecc7..e2ef2d890a 100644
--- a/lib/wx/api_gen/wxapi.conf
+++ b/lib/wx/api_gen/wxapi.conf
@@ -87,7 +87,27 @@
{wxNullPen, {address,wxPen}},
{wxNullBrush, {address,wxBrush}},
{wxNullPalette, {address,wxPalette}},
- {wxNullFont, {address,wxFont}}]}.
+ {wxNullFont, {address,wxFont}},
+
+ %% New enums needed for gl contexts not static numbers
+ {'WX_GL_SAMPLE_BUFFERS', {test_if, "wxCHECK_VERSION(3,0,0)"}},
+ {'WX_GL_SAMPLES', {test_if, "wxCHECK_VERSION(3,0,0)"}},
+ {'WX_GL_FRAMEBUFFER_SRGB', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_CORE_PROFILE', {test_if, "wxCHECK_VERSION(3,0,3)"}},
+ {'WX_GL_MAJOR_VERSION', {test_if, "wxCHECK_VERSION(3,0,3)"}},
+ {'WX_GL_MINOR_VERSION', {test_if, "wxCHECK_VERSION(3,0,3)"}},
+ {'wx_GL_COMPAT_PROFILE', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_FORWARD_COMPAT', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_ES2', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_DEBUG', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_ROBUST_ACCESS', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_NO_RESET_NOTIFY', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_LOSE_ON_RESET', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_RESET_ISOLATION', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_RELEASE_FLUSH', {test_if, "wxCHECK_VERSION(3,1,0)"}},
+ {'WX_GL_RELEASE_NONE', {test_if, "wxCHECK_VERSION(3,1,0)"}}
+ ]}.
+
{enum, wxBackgroundStyle, "wxBG_STYLE_"}.
{enum, wxWindowVariant, "wxWINDOW_VARIANT_"}.
{enum, wxBitmapType, "wxBITMAP_TYPE_"}.
@@ -433,7 +453,8 @@
{class, wxGraphicsRenderer, object, [{ifdef, wxUSE_GRAPHICS_CONTEXT}],
['GetDefaultRenderer','CreateContext',
%%'CreateContextFromNativeContext', 'CreateContextFromNativeWindow',
- 'CreatePen','CreateBrush',
+ {'CreatePen', [{where, taylormade}]},
+ 'CreateBrush',
{'CreateLinearGradientBrush', [{deprecated, "!wxCHECK_VERSION(2,9,0)"}]},
{'CreateRadialGradientBrush', [{deprecated, "!wxCHECK_VERSION(2,9,0)"}]},
'CreateFont',
diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp
index a47d602337..a7bac4cf9d 100644
--- a/lib/wx/c_src/gen/wxe_funcs.cpp
+++ b/lib/wx/c_src/gen/wxe_funcs.cpp
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2008-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.
@@ -7010,13 +7010,41 @@ case wxGraphicsRenderer_CreateContext_1_0: { // wxGraphicsRenderer::CreateContex
rt.addRef(getRef((void *)Result,memenv), "wxGraphicsContext");
break;
}
-case wxGraphicsRenderer_CreatePen: { // wxGraphicsRenderer::CreatePen
+
+case wxGraphicsRenderer_CreatePen: { // wxGraphicsRenderer::CreatePen taylormade
wxGraphicsRenderer *This = (wxGraphicsRenderer *) getPtr(bp,memenv); bp += 4;
wxPen *pen = (wxPen *) getPtr(bp,memenv); bp += 4;
if(!This) throw wxe_badarg(0);
- wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(*pen)); newPtr((void *) Result,4, memenv);;
+#if !wxCHECK_VERSION(3,1,1)
+ wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(*pen)); newPtr((void *) Result,4, memenv);
rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPen");
break;
+#else
+ wxGraphicsPenInfo info = wxGraphicsPenInfo()
+ .Colour(pen->GetColour())
+ .Width(pen->GetWidth())
+ .Style(pen->GetStyle())
+ .Join(pen->GetJoin())
+ .Cap(pen->GetCap())
+ ;
+
+ if ( info.GetStyle() == wxPENSTYLE_USER_DASH )
+ {
+ wxDash *dashes;
+ if ( int nb_dashes = pen->GetDashes(&dashes) )
+ info.Dashes(nb_dashes, dashes);
+ }
+
+ if ( info.GetStyle() == wxPENSTYLE_STIPPLE )
+ {
+ if ( wxBitmap* const stipple = pen->GetStipple() )
+ info.Stipple(*stipple);
+ }
+ wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(info));
+ newPtr((void *) Result,4, memenv);
+ rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPen");
+ break;
+#endif
}
case wxGraphicsRenderer_CreateBrush: { // wxGraphicsRenderer::CreateBrush
wxGraphicsRenderer *This = (wxGraphicsRenderer *) getPtr(bp,memenv); bp += 4;
diff --git a/lib/wx/c_src/gen/wxe_init.cpp b/lib/wx/c_src/gen/wxe_init.cpp
index 1e432e34ce..6ce33a5449 100644
--- a/lib/wx/c_src/gen/wxe_init.cpp
+++ b/lib/wx/c_src/gen/wxe_init.cpp
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2015. All Rights Reserved.
+ * Copyright Ericsson AB 2008-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.
@@ -529,6 +529,111 @@ void WxeApp::init_nonconsts(wxeMemEnv *memenv, ErlDrvTermData caller) {
rt.addTupleCount(2);
rt.addAtom("wxCURSOR_MAX"); rt.addInt(wxCURSOR_MAX);
rt.addTupleCount(2);
+#if wxCHECK_VERSION(3,0,3)
+ rt.addAtom("WX_GL_CORE_PROFILE"); rt.addInt(WX_GL_CORE_PROFILE);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_CORE_PROFILE"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_DEBUG"); rt.addInt(WX_GL_DEBUG);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_DEBUG"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_ES2"); rt.addInt(WX_GL_ES2);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_ES2"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_FORWARD_COMPAT"); rt.addInt(WX_GL_FORWARD_COMPAT);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_FORWARD_COMPAT"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_FRAMEBUFFER_SRGB"); rt.addInt(WX_GL_FRAMEBUFFER_SRGB);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_FRAMEBUFFER_SRGB"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_LOSE_ON_RESET"); rt.addInt(WX_GL_LOSE_ON_RESET);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_LOSE_ON_RESET"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,0,3)
+ rt.addAtom("WX_GL_MAJOR_VERSION"); rt.addInt(WX_GL_MAJOR_VERSION);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_MAJOR_VERSION"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,0,3)
+ rt.addAtom("WX_GL_MINOR_VERSION"); rt.addInt(WX_GL_MINOR_VERSION);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_MINOR_VERSION"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_NO_RESET_NOTIFY"); rt.addInt(WX_GL_NO_RESET_NOTIFY);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_NO_RESET_NOTIFY"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_RELEASE_FLUSH"); rt.addInt(WX_GL_RELEASE_FLUSH);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_RELEASE_FLUSH"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_RELEASE_NONE"); rt.addInt(WX_GL_RELEASE_NONE);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_RELEASE_NONE"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_RESET_ISOLATION"); rt.addInt(WX_GL_RESET_ISOLATION);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_RESET_ISOLATION"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("WX_GL_ROBUST_ACCESS"); rt.addInt(WX_GL_ROBUST_ACCESS);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_ROBUST_ACCESS"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,0,0)
+ rt.addAtom("WX_GL_SAMPLES"); rt.addInt(WX_GL_SAMPLES);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_SAMPLES"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,0,0)
+ rt.addAtom("WX_GL_SAMPLE_BUFFERS"); rt.addInt(WX_GL_SAMPLE_BUFFERS);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("WX_GL_SAMPLE_BUFFERS"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
rt.addAtom("wxBLACK"); rt.add(*(wxBLACK));
rt.addTupleCount(2);
rt.addAtom("wxBLACK_BRUSH"); rt.addRef(getRef((void *)wxBLACK_BRUSH,memenv),"wxBrush");
@@ -611,7 +716,14 @@ void WxeApp::init_nonconsts(wxeMemEnv *memenv, ErlDrvTermData caller) {
rt.addTupleCount(2);
rt.addAtom("wxWHITE_PEN"); rt.addRef(getRef((void *)wxWHITE_PEN,memenv),"wxPen");
rt.addTupleCount(2);
- rt.endList(293);
+#if wxCHECK_VERSION(3,1,0)
+ rt.addAtom("wx_GL_COMPAT_PROFILE"); rt.addInt(wx_GL_COMPAT_PROFILE);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("wx_GL_COMPAT_PROFILE"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+ rt.endList(309);
rt.addTupleCount(2);
rt.send();
}
diff --git a/lib/wx/include/wx.hrl b/lib/wx/include/wx.hrl
index a14cc89cee..23f3b95403 100644
--- a/lib/wx/include/wx.hrl
+++ b/lib/wx/include/wx.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-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.
@@ -373,6 +373,21 @@
-define(wxDefaultPosition, {-1,-1}).
%% Global Variables
+-define('WX_GL_CORE_PROFILE', wxe_util:get_const('WX_GL_CORE_PROFILE')).
+-define('WX_GL_DEBUG', wxe_util:get_const('WX_GL_DEBUG')).
+-define('WX_GL_ES2', wxe_util:get_const('WX_GL_ES2')).
+-define('WX_GL_FORWARD_COMPAT', wxe_util:get_const('WX_GL_FORWARD_COMPAT')).
+-define('WX_GL_FRAMEBUFFER_SRGB', wxe_util:get_const('WX_GL_FRAMEBUFFER_SRGB')).
+-define('WX_GL_LOSE_ON_RESET', wxe_util:get_const('WX_GL_LOSE_ON_RESET')).
+-define('WX_GL_MAJOR_VERSION', wxe_util:get_const('WX_GL_MAJOR_VERSION')).
+-define('WX_GL_MINOR_VERSION', wxe_util:get_const('WX_GL_MINOR_VERSION')).
+-define('WX_GL_NO_RESET_NOTIFY', wxe_util:get_const('WX_GL_NO_RESET_NOTIFY')).
+-define('WX_GL_RELEASE_FLUSH', wxe_util:get_const('WX_GL_RELEASE_FLUSH')).
+-define('WX_GL_RELEASE_NONE', wxe_util:get_const('WX_GL_RELEASE_NONE')).
+-define('WX_GL_RESET_ISOLATION', wxe_util:get_const('WX_GL_RESET_ISOLATION')).
+-define('WX_GL_ROBUST_ACCESS', wxe_util:get_const('WX_GL_ROBUST_ACCESS')).
+-define('WX_GL_SAMPLES', wxe_util:get_const('WX_GL_SAMPLES')).
+-define('WX_GL_SAMPLE_BUFFERS', wxe_util:get_const('WX_GL_SAMPLE_BUFFERS')).
-define(wxBLACK, wxe_util:get_const(wxBLACK)).
-define(wxBLACK_BRUSH, wxe_util:get_const(wxBLACK_BRUSH)).
-define(wxBLACK_DASHED_PEN, wxe_util:get_const(wxBLACK_DASHED_PEN)).
@@ -414,6 +429,7 @@
-define(wxWHITE, wxe_util:get_const(wxWHITE)).
-define(wxWHITE_BRUSH, wxe_util:get_const(wxWHITE_BRUSH)).
-define(wxWHITE_PEN, wxe_util:get_const(wxWHITE_PEN)).
+-define(wx_GL_COMPAT_PROFILE, wxe_util:get_const(wx_GL_COMPAT_PROFILE)).
%% Enum and defines
% From class wxAuiManager
diff --git a/otp_versions.table b/otp_versions.table
index 8976b39c24..f83d9e4f8b 100644
--- a/otp_versions.table
+++ b/otp_versions.table
@@ -1,3 +1,5 @@
+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 :
OTP-20.3.2 : ssh-4.6.7 stdlib-3.4.5 # 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 sasl-3.1.1 snmp-5.2.10 ssl-8.2.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 :
OTP-20.3.1 : ssl-8.2.5 # 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 sasl-3.1.1 snmp-5.2.10 ssh-4.6.6 stdlib-3.4.4 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 :
OTP-20.3 : asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 crypto-4.2.1 dialyzer-3.2.4 diameter-2.1.4 erts-9.3 hipe-3.17.1 inets-6.5 kernel-5.4.3 observer-2.7 runtime_tools-1.12.5 snmp-5.2.10 ssh-4.6.6 ssl-8.2.4 stdlib-3.4.4 tools-2.11.2 # 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 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.1 et-1.6.1 eunit-2.3.5 ic-4.4.3 jinterface-1.8.1 megaco-3.18.3 mnesia-4.15.3 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 sasl-3.1.1 syntax_tools-2.1.4 wx-1.8.3 xmerl-1.3.16 :
@@ -57,6 +59,7 @@ OTP-19.0.3 : inets-6.3.2 kernel-5.0.1 ssl-8.0.1 # asn1-4.0.3 common_test-1.12.2
OTP-19.0.2 : compiler-7.0.1 erts-8.0.2 stdlib-3.0.1 # asn1-4.0.3 common_test-1.12.2 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 debugger-4.2 dialyzer-3.0.1 diameter-1.12 edoc-0.7.19 eldap-1.2.2 erl_docgen-0.5 erl_interface-3.9 et-1.6 eunit-2.3 gs-1.6.1 hipe-3.15.1 ic-4.4.1 inets-6.3.1 jinterface-1.7 kernel-5.0 megaco-3.18.1 mnesia-4.14 observer-2.2.1 odbc-2.11.2 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.2 percept-0.9 public_key-1.2 reltool-0.7.1 runtime_tools-1.10 sasl-3.0 snmp-5.2.3 ssh-4.3.1 ssl-8.0 syntax_tools-2.0 tools-2.8.5 typer-0.9.11 wx-1.7 xmerl-1.3.11 :
OTP-19.0.1 : dialyzer-3.0.1 erts-8.0.1 inets-6.3.1 observer-2.2.1 ssh-4.3.1 tools-2.8.5 # asn1-4.0.3 common_test-1.12.2 compiler-7.0 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 debugger-4.2 diameter-1.12 edoc-0.7.19 eldap-1.2.2 erl_docgen-0.5 erl_interface-3.9 et-1.6 eunit-2.3 gs-1.6.1 hipe-3.15.1 ic-4.4.1 jinterface-1.7 kernel-5.0 megaco-3.18.1 mnesia-4.14 odbc-2.11.2 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.2 percept-0.9 public_key-1.2 reltool-0.7.1 runtime_tools-1.10 sasl-3.0 snmp-5.2.3 ssl-8.0 stdlib-3.0 syntax_tools-2.0 typer-0.9.11 wx-1.7 xmerl-1.3.11 :
OTP-19.0 : asn1-4.0.3 common_test-1.12.2 compiler-7.0 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 debugger-4.2 dialyzer-3.0 diameter-1.12 edoc-0.7.19 eldap-1.2.2 erl_docgen-0.5 erl_interface-3.9 erts-8.0 et-1.6 eunit-2.3 gs-1.6.1 hipe-3.15.1 ic-4.4.1 inets-6.3 jinterface-1.7 kernel-5.0 megaco-3.18.1 mnesia-4.14 observer-2.2 odbc-2.11.2 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.2 percept-0.9 public_key-1.2 reltool-0.7.1 runtime_tools-1.10 sasl-3.0 snmp-5.2.3 ssh-4.3 ssl-8.0 stdlib-3.0 syntax_tools-2.0 tools-2.8.4 typer-0.9.11 wx-1.7 xmerl-1.3.11 # :
+OTP-18.3.4.9 : ssh-4.2.2.6 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3.1 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3.1 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1.4 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4.1 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssl-7.3.3.2 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.4.8 : ssh-4.2.2.5 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3.1 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3.1 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1.4 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4.1 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssl-7.3.3.2 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.4.7 : ssl-7.3.3.2 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3.1 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3.1 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1.4 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4.1 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2.4 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.4.6 : compiler-6.0.3.1 eldap-1.2.1.1 erts-7.3.1.4 ssh-4.2.2.4 # asn1-4.0.2 common_test-1.12.1.1 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3.1 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 erl_docgen-0.4.2 erl_interface-3.8.2 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4.1 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssl-7.3.3.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
diff --git a/system/doc/design_principles/Makefile b/system/doc/design_principles/Makefile
index 611ab6da99..41d2d1208f 100644
--- a/system/doc/design_principles/Makefile
+++ b/system/doc/design_principles/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
+# Copyright Ericsson AB 1997-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.
@@ -60,11 +60,11 @@ GIF_FILES = \
sup5.gif \
sup6.gif
-PNG_FILES = \
- code_lock.png \
- code_lock_2.png
+SVG_FILES = \
+ code_lock.svg \
+ code_lock_2.svg
-IMAGE_FILES = $(GIF_FILES) $(PNG_FILES)
+IMAGE_FILES = $(GIF_FILES) $(SVG_FILES)
XML_FILES = \
$(BOOK_FILES) $(XML_CHAPTER_FILES) \
@@ -93,7 +93,7 @@ _create_dirs := $(shell mkdir -p $(HTMLDIR))
$(HTMLDIR)/%.gif: %.gif
$(INSTALL_DATA) $< $@
-$(HTMLDIR)/%.png: %.png
+$(HTMLDIR)/%.svg: %.svg
$(INSTALL_DATA) $< $@
docs: html
diff --git a/system/doc/design_principles/code_lock.dia b/system/doc/design_principles/code_lock.dia
index eaa2aca5b0..fe43d6da2c 100644
--- a/system/doc/design_principles/code_lock.dia
+++ b/system/doc/design_principles/code_lock.dia
Binary files differ
diff --git a/system/doc/design_principles/code_lock.png b/system/doc/design_principles/code_lock.png
deleted file mode 100644
index 40bd35fc74..0000000000
--- a/system/doc/design_principles/code_lock.png
+++ /dev/null
Binary files differ
diff --git a/system/doc/design_principles/code_lock.svg b/system/doc/design_principles/code_lock.svg
new file mode 100644
index 0000000000..223e121486
--- /dev/null
+++ b/system/doc/design_principles/code_lock.svg
@@ -0,0 +1,132 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/PR-SVG-20010719/DTD/svg10.dtd">
+<svg width="41cm" height="52cm" viewBox="-2 -2 806 1023" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="492.782,860 600,860 600,900 "/>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,900 380,900 380,931.6 "/>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640,560 640,580 640,580 640,600 "/>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="492.782,300 640,300 640,340 "/>
+ <g>
+ <path style="fill: #d5d5f7" d="M 289.774 260 L 470.226,260 C 492.782,276 500,284 500,300 C 500,316 492.782,324 470.226,340 L 289.774,340 C 267.218,324 260,316 260,300 C 260,284 267.218,276 289.774,260z"/>
+ <path style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" d="M 289.774 260 L 470.226,260 C 492.782,276 500,284 500,300 C 500,316 492.782,324 470.226,340 L 289.774,340 C 267.218,324 260,316 260,300 C 260,284 267.218,276 289.774,260"/>
+ <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:700" x="380" y="308.467">
+ <tspan x="380" y="308.467">locked</tspan>
+ </text>
+ </g>
+ <g>
+ <path style="fill: #d5d5f7" d="M 289.774 820 L 470.226,820 C 492.782,836 500,844 500,860 C 500,876 492.782,884 470.226,900 L 289.774,900 C 267.218,884 260,876 260,860 C 260,844 267.218,836 289.774,820z"/>
+ <path style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" d="M 289.774 820 L 470.226,820 C 492.782,836 500,844 500,860 C 500,876 492.782,884 470.226,900 L 289.774,900 C 267.218,884 260,876 260,860 C 260,844 267.218,836 289.774,820"/>
+ <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:700" x="380" y="868.467">
+ <tspan x="380" y="868.467">open</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #aad7aa" points="520,340 760,340 736,360 760,380 520,380 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="520,340 760,340 736,360 760,380 520,380 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:italic;font-weight:normal" x="546" y="366.35">
+ <tspan x="546" y="366.35">{button,Button}</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #f3cccc" points="640,480 800,520 640,560 480,520 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640,480 800,520 640,560 480,520 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="643.2" y="527.15">
+ <tspan x="643.2" y="527.15">Correct Code?</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="0,940 160,940 160,980 0,980 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="0,940 160,940 160,980 0,980 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="80" y="966.35">
+ <tspan x="80" y="966.35">do_lock()</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #aad7aa" points="280,931.6 480,931.6 460,960 480,988.4 280,988.4 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="280,931.6 480,931.6 460,960 480,988.4 280,988.4 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:italic;font-weight:normal" x="380" y="966.35">
+ <tspan x="380" y="966.35">state_timeout</tspan>
+ </text>
+ </g>
+ <g>
+ <ellipse style="fill: #d5d5f7" cx="380" cy="40" rx="40" ry="40"/>
+ <ellipse style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" cx="380" cy="40" rx="40" ry="40"/>
+ <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="380" y="48.4667">
+ <tspan x="380" y="48.4667">init</tspan>
+ </text>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380.719" y1="180" x2="380.087" y2="250.264"/>
+ <polygon style="fill: #000000" points="380.02,257.764 375.11,247.72 380.087,250.264 385.11,247.809 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380.02,257.764 375.11,247.72 380.087,250.264 385.11,247.809 "/>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="640.438" y1="440" x2="640.106" y2="470.265"/>
+ <polygon style="fill: #000000" points="640.024,477.764 635.134,467.71 640.106,470.265 645.134,467.819 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640.024,477.764 635.134,467.71 640.106,470.265 645.134,467.819 "/>
+ </g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640,700 640,740 380,740 380,740 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:normal;font-weight:normal" x="640" y="578.9">
+ <tspan x="640" y="578.9">Y</tspan>
+ </text>
+ <text font-size="20.32" style="fill: #000000;text-anchor:end;font-family:sans-serif;font-style:normal;font-weight:normal" x="480" y="538.9">
+ <tspan x="480" y="538.9">N</tspan>
+ </text>
+ <g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="80,940 80,220 370.623,220 "/>
+ <polygon style="fill: #000000" points="378.123,220 368.123,225 370.623,220 368.123,215 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="378.123,220 368.123,225 370.623,220 368.123,215 "/>
+ </g>
+ <g>
+ <polygon style="fill: #aad7aa" points="500,900 700,900 680,920 700,940 500,940 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="500,900 700,900 680,920 700,940 500,940 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:italic;font-weight:normal" x="522" y="926.35">
+ <tspan x="522" y="926.35">{button,Digit}</tspan>
+ </text>
+ </g>
+ <g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="600,940 600,980 760,980 760,780 389.736,780 "/>
+ <polygon style="fill: #000000" points="382.236,780 392.236,775 389.736,780 392.236,785 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="382.236,780 392.236,775 389.736,780 392.236,785 "/>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="260,120 501.438,120 501.438,180 260,180 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="260,120 501.438,120 501.438,180 260,180 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:normal;font-weight:normal" x="286.144" y="143.65">
+ <tspan x="286.144" y="143.65">do_lock()</tspan>
+ <tspan x="286.144" y="169.05">Clear Buttons</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="500,600 780,600 780,700 500,700 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="500,600 780,600 780,700 500,700 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:normal;font-weight:normal" x="530" y="630.95">
+ <tspan x="530" y="630.95">do_unlock()</tspan>
+ <tspan x="530" y="656.35">Clear Buttons</tspan>
+ <tspan x="530" y="681.75">state_timeout 10 s</tspan>
+ </text>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380" y1="80" x2="380.544" y2="110.266"/>
+ <polygon style="fill: #000000" points="380.679,117.764 375.5,107.856 380.544,110.266 385.498,107.676 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380.679,117.764 375.5,107.856 380.544,110.266 385.498,107.676 "/>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380" y1="740" x2="380" y2="810.264"/>
+ <polygon style="fill: #000000" points="380,817.764 375,807.764 380,810.264 385,807.764 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,817.764 375,807.764 380,810.264 385,807.764 "/>
+ </g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,988.4 380,1020 80,1020 80,980 "/>
+ <g>
+ <polygon style="fill: #ffff8f" points="540,400 740.875,400 740.875,440 540,440 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="540,400 740.875,400 740.875,440 540,440 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="640.438" y="426.35">
+ <tspan x="640.438" y="426.35">Collect Buttons</tspan>
+ </text>
+ </g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="640" y1="380" x2="640.438" y2="400"/>
+ <g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="480,520 380,520 380,351 "/>
+ <polygon style="fill: #000000" points="385,351 380,341 375,351 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="385,351 380,341 375,351 "/>
+ </g>
+</svg>
diff --git a/system/doc/design_principles/code_lock_2.dia b/system/doc/design_principles/code_lock_2.dia
index 3b9ba554d8..31eb0fb6eb 100644
--- a/system/doc/design_principles/code_lock_2.dia
+++ b/system/doc/design_principles/code_lock_2.dia
Binary files differ
diff --git a/system/doc/design_principles/code_lock_2.png b/system/doc/design_principles/code_lock_2.png
deleted file mode 100644
index 3aca9dd5aa..0000000000
--- a/system/doc/design_principles/code_lock_2.png
+++ /dev/null
Binary files differ
diff --git a/system/doc/design_principles/code_lock_2.svg b/system/doc/design_principles/code_lock_2.svg
new file mode 100644
index 0000000000..d3e15e7577
--- /dev/null
+++ b/system/doc/design_principles/code_lock_2.svg
@@ -0,0 +1,140 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/PR-SVG-20010719/DTD/svg10.dtd">
+<svg width="41cm" height="52cm" viewBox="-1 0 806 1021" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,300.55 380,300 140,300 140,360 "/>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="412.782,900 412.782,900 560,900 560,940 "/>
+ <g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="560,980 560,1020 0,1020 0,120.55 370.264,120.55 "/>
+ <polygon style="fill: #000000" points="377.764,120.55 367.764,125.55 370.264,120.55 367.764,115.55 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="377.764,120.55 367.764,125.55 370.264,120.55 367.764,115.55 "/>
+ </g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640,680 640,720 300,720 300,760 "/>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="492.782,300.55 492.782,300 640,300 640,360 "/>
+ <g>
+ <path style="fill: #d5d5f7" d="M 289.774 261.1 L 470.226,261.1 C 492.782,276.88 500,284.77 500,300.55 C 500,316.33 492.782,324.22 470.226,340 L 289.774,340 C 267.218,324.22 260,316.33 260,300.55 C 260,284.77 267.218,276.88 289.774,261.1z"/>
+ <path style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" d="M 289.774 261.1 L 470.226,261.1 C 492.782,276.88 500,284.77 500,300.55 C 500,316.33 492.782,324.22 470.226,340 L 289.774,340 C 267.218,324.22 260,316.33 260,300.55 C 260,284.77 267.218,276.88 289.774,261.1"/>
+ <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:700" x="380" y="309.017">
+ <tspan x="380" y="309.017">locked</tspan>
+ </text>
+ </g>
+ <g>
+ <path style="fill: #d5d5f7" d="M 209.774 860 L 390.226,860 C 412.782,876 420,884 420,900 C 420,916 412.782,924 390.226,940 L 209.774,940 C 187.218,924 180,916 180,900 C 180,884 187.218,876 209.774,860z"/>
+ <path style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" d="M 209.774 860 L 390.226,860 C 412.782,876 420,884 420,900 C 420,916 412.782,924 390.226,940 L 209.774,940 C 187.218,924 180,916 180,900 C 180,884 187.218,876 209.774,860"/>
+ <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:700" x="300" y="908.467">
+ <tspan x="300" y="908.467">open</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #aad7aa" points="520,360 760,360 736,380 760,400 520,400 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="520,360 760,360 736,380 760,400 520,400 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:italic;font-weight:normal" x="546" y="386.35">
+ <tspan x="546" y="386.35">{button,Button}</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="140,760 460,760 460,816.8 140,816.8 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="140,760 460,760 460,816.8 140,816.8 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:normal;font-weight:normal" x="174" y="782.05">
+ <tspan x="174" y="782.05">do_unlock()</tspan>
+ <tspan x="174" y="807.45">state_timeout 10 s</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="260,160 500,160 500,222.2 260,222.2 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="260,160 500,160 500,222.2 260,222.2 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="380" y="184.75">
+ <tspan x="380" y="184.75">do_lock()</tspan>
+ <tspan x="380" y="210.15">Clear Buttons</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #aad7aa" points="460,940 660,940 640,960 660,980 460,980 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="460,940 660,940 640,960 660,980 460,980 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:italic;font-weight:normal" x="560" y="966.35">
+ <tspan x="560" y="966.35">state_timeout</tspan>
+ </text>
+ </g>
+ <g>
+ <ellipse style="fill: #d5d5f7" cx="380" cy="41.1" rx="40" ry="40"/>
+ <ellipse style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" cx="380" cy="41.1" rx="40" ry="40"/>
+ <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="380" y="49.5667">
+ <tspan x="380" y="49.5667">init</tspan>
+ </text>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380" y1="81.1" x2="380" y2="150.264"/>
+ <polygon style="fill: #000000" points="380,157.764 375,147.764 380,150.264 385,147.764 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,157.764 375,147.764 380,150.264 385,147.764 "/>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380" y1="222.2" x2="380" y2="251.364"/>
+ <polygon style="fill: #000000" points="380,258.864 375,248.864 380,251.364 385,248.864 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,258.864 375,248.864 380,251.364 385,248.864 "/>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="300" y1="816.8" x2="300" y2="850.264"/>
+ <polygon style="fill: #000000" points="300,857.764 295,847.764 300,850.264 305,847.764 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="300,857.764 295,847.764 300,850.264 305,847.764 "/>
+ </g>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380" y1="560" x2="380" y2="349.736"/>
+ <polygon style="fill: #000000" points="380,342.236 385,352.236 380,349.736 375,352.236 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,342.236 385,352.236 380,349.736 375,352.236 "/>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="240,560 520,560 520,600 240,600 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="240,560 520,560 520,600 240,600 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="380" y="586.35">
+ <tspan x="380" y="586.35">state_timeout 30 s</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #aad7aa" points="40,360 240,360 220,380 240,400 40,400 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="40,360 240,360 220,380 240,400 40,400 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:italic;font-weight:normal" x="62" y="386.35">
+ <tspan x="62" y="386.35">state_timeout</tspan>
+ </text>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="540,440 741.438,440 741.438,480 540,480 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="540,440 741.438,440 741.438,480 540,480 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="640.719" y="466.35">
+ <tspan x="640.719" y="466.35">Collect Buttons</tspan>
+ </text>
+ </g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="640" y1="400" x2="640.719" y2="440"/>
+ <g>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="640.611" y1="480.995" x2="640.056" y2="589"/>
+ <polygon style="fill: #000000" points="635.057,588.974 640.005,599 645.056,589.026 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="635.057,588.974 640.005,599 645.056,589.026 "/>
+ </g>
+ <g>
+ <polygon style="fill: #ffff8f" points="40,440 240,440 240,480 40,480 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="40,440 240,440 240,480 40,480 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="140" y="466.35">
+ <tspan x="140" y="466.35">Clear Buttons</tspan>
+ </text>
+ </g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="480,640 380,640 380,600 "/>
+ <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="140" y1="400" x2="140" y2="440"/>
+ <g>
+ <g>
+ <polygon style="fill: #f3cccc" points="640,600 800,640 640,680 480,640 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640,600 800,640 640,680 480,640 "/>
+ <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="643.2" y="647.15">
+ <tspan x="643.2" y="647.15">Correct Code?</tspan>
+ </text>
+ </g>
+ <text font-size="20.32" style="fill: #000000;text-anchor:end;font-family:sans-serif;font-style:normal;font-weight:normal" x="480" y="658.9">
+ <tspan x="480" y="658.9">N</tspan>
+ </text>
+ <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:normal;font-weight:normal" x="640" y="698.9">
+ <tspan x="640" y="698.9">Y</tspan>
+ </text>
+ </g>
+ <g>
+ <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="140,480 140,516 369,516 "/>
+ <polygon style="fill: #000000" points="369,521 379,516 369,511 "/>
+ <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="369,521 379,516 369,511 "/>
+ </g>
+</svg>
diff --git a/system/doc/design_principles/statem.xml b/system/doc/design_principles/statem.xml
index 5be2981f62..80ee9c992f 100644
--- a/system/doc/design_principles/statem.xml
+++ b/system/doc/design_principles/statem.xml
@@ -36,16 +36,6 @@
manual page in STDLIB, where all interface functions and callback
functions are described in detail.
</p>
- <note>
- <p>
- This is a new behavior in Erlang/OTP 19.0.
- It has been thoroughly reviewed, is stable enough
- to be used by at least two heavy OTP applications, and is here to stay.
- Depending on user feedback, we do not expect
- but can find it necessary to make minor
- not backward compatible changes into Erlang/OTP 20.0.
- </p>
- </note>
<!-- =================================================================== -->
@@ -72,13 +62,14 @@ State(S) x Event(E) -> Actions(A), State(S')</pre>
<p>These relations are interpreted as follows:
if we are in state <c>S</c> and event <c>E</c> occurs, we
are to perform actions <c>A</c> and make a transition to
- state <c>S'</c>. Notice that <c>S'</c> can be equal to <c>S</c>.
+ state <c>S'</c>. Notice that <c>S'</c> can be equal to <c>S</c>
+ and that <c>A</c> can be empty.
</p>
<p>
As <c>A</c> and <c>S'</c> depend only on
<c>S</c> and <c>E</c>, the kind of state machine described
- here is a Mealy Machine
- (see, for example, the corresponding Wikipedia article).
+ here is a Mealy machine
+ (see, for example, the Wikipedia article "Mealy machine").
</p>
<p>
Like most <c>gen_</c> behaviors, <c>gen_statem</c> keeps
@@ -88,7 +79,95 @@ State(S) x Event(E) -> Actions(A), State(S')</pre>
or on the number of distinct input events,
a state machine implemented with this behavior
is in fact Turing complete.
- But it feels mostly like an Event-Driven Mealy Machine.
+ But it feels mostly like an Event-Driven Mealy machine.
+ </p>
+ </section>
+
+<!-- =================================================================== -->
+
+ <section>
+ <marker id="When to use gen_statem" />
+ <title>When to use gen_statem</title>
+ <p>
+ If your process logic is convenient to describe as a state machine,
+ and you want any of these <c>gen_statem</c> key features:
+ </p>
+ <list type="bulleted">
+ <item>
+ Co-located callback code for each state,
+ regardless of
+ <seealso marker="#Event Types">Event Type</seealso>
+ (such as <em>call</em>, <em>cast</em> and <em>info</em>)
+ </item>
+ <item>
+ <seealso marker="#Postponing Events">
+ Postponing Events
+ </seealso>
+ (a substitute for selective receive)
+ </item>
+ <item>
+ <seealso marker="#Inserted Events">
+ Inserted Events
+ </seealso>
+ that is: events from the state machine to itself
+ (in particular purely internal events)
+ </item>
+ <item>
+ <seealso marker="#State Enter Calls">
+ State Enter Calls
+ </seealso>
+ (callback on state entry co-located with the rest
+ of each state's callback code)
+ </item>
+ <item>
+ Easy-to-use timeouts
+ (<seealso marker="#State Time-Outs">State Time-Outs</seealso>,
+ <seealso marker="#Event Time-Outs">Event Time-Outs</seealso>
+ and
+ <seealso marker="#Generic Time-Outs">Generic Time-outs</seealso>
+ (named time-outs))
+ </item>
+ </list>
+ <p>
+ If so, or if possibly needed in future versions,
+ then you should consider using <c>gen_statem</c> over
+ <seealso marker="stdlib:gen_server"><c>gen_server</c></seealso>.
+ </p>
+ <p>
+ For simple state machines not needing these features
+ <seealso marker="stdlib:gen_server"><c>gen_server</c></seealso>
+ works just fine.
+ It also has got smaller call overhead,
+ but we are talking about something like 2 vs 3.3 microseconds
+ call roundtrip time here, so if the server callback
+ does just a little bit more than just replying,
+ or if the call is not extremely frequent,
+ that difference will be hard to notice.
+ </p>
+ </section>
+
+<!-- =================================================================== -->
+
+ <section>
+ <marker id="Callback Module" />
+ <title>Callback Module</title>
+ <p>
+ The callback module contains functions that implement
+ the state machine.
+ When an event occurs,
+ the <c>gen_statem</c> behaviour engine
+ calls a function in the callback module with the event,
+ current state and server data.
+ This function performs the actions for this event,
+ and returns the new state and server data
+ and also actions to be performed by the behaviour engine.
+ </p>
+ <p>
+ The behaviour engine holds the state machine state,
+ server data, timer references, a queue of posponed messages
+ and other metadata. It receives all process messages,
+ handles the system messages, and calls the callback module
+ with machine specific events.
</p>
</section>
@@ -100,61 +179,72 @@ State(S) x Event(E) -> Actions(A), State(S')</pre>
<p>
The <c>gen_statem</c> behavior supports two callback modes:
</p>
- <list type="bulleted">
+ <taglist>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-callback_mode">
+ <c>state_functions</c>
+ </seealso>
+ </tag>
<item>
<p>
- In mode
- <seealso marker="stdlib:gen_statem#type-callback_mode"><c>state_functions</c></seealso>,
- the state transition rules are written as some Erlang
- functions, which conform to the following convention:
- </p>
- <pre>
-StateName(EventType, EventContent, Data) ->
- ... code for actions here ...
- {next_state, NewStateName, NewData}.
- </pre>
- <p>
- This form is used in most examples here for example in section
- <seealso marker="#Example">Example</seealso>.
+ Events are handled by one callback function per state.
</p>
</item>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-callback_mode">
+ <c>handle_event_function</c>
+ </seealso>
+ </tag>
<item>
<p>
- In mode
- <seealso marker="stdlib:gen_statem#type-callback_mode"><c>handle_event_function</c></seealso>,
- only one Erlang function provides all state transition rules:
- </p>
- <pre>
-handle_event(EventType, EventContent, State, Data) ->
- ... code for actions here ...
- {next_state, NewState, NewData}
- </pre>
- <p>
- See section
- <seealso marker="#One Event Handler">One Event Handler</seealso>
- for an example.
+ Events are handled by one single callback function.
</p>
</item>
- </list>
+ </taglist>
<p>
- Both these modes allow other return tuples; see
- <seealso marker="stdlib:gen_statem#Module:StateName/3"><c>Module:StateName/3</c></seealso>
- in the <c>gen_statem</c> manual page.
- These other return tuples can, for example, stop the machine,
- execute state transition actions on the machine engine itself,
- and send replies.
+ The callback mode is selected at server start
+ and may be changed with a code upgrade/downgrade.
+ </p>
+ <p>
+ See the section
+ <seealso marker="#Event Handler">Event Handler</seealso>
+ that describes the event handling callback function(s).
+ </p>
+ <p>
+ The callback mode is selected by implementing
+ a mandatory callback function
+ <seealso marker="stdlib:gen_statem#Module:callback_mode/0">
+ <c>Module:callback_mode()</c>
+ </seealso>
+ that returns one of the callback modes.
+ </p>
+ <p>
+ The
+ <seealso marker="stdlib:gen_statem#Module:callback_mode/0">
+ <c>Module:callback_mode()</c>
+ </seealso>
+ function may also return a list containing the callback mode
+ and the atom <c>state_enter</c> in which case
+ <seealso marker="#State Enter Calls">State Enter Calls</seealso>
+ are activated for the callback mode.
</p>
<section>
<marker id="Choosing the Callback Mode" />
<title>Choosing the Callback Mode</title>
<p>
+ The short version: choose <c>state_functions</c> -
+ it is the one most like <c>gen_fsm</c>.
+ But if you do not want the restriction that the state
+ must be an atom, or if you do not want to write
+ one event handler function per state; please read on...
+ </p>
+ <p>
The two
- <seealso marker="#Callback Modes">callback modes</seealso>
- give different possibilities
- and restrictions, but one goal remains:
- you want to handle all possible combinations of
- events and states.
+ <seealso marker="#Callback Modes">Callback Modes</seealso>
+ give different possibilities and restrictions,
+ with one common goal:
+ to handle all possible combinations of events and states.
</p>
<p>
This can be done, for example, by focusing on one state at the time
@@ -167,7 +257,7 @@ handle_event(EventType, EventContent, State, Data) ->
With <c>state_functions</c>, you are restricted to use
atom-only states, and the <c>gen_statem</c> engine
branches depending on state name for you.
- This encourages the callback module to gather
+ This encourages the callback module to co-locate
the implementation of all event actions particular
to one state in the same place in the code,
hence to focus on one state at the time.
@@ -186,13 +276,17 @@ handle_event(EventType, EventContent, State, Data) ->
This mode works equally well when you want to focus on
one event at the time or on
one state at the time, but function
- <seealso marker="stdlib:gen_statem#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>
+ <seealso marker="stdlib:gen_statem#Module:handle_event/4">
+ <c>Module:handle_event/4</c>
+ </seealso>
quickly grows too large to handle without branching to
helper functions.
</p>
<p>
The mode enables the use of non-atom states, for example,
complex states or even hierarchical states.
+ See section
+ <seealso marker="#Complex State">Complex State</seealso>.
If, for example, a state diagram is largely alike
for the client side and the server side of a protocol,
you can have a state <c>{StateName,server}</c> or
@@ -208,43 +302,180 @@ handle_event(EventType, EventContent, State, Data) ->
<!-- =================================================================== -->
<section>
- <marker id="State Enter Calls" />
- <title>State Enter Calls</title>
+ <marker id="Event Handler" />
+ <title>Event Handler</title>
<p>
- The <c>gen_statem</c> behavior can regardless of callback mode
- automatically
- <seealso marker="stdlib:gen_statem#type-state_enter">
- call the state callback
- </seealso>
- with special arguments whenever the state changes
- so you can write state entry actions
- near the rest of the state transition rules.
- It typically looks like this:
+ Which callback function that handles an event
+ depends on the callback mode:
</p>
- <pre>
-StateName(enter, _OldState, Data) ->
- ... code for state entry actions here ...
- {keep_state, NewData};
-StateName(EventType, EventContent, Data) ->
- ... code for actions here ...
- {next_state, NewStateName, NewData}.</pre>
+ <taglist>
+ <tag><c>state_functions</c></tag>
+ <item>
+ The event is handled by:<br />
+ <seealso marker="stdlib:gen_statem#Module:StateName/3">
+ <c>Module:StateName(EventType, EventContent, Data)</c>
+ </seealso>
+ <p>
+ This form is the one mostly used in the
+ <seealso marker="#Example">Example</seealso>
+ section.
+ </p>
+ </item>
+ <tag><c>handle_event_function</c></tag>
+ <item>
+ The event is handled by:<br />
+ <seealso marker="stdlib:gen_statem#Module:handle_event/4">
+ <c>Module:handle_event(EventType, EventContent, State, Data)</c>
+ </seealso>
+ <p>
+ See section
+ <seealso marker="#One Event Handler">One Event Handler</seealso>
+ for an example.
+ </p>
+ </item>
+ </taglist>
<p>
- Depending on how your state machine is specified,
- this can be a very useful feature,
- but it forces you to handle the state enter calls in all states.
- See also the
- <seealso marker="#State Entry Actions">
- State Entry Actions
+ The state is either the name of the function itself or an argument to it.
+ The other arguments are the <c>EventType</c> described in section
+ <seealso marker="#Event Types">Event Types</seealso>,
+ the event dependent <c>EventContent</c>, and the current server <c>Data</c>.
+ </p>
+ <p>
+ State enter calls are also handled by the event handler and have
+ slightly different arguments. See the section
+ <seealso marker="#State Enter Calls">State Enter Calls</seealso>.
+ </p>
+ <p>
+ The event handler return values are defined in the description of
+ <seealso marker="stdlib:gen_statem#Module:StateName/3">
+ <c>Module:StateName/3</c>
</seealso>
- chapter.
+ in the <c>gen_statem</c> manual page, but here is
+ a more readable list:
</p>
+ <taglist>
+ <tag>
+ <c>{next_state, NextState, NewData, Actions}</c><br />
+ <c>{next_state, NextState, NewData}</c>
+ </tag>
+ <item>
+ <p>
+ Set next state and update the server data.
+ If the <c>Actions</c> field is used, execute state transition actions.
+ An empty <c>Actions</c> list is equivalent to not returning the field.
+ </p>
+ <p>
+ See section
+ <seealso marker="#State Transition Actions">
+ State Transition Actions
+ </seealso>
+ for a list of possible
+ state transition actions.
+ </p>
+ <p>
+ If <c>NextState =/= State</c> the state machine changes
+ to a new state. A
+ <seealso marker="#State Enter Calls">state enter call</seealso>
+ is performed if enabled and all
+ <seealso marker="#Postponing Events">postponed events</seealso>
+ are retried.
+ </p>
+ </item>
+ <tag>
+ <c>{keep_state, NewData, Actions}</c><br />
+ <c>{keep_state, NewData}</c>
+ </tag>
+ <item>
+ <p>
+ Same as the <c>next_state</c> values with
+ <c>NextState =:= State</c>, that is, no state change.
+ </p>
+ </item>
+ <tag>
+ <c>{keep_state_and_data, Actions}</c><br />
+ <c>keep_state_and_data</c>
+ </tag>
+ <item>
+ <p>
+ Same as the <c>keep_state</c> values with
+ <c>NextData =:= Data</c>, that is, no change in server data.
+ </p>
+ </item>
+ <tag>
+ <c>{repeat_state, NewData, Actions}</c><br />
+ <c>{repeat_state, NewData}</c><br />
+ <c>{repeat_state_and_data, Actions}</c><br />
+ <c>repeat_state_and_data</c>
+ </tag>
+ <item>
+ <p>
+ Same as the <c>keep_state</c> or <c>keep_state_and_data</c> values,
+ and if
+ <seealso marker="#State Enter Calls">
+ State Enter Calls
+ </seealso>
+ are enabled, repeat the state enter call
+ as if this state was entered again.
+ </p>
+ </item>
+ <tag>
+ <c>{stop, Reason, NewData}</c><br />
+ <c>{stop, Reason}</c>
+ </tag>
+ <item>
+ <p>
+ Stop the server with reason <c>Reason</c>.
+ If the <c>NewData</c> field is used, first update the server data.
+ </p>
+ </item>
+ <tag>
+ <c>{stop_and_reply, Reason, NewData, ReplyActions}</c><br />
+ <c>{stop_and_reply, Reason, ReplyActions}</c>
+ </tag>
+ <item>
+ <p>
+ Same as the <c>stop</c> values, but first execute the given
+ state transition actions that may only be reply actions.
+ </p>
+ </item>
+ </taglist>
+
+ <section>
+ <marker id="The First State" />
+ <title>The First State</title>
+ <p>
+ To decide the first state the
+ <seealso marker="stdlib:gen_statem#Module:init/1">
+ <c>Module:init(Args)</c>
+ </seealso>
+ callback function is called before any
+ <seealso marker="#Event Handler">Event Handler</seealso>
+ is called. This function behaves like an event handler
+ function, but gets its only argument <c>Args</c> from
+ the <c>gen_statem</c>
+ <seealso marker="stdlib:gen_statem#start/3">
+ <c>start/3,4</c>
+ </seealso>
+ or
+ <seealso marker="stdlib:gen_statem#start_link/3">
+ <c>start_link/3,4</c>
+ </seealso>
+ function, and returns <c>{ok, State, Data}</c>
+ or <c>{ok, State, Data, Actions}</c>.
+ If you use the
+ <seealso marker="#Postponing Events"><c>postpone</c></seealso>
+ action from this function, that action is ignored,
+ since there is no event to postpone.
+ </p>
+ </section>
+
</section>
<!-- =================================================================== -->
<section>
- <marker id="Actions" />
- <title>Actions</title>
+ <marker id="State Transition Actions" />
+ <title>State Transition Actions</title>
<p>
In the first section
<seealso marker="#Event-Driven State Machines">
@@ -259,77 +490,102 @@ StateName(EventType, EventContent, Data) ->
</p>
<p>
There are more specific state-transition actions
- that a callback function can order the <c>gen_statem</c>
+ that a callback function can command the <c>gen_statem</c>
engine to do after the callback function return.
- These are ordered by returning a list of
+ These are commanded by returning a list of
<seealso marker="stdlib:gen_statem#type-action">actions</seealso>
in the
- <seealso marker="stdlib:gen_statem#type-state_callback_result">return tuple</seealso>
+ <seealso marker="stdlib:gen_statem#type-state_callback_result">
+ return value
+ </seealso>
from the
<seealso marker="stdlib:gen_statem#Module:StateName/3">callback function</seealso>.
- These state transition actions affect the <c>gen_statem</c>
- engine itself and can do the following:
+ These are the possible state transition actions:
</p>
- <list type="bulleted">
- <item>
+ <taglist>
+ <tag>
<seealso marker="stdlib:gen_statem#type-postpone">
- Postpone
+ <c>postpone</c>
</seealso>
- the current event, see section
+ <br />
+ <c>{postpone, Boolean}</c>
+ </tag>
+ <item>
+ If set postpone the current event, see section
<seealso marker="#Postponing Events">Postponing Events</seealso>
</item>
- <item>
+ <tag>
<seealso marker="stdlib:gen_statem#type-hibernate">
- Hibernate
+ <c>hibernate</c>
</seealso>
- the <c>gen_statem</c>, treated in
+ <br />
+ <c>{hibernate, Boolean}</c>
+ </tag>
+ <item>
+ If set hibernate the <c>gen_statem</c>, treated in section
<seealso marker="#Hibernation">Hibernation</seealso>
</item>
- <item>
- Start a
+ <tag>
<seealso marker="stdlib:gen_statem#type-state_timeout">
- state time-out</seealso>,
- read more in section
+ <c>{state_timeout, Time}</c>
+ </seealso>
+ <br />
+ <c>{state_timeout, Time, Opts}</c>
+ </tag>
+ <item>
+ Start a state time-out, read more in section
<seealso marker="#State Time-Outs">State Time-Outs</seealso>
</item>
- <item>
- Start a
+ <tag>
<seealso marker="stdlib:gen_statem#type-generic_timeout">
- generic time-out</seealso>,
- read more in section
+ <c>{{timeout, Name}, Time}</c>
+ </seealso>
+ <br />
+ <c>{{timeout, Name}, Time, Opts}</c>
+ </tag>
+ <item>
+ Start a generic time-out, read more in section
<seealso marker="#Generic Time-Outs">Generic Time-Outs</seealso>
</item>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-event_timeout">
+ <c>{timeout, Time}</c>
+ </seealso>
+ <br />
+ <c>{timeout, Time, Opts}</c><br />
+ <c>Time</c>
+ </tag>
<item>
- Start an
- <seealso marker="stdlib:gen_statem#type-event_timeout">event time-out</seealso>,
- see more in section
+ Start an event time-out, see more in section
<seealso marker="#Event Time-Outs">Event Time-Outs</seealso>
</item>
- <item>
+ <tag>
<seealso marker="stdlib:gen_statem#type-reply_action">
- Reply
+ <c>{reply, From, Reply}</c>
</seealso>
- to a caller, mentioned at the end of section
+ </tag>
+ <item>
+ Reply to a caller, mentioned at the end of section
<seealso marker="#All State Events">All State Events</seealso>
</item>
- <item>
- Generate the
+ <tag>
<seealso marker="stdlib:gen_statem#type-action">
- next event
+ <c>{next_event, EventType, EventContent}</c>
</seealso>
- to handle, see section
- <seealso marker="#Self-Generated Events">Self-Generated Events</seealso>
+ </tag>
+ <item>
+ Generate the next event to handle, see section
+ <seealso marker="#Inserted Events">Inserted Events</seealso>
</item>
- </list>
+ </taglist>
<p>
- For details, see the
- <seealso marker="stdlib:gen_statem#type-action">
- <c>gen_statem(3)</c>
- </seealso>
- manual page.
+ For details, see the <c>gen_statem(3)</c>
+ manual page for type
+ <seealso marker="stdlib:gen_statem#type-action"><c>action()</c></seealso>.
You can, for example, reply to many callers,
generate multiple next events,
- and set time-outs to relative or absolute times.
+ and set a time-out to use absolute instead of relative time
+ (using the <c>Opts</c> field).
</p>
</section>
@@ -341,8 +597,8 @@ StateName(EventType, EventContent, Data) ->
<p>
Events are categorized in different
<seealso marker="stdlib:gen_statem#type-event_type">event types</seealso>.
- Events of all types are handled in the same callback function,
- for a given state, and the function gets
+ Events of all types are for a given state
+ handled in the same callback function, and that function gets
<c>EventType</c> and <c>EventContent</c> as arguments.
</p>
<p>
@@ -350,12 +606,20 @@ StateName(EventType, EventContent, Data) ->
they come from:
</p>
<taglist>
- <tag><c>cast</c></tag>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-external_event_type">
+ <c>cast</c>
+ </seealso>
+ </tag>
<item>
Generated by
<seealso marker="stdlib:gen_statem#cast/2"><c>gen_statem:cast</c></seealso>.
</item>
- <tag><c>{call,From}</c></tag>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-external_event_type">
+ <c>{call,From}</c>
+ </seealso>
+ </tag>
<item>
Generated by
<seealso marker="stdlib:gen_statem#call/2"><c>gen_statem:call</c></seealso>,
@@ -364,12 +628,20 @@ StateName(EventType, EventContent, Data) ->
<c>{reply,From,Msg}</c> or by calling
<seealso marker="stdlib:gen_statem#reply/1"><c>gen_statem:reply</c></seealso>.
</item>
- <tag><c>info</c></tag>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-external_event_type">
+ <c>info</c>
+ </seealso>
+ </tag>
<item>
Generated by any regular process message sent to
the <c>gen_statem</c> process.
</item>
- <tag><c>state_timeout</c></tag>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-timeout_event_type">
+ <c>state_timeout</c>
+ </seealso>
+ </tag>
<item>
Generated by state transition action
<seealso marker="stdlib:gen_statem#type-state_timeout">
@@ -377,7 +649,11 @@ StateName(EventType, EventContent, Data) ->
</seealso>
state timer timing out.
</item>
- <tag><c>{timeout,Name}</c></tag>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-timeout_event_type">
+ <c>{timeout,Name}</c>
+ </seealso>
+ </tag>
<item>
Generated by state transition action
<seealso marker="stdlib:gen_statem#type-generic_timeout">
@@ -385,7 +661,11 @@ StateName(EventType, EventContent, Data) ->
</seealso>
generic timer timing out.
</item>
- <tag><c>timeout</c></tag>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-timeout_event_type">
+ <c>timeout</c>
+ </seealso>
+ </tag>
<item>
Generated by state transition action
<seealso marker="stdlib:gen_statem#type-event_timeout">
@@ -394,7 +674,11 @@ StateName(EventType, EventContent, Data) ->
(or its short form <c>Time</c>)
event timer timing out.
</item>
- <tag><c>internal</c></tag>
+ <tag>
+ <seealso marker="stdlib:gen_statem#type-event_type">
+ <c>internal</c>
+ </seealso>
+ </tag>
<item>
Generated by state transition
<seealso marker="stdlib:gen_statem#type-action">action</seealso>
@@ -408,19 +692,75 @@ StateName(EventType, EventContent, Data) ->
<!-- =================================================================== -->
<section>
+ <marker id="State Enter Calls" />
+ <title>State Enter Calls</title>
+ <p>
+ The <c>gen_statem</c> behavior can if this is enabled,
+ regardless of callback mode,
+ automatically
+ <seealso marker="stdlib:gen_statem#type-state_enter">
+ call the state callback
+ </seealso>
+ with special arguments whenever the state changes
+ so you can write state enter actions
+ near the rest of the state transition rules.
+ It typically looks like this:
+ </p>
+ <pre>
+StateName(enter, OldState, Data) ->
+ ... code for state enter actions here ...
+ {keep_state, NewData};
+StateName(EventType, EventContent, Data) ->
+ ... code for actions here ...
+ {next_state, NewStateName, NewData}.</pre>
+ <p>
+ Since the state enter call is not an event there are restrictions
+ on the allowed return value and
+ <seealso marker="#State Transition Actions">State Transition Actions</seealso>.
+ You may not change the state,
+ <seealso marker="#Postponing Events">postpone</seealso>
+ this non-event, or
+ <seealso marker="#Inserted Events">insert events</seealso>.
+ </p>
+ <p>
+ The first state that is entered will get a state enter call
+ with <c>OldState</c> equal to the current state.
+ </p>
+ <p>
+ You may repeat the state enter call using the <c>{repeat_state,...}</c>
+ return value from the
+ <seealso marker="#Event Handler">Event Handler</seealso>.
+ In this case <c>OldState</c> will also be equal to the current state.
+ </p>
+ <p>
+ Depending on how your state machine is specified,
+ this can be a very useful feature,
+ but it forces you to handle the state enter calls in all states.
+ See also the
+ <seealso marker="#State Enter Actions">
+ State Enter Actions
+ </seealso>
+ chapter.
+ </p>
+ </section>
+
+<!-- =================================================================== -->
+
+ <section>
<marker id="Example" />
<title>Example</title>
<p>
A door with a code lock can be seen as a state machine.
Initially, the door is locked. When someone presses a button,
an event is generated.
- Depending on what buttons have been pressed before,
- the sequence so far can be correct, incomplete, or wrong.
- If correct, the door is unlocked for 10 seconds (10,000 milliseconds).
- If incomplete, we wait for another button to be pressed. If
- wrong, we start all over, waiting for a new button sequence.
- </p>
- <image file="../design_principles/code_lock.png">
+ The pressed buttons are collected, up to the number of buttons
+ in the correct code.
+ If correct, the door is unlocked for 10 seconds.
+ If not correct, we wait for a new button to be pressed.
+ </p>
+ <!-- The image is edited with dia in a .dia file,
+ then exported to Scalable Vector Graphics. -->
+ <image file="../design_principles/code_lock.svg" width="80%">
<icaption>Code Lock State Diagram</icaption>
</image>
<p>
@@ -434,43 +774,51 @@ StateName(EventType, EventContent, Data) ->
-export([start_link/1]).
-export([button/1]).
--export([init/1,callback_mode/0,terminate/3,code_change/4]).
+-export([init/1,callback_mode/0,terminate/3]).
-export([locked/3,open/3]).
start_link(Code) ->
gen_statem:start_link({local,?NAME}, ?MODULE, Code, []).
-button(Digit) ->
- gen_statem:cast(?NAME, {button,Digit}).
+button(Button) ->
+ gen_statem:cast(?NAME, {button,Button}).
init(Code) ->
do_lock(),
- Data = #{code => Code, remaining => Code},
+ Data = #{code => Code, length => length(Code), buttons => []},
{ok, locked, Data}.
callback_mode() ->
state_functions.
-
+ ]]></code>
+ <code type="erl"><![CDATA[
locked(
- cast, {button,Digit},
- #{code := Code, remaining := Remaining} = Data) ->
- case Remaining of
- [Digit] ->
+ cast, {button,Button},
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+ NewButtons =
+ if
+ length(Buttons) < Length ->
+ Buttons;
+ true ->
+ tl(Buttons)
+ end ++ [Button],
+ if
+ NewButtons =:= Code -> % Correct
do_unlock(),
- {next_state, open, Data#{remaining := Code},
- [{state_timeout,10000,lock}]};
- [Digit|Rest] -> % Incomplete
- {next_state, locked, Data#{remaining := Rest}};
- _Wrong ->
- {next_state, locked, Data#{remaining := Code}}
+ {next_state, open, Data#{buttons := []},
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
+ true -> % Incomplete | Incorrect
+ {next_state, locked, Data#{buttons := NewButtons}}
end.
-
+ ]]></code>
+ <code type="erl"><![CDATA[
open(state_timeout, lock, Data) ->
do_lock(),
{next_state, locked, Data};
open(cast, {button,_}, Data) ->
{next_state, open, Data}.
-
+ ]]></code>
+ <code type="erl"><![CDATA[
do_lock() ->
io:format("Lock~n", []).
do_unlock() ->
@@ -479,8 +827,6 @@ do_unlock() ->
terminate(_Reason, State, _Data) ->
State =/= locked andalso do_lock(),
ok.
-code_change(_Vsn, State, Data, _Extra) ->
- {ok, State, Data}.
]]></code>
<p>The code is explained in the next sections.</p>
</section>
@@ -556,17 +902,17 @@ start_link(Code) ->
in this case <c>locked</c>; assuming that the door is locked to begin
with. <c>Data</c> is the internal server data of the <c>gen_statem</c>.
Here the server data is a <seealso marker="stdlib:maps">map</seealso>
- with key <c>code</c> that stores
- the correct button sequence, and key <c>remaining</c>
- that stores the remaining correct button sequence
- (the same as the <c>code</c> to begin with).
+ with key <c>code</c> that stores the correct button sequence,
+ key <c>length</c> store its length,
+ and key <c>buttons</c> that stores the collected buttons
+ up to the same length.
</p>
<code type="erl"><![CDATA[
init(Code) ->
do_lock(),
- Data = #{code => Code, remaining => Code},
- {ok,locked,Data}.
+ Data = #{code => Code, length => length(Code), buttons => []},
+ {ok, locked, Data}.
]]></code>
<p>Function
<seealso marker="stdlib:gen_statem#start_link/3"><c>gen_statem:start_link</c></seealso>
@@ -584,10 +930,6 @@ init(Code) ->
a <c>gen_statem</c> that is not part of a supervision tree.
</p>
- <code type="erl"><![CDATA[
-callback_mode() ->
- state_functions.
- ]]></code>
<p>
Function
<seealso marker="stdlib:gen_statem#Module:callback_mode/0"><c>Module:callback_mode/0</c></seealso>
@@ -595,8 +937,12 @@ callback_mode() ->
<seealso marker="#Callback Modes"><c>CallbackMode</c></seealso>
for the callback module, in this case
<seealso marker="stdlib:gen_statem#type-callback_mode"><c>state_functions</c></seealso>.
- That is, each state has got its own handler function.
+ That is, each state has got its own handler function:
</p>
+ <code type="erl"><![CDATA[
+callback_mode() ->
+ state_functions.
+ ]]></code>
</section>
@@ -620,7 +966,7 @@ button(Digit) ->
<c>{button,Digit}</c> is the event content.
</p>
<p>
- The event is made into a message and sent to the <c>gen_statem</c>.
+ The event is sent to the <c>gen_statem</c>.
When the event is received, the <c>gen_statem</c> calls
<c>StateName(cast, Event, Data)</c>, which is expected to
return a tuple <c>{next_state, NewStateName, NewData}</c>,
@@ -629,44 +975,48 @@ button(Digit) ->
<c>NewStateName</c> is the name of the next state to go to.
<c>NewData</c> is a new value for the server data of
the <c>gen_statem</c>, and <c>Actions</c> is a list of
- actions on the <c>gen_statem</c> engine.
+ actions to be performed by the <c>gen_statem</c> engine.
</p>
+
<code type="erl"><![CDATA[
locked(
- cast, {button,Digit},
- #{code := Code, remaining := Remaining} = Data) ->
- case Remaining of
- [Digit] -> % Complete
+ cast, {button,Button},
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+ NewButtons =
+ if
+ length(Buttons) < Length ->
+ Buttons;
+ true ->
+ tl(Buttons)
+ end ++ [Button],
+ if
+ NewButtons =:= Code -> % Correct
do_unlock(),
- {next_state, open, Data#{remaining := Code},
- [{state_timeout,10000,lock}]};
- [Digit|Rest] -> % Incomplete
- {next_state, locked, Data#{remaining := Rest}};
- [_|_] -> % Wrong
- {next_state, locked, Data#{remaining := Code}}
+ {next_state, open, Data#{buttons := []},
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
+ true -> % Incomplete | Incorrect
+ {next_state, locked, Data#{buttons := NewButtons}}
end.
-
-open(state_timeout, lock, Data) ->
- do_lock(),
- {next_state, locked, Data};
-open(cast, {button,_}, Data) ->
- {next_state, open, Data}.
]]></code>
<p>
- If the door is locked and a button is pressed, the pressed
- button is compared with the next correct button.
+ In state <c>locked</c>, when a button is pressed,
+ it is collected with the last pressed buttons
+ up to the length of the correct code,
+ and compared with the correct code.
Depending on the result, the door is either unlocked
and the <c>gen_statem</c> goes to state <c>open</c>,
or the door remains in state <c>locked</c>.
</p>
<p>
- If the pressed button is incorrect, the server data
- restarts from the start of the code sequence.
- </p>
- <p>
- If the whole code is correct, the server changes states
- to <c>open</c>.
+ When changing to state <c>open</c>, the collected
+ buttons are reset, the lock unlocked, and a state timer
+ for 10 s is started.
</p>
+
+ <code type="erl"><![CDATA[
+open(cast, {button,_}, Data) ->
+ {next_state, open, Data}.
+ ]]></code>
<p>
In state <c>open</c>, a button event is ignored
by staying in the same state. This can also be done
@@ -684,9 +1034,9 @@ open(cast, {button,_}, Data) ->
the following tuple is returned from <c>locked/2</c>:
</p>
<code type="erl"><![CDATA[
-{next_state, open, Data#{remaining := Code},
- [{state_timeout,10000,lock}]};
- ]]></code>
+{next_state, open, Data#{buttons := []},
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
+ ]]></code>
<p>
10,000 is a time-out value in milliseconds.
After this time (10 seconds), a time-out occurs.
@@ -721,10 +1071,9 @@ open(state_timeout, lock, Data) ->
</p>
<p>
Consider a <c>code_length/0</c> function that returns
- the length of the correct code
- (that should not be sensitive to reveal).
+ the length of the correct code.
We dispatch all events that are not state-specific
- to the common function <c>handle_event/3</c>:
+ to the common function <c>handle_common/3</c>:
</p>
<code type="erl"><![CDATA[
...
@@ -737,16 +1086,46 @@ code_length() ->
...
locked(...) -> ... ;
locked(EventType, EventContent, Data) ->
- handle_event(EventType, EventContent, Data).
+ handle_common(EventType, EventContent, Data).
...
open(...) -> ... ;
open(EventType, EventContent, Data) ->
- handle_event(EventType, EventContent, Data).
+ handle_common(EventType, EventContent, Data).
-handle_event({call,From}, code_length, #{code := Code} = Data) ->
- {keep_state, Data, [{reply,From,length(Code)}]}.
+handle_common({call,From}, code_length, #{code := Code} = Data) ->
+ {keep_state, Data,
+ [{reply,From,length(Code)}]}.
]]></code>
+
+ <p>
+ Another way to do it is through a convenience macro
+ <c>?HANDLE_COMMON/0</c>:
+ </p>
+ <code type="erl"><![CDATA[
+...
+-export([button/1,code_length/0]).
+...
+
+code_length() ->
+ gen_statem:call(?NAME, code_length).
+
+-define(HANDLE_COMMON,
+ ?FUNCTION_NAME(T, C, D) -> handle_common(T, C, D)).
+%%
+handle_common({call,From}, code_length, #{code := Code} = Data) ->
+ {keep_state, Data,
+ [{reply,From,length(Code)}]}.
+
+...
+locked(...) -> ... ;
+?HANDLE_COMMON.
+
+...
+open(...) -> ... ;
+?HANDLE_COMMON.
+]]></code>
+
<p>
This example uses
<seealso marker="stdlib:gen_statem#call/2"><c>gen_statem:call/2</c></seealso>,
@@ -757,6 +1136,14 @@ handle_event({call,From}, code_length, #{code := Code} = Data) ->
when you want to stay in the current state but do not know or
care about what it is.
</p>
+ <p>
+ If the common event handler needs to know the current state
+ a function <c>handle_common/4</c> can be used instead:
+ </p>
+ <code type="erl"><![CDATA[
+-define(HANDLE_COMMON,
+ ?FUNCTION_NAME(T, C, D) -> handle_common(T, C, ?FUNCTION_NAME, D)).
+ ]]></code>
</section>
<!-- =================================================================== -->
@@ -765,7 +1152,11 @@ handle_event({call,From}, code_length, #{code := Code} = Data) ->
<marker id="One Event Handler" />
<title>One Event Handler</title>
<p>
- If mode <c>handle_event_function</c> is used,
+ If
+ <seealso marker="#Callback Modes">
+ Callback Mode
+ </seealso>
+ <c>handle_event_function</c> is used,
all events are handled in
<seealso marker="stdlib:gen_statem#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>
and we can (but do not have to) use an event-centered approach
@@ -783,25 +1174,35 @@ callback_mode() ->
handle_event(cast, {button,Digit}, State, #{code := Code} = Data) ->
case State of
locked ->
- case maps:get(remaining, Data) of
- [Digit] -> % Complete
- do_unlock(),
- {next_state, open, Data#{remaining := Code},
- [{state_timeout,10000,lock}]};
- [Digit|Rest] -> % Incomplete
- {keep_state, Data#{remaining := Rest}};
- [_|_] -> % Wrong
- {keep_state, Data#{remaining := Code}}
- end;
+ #{length := Length, buttons := Buttons} = Data,
+ NewButtons =
+ if
+ length(Buttons) < Length ->
+ Buttons;
+ true ->
+ tl(Buttons)
+ end ++ [Button],
+ if
+ NewButtons =:= Code -> % Correct
+ do_unlock(),
+ {next_state, open, Data#{buttons := []},
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
+ true -> % Incomplete | Incorrect
+ {keep_state, Data#{buttons := NewButtons}}
+ end;
open ->
keep_state_and_data
end;
handle_event(state_timeout, lock, open, Data) ->
do_lock(),
- {next_state, locked, Data}.
+ {next_state, locked, Data};
+handle_event(
+ {call,From}, code_length, _State, #{code := Code} = Data) ->
+ {keep_state, Data,
+ [{reply,From,length(Code)}]}.
...
- ]]></code>
+]]></code>
</section>
<!-- =================================================================== -->
@@ -833,7 +1234,7 @@ init(Args) ->
process_flag(trap_exit, true),
do_lock(),
...
- ]]></code>
+ ]]></code>
<p>
When ordered to shut down, the <c>gen_statem</c> then calls
callback function <c>terminate(shutdown, State, Data)</c>.
@@ -847,7 +1248,7 @@ init(Args) ->
terminate(_Reason, State, _Data) ->
State =/= locked andalso do_lock(),
ok.
- ]]></code>
+ ]]></code>
</section>
<section>
@@ -866,7 +1267,7 @@ terminate(_Reason, State, _Data) ->
...
stop() ->
gen_statem:stop(?NAME).
- ]]></code>
+ ]]></code>
<p>
This makes the <c>gen_statem</c> call callback function
<c>terminate/3</c> just like for a supervised server
@@ -889,30 +1290,29 @@ stop() ->
</p>
<p>
It is ordered by the state transition action
- <c>{timeout,Time,EventContent}</c>, or just <c>Time</c>,
- or even just <c>Time</c> instead of an action list
+ <c>{timeout,Time,EventContent}</c>, or just an integer <c>Time</c>,
+ even without the enclosing actions list
(the latter is a form inherited from <c>gen_fsm</c>.
</p>
<p>
- This type of time-out is useful to for example act on inactivity.
+ This type of time-out is useful for example to act on inactivity.
Let us restart the code sequence
if no button is pressed for say 30 seconds:
</p>
<code type="erl"><![CDATA[
...
-locked(
- timeout, _,
- #{code := Code, remaining := Remaining} = Data) ->
- {next_state, locked, Data#{remaining := Code}};
+locked(timeout, _, Data) ->
+ {next_state, locked, Data#{buttons := []}};
locked(
cast, {button,Digit},
- #{code := Code, remaining := Remaining} = Data) ->
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
...
- [Digit|Rest] -> % Incomplete
- {next_state, locked, Data#{remaining := Rest}, 30000};
+ true -> % Incomplete | Incorrect
+ {next_state, locked, Data#{buttons := NewButtons},
+ 30000} % Time in milliseconds
...
- ]]></code>
+]]></code>
<p>
Whenever we receive a button event we start an event time-out
of 30 seconds, and if we get an event type <c>timeout</c>
@@ -925,6 +1325,13 @@ locked(
Whatever event you act on has already cancelled
the event time-out...
</p>
+ <p>
+ Note that an event time-out does not work well with
+ when you have for example a status call as in
+ <seealso marker="#All State Events">All State Events</seealso>,
+ or handle unknown events, since all kinds of events
+ will cancel the event time-out.
+ </p>
</section>
<!-- =================================================================== -->
@@ -952,37 +1359,43 @@ locked(
<p>
Here is how to accomplish the state time-out
in the previous example by instead using a generic time-out
- named <c>open_tm</c>:
+ named for example <c>open</c>:
</p>
<code type="erl"><![CDATA[
...
locked(
cast, {button,Digit},
- #{code := Code, remaining := Remaining} = Data) ->
- case Remaining of
- [Digit] ->
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+...
+ if
+ NewButtons =:= Code -> % Correct
do_unlock(),
- {next_state, open, Data#{remaining := Code},
- [{{timeout,open_tm},10000,lock}]};
+ {next_state, open, Data#{buttons := []},
+ [{{timeout,open},10000,lock}]}; % Time in milliseconds
...
-open({timeout,open_tm}, lock, Data) ->
+open({timeout,open}, lock, Data) ->
do_lock(),
{next_state,locked,Data};
open(cast, {button,_}, Data) ->
{keep_state,Data};
...
- ]]></code>
+]]></code>
<p>
- Just as
- <seealso marker="#State Time-Outs">state time-outs</seealso>
- you can restart or cancel a specific generic time-out
+ Specific generic time-outs can just as
+ <seealso marker="#State Time-Outs">State Time-Outs</seealso>
+ be restarted or cancelled
by setting it to a new time or <c>infinity</c>.
</p>
<p>
- Another way to handle a late time-out can be to not cancel it,
- but to ignore it if it arrives in a state
- where it is known to be late.
+ In this particular case we do not need to cancel the timeout
+ since the timeout event is the only possible reason to
+ change the state from <c>open</c> to <c>locked</c>.
+ </p>
+ <p>
+ Instead of bothering with when to cancel a time-out,
+ a late time-out event can be handled by ignoring it
+ if it arrives in a state where it is known to be late.
</p>
</section>
@@ -994,7 +1407,7 @@ open(cast, {button,_}, Data) ->
<p>
The most versatile way to handle time-outs is to use
Erlang Timers; see
- <seealso marker="erts:erlang#start_timer/4"><c>erlang:start_timer3,4</c></seealso>.
+ <seealso marker="erts:erlang#start_timer/4"><c>erlang:start_timer/3,4</c></seealso>.
Most time-out tasks can be performed with the
time-out features in <c>gen_statem</c>,
but an example of one that can not is if you should need
@@ -1009,12 +1422,15 @@ open(cast, {button,_}, Data) ->
...
locked(
cast, {button,Digit},
- #{code := Code, remaining := Remaining} = Data) ->
- case Remaining of
- [Digit] ->
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+...
+ if
+ NewButtons =:= Code -> % Correct
do_unlock(),
- Tref = erlang:start_timer(10000, self(), lock),
- {next_state, open, Data#{remaining := Code, timer => Tref}};
+ Tref =
+ erlang:start_timer(
+ 10000, self(), lock), % Time in milliseconds
+ {next_state, open, Data#{buttons := [], timer => Tref}};
...
open(info, {timeout,Tref,lock}, #{timer := Tref} = Data) ->
@@ -1023,7 +1439,7 @@ open(info, {timeout,Tref,lock}, #{timer := Tref} = Data) ->
open(cast, {button,_}, Data) ->
{keep_state,Data};
...
- ]]></code>
+]]></code>
<p>
Removing the <c>timer</c> key from the map when we
change to state <c>locked</c> is not strictly
@@ -1063,7 +1479,9 @@ open(cast, {button,_}, Data) ->
</p>
<p>
Postponing is ordered by the state transition
- <seealso marker="stdlib:gen_statem#type-action">action</seealso>
+ <seealso marker="#State Transition Actions">
+ State Transition Action
+ </seealso>
<c>postpone</c>.
</p>
<p>
@@ -1076,15 +1494,18 @@ open(cast, {button,_}, Data) ->
open(cast, {button,_}, Data) ->
{keep_state,Data,[postpone]};
...
- ]]></code>
+]]></code>
<p>
Since a postponed event is only retried after a state change,
you have to think about where to keep a state data item.
You can keep it in the server <c>Data</c>
or in the <c>State</c> itself,
for example by having two more or less identical states
- to keep a boolean value, or by using a complex state with
- <seealso marker="#Callback Modes">callback mode</seealso>
+ to keep a boolean value, or by using a complex state
+ (see section
+ <seealso marker="#Complex State">Complex State</seealso>)
+ with
+ <seealso marker="#Callback Modes">Callback Mode</seealso>
<seealso marker="stdlib:gen_statem#type-callback_mode"><c>handle_event_function</c></seealso>.
If a change in the value changes the set of events that is handled,
then the value should be kept in the State.
@@ -1134,28 +1555,38 @@ start_link(Code) ->
fun () ->
true = register(?NAME, self()),
do_lock(),
- locked(Code, Code)
+ locked(Code, length(Code), [])
end).
-button(Digit) ->
- ?NAME ! {button,Digit}.
-
-locked(Code, [Digit|Remaining]) ->
+button(Button) ->
+ ?NAME ! {button,Button}.
+ ]]></code>
+ <code type="erl"><![CDATA[
+locked(Code, Length, Buttons) ->
receive
- {button,Digit} when Remaining =:= [] ->
- do_unlock(),
- open(Code);
- {button,Digit} ->
- locked(Code, Remaining);
- {button,_} ->
- locked(Code, Code)
+ {button,Button} ->
+ NewButtons =
+ if
+ length(Buttons) < Length ->
+ Buttons;
+ true ->
+ tl(Buttons)
+ end ++ [Button],
+ if
+ NewButtons =:= Code -> % Correct
+ do_unlock(),
+ open(Code, Length);
+ true -> % Incomplete | Incorrect
+ locked(Code, Length, NewButtons)
+ end
end.
-
-open(Code) ->
+ ]]></code>
+ <code type="erl"><![CDATA[
+open(Code, Length) ->
receive
- after 10000 ->
+ after 10000 -> % Time in milliseconds
do_lock(),
- locked(Code, Code)
+ locked(Code, Length, [])
end.
do_lock() ->
@@ -1178,8 +1609,10 @@ do_unlock() ->
passing non-system messages to the callback module.
</p>
<p>
- The state transition
- <seealso marker="stdlib:gen_statem#type-action">action</seealso>
+ The
+ <seealso marker="#State Transition Actions">
+ State Transition Action
+ </seealso>
<c>postpone</c> is designed to model
selective receives. A selective receive implicitly postpones
any not received events, but the <c>postpone</c>
@@ -1196,16 +1629,16 @@ do_unlock() ->
<!-- =================================================================== -->
<section>
- <marker id="State Entry Actions" />
- <title>State Entry Actions</title>
+ <marker id="State Enter Actions" />
+ <title>State Enter Actions</title>
<p>
Say you have a state machine specification
- that uses state entry actions.
- Allthough you can code this using self-generated events
+ that uses state enter actions.
+ Allthough you can code this using inserted events
(described in the next section), especially if just
- one or a few states has got state entry actions,
+ one or a few states has got state enter actions,
this is a perfect use case for the built in
- <seealso marker="#State Enter Calls">state enter calls</seealso>.
+ <seealso marker="#State Enter Calls">State Enter Calls</seealso>.
</p>
<p>
You return a list containing <c>state_enter</c> from your
@@ -1219,7 +1652,7 @@ do_unlock() ->
...
init(Code) ->
process_flag(trap_exit, true),
- Data = #{code => Code},
+ Data = #{code => Code, length = length(Code)},
{ok, locked, Data}.
callback_mode() ->
@@ -1227,24 +1660,26 @@ callback_mode() ->
locked(enter, _OldState, Data) ->
do_lock(),
- {keep_state,Data#{remaining => Code}};
+ {keep_state,Data#{buttons => []}};
locked(
cast, {button,Digit},
- #{code := Code, remaining := Remaining} = Data) ->
- case Remaining of
- [Digit] ->
- {next_state, open, Data};
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+...
+ if
+ NewButtons =:= Code -> % Correct
+ {next_state, open, Data};
...
open(enter, _OldState, _Data) ->
do_unlock(),
- {keep_state_and_data, [{state_timeout,10000,lock}]};
+ {keep_state_and_data,
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
open(state_timeout, lock, Data) ->
{next_state, locked, Data};
...
- ]]></code>
+]]></code>
<p>
- You can repeat the state entry code by returning one of
+ You can repeat the state enter code by returning one of
<c>{repeat_state, ...}</c>, <c>{repeat_state_and_data,_}</c>
or <c>repeat_state_and_data</c> that otherwise behaves
exactly like their <c>keep_state</c> siblings.
@@ -1259,13 +1694,15 @@ open(state_timeout, lock, Data) ->
<!-- =================================================================== -->
<section>
- <marker id="Self-Generated Events" />
- <title>Self-Generated Events</title>
+ <marker id="Inserted Events" />
+ <title>Inserted Events</title>
<p>
It can sometimes be beneficial to be able to generate events
to your own state machine.
- This can be done with the state transition
- <seealso marker="stdlib:gen_statem#type-action">action</seealso>
+ This can be done with the
+ <seealso marker="#State Transition Actions">
+ State Transition Action
+ </seealso>
<c>{next_event,EventType,EventContent}</c>.
</p>
<p>
@@ -1279,58 +1716,75 @@ open(state_timeout, lock, Data) ->
<p>
One example for this is to pre-process incoming data, for example
decrypting chunks or collecting characters up to a line break.
+ </p>
+ <p>
Purists may argue that this should be modelled with a separate
state machine that sends pre-processed events
- to the main state machine.
- But to decrease overhead the small pre-processing state machine
+ to the main state machine,
+ but to decrease overhead the small pre-processing state machine
can be implemented in the common state event handling
of the main state machine using a few state data variables
that then sends the pre-processed events as internal events
to the main state machine.
+ Using internal events also can make it easier
+ to synchronize the state machines.
+ </p>
+ <p>
+ A variant of this is to use a
+ <seealso marker="#Complex State">
+ Complex State
+ </seealso>
+ with
+ <seealso marker="#One Event Handler">One Event Handler</seealso>.
+ The state is then modeled with for example a tuple
+ <c>{MainFSMState,SubFSMState}</c>.
</p>
<p>
- The following example uses an input model where you give the lock
- characters with <c>put_chars(Chars)</c> and then call
- <c>enter()</c> to finish the input.
+ To illustrate this we make up an example where the buttons
+ instead generate down and up (press and release) events,
+ and the lock responds to an up event only after
+ the corresponding down event.
</p>
<code type="erl"><![CDATA[
...
--export(put_chars/1, enter/0).
+-export(down/1, up/1).
...
-put_chars(Chars) when is_binary(Chars) ->
- gen_statem:call(?NAME, {chars,Chars}).
+down(Button) ->
+ gen_statem:cast(?NAME, {down,Button}).
-enter() ->
- gen_statem:call(?NAME, enter).
+up(Button) ->
+ gen_statem:cast(?NAME, {up,Button}).
...
locked(enter, _OldState, Data) ->
do_lock(),
{keep_state,Data#{remaining => Code, buf => []}};
+locked(
+ internal, {button,Digit},
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
...
-
-handle_event({call,From}, {chars,Chars}, #{buf := Buf} = Data) ->
- {keep_state, Data#{buf := [Chars|Buf],
- [{reply,From,ok}]};
-handle_event({call,From}, enter, #{buf := Buf} = Data) ->
- Chars = unicode:characters_to_binary(lists:reverse(Buf)),
- try binary_to_integer(Chars) of
- Digit ->
- {keep_state, Data#{buf := []},
- [{reply,From,ok},
- {next_event,internal,{button,Chars}}]}
- catch
- error:badarg ->
- {keep_state, Data#{buf := []},
- [{reply,From,{error,not_an_integer}}]}
+]]></code>
+ <code type="erl"><![CDATA[
+handle_common(cast, {down,Button}, Data) ->
+ {keep_state, Data#{button := Button}};
+handle_common(cast, {up,Button}, Data) ->
+ case Data of
+ #{button := Button} ->
+ {keep_state,maps:remove(button, Data),
+ [{next_event,internal,{button,Button}}]};
+ #{} ->
+ keep_state_and_data
end;
...
- ]]></code>
+
+open(internal, {button,_}, Data) ->
+ {keep_state,Data,[postpone]};
+...
+]]></code>
<p>
If you start this program with <c>code_lock:start([17])</c>
- you can unlock with <c>code_lock:put_chars(&lt;&lt;"001">>),
- code_lock:put_chars(&lt;&lt;"7">>), code_lock:enter()</c>.
+ you can unlock with <c>code_lock:down(17), code_lock:up(17).</c>
</p>
</section>
@@ -1344,14 +1798,16 @@ handle_event({call,From}, enter, #{buf := Buf} = Data) ->
modifications and some more using state enter calls,
which deserves a new state diagram:
</p>
- <image file="../design_principles/code_lock_2.png">
+ <!-- The image is edited with dia in a .dia file,
+ then exported to Scalable Vector Graphics. -->
+ <image file="../design_principles/code_lock_2.svg" width="80%">
<icaption>Code Lock State Diagram Revisited</icaption>
</image>
<p>
Notice that this state diagram does not specify how to handle
a button event in the state <c>open</c>. So, you need to
- read somewhere else that unspecified events
- must be ignored as in not consumed but handled in some other state.
+ read in some side notes, that is, here: that unspecified events
+ shall be postponed (handled in some later state).
Also, the state diagram does not show that the <c>code_length/0</c>
call must be handled in every state.
</p>
@@ -1368,8 +1824,8 @@ handle_event({call,From}, enter, #{buf := Buf} = Data) ->
-define(NAME, code_lock_2).
-export([start_link/1,stop/0]).
--export([button/1,code_length/0]).
--export([init/1,callback_mode/0,terminate/3,code_change/4]).
+-export([down/1,up/1,code_length/0]).
+-export([init/1,callback_mode/0,terminate/3]).
-export([locked/3,open/3]).
start_link(Code) ->
@@ -1377,52 +1833,75 @@ start_link(Code) ->
stop() ->
gen_statem:stop(?NAME).
-button(Digit) ->
- gen_statem:cast(?NAME, {button,Digit}).
+down(Digit) ->
+ gen_statem:cast(?NAME, {down,Digit}).
+up(Digit) ->
+ gen_statem:cast(?NAME, {up,Digit}).
code_length() ->
gen_statem:call(?NAME, code_length).
-
+ ]]></code>
+ <code type="erl"><![CDATA[
init(Code) ->
process_flag(trap_exit, true),
- Data = #{code => Code},
+ Data = #{code => Code, length => length(Code), buttons => []},
{ok, locked, Data}.
callback_mode() ->
[state_functions,state_enter].
-locked(enter, _OldState, #{code := Code} = Data) ->
+-define(HANDLE_COMMON,
+ ?FUNCTION_NAME(T, C, D) -> handle_common(T, C, D)).
+%%
+handle_common(cast, {down,Button}, Data) ->
+ {keep_state, Data#{button => Button}};
+handle_common(cast, {up,Button}, Data) ->
+ case Data of
+ #{button := Button} ->
+ {keep_state, maps:remove(button, Data),
+ [{next_event,internal,{button,Button}}]};
+ #{} ->
+ keep_state_and_data
+ end;
+handle_common({call,From}, code_length, #{code := Code}) ->
+ {keep_state_and_data,
+ [{reply,From,length(Code)}]}.
+ ]]></code>
+ <code type="erl"><![CDATA[
+locked(enter, _OldState, Data) ->
do_lock(),
- {keep_state, Data#{remaining => Code}};
-locked(
- timeout, _,
- #{code := Code, remaining := Remaining} = Data) ->
- {keep_state, Data#{remaining := Code}};
+ {keep_state, Data#{buttons := []}};
+locked(state_timeout, button, Data) ->
+ {keep_state, Data#{buttons := []}};
locked(
- cast, {button,Digit},
- #{code := Code, remaining := Remaining} = Data) ->
- case Remaining of
- [Digit] -> % Complete
+ internal, {button,Digit},
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+ NewButtons =
+ if
+ length(Buttons) < Length ->
+ Buttons;
+ true ->
+ tl(Buttons)
+ end ++ [Button],
+ if
+ NewButtons =:= Code -> % Correct
+ do_unlock(),
{next_state, open, Data};
- [Digit|Rest] -> % Incomplete
- {keep_state, Data#{remaining := Rest}, 30000};
- [_|_] -> % Wrong
- {keep_state, Data#{remaining := Code}}
+ true -> % Incomplete | Incorrect
+ {keep_state, Data#{buttons := NewButtons},
+ [{state_timeout,30000,button}]} % Time in milliseconds
end;
-locked(EventType, EventContent, Data) ->
- handle_event(EventType, EventContent, Data).
-
+?HANDLE_COMMON.
+]]></code>
+ <code type="erl"><![CDATA[
open(enter, _OldState, _Data) ->
do_unlock(),
- {keep_state_and_data, [{state_timeout,10000,lock}]};
+ {keep_state_and_data,
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
open(state_timeout, lock, Data) ->
{next_state, locked, Data};
-open(cast, {button,_}, _) ->
+open(internal, {button,_}, _) ->
{keep_state_and_data, [postpone]};
-open(EventType, EventContent, Data) ->
- handle_event(EventType, EventContent, Data).
-
-handle_event({call,From}, code_length, #{code := Code}) ->
- {keep_state_and_data, [{reply,From,length(Code)}]}.
+?HANDLE_COMMON.
do_lock() ->
io:format("Locked~n", []).
@@ -1432,9 +1911,7 @@ do_unlock() ->
terminate(_Reason, State, _Data) ->
State =/= locked andalso do_lock(),
ok.
-code_change(_Vsn, State, Data, _Extra) ->
- {ok,State,Data}.
- ]]></code>
+ ]]></code>
</section>
<section>
@@ -1448,54 +1925,72 @@ code_change(_Vsn, State, Data, _Extra) ->
so this example first branches depending on state:
</p>
<code type="erl"><![CDATA[
-...
-export([handle_event/4]).
-
-...
+]]></code>
+ <code type="erl"><![CDATA[
callback_mode() ->
[handle_event_function,state_enter].
-
+ ]]></code>
+ <code type="erl"><![CDATA[
+%%
%% State: locked
-handle_event(
- enter, _OldState, locked,
- #{code := Code} = Data) ->
+handle_event(enter, _OldState, locked, Data) ->
do_lock(),
- {keep_state, Data#{remaining => Code}};
-handle_event(
- timeout, _, locked,
- #{code := Code, remaining := Remaining} = Data) ->
- {keep_state, Data#{remaining := Code}};
+ {keep_state, Data#{buttons := []}};
+handle_event(state_timeout, button, locked, Data) ->
+ {keep_state, Data#{buttons := []}};
handle_event(
- cast, {button,Digit}, locked,
- #{code := Code, remaining := Remaining} = Data) ->
- case Remaining of
- [Digit] -> % Complete
+ internal, {button,Digit}, locked,
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+ NewButtons =
+ if
+ length(Buttons) < Length ->
+ Buttons;
+ true ->
+ tl(Buttons)
+ end ++ [Button],
+ if
+ NewButtons =:= Code -> % Correct
+ do_unlock(),
{next_state, open, Data};
- [Digit|Rest] -> % Incomplete
- {keep_state, Data#{remaining := Rest}, 30000};
- [_|_] -> % Wrong
- {keep_state, Data#{remaining := Code}}
+ true -> % Incomplete | Incorrect
+ {keep_state, Data#{buttons := NewButtons},
+ [{state_timeout,30000,button}]} % Time in milliseconds
end;
+ ]]></code>
+ <code type="erl"><![CDATA[
%%
%% State: open
handle_event(enter, _OldState, open, _Data) ->
do_unlock(),
- {keep_state_and_data, [{state_timeout,10000,lock}]};
+ {keep_state_and_data,
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
handle_event(state_timeout, lock, open, Data) ->
{next_state, locked, Data};
-handle_event(cast, {button,_}, open, _) ->
+handle_event(internal, {button,_}, open, _) ->
{keep_state_and_data,[postpone]};
-%%
-%% Any state
-handle_event({call,From}, code_length, _State, #{code := Code}) ->
- {keep_state_and_data, [{reply,From,length(Code)}]}.
-
-...
- ]]></code>
+ ]]></code>
+ <code type="erl"><![CDATA[
+%% Common events
+handle_event(cast, {down,Button}, _State, Data) ->
+ {keep_state, Data#{button => Button}};
+handle_event(cast, {up,Button}, _State, Data) ->
+ case Data of
+ #{button := Button} ->
+ {keep_state, maps:remove(button, Data),
+ [{next_event,internal,{button,Button}},
+ {state_timeout,30000,button}]}; % Time in milliseconds
+ #{} ->
+ keep_state_and_data
+ end;
+handle_event({call,From}, code_length, _State, #{length := Length}) ->
+ {keep_state_and_data,
+ [{reply,From,Length}]}.
+ ]]></code>
</section>
<p>
- Notice that postponing buttons from the <c>locked</c> state
- to the <c>open</c> state feels like a strange thing to do
+ Notice that postponing buttons from the <c>open</c> state
+ to the <c>locked</c> state feels like a strange thing to do
for a code lock, but it at least illustrates event postponing.
</p>
</section>
@@ -1532,7 +2027,7 @@ handle_event({call,From}, code_length, _State, #{code := Code}) ->
</p>
<code type="erl"><![CDATA[
...
--export([init/1,terminate/3,code_change/4,format_status/2]).
+-export([init/1,terminate/3,format_status/2]).
...
format_status(Opt, [_PDict,State,Data]) ->
@@ -1540,7 +2035,6 @@ format_status(Opt, [_PDict,State,Data]) ->
{State,
maps:filter(
fun (code, _) -> false;
- (remaining, _) -> false;
(_, _) -> true
end,
Data)},
@@ -1576,10 +2070,10 @@ format_status(Opt, [_PDict,State,Data]) ->
<p>
One reason to use this is when you have a state item
that when changed should cancel the
- <seealso marker="#State Time-Outs">state time-out</seealso>,
+ <seealso marker="#State Time-Outs">State Time-Out</seealso>,
or one that affects the event handling
in combination with postponing events.
- We will complicate the previous example
+ We will go for the latter and complicate the previous example
by introducing a configurable lock button
(this is the state item in question),
which in the <c>open</c> state immediately locks the door,
@@ -1588,33 +2082,33 @@ format_status(Opt, [_PDict,State,Data]) ->
<p>
Suppose now that we call <c>set_lock_button</c>
while the door is open,
- and have already postponed a button event
- that until now was not the lock button.
- The sensible thing can be to say that
- the button was pressed too early so it is
- not to be recognized as the lock button.
- However, then it can be surprising that a button event
- that now is the lock button event arrives (as retried postponed)
- immediately after the state transits to <c>locked</c>.
- </p>
- <p>
- So we make the <c>button/1</c> function synchronous
- by using
- <seealso marker="stdlib:gen_statem#call/2"><c>gen_statem:call</c></seealso>
- and still postpone its events in the <c>open</c> state.
- Then a call to <c>button/1</c> during the <c>open</c>
- state does not return until the state transits to <c>locked</c>,
- as it is there the event is handled and the reply is sent.
- </p>
- <p>
- If a process now calls <c>set_lock_button/1</c>
- to change the lock button while another process
- hangs in <c>button/1</c> with the new lock button,
- it can be expected that the hanging lock button call
- immediately takes effect and locks the lock.
- Therefore, we make the current lock button a part of the state,
- so that when we change the lock button, the state changes
- and all postponed events are retried.
+ and we have already postponed a button event
+ that was the new lock button:
+ </p>
+ <code type="erl"><![CDATA[
+1> code_lock:start_link([a,b,c], x).
+{ok,<0.666.0>}
+2> code_lock:button(a).
+ok
+3> code_lock:button(b).
+ok
+4> code_lock:button(c).
+ok
+Open
+5> code_lock:button(y).
+ok
+6> code_lock:set_lock_button(y).
+x
+% What should happen here? Immediate lock or nothing?
+]]></code>
+ <p>
+ We could say that the button was pressed too early
+ so it is not to be recognized as the lock button.
+ Or we can make the lock button part of the state so
+ when we then change the lock button in the locked state,
+ the change becomes a state change
+ and all postponed events are retried,
+ therefore the lock is immediately locked!
</p>
<p>
We define the state as <c>{StateName,LockButton}</c>,
@@ -1627,8 +2121,8 @@ format_status(Opt, [_PDict,State,Data]) ->
-define(NAME, code_lock_3).
-export([start_link/2,stop/0]).
--export([button/1,code_length/0,set_lock_button/1]).
--export([init/1,callback_mode/0,terminate/3,code_change/4,format_status/2]).
+-export([button/1,set_lock_button/1]).
+-export([init/1,callback_mode/0,terminate/3]).
-export([handle_event/4]).
start_link(Code, LockButton) ->
@@ -1637,77 +2131,69 @@ start_link(Code, LockButton) ->
stop() ->
gen_statem:stop(?NAME).
-button(Digit) ->
- gen_statem:call(?NAME, {button,Digit}).
-code_length() ->
- gen_statem:call(?NAME, code_length).
+button(Button) ->
+ gen_statem:cast(?NAME, {button,Button}).
set_lock_button(LockButton) ->
gen_statem:call(?NAME, {set_lock_button,LockButton}).
-
+ ]]></code>
+ <code type="erl"><![CDATA[
init({Code,LockButton}) ->
process_flag(trap_exit, true),
- Data = #{code => Code, remaining => undefined},
+ Data = #{code => Code, length => length(Code), buttons => []},
{ok, {locked,LockButton}, Data}.
callback_mode() ->
[handle_event_function,state_enter].
-handle_event(
- {call,From}, {set_lock_button,NewLockButton},
- {StateName,OldLockButton}, Data) ->
- {next_state, {StateName,NewLockButton}, Data,
- [{reply,From,OldLockButton}]};
-handle_event(
- {call,From}, code_length,
- {_StateName,_LockButton}, #{code := Code}) ->
- {keep_state_and_data,
- [{reply,From,length(Code)}]};
-%%
%% State: locked
+handle_event(enter, _OldState, {locked,_}, Data) ->
+ do_lock(),
+ {keep_state, Data#{buttons := []}};
+handle_event(state_timeout, button, {locked,_}, Data) ->
+ {keep_state, Data#{buttons := []}};
handle_event(
- EventType, EventContent,
- {locked,LockButton}, #{code := Code, remaining := Remaining} = Data) ->
- case {EventType, EventContent} of
- {enter, _OldState} ->
- do_lock(),
- {keep_state, Data#{remaining := Code}};
- {timeout, _} ->
- {keep_state, Data#{remaining := Code}};
- {{call,From}, {button,Digit}} ->
- case Remaining of
- [Digit] -> % Complete
- {next_state, {open,LockButton}, Data,
- [{reply,From,ok}]};
- [Digit|Rest] -> % Incomplete
- {keep_state, Data#{remaining := Rest},
- [{reply,From,ok}, 30000]};
- [_|_] -> % Wrong
- {keep_state, Data#{remaining := Code},
- [{reply,From,ok}]}
- end
+ cast, {button,Digit}, {locked,LockButton},
+ #{code := Code, length := Length, buttons := Buttons} = Data) ->
+ NewButtons =
+ if
+ length(Buttons) < Length ->
+ Buttons;
+ true ->
+ tl(Buttons)
+ end ++ [Button],
+ if
+ NewButtons =:= Code -> % Correct
+ do_unlock(),
+ {next_state, {open,LockButton}, Data};
+ true -> % Incomplete | Incorrect
+ {keep_state, Data#{buttons := NewButtons},
+ [{state_timeout,30000,button}]} % Time in milliseconds
end;
+ ]]></code>
+ <code type="erl"><![CDATA[
%%
%% State: open
+handle_event(enter, _OldState, {open,_}, _Data) ->
+ do_unlock(),
+ {keep_state_and_data,
+ [{state_timeout,10000,lock}]}; % Time in milliseconds
+handle_event(state_timeout, lock, {open,_}, Data) ->
+ {next_state, locked, Data};
+handle_event(cast, {button,LockButton}, {open,LockButton}, Data) ->
+ {next_state, {locked,LockButton}, Data};
+handle_event(cast, {button,_}, {open,_}, Data) ->
+ {keep_state_and_data,[postpone]};
+ ]]></code>
+ <code type="erl"><![CDATA[
+%%
+%% Common events
handle_event(
- EventType, EventContent,
- {open,LockButton}, Data) ->
- case {EventType, EventContent} of
- {enter, _OldState} ->
- do_unlock(),
- {keep_state_and_data, [{state_timeout,10000,lock}]};
- {state_timeout, lock} ->
- {next_state, {locked,LockButton}, Data};
- {{call,From}, {button,Digit}} ->
- if
- Digit =:= LockButton ->
- {next_state, {locked,LockButton}, Data,
- [{reply,From,locked}]};
- true ->
- {keep_state_and_data,
- [postpone]}
- end
- end.
-
+ {call,From}, {set_lock_button,NewLockButton},
+ {StateName,OldLockButton}, Data) ->
+ {next_state, {StateName,NewLockButton}, Data,
+ [{reply,From,OldLockButton}]}.
+ ]]></code>
+ <code type="erl"><![CDATA[
do_lock() ->
io:format("Locked~n", []).
do_unlock() ->
@@ -1716,29 +2202,7 @@ do_unlock() ->
terminate(_Reason, State, _Data) ->
State =/= locked andalso do_lock(),
ok.
-code_change(_Vsn, State, Data, _Extra) ->
- {ok,State,Data}.
-format_status(Opt, [_PDict,State,Data]) ->
- StateData =
- {State,
- maps:filter(
- fun (code, _) -> false;
- (remaining, _) -> false;
- (_, _) -> true
- end,
- Data)},
- case Opt of
- terminate ->
- StateData;
- normal ->
- [{data,[{"State",StateData}]}]
- end.
]]></code>
- <p>
- It can be an ill-fitting model for a physical code lock
- that the <c>button/1</c> call can hang until the lock
- is locked. But for an API in general it is not that strange.
- </p>
</section>
<!-- =================================================================== -->
@@ -1770,17 +2234,15 @@ format_status(Opt, [_PDict,State,Data]) ->
</p>
<code type="erl"><![CDATA[
...
+%%
%% State: open
-handle_event(
- EventType, EventContent,
- {open,LockButton}, Data) ->
- case {EventType, EventContent} of
- {enter, _OldState} ->
- do_unlock(),
- {keep_state_and_data,
- [{state_timeout,10000,lock},hibernate]};
+handle_event(enter, _OldState, {open,_}, _Data) ->
+ do_unlock(),
+ {keep_state_and_data,
+ [{state_timeout,10000,lock}, % Time in milliseconds
+ hibernate]};
...
- ]]></code>
+]]></code>
<p>
The atom
<seealso marker="stdlib:gen_statem#type-hibernate"><c>hibernate</c></seealso>
@@ -1793,20 +2255,34 @@ handle_event(
<p>
To change that we would need to insert
action <c>hibernate</c> in more places.
- For example, for the state-independent <c>set_lock_button</c>
- and <c>code_length</c> operations that then would have to
- be aware of using <c>hibernate</c> while in the
+ For example, the state-independent <c>set_lock_button</c>
+ operation would have to use <c>hibernate</c> but only in the
<c>{open,_}</c> state, which would clutter the code.
</p>
<p>
- Another not uncommon scenario is to use the event time-out
- to triger hibernation after a certain time of inactivity.
+ Another not uncommon scenario is to use the
+ <seealso marker="#Event Time-Outs">Event Time-Out</seealso>
+ to trigger hibernation after a certain time of inactivity.
+ There is also a server start option
+ <seealso marker="stdlib:gen_statem#type-hibernate_after_opt">
+ <c>{hibernate_after, Timeout}</c>
+ </seealso>
+ for
+ <seealso marker="stdlib:gen_statem#start/3">
+ <c>start/3,4</c>
+ </seealso>
+ or
+ <seealso marker="stdlib:gen_statem#start_link/3">
+ <c>start_link/3,4</c>
+ </seealso>
+ that may be used to automatically hibernate the server.
</p>
<p>
- This server probably does not use
+ This particular server probably does not use
heap memory worth hibernating for.
To gain anything from hibernation, your server would
- have to produce some garbage during callback execution,
+ have to produce non-insignificant garbage
+ during callback execution,
for which this example server can serve as a bad example.
</p>
</section>