aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Makefile.in3
-rw-r--r--erts/doc/src/erl_driver.xml19
-rw-r--r--erts/doc/src/erts_alloc.xml58
-rw-r--r--erts/emulator/Makefile.in5
-rw-r--r--erts/emulator/beam/atom.names3
-rw-r--r--erts/emulator/beam/beam_bif_load.c25
-rw-r--r--erts/emulator/beam/beam_bp.c30
-rw-r--r--erts/emulator/beam/beam_catches.c46
-rw-r--r--erts/emulator/beam/beam_debug.c5
-rw-r--r--erts/emulator/beam/beam_emu.c3
-rw-r--r--erts/emulator/beam/bif.c13
-rw-r--r--erts/emulator/beam/bif.tab4
-rw-r--r--erts/emulator/beam/break.c11
-rw-r--r--erts/emulator/beam/dist.c9
-rw-r--r--erts/emulator/beam/erl_afit_alloc.c18
-rw-r--r--erts/emulator/beam/erl_alloc.c1289
-rw-r--r--erts/emulator/beam/erl_alloc.h186
-rw-r--r--erts/emulator/beam/erl_alloc.types62
-rw-r--r--erts/emulator/beam/erl_alloc_util.c1015
-rw-r--r--erts/emulator/beam/erl_alloc_util.h109
-rw-r--r--erts/emulator/beam/erl_ao_firstfit_alloc.c16
-rw-r--r--erts/emulator/beam/erl_async.c737
-rw-r--r--erts/emulator/beam/erl_async.h66
-rw-r--r--erts/emulator/beam/erl_bestfit_alloc.c16
-rw-r--r--erts/emulator/beam/erl_bif_info.c119
-rw-r--r--erts/emulator/beam/erl_bif_timer.c3
-rw-r--r--erts/emulator/beam/erl_bif_trace.c37
-rw-r--r--erts/emulator/beam/erl_db.c3
-rw-r--r--erts/emulator/beam/erl_db_util.c5
-rw-r--r--erts/emulator/beam/erl_driver.h15
-rw-r--r--erts/emulator/beam/erl_drv_thread.c8
-rw-r--r--erts/emulator/beam/erl_gc.c8
-rw-r--r--erts/emulator/beam/erl_goodfit_alloc.c18
-rw-r--r--erts/emulator/beam/erl_init.c135
-rw-r--r--erts/emulator/beam/erl_lock_check.c14
-rw-r--r--erts/emulator/beam/erl_mtrace.c8
-rw-r--r--erts/emulator/beam/erl_nif.c9
-rw-r--r--erts/emulator/beam/erl_node_tables.c5
-rw-r--r--erts/emulator/beam/erl_port_task.c26
-rw-r--r--erts/emulator/beam/erl_process.c1552
-rw-r--r--erts/emulator/beam/erl_process.h116
-rw-r--r--erts/emulator/beam/erl_process_lock.h17
-rw-r--r--erts/emulator/beam/erl_sched_spec_pre_alloc.c305
-rw-r--r--erts/emulator/beam/erl_sched_spec_pre_alloc.h239
-rw-r--r--erts/emulator/beam/erl_smp.h10
-rw-r--r--erts/emulator/beam/erl_thr_progress.c1373
-rw-r--r--erts/emulator/beam/erl_thr_progress.h233
-rw-r--r--erts/emulator/beam/erl_thr_queue.c745
-rw-r--r--erts/emulator/beam/erl_thr_queue.h211
-rw-r--r--erts/emulator/beam/erl_threads.h14
-rw-r--r--erts/emulator/beam/erl_trace.c113
-rw-r--r--erts/emulator/beam/erl_vm.h6
-rw-r--r--erts/emulator/beam/export.c6
-rw-r--r--erts/emulator/beam/fix_alloc.c287
-rw-r--r--erts/emulator/beam/global.h8
-rw-r--r--erts/emulator/beam/io.c6
-rw-r--r--erts/emulator/beam/module.c5
-rw-r--r--erts/emulator/beam/sys.h301
-rw-r--r--erts/emulator/beam/time.c2
-rw-r--r--erts/emulator/beam/utils.c701
-rw-r--r--erts/emulator/hipe/hipe_bif_list.m41
-rw-r--r--erts/emulator/sys/common/erl_check_io.c25
-rw-r--r--erts/emulator/sys/common/erl_check_io.h9
-rw-r--r--erts/emulator/sys/common/erl_mseg.c668
-rw-r--r--erts/emulator/sys/common/erl_mseg.h11
-rw-r--r--erts/emulator/sys/common/erl_poll.c193
-rw-r--r--erts/emulator/sys/common/erl_poll.h5
-rw-r--r--erts/emulator/sys/unix/erl_unix_sys.h6
-rw-r--r--erts/emulator/sys/unix/sys.c224
-rw-r--r--erts/emulator/sys/vxworks/sys.c17
-rw-r--r--erts/emulator/sys/win32/erl_poll.c6
-rw-r--r--erts/emulator/sys/win32/sys.c146
-rw-r--r--erts/emulator/sys/win32/sys_env.c14
-rw-r--r--erts/emulator/sys/win32/sys_interrupt.c5
-rw-r--r--erts/emulator/test/driver_SUITE.erl156
-rw-r--r--erts/emulator/test/driver_SUITE_data/Makefile.src4
-rw-r--r--erts/emulator/test/driver_SUITE_data/async_blast_drv.c124
-rw-r--r--erts/emulator/test/driver_SUITE_data/thr_free_drv.c241
-rw-r--r--erts/emulator/test/mtx_SUITE.erl13
-rw-r--r--erts/emulator/test/system_info_SUITE.erl313
-rw-r--r--erts/etc/common/erlc.c1
-rw-r--r--erts/etc/common/erlexec.c3
-rw-r--r--erts/include/internal/ethr_mutex.h115
-rw-r--r--erts/include/internal/ethread.h1
-rw-r--r--erts/lib_src/common/ethr_mutex.c496
-rw-r--r--erts/preloaded/ebin/erl_prim_loader.beambin52880 -> 50320 bytes
-rw-r--r--erts/preloaded/ebin/erlang.beambin26772 -> 39568 bytes
-rw-r--r--erts/preloaded/ebin/init.beambin45172 -> 45264 bytes
-rw-r--r--erts/preloaded/ebin/otp_ring0.beambin1432 -> 1528 bytes
-rw-r--r--erts/preloaded/ebin/prim_file.beambin32332 -> 32448 bytes
-rw-r--r--erts/preloaded/ebin/prim_inet.beambin64884 -> 65000 bytes
-rw-r--r--erts/preloaded/ebin/prim_zip.beambin22436 -> 22532 bytes
-rw-r--r--erts/preloaded/ebin/zlib.beambin12608 -> 11836 bytes
-rw-r--r--erts/preloaded/src/erlang.erl404
-rw-r--r--lib/crypto/c_src/crypto.c27
-rw-r--r--lib/crypto/doc/src/crypto.xml30
-rw-r--r--lib/crypto/src/crypto.erl34
-rw-r--r--lib/crypto/test/crypto_SUITE.erl22
-rw-r--r--lib/dialyzer/src/dialyzer_contracts.erl2
-rw-r--r--lib/dialyzer/src/dialyzer_typesig.erl22
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/crash1
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy4
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy_28
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash1
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy.erl14
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy_2.erl14
-rw-r--r--lib/diameter/doc/src/diameter.xml123
-rw-r--r--lib/diameter/include/diameter_gen.hrl8
-rw-r--r--lib/diameter/src/Makefile4
-rw-r--r--lib/diameter/src/base/diameter_capx.erl29
-rw-r--r--lib/diameter/src/base/diameter_codec.erl22
-rw-r--r--lib/diameter/src/base/diameter_peer_fsm.erl298
-rw-r--r--lib/diameter/src/base/diameter_service.erl116
-rw-r--r--lib/diameter/src/base/diameter_watchdog.erl10
-rw-r--r--lib/diameter/test/Makefile41
-rw-r--r--lib/diameter/test/depend.sed18
-rw-r--r--lib/diameter/test/diameter_capx_SUITE.erl432
-rw-r--r--lib/diameter/test/diameter_codec_test.erl2
-rw-r--r--lib/diameter/test/diameter_failover_SUITE.erl7
-rw-r--r--lib/diameter/test/diameter_relay_SUITE.erl7
-rw-r--r--lib/diameter/test/diameter_tls_SUITE.erl7
-rw-r--r--lib/diameter/test/diameter_traffic_SUITE.erl13
-rw-r--r--lib/diameter/test/diameter_transport_SUITE.erl2
-rw-r--r--lib/diameter/test/diameter_util.erl18
-rw-r--r--lib/diameter/test/diameter_watchdog_SUITE.erl2
-rw-r--r--lib/diameter/test/modules.mk1
-rw-r--r--lib/diameter/test/release.sed35
-rw-r--r--lib/megaco/doc/src/notes.xml7
-rw-r--r--lib/mnesia/doc/src/notes.xml30
-rw-r--r--lib/mnesia/src/mnesia.appup.src4
-rw-r--r--lib/mnesia/src/mnesia_bup.erl4
-rw-r--r--lib/mnesia/src/mnesia_controller.erl35
-rw-r--r--lib/mnesia/src/mnesia_event.erl6
-rw-r--r--lib/mnesia/src/mnesia_frag.erl12
-rw-r--r--lib/mnesia/src/mnesia_monitor.erl6
-rw-r--r--lib/mnesia/src/mnesia_schema.erl108
-rw-r--r--lib/mnesia/test/mnesia_evil_backup.erl8
-rw-r--r--lib/mnesia/test/mnesia_evil_coverage_test.erl4
-rw-r--r--lib/mnesia/test/mnesia_install_test.erl23
-rw-r--r--lib/mnesia/vsn.mk2
-rw-r--r--lib/public_key/asn1/InformationFramework.asn1682
-rw-r--r--lib/public_key/asn1/Makefile20
-rw-r--r--lib/public_key/asn1/PKCS-8.asn183
-rw-r--r--lib/public_key/asn1/PKCS-FRAME.set.asn3
-rw-r--r--lib/public_key/asn1/PKCS5v2-0.asn1142
-rw-r--r--lib/public_key/doc/src/public_key.xml23
-rw-r--r--lib/public_key/include/public_key.hrl1
-rw-r--r--lib/public_key/src/Makefile6
-rw-r--r--lib/public_key/src/pubkey_pbe.erl213
-rw-r--r--lib/public_key/src/pubkey_pem.erl81
-rw-r--r--lib/public_key/src/public_key.app.src4
-rw-r--r--lib/public_key/src/public_key.erl102
-rw-r--r--lib/public_key/test/Makefile3
-rw-r--r--lib/public_key/test/pbe_SUITE.erl259
-rw-r--r--lib/public_key/test/pbe_SUITE_data/des_cbc_enc_key.pem11
-rw-r--r--lib/public_key/test/pbe_SUITE_data/des_ede3_cbc_enc_key.pem11
-rw-r--r--lib/public_key/test/pbe_SUITE_data/rc2_cbc_enc_key.pem12
-rw-r--r--lib/public_key/test/public_key_SUITE.erl27
-rw-r--r--lib/runtime_tools/src/erts_alloc_config.erl10
-rw-r--r--lib/ssl/doc/src/ssl.xml5
-rw-r--r--lib/ssl/src/ssl.erl7
-rw-r--r--lib/ssl/src/ssl_connection.erl28
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl16
-rw-r--r--lib/ssl/test/ssl_test_lib.erl14
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl11
-rw-r--r--lib/stdlib/test/ets_SUITE.erl215
-rw-r--r--lib/stdlib/test/supervisor_SUITE.erl25
-rw-r--r--lib/xmerl/include/xmerl.hrl17
-rw-r--r--lib/xmerl/src/xmerl_lib.erl3
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_base.erlsrc38
-rw-r--r--lib/xmerl/src/xmerl_scan.erl376
-rw-r--r--lib/xmerl/src/xmerl_validate.erl103
-rw-r--r--lib/xmerl/src/xmerl_xpath.erl114
-rw-r--r--lib/xmerl/src/xmerl_xpath_lib.erl4
-rw-r--r--lib/xmerl/src/xmerl_xpath_parse.yrl1
-rw-r--r--lib/xmerl/src/xmerl_xpath_pred.erl9
-rw-r--r--lib/xmerl/src/xmerl_xsd.erl63
-rw-r--r--lib/xmerl/test/xmerl_SUITE.erl36
-rw-r--r--lib/xmerl/test/xmerl_SUITE_data/misc.tar.gzbin47340 -> 48157 bytes
-rw-r--r--lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl2
-rw-r--r--lib/xmerl/vsn.mk2
181 files changed, 13039 insertions, 4978 deletions
diff --git a/Makefile.in b/Makefile.in
index 7baf5cc3aa..9ac516ca33 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -854,7 +854,8 @@ tests release_tests: $(TEST_DIRS)
$(TEST_DIRS):
if test -f $@/Makefile; then \
- (cd $@; $(MAKE) TESTROOT=$(TESTSUITE_ROOT) release_tests) || exit $$?; \
+ (cd $@; $(MAKE) TESTROOT=$(TESTSUITE_ROOT) \
+ PATH=$(ERL_TOP)/bin:$(BOOT_PREFIX)$${PATH} release_tests) || exit $$?; \
fi
#
diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml
index 2fb03954b6..8e18dd6657 100644
--- a/erts/doc/src/erl_driver.xml
+++ b/erts/doc/src/erl_driver.xml
@@ -1638,12 +1638,19 @@ ERL_DRV_EXT2TERM char *buf, ErlDrvUInt len
<fsummary>Cancel an asynchronous call</fsummary>
<desc>
<marker id="driver_async_cancel"></marker>
- <p>This function cancels an asynchronous operation, by removing
- it from the queue. Only functions in the queue can be
- cancelled; if a function is executing, it's too late to
- cancel it. The <c>async_free</c> function is also called.</p>
- <p>The return value is 1 if the operation was removed from the
- queue, otherwise 0.</p>
+ <p>This function used to cancel a scheduled asynchronous operation,
+ if it was still in the queue. It returned 1 if it succeeded, and
+ 0 if it failed.</p>
+ <p>Since it could not guarantee success, it was more or less useless.
+ The user had to implement synchronization of cancellation anyway.
+ It also unnecessarily complicated the implementation. Therefore,
+ as of OTP-R15B <c>driver_async_cancel()</c> is deprecated, and
+ scheduled for removal in OTP-R16. It will currently always fail,
+ and return 0.</p>
+ <warning><p><c>driver_async_cancel()</c> is deferred and will
+ be removed in the OTP-R16 release.</p>
+ </warning>
+
</desc>
</func>
<func>
diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml
index 86e1e5168a..3b5ee5391c 100644
--- a/erts/doc/src/erts_alloc.xml
+++ b/erts/doc/src/erts_alloc.xml
@@ -58,11 +58,8 @@
<item>Allocator used for memory blocks that are expected to be
long-lived, for example Erlang code.</item>
<tag><c>fix_alloc</c></tag>
- <item>A very fast allocator used for some fix-sized
- data. <c>fix_alloc</c> manages a set of memory pools from
- which memory blocks are handed out. <c>fix_alloc</c>
- allocates memory pools from <c>ll_alloc</c>. Memory pools
- that have been allocated are never deallocated.</item>
+ <item>A fast allocator used for some frequently used
+ fixed size data types.</item>
<tag><c>std_alloc</c></tag>
<item>Allocator used for most memory blocks not allocated via any of
the other allocators described above.</item>
@@ -83,7 +80,7 @@
where only small blocks are placed. Currently this allocator is
disabled by default.</item>
</taglist>
- <p><c>sys_alloc</c> and <c>fix_alloc</c> are always enabled and
+ <p><c>sys_alloc</c> is always enabled and
cannot be disabled. <c>mseg_alloc</c> is always enabled if it is
available and an allocator that uses it is enabled. All other
allocators can be <seealso marker="#M_e">enabled or disabled</seealso>.
@@ -104,7 +101,7 @@
<marker id="alloc_util"></marker>
<title>The alloc_util framework</title>
<p>Internally a framework called <c>alloc_util</c> is used for
- implementing allocators. <c>sys_alloc</c>, <c>fix_alloc</c>, and
+ implementing allocators. <c>sys_alloc</c>, and
<c>mseg_alloc</c> do not use this framework; hence, the
following does <em>not</em> apply to them.</p>
<p>An allocator manages multiple areas, called carriers, in which
@@ -212,6 +209,14 @@
This since it will only cause problems for other allocators.</p>
</item>
</taglist>
+ <p>Apart from the ordinary allocators described above a number of
+ pre-allocators are used for some specific data types. These
+ pre-allocators pre-allocate a fixed amount of memory for certain data
+ types when the run-time system starts. As long as there are available
+ pre-allocated memory, it will be used. When no pre-allocated memory is
+ available, memory will be allocated in ordinary allocators. These
+ pre-allocators are typically much faster than the ordinary allocators,
+ but can only satisfy a limited amount of requests.</p>
</section>
<note><p>
@@ -272,18 +277,6 @@
Max cached segments. The maximum number of memory segments
stored in the memory segment cache. Valid range is
0-30. Default value is 5.</item>
- <tag><marker id="MMcci"><c><![CDATA[+MMcci <time>]]></c></marker></tag>
- <item>
- Cache check interval (in milliseconds). The memory segment
- cache is checked for segments to destroy at an interval
- determined by this parameter. Default value is 1000.</item>
- </taglist>
- <p>The following flags are available for configuration of
- <c>fix_alloc</c>:</p>
- <taglist>
- <tag><marker id="MFe"><c>+MFe true</c></marker></tag>
- <item>
- Enable <c>fix_alloc</c>. Note: <c>fix_alloc</c> cannot be disabled.</item>
</taglist>
<p>The following flags are available for configuration of
<c>sys_alloc</c>:</p>
@@ -322,7 +315,7 @@
based on <c>alloc_util</c>. If <c>u</c> is used as subsystem
identifier (i.e., <c><![CDATA[<S> = u]]></c>) all allocators based on
<c>alloc_util</c> will be effected. If <c>B</c>, <c>D</c>, <c>E</c>,
- <c>H</c>, <c>L</c>, <c>R</c>, <c>S</c>, or <c>T</c> is used as
+ <c>F</c>, <c>H</c>, <c>L</c>, <c>R</c>, <c>S</c>, or <c>T</c> is used as
subsystem identifier, only the specific allocator identified will be
effected:</p>
<taglist>
@@ -441,26 +434,23 @@
kilobytes). See <seealso marker="#mseg_mbc_sizes">the description
on how sizes for mseg_alloc multiblock carriers are decided</seealso>
in "the <c>alloc_util</c> framework" section.</item>
- <tag><marker id="M_t"><c><![CDATA[+M<S>t true|false|<amount>]]></c></marker></tag>
+ <tag><marker id="M_t"><c><![CDATA[+M<S>t true|false]]></c></marker></tag>
<item>
- <p>Multiple, thread specific instances of the allocator.
- This option will only have any effect on the runtime system
- with SMP support. Default behaviour on the runtime system with
- SMP support (<c>N</c> equals the number of scheduler threads):</p>
+ Multiple, thread specific instances of the allocator.
+ This option will only have any effect on the runtime system
+ with SMP support. Default behaviour on the runtime system with
+ SMP support:
<taglist>
- <tag><c>temp_alloc</c></tag>
- <item><c>N + 1</c> instances.</item>
<tag><c>ll_alloc</c></tag>
<item><c>1</c> instance.</item>
<tag>Other allocators</tag>
- <item><c>N</c> instances when <c>N</c> is less than or equal to
- <c>16</c>. <c>16</c> instances when <c>N</c> is greater than
- <c>16</c>.</item>
+ <item><c>NoSchedulers+1</c> instances. Each scheduler will use
+ a lock-free instance of its own and other threads will use
+ a common instance.</item>
</taglist>
- <p><c>temp_alloc</c> will always use <c>N + 1</c> instances when
- this option has been enabled regardless of the amount passed.
- Other allocators will use the same amount of instances as the
- amount passed as long as it isn't greater than <c>N</c>.</p>
+ It was previously (before ERTS version 5.9) possible to configure
+ a smaller amount of thread specific instances than schedulers.
+ This is, however, not possible any more.
</item>
</taglist>
<p>Currently the following flags are available for configuration of
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 6cd9be5680..708d4ca0a3 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -721,7 +721,7 @@ RUN_OBJS = \
$(OBJDIR)/external.o $(OBJDIR)/dist.o \
$(OBJDIR)/binary.o $(OBJDIR)/erl_db.o \
$(OBJDIR)/erl_db_util.o $(OBJDIR)/erl_db_hash.o \
- $(OBJDIR)/erl_db_tree.o $(OBJDIR)/fix_alloc.o \
+ $(OBJDIR)/erl_db_tree.o $(OBJDIR)/erl_thr_progress.o \
$(OBJDIR)/big.o $(OBJDIR)/hash.o \
$(OBJDIR)/index.o $(OBJDIR)/atom.o \
$(OBJDIR)/module.o $(OBJDIR)/export.o \
@@ -738,7 +738,8 @@ RUN_OBJS = \
$(OBJDIR)/erl_bif_re.o $(OBJDIR)/erl_unicode.o \
$(OBJDIR)/packet_parser.o $(OBJDIR)/safe_hash.o \
$(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o \
- $(OBJDIR)/erl_bif_binary.o $(OBJDIR)/erl_ao_firstfit_alloc.o
+ $(OBJDIR)/erl_bif_binary.o $(OBJDIR)/erl_ao_firstfit_alloc.o \
+ $(OBJDIR)/erl_thr_queue.o $(OBJDIR)/erl_sched_spec_pre_alloc.o
ifeq ($(TARGET),win32)
DRV_OBJS = \
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index e7308dbf43..71454b3e57 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -69,6 +69,8 @@ atom ac
atom active
atom all
atom all_but_first
+atom alloc_info
+atom alloc_sizes
atom allocated
atom allocated_areas
atom allocator
@@ -555,5 +557,6 @@ atom warning_msg
atom wordsize
atom write_concurrency
atom xor
+atom x86
atom yes
atom yield
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 8c1f85ea37..294b1578be 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -33,6 +33,7 @@
#include "beam_catches.h"
#include "erl_binary.h"
#include "erl_nif.h"
+#include "erl_thr_progress.h"
static void set_default_trace_pattern(Eterm module);
static Eterm check_process_code(Process* rp, Module* modp);
@@ -64,7 +65,7 @@ load_module_2(BIF_ALIST_2)
goto error;
}
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
hp = HAlloc(BIF_P, 3);
sz = binary_size(BIF_ARG_2);
@@ -101,7 +102,7 @@ load_module_2(BIF_ALIST_2)
done:
erts_free_aligned_binary_bytes(temp_alloc);
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(res);
@@ -116,12 +117,12 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
}
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
erts_export_consolidate();
purge_res = purge_module(atom_val(BIF_ARG_1));
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
if (purge_res < 0) {
@@ -150,12 +151,12 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3)
Eterm res;
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
erts_export_consolidate();
res = erts_make_stub_module(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
return res;
}
@@ -237,7 +238,7 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1)
goto badarg;
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
{
Module *modp = erts_get_module(BIF_ARG_1);
@@ -258,7 +259,7 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1)
}
}
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
if (res == am_badarg) {
@@ -350,7 +351,7 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
}
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
if (BIF_ARG_2 == am_true) {
int i;
@@ -389,7 +390,7 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
modp->catches = BEAM_CATCHES_NIL;
remove_from_address_table(code);
}
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(am_true);
}
@@ -726,10 +727,10 @@ delete_code(Process *c_p, ErtsProcLocks c_p_locks, Module* modp)
if (modp->code != NULL && modp->code[MI_NUM_BREAKPOINTS] > 0) {
if (c_p && c_p_locks)
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
erts_clear_module_break(modp);
modp->code[MI_NUM_BREAKPOINTS] = 0;
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
if (c_p && c_p_locks)
erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
}
diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c
index c90795c343..dd31376a2d 100644
--- a/erts/emulator/beam/beam_bp.c
+++ b/erts/emulator/beam/beam_bp.c
@@ -167,7 +167,7 @@ erts_bp_init(void) {
int
erts_set_trace_break(Eterm mfa[3], int specified, Binary *match_spec,
Eterm tracer_pid) {
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
return set_break(mfa, specified, match_spec,
(BeamInstr) BeamOp(op_i_trace_breakpoint), 0, tracer_pid);
}
@@ -175,7 +175,7 @@ erts_set_trace_break(Eterm mfa[3], int specified, Binary *match_spec,
int
erts_set_mtrace_break(Eterm mfa[3], int specified, Binary *match_spec,
Eterm tracer_pid) {
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
return set_break(mfa, specified, match_spec,
(BeamInstr) BeamOp(op_i_mtrace_breakpoint), 0, tracer_pid);
}
@@ -184,7 +184,7 @@ erts_set_mtrace_break(Eterm mfa[3], int specified, Binary *match_spec,
void
erts_set_mtrace_bif(BeamInstr *pc, Binary *match_spec, Eterm tracer_pid) {
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
set_function_break(NULL, pc, BREAK_IS_BIF, match_spec, (BeamInstr) BeamOp(op_i_mtrace_breakpoint), 0, tracer_pid);
}
@@ -198,35 +198,35 @@ void erts_clear_time_trace_bif(BeamInstr *pc) {
int
erts_set_debug_break(Eterm mfa[3], int specified) {
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
return set_break(mfa, specified, NULL,
(BeamInstr) BeamOp(op_i_debug_breakpoint), 0, NIL);
}
int
erts_set_count_break(Eterm mfa[3], int specified, enum erts_break_op count_op) {
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
return set_break(mfa, specified, NULL,
(BeamInstr) BeamOp(op_i_count_breakpoint), count_op, NIL);
}
int
erts_set_time_break(Eterm mfa[3], int specified, enum erts_break_op count_op) {
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
return set_break(mfa, specified, NULL,
(BeamInstr) BeamOp(op_i_time_breakpoint), count_op, NIL);
}
int
erts_clear_trace_break(Eterm mfa[3], int specified) {
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
return clear_break(mfa, specified,
(BeamInstr) BeamOp(op_i_trace_breakpoint));
}
int
erts_clear_mtrace_break(Eterm mfa[3], int specified) {
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
return clear_break(mfa, specified,
(BeamInstr) BeamOp(op_i_mtrace_breakpoint));
}
@@ -238,41 +238,41 @@ erts_clear_mtrace_bif(BeamInstr *pc) {
int
erts_clear_debug_break(Eterm mfa[3], int specified) {
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
return clear_break(mfa, specified,
(BeamInstr) BeamOp(op_i_debug_breakpoint));
}
int
erts_clear_count_break(Eterm mfa[3], int specified) {
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
return clear_break(mfa, specified,
(BeamInstr) BeamOp(op_i_count_breakpoint));
}
int
erts_clear_time_break(Eterm mfa[3], int specified) {
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
return clear_break(mfa, specified,
(BeamInstr) BeamOp(op_i_time_breakpoint));
}
int
erts_clear_break(Eterm mfa[3], int specified) {
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
return clear_break(mfa, specified, 0);
}
int
erts_clear_module_break(Module *modp) {
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
ASSERT(modp);
return clear_module_break(modp, NULL, 0, 0);
}
int
erts_clear_function_break(Module *modp, BeamInstr *pc) {
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
ASSERT(modp);
return clear_function_break(modp, pc, BREAK_IS_ERL, 0);
}
@@ -981,7 +981,7 @@ static int set_function_break(Module *modp, BeamInstr *pc, int bif,
BpDataTime *bdt = (BpDataTime *) bd;
Uint i = 0;
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
if (count_op == erts_break_stop) {
bdt->pause = 1;
diff --git a/erts/emulator/beam/beam_catches.c b/erts/emulator/beam/beam_catches.c
index e795b4efbd..a550ec5ad0 100644
--- a/erts/emulator/beam/beam_catches.c
+++ b/erts/emulator/beam/beam_catches.c
@@ -22,21 +22,27 @@
#endif
#include "sys.h"
#include "beam_catches.h"
+#include "global.h"
-/* XXX: should use dynamic reallocation */
-#define TABSIZ (16*1024)
-static struct {
+/* R14B04 has about 380 catches when starting erlang */
+#define DEFAULT_TABSIZE (1024)
+typedef struct {
BeamInstr *cp;
unsigned cdr;
-} beam_catches[TABSIZ];
+} beam_catch_t;
static int free_list;
static unsigned high_mark;
+static unsigned tabsize;
+static beam_catch_t *beam_catches;
void beam_catches_init(void)
{
+ tabsize = DEFAULT_TABSIZE;
free_list = -1;
high_mark = 0;
+
+ beam_catches = erts_alloc(ERTS_ALC_T_CODE, sizeof(beam_catch_t)*DEFAULT_TABSIZE);
}
unsigned beam_catches_cons(BeamInstr *cp, unsigned cdr)
@@ -50,16 +56,21 @@ unsigned beam_catches_cons(BeamInstr *cp, unsigned cdr)
* This avoids the need to initialise the free list in
* beam_catches_init(), which would cost O(TABSIZ) time.
*/
- if( (i = free_list) >= 0 ) {
+ if( free_list >= 0 ) {
+ i = free_list;
free_list = beam_catches[i].cdr;
- } else if( (i = high_mark) < TABSIZ ) {
- high_mark = i + 1;
+ } else if( high_mark < tabsize ) {
+ i = high_mark;
+ high_mark++;
} else {
- fprintf(stderr, "beam_catches_cons: no free slots :-(\r\n");
- exit(1);
+ /* No free slots and table is full: realloc table */
+ tabsize = 2*tabsize;
+ beam_catches = erts_realloc(ERTS_ALC_T_CODE, beam_catches, sizeof(beam_catch_t)*tabsize);
+ i = high_mark;
+ high_mark++;
}
- beam_catches[i].cp = cp;
+ beam_catches[i].cp = cp;
beam_catches[i].cdr = cdr;
return i;
@@ -67,10 +78,8 @@ unsigned beam_catches_cons(BeamInstr *cp, unsigned cdr)
BeamInstr *beam_catches_car(unsigned i)
{
- if( i >= TABSIZ ) {
- fprintf(stderr,
- "beam_catches_car: index %#x is out of range\r\n", i);
- abort();
+ if( i >= tabsize ) {
+ erl_exit(1, "beam_catches_delmod: index %#x is out of range\r\n", i);
}
return beam_catches[i].cp;
}
@@ -80,18 +89,15 @@ void beam_catches_delmod(unsigned head, BeamInstr *code, unsigned code_bytes)
unsigned i, cdr;
for(i = head; i != (unsigned)-1;) {
- if( i >= TABSIZ ) {
- fprintf(stderr,
- "beam_catches_delmod: index %#x is out of range\r\n", i);
- abort();
+ if( i >= tabsize ) {
+ erl_exit(1, "beam_catches_delmod: index %#x is out of range\r\n", i);
}
if( (char*)beam_catches[i].cp - (char*)code >= code_bytes ) {
- fprintf(stderr,
+ erl_exit(1,
"beam_catches_delmod: item %#x has cp %#lx which is not "
"in module's range [%#lx,%#lx[\r\n",
i, (long)beam_catches[i].cp,
(long)code, (long)((char*)code + code_bytes));
- abort();
}
beam_catches[i].cp = 0;
cdr = beam_catches[i].cdr;
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index 18c5081d4c..8041c92162 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -37,6 +37,7 @@
#include "beam_load.h"
#include "beam_bp.h"
#include "erl_binary.h"
+#include "erl_thr_progress.h"
#ifdef ARCH_64
# define HEXF "%016bpX"
@@ -114,7 +115,7 @@ erts_debug_breakpoint_2(BIF_ALIST_2)
}
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
if (bool == am_true) {
res = make_small(erts_set_debug_break(mfa, specified));
@@ -122,7 +123,7 @@ erts_debug_breakpoint_2(BIF_ALIST_2)
res = make_small(erts_clear_debug_break(mfa, specified));
}
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
return res;
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 6e6380d6b1..9c5450bd48 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -36,6 +36,7 @@
#include "dist.h"
#include "beam_bp.h"
#include "beam_catches.h"
+#include "erl_thr_progress.h"
#ifdef HIPE
#include "hipe_mode_switch.h"
#include "hipe_bif1.h"
@@ -70,7 +71,7 @@ do { \
} \
else \
erts_lc_check_exact(NULL, 0); \
- ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); \
+ ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking()); \
} while (0)
# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \
if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN)
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 4bfae7e2db..8ab363a1ec 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -36,6 +36,7 @@
#include "beam_bp.h"
#include "erl_db_util.h"
#include "register.h"
+#include "erl_thr_progress.h"
static Export* flush_monitor_message_trap = NULL;
static Export* set_cpu_topology_trap = NULL;
@@ -4033,11 +4034,11 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
}
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
H_MIN_SIZE = erts_next_heap_size(n, 0);
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(make_small(oval));
@@ -4049,11 +4050,11 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
}
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
BIN_VH_MIN_SIZE = erts_next_heap_size(n, 0);
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(make_small(oval));
@@ -4087,7 +4088,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
Uint i;
ErlMessage* mp;
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
for (i = 0; i < erts_max_processes; i++) {
if (process_tab[i] != (Process*) 0) {
@@ -4104,7 +4105,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
}
}
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(am_true);
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index ba30fa85b8..987008c937 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -160,10 +160,6 @@ bif erlang:md5_update/2
bif 'erl.util.crypt.md5':update/2 ebif_md5_update_2
bif erlang:md5_final/1
bif 'erl.util.crypt.md5':final/1 ebif_md5_final_1
-bif erlang:memory/0
-bif 'erl.lang':memory/0 ebif_memory_0
-bif erlang:memory/1
-bif 'erl.lang':memory/1 ebif_memory_1
bif erlang:module_loaded/1
bif 'erl.system.code':is_loaded/1 ebif_is_loaded_1 module_loaded_1
bif erlang:function_exported/3
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index 8132bbeaa1..784e55ecd2 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -37,6 +37,7 @@
#include "beam_load.h"
#include "erl_instrument.h"
#include "erl_bif_timer.h"
+#include "erl_thr_progress.h"
/* Forward declarations -- should really appear somewhere else */
static void process_killer(void);
@@ -653,20 +654,18 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
if (ERTS_SOMEONE_IS_CRASH_DUMPING)
return;
- /* Wait for all threads to block. If all threads haven't blocked
+#ifdef ERTS_SMP
+ /*
+ * Wait for all managed threads to block. If all threads haven't blocked
* after a minute, we go anyway and hope for the best...
*
* We do not release system again. We expect an exit() or abort() after
* dump has been written.
- *
- * NOTE: We allow gc therefore it is important not to lock *any*
- * process locks.
*/
- erts_smp_emergency_block_system(60000, ERTS_BS_FLG_ALLOW_GC);
+ erts_thr_progress_fatal_error_block(60000);
/* Either worked or not... */
/* Allow us to pass certain places without locking... */
-#ifdef ERTS_SMP
erts_smp_atomic32_set_mb(&erts_writing_erl_crash_dump, 1);
erts_smp_tsd_set(erts_is_crash_dumping_key, (void *) 1);
#else
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index 29b83520dd..264374789c 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -41,6 +41,7 @@
#include "bif.h"
#include "external.h"
#include "erl_binary.h"
+#include "erl_thr_progress.h"
/* Turn this on to get printouts of all distribution messages
* which go on the line
@@ -430,11 +431,11 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason)
erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx);
nodename = erts_this_dist_entry->sysname;
- erts_smp_block_system(ERTS_BS_FLG_ALLOW_GC);
+ erts_smp_thr_progress_block();
erts_set_this_node(am_Noname, 0);
erts_is_alive = 0;
send_nodes_mon_msgs(NULL, am_nodedown, nodename, am_visible, nd_reason);
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
}
else { /* recursive call via erts_do_exit_port() will end up here */
@@ -2330,11 +2331,11 @@ BIF_RETTYPE setnode_2(BIF_ALIST_2)
#endif
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(ERTS_BS_FLG_ALLOW_GC);
+ erts_smp_thr_progress_block();
erts_set_this_node(BIF_ARG_1, (Uint32) creation);
erts_is_alive = 1;
send_nodes_mon_msgs(NULL, am_nodeup, BIF_ARG_1, am_visible, NIL);
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(am_true);
diff --git a/erts/emulator/beam/erl_afit_alloc.c b/erts/emulator/beam/erl_afit_alloc.c
index bcc7ea04ae..570cc59be2 100644
--- a/erts/emulator/beam/erl_afit_alloc.c
+++ b/erts/emulator/beam/erl_afit_alloc.c
@@ -65,16 +65,20 @@ erts_afalc_start(AFAllctr_t *afallctr,
AFAllctrInit_t *afinit,
AllctrInit_t *init)
{
- AFAllctr_t nulled_state = {{0}};
- /* {{0}} is used instead of {0}, in order to avoid (an incorrect) gcc
- warning. gcc warns if {0} is used as initializer of a struct when
- the first member is a struct (not if, for example, the third member
- is a struct). */
+ struct {
+ int dummy;
+ AFAllctr_t allctr;
+ } zero = {0};
+ /* The struct with a dummy element first is used in order to avoid (an
+ incorrect) gcc warning. gcc warns if {0} is used as initializer of
+ a struct when the first member is a struct (not if, for example,
+ the third member is a struct). */
+
Allctr_t *allctr = (Allctr_t *) afallctr;
- init->sbmbct = 0; /* Small mbc not supported by afit */
+ sys_memcpy((void *) afallctr, (void *) &zero.allctr, sizeof(AFAllctr_t));
- sys_memcpy((void *) afallctr, (void *) &nulled_state, sizeof(AFAllctr_t));
+ init->sbmbct = 0; /* Small mbc not supported by afit */
allctr->mbc_header_size = sizeof(Carrier_t);
allctr->min_mbc_size = MIN_MBC_SZ;
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 9af80dd7a9..33d6cf5f2f 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -40,6 +40,8 @@
#include "erl_mseg.h"
#include "erl_monitors.h"
#include "erl_bif_timer.h"
+#include "erl_cpu_topology.h"
+#include "erl_thr_queue.h"
#if defined(ERTS_ALC_T_DRV_SEL_D_STATE) || defined(ERTS_ALC_T_DRV_EV_D_STATE)
#include "erl_check_io.h"
#endif
@@ -54,7 +56,14 @@
#include "erl_ao_firstfit_alloc.h"
-#define ERTS_ALC_DEFAULT_MAX_THR_PREF 16
+#if ERTS_MAX_NO_OF_SCHEDULERS > ERTS_AU_MAX_PREF_ALLOC_INSTANCES
+# error "Too many schedulers; cannot create that many pref alloc instances"
+#endif
+
+#define ERTS_ALC_FIX_TYPE_IX(T) \
+ (ERTS_ALC_T2N((T)) - ERTS_ALC_N_MIN_A_FIXED_SIZE)
+
+#define ERTS_ALC_DEFAULT_MAX_THR_PREF ERTS_MAX_NO_OF_SCHEDULERS
#if defined(SMALL_MEMORY) || defined(PURIFY) || defined(VALGRIND)
#define AU_ALLOC_DEFAULT_ENABLE(X) 0
@@ -106,24 +115,43 @@ static ErtsAllocatorState_t eheap_alloc_state;
static ErtsAllocatorState_t binary_alloc_state;
static ErtsAllocatorState_t ets_alloc_state;
static ErtsAllocatorState_t driver_alloc_state;
+static ErtsAllocatorState_t fix_alloc_state;
-ErtsAlcType_t erts_fix_core_allocator_ix;
-#ifdef ERTS_ALC_N_MIN_A_FIXED_SIZE
-static void *(*fix_core_allocator)(ErtsAlcType_t, void *, Uint);
-static void *fix_core_extra;
-static void *fix_core_alloc(Uint size)
+typedef struct {
+ erts_smp_atomic32_t refc;
+ int only_sz;
+ Uint req_sched;
+ Process *proc;
+ Eterm ref;
+ Eterm ref_heap[REF_THING_SIZE];
+ int allocs[ERTS_ALC_A_MAX-ERTS_ALC_A_MIN+1+2];
+} ErtsAllocInfoReq;
+
+#define ERTS_ALC_INFO_A_ALLOC_UTIL (ERTS_ALC_A_MAX + 1)
+#define ERTS_ALC_INFO_A_MSEG_ALLOC (ERTS_ALC_A_MAX + 2)
+#define ERTS_ALC_INFO_A_MAX ERTS_ALC_INFO_A_MSEG_ALLOC
+
+#if !HALFWORD_HEAP
+ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(aireq,
+ ErtsAllocInfoReq,
+ 5,
+ ERTS_ALC_T_AINFO_REQ)
+#else
+static ERTS_INLINE ErtsAllocInfoReq *
+aireq_alloc(void)
{
- void *res;
- res = (*fix_core_allocator)(ERTS_ALC_T_UNDEF, fix_core_extra, size);
- if (erts_mtrace_enabled)
- erts_mtrace_crr_alloc(res,
- ERTS_ALC_A_FIXED_SIZE,
- erts_fix_core_allocator_ix,
- size);
- return res;
+ return erts_alloc(ERTS_ALC_T_AINFO_REQ, sizeof(ErtsAllocInfoReq));
+}
+
+static ERTS_INLINE void
+aireq_free(ErtsAllocInfoReq *ptr)
+{
+ erts_free(ERTS_ALC_T_AINFO_REQ, ptr);
}
#endif
+ErtsAlcType_t erts_fix_core_allocator_ix;
+
enum allctr_type {
GOODFIT,
BESTFIT,
@@ -181,6 +209,7 @@ typedef struct {
struct au_init binary_alloc;
struct au_init ets_alloc;
struct au_init driver_alloc;
+ struct au_init fix_alloc;
#if HALFWORD_HEAP
struct au_init sbmbc_low_alloc;
struct au_init std_low_alloc;
@@ -393,46 +422,52 @@ set_default_driver_alloc_opts(struct au_init *ip)
ip->init.util.ts = ERTS_ALC_MTA_DRIVER;
}
+static void
+set_default_fix_alloc_opts(struct au_init *ip,
+ size_t *fix_type_sizes)
+{
+ SET_DEFAULT_ALLOC_OPTS(ip);
+ ip->enable = AU_ALLOC_DEFAULT_ENABLE(1);
+ ip->thr_spec = 1;
+ ip->atype = BESTFIT;
+ ip->init.bf.ao = 1;
+ ip->init.util.name_prefix = "fix_";
+ ip->init.util.fix_type_size = fix_type_sizes;
+ ip->init.util.alloc_no = ERTS_ALC_A_FIXED_SIZE;
+#ifndef SMALL_MEMORY
+ ip->init.util.mmbcs = 128*1024; /* Main carrier size */
+#else
+ ip->init.util.mmbcs = 128*1024; /* Main carrier size */
+#endif
+ ip->init.util.ts = ERTS_ALC_MTA_FIXED_SIZE;
+}
+
#ifdef ERTS_SMP
static void
adjust_tpref(struct au_init *ip, int no_sched)
{
if (ip->thr_spec) {
- Uint allocs;
- if (ip->thr_spec < 0) {/* User specified amount */
- allocs = abs(ip->thr_spec);
- if (allocs > no_sched)
- allocs = no_sched;
- }
- else if (no_sched > ERTS_ALC_DEFAULT_MAX_THR_PREF)
- allocs = ERTS_ALC_DEFAULT_MAX_THR_PREF;
- else
- allocs = no_sched;
- if (allocs <= 1)
- ip->thr_spec = 0;
- else {
- ip->thr_spec = (int) allocs;
- ip->thr_spec *= -1; /* thread preferred */
-
- /* If default ... */
-
- /* ... shrink main multi-block carrier size */
- if (ip->default_.mmbcs)
- ip->init.util.mmbcs /= ERTS_MIN(4, allocs);
- /* ... shrink largest multi-block carrier size */
- if (ip->default_.lmbcs)
- ip->init.util.lmbcs /= ERTS_MIN(2, allocs);
- /* ... shrink smallest multi-block carrier size */
- if (ip->default_.smbcs)
- ip->init.util.smbcs /= ERTS_MIN(4, allocs);
- /* ... and more than three allocators shrink
- max mseg multi-block carriers */
- if (ip->default_.mmmbc && allocs > 2) {
- ip->init.util.mmmbc /= ERTS_MIN(4, allocs - 1);
- if (ip->init.util.mmmbc < 3)
- ip->init.util.mmmbc = 3;
- }
+ ip->thr_spec = no_sched;
+ ip->thr_spec *= -1; /* thread preferred */
+
+ /* If default ... */
+
+ /* ... shrink main multi-block carrier size */
+ if (ip->default_.mmbcs)
+ ip->init.util.mmbcs /= ERTS_MIN(4, no_sched);
+ /* ... shrink largest multi-block carrier size */
+ if (ip->default_.lmbcs)
+ ip->init.util.lmbcs /= ERTS_MIN(2, no_sched);
+ /* ... shrink smallest multi-block carrier size */
+ if (ip->default_.smbcs)
+ ip->init.util.smbcs /= ERTS_MIN(4, no_sched);
+ /* ... and more than three allocators shrink
+ max mseg multi-block carriers */
+ if (ip->default_.mmmbc && no_sched > 2) {
+ ip->init.util.mmmbc /= ERTS_MIN(4, no_sched - 1);
+ if (ip->init.util.mmmbc < 3)
+ ip->init.util.mmmbc = 3;
}
}
}
@@ -442,7 +477,7 @@ adjust_tpref(struct au_init *ip, int no_sched)
static void handle_args(int *, char **, erts_alc_hndl_args_init_t *);
static void
-set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init);
+set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu);
static void
start_au_allocator(ErtsAlcType_t alctr_n,
@@ -456,8 +491,6 @@ refuse_af_strategy(struct au_init *init)
init->atype = GOODFIT;
}
-static void init_thr_ix(int static_ixs);
-
#ifdef HARD_DEBUG
static void hdbg_init(void);
#endif
@@ -466,7 +499,7 @@ void
erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
{
UWord extra_block_size = 0;
- int i;
+ int i, ncpu;
erts_alc_hndl_args_init_t init = {
0,
#if HAVE_ERTS_MSEG
@@ -474,17 +507,38 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
#endif
ERTS_DEFAULT_TRIM_THRESHOLD,
ERTS_DEFAULT_TOP_PAD,
- ERTS_DEFAULT_ALCU_INIT
+ ERTS_DEFAULT_ALCU_INIT,
};
+ size_t fix_type_sizes[ERTS_ALC_NO_FIXED_SIZES] = {0};
+ fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_PROC)]
+ = sizeof(Process);
+#if !HALFWORD_HEAP
+ fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MONITOR_SH)]
+ = ERTS_MONITOR_SH_SIZE;
+ fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_NLINK_SH)]
+ = ERTS_LINK_SH_SIZE;
+#endif
+ fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_EV_D_STATE)]
+ = sizeof(ErtsDrvEventDataState);
+ fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_SEL_D_STATE)]
+ = sizeof(ErtsDrvSelectDataState);
+ fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MSG_REF)]
+ = sizeof(ErlMessage);
+#ifdef ERTS_SMP
+ fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_THR_Q_EL_SL)]
+ = sizeof(ErtsThrQElement_t);
+#endif
#ifdef HARD_DEBUG
hdbg_init();
#endif
erts_have_sbmbc_alloc = 0;
+ ncpu = eaiop->ncpu;
+ if (ncpu < 1)
+ ncpu = 1;
erts_sys_alloc_init();
- init_thr_ix(erts_no_schedulers);
erts_init_utils_mem();
set_default_sbmbc_alloc_opts(&init.sbmbc_alloc);
@@ -496,20 +550,23 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
set_default_binary_alloc_opts(&init.binary_alloc);
set_default_ets_alloc_opts(&init.ets_alloc);
set_default_driver_alloc_opts(&init.driver_alloc);
+ set_default_fix_alloc_opts(&init.fix_alloc,
+ fix_type_sizes);
if (argc && argv)
handle_args(argc, argv, &init);
- if (erts_no_schedulers <= 1) {
- init.sbmbc_alloc.thr_spec = 0;
- init.sl_alloc.thr_spec = 0;
- init.std_alloc.thr_spec = 0;
- init.ll_alloc.thr_spec = 0;
- init.eheap_alloc.thr_spec = 0;
- init.binary_alloc.thr_spec = 0;
- init.ets_alloc.thr_spec = 0;
- init.driver_alloc.thr_spec = 0;
- }
+#ifndef ERTS_SMP
+ init.sbmbc_alloc.thr_spec = 0;
+ init.sl_alloc.thr_spec = 0;
+ init.std_alloc.thr_spec = 0;
+ init.ll_alloc.thr_spec = 0;
+ init.eheap_alloc.thr_spec = 0;
+ init.binary_alloc.thr_spec = 0;
+ init.ets_alloc.thr_spec = 0;
+ init.driver_alloc.thr_spec = 0;
+ init.fix_alloc.thr_spec = 0;
+#endif
if (init.erts_alloc_config) {
/* Adjust flags that erts_alloc_config won't like */
@@ -522,6 +579,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
init.binary_alloc.thr_spec = 0;
init.ets_alloc.thr_spec = 0;
init.driver_alloc.thr_spec = 0;
+ init.fix_alloc.thr_spec = 0;
}
#ifdef ERTS_SMP
@@ -538,6 +596,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
adjust_tpref(&init.binary_alloc, erts_no_schedulers);
adjust_tpref(&init.ets_alloc, erts_no_schedulers);
adjust_tpref(&init.driver_alloc, erts_no_schedulers);
+ adjust_tpref(&init.fix_alloc, erts_no_schedulers);
#else
/* No thread specific if not smp */
@@ -556,6 +615,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
refuse_af_strategy(&init.binary_alloc);
refuse_af_strategy(&init.ets_alloc);
refuse_af_strategy(&init.driver_alloc);
+ refuse_af_strategy(&init.fix_alloc);
#ifdef ERTS_SMP
if (!init.temp_alloc.thr_spec)
@@ -564,6 +624,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
erts_mtrace_pre_init();
#if HAVE_ERTS_MSEG
+ init.mseg.nos = erts_no_schedulers;
erts_mseg_init(&init.mseg);
#endif
erts_alcu_init(&init.alloc_util);
@@ -583,20 +644,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
erts_allctrs_info[i].extra = NULL;
}
-#ifdef ERTS_ALC_N_MIN_A_FIXED_SIZE
-#if !defined(PURIFY) && !defined(VALGRIND)
- erts_allctrs[ERTS_ALC_A_FIXED_SIZE].alloc = erts_fix_alloc;
- erts_allctrs[ERTS_ALC_A_FIXED_SIZE].realloc = erts_fix_realloc;
- erts_allctrs[ERTS_ALC_A_FIXED_SIZE].free = erts_fix_free;
- erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].enabled = 1;
-#else
- erts_allctrs[ERTS_ALC_A_FIXED_SIZE].alloc = erts_sys_alloc;
- erts_allctrs[ERTS_ALC_A_FIXED_SIZE].realloc = erts_sys_realloc;
- erts_allctrs[ERTS_ALC_A_FIXED_SIZE].free = erts_sys_free;
- erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].enabled = 0;
-#endif
-#endif
-
erts_allctrs[ERTS_ALC_A_SYSTEM].alloc = erts_sys_alloc;
erts_allctrs[ERTS_ALC_A_SYSTEM].realloc = erts_sys_realloc;
erts_allctrs[ERTS_ALC_A_SYSTEM].free = erts_sys_free;
@@ -621,20 +668,21 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
init.ll_low_alloc.init.util.force = 1;
init.ll_low_alloc.init.util.low_mem = 1;
- set_au_allocator(ERTS_ALC_A_SBMBC_LOW, &init.sbmbc_low_alloc);
- set_au_allocator(ERTS_ALC_A_STANDARD_LOW, &init.std_low_alloc);
- set_au_allocator(ERTS_ALC_A_LONG_LIVED_LOW, &init.ll_low_alloc);
+ set_au_allocator(ERTS_ALC_A_SBMBC_LOW, &init.sbmbc_low_alloc, ncpu);
+ set_au_allocator(ERTS_ALC_A_STANDARD_LOW, &init.std_low_alloc, ncpu);
+ set_au_allocator(ERTS_ALC_A_LONG_LIVED_LOW, &init.ll_low_alloc, ncpu);
#endif /* HALFWORD */
- set_au_allocator(ERTS_ALC_A_TEMPORARY, &init.temp_alloc);
- set_au_allocator(ERTS_ALC_A_SBMBC, &init.sbmbc_alloc);
- set_au_allocator(ERTS_ALC_A_SHORT_LIVED, &init.sl_alloc);
- set_au_allocator(ERTS_ALC_A_STANDARD, &init.std_alloc);
- set_au_allocator(ERTS_ALC_A_LONG_LIVED, &init.ll_alloc);
- set_au_allocator(ERTS_ALC_A_EHEAP, &init.eheap_alloc);
- set_au_allocator(ERTS_ALC_A_BINARY, &init.binary_alloc);
- set_au_allocator(ERTS_ALC_A_ETS, &init.ets_alloc);
- set_au_allocator(ERTS_ALC_A_DRIVER, &init.driver_alloc);
+ set_au_allocator(ERTS_ALC_A_TEMPORARY, &init.temp_alloc, ncpu);
+ set_au_allocator(ERTS_ALC_A_SBMBC, &init.sbmbc_alloc, ncpu);
+ set_au_allocator(ERTS_ALC_A_SHORT_LIVED, &init.sl_alloc, ncpu);
+ set_au_allocator(ERTS_ALC_A_STANDARD, &init.std_alloc, ncpu);
+ set_au_allocator(ERTS_ALC_A_LONG_LIVED, &init.ll_alloc, ncpu);
+ set_au_allocator(ERTS_ALC_A_EHEAP, &init.eheap_alloc, ncpu);
+ set_au_allocator(ERTS_ALC_A_BINARY, &init.binary_alloc, ncpu);
+ set_au_allocator(ERTS_ALC_A_ETS, &init.ets_alloc, ncpu);
+ set_au_allocator(ERTS_ALC_A_DRIVER, &init.driver_alloc, ncpu);
+ set_au_allocator(ERTS_ALC_A_FIXED_SIZE, &init.fix_alloc, ncpu);
for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
if (!erts_allctrs[i].alloc)
@@ -650,10 +698,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
sys_alloc_opt(SYS_ALLOC_OPT_TRIM_THRESHOLD, init.trim_threshold);
sys_alloc_opt(SYS_ALLOC_OPT_TOP_PAD, init.top_pad);
- if (erts_allctrs_info[ERTS_FIX_CORE_ALLOCATOR].enabled)
- erts_fix_core_allocator_ix = ERTS_FIX_CORE_ALLOCATOR;
- else
- erts_fix_core_allocator_ix = ERTS_ALC_A_SYSTEM;
erts_mtrace_init(init.instr.mtrace, init.instr.nodename);
@@ -710,49 +754,40 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
&init.driver_alloc,
&driver_alloc_state);
- fix_core_allocator = erts_allctrs[erts_fix_core_allocator_ix].alloc;
- fix_core_extra = erts_allctrs[erts_fix_core_allocator_ix].extra;
+ start_au_allocator(ERTS_ALC_A_FIXED_SIZE,
+ &init.fix_alloc,
+ &fix_alloc_state);
erts_mtrace_install_wrapper_functions();
extra_block_size += erts_instr_init(init.instr.stat, init.instr.map);
+#if !HALFWORD_HEAP
+ init_aireq_alloc();
+#endif
+
#ifdef DEBUG
extra_block_size += install_debug_functions();
#endif
-#ifdef ERTS_ALC_N_MIN_A_FIXED_SIZE
-
- erts_init_fix_alloc(extra_block_size, fix_core_alloc);
-
+}
-#if !defined(PURIFY) && !defined(VALGRIND)
- erts_set_fix_size(ERTS_ALC_T_PROC, sizeof(Process));
- erts_set_fix_size(ERTS_ALC_T_DB_TABLE, sizeof(DbTable));
- erts_set_fix_size(ERTS_ALC_T_ATOM, sizeof(Atom));
+void
+erts_alloc_late_init(void)
+{
- erts_set_fix_size(ERTS_ALC_T_MODULE, sizeof(Module));
- erts_set_fix_size(ERTS_ALC_T_REG_PROC, sizeof(RegProc));
- erts_set_fix_size(ERTS_ALC_T_FUN_ENTRY, sizeof(ErlFunEntry));
-#ifdef ERTS_ALC_T_DRV_EV_D_STATE
- erts_set_fix_size(ERTS_ALC_T_DRV_EV_D_STATE,
- sizeof(ErtsDrvEventDataState));
-#endif
-#ifdef ERTS_ALC_T_DRV_SEL_D_STATE
- erts_set_fix_size(ERTS_ALC_T_DRV_SEL_D_STATE,
- sizeof(ErtsDrvSelectDataState));
-#endif
-#if !HALFWORD_HEAP
- erts_set_fix_size(ERTS_ALC_T_EXPORT, sizeof(Export));
- erts_set_fix_size(ERTS_ALC_T_MONITOR_SH, ERTS_MONITOR_SH_SIZE*sizeof(Uint));
- erts_set_fix_size(ERTS_ALC_T_NLINK_SH, ERTS_LINK_SH_SIZE*sizeof(Uint));
-#endif
-#endif
-#endif
+}
+static void *
+erts_realloc_fixed_size(ErtsAlcType_t type, void *extra, void *p, Uint size)
+{
+ erl_exit(ERTS_ABORT_EXIT,
+ "Attempt to reallocate a block of the fixed size type %s\n",
+ ERTS_ALC_T2TD(type));
}
+
static void
-set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init)
+set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu)
{
ErtsAllocatorFunctions_t *af = &erts_allctrs[alctr_n];
ErtsAllocatorInfo_t *ai = &erts_allctrs_info[alctr_n];
@@ -764,6 +799,12 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init)
if (init->init.util.force)
init->enable = 1;
+ tspec->enabled = 0;
+ tspec->dd = 0;
+ tspec->aix = alctr_n;
+ tspec->size = 0;
+ ai->thr_spec = 0;
+
if (!init->enable) {
af->alloc = erts_sys_alloc;
af->realloc = erts_sys_realloc;
@@ -775,14 +816,14 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init)
return;
}
- tspec->enabled = 0;
- tspec->all_thr_safe = 0;
- ai->thr_spec = 0;
#ifdef USE_THREADS
+#ifdef ERTS_SMP
if (init->thr_spec) {
if (init->thr_spec > 0) {
af->alloc = erts_alcu_alloc_thr_spec;
- if (init->init.util.ramv)
+ if (init->init.util.fix_type_size)
+ af->realloc = erts_realloc_fixed_size;
+ else if (init->init.util.ramv)
af->realloc = erts_alcu_realloc_mv_thr_spec;
else
af->realloc = erts_alcu_realloc_thr_spec;
@@ -790,12 +831,14 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init)
}
else {
af->alloc = erts_alcu_alloc_thr_pref;
- if (init->init.util.ramv)
+ if (init->init.util.fix_type_size)
+ af->realloc = erts_realloc_fixed_size;
+ else if (init->init.util.ramv)
af->realloc = erts_alcu_realloc_mv_thr_pref;
else
af->realloc = erts_alcu_realloc_thr_pref;
af->free = erts_alcu_free_thr_pref;
- tspec->all_thr_safe = 1;
+ tspec->dd = 1;
}
tspec->enabled = 1;
@@ -803,9 +846,13 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init)
ai->thr_spec = tspec->size;
}
- else if (init->init.util.ts) {
+ else
+#endif
+ if (init->init.util.ts) {
af->alloc = erts_alcu_alloc_ts;
- if (init->init.util.ramv)
+ if (init->init.util.fix_type_size)
+ af->realloc = erts_realloc_fixed_size;
+ else if (init->init.util.ramv)
af->realloc = erts_alcu_realloc_mv_ts;
else
af->realloc = erts_alcu_realloc_ts;
@@ -815,7 +862,9 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init)
#endif
{
af->alloc = erts_alcu_alloc;
- if (init->init.util.ramv)
+ if (init->init.util.fix_type_size)
+ af->realloc = erts_realloc_fixed_size;
+ else if (init->init.util.ramv)
af->realloc = erts_alcu_realloc_mv;
else
af->realloc = erts_alcu_realloc;
@@ -838,12 +887,14 @@ start_au_allocator(ErtsAlcType_t alctr_n,
ErtsAllocatorFunctions_t *af = &erts_allctrs[alctr_n];
ErtsAllocatorInfo_t *ai = &erts_allctrs_info[alctr_n];
ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[alctr_n];
+ ErtsAlcFixList_t *fix_lists = NULL;
+ size_t fix_list_size = 0;
if (!init->enable)
return;
if (init->thr_spec) {
- void *states = erts_sys_alloc(0,
+ char *states = erts_sys_alloc(0,
NULL,
((sizeof(Allctr_t *)
* (tspec->size + 1))
@@ -855,18 +906,40 @@ start_au_allocator(ErtsAlcType_t alctr_n,
"Failed to allocate allocator states for %salloc\n",
init->init.util.name_prefix);
tspec->allctr = (Allctr_t **) states;
- states = ((char *) states) + sizeof(Allctr_t *) * (tspec->size + 1);
+ states += sizeof(Allctr_t *) * (tspec->size + 1);
states = ((((UWord) states) & ERTS_CACHE_LINE_MASK)
- ? (void *) ((((UWord) states) & ~ERTS_CACHE_LINE_MASK)
+ ? (char *) ((((UWord) states) & ~ERTS_CACHE_LINE_MASK)
+ ERTS_CACHE_LINE_SIZE)
- : (void *) states);
- tspec->allctr[0] = init->thr_spec > 0 ? (Allctr_t *) state : (Allctr_t *) NULL;
+ : (char *) states);
+ tspec->allctr[0] = (Allctr_t *) state;
size = tspec->size;
for (i = 1; i < size; i++)
tspec->allctr[i] = (Allctr_t *)
&((ErtsAllocatorState_t *) states)[i-1];
}
+ if (init->init.util.fix_type_size) {
+ size_t tot_fix_list_size;
+ fix_list_size = sizeof(ErtsAlcFixList_t)*ERTS_ALC_NO_FIXED_SIZES;
+ fix_list_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(fix_list_size);
+ tot_fix_list_size = fix_list_size;
+ if (init->thr_spec)
+ tot_fix_list_size *= tspec->size;
+ fix_lists = erts_sys_alloc(0,
+ NULL,
+ (tot_fix_list_size
+ + ERTS_CACHE_LINE_SIZE - 1));
+ if (!fix_lists)
+ erl_exit(ERTS_ABORT_EXIT,
+ "Failed to allocate fix lists for %salloc\n",
+ init->init.util.name_prefix);
+
+ if (((UWord) fix_lists) & ERTS_CACHE_LINE_MASK)
+ fix_lists = ((ErtsAlcFixList_t *)
+ ((((UWord) fix_lists) & ~ERTS_CACHE_LINE_MASK)
+ + ERTS_CACHE_LINE_SIZE));
+ }
+
for (i = 0; i < size; i++) {
void *as;
atype = init->atype;
@@ -877,25 +950,32 @@ start_au_allocator(ErtsAlcType_t alctr_n,
as0 = (void *) tspec->allctr[i];
if (!as0)
continue;
- if (i == 0) {
- if (atype == AFIT)
- atype = GOODFIT;
- init->init.util.ts = 1;
+ if (init->thr_spec < 0) {
+ init->init.util.ts = i == 0;
+ init->init.util.tspec = 0;
+ init->init.util.tpref = -1*init->thr_spec + 1;
}
else {
- if (init->thr_spec < 0) {
+ if (i != 0)
+ init->init.util.ts = 0;
+ else {
+ if (atype == AFIT)
+ atype = GOODFIT;
init->init.util.ts = 1;
- init->init.util.tspec = 0;
- init->init.util.tpref = -1*init->thr_spec;
}
- else {
- init->init.util.ts = 0;
- init->init.util.tspec = init->thr_spec + 1;
- init->init.util.tpref = 0;
- }
- }
+ init->init.util.tspec = init->thr_spec + 1;
+ init->init.util.tpref = 0;
+ }
+ }
+
+ if (fix_lists) {
+ init->init.util.fix = fix_lists;
+ fix_lists = ((ErtsAlcFixList_t *)
+ (((char *) fix_lists) + fix_list_size));
}
+ init->init.util.ix = i;
+
switch (atype) {
case GOODFIT:
as = (void *) erts_gfalc_start((GFAllctr_t *) as0,
@@ -931,11 +1011,8 @@ start_au_allocator(ErtsAlcType_t alctr_n,
af->extra = as;
}
- if (init->thr_spec) {
+ if (init->thr_spec)
af->extra = tspec;
- init->init.util.ts = 1;
- }
-
ai->extra = af->extra;
}
@@ -1055,34 +1132,6 @@ get_amount_value(char *param_end, char** argv, int* ip)
return (Uint) tmp;
}
-static int
-get_bool_or_possitive_amount_value(int *bool, Uint *amount,
- char *param_end, char** argv, int* ip)
-{
- char *param = argv[*ip]+1;
- char *value = get_value(param_end, argv, ip);
- if (strcmp(value, "true") == 0) {
- *bool = 1;
- return 1;
- }
- else if (strcmp(value, "false") == 0) {
- *bool = 0;
- return 1;
- }
- else {
- Sint tmp;
- char *rest;
- errno = 0;
- tmp = (Sint) strtol(value, &rest, 10);
- if (errno != 0 || rest == value || tmp <= 0) {
- bad_value(param, param_end, value);
- return -1;
- }
- *amount = (Uint) tmp;
- return 0;
- }
-}
-
static void
handle_au_arg(struct au_init *auip,
char* sub_param,
@@ -1197,25 +1246,16 @@ handle_au_arg(struct au_init *auip,
goto bad_switch;
break;
case 't': {
- Uint no;
- int enable;
- int res = get_bool_or_possitive_amount_value(&enable,
- &no,
- sub_param+1,
- argv,
- ip);
- if (res > 0)
- auip->thr_spec = enable ? 1 : 0;
+ int res = get_bool_value(sub_param+1, argv, ip);
+ if (res > 0) {
+ auip->thr_spec = 1;
+ break;
+ }
else if (res == 0) {
- int allocs = (int) no;
- if (allocs < 0)
- allocs = INT_MIN;
- else {
- allocs *= -1;
- }
- auip->thr_spec = allocs;
+ auip->thr_spec = 0;
+ break;
}
- break;
+ goto bad_switch;
}
default:
bad_switch:
@@ -1234,6 +1274,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
&init->eheap_alloc,
&init->ll_alloc,
&init->driver_alloc,
+ &init->fix_alloc,
&init->sl_alloc,
&init->temp_alloc
};
@@ -1264,14 +1305,8 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
case 'E':
handle_au_arg(&init->ets_alloc, &argv[i][3], argv, &i);
break;
- case 'F': /* fix_alloc */
- if (has_prefix("e", param+2)) {
- arg = get_value(param+3, argv, &i);
- if (strcmp("true", arg) != 0)
- bad_value(param, param+3, arg);
- }
- else
- bad_param(param, param+2);
+ case 'F':
+ handle_au_arg(&init->fix_alloc, &argv[i][3], argv, &i);
break;
case 'H':
handle_au_arg(&init->eheap_alloc, &argv[i][3], argv, &i);
@@ -1298,12 +1333,6 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
#endif
get_amount_value(argv[i]+6, argv, &i);
}
- else if (has_prefix("cci", argv[i]+3)) {
-#if HAVE_ERTS_MSEG
- init->mseg.cci =
-#endif
- get_amount_value(argv[i]+6, argv, &i);
- }
else {
bad_param(param, param+2);
}
@@ -1389,6 +1418,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
set_default_binary_alloc_opts(&init->binary_alloc);
set_default_ets_alloc_opts(&init->ets_alloc);
set_default_driver_alloc_opts(&init->driver_alloc);
+ set_default_driver_alloc_opts(&init->fix_alloc);
init->driver_alloc.enable = 0;
if (strcmp("r9c", arg) == 0) {
@@ -1523,43 +1553,74 @@ static char *type_no_str(ErtsAlcType_t n)
#define type_str(T) type_no_str(ERTS_ALC_T2N((T)))
-erts_tsd_key_t thr_ix_key;
-erts_spinlock_t alloc_thr_ix_lock;
-int last_thr_ix;
-int first_dyn_thr_ix;
-
-static void
-init_thr_ix(int static_ixs)
+void
+erts_alloc_register_scheduler(void *vesdp)
{
- erts_tsd_key_create(&thr_ix_key);
- erts_spinlock_init(&alloc_thr_ix_lock, "alloc_thr_ix_lock");
- last_thr_ix = -4711;
- first_dyn_thr_ix = static_ixs+1;
+ ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp;
+ int ix = (int) esdp->no;
+ int aix;
+
+ for (aix = ERTS_ALC_A_MIN; aix <= ERTS_ALC_A_MAX; aix++) {
+ ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[aix];
+ esdp->alloc_data.deallctr[aix] = NULL;
+ esdp->alloc_data.pref_ix[aix] = -1;
+ if (tspec->enabled) {
+ if (!tspec->dd)
+ esdp->alloc_data.pref_ix[aix] = ix;
+ else {
+ Allctr_t *allctr = tspec->allctr[ix];
+ ASSERT(allctr);
+ esdp->alloc_data.deallctr[aix] = allctr;
+ esdp->alloc_data.pref_ix[aix] = ix;
+ }
+ }
+ }
}
-int
-erts_alc_get_thr_ix(void)
+void
+erts_alloc_scheduler_handle_delayed_dealloc(void *vesdp,
+ int *need_thr_progress,
+ int *more_work)
{
- int ix = (int)(long) erts_tsd_get(thr_ix_key);
- if (ix == 0) {
- erts_spin_lock(&alloc_thr_ix_lock);
- last_thr_ix++;
- if (last_thr_ix < 0)
- last_thr_ix = first_dyn_thr_ix;
- ix = last_thr_ix;
- erts_spin_unlock(&alloc_thr_ix_lock);
- erts_tsd_set(thr_ix_key, (void *)(long) ix);
+ ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp;
+ int aix;
+ for (aix = ERTS_ALC_A_MIN; aix <= ERTS_ALC_A_MAX; aix++) {
+ Allctr_t *allctr;
+ if (esdp)
+ allctr = esdp->alloc_data.deallctr[aix];
+ else {
+ ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[aix];
+ if (tspec->enabled && tspec->dd)
+ allctr = tspec->allctr[0];
+ else
+ allctr = NULL;
+ }
+ if (allctr) {
+ erts_alcu_check_delayed_dealloc(allctr,
+ 1,
+ need_thr_progress,
+ more_work);
+ }
}
- ASSERT(ix > 0);
- return ix;
}
-void erts_alloc_reg_scheduler_id(Uint id)
+erts_aint32_t
+erts_alloc_fix_alloc_shrink(int ix, erts_aint32_t flgs)
{
- int ix = (int) id;
- ASSERT(0 < ix && ix <= first_dyn_thr_ix);
- ASSERT(0 == (int) (long) erts_tsd_get(thr_ix_key));
- erts_tsd_set(thr_ix_key, (void *)(long) ix);
+#ifdef ERTS_SMP
+ ErtsAllocatorThrSpec_t *tspec;
+ tspec = &erts_allctr_thr_spec[ERTS_ALC_A_FIXED_SIZE];
+ if (erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].thr_spec && tspec->enabled)
+ return erts_alcu_fix_alloc_shrink(tspec->allctr[ix], flgs);
+ if (ix == 0 && erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].extra)
+ return erts_alcu_fix_alloc_shrink(
+ erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].extra, flgs);
+#else
+ if (ix == 1 && erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].extra)
+ return erts_alcu_fix_alloc_shrink(
+ erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].extra, flgs);
+#endif
+ return 0;
}
static void
@@ -1574,14 +1635,12 @@ erts_alloc_get_verify_unused_temp_alloc(Allctr_t **allctr)
if (erts_allctrs_info[ERTS_ALC_A_TEMPORARY].alloc_util
&& erts_allctrs_info[ERTS_ALC_A_TEMPORARY].thr_spec) {
ErtsAllocatorThrSpec_t *tspec;
+ int ix = ERTS_ALC_GET_THR_IX();
tspec = &erts_allctr_thr_spec[ERTS_ALC_A_TEMPORARY];
- if (!tspec->all_thr_safe) {
- int ix = erts_alc_get_thr_ix();
- if (ix < tspec->size) {
- *allctr = tspec->allctr[ix];
- return erts_alcu_verify_unused;
- }
+ if (ix < tspec->size) {
+ *allctr = tspec->allctr[ix];
+ return erts_alcu_verify_unused;
}
}
@@ -1680,7 +1739,7 @@ erts_realloc_n_enomem(ErtsAlcType_t n, void *ptr, Uint size)
}
static ERTS_INLINE UWord
-alcu_size(ErtsAlcType_t ai)
+alcu_size(ErtsAlcType_t ai, ErtsAlcUFixInfo_t *fi, int fisz)
{
UWord res = 0;
@@ -1690,22 +1749,20 @@ alcu_size(ErtsAlcType_t ai)
if (!erts_allctrs_info[ai].thr_spec) {
Allctr_t *allctr = erts_allctrs_info[ai].extra;
AllctrSize_t asize;
- erts_alcu_current_size(allctr, &asize);
+ erts_alcu_current_size(allctr, &asize, fi, fisz);
res += asize.blocks;
}
else {
ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[ai];
int i;
- ASSERT(tspec->all_thr_safe);
-
ASSERT(tspec->enabled);
for (i = tspec->size - 1; i >= 0; i--) {
Allctr_t *allctr = tspec->allctr[i];
AllctrSize_t asize;
if (allctr) {
- erts_alcu_current_size(allctr, &asize);
+ erts_alcu_current_size(allctr, &asize, fi, fisz);
res += asize.blocks;
}
}
@@ -1733,7 +1790,6 @@ alcu_is_low(ErtsAlcType_t ai)
int found_one = 0;
# endif
- ASSERT(tspec->all_thr_safe);
ASSERT(tspec->enabled);
for (i = tspec->size - 1; i >= 0; i--) {
@@ -1757,11 +1813,24 @@ alcu_is_low(ErtsAlcType_t ai)
}
#endif /* HALFWORD */
+static ERTS_INLINE void
+add_fix_values(UWord *ap, UWord *up, ErtsAlcUFixInfo_t *fi, ErtsAlcType_t type)
+{
+ int ix = ERTS_ALC_T2N(type) - ERTS_ALC_N_MIN_A_FIXED_SIZE;
+ ASSERT(0 <= ix && ix < ERTS_ALC_NO_FIXED_SIZES);
+
+ *ap += (UWord) fi[ix].allocated;
+ *up += (UWord) fi[ix].used;
+}
+
Eterm
erts_memory(int *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)
- ErtsFixInfo efi;
struct {
int total;
int processes;
@@ -1800,6 +1869,9 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
Eterm res = THE_NON_VALUE;
ErtsAlcType_t ai;
int only_one_value = 0;
+ ErtsAlcUFixInfo_t fi[ERTS_ALC_NO_FIXED_SIZES] = {{0,0}};
+
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
/* Figure out whats wanted... */
@@ -1969,7 +2041,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
for (ai = ERTS_ALC_A_MIN; ai <= ERTS_ALC_A_MAX; ai++) {
switch (ai) {
case ERTS_ALC_A_SYSTEM:
- case ERTS_ALC_A_FIXED_SIZE:
case ERTS_ALC_A_SBMBC:
#if HALFWORD_HEAP
case ERTS_ALC_A_SBMBC_LOW:
@@ -2029,11 +2100,15 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
case ERTS_ALC_A_BINARY:
save = &size.binary;
break;
+ case ERTS_ALC_A_FIXED_SIZE:
+ asz = alcu_size(ai, fi, ERTS_ALC_NO_FIXED_SIZES);
+ size.total += asz;
+ continue;
default:
save = NULL;
break;
}
- asz = alcu_size(ai);
+ asz = alcu_size(ai, NULL, 0);
if (save)
*save = asz;
size.total += asz;
@@ -2053,8 +2128,11 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
if (ERTS_MEM_NEED_ALL_ALCU)
tmp = size.processes;
- else
- tmp = alcu_size(ERTS_ALC_A_EHEAP);
+ else {
+ alcu_size(ERTS_ALC_A_FIXED_SIZE,
+ fi, ERTS_ALC_NO_FIXED_SIZES);
+ tmp = alcu_size(ERTS_ALC_A_EHEAP, NULL, 0);
+ }
tmp += erts_max_processes*sizeof(Process*);
#ifdef HYBRID
tmp += erts_max_processes*sizeof(Process*);
@@ -2064,69 +2142,54 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
size.processes = size.processes_used = tmp;
-#if HALFWORD_HEAP
- /* BUG: We ignore link and monitor memory */
-#else
- erts_fix_info(ERTS_ALC_T_NLINK_SH, &efi);
- size.processes += efi.total;
- size.processes_used += efi.used;
+ add_fix_values(&size.processes,
+ &size.processes_used,
+ fi,
+ ERTS_ALC_T_PROC);
+#if !HALFWORD_HEAP
+ add_fix_values(&size.processes,
+ &size.processes_used,
+ fi,
+ ERTS_ALC_T_MONITOR_SH);
- erts_fix_info(ERTS_ALC_T_MONITOR_SH, &efi);
- size.processes += efi.total;
- size.processes_used += efi.used;
+ add_fix_values(&size.processes,
+ &size.processes_used,
+ fi,
+ ERTS_ALC_T_NLINK_SH);
#endif
-
- erts_fix_info(ERTS_ALC_T_PROC, &efi);
- size.processes += efi.total;
- size.processes_used += efi.used;
-
- erts_fix_info(ERTS_ALC_T_REG_PROC, &efi);
- size.processes += efi.total;
- size.processes_used += efi.used;
-
+ add_fix_values(&size.processes,
+ &size.processes_used,
+ fi,
+ ERTS_ALC_T_MSG_REF);
}
if (want.atom || want.atom_used) {
Uint reserved_atom_space, atom_space;
erts_atom_get_text_space_sizes(&reserved_atom_space, &atom_space);
size.atom = size.atom_used = atom_table_sz();
- erts_fix_info(ERTS_ALC_T_ATOM, &efi);
- if (want.atom) {
+ if (want.atom)
size.atom += reserved_atom_space;
- size.atom += efi.total;
- }
- if (want.atom_used) {
+ if (want.atom_used)
size.atom_used += atom_space;
- size.atom_used += efi.used;
- }
}
if (!ERTS_MEM_NEED_ALL_ALCU && want.binary)
- size.binary = alcu_size(ERTS_ALC_A_BINARY);
+ size.binary = alcu_size(ERTS_ALC_A_BINARY, NULL, 0);
if (want.code) {
size.code = module_table_sz();
- erts_fix_info(ERTS_ALC_T_MODULE, &efi);
- size.code += efi.used;
size.code += export_table_sz();
-#if HALFWORD_HEAP
size.code += export_list_size() * sizeof(Export);
-#else
- erts_fix_info(ERTS_ALC_T_EXPORT, &efi);
- size.code += efi.used;
-#endif
size.code += erts_fun_table_sz();
- erts_fix_info(ERTS_ALC_T_FUN_ENTRY, &efi);
- size.code += efi.used;
size.code += allocated_modules*sizeof(Range);
size.code += erts_total_code_size;
}
if (want.ets) {
if (!ERTS_MEM_NEED_ALL_ALCU)
- size.ets = alcu_size(ERTS_ALC_A_ETS);
+ size.ets = alcu_size(ERTS_ALC_A_ETS, NULL, 0);
size.ets += erts_get_ets_misc_mem_size();
}
@@ -2199,13 +2262,10 @@ struct aa_values {
Eterm
erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc)
{
-#define MAX_AA_VALUES \
- (20 + (ERTS_ALC_N_MAX_A_FIXED_SIZE - ERTS_ALC_N_MIN_A_FIXED_SIZE + 1))
-
+#define MAX_AA_VALUES (23)
struct aa_values values[MAX_AA_VALUES];
Eterm res = THE_NON_VALUE;
int i, length;
- ErtsFixInfo efi;
Uint reserved_atom_space, atom_space;
if (proc) {
@@ -2270,6 +2330,11 @@ erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc)
i++;
values[i].arity = 2;
+ values[i].name = "export_list";
+ values[i].ui[0] = export_list_size() * sizeof(Export);
+ i++;
+
+ values[i].arity = 2;
values[i].name = "register_table";
values[i].ui[0] = process_reg_sz();
i++;
@@ -2314,22 +2379,15 @@ erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc)
values[i].ui[0] = erts_tot_link_lh_size();
i++;
- {
- Uint n;
-
- for (n = ERTS_ALC_N_MIN_A_FIXED_SIZE;
- n <= ERTS_ALC_N_MAX_A_FIXED_SIZE;
- n++) {
- erts_fix_info(ERTS_ALC_N2T(n), &efi);
-
- values[i].arity = 3;
- values[i].name = ERTS_ALC_N2TD(n);
- values[i].ui[0] = efi.total;
- values[i].ui[1] = efi.used;
- i++;
- }
+ values[i].arity = 2;
+ values[i].name = "process_table";
+ values[i].ui[0] = erts_max_processes*sizeof(Process*);
+ i++;
- }
+ values[i].arity = 2;
+ values[i].name = "ets_misc";
+ values[i].ui[0] = erts_get_ets_misc_mem_size();
+ i++;
length = i;
ASSERT(length <= MAX_AA_VALUES);
@@ -2423,17 +2481,16 @@ erts_alloc_util_allocators(void *proc)
Uint sz;
int i;
/*
- * Currently all allocators except sys_alloc and fix_alloc are
+ * Currently all allocators except sys_alloc are
* alloc_util allocators.
*/
- sz = ((ERTS_ALC_A_MAX + 1 - ERTS_ALC_A_MIN) - 2)*2;
+ sz = ((ERTS_ALC_A_MAX + 1 - ERTS_ALC_A_MIN) - 1)*2;
ASSERT(sz > 0);
hp = HAlloc((Process *) proc, sz);
res = NIL;
for (i = ERTS_ALC_A_MAX; i >= ERTS_ALC_A_MIN; i--) {
switch (i) {
case ERTS_ALC_A_SYSTEM:
- case ERTS_ALC_A_FIXED_SIZE:
break;
default: {
char *alc_str = (char *) ERTS_ALC_A2AD(i);
@@ -2447,267 +2504,12 @@ erts_alloc_util_allocators(void *proc)
return res;
}
-Eterm
-erts_allocator_info_term(void *proc, Eterm which_alloc, int only_sz)
-{
-#define ERTS_AIT_RET(R) \
- do { res = (R); goto done; } while (0)
-#define ERTS_AIT_HALLOC(P, S) \
- do { hp = HAlloc((P), (S)); hp_end = hp + (S); } while (0)
-
- ErtsAlcType_t i;
- Uint sz = 0;
- Uint *hp = NULL;
- Uint *hp_end = NULL;
- Eterm res = am_undefined;
-
- if (is_not_atom(which_alloc))
- goto done;
-
- for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
- if (erts_is_atom_str((char *) ERTS_ALC_A2AD(i), which_alloc)) {
- if (!erts_allctrs_info[i].enabled)
- ERTS_AIT_RET(am_false);
- else {
- if (erts_allctrs_info[i].alloc_util) {
- Eterm ires, tmp;
- Eterm **hpp;
- Uint *szp;
- Eterm (*info_func)(Allctr_t *,
- int,
- int *,
- void *,
- Uint **,
- Uint *);
-
- info_func = (only_sz
- ? erts_alcu_sz_info
- : erts_alcu_info);
-
- if (erts_allctrs_info[i].thr_spec) {
- ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[i];
- int j;
- int block_system = !tspec->all_thr_safe;
-
- if (block_system) {
- erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
- }
- ASSERT(tspec->enabled);
-
- szp = &sz;
- hpp = NULL;
-
- while (1) {
- ires = NIL;
- for (j = tspec->size - 1; j >= 0; j--) {
- Allctr_t *allctr = tspec->allctr[j];
- if (allctr) {
- tmp = erts_bld_tuple(hpp,
- szp,
- 3,
- erts_bld_atom(hpp,
- szp,
- "instance"),
- make_small((Uint) j),
- (*info_func)(allctr,
- hpp != NULL,
- NULL,
- NULL,
- hpp,
- szp));
- ires = erts_bld_cons(hpp, szp, tmp, ires);
- }
- }
- if (hpp)
- break;
- ERTS_AIT_HALLOC((Process *) proc, sz);
- hpp = &hp;
- szp = NULL;
- }
-
- if (block_system) {
- erts_smp_release_system();
- erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN);
- }
- }
- else {
- Allctr_t *allctr = erts_allctrs_info[i].extra;
- szp = &sz;
- hpp = NULL;
- while (1) {
- ires = NIL;
- tmp = erts_bld_tuple(hpp,
- szp,
- 3,
- erts_bld_atom(hpp,
- szp,
- "instance"),
- make_small((Uint) 0),
- (*info_func)(allctr,
- hpp != NULL,
- NULL,
- NULL,
- hpp,
- szp));
- ires = erts_bld_cons(hpp, szp, tmp, ires);
- if (hpp)
- break;
- ERTS_AIT_HALLOC((Process *) proc, sz);
- hpp = &hp;
- szp = NULL;
- }
- }
- ERTS_AIT_RET(ires);
- }
- else {
- Eterm *szp, **hpp;
-
- switch (i) {
- case ERTS_ALC_A_SYSTEM: {
- SysAllocStat sas;
- Eterm opts_am;
- Eterm opts;
- Eterm as[4]; /* Ok even if !HEAP_ON_C_STACK, not really heap data on stack */
- Eterm ts[4]; /* Ok even if !HEAP_ON_C_STACK, not really heap data on stack */
- int l;
-
- if (only_sz)
- ERTS_AIT_RET(NIL);
-
- sys_alloc_stat(&sas);
- opts_am = am_atom_put("options", 7);
-
- szp = &sz;
- hpp = NULL;
-
- restart_sys_alloc:
- l = 0;
- as[l] = am_atom_put("e", 1);
- ts[l++] = am_true;
- as[l] = am_atom_put("m", 1);
- ts[l++] = am_atom_put("libc", 4);
- if(sas.trim_threshold >= 0) {
- as[l] = am_atom_put("tt", 2);
- ts[l++] = erts_bld_uint(hpp, szp,
- (Uint) sas.trim_threshold);
- }
- if(sas.top_pad >= 0) {
- as[l] = am_atom_put("tp", 2);
- ts[l++] = erts_bld_uint(hpp, szp, (Uint) sas.top_pad);
- }
-
- opts = erts_bld_2tup_list(hpp, szp, l, as, ts);
- res = erts_bld_2tup_list(hpp, szp, 1, &opts_am, &opts);
-
- if (szp) {
- ERTS_AIT_HALLOC((Process *) proc, sz);
- szp = NULL;
- hpp = &hp;
- goto restart_sys_alloc;
- }
- ERTS_AIT_RET(res);
- }
- case ERTS_ALC_A_FIXED_SIZE: {
- ErtsAlcType_t n;
- Eterm as[2], vs[2];
-
- if (only_sz)
- ERTS_AIT_RET(NIL);
-
- as[0] = am_atom_put("options", 7);
- as[1] = am_atom_put("pools", 5);
-
- szp = &sz;
- hpp = NULL;
-
- restart_fix_alloc:
-
- vs[0] = erts_bld_cons(hpp, szp,
- erts_bld_tuple(hpp, szp, 2,
- am_atom_put("e",
- 1),
- am_true),
- NIL);
-
- vs[1] = NIL;
- for (n = ERTS_ALC_N_MIN_A_FIXED_SIZE;
- n <= ERTS_ALC_N_MAX_A_FIXED_SIZE;
- n++) {
- ErtsFixInfo efi;
- erts_fix_info(ERTS_ALC_N2T(n), &efi);
-
- vs[1] = erts_bld_cons(
- hpp, szp,
- erts_bld_tuple(
- hpp, szp, 3,
- am_atom_put((char *) ERTS_ALC_N2TD(n),
- strlen(ERTS_ALC_N2TD(n))),
- erts_bld_uint(hpp, szp, efi.total),
- erts_bld_uint(hpp, szp, efi.used)),
- vs[1]);
-
- }
-
- res = erts_bld_2tup_list(hpp, szp, 2, as, vs);
- if (szp) {
- ERTS_AIT_HALLOC((Process *) proc, sz);
- szp = NULL;
- hpp = &hp;
- goto restart_fix_alloc;
- }
- ERTS_AIT_RET(res);
- }
- default:
- ASSERT(0);
- goto done;
- }
- }
- }
- }
- }
-
- if (ERTS_IS_ATOM_STR("mseg_alloc", which_alloc)) {
-#if HAVE_ERTS_MSEG
- if (only_sz)
- ERTS_AIT_RET(NIL);
- erts_mseg_info(NULL, NULL, 0, NULL, &sz);
- if (sz)
- ERTS_AIT_HALLOC((Process *) proc, sz);
- ERTS_AIT_RET(erts_mseg_info(NULL, NULL, 1, &hp, NULL));
-#else
- ERTS_AIT_RET(am_false);
-#endif
-
- }
- else if (ERTS_IS_ATOM_STR("alloc_util", which_alloc)) {
- if (only_sz)
- ERTS_AIT_RET(NIL);
- erts_alcu_au_info_options(NULL, NULL, NULL, &sz);
- if (sz)
- ERTS_AIT_HALLOC((Process *) proc, sz);
- ERTS_AIT_RET(erts_alcu_au_info_options(NULL, NULL, &hp, NULL));
- }
-
- done:
- if (hp) {
- ASSERT(hp_end >= hp);
- HRelease((Process *) proc, hp_end, hp);
- }
- return res;
-
-#undef ERTS_AIT_RET
-#undef ERTS_AIT_HALLOC
-}
-
void
erts_allocator_info(int to, void *arg)
{
ErtsAlcType_t a;
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)
- || (ERTS_IS_CRASH_DUMPING
- && erts_smp_is_system_blocked(ERTS_BS_FLG_ALLOW_GC)));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
for (a = ERTS_ALC_A_MIN; a <= ERTS_ALC_A_MAX; a++) {
int ai;
@@ -2748,22 +2550,6 @@ erts_allocator_info(int to, void *arg)
erts_print(to, arg, "option tp: %d\n", sas.top_pad);
break;
}
- case ERTS_ALC_A_FIXED_SIZE: {
- ErtsAlcType_t n;
- erts_print(to, arg, "option e: true\n");
-
- for (n = ERTS_ALC_N_MIN_A_FIXED_SIZE;
- n <= ERTS_ALC_N_MAX_A_FIXED_SIZE;
- n++) {
- ErtsFixInfo efi;
- erts_fix_info(ERTS_ALC_N2T(n), &efi);
- erts_print(to, arg, "%s: %lu %lu\n",
- ERTS_ALC_N2TD(n),
- efi.total,
- efi.used);
- }
- break;
- }
default:
ASSERT(0);
break;
@@ -2774,8 +2560,18 @@ erts_allocator_info(int to, void *arg)
}
#if HAVE_ERTS_MSEG
- erts_print(to, arg, "=allocator:mseg_alloc\n");
- erts_mseg_info(&to, arg, 0, NULL, NULL);
+ {
+#ifdef ERTS_SMP
+ int max = (int) erts_no_schedulers;
+#else
+ int max = 0;
+#endif
+ int i;
+ for (i = 0; i <= max; i++) {
+ erts_print(to, arg, "=allocator:mseg_alloc[%d]\n", i);
+ erts_mseg_info(i, &to, arg, 0, NULL, NULL);
+ }
+ }
#endif
erts_print(to, arg, "=allocator:alloc_util\n");
@@ -2829,7 +2625,7 @@ erts_allocator_options(void *proc)
use_mseg++;
#endif
if (erts_allctr_thr_spec[a].enabled)
- allctr = erts_allctr_thr_spec[a].allctr[1];
+ allctr = erts_allctr_thr_spec[a].allctr[0];
else
allctr = erts_allctrs_info[a].extra;
tmp = erts_alcu_info_options(allctr, NULL, NULL, hpp, szp);
@@ -2878,7 +2674,7 @@ erts_allocator_options(void *proc)
#if HAVE_ERTS_MSEG
if (use_mseg) {
atoms[length] = am_atom_put("mseg_alloc", 10);
- terms[length++] = erts_mseg_info_options(NULL, NULL, hpp, szp);
+ terms[length++] = erts_mseg_info_options(0, NULL, NULL, hpp, szp);
}
#endif
@@ -2982,6 +2778,313 @@ void *erts_alloc_permanent_cache_aligned(ErtsAlcType_t type, Uint size)
return (void*)v;
}
+static void
+reply_alloc_info(void *vair)
+{
+ ErtsAllocInfoReq *air = (ErtsAllocInfoReq *) vair;
+ Uint sched_id = erts_get_scheduler_id();
+ int global_instances = air->req_sched == sched_id;
+ ErtsProcLocks rp_locks;
+ Process *rp = air->proc;
+ Eterm ref_copy = NIL, ai_list, msg;
+ Eterm *hp = NULL, *hp_end = NULL, *hp_start = NULL;
+ Eterm **hpp;
+ Uint sz, *szp;
+ ErlOffHeap *ohp = NULL;
+ ErlHeapFragment *bp = NULL;
+ int i;
+ Eterm (*info_func)(Allctr_t *,
+ int,
+ int *,
+ void *,
+ Uint **,
+ Uint *) = (air->only_sz
+ ? erts_alcu_sz_info
+ : erts_alcu_info);
+
+ rp_locks = air->req_sched == sched_id ? ERTS_PROC_LOCK_MAIN : 0;
+
+ sz = 0;
+ hpp = NULL;
+ szp = &sz;
+
+ while (1) {
+
+ if (hpp)
+ ref_copy = STORE_NC(hpp, ohp, air->ref);
+ else
+ *szp += REF_THING_SIZE;
+
+ ai_list = NIL;
+ for (i = 0; air->allocs[i] != ERTS_ALC_A_INVALID; i++);
+ for (i--; i >= 0; i--) {
+ int ai = air->allocs[i];
+ Allctr_t *allctr;
+ Eterm ainfo;
+ Eterm alloc_atom;
+ if (global_instances) {
+ switch (ai) {
+ case ERTS_ALC_A_SYSTEM: {
+ alloc_atom = erts_bld_atom(hpp, szp, "sys_alloc");
+ ainfo = NIL;
+ if (!air->only_sz) {
+ SysAllocStat sas;
+ if (hpp)
+ sys_alloc_stat(&sas);
+ if (szp) {
+ /* ensure ehough heap */
+ sas.top_pad = INT_MAX;
+ sas.trim_threshold = INT_MAX;
+ }
+ if (sas.top_pad >= 0) {
+ ainfo = erts_bld_cons(
+ hpp, szp,
+ erts_bld_tuple(
+ hpp, szp, 2,
+ erts_bld_atom(hpp, szp, "tp"),
+ erts_bld_uint(
+ hpp, szp,
+ (Uint) sas.top_pad)),
+ ainfo);
+ }
+ if (sas.trim_threshold >= 0) {
+ ainfo = erts_bld_cons(
+ hpp, szp,
+ erts_bld_tuple(
+ hpp, szp, 2,
+ erts_bld_atom(hpp, szp, "tt"),
+ erts_bld_uint(
+ hpp, szp,
+ (Uint) sas.trim_threshold)),
+ ainfo);
+ }
+ ainfo = erts_bld_cons(hpp, szp,
+ erts_bld_tuple(
+ hpp, szp, 2,
+ erts_bld_atom(hpp, szp,
+ "m"),
+ erts_bld_atom(hpp, szp,
+ "libc")),
+ ainfo);
+ ainfo = erts_bld_cons(hpp, szp,
+ erts_bld_tuple(
+ hpp, szp, 2,
+ erts_bld_atom(hpp, szp,
+ "e"),
+ am_true),
+ ainfo);
+ ainfo = erts_bld_tuple(hpp, szp, 2,
+ erts_bld_atom(hpp, szp,
+ "otps"),
+ ainfo);
+ }
+ ainfo = erts_bld_tuple(hpp, szp, 3,
+ alloc_atom,
+ make_small(0),
+ ainfo);
+ break;
+ }
+ case ERTS_ALC_INFO_A_ALLOC_UTIL:
+ alloc_atom = erts_bld_atom(hpp, szp, "alloc_util");
+ ainfo = (air->only_sz
+ ? NIL
+ : erts_alcu_au_info_options(NULL, NULL,
+ hpp, szp));
+ ainfo = erts_bld_tuple(hpp, szp, 3,
+ alloc_atom,
+ make_small(0),
+ ainfo);
+ break;
+ case ERTS_ALC_INFO_A_MSEG_ALLOC:
+ alloc_atom = erts_bld_atom(hpp, szp, "mseg_alloc");
+#if HAVE_ERTS_MSEG
+ ainfo = (air->only_sz
+ ? NIL
+ : erts_mseg_info(0, NULL, NULL, hpp != NULL,
+ hpp, szp));
+ ainfo = erts_bld_tuple(hpp, szp, 3,
+ alloc_atom,
+ make_small(0),
+ ainfo);
+#else
+ ainfo = erts_bld_tuple(hpp, szp, 2, alloc_atom,
+ am_false);
+#endif
+ break;
+ default:
+ alloc_atom = erts_bld_atom(hpp, szp,
+ (char *) ERTS_ALC_A2AD(ai));
+ if (!erts_allctrs_info[ai].enabled)
+ ainfo = erts_bld_tuple(hpp, szp, 2, alloc_atom,
+ am_false);
+ else if (erts_allctrs_info[ai].alloc_util) {
+ if (erts_allctrs_info[ai].thr_spec)
+ allctr = erts_allctr_thr_spec[ai].allctr[0];
+ else
+ allctr = erts_allctrs_info[ai].extra;
+ ainfo = info_func(allctr, hpp != NULL, NULL,
+ NULL, hpp, szp);
+ ainfo = erts_bld_tuple(hpp, szp, 3, alloc_atom,
+ make_small(0), ainfo);
+ }
+ else {
+ erl_exit(ERTS_ABORT_EXIT, "%s:%d: internal error\n",
+ __FILE__, __LINE__);
+ }
+ }
+ ai_list = erts_bld_cons(hpp, szp,
+ ainfo, ai_list);
+ }
+ switch (ai) {
+ case ERTS_ALC_A_SYSTEM:
+ case ERTS_ALC_INFO_A_ALLOC_UTIL:
+ break;
+ case ERTS_ALC_INFO_A_MSEG_ALLOC:
+#if HAVE_ERTS_MSEG && defined(ERTS_SMP)
+ alloc_atom = erts_bld_atom(hpp, szp, "mseg_alloc");
+ ainfo = (air->only_sz
+ ? NIL
+ : erts_mseg_info(sched_id, NULL, NULL,
+ hpp != NULL, hpp, szp));
+ ainfo = erts_bld_tuple(hpp, szp, 3,
+ alloc_atom,
+ make_small(sched_id),
+ ainfo);
+ ai_list = erts_bld_cons(hpp, szp, ainfo, ai_list);
+#endif
+ break;
+ default:
+ if (erts_allctrs_info[ai].thr_spec) {
+ alloc_atom = erts_bld_atom(hpp, szp,
+ (char *) ERTS_ALC_A2AD(ai));
+ allctr = erts_allctr_thr_spec[ai].allctr[sched_id];
+ ainfo = info_func(allctr, hpp != NULL, NULL,
+ NULL, hpp, szp);
+ ai_list = erts_bld_cons(hpp, szp,
+ erts_bld_tuple(
+ hpp, szp,
+ 3,
+ alloc_atom,
+ make_small(sched_id),
+ ainfo),
+ ai_list);
+ }
+ break;
+ }
+ msg = erts_bld_tuple(hpp, szp,
+ 3,
+ ref_copy,
+ make_small(sched_id),
+ ai_list);
+
+ }
+ if (hpp)
+ break;
+
+ hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks);
+ hp_start = hp;
+ hp_end = hp + sz;
+ szp = NULL;
+ hpp = &hp;
+ }
+ if (bp)
+ bp = erts_resize_message_buffer(bp, hp - hp_start, &msg, 1);
+ else {
+ ASSERT(hp);
+ HRelease(rp, hp_end, hp);
+ }
+
+ erts_queue_message(rp, &rp_locks, bp, msg, NIL);
+
+ if (air->req_sched == sched_id)
+ rp_locks &= ~ERTS_PROC_LOCK_MAIN;
+
+ erts_smp_proc_unlock(rp, rp_locks);
+ erts_smp_proc_dec_refc(rp);
+
+ if (erts_smp_atomic32_dec_read_nob(&air->refc) == 0)
+ aireq_free(air);
+}
+
+int
+erts_request_alloc_info(struct process *c_p,
+ Eterm ref,
+ Eterm allocs,
+ int only_sz)
+{
+ ErtsAllocInfoReq *air = aireq_alloc();
+ Eterm req_ai[ERTS_ALC_A_MAX+1+2] = {0};
+ Eterm alist;
+ Eterm *hp;
+ int airix = 0, ai;
+
+ air->req_sched = erts_get_scheduler_id();
+
+ air->only_sz = only_sz;
+
+ air->proc = c_p;
+
+ if (is_not_internal_ref(ref))
+ return 0;
+
+ hp = &air->ref_heap[0];
+ air->ref = STORE_NC(&hp, NULL, ref);
+
+ if (is_not_list(allocs))
+ return 0;
+
+ alist = allocs;
+
+ while (is_list(alist)) {
+ int saved = 0;
+ Eterm* consp = list_val(alist);
+ Eterm alloc = CAR(consp);
+
+ for (ai = ERTS_ALC_A_MIN; ai <= ERTS_ALC_A_MAX; ai++)
+ if (erts_is_atom_str((char *) erts_alc_a2ad[ai], alloc))
+ goto save_alloc;
+ if (erts_is_atom_str("mseg_alloc", alloc)) {
+ ai = ERTS_ALC_INFO_A_MSEG_ALLOC;
+ goto save_alloc;
+ }
+ if (erts_is_atom_str("alloc_util", alloc)) {
+ ai = ERTS_ALC_INFO_A_ALLOC_UTIL;
+ save_alloc:
+ if (req_ai[ai])
+ return 0;
+ air->allocs[airix++] = ai;
+ req_ai[ai] = 1;
+ saved = 1;
+ }
+
+ if (!saved)
+ return 0;
+
+ alist = CDR(consp);
+ }
+
+ if (is_not_nil(alist))
+ return 0;
+
+ air->allocs[airix] = ERTS_ALC_A_INVALID;
+
+ erts_smp_atomic32_init_nob(&air->refc,
+ (erts_aint32_t) erts_no_schedulers);
+
+ erts_smp_proc_add_refc(c_p, (Sint32) erts_no_schedulers);
+
+#ifdef ERTS_SMP
+ if (erts_no_schedulers > 1)
+ erts_schedule_multi_misc_aux_work(1,
+ erts_no_schedulers,
+ reply_alloc_info,
+ (void *) air);
+#endif
+
+ reply_alloc_info((void *) air);
+
+ return 1;
+}
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
* Deprecated functions *
diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h
index 80cb82c393..f4133cdb1a 100644
--- a/erts/emulator/beam/erl_alloc.h
+++ b/erts/emulator/beam/erl_alloc.h
@@ -43,43 +43,40 @@
# define ERTS_ALC_INLINE
#endif
-#define ERTS_FIX_CORE_ALLOCATOR ERTS_ALC_A_LONG_LIVED
-extern ErtsAlcType_t erts_fix_core_allocator_ix;
-
-typedef struct {
- Uint total;
- Uint used;
-} ErtsFixInfo;
+#define ERTS_ALC_NO_FIXED_SIZES \
+ (ERTS_ALC_N_MAX_A_FIXED_SIZE - ERTS_ALC_N_MIN_A_FIXED_SIZE + 1)
void erts_sys_alloc_init(void);
void *erts_sys_alloc(ErtsAlcType_t, void *, Uint);
void *erts_sys_realloc(ErtsAlcType_t, void *, void *, Uint);
void erts_sys_free(ErtsAlcType_t, void *, void *);
-
-void erts_init_fix_alloc(Uint, void *(*)(Uint));
-Uint erts_get_fix_size(ErtsAlcType_t);
-void erts_set_fix_size(ErtsAlcType_t, Uint);
-void erts_fix_info(ErtsAlcType_t, ErtsFixInfo *);
-void *erts_fix_alloc(ErtsAlcType_t, void *, Uint);
-void *erts_fix_realloc(ErtsAlcType_t, void *, void*, Uint);
-void erts_fix_free(ErtsAlcType_t, void *, void*);
-
-
Eterm erts_memory(int *, void *, void *, Eterm);
Eterm erts_allocated_areas(int *, void *, void *);
Eterm erts_alloc_util_allocators(void *proc);
void erts_allocator_info(int, void *);
-Eterm erts_allocator_info_term(void *proc, Eterm which_alloc, int only_sz);
Eterm erts_allocator_options(void *proc);
+struct process;
+
+int erts_request_alloc_info(struct process *c_p, Eterm ref, Eterm allocs,
+ int only_sz);
+
#define ERTS_ALLOC_INIT_DEF_OPTS_INITER {0}
typedef struct {
- int dummy;
+ int ncpu;
} ErtsAllocInitOpts;
+typedef struct {
+ Allctr_t *deallctr[ERTS_ALC_A_MAX+1];
+ int pref_ix[ERTS_ALC_A_MAX+1];
+ int flist_ix[ERTS_ALC_A_MAX+1];
+ int pre_alc_ix;
+} ErtsSchedAllocData;
+
void erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop);
+void erts_alloc_late_init(void);
#if defined(GET_ERTS_ALC_TEST) || defined(ERTS_ALC_INTERNAL__)
/* Only for testing */
@@ -126,15 +123,19 @@ extern ErtsAllocatorInfo_t erts_allctrs_info[ERTS_ALC_A_MAX+1];
typedef struct {
int enabled;
- int all_thr_safe;
+ int dd;
+ int aix;
int size;
Allctr_t **allctr;
} ErtsAllocatorThrSpec_t;
extern ErtsAllocatorThrSpec_t erts_allctr_thr_spec[ERTS_ALC_A_MAX+1];
-int erts_alc_get_thr_ix(void);
-void erts_alloc_reg_scheduler_id(Uint id);
+void erts_alloc_register_scheduler(void *vesdp);
+void erts_alloc_scheduler_handle_delayed_dealloc(void *vesdp,
+ int *need_thr_progress,
+ int *more_work);
+erts_aint32_t erts_alloc_fix_alloc_shrink(int ix, erts_aint32_t flgs);
__decl_noreturn void erts_alloc_enomem(ErtsAlcType_t,Uint)
__noreturn;
@@ -252,6 +253,8 @@ void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size)
#endif /* #if ERTS_ALC_DO_INLINE || defined(ERTS_ALC_INTERNAL__) */
+#define ERTS_ALC_GET_THR_IX() ((int) erts_get_scheduler_id())
+
typedef void (*erts_alloc_verify_func_t)(Allctr_t *);
erts_alloc_verify_func_t
@@ -436,136 +439,41 @@ NAME##_free(TYPE *p) \
} \
}
-typedef struct {
- void *start;
- void *end;
- int chunks_mem_size;
-} erts_sched_pref_quick_alloc_data_t;
-
-#ifdef DEBUG
-#define ERTS_SPPA_DBG_CHK_IN_CHNK(A, C, P) \
-do { \
- ASSERT((void *) (C) < (void *) (P)); \
- ASSERT((void *) (P) \
- < (void *) (((char *) (C)) + (A)->chunks_mem_size)); \
-} while (0)
-#else
-#define ERTS_SPPA_DBG_CHK_IN_CHNK(A, C, P)
-#endif
+#include "erl_sched_spec_pre_alloc.h"
#define ERTS_SCHED_PREF_PRE_ALLOC_IMPL(NAME, TYPE, PASZ) \
-union erts_qa_##NAME##__ { \
+union erts_sspa_##NAME##__ { \
+ erts_sspa_blk_t next; \
TYPE type; \
- union erts_qa_##NAME##__ *next; \
}; \
-typedef struct { \
- erts_smp_spinlock_t lock; \
- union erts_qa_##NAME##__ *freelist; \
- union erts_qa_##NAME##__ pre_alloced[1]; \
-} erts_qa_##NAME##_chunk__; \
-static erts_sched_pref_quick_alloc_data_t *qa_data_##NAME##__; \
-static ERTS_INLINE erts_qa_##NAME##_chunk__ * \
-get_##NAME##_chunk_ix(int cix) \
-{ \
- char *ptr = (char *) qa_data_##NAME##__->start; \
- ptr += cix*qa_data_##NAME##__->chunks_mem_size; \
- return (erts_qa_##NAME##_chunk__ *) ptr; \
-} \
-static ERTS_INLINE erts_qa_##NAME##_chunk__ * \
-get_##NAME##_chunk_ptr(void *ptr) \
-{ \
- int cix; \
- size_t diff; \
- if (ptr < qa_data_##NAME##__->start || qa_data_##NAME##__->end <= ptr)\
- return NULL; \
- diff = ((char *) ptr) - ((char *) qa_data_##NAME##__->start); \
- cix = diff / qa_data_##NAME##__->chunks_mem_size; \
- return get_##NAME##_chunk_ix(cix); \
-} \
+ \
+static erts_sspa_data_t *sspa_data_##NAME##__; \
+ \
static void \
init_##NAME##_alloc(void) \
{ \
- size_t tot_size; \
- size_t chunk_mem_size; \
- char *chunk_start; \
- int cix; \
- int no_blocks = ERTS_PRE_ALLOC_SIZE((PASZ)); \
- int no_blocks_per_chunk = 2*((no_blocks-1)/erts_no_schedulers + 1); \
- no_blocks = no_blocks_per_chunk * erts_no_schedulers; \
- chunk_mem_size = sizeof(erts_qa_##NAME##_chunk__); \
- chunk_mem_size += (sizeof(union erts_qa_##NAME##__) \
- * (no_blocks_per_chunk - 1)); \
- chunk_mem_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(chunk_mem_size); \
- tot_size = sizeof(erts_sched_pref_quick_alloc_data_t); \
- tot_size += ERTS_CACHE_LINE_SIZE - 1; \
- tot_size += chunk_mem_size*erts_no_schedulers; \
- qa_data_##NAME##__ = erts_alloc(ERTS_ALC_T_PRE_ALLOC_DATA,tot_size);\
- chunk_start = (((char *) qa_data_##NAME##__) \
- + sizeof(erts_sched_pref_quick_alloc_data_t)); \
- if ((((UWord) chunk_start) & ERTS_CACHE_LINE_MASK) != ((UWord) 0)) \
- chunk_start = ((char *) \
- ((((UWord) chunk_start) & ~ERTS_CACHE_LINE_MASK) \
- + ERTS_CACHE_LINE_SIZE)); \
- qa_data_##NAME##__->chunks_mem_size = chunk_mem_size; \
- qa_data_##NAME##__->start = (void *) chunk_start; \
- qa_data_##NAME##__->end = (chunk_start \
- + chunk_mem_size*erts_no_schedulers); \
- for (cix = 0; cix < erts_no_schedulers; cix++) { \
- int i; \
- erts_qa_##NAME##_chunk__ *chunk = get_##NAME##_chunk_ix(cix); \
- erts_smp_spinlock_init(&chunk->lock, #NAME "_alloc_lock"); \
- chunk->freelist = &chunk->pre_alloced[0]; \
- for (i = 1; i < no_blocks_per_chunk; i++) { \
- ERTS_PRE_ALLOC_CLOBBER(&chunk->pre_alloced[i-1], \
- union erts_qa_##NAME##__); \
- chunk->pre_alloced[i-1].next = &chunk->pre_alloced[i]; \
- } \
- ERTS_PRE_ALLOC_CLOBBER(&chunk->pre_alloced[no_blocks_per_chunk-1],\
- union erts_qa_##NAME##__); \
- chunk->pre_alloced[no_blocks_per_chunk-1].next = NULL; \
- } \
+ sspa_data_##NAME##__ = \
+ erts_sspa_create(sizeof(union erts_sspa_##NAME##__), \
+ ERTS_PRE_ALLOC_SIZE((PASZ))); \
} \
-static ERTS_INLINE TYPE * \
+ \
+static TYPE * \
NAME##_alloc(void) \
{ \
- int cix = ((int) erts_get_scheduler_id()) - 1; \
- TYPE *res; \
- if (cix < 0) \
- res = NULL; \
- else { \
- erts_qa_##NAME##_chunk__ *chunk = get_##NAME##_chunk_ix(cix); \
- erts_smp_spin_lock(&chunk->lock); \
- if (!chunk->freelist) \
- res = NULL; \
- else { \
- res = &chunk->freelist->type; \
- chunk->freelist = chunk->freelist->next; \
- ERTS_SPPA_DBG_CHK_IN_CHNK(qa_data_##NAME##__, chunk, res); \
- } \
- erts_smp_spin_unlock(&chunk->lock); \
- } \
- return res; \
+ ErtsSchedulerData *esdp = erts_get_scheduler_data(); \
+ if (!esdp) \
+ return NULL; \
+ return (TYPE *) erts_sspa_alloc(sspa_data_##NAME##__, \
+ (int) esdp->no - 1); \
} \
-static ERTS_INLINE int \
+ \
+static int \
NAME##_free(TYPE *p) \
{ \
- erts_qa_##NAME##_chunk__ *chunk; \
- chunk = get_##NAME##_chunk_ptr((void *) p); \
- if (!chunk) \
- return 0; \
- else { \
- union erts_qa_##NAME##__ *up; \
- ERTS_SPPA_DBG_CHK_IN_CHNK(qa_data_##NAME##__, chunk, p); \
- up = ((union erts_qa_##NAME##__ *) \
- (((char *) p) \
- - ((char *) &((union erts_qa_##NAME##__ *) 0)->type))); \
- erts_smp_spin_lock(&chunk->lock); \
- ERTS_PRE_ALLOC_CLOBBER(up, union erts_qa_##NAME##__); \
- up->next = chunk->freelist; \
- chunk->freelist = up; \
- erts_smp_spin_unlock(&chunk->lock); \
- return 1; \
- } \
+ ErtsSchedulerData *esdp = erts_get_scheduler_data(); \
+ return erts_sspa_free(sspa_data_##NAME##__, \
+ esdp ? (int) esdp->no - 1 : -1, \
+ (char *) p); \
}
#ifdef DEBUG
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index eda0831441..962db8b831 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -50,6 +50,15 @@
# command line argument to make_alloc_types. The variable X is false
# after a "+disable X" statement or if it has never been mentioned.
++if smp
++disable threads_no_smp
++else
++if threads
++enable threads_no_smp
++else
++disable threads_no_smp
++endif
++endif
# --- Allocator declarations -------------------------------------------------
#
@@ -133,29 +142,25 @@ class SYSTEM system_data
# should be deallocated before the emulator starts executing Erlang
# code again.
#
-# NOTE: When adding or removing a type which uses the FIXED_SIZE allocator,
-# also add or remove initialization of the type in erts_alloc_init()
-# (erl_alloc.c).
-#
# <TYPE> <ALLOCATOR> <CLASS> <DESCRIPTION>
type SBMBC SBMBC SYSTEM small_block_mbc
type PROC FIXED_SIZE PROCESSES proc
-type ATOM FIXED_SIZE ATOM atom_entry
-type MODULE FIXED_SIZE CODE module_entry
-type REG_PROC FIXED_SIZE PROCESSES reg_proc
+type ATOM LONG_LIVED ATOM atom_entry
+type MODULE LONG_LIVED CODE module_entry
+type REG_PROC STANDARD PROCESSES reg_proc
type LINK_LH STANDARD PROCESSES link_lh
type SUSPEND_MON STANDARD PROCESSES suspend_monitor
type PEND_SUSPEND SHORT_LIVED PROCESSES pending_suspend
type PROC_LIST SHORT_LIVED PROCESSES proc_list
-type FUN_ENTRY FIXED_SIZE CODE fun_entry
+type FUN_ENTRY LONG_LIVED CODE fun_entry
type ATOM_TXT LONG_LIVED ATOM atom_text
type BEAM_REGISTER EHEAP PROCESSES beam_register
type HEAP EHEAP PROCESSES heap
type OLD_HEAP EHEAP PROCESSES old_heap
type HEAP_FRAG EHEAP PROCESSES heap_frag
type TMP_HEAP TEMPORARY PROCESSES tmp_heap
-type MSG_REF SHORT_LIVED PROCESSES msg_ref
+type MSG_REF FIXED_SIZE PROCESSES msg_ref
type MSG_ROOTS TEMPORARY PROCESSES msg_roots
type ROOTSET TEMPORARY PROCESSES root_set
type LOADER_TMP TEMPORARY CODE loader_tmp
@@ -196,10 +201,10 @@ type LINEBUF STANDARD SYSTEM line_buf
type IOQ STANDARD SYSTEM io_queue
type BITS_BUF STANDARD SYSTEM bits_buf
type TMP_DIST_BUF TEMPORARY SYSTEM tmp_dist_buf
-type ASYNC_Q LONG_LIVED SYSTEM async_queue
+type ASYNC_DATA LONG_LIVED SYSTEM internal_async_data
type ESTACK TEMPORARY SYSTEM estack
type PORT_CALL_BUF TEMPORARY SYSTEM port_call_buf
-type DB_TABLE FIXED_SIZE ETS db_tab
+type DB_TABLE ETS ETS db_tab
type DB_FIXATION SHORT_LIVED ETS db_fixation
type DB_FIX_DEL SHORT_LIVED ETS fixed_del
type DB_TABLES LONG_LIVED ETS db_tabs
@@ -256,6 +261,23 @@ type TMP_CPU_IDS SHORT_LIVED SYSTEM tmp_cpu_ids
type EXT_TERM_DATA SHORT_LIVED PROCESSES external_term_data
type ZLIB STANDARD SYSTEM zlib
type CPU_GRPS_MAP LONG_LIVED SYSTEM cpu_groups_map
+type AUX_WORK_TMO LONG_LIVED SYSTEM aux_work_timeouts
+type MISC_AUX_WORK_Q LONG_LIVED SYSTEM misc_aux_work_q
+
++if threads_no_smp
+# Need thread safe allocs, but std_alloc and fix_alloc are not;
+# use driver_alloc which is...
+type THR_Q_EL DRIVER SYSTEM thr_q_element
+type THR_Q_EL_SL DRIVER SYSTEM sl_thr_q_element
+type MISC_AUX_WORK DRIVER SYSTEM misc_aux_work
++else
+type THR_Q_EL STANDARD SYSTEM thr_q_element
+type THR_Q_EL_SL FIXED_SIZE SYSTEM sl_thr_q_element
+type MISC_AUX_WORK SHORT_LIVED SYSTEM misc_aux_work
++endif
+type THR_Q STANDARD SYSTEM thr_queue
+type THR_Q_SL SHORT_LIVED SYSTEM short_lived_thr_queue
+type THR_Q_LL LONG_LIVED SYSTEM long_lived_thr_queue
+if smp
type ASYNC SHORT_LIVED SYSTEM async
@@ -271,8 +293,9 @@ type XPORTS_LIST SHORT_LIVED SYSTEM extra_port_list
type PROC_LCK_WTR LONG_LIVED SYSTEM proc_lock_waiter
type PROC_LCK_QS LONG_LIVED SYSTEM proc_lock_queues
type RUNQ_BLNS LONG_LIVED SYSTEM run_queue_balancing
-type MISC_AUX_WORK_Q LONG_LIVED SYSTEM misc_aux_work_q
-type MISC_AUX_WORK SHORT_LIVED SYSTEM misc_aux_work
+type THR_PRGR_IDATA LONG_LIVED SYSTEM thr_prgr_internal_data
+type THR_PRGR_DATA LONG_LIVED SYSTEM thr_prgr_data
+type T_THR_PRGR_DATA SHORT_LIVED SYSTEM temp_thr_prgr_data
+endif
#
@@ -285,12 +308,6 @@ type ETHR_STD STANDARD SYSTEM ethread_standard
type ETHR_SL SHORT_LIVED SYSTEM ethread_short_lived
type ETHR_LL LONG_LIVED SYSTEM ethread_long_lived
-+ifnot smp
-
-type ARCALLBACK LONG_LIVED SYSTEM async_ready_callback
-
-+endif
-
+endif
+if shared_heap
@@ -346,10 +363,10 @@ type DB_MS_PSDO_PROC LONG_LIVED_LOW ETS db_match_pseudo_proc
type SCHDLR_DATA LONG_LIVED_LOW SYSTEM scheduler_data
type LL_TEMP_TERM LONG_LIVED_LOW SYSTEM ll_temp_term
-# no FIXED_SIZE for low memory
-type EXPORT STANDARD_LOW CODE export_entry
+type EXPORT LONG_LIVED_LOW CODE export_entry
type MONITOR_SH STANDARD_LOW PROCESSES monitor_sh
type NLINK_SH STANDARD_LOW PROCESSES nlink_sh
+type AINFO_REQ STANDARD_LOW SYSTEM alloc_info_request
+else # "fullword"
@@ -362,9 +379,10 @@ type DB_MS_PSDO_PROC LONG_LIVED ETS db_match_pseudo_proc
type SCHDLR_DATA LONG_LIVED SYSTEM scheduler_data
type LL_TEMP_TERM LONG_LIVED SYSTEM ll_temp_term
-type EXPORT FIXED_SIZE CODE export_entry
+type EXPORT LONG_LIVED CODE export_entry
type MONITOR_SH FIXED_SIZE PROCESSES monitor_sh
type NLINK_SH FIXED_SIZE PROCESSES nlink_sh
+type AINFO_REQ SHORT_LIVED SYSTEM alloc_info_request
+endif
diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c
index d51ed0c36d..af386c9197 100644
--- a/erts/emulator/beam/erl_alloc_util.c
+++ b/erts/emulator/beam/erl_alloc_util.c
@@ -46,6 +46,7 @@
#include "erl_alloc_util.h"
#include "erl_mseg.h"
#include "erl_threads.h"
+#include "erl_thr_progress.h"
#ifdef ERTS_ENABLE_LOCK_COUNT
#include "erl_lock_count.h"
@@ -61,6 +62,13 @@
#warning "* * * * * * * * * *"
#endif
+#define ERTS_ALCU_DD_OPS_LIM_HIGH 20
+#define ERTS_ALCU_DD_OPS_LIM_LOW 2
+
+/* Fix alloc limit */
+#define ERTS_ALCU_FIX_MAX_LIST_SZ 1000
+#define ERTS_ALC_FIX_MAX_SHRINK_OPS 30
+
#define ALLOC_ZERO_EQ_NULL 0
static int atoms_initialized = 0;
@@ -269,7 +277,6 @@ static void check_blk_carrier(Allctr_t *, Block_t *);
#define HARD_CHECK_BLK_CARRIER(A, B)
#endif
-
/* Statistics updating ... */
#ifdef DEBUG
@@ -465,26 +472,34 @@ do { \
#ifdef DEBUG
#ifdef USE_THREADS
-#define ERTS_ALCU_DBG_CHK_THR_SPEC(A) \
+#define ERTS_ALCU_DBG_CHK_THR_ACCESS(A) \
do { \
if (!(A)->thread_safe) { \
- if (!(A)->debug.saved_tid) \
+ if (!(A)->debug.saved_tid) { \
(A)->debug.tid = erts_thr_self(); \
+ (A)->debug.saved_tid = 1; \
+ } \
else { \
- ASSERT(ethr_equal_tids((A)->debug.tid, erts_thr_self())); \
+ ERTS_SMP_LC_ASSERT( \
+ ethr_equal_tids((A)->debug.tid, erts_thr_self()) \
+ || erts_thr_progress_is_blocking()); \
} \
} \
} while (0)
#else
-#define ERTS_ALCU_DBG_CHK_THR_SPEC(A)
+#define ERTS_ALCU_DBG_CHK_THR_ACCESS(A)
#endif
#else
-#define ERTS_ALCU_DBG_CHK_THR_SPEC(A)
+#define ERTS_ALCU_DBG_CHK_THR_ACCESS(A)
#endif
static void make_name_atoms(Allctr_t *allctr);
+static Block_t *create_carrier(Allctr_t *, Uint, UWord);
+static void destroy_carrier(Allctr_t *, Block_t *);
+static void mbc_free(Allctr_t *allctr, void *p);
+
/* mseg ... */
@@ -651,6 +666,446 @@ static void destroy_sbmbc(Allctr_t *allctr, Block_t *blk);
static Block_t *create_carrier(Allctr_t *, Uint, UWord);
static void destroy_carrier(Allctr_t *, Block_t *);
+#if 0
+#define ERTS_DBG_CHK_FIX_LIST(A, FIX, IX, B) \
+ do { if ((FIX)) chk_fix_list((A), (FIX), (IX), (B)); } while (0)
+static void
+chk_fix_list(Allctr_t *allctr, ErtsAlcFixList_t *fix, int ix, int before)
+{
+ void *p;
+ int n;
+ for (n = 0, p = fix[ix].list; p; p = *((void **) p))
+ n++;
+ if (n != fix[ix].list_size) {
+ erts_fprintf(stderr, "FOUND IT ts=%d, sched=%d, ix=%d, n=%d, ls=%d %s!\n",
+ allctr->thread_safe, allctr->ix, ix, n, fix[ix].list_size, before ? "before" : "after");
+ abort();
+ }
+}
+#else
+#define ERTS_DBG_CHK_FIX_LIST(A, FIX, IX, B)
+#endif
+
+erts_aint32_t
+erts_alcu_fix_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs)
+{
+ int all_empty = 1;
+ erts_aint32_t res = 0;
+ int ix, o;
+ ErtsAlcFixList_t *fix = allctr->fix;
+ int flush = flgs == 0;
+
+#ifdef USE_THREADS
+ if (allctr->thread_safe)
+ erts_mtx_lock(&allctr->mutex);
+#endif
+
+ for (ix = 0; ix < ERTS_ALC_NO_FIXED_SIZES; ix++) {
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1);
+ if (flgs & ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM) {
+ fix[ix].limit = fix[ix].max_used;
+ if (fix[ix].limit < fix[ix].used)
+ fix[ix].limit = fix[ix].used;
+ fix[ix].max_used = fix[ix].used;
+ ASSERT(fix[ix].limit >= 0);
+
+ }
+ if (flush) {
+ fix[ix].limit = 0;
+ fix[ix].max_used = fix[ix].used;
+ ASSERT(fix[ix].limit >= 0);
+ }
+ for (o = 0; o < ERTS_ALC_FIX_MAX_SHRINK_OPS || flush; o++) {
+ Block_t *blk;
+ void *ptr;
+
+ if (!flush && fix[ix].limit >= fix[ix].allocated)
+ break;
+ if (fix[ix].list_size == 0)
+ break;
+ ptr = fix[ix].list;
+ fix[ix].list = *((void **) ptr);
+ fix[ix].list_size--;
+
+ blk = UMEM2BLK(ptr);
+
+ if (IS_SBC_BLK(blk))
+ destroy_carrier(allctr, blk);
+ else
+ mbc_free(allctr, ptr);
+
+ fix[ix].allocated--;
+ }
+ if (fix[ix].list_size != 0) {
+ if (fix[ix].limit < fix[ix].allocated)
+ res |= ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC;
+ all_empty = 0;
+ }
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
+ }
+
+ if (all_empty && allctr->fix_shrink_scheduled) {
+ allctr->fix_shrink_scheduled = 0;
+ erts_set_aux_work_timeout(allctr->ix,
+ (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM
+ | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC),
+ 0);
+ }
+
+#ifdef USE_THREADS
+ if (allctr->thread_safe)
+ erts_mtx_unlock(&allctr->mutex);
+#endif
+
+ return res;
+}
+
+#ifdef ERTS_SMP
+
+#define ERTS_ALCU_DD_FIX_TYPE_OFFS \
+ ((sizeof(ErtsAllctrDDBlock_t)-1)/sizeof(UWord) + 1)
+
+#define ERTS_AU_PREF_ALLOC_IX_MASK \
+ ((((UWord) 1) << ERTS_AU_PREF_ALLOC_BITS) - 1)
+#define ERTS_AU_PREF_ALLOC_SIZE_MASK \
+ ((((UWord) 1) << (sizeof(UWord)*8 - ERTS_AU_PREF_ALLOC_BITS)) - 1)
+
+static ERTS_INLINE int
+get_pref_allctr(void *extra, Allctr_t **allctr)
+{
+ ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
+ int pref_ix;
+
+ pref_ix = ERTS_ALC_GET_THR_IX();
+
+ ASSERT(sizeof(UWord) == sizeof(Allctr_t *));
+ ASSERT(0 <= pref_ix && pref_ix < tspec->size);
+
+ *allctr = tspec->allctr[pref_ix];
+ return pref_ix;
+}
+
+static ERTS_INLINE void *
+get_used_allctr(void *extra, void *p, Allctr_t **allctr, UWord *sizep)
+{
+ ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
+ void *ptr = (void *) (((char *) p) - sizeof(UWord));
+ UWord ainfo = *((UWord *) ptr);
+ int aix = (int) (ainfo & ERTS_AU_PREF_ALLOC_IX_MASK);
+ *allctr = tspec->allctr[aix];
+ if (sizep)
+ *sizep = ((ainfo >> ERTS_AU_PREF_ALLOC_BITS)
+ & ERTS_AU_PREF_ALLOC_SIZE_MASK);
+ return ptr;
+}
+
+static ERTS_INLINE void *
+put_used_allctr(void *p, int ix, UWord size)
+{
+ UWord ainfo = (size >= ERTS_AU_PREF_ALLOC_SIZE_MASK
+ ? ERTS_AU_PREF_ALLOC_SIZE_MASK
+ : size);
+ ainfo <<= ERTS_AU_PREF_ALLOC_BITS;
+ ainfo |= (UWord) ix;
+ *((UWord *) p) = ainfo;
+ return (void *) (((char *) p) + sizeof(UWord));
+}
+
+static void
+init_dd_queue(ErtsAllctrDDQueue_t *ddq)
+{
+ erts_atomic_init_nob(&ddq->tail.data.marker.atmc_next, ERTS_AINT_NULL);
+ erts_atomic_init_nob(&ddq->tail.data.last,
+ (erts_aint_t) &ddq->tail.data.marker);
+ erts_atomic_init_nob(&ddq->tail.data.um_refc[0], 0);
+ erts_atomic_init_nob(&ddq->tail.data.um_refc[1], 0);
+ erts_atomic32_init_nob(&ddq->tail.data.um_refc_ix, 0);
+ ddq->head.first = &ddq->tail.data.marker;
+ ddq->head.unref_end = &ddq->tail.data.marker;
+ ddq->head.next.thr_progress = erts_thr_progress_current();
+ ddq->head.next.thr_progress_reached = 1;
+ ddq->head.next.um_refc_ix = 1;
+ ddq->head.next.unref_end = &ddq->tail.data.marker;
+ ddq->head.used_marker = 1;
+}
+
+static ERTS_INLINE erts_aint_t
+ddq_managed_thread_enqueue(ErtsAllctrDDQueue_t *ddq, void *ptr)
+{
+ erts_aint_t ilast, itmp;
+ ErtsAllctrDDBlock_t *this = ptr;
+
+ erts_atomic_init_nob(&this->atmc_next, ERTS_AINT_NULL);
+
+ /* Enqueue at end of list... */
+
+ ilast = erts_atomic_read_nob(&ddq->tail.data.last);
+ while (1) {
+ ErtsAllctrDDBlock_t *last = (ErtsAllctrDDBlock_t *) ilast;
+ itmp = erts_atomic_cmpxchg_mb(&last->atmc_next,
+ (erts_aint_t) this,
+ ERTS_AINT_NULL);
+ if (itmp == ERTS_AINT_NULL)
+ break;
+ ilast = itmp;
+ }
+
+ /* Move last pointer forward... */
+ while (1) {
+ if (erts_atomic_read_rb(&this->atmc_next) != ERTS_AINT_NULL) {
+ /* Someone else will move it forward */
+ return erts_atomic_read_rb(&ddq->tail.data.last);
+ }
+ itmp = erts_atomic_cmpxchg_mb(&ddq->tail.data.last,
+ (erts_aint_t) this,
+ ilast);
+ if (ilast == itmp)
+ return (erts_aint_t) this;
+ ilast = itmp;
+ }
+}
+
+static ERTS_INLINE int
+ddq_enqueue(ErtsAlcType_t type, ErtsAllctrDDQueue_t *ddq, void *ptr)
+{
+ erts_aint_t ilast;
+ int um_refc_ix = 0;
+ int managed_thread = erts_thr_progress_is_managed_thread();
+ if (!managed_thread) {
+ um_refc_ix = erts_atomic32_read_acqb(&ddq->tail.data.um_refc_ix);
+ while (1) {
+ int tmp_um_refc_ix;
+ erts_atomic_inc_acqb(&ddq->tail.data.um_refc[um_refc_ix]);
+ tmp_um_refc_ix = erts_atomic32_read_acqb(&ddq->tail.data.um_refc_ix);
+ if (tmp_um_refc_ix == um_refc_ix)
+ break;
+ erts_atomic_dec_relb(&ddq->tail.data.um_refc[um_refc_ix]);
+ um_refc_ix = tmp_um_refc_ix;
+ }
+ }
+
+ ilast = ddq_managed_thread_enqueue(ddq, ptr);
+
+ if (!managed_thread)
+ erts_atomic_dec_relb(&ddq->tail.data.um_refc[um_refc_ix]);
+ return ilast == (erts_aint_t) ptr;
+}
+
+static ERTS_INLINE void *
+ddq_dequeue(ErtsAllctrDDQueue_t *ddq)
+{
+ ErtsAllctrDDBlock_t *blk;
+
+ if (ddq->head.first == ddq->head.unref_end)
+ return NULL;
+
+ blk = ddq->head.first;
+ if (blk == &ddq->tail.data.marker) {
+ ASSERT(ddq->head.used_marker);
+ ddq->head.used_marker = 0;
+ blk = ((ErtsAllctrDDBlock_t *)
+ erts_atomic_read_nob(&blk->atmc_next));
+ if (blk == ddq->head.unref_end) {
+ ddq->head.first = blk;
+ return NULL;
+ }
+ }
+
+ ddq->head.first = ((ErtsAllctrDDBlock_t *)
+ erts_atomic_read_nob(&blk->atmc_next));
+
+ ASSERT(ddq->head.first);
+
+ return (void *) blk;
+}
+
+static int
+ddq_check_incoming(ErtsAllctrDDQueue_t *ddq)
+{
+ erts_aint_t ilast = erts_atomic_read_nob(&ddq->tail.data.last);
+ if (((ErtsAllctrDDBlock_t *) ilast) == &ddq->tail.data.marker
+ && ddq->head.first == &ddq->tail.data.marker) {
+ /* Nothing more to do... */
+ return 0;
+ }
+
+ if (ddq->head.next.thr_progress_reached
+ || erts_thr_progress_has_reached(ddq->head.next.thr_progress)) {
+ int um_refc_ix;
+ ddq->head.next.thr_progress_reached = 1;
+ um_refc_ix = ddq->head.next.um_refc_ix;
+ if (erts_atomic_read_acqb(&ddq->tail.data.um_refc[um_refc_ix]) == 0) {
+ /* Move unreferenced end pointer forward... */
+
+ ddq->head.unref_end = ddq->head.next.unref_end;
+
+ if (!ddq->head.used_marker
+ && ddq->head.unref_end == (ErtsAllctrDDBlock_t *) ilast) {
+ ddq->head.used_marker = 1;
+ ilast = ddq_managed_thread_enqueue(ddq, &ddq->tail.data.marker);
+ }
+
+ if (ddq->head.unref_end == (ErtsAllctrDDBlock_t *) ilast)
+ ERTS_THR_MEMORY_BARRIER;
+ else {
+ ddq->head.next.unref_end = (ErtsAllctrDDBlock_t *) ilast;
+ ERTS_THR_MEMORY_BARRIER;
+ ddq->head.next.thr_progress = erts_thr_progress_later();
+ erts_atomic32_set_relb(&ddq->tail.data.um_refc_ix,
+ um_refc_ix);
+ ddq->head.next.um_refc_ix = um_refc_ix == 0 ? 1 : 0;
+ ddq->head.next.thr_progress_reached = 0;
+ }
+ }
+ }
+ return 1;
+}
+
+static ERTS_INLINE int
+handle_delayed_dealloc(Allctr_t *allctr,
+ int allctr_locked,
+ int use_limit,
+ int ops_limit,
+ int *need_thr_progress,
+ int *need_more_work)
+{
+ int need_thr_prgr = 0;
+ int need_mr_wrk = 0;
+ int have_checked_incoming = 0;
+ int ops = 0;
+ ErtsAlcFixList_t *fix;
+ int res;
+ ErtsAllctrDDQueue_t *ddq;
+
+ if (allctr->thread_safe && !allctr_locked)
+ erts_mtx_lock(&allctr->mutex);
+
+ ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
+
+ fix = allctr->fix;
+
+ ddq = &allctr->dd.q;
+
+ res = 0;
+
+ while (1) {
+ Block_t *blk;
+ void *ptr;
+ int ix;
+
+ if (use_limit && ++ops > ops_limit) {
+ if (ddq->head.first != ddq->head.unref_end) {
+ need_mr_wrk = 1;
+ if (need_more_work)
+ *need_more_work |= 1;
+ }
+ break;
+ }
+
+ dequeue:
+ ptr = ddq_dequeue(ddq);
+ if (!ptr) {
+ if (have_checked_incoming)
+ break;
+ need_thr_prgr = ddq_check_incoming(ddq);
+ if (need_thr_progress)
+ *need_thr_progress |= need_thr_prgr;
+ have_checked_incoming = 1;
+ goto dequeue;
+ }
+
+ res = 1;
+
+ INC_CC(allctr->calls.this_free);
+
+ if (fix) {
+ ErtsAlcType_t type;
+
+ type = (ErtsAlcType_t) ((UWord *) ptr)[ERTS_ALCU_DD_FIX_TYPE_OFFS];
+ ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE;
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1);
+ fix[ix].used--;
+ if (fix[ix].allocated < fix[ix].limit
+ && fix[ix].list_size < ERTS_ALCU_FIX_MAX_LIST_SZ) {
+ *((void **) ptr) = fix[ix].list;
+ fix[ix].list = ptr;
+ fix[ix].list_size++;
+ if (!allctr->fix_shrink_scheduled) {
+ allctr->fix_shrink_scheduled = 1;
+ erts_set_aux_work_timeout(
+ allctr->ix,
+ (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM
+ | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC),
+ 1);
+ }
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
+ continue;
+ }
+ fix[ix].allocated--;
+ if (fix[ix].list && fix[ix].allocated > fix[ix].limit) {
+ blk = UMEM2BLK(ptr);
+ if (IS_SBC_BLK(blk))
+ destroy_carrier(allctr, blk);
+ else
+ mbc_free(allctr, ptr);
+ ptr = fix[ix].list;
+ fix[ix].list = *((void **) ptr);
+ fix[ix].list_size--;
+ fix[ix].allocated--;
+ }
+ }
+
+ blk = UMEM2BLK(ptr);
+
+ if (IS_SBC_BLK(blk))
+ destroy_carrier(allctr, blk);
+ else
+ mbc_free(allctr, ptr);
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
+ }
+
+ if (need_thr_progress && !(need_thr_prgr | need_mr_wrk)) {
+ need_thr_prgr = ddq_check_incoming(ddq);
+ *need_thr_progress |= need_thr_prgr;
+ }
+
+ if (allctr->thread_safe && !allctr_locked)
+ erts_mtx_unlock(&allctr->mutex);
+ return res;
+}
+
+static ERTS_INLINE void
+enqueue_dealloc_other_instance(ErtsAlcType_t type, Allctr_t *allctr, void *ptr)
+{
+ if (allctr->fix)
+ ((UWord *) ptr)[ERTS_ALCU_DD_FIX_TYPE_OFFS] = (UWord) type;
+
+ if (ddq_enqueue(type, &allctr->dd.q, ptr))
+ erts_alloc_notify_delayed_dealloc(allctr->ix);
+}
+
+#endif
+
+void
+erts_alcu_check_delayed_dealloc(Allctr_t *allctr,
+ int limit,
+ int *need_thr_progress,
+ int *more_work)
+{
+#ifdef ERTS_SMP
+ handle_delayed_dealloc(allctr,
+ 0,
+ limit,
+ ERTS_ALCU_DD_OPS_LIM_HIGH,
+ need_thr_progress,
+ more_work);
+#endif
+}
+
+#define ERTS_ALCU_HANDLE_DD_IN_OP(Allctr, Locked) \
+ handle_delayed_dealloc((Allctr), (Locked), 1, \
+ ERTS_ALCU_DD_OPS_LIM_LOW, NULL, NULL)
+
/* Multi block carrier alloc/realloc/free ... */
/* NOTE! mbc_alloc() may in case of memory shortage place the requested
@@ -680,8 +1135,21 @@ mbc_alloc_block(Allctr_t *allctr, Uint size, Uint *blk_szp, Uint32 *alcu_flgsp)
}
}
+#ifdef ERTS_SMP
+ if (allctr->dd.use)
+ ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1);
+#endif
+
blk = (*allctr->get_free_block)(allctr, get_blk_sz, NULL, 0, *alcu_flgsp);
+#ifdef ERTS_SMP
+ if (!blk && allctr->dd.use) {
+ if (ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1))
+ blk = (*allctr->get_free_block)(allctr, get_blk_sz, NULL, 0,
+ *alcu_flgsp);
+ }
+#endif
+
if (!blk) {
if ((*alcu_flgsp) & ERTS_ALCU_FLG_SBMBC)
blk = create_sbmbc(allctr, get_blk_sz);
@@ -939,6 +1407,11 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
Uint is_last_blk;
#endif /* #ifndef MBC_REALLOC_ALWAYS_MOVES */
+#ifdef ERTS_SMP
+ if (allctr->dd.use)
+ ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1);
+#endif
+
ASSERT(p);
ASSERT(size);
ASSERT(size < allctr->sbc_threshold);
@@ -1005,7 +1478,6 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs)
cand_blk,
cand_blk_sz,
alcu_flgs);
-
if (new_blk || cand_blk != blk)
goto move_into_new_blk;
}
@@ -1441,7 +1913,7 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
goto try_sys_alloc;
if (flags & CFLG_FORCE_MSEG)
goto try_mseg;
- if (erts_mseg_no() >= max_mseg_carriers)
+ if (erts_mseg_no(&allctr->mseg_opt) >= max_mseg_carriers)
goto try_sys_alloc;
if (flags & CFLG_SBC) {
if (allctr->sbcs.curr.norm.mseg.no >= allctr->max_mseg_sbcs)
@@ -1840,8 +2312,12 @@ static struct {
Eterm ycs;
/* Eterm sbmbcs; */
+
+ Eterm fix_types;
+
Eterm mbcs;
Eterm sbcs;
+
Eterm sys_alloc_carriers_size;
#if HAVE_ERTS_MSEG
Eterm mseg_alloc_carriers_size;
@@ -1871,6 +2347,8 @@ static struct {
#endif
} am;
+static Eterm fix_type_atoms[ERTS_ALC_NO_FIXED_SIZES];
+
static ERTS_INLINE void atom_init(Eterm *atom, char *name)
{
*atom = am_atom_put(name, strlen(name));
@@ -1891,6 +2369,7 @@ init_atoms(Allctr_t *allctr)
erts_mtx_lock(&init_atoms_mtx);
if (!atoms_initialized) {
+ int ix;
#ifdef DEBUG
Eterm *atom;
@@ -1933,8 +2412,12 @@ init_atoms(Allctr_t *allctr)
AM_INIT(ycs);
/*AM_INIT(sbmbcs);*/
+
+ AM_INIT(fix_types);
+
AM_INIT(mbcs);
AM_INIT(sbcs);
+
AM_INIT(sys_alloc_carriers_size);
#if HAVE_ERTS_MSEG
AM_INIT(mseg_alloc_carriers_size);
@@ -1965,6 +2448,13 @@ init_atoms(Allctr_t *allctr)
ASSERT(*atom != THE_NON_VALUE);
}
#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 = strlen(name);
+ fix_type_atoms[ix] = am_atom_put(name, len);
+ }
}
@@ -2043,6 +2533,48 @@ add_4tup(Uint **hpp, Uint *szp, Eterm *lp,
}
static Eterm
+sz_info_fix(Allctr_t *allctr,
+ int *print_to_p,
+ void *print_to_arg,
+ Uint **hpp,
+ Uint *szp)
+{
+ Eterm res;
+ int ix;
+ ErtsAlcFixList_t *fix = allctr->fix;
+
+ ASSERT(fix);
+
+ res = NIL;
+
+ for (ix = ERTS_ALC_NO_FIXED_SIZES-1; ix >= 0; ix--) {
+ ErtsAlcType_t n = ix + ERTS_ALC_N_MIN_A_FIXED_SIZE;
+ Uint alloced = (fix[ix].type_size * fix[ix].allocated);
+ Uint used = fix[ix].type_size*fix[ix].used;
+
+ if (print_to_p) {
+ int to = *print_to_p;
+ void *arg = print_to_arg;
+ erts_print(to,
+ arg,
+ "fix type: %s %bpu %bpu\n",
+ (char *) ERTS_ALC_N2TD(n),
+ alloced,
+ used);
+ }
+
+ if (hpp || szp) {
+ add_3tup(hpp, szp, &res,
+ fix_type_atoms[ix],
+ bld_unstable_uint(hpp, szp, alloced),
+ bld_unstable_uint(hpp, szp, used));
+ }
+ }
+
+ return res;
+}
+
+static Eterm
sz_info_carriers(Allctr_t *allctr,
CarriersStats_t *cs,
char *prefix,
@@ -2590,7 +3122,7 @@ erts_alcu_sz_info(Allctr_t *allctr,
Uint **hpp,
Uint *szp)
{
- Eterm res, sbmbcs, mbcs, sbcs;
+ Eterm res, sbmbcs, mbcs, sbcs, fix = THE_NON_VALUE;
res = THE_NON_VALUE;
@@ -2607,6 +3139,8 @@ erts_alcu_sz_info(Allctr_t *allctr,
erts_mtx_lock(&allctr->mutex);
#endif
+ ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
+
if (hpp || szp)
ensure_atoms_initialized(allctr);
@@ -2619,6 +3153,8 @@ erts_alcu_sz_info(Allctr_t *allctr,
update_max_ever_values(&allctr->mbcs);
update_max_ever_values(&allctr->sbcs);
+ if (allctr->fix)
+ fix = sz_info_fix(allctr, print_to_p, print_to_arg, hpp, szp);
sbmbcs = sz_info_carriers(allctr, &allctr->sbmbcs, "sbmbcs ", print_to_p,
print_to_arg, hpp, szp);
mbcs = sz_info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p,
@@ -2631,6 +3167,8 @@ erts_alcu_sz_info(Allctr_t *allctr,
add_2tup(hpp, szp, &res, am.sbcs, sbcs);
add_2tup(hpp, szp, &res, am.mbcs, mbcs);
add_2tup(hpp, szp, &res, am.sbmbcs, sbmbcs);
+ if (allctr->fix)
+ add_2tup(hpp, szp, &res, am.fix_types, fix);
}
if (begin_max_period) {
@@ -2656,7 +3194,7 @@ erts_alcu_info(Allctr_t *allctr,
Uint **hpp,
Uint *szp)
{
- Eterm res, sett, sbmbcs, mbcs, sbcs, calls;
+ Eterm res, sett, sbmbcs, mbcs, sbcs, calls, fix = THE_NON_VALUE;
res = THE_NON_VALUE;
@@ -2673,6 +3211,8 @@ erts_alcu_info(Allctr_t *allctr,
erts_mtx_lock(&allctr->mutex);
#endif
+ ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
+
if (hpp || szp)
ensure_atoms_initialized(allctr);
@@ -2694,6 +3234,8 @@ erts_alcu_info(Allctr_t *allctr,
}
sett = info_options(allctr, print_to_p, print_to_arg, hpp, szp);
+ if (allctr->fix)
+ fix = sz_info_fix(allctr, print_to_p, print_to_arg, hpp, szp);
sbmbcs = info_carriers(allctr, &allctr->sbmbcs, "sbmbcs ", print_to_p,
print_to_arg, hpp, szp);
mbcs = info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p,
@@ -2709,6 +3251,8 @@ erts_alcu_info(Allctr_t *allctr,
add_2tup(hpp, szp, &res, am.sbcs, sbcs);
add_2tup(hpp, szp, &res, am.mbcs, mbcs);
add_2tup(hpp, szp, &res, am.sbmbcs, sbmbcs);
+ if (allctr->fix)
+ add_2tup(hpp, szp, &res, am.fix_types, fix);
add_2tup(hpp, szp, &res, am.options, sett);
add_3tup(hpp, szp, &res,
am.versions,
@@ -2733,7 +3277,7 @@ erts_alcu_info(Allctr_t *allctr,
void
-erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size)
+erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size, ErtsAlcUFixInfo_t *fi, int fisz)
{
#ifdef USE_THREADS
@@ -2751,6 +3295,18 @@ erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size)
size->blocks += allctr->sbmbcs.blocks.curr.size;
size->blocks += allctr->sbcs.blocks.curr.size;
+ if (fi) {
+ int ix;
+ for (ix = 0; ix < fisz; ix++) {
+ if (allctr->fix) {
+ fi[ix].allocated += (allctr->fix[ix].type_size
+ * allctr->fix[ix].allocated);
+ fi[ix].used += (allctr->fix[ix].type_size
+ * allctr->fix[ix].used);
+ }
+ }
+ }
+
#ifdef USE_THREADS
if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
@@ -2764,12 +3320,16 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
{
Allctr_t *allctr = (Allctr_t *) extra;
void *res;
+ ErtsAlcFixList_t *fix;
ASSERT(initialized);
ASSERT(allctr);
- ERTS_ALCU_DBG_CHK_THR_SPEC(allctr);
+ ERTS_SMP_LC_ASSERT(!allctr->thread_safe
+ || erts_lc_mtx_is_locked(&allctr->mutex));
+
+ ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
#if ALLOC_ZERO_EQ_NULL
if (!size)
@@ -2778,18 +3338,61 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
INC_CC(allctr->calls.this_alloc);
+ fix = allctr->fix;
+ if (fix) {
+ int ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE;
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1);
+ fix[ix].used++;
+ res = fix[ix].list;
+ if (res) {
+ fix[ix].list_size--;
+ fix[ix].list = *((void **) res);
+ if (fix[ix].list && fix[ix].allocated > fix[ix].limit) {
+ void *p = fix[ix].list;
+ Block_t *blk;
+ fix[ix].list = *((void **) p);
+ fix[ix].list_size--;
+ blk = UMEM2BLK(p);
+ if (IS_SBC_BLK(blk))
+ destroy_carrier(allctr, blk);
+ else
+ mbc_free(allctr, p);
+ fix[ix].allocated--;
+ }
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
+ return res;
+ }
+ if (size < 2*sizeof(UWord))
+ size += sizeof(UWord);
+ if (fix[ix].limit < fix[ix].used)
+ fix[ix].limit = fix[ix].used;
+ if (fix[ix].max_used < fix[ix].used)
+ fix[ix].max_used = fix[ix].used;
+ fix[ix].allocated++;
+ }
+
if (size >= allctr->sbc_threshold) {
+ Block_t *blk;
+#ifdef ERTS_SMP
+ if (allctr->dd.use)
+ ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1);
+#endif
#if HALFWORD_HEAP
- Block_t *blk = create_carrier(allctr, size,
- CFLG_SBC | CFLG_FORCE_MSEG);
+ blk = create_carrier(allctr, size,
+ CFLG_SBC | CFLG_FORCE_MSEG);
#else
- Block_t *blk = create_carrier(allctr, size, CFLG_SBC);
+ blk = create_carrier(allctr, size, CFLG_SBC);
#endif
res = blk ? BLK2UMEM(blk) : NULL;
}
else
res = mbc_alloc(allctr, size);
+ if (!res && fix) {
+ int ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE;
+ fix[ix].allocated--;
+ fix[ix].used--;
+ }
return res;
}
@@ -2818,29 +3421,28 @@ erts_alcu_alloc_ts(ErtsAlcType_t type, void *extra, Uint size)
return res;
}
+#ifdef ERTS_SMP
+
void *
erts_alcu_alloc_thr_spec(ErtsAlcType_t type, void *extra, Uint size)
{
ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
- int ix = erts_alc_get_thr_ix();
+ int ix;
Allctr_t *allctr;
- int unlock;
void *res;
- ASSERT(ix > 0);
- if (ix < tspec->size) {
- allctr = tspec->allctr[ix];
- unlock = 0;
- }
- else {
- allctr = tspec->allctr[0];
- unlock = 1;
+ ix = ERTS_ALC_GET_THR_IX();
+
+ ASSERT(0 <= ix && ix < tspec->size);
+
+ allctr = tspec->allctr[ix];
+
+ if (allctr->thread_safe)
erts_mtx_lock(&allctr->mutex);
- }
res = do_erts_alcu_alloc(type, allctr, size);
- if (unlock)
+ if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
DEBUG_CHECK_ALIGNMENT(res);
@@ -2851,51 +3453,96 @@ erts_alcu_alloc_thr_spec(ErtsAlcType_t type, void *extra, Uint size)
void *
erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size)
{
- ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
- int ix = erts_alc_get_thr_ix();
- Allctr_t *allctr;
+ int pref_ix;
+ Allctr_t *pref_allctr;
void *res;
- ASSERT(sizeof(UWord) == sizeof(Allctr_t *));
- ASSERT(ix > 0);
- if (ix >= tspec->size)
- ix = (ix % (tspec->size - 1)) + 1;
- allctr = tspec->allctr[ix];
- erts_mtx_lock(&allctr->mutex);
- res = do_erts_alcu_alloc(type, allctr, size + sizeof(UWord));
- if (res) {
- *((Allctr_t **) res) = allctr;
- res = (void *) (((char *) res) + sizeof(UWord));
- }
- erts_mtx_unlock(&allctr->mutex);
+ pref_ix = get_pref_allctr(extra, &pref_allctr);
+
+ if (pref_allctr->thread_safe)
+ erts_mtx_lock(&pref_allctr->mutex);
+
+ ERTS_ALCU_DBG_CHK_THR_ACCESS(pref_allctr);
+
+ res = do_erts_alcu_alloc(type, pref_allctr, size + sizeof(UWord));
+ if (pref_allctr->thread_safe)
+ erts_mtx_unlock(&pref_allctr->mutex);
+
+ if (res)
+ res = put_used_allctr(res, pref_ix, size);
+
DEBUG_CHECK_ALIGNMENT(res);
+
+
return res;
}
#endif
+#endif
+
/* ------------------------------------------------------------------------- */
static ERTS_INLINE void
do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p)
{
+ int ix;
Allctr_t *allctr = (Allctr_t *) extra;
ASSERT(initialized);
ASSERT(allctr);
- ERTS_ALCU_DBG_CHK_THR_SPEC(allctr);
+ ERTS_SMP_LC_ASSERT(!allctr->thread_safe
+ || erts_lc_mtx_is_locked(&allctr->mutex));
+
+ ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
if (p) {
+ ErtsAlcFixList_t *fix = allctr->fix;
Block_t *blk;
INC_CC(allctr->calls.this_free);
+ if (fix) {
+ ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE;
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1);
+ fix[ix].used--;
+ if (fix[ix].allocated < fix[ix].limit
+ && fix[ix].list_size < ERTS_ALCU_FIX_MAX_LIST_SZ) {
+ *((void **) p) = fix[ix].list;
+ fix[ix].list = p;
+ fix[ix].list_size++;
+ if (!allctr->fix_shrink_scheduled) {
+ allctr->fix_shrink_scheduled = 1;
+ erts_set_aux_work_timeout(
+ allctr->ix,
+ (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM
+ | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC),
+ 1);
+ }
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
+ return;
+ }
+ fix[ix].allocated--;
+ if (fix[ix].list && fix[ix].allocated > fix[ix].limit) {
+ blk = UMEM2BLK(p);
+ if (IS_SBC_BLK(blk))
+ destroy_carrier(allctr, blk);
+ else
+ mbc_free(allctr, p);
+ p = fix[ix].list;
+ fix[ix].list = *((void **) p);
+ fix[ix].list_size--;
+ fix[ix].allocated--;
+ }
+ }
+
blk = UMEM2BLK(p);
if (IS_SBC_BLK(blk))
destroy_carrier(allctr, blk);
else
mbc_free(allctr, p);
+ ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0);
}
}
@@ -2915,44 +3562,56 @@ erts_alcu_free_ts(ErtsAlcType_t type, void *extra, void *p)
erts_mtx_unlock(&allctr->mutex);
}
+#ifdef ERTS_SMP
+
void
erts_alcu_free_thr_spec(ErtsAlcType_t type, void *extra, void *p)
{
ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
- int ix = erts_alc_get_thr_ix();
- int unlock;
+ int ix;
Allctr_t *allctr;
- ASSERT(ix > 0);
- if (ix < tspec->size) {
- allctr = tspec->allctr[ix];
- unlock = 0;
- }
- else {
- allctr = tspec->allctr[0];
- unlock = 1;
+ ix = ERTS_ALC_GET_THR_IX();
+
+ ASSERT(0 <= ix && ix < tspec->size);
+
+ allctr = tspec->allctr[ix];
+
+ if (allctr->thread_safe)
erts_mtx_lock(&allctr->mutex);
- }
do_erts_alcu_free(type, allctr, p);
- if (unlock)
+
+ if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
}
void
-erts_alcu_free_thr_pref(ErtsAlcType_t type, void *unused, void *p)
+erts_alcu_free_thr_pref(ErtsAlcType_t type, void *extra, void *p)
{
if (p) {
- void *ptr = (void *) (((char *) p) - sizeof(UWord));
- Allctr_t *allctr = *((Allctr_t **) ptr);
- erts_mtx_lock(&allctr->mutex);
- do_erts_alcu_free(type, allctr, ptr);
- erts_mtx_unlock(&allctr->mutex);
+ Allctr_t *pref_allctr, *used_allctr;
+ void *ptr;
+
+ get_pref_allctr(extra, &pref_allctr);
+ ptr = get_used_allctr(extra, p, &used_allctr, NULL);
+ if (pref_allctr != used_allctr)
+ enqueue_dealloc_other_instance(type, used_allctr, ptr);
+ else {
+ if (used_allctr->thread_safe)
+ erts_mtx_lock(&used_allctr->mutex);
+ ERTS_ALCU_DBG_CHK_THR_ACCESS(used_allctr);
+ do_erts_alcu_free(type, used_allctr, ptr);
+ if (used_allctr->thread_safe)
+ erts_mtx_unlock(&used_allctr->mutex);
+ }
}
}
#endif
+#endif
+
/* ------------------------------------------------------------------------- */
static ERTS_INLINE void *
@@ -2970,7 +3629,10 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
ASSERT(allctr);
- ERTS_ALCU_DBG_CHK_THR_SPEC(allctr);
+ ERTS_SMP_LC_ASSERT(!allctr->thread_safe
+ || erts_lc_mtx_is_locked(&allctr->mutex));
+
+ ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr);
if (!p) {
res = do_erts_alcu_alloc(type, extra, size);
@@ -3063,6 +3725,10 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
}
else {
Block_t *new_blk;
+#ifdef ERTS_SMP
+ if (allctr->dd.use)
+ ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1);
+#endif
if(IS_SBC_BLK(blk)) {
do_carrier_resize:
#if HALFWORD_HEAP
@@ -3166,30 +3832,29 @@ erts_alcu_realloc_mv_ts(ErtsAlcType_t type, void *extra, void *p, Uint size)
return res;
}
+#ifdef ERTS_SMP
+
void *
erts_alcu_realloc_thr_spec(ErtsAlcType_t type, void *extra,
void *ptr, Uint size)
{
ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
- int ix = erts_alc_get_thr_ix();
+ int ix;
Allctr_t *allctr;
- int unlock;
void *res;
- ASSERT(ix > 0);
- if (ix < tspec->size) {
- allctr = tspec->allctr[ix];
- unlock = 0;
- }
- else {
- allctr = tspec->allctr[0];
- unlock = 1;
+ ix = ERTS_ALC_GET_THR_IX();
+
+ ASSERT(0 <= ix && ix < tspec->size);
+
+ allctr = tspec->allctr[ix];
+
+ if (allctr->thread_safe)
erts_mtx_lock(&allctr->mutex);
- }
res = do_erts_alcu_realloc(type, allctr, ptr, size, 0);
- if (unlock)
+ if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
DEBUG_CHECK_ALIGNMENT(res);
@@ -3202,26 +3867,22 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra,
void *ptr, Uint size)
{
ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
- int ix = erts_alc_get_thr_ix();
+ int ix;
Allctr_t *allctr;
- int unlock;
void *res;
- ASSERT(ix > 0);
- if (ix < tspec->size) {
- allctr = tspec->allctr[ix];
- unlock = 0;
- }
- else {
- allctr = tspec->allctr[0];
- unlock = 1;
- erts_mtx_lock(&allctr->mutex);
- }
+ ix = ERTS_ALC_GET_THR_IX();
+ ASSERT(0 <= ix && ix < tspec->size);
+
+ allctr = tspec->allctr[ix];
+
+ if (allctr->thread_safe)
+ erts_mtx_lock(&allctr->mutex);
res = do_erts_alcu_alloc(type, allctr, size);
if (!res) {
- if (unlock)
+ if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
res = erts_alcu_realloc_thr_spec(type, allctr, ptr, size);
}
@@ -3235,7 +3896,7 @@ 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);
- if (unlock)
+ if (allctr->thread_safe)
erts_mtx_unlock(&allctr->mutex);
}
@@ -3244,129 +3905,101 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra,
return res;
}
-void *
-erts_alcu_realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size)
+static ERTS_INLINE void *
+realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size,
+ int force_move)
{
- ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
- int ix;
+ int pref_ix;
void *ptr, *res;
Allctr_t *pref_allctr, *used_allctr;
+ UWord old_user_size;
if (!p)
return erts_alcu_alloc_thr_pref(type, extra, size);
- ptr = (void *) (((char *) p) - sizeof(UWord));
- used_allctr = *((Allctr_t **) ptr);
+ pref_ix = get_pref_allctr(extra, &pref_allctr);
+ ptr = get_used_allctr(extra, p, &used_allctr, &old_user_size);
- ix = erts_alc_get_thr_ix();
- ASSERT(ix > 0);
- if (ix >= tspec->size)
- ix = (ix % (tspec->size - 1)) + 1;
- pref_allctr = tspec->allctr[ix];
ASSERT(used_allctr && pref_allctr);
- erts_mtx_lock(&used_allctr->mutex);
- res = do_erts_alcu_realloc(type,
- used_allctr,
- ptr,
- size + sizeof(UWord),
- (pref_allctr != used_allctr
- ? ERTS_ALCU_FLG_FAIL_REALLOC_MOVE
- : 0));
- erts_mtx_unlock(&used_allctr->mutex);
- if (res) {
- ASSERT(used_allctr == *((Allctr_t **) res));
- res = (void *) (((char *) res) + sizeof(UWord));
- DEBUG_CHECK_ALIGNMENT(res);
+ if (!force_move && used_allctr == pref_allctr) {
+ if (used_allctr->thread_safe)
+ erts_mtx_lock(&used_allctr->mutex);
+ ERTS_ALCU_DBG_CHK_THR_ACCESS(used_allctr);
+ res = do_erts_alcu_realloc(type,
+ used_allctr,
+ ptr,
+ size + sizeof(UWord),
+ 0);
+ if (used_allctr->thread_safe)
+ erts_mtx_unlock(&used_allctr->mutex);
+ if (res)
+ res = put_used_allctr(res, pref_ix, size);
}
else {
- erts_mtx_lock(&pref_allctr->mutex);
+ if (pref_allctr->thread_safe)
+ erts_mtx_lock(&pref_allctr->mutex);
res = do_erts_alcu_alloc(type, pref_allctr, size + sizeof(UWord));
- erts_mtx_unlock(&pref_allctr->mutex);
+ if (pref_allctr->thread_safe && (!force_move
+ || used_allctr != pref_allctr))
+ erts_mtx_unlock(&pref_allctr->mutex);
if (res) {
Block_t *blk;
size_t cpy_size;
- *((Allctr_t **) res) = pref_allctr;
- res = (void *) (((char *) res) + sizeof(UWord));
+ res = put_used_allctr(res, pref_ix, size);
DEBUG_CHECK_ALIGNMENT(res);
- erts_mtx_lock(&used_allctr->mutex);
blk = UMEM2BLK(ptr);
- cpy_size = BLK_SZ(blk) - ABLK_HDR_SZ - sizeof(UWord);
+ if (old_user_size != ERTS_AU_PREF_ALLOC_SIZE_MASK)
+ cpy_size = old_user_size;
+ else {
+ if (used_allctr->thread_safe && (!force_move
+ || used_allctr != pref_allctr))
+ erts_mtx_lock(&used_allctr->mutex);
+ ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&used_allctr->mutex));
+ cpy_size = BLK_SZ(blk);
+ if (used_allctr->thread_safe && (!force_move
+ || used_allctr != pref_allctr))
+ erts_mtx_unlock(&used_allctr->mutex);
+ cpy_size -= ABLK_HDR_SZ + sizeof(UWord);
+ }
if (cpy_size > size)
cpy_size = size;
sys_memcpy(res, p, cpy_size);
- do_erts_alcu_free(type, used_allctr, ptr);
- erts_mtx_unlock(&used_allctr->mutex);
+
+ if (!force_move || used_allctr != pref_allctr)
+ enqueue_dealloc_other_instance(type, used_allctr, ptr);
+ else {
+ do_erts_alcu_free(type, used_allctr, ptr);
+ ASSERT(pref_allctr == used_allctr);
+ if (pref_allctr->thread_safe)
+ erts_mtx_unlock(&pref_allctr->mutex);
+ }
}
}
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);
+}
void *
erts_alcu_realloc_mv_thr_pref(ErtsAlcType_t type, void *extra,
void *p, Uint size)
{
- ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra;
- int ix;
- void *ptr, *res;
- Allctr_t *pref_allctr, *used_allctr;
-
- if (!p)
- return erts_alcu_alloc_thr_pref(type, extra, size);
-
- ptr = (void *) (((char *) p) - sizeof(UWord));
- used_allctr = *((Allctr_t **) ptr);
-
- ix = erts_alc_get_thr_ix();
- ASSERT(ix > 0);
- if (ix >= tspec->size)
- ix = (ix % (tspec->size - 1)) + 1;
- pref_allctr = tspec->allctr[ix];
- ASSERT(used_allctr && pref_allctr);
-
- erts_mtx_lock(&pref_allctr->mutex);
- res = do_erts_alcu_alloc(type, pref_allctr, size + sizeof(UWord));
- if (!res) {
- erts_mtx_unlock(&pref_allctr->mutex);
- res = erts_alcu_realloc_thr_pref(type, extra, p, size);
- }
- else {
- Block_t *blk;
- size_t cpy_size;
- Allctr_t *allctr;
-
- *((Allctr_t **) res) = pref_allctr;
- res = (void *) (((char *) res) + sizeof(UWord));
-
- DEBUG_CHECK_ALIGNMENT(res);
-
- if (used_allctr == pref_allctr)
- allctr = pref_allctr;
- else {
- erts_mtx_unlock(&pref_allctr->mutex);
- allctr = used_allctr;
- erts_mtx_lock(&allctr->mutex);
- }
-
- blk = UMEM2BLK(ptr);
- cpy_size = BLK_SZ(blk) - ABLK_HDR_SZ - sizeof(UWord);
- if (cpy_size > size)
- cpy_size = size;
- sys_memcpy(res, p, cpy_size);
- do_erts_alcu_free(type, allctr, ptr);
- erts_mtx_unlock(&allctr->mutex);
- }
-
- return res;
+ return realloc_thr_pref(type, extra, p, size, 1);
}
#endif
+#endif
+
/* ------------------------------------------------------------------------- */
int
@@ -3381,6 +4014,10 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
sys_memcpy((void *) &allctr->mseg_opt,
(void *) &erts_mseg_default_opt,
sizeof(ErtsMsegOpt_t));
+#ifdef ERTS_SMP
+ if (init->tspec || init->tpref)
+ allctr->mseg_opt.sched_spec = 1;
+#endif
# if HALFWORD_HEAP
allctr->mseg_opt.low_mem = init->low_mem;
# endif
@@ -3390,6 +4027,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
if (!allctr->name_prefix)
goto error;
+ allctr->ix = init->ix;
allctr->alloc_no = init->alloc_no;
if (allctr->alloc_no < ERTS_ALC_A_MIN
|| ERTS_ALC_A_MAX < allctr->alloc_no)
@@ -3431,6 +4069,18 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
goto error;
allctr->min_block_size = UNIT_CEILING(allctr->min_block_size
+ sizeof(UWord));
+#if ERTS_SMP
+ if (init->tpref) {
+ Uint sz = sizeof(Block_t);
+ sz += ERTS_ALCU_DD_FIX_TYPE_OFFS*sizeof(UWord);
+ if (init->fix)
+ sz += sizeof(UWord);
+ sz = UNIT_CEILING(sz);
+ if (sz > allctr->min_block_size)
+ allctr->min_block_size = sz;
+ }
+#endif
+
allctr->sbmbc_threshold = init->sbmbct;
@@ -3493,7 +4143,8 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
if (allctr->mbc_header_size < sizeof(Carrier_t))
goto error;
-#ifdef USE_THREADS
+#ifdef ERTS_SMP
+ allctr->dd.use = 0;
if (init->tpref) {
allctr->mbc_header_size = (UNIT_CEILING(allctr->mbc_header_size
+ FBLK_FTR_SZ
@@ -3507,6 +4158,9 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
+ sizeof(UWord))
- ABLK_HDR_SZ
- sizeof(UWord));
+
+ allctr->dd.use = 1;
+ init_dd_queue(&allctr->dd.q);
}
else
#endif
@@ -3548,6 +4202,21 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
}
+ if (init->fix) {
+ int i;
+ allctr->fix = init->fix;
+ allctr->fix_shrink_scheduled = 0;
+ for (i = 0; i < ERTS_ALC_NO_FIXED_SIZES; i++) {
+ allctr->fix[i].max_used = 0;
+ allctr->fix[i].limit = 0;
+ allctr->fix[i].type_size = init->fix_type_size[i];
+ allctr->fix[i].list_size = 0;
+ allctr->fix[i].list = NULL;
+ allctr->fix[i].allocated = 0;
+ allctr->fix[i].used = 0;
+ }
+ }
+
return 1;
error:
diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h
index fed4d3dbe6..df560a0de2 100644
--- a/erts/emulator/beam/erl_alloc_util.h
+++ b/erts/emulator/beam/erl_alloc_util.h
@@ -20,10 +20,13 @@
#ifndef ERL_ALLOC_UTIL__
#define ERL_ALLOC_UTIL__
-#define ERTS_ALCU_VSN_STR "2.2"
+#define ERTS_ALCU_VSN_STR "3.0"
#include "erl_alloc_types.h"
+#define ERTS_AU_PREF_ALLOC_BITS 11
+#define ERTS_AU_MAX_PREF_ALLOC_INSTANCES (1 << ERTS_AU_PREF_ALLOC_BITS)
+
typedef struct Allctr_t_ Allctr_t;
typedef struct {
@@ -35,6 +38,7 @@ typedef struct {
char *name_prefix;
ErtsAlcType_t alloc_no;
int force;
+ int ix;
int ts;
int tspec;
int tpref;
@@ -53,6 +57,9 @@ typedef struct {
UWord mbcgs;
UWord sbmbct;
UWord sbmbcs;
+
+ void *fix;
+ size_t *fix_type_size;
} AllctrInit_t;
typedef struct {
@@ -60,6 +67,11 @@ typedef struct {
UWord carriers;
} AllctrSize_t;
+typedef struct {
+ UWord allocated;
+ UWord used;
+} ErtsAlcUFixInfo_t;
+
#ifndef SMALL_MEMORY
#define ERTS_DEFAULT_ALCU_INIT { \
@@ -71,6 +83,7 @@ typedef struct {
NULL, \
ERTS_ALC_A_INVALID, /* (number) alloc_no: allocator number */\
0, /* (bool) force: force enabled */\
+ 0, /* (number) ix: instance index */\
1, /* (bool) ts: thread safe */\
0, /* (bool) tspec: thread specific */\
0, /* (bool) tpref: thread preferred */\
@@ -88,7 +101,10 @@ typedef struct {
1024*1024, /* (bytes) smbcs: smallest mbc size */\
10, /* (amount) mbcgs: mbc growth stages */\
256, /* (bytes) sbmbct: small block mbc threshold */\
- 8*1024 /* (bytes) sbmbcs: small block mbc size */\
+ 8*1024, /* (bytes) sbmbcs: small block mbc size */ \
+ /* --- Data not options -------------------------------------------- */\
+ NULL, /* (ptr) fix */\
+ NULL /* (ptr) fix_type_size */\
}
#else /* if SMALL_MEMORY */
@@ -102,6 +118,7 @@ typedef struct {
NULL, \
ERTS_ALC_A_INVALID, /* (number) alloc_no: allocator number */\
0, /* (bool) force: force enabled */\
+ 0, /* (number) ix: instance index */\
1, /* (bool) ts: thread safe */\
0, /* (bool) tspec: thread specific */\
0, /* (bool) tpref: thread preferred */\
@@ -118,7 +135,10 @@ typedef struct {
128*1024, /* (bytes) smbcs: smallest mbc size */\
10, /* (amount) mbcgs: mbc growth stages */\
256, /* (bytes) sbmbct: small block mbc threshold */\
- 8*1024 /* (bytes) sbmbcs: small block mbc size */\
+ 8*1024, /* (bytes) sbmbcs: small block mbc size */ \
+ /* --- Data not options -------------------------------------------- */\
+ NULL, /* (ptr) fix */\
+ NULL /* (ptr) fix_type_size */\
}
#endif
@@ -132,6 +152,7 @@ void * erts_alcu_alloc_ts(ErtsAlcType_t, void *, Uint);
void * erts_alcu_realloc_ts(ErtsAlcType_t, void *, void *, Uint);
void * erts_alcu_realloc_mv_ts(ErtsAlcType_t, void *, void *, Uint);
void erts_alcu_free_ts(ErtsAlcType_t, void *, void *);
+#ifdef ERTS_SMP
void * erts_alcu_alloc_thr_spec(ErtsAlcType_t, void *, Uint);
void * erts_alcu_realloc_thr_spec(ErtsAlcType_t, void *, void *, Uint);
void * erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t, void *, void *, Uint);
@@ -141,12 +162,16 @@ void * erts_alcu_realloc_thr_pref(ErtsAlcType_t, void *, void *, Uint);
void * erts_alcu_realloc_mv_thr_pref(ErtsAlcType_t, void *, void *, Uint);
void erts_alcu_free_thr_pref(ErtsAlcType_t, void *, void *);
#endif
+#endif
Eterm erts_alcu_au_info_options(int *, void *, Uint **, Uint *);
Eterm erts_alcu_info_options(Allctr_t *, int *, void *, Uint **, Uint *);
Eterm erts_alcu_sz_info(Allctr_t *, int, int *, void *, Uint **, Uint *);
Eterm erts_alcu_info(Allctr_t *, int, int *, void *, Uint **, Uint *);
void erts_alcu_init(AlcUInit_t *);
-void erts_alcu_current_size(Allctr_t *, AllctrSize_t *);
+void erts_alcu_current_size(Allctr_t *, AllctrSize_t *,
+ ErtsAlcUFixInfo_t *, int);
+void erts_alcu_check_delayed_dealloc(Allctr_t *, int, int *, int *);
+erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t);
#endif
@@ -246,7 +271,74 @@ typedef struct {
} blocks;
} CarriersStats_t;
+#ifdef ERTS_SMP
+
+typedef union ErtsAllctrDDBlock_t_ ErtsAllctrDDBlock_t;
+
+union ErtsAllctrDDBlock_t_ {
+ erts_atomic_t atmc_next;
+ ErtsAllctrDDBlock_t *ptr_next;
+};
+
+typedef struct {
+ ErtsAllctrDDBlock_t marker;
+ erts_atomic_t last;
+ erts_atomic_t um_refc[2];
+ erts_atomic32_t um_refc_ix;
+} ErtsDDTail_t;
+
+typedef struct {
+ /*
+ * This structure needs to be cache line aligned for best
+ * performance.
+ */
+ union {
+ /* Modified by threads returning memory to this allocator */
+ ErtsDDTail_t data;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsDDTail_t))];
+ } tail;
+ /*
+ * Everything below this point is *only* accessed by the
+ * thread owning the allocator.
+ */
+ struct {
+ ErtsAllctrDDBlock_t *first;
+ ErtsAllctrDDBlock_t *unref_end;
+ struct {
+ ErtsThrPrgrVal thr_progress;
+ int thr_progress_reached;
+ int um_refc_ix;
+ ErtsAllctrDDBlock_t *unref_end;
+ } next;
+ int used_marker;
+ } head;
+} ErtsAllctrDDQueue_t;
+
+#endif
+
+typedef struct {
+ size_t type_size;
+ SWord list_size;
+ void *list;
+ SWord max_used;
+ SWord limit;
+ SWord allocated;
+ SWord used;
+} ErtsAlcFixList_t;
+
struct Allctr_t_ {
+#ifdef ERTS_SMP
+ struct {
+ /*
+ * We want the queue at the beginning of
+ * the Allctr_t struct, due to cache line
+ * alignment reasons.
+ */
+ ErtsAllctrDDQueue_t q;
+ int use;
+ int ix;
+ } dd;
+#endif
/* Allocator name prefix */
char * name_prefix;
@@ -254,6 +346,9 @@ struct Allctr_t_ {
/* Allocator number */
ErtsAlcType_t alloc_no;
+ /* Instance index */
+ int ix;
+
/* Alloc, realloc and free names as atoms */
struct {
Eterm alloc;
@@ -278,6 +373,7 @@ struct Allctr_t_ {
Uint mbc_growth_stages;
Uint sbmbc_threshold;
Uint sbmbc_size;
+
#if HAVE_ERTS_MSEG
ErtsMsegOpt_t mseg_opt;
#endif
@@ -315,6 +411,10 @@ struct Allctr_t_ {
void (*check_mbc) (Allctr_t *, Carrier_t *);
#endif
+ int fix_n_base;
+ int fix_shrink_scheduled;
+ ErtsAlcFixList_t *fix;
+
#ifdef USE_THREADS
/* Mutex for this allocator */
erts_mtx_t mutex;
@@ -323,6 +423,7 @@ struct Allctr_t_ {
Allctr_t *prev;
Allctr_t *next;
} ts_list;
+
#endif
int atoms_initialized;
diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c
index 90d8ea7300..5bdb752d3a 100644
--- a/erts/emulator/beam/erl_ao_firstfit_alloc.c
+++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c
@@ -170,14 +170,18 @@ erts_aoffalc_start(AOFFAllctr_t *alc,
AOFFAllctrInit_t* aoffinit,
AllctrInit_t *init)
{
- AOFFAllctr_t nulled_state = {{0}};
- /* {{0}} is used instead of {0}, in order to avoid (an incorrect) gcc
- warning. gcc warns if {0} is used as initializer of a struct when
- the first member is a struct (not if, for example, the third member
- is a struct). */
+ struct {
+ int dummy;
+ AOFFAllctr_t allctr;
+ } zero = {0};
+ /* The struct with a dummy element first is used in order to avoid (an
+ incorrect) gcc warning. gcc warns if {0} is used as initializer of
+ a struct when the first member is a struct (not if, for example,
+ the third member is a struct). */
+
Allctr_t *allctr = (Allctr_t *) alc;
- sys_memcpy((void *) alc, (void *) &nulled_state, sizeof(AOFFAllctr_t));
+ sys_memcpy((void *) alc, (void *) &zero.allctr, sizeof(AOFFAllctr_t));
allctr->mbc_header_size = sizeof(Carrier_t);
allctr->min_mbc_size = MIN_MBC_SZ;
diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c
index 91b64411d4..2dc7237f7c 100644
--- a/erts/emulator/beam/erl_async.c
+++ b/erts/emulator/beam/erl_async.c
@@ -24,10 +24,18 @@
#include "erl_sys_driver.h"
#include "global.h"
#include "erl_threads.h"
+#include "erl_thr_queue.h"
+#include "erl_async.h"
+
+#define ERTS_MAX_ASYNC_READY_CALLS_IN_SEQ 20
+
+#define ERTS_ASYNC_PRINT_JOB 0
+
+#if !defined(ERTS_SMP) && defined(USE_THREADS) && !ERTS_USE_ASYNC_READY_Q
+# error "Need async ready queue in non-smp case"
+#endif
typedef struct _erl_async {
- struct _erl_async* next;
- struct _erl_async* prev;
DE_Handle* hndl; /* The DE_Handle is needed when port is gone */
Eterm port;
long async_id;
@@ -35,345 +43,498 @@ typedef struct _erl_async {
ErlDrvPDL pdl;
void (*async_invoke)(void*);
void (*async_free)(void*);
-} ErlAsync;
+#if ERTS_USE_ASYNC_READY_Q
+ Uint sched_id;
+ union {
+ ErtsThrQPrepEnQ_t *prep_enq;
+ ErtsThrQFinDeQ_t fin_deq;
+ } q;
+#endif
+} ErtsAsync;
+
+#if ERTS_USE_ASYNC_READY_Q
+
+/*
+ * We can do without the enqueue mutex since it isn't needed for
+ * thread safety. Its only purpose is to put async threads to sleep
+ * during a blast of ready async jobs. This in order to reduce
+ * contention on the enqueue end of the async ready queues. During
+ * such a blast without the enqueue mutex much cpu time is consumed
+ * by the async threads without them doing much progress which in turn
+ * slow down progress of scheduler threads.
+ */
+#define ERTS_USE_ASYNC_READY_ENQ_MTX 1
+
+#if ERTS_USE_ASYNC_READY_ENQ_MTX
typedef struct {
- erts_mtx_t mtx;
- erts_cnd_t cv;
- erts_tid_t thr;
- int len;
-#ifndef ERTS_SMP
- int hndl;
+ erts_mtx_t enq_mtx;
+} ErtsAsyncReadyQXData;
+
#endif
- ErlAsync* head;
- ErlAsync* tail;
-#ifdef ERTS_ENABLE_LOCK_CHECK
- int no;
+
+typedef struct {
+#if ERTS_USE_ASYNC_READY_ENQ_MTX
+ union {
+ ErtsAsyncReadyQXData data;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(
+ sizeof(ErtsAsyncReadyQXData))];
+ } x;
#endif
-} AsyncQueue;
+ ErtsThrQ_t thr_q;
+ ErtsThrQFinDeQ_t fin_deq;
+} ErtsAsyncReadyQ;
-static erts_smp_spinlock_t async_id_lock;
-static long async_id = 0;
+typedef union {
+ ErtsAsyncReadyQ arq;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAsyncReadyQ))];
+} ErtsAlgndAsyncReadyQ;
-#ifndef ERTS_SMP
+#endif /* ERTS_USE_ASYNC_READY_Q */
-erts_mtx_t async_ready_mtx;
-static ErlAsync* async_ready_list = NULL;
+typedef struct {
+ ErtsThrQ_t thr_q;
+ erts_tid_t thr_id;
+} ErtsAsyncQ;
+
+typedef union {
+ ErtsAsyncQ aq;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAsyncQ))];
+} ErtsAlgndAsyncQ;
+typedef struct {
+ int no_initialized;
+ erts_mtx_t mtx;
+ erts_cnd_t cnd;
+ erts_atomic_t id;
+} ErtsAsyncInit;
+
+typedef struct {
+ union {
+ ErtsAsyncInit data;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAsyncInit))];
+ } init;
+ ErtsAlgndAsyncQ *queue;
+#if ERTS_USE_ASYNC_READY_Q
+ ErtsAlgndAsyncReadyQ *ready_queue;
#endif
+} ErtsAsyncData;
-/*
-** Initialize worker threads (if supported)
-*/
+int erts_async_max_threads; /* Initialized by erl_init.c */
+int erts_async_thread_suggested_stack_size; /* Initialized by erl_init.c */
-/* Detach from driver */
-static void async_detach(DE_Handle* dh)
-{
- return;
-}
+static ErtsAsyncData *async;
+#ifndef USE_THREADS
-#ifdef USE_THREADS
+void
+erts_init_async(void)
+{
-static AsyncQueue* async_q;
+}
-static void* async_main(void*);
-static void async_add(ErlAsync*, AsyncQueue*);
+#else
-#ifndef ERTS_SMP
-typedef struct ErtsAsyncReadyCallback_ ErtsAsyncReadyCallback;
-struct ErtsAsyncReadyCallback_ {
- struct ErtsAsyncReadyCallback_ *next;
- void (*callback)(void);
-};
+static void *async_main(void *);
-static ErtsAsyncReadyCallback *callbacks;
-static int async_handle;
+static ERTS_INLINE ErtsAsyncQ *
+async_q(int i)
+{
+ return &async->queue[i].aq;
+}
+
+#if ERTS_USE_ASYNC_READY_Q
-int erts_register_async_ready_callback(void (*funcp)(void))
+static ERTS_INLINE ErtsAsyncReadyQ *
+async_ready_q(Uint sched_id)
{
- ErtsAsyncReadyCallback *cb = erts_alloc(ERTS_ALC_T_ARCALLBACK,
- sizeof(ErtsAsyncReadyCallback));
- cb->next = callbacks;
- cb->callback = funcp;
- erts_mtx_lock(&async_ready_mtx);
- callbacks = cb;
- erts_mtx_unlock(&async_ready_mtx);
- return async_handle;
+ return &async->ready_queue[((int)sched_id)-1].arq;
}
+
#endif
-int init_async(int hndl)
+void
+erts_init_async(void)
{
- erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER;
- AsyncQueue* q;
- int i;
+ async = NULL;
+ if (erts_async_max_threads > 0) {
+#if ERTS_USE_ASYNC_READY_Q
+ ErtsThrQInit_t qinit = ERTS_THR_Q_INIT_DEFAULT;
+#endif
+ erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER;
+ char *ptr;
+ size_t tot_size = 0;
+ int i;
+
+ tot_size += ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAsyncData));
+ tot_size += sizeof(ErtsAlgndAsyncQ)*erts_async_max_threads;
+#if ERTS_USE_ASYNC_READY_Q
+ tot_size += sizeof(ErtsAlgndAsyncReadyQ)*erts_no_schedulers;
+#endif
- thr_opts.detached = 0;
- thr_opts.suggested_stack_size = erts_async_thread_suggested_stack_size;
-
-#ifndef ERTS_SMP
- callbacks = NULL;
- async_handle = hndl;
- erts_mtx_init(&async_ready_mtx, "async_ready");
- async_ready_list = NULL;
-#endif
-
- async_id = 0;
- erts_smp_spinlock_init(&async_id_lock, "async_id");
-
- async_q = q = (AsyncQueue*)
- (erts_async_max_threads
- ? erts_alloc(ERTS_ALC_T_ASYNC_Q,
- erts_async_max_threads * sizeof(AsyncQueue))
- : NULL);
- for (i = 0; i < erts_async_max_threads; i++) {
- q->head = NULL;
- q->tail = NULL;
- q->len = 0;
-#ifndef ERTS_SMP
- q->hndl = hndl;
-#endif
-#ifdef ERTS_ENABLE_LOCK_CHECK
- q->no = i;
-#endif
- erts_mtx_init(&q->mtx, "asyncq");
- erts_cnd_init(&q->cv);
- erts_thr_create(&q->thr, async_main, (void*)q, &thr_opts);
- q++;
- }
- return 0;
-}
+ ptr = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_ASYNC_DATA,
+ tot_size);
+ async = (ErtsAsyncData *) ptr;
+ ptr += ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAsyncData));
-int exit_async()
-{
- int i;
+ async->init.data.no_initialized = 0;
+ erts_mtx_init(&async->init.data.mtx, "async_init_mtx");
+ erts_cnd_init(&async->init.data.cnd);
+ erts_atomic_init_nob(&async->init.data.id, 0);
- /* terminate threads */
- for (i = 0; i < erts_async_max_threads; i++) {
- ErlAsync* a = (ErlAsync*) erts_alloc(ERTS_ALC_T_ASYNC,
- sizeof(ErlAsync));
- a->port = NIL;
- async_add(a, &async_q[i]);
- }
+ async->queue = (ErtsAlgndAsyncQ *) ptr;
+ ptr += sizeof(ErtsAlgndAsyncQ)*erts_async_max_threads;
- for (i = 0; i < erts_async_max_threads; i++) {
- erts_thr_join(async_q[i].thr, NULL);
- erts_mtx_destroy(&async_q[i].mtx);
- erts_cnd_destroy(&async_q[i].cv);
- }
-#ifndef ERTS_SMP
- erts_mtx_destroy(&async_ready_mtx);
+#if ERTS_USE_ASYNC_READY_Q
+
+ qinit.live.queue = ERTS_THR_Q_LIVE_LONG;
+ qinit.live.objects = ERTS_THR_Q_LIVE_SHORT;
+ qinit.notify = erts_notify_check_async_ready_queue;
+
+ async->ready_queue = (ErtsAlgndAsyncReadyQ *) ptr;
+ ptr += sizeof(ErtsAlgndAsyncReadyQ)*erts_no_schedulers;
+
+ for (i = 1; i <= erts_no_schedulers; i++) {
+ ErtsAsyncReadyQ *arq = async_ready_q(i);
+#if ERTS_USE_ASYNC_READY_ENQ_MTX
+ erts_mtx_init(&arq->x.data.enq_mtx, "async_enq_mtx");
#endif
- if (async_q)
- erts_free(ERTS_ALC_T_ASYNC_Q, (void *) async_q);
- return 0;
+ erts_thr_q_finalize_dequeue_state_init(&arq->fin_deq);
+ qinit.arg = (void *) (SWord) i;
+ erts_thr_q_initialize(&arq->thr_q, &qinit);
+ }
+
+#endif
+
+ /* Create async threads... */
+
+ thr_opts.detached = 0;
+ thr_opts.suggested_stack_size
+ = erts_async_thread_suggested_stack_size;
+
+ for (i = 0; i < erts_async_max_threads; i++) {
+ ErtsAsyncQ *aq = async_q(i);
+ erts_thr_create(&aq->thr_id, async_main, (void*) aq, &thr_opts);
+ }
+
+ /* Wait for async threads to initialize... */
+
+ erts_mtx_lock(&async->init.data.mtx);
+ while (async->init.data.no_initialized != erts_async_max_threads)
+ erts_cnd_wait(&async->init.data.cnd, &async->init.data.mtx);
+ erts_mtx_unlock(&async->init.data.mtx);
+
+ erts_mtx_destroy(&async->init.data.mtx);
+ erts_cnd_destroy(&async->init.data.cnd);
+
+ }
}
+#if ERTS_USE_ASYNC_READY_Q
-static void async_add(ErlAsync* a, AsyncQueue* q)
+void *
+erts_get_async_ready_queue(Uint sched_id)
+{
+ return (void *) async ? async_ready_q(sched_id) : NULL;
+}
+
+#endif
+
+static ERTS_INLINE void async_add(ErtsAsync *a, ErtsAsyncQ* q)
{
if (is_internal_port(a->port)) {
- ERTS_LC_ASSERT(erts_drvportid2port(a->port));
+#if ERTS_USE_ASYNC_READY_Q
+ ErtsAsyncReadyQ *arq = async_ready_q(a->sched_id);
+ a->q.prep_enq = erts_thr_q_prepare_enqueue(&arq->thr_q);
+#endif
/* make sure the driver will stay around */
- driver_lock_driver(internal_port_index(a->port));
+ if (a->hndl)
+ erts_ddll_reference_referenced_driver(a->hndl);
}
- erts_mtx_lock(&q->mtx);
+#if ERTS_ASYNC_PRINT_JOB
+ erts_fprintf(stderr, "-> %ld\n", a->async_id);
+#endif
- if (q->len == 0) {
- q->head = a;
- q->tail = a;
- q->len = 1;
- erts_cnd_signal(&q->cv);
- }
- else { /* no need to signal (since the worker is working) */
- a->next = q->head;
- q->head->prev = a;
- q->head = a;
- q->len++;
- }
- erts_mtx_unlock(&q->mtx);
+ erts_thr_q_enqueue(&q->thr_q, a);
}
-static ErlAsync* async_get(AsyncQueue* q)
+static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q,
+ erts_tse_t *tse,
+ ErtsThrQPrepEnQ_t **prep_enq)
{
- ErlAsync* a;
+#if ERTS_USE_ASYNC_READY_Q
+ int saved_fin_deq = 0;
+ ErtsThrQFinDeQ_t fin_deq;
+#endif
- erts_mtx_lock(&q->mtx);
- while((a = q->tail) == NULL) {
- erts_cnd_wait(&q->cv, &q->mtx);
- }
+ while (1) {
+ ErtsAsync *a = (ErtsAsync *) erts_thr_q_dequeue(q);
+ if (a) {
+
+#if ERTS_USE_ASYNC_READY_Q
+ *prep_enq = a->q.prep_enq;
+ erts_thr_q_get_finalize_dequeue_data(q, &a->q.fin_deq);
+ if (saved_fin_deq)
+ erts_thr_q_append_finalize_dequeue_data(&a->q.fin_deq, &fin_deq);
+#endif
+
+ return a;
+ }
+
+ if (ERTS_THR_Q_DIRTY != erts_thr_q_clean(q)) {
+ ErtsThrQFinDeQ_t tmp_fin_deq;
+
+ erts_tse_reset(tse);
+
+#if ERTS_USE_ASYNC_READY_Q
+ chk_fin_deq:
+ if (erts_thr_q_get_finalize_dequeue_data(q, &tmp_fin_deq)) {
+ if (!saved_fin_deq) {
+ erts_thr_q_finalize_dequeue_state_init(&fin_deq);
+ saved_fin_deq = 1;
+ }
+ erts_thr_q_append_finalize_dequeue_data(&fin_deq,
+ &tmp_fin_deq);
+ }
+#endif
+
+ switch (erts_thr_q_inspect(q, 1)) {
+ case ERTS_THR_Q_DIRTY:
+ break;
#ifdef ERTS_SMP
- ASSERT(a && q->tail == a);
+ case ERTS_THR_Q_NEED_THR_PRGR: {
+ ErtsThrPrgrVal prgr = erts_thr_q_need_thr_progress(q);
+ erts_thr_progress_wakeup(NULL, prgr);
+ /*
+ * We do no dequeue finalizing in hope that a new async
+ * job will arrive before we are woken due to thread
+ * progress...
+ */
+ erts_tse_wait(tse);
+ break;
+ }
#endif
- if (q->head == q->tail) {
- q->head = q->tail = NULL;
- q->len = 0;
- }
- else {
- q->tail->prev->next = NULL;
- q->tail = q->tail->prev;
- q->len--;
+ case ERTS_THR_Q_CLEAN:
+
+#if ERTS_USE_ASYNC_READY_Q
+ if (saved_fin_deq) {
+ if (erts_thr_q_finalize_dequeue(&fin_deq))
+ goto chk_fin_deq;
+ else
+ saved_fin_deq = 0;
+ }
+#endif
+
+ erts_tse_wait(tse);
+ break;
+
+ default:
+ ASSERT(0);
+ break;
+ }
+
+ }
}
- erts_mtx_unlock(&q->mtx);
- return a;
}
-
-static int async_del(long id)
+static ERTS_INLINE void call_async_ready(ErtsAsync *a)
{
- int i;
- /* scan all queue for an entry with async_id == 'id' */
-
- for (i = 0; i < erts_async_max_threads; i++) {
- ErlAsync* a;
- erts_mtx_lock(&async_q[i].mtx);
-
- a = async_q[i].head;
- while(a != NULL) {
- if (a->async_id == id) {
- if (a->prev != NULL)
- a->prev->next = a->next;
- else
- async_q[i].head = a->next;
- if (a->next != NULL)
- a->next->prev = a->prev;
- else
- async_q[i].tail = a->prev;
- async_q[i].len--;
- erts_mtx_unlock(&async_q[i].mtx);
- if (a->async_free != NULL)
- a->async_free(a->async_data);
- async_detach(a->hndl);
- erts_free(ERTS_ALC_T_ASYNC, a);
- return 1;
- }
- a = a->next;
+ Port *p = erts_id2port_sflgs(a->port,
+ NULL,
+ 0,
+ ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP);
+ if (!p) {
+ if (a->async_free)
+ a->async_free(a->async_data);
+ }
+ else {
+ if (async_ready(p, a->async_data)) {
+ if (a->async_free)
+ a->async_free(a->async_data);
}
- erts_mtx_unlock(&async_q[i].mtx);
+ erts_port_release(p);
}
- return 0;
+ if (a->hndl)
+ erts_ddll_dereference_driver(a->hndl);
}
-static void* async_main(void* arg)
+static ERTS_INLINE void async_reply(ErtsAsync *a, ErtsThrQPrepEnQ_t *prep_enq)
{
- AsyncQueue* q = (AsyncQueue*) arg;
+#if ERTS_USE_ASYNC_READY_Q
+ ErtsAsyncReadyQ *arq;
-#ifdef ERTS_ENABLE_LOCK_CHECK
- {
- char buf[27];
- erts_snprintf(&buf[0], 27, "async %d", q->no);
- erts_lc_set_thread_name(&buf[0]);
- }
+ if (a->pdl)
+ driver_pdl_dec_refc(a->pdl);
+
+#if ERTS_ASYNC_PRINT_JOB
+ erts_fprintf(stderr, "=>> %ld\n", a->async_id);
#endif
- while(1) {
- ErlAsync* a = async_get(q);
+ arq = async_ready_q(a->sched_id);
- if (a->port == NIL) { /* TIME TO DIE SIGNAL */
- erts_free(ERTS_ALC_T_ASYNC, (void *) a);
- break;
- }
- else {
- (*a->async_invoke)(a->async_data);
- /* Major problem if the code for async_invoke
- or async_free is removed during a blocking operation */
+#if ERTS_USE_ASYNC_READY_ENQ_MTX
+ erts_mtx_lock(&arq->x.data.enq_mtx);
+#endif
+
+ erts_thr_q_enqueue_prepared(&arq->thr_q, (void *) a, prep_enq);
+
+#if ERTS_USE_ASYNC_READY_ENQ_MTX
+ erts_mtx_unlock(&arq->x.data.enq_mtx);
+#endif
+
+#else /* ERTS_USE_ASYNC_READY_Q */
+
+ call_async_ready(a);
+ if (a->pdl)
+ driver_pdl_dec_refc(a->pdl);
+ erts_free(ERTS_ALC_T_ASYNC, (void *) a);
+
+#endif /* ERTS_USE_ASYNC_READY_Q */
+}
+
+
+static void
+async_wakeup(void *vtse)
+{
+ erts_tse_set((erts_tse_t *) vtse);
+}
+
+static erts_tse_t *async_thread_init(ErtsAsyncQ *aq)
+{
+ ErtsThrQInit_t qinit = ERTS_THR_Q_INIT_DEFAULT;
+ erts_tse_t *tse = erts_tse_fetch();
#ifdef ERTS_SMP
- {
- Port *p;
- p = erts_id2port_sflgs(a->port,
- NULL,
- 0,
- ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP);
- if (!p) {
- if (a->async_free)
- (*a->async_free)(a->async_data);
- }
- else {
- if (async_ready(p, a->async_data)) {
- if (a->async_free)
- (*a->async_free)(a->async_data);
- }
- async_detach(a->hndl);
- erts_port_release(p);
- }
- if (a->pdl) {
- driver_pdl_dec_refc(a->pdl);
- }
- erts_free(ERTS_ALC_T_ASYNC, (void *) a);
- }
-#else
- if (a->pdl) {
- driver_pdl_dec_refc(a->pdl);
- }
- erts_mtx_lock(&async_ready_mtx);
- a->next = async_ready_list;
- async_ready_list = a;
- erts_mtx_unlock(&async_ready_mtx);
- sys_async_ready(q->hndl);
+ ErtsThrPrgrCallbacks callbacks;
+
+ callbacks.arg = (void *) tse;
+ callbacks.wakeup = async_wakeup;
+ callbacks.prepare_wait = NULL;
+ callbacks.wait = NULL;
+
+ erts_thr_progress_register_unmanaged_thread(&callbacks);
#endif
- }
- }
- return NULL;
+ qinit.live.queue = ERTS_THR_Q_LIVE_LONG;
+ qinit.live.objects = ERTS_THR_Q_LIVE_SHORT;
+ qinit.arg = (void *) tse;
+ qinit.notify = async_wakeup;
+#if ERTS_USE_ASYNC_READY_Q
+ qinit.auto_finalize_dequeue = 0;
+#endif
+
+ erts_thr_q_initialize(&aq->thr_q, &qinit);
+
+ /* Inform main thread that we are done initializing... */
+ erts_mtx_lock(&async->init.data.mtx);
+ async->init.data.no_initialized++;
+ erts_cnd_signal(&async->init.data.cnd);
+ erts_mtx_unlock(&async->init.data.mtx);
+
+ return tse;
}
+static void *async_main(void* arg)
+{
+ ErtsAsyncQ *aq = (ErtsAsyncQ *) arg;
+ erts_tse_t *tse = async_thread_init(aq);
+
+ while (1) {
+ ErtsThrQPrepEnQ_t *prep_enq;
+ ErtsAsync *a = async_get(&aq->thr_q, tse, &prep_enq);
+ if (is_nil(a->port))
+ break; /* Time to die */
+#if ERTS_ASYNC_PRINT_JOB
+ erts_fprintf(stderr, "<- %ld\n", a->async_id);
#endif
-#ifndef ERTS_SMP
+ a->async_invoke(a->async_data);
+
+ async_reply(a, prep_enq);
+ }
+
+ return NULL;
+}
+
+#endif /* USE_THREADS */
-int check_async_ready(void)
+void
+erts_exit_flush_async(void)
{
#ifdef USE_THREADS
- ErtsAsyncReadyCallback *cbs;
+ int i;
+ ErtsAsync a;
+ a.port = NIL;
+ /*
+ * Terminate threads in order to flush queues. We do not
+ * bother to clean everything up since we are about to
+ * terminate the runtime system and a cleanup would only
+ * delay the termination.
+ */
+ for (i = 0; i < erts_async_max_threads; i++)
+ async_add(&a, async_q(i));
+ for (i = 0; i < erts_async_max_threads; i++)
+ erts_thr_join(async->queue[i].aq.thr_id, NULL);
#endif
- ErlAsync* a;
- int count = 0;
+}
- erts_mtx_lock(&async_ready_mtx);
- a = async_ready_list;
- async_ready_list = NULL;
-#ifdef USE_THREADS
- cbs = callbacks;
-#endif
- erts_mtx_unlock(&async_ready_mtx);
-
- while(a != NULL) {
- ErlAsync* a_next = a->next;
- /* Every port not dead */
- Port *p = erts_id2port_sflgs(a->port,
- NULL,
- 0,
- ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP);
- if (!p) {
- if (a->async_free)
- (*a->async_free)(a->async_data);
- }
- else {
- count++;
- if (async_ready(p, a->async_data)) {
- if (a->async_free != NULL)
- (*a->async_free)(a->async_data);
- }
- async_detach(a->hndl);
- erts_port_release(p);
+#if defined(USE_THREADS) && ERTS_USE_ASYNC_READY_Q
+
+int erts_check_async_ready(void *varq)
+{
+ ErtsAsyncReadyQ *arq = (ErtsAsyncReadyQ *) varq;
+ int res = 1;
+ int i;
+
+ for (i = 0; i < ERTS_MAX_ASYNC_READY_CALLS_IN_SEQ; i++) {
+ ErtsAsync *a = (ErtsAsync *) erts_thr_q_dequeue(&arq->thr_q);
+ if (!a) {
+ res = 0;
+ break;
}
+
+#if ERTS_ASYNC_PRINT_JOB
+ erts_fprintf(stderr, "<<= %ld\n", a->async_id);
+#endif
+ erts_thr_q_append_finalize_dequeue_data(&arq->fin_deq, &a->q.fin_deq);
+ call_async_ready(a);
erts_free(ERTS_ALC_T_ASYNC, (void *) a);
- a = a_next;
}
-#ifdef USE_THREADS
- for (; cbs; cbs = cbs->next)
- (*cbs->callback)();
-#endif
- return count;
+
+ erts_thr_q_finalize_dequeue(&arq->fin_deq);
+
+ return res;
}
+int erts_async_ready_clean(void *varq, void *val)
+{
+ ErtsAsyncReadyQ *arq = (ErtsAsyncReadyQ *) varq;
+ ErtsThrQCleanState_t cstate;
+
+ cstate = erts_thr_q_clean(&arq->thr_q);
+
+ if (erts_thr_q_finalize_dequeue(&arq->fin_deq))
+ return ERTS_ASYNC_READY_DIRTY;
+
+ switch (cstate) {
+ case ERTS_THR_Q_DIRTY:
+ return ERTS_ASYNC_READY_DIRTY;
+#ifdef ERTS_SMP
+ case ERTS_THR_Q_NEED_THR_PRGR:
+ *((ErtsThrPrgrVal *) val)
+ = erts_thr_q_need_thr_progress(&arq->thr_q);
+ return ERTS_ASYNC_READY_NEED_THR_PRGR;
#endif
+ case ERTS_THR_Q_CLEAN:
+ break;
+ }
+ return ERTS_ASYNC_READY_CLEAN;
+}
+#endif
/*
** Schedule async_invoke on a worker thread
@@ -393,19 +554,29 @@ long driver_async(ErlDrvPort ix, unsigned int* key,
void (*async_invoke)(void*), void* async_data,
void (*async_free)(void*))
{
- ErlAsync* a = (ErlAsync*) erts_alloc(ERTS_ALC_T_ASYNC, sizeof(ErlAsync));
- Port* prt = erts_drvport2port(ix);
+ ErtsAsync* a;
+ Port* prt;
long id;
unsigned int qix;
+#if ERTS_USE_ASYNC_READY_Q
+ Uint sched_id;
+ sched_id = erts_get_scheduler_id();
+ if (!sched_id)
+ sched_id = 1;
+#endif
+ prt = erts_drvport2port(ix);
if (!prt)
return -1;
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
- a->next = NULL;
- a->prev = NULL;
+ a = (ErtsAsync*) erts_alloc(ERTS_ALC_T_ASYNC, sizeof(ErtsAsync));
+
+#if ERTS_USE_ASYNC_READY_Q
+ a->sched_id = sched_id;
+#endif
a->hndl = (DE_Handle*)prt->drv_ptr->handle;
a->port = prt->id;
a->pdl = NULL;
@@ -413,12 +584,16 @@ long driver_async(ErlDrvPort ix, unsigned int* key,
a->async_invoke = async_invoke;
a->async_free = async_free;
- erts_smp_spin_lock(&async_id_lock);
- async_id = (async_id + 1) & 0x7fffffff;
- if (async_id == 0)
- async_id++;
- id = async_id;
- erts_smp_spin_unlock(&async_id_lock);
+ if (!async)
+ id = 0;
+ else {
+ do {
+ id = erts_atomic_inc_read_nob(&async->init.data.id);
+ } while (id == 0);
+ if (id < 0)
+ id *= -1;
+ ASSERT(id > 0);
+ }
a->async_id = id;
@@ -437,7 +612,7 @@ long driver_async(ErlDrvPort ix, unsigned int* key,
driver_pdl_inc_refc(prt->port_data_lock);
a->pdl = prt->port_data_lock;
}
- async_add(a, &async_q[qix]);
+ async_add(a, async_q(qix));
return id;
}
#endif
@@ -455,10 +630,16 @@ long driver_async(ErlDrvPort ix, unsigned int* key,
int driver_async_cancel(unsigned int id)
{
-#ifdef USE_THREADS
- if (erts_async_max_threads > 0)
- return async_del(id);
-#endif
+ /*
+ * Not supported anymore. Always fail (which is backward
+ * compatible).
+ *
+ * This functionality could be implemented again. However,
+ * it is (and always has been) completely useless since
+ * it doesn't give you any guarantees whatsoever. The user
+ * needs to (and always have had to) synchronize in his/her
+ * own code in order to get any guarantees.
+ */
return 0;
}
diff --git a/erts/emulator/beam/erl_async.h b/erts/emulator/beam/erl_async.h
new file mode 100644
index 0000000000..95374a8fc9
--- /dev/null
+++ b/erts/emulator/beam/erl_async.h
@@ -0,0 +1,66 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2011. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#ifndef ERL_ASYNC_H__
+#define ERL_ASYNC_H__
+
+#define ERTS_MAX_NO_OF_ASYNC_THREADS 1024
+extern int erts_async_max_threads;
+#define ERTS_ASYNC_THREAD_MIN_STACK_SIZE 16 /* Kilo words */
+#define ERTS_ASYNC_THREAD_MAX_STACK_SIZE 8192 /* Kilo words */
+extern int erts_async_thread_suggested_stack_size;
+
+#ifdef USE_THREADS
+
+#ifdef ERTS_SMP
+/*
+ * With smp support we can choose to have, or not to
+ * have an async ready queue.
+ */
+#define ERTS_USE_ASYNC_READY_Q 1
+#endif
+
+#ifndef ERTS_SMP
+/* In non-smp case we *need* the async ready queue */
+# undef ERTS_USE_ASYNC_READY_Q
+# define ERTS_USE_ASYNC_READY_Q 1
+#endif
+
+#ifndef ERTS_USE_ASYNC_READY_Q
+# define ERTS_USE_ASYNC_READY_Q 0
+#endif
+
+#if ERTS_USE_ASYNC_READY_Q
+int erts_check_async_ready(void *);
+int erts_async_ready_clean(void *, void *);
+void *erts_get_async_ready_queue(Uint sched_id);
+#define ERTS_ASYNC_READY_CLEAN 0
+#define ERTS_ASYNC_READY_DIRTY 1
+#ifdef ERTS_SMP
+#define ERTS_ASYNC_READY_NEED_THR_PRGR 2
+#endif
+#endif /* ERTS_USE_ASYNC_READY_Q */
+
+#endif /* USE_THREADS */
+
+void erts_init_async(void);
+void erts_exit_flush_async(void);
+
+
+#endif /* ERL_ASYNC_H__ */
diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c
index f2199d41a1..c50fdeb4e8 100644
--- a/erts/emulator/beam/erl_bestfit_alloc.c
+++ b/erts/emulator/beam/erl_bestfit_alloc.c
@@ -161,14 +161,18 @@ erts_bfalc_start(BFAllctr_t *bfallctr,
BFAllctrInit_t *bfinit,
AllctrInit_t *init)
{
- BFAllctr_t nulled_state = {{0}};
- /* {{0}} is used instead of {0}, in order to avoid (an incorrect) gcc
- warning. gcc warns if {0} is used as initializer of a struct when
- the first member is a struct (not if, for example, the third member
- is a struct). */
+ struct {
+ int dummy;
+ BFAllctr_t allctr;
+ } zero = {0};
+ /* The struct with a dummy element first is used in order to avoid (an
+ incorrect) gcc warning. gcc warns if {0} is used as initializer of
+ a struct when the first member is a struct (not if, for example,
+ the third member is a struct). */
+
Allctr_t *allctr = (Allctr_t *) bfallctr;
- sys_memcpy((void *) bfallctr, (void *) &nulled_state, sizeof(BFAllctr_t));
+ sys_memcpy((void *) bfallctr, (void *) &zero.allctr, sizeof(BFAllctr_t));
bfallctr->address_order = bfinit->ao;
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 8a9e6cca08..a79feaebdb 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -39,6 +39,8 @@
#include "dist.h"
#include "erl_gc.h"
#include "erl_cpu_topology.h"
+#include "erl_async.h"
+#include "erl_thr_progress.h"
#ifdef HIPE
#include "hipe_arch.h"
#endif
@@ -52,6 +54,9 @@
#include <valgrind/memcheck.h>
#endif
+static Export* alloc_info_trap = NULL;
+static Export* alloc_sizes_trap = NULL;
+
#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
/* Keep erts_system_version as a global variable for easy access from a core */
@@ -1734,9 +1739,19 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */
sel = *tp++;
- if (sel == am_allocator_sizes && arity == 2) {
- return erts_allocator_info_term(BIF_P, *tp, 1);
- } else if (sel == am_wordsize && arity == 2) {
+ if (sel == am_allocator_sizes) {
+ switch (arity) {
+ case 2:
+ ERTS_BIF_PREP_TRAP1(ret, alloc_sizes_trap, BIF_P, *tp);
+ return ret;
+ case 3:
+ if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 1))
+ return am_true;
+ default:
+ goto badarg;
+ }
+ }
+ else if (sel == am_wordsize && arity == 2) {
if (tp[0] == am_internal) {
return make_small(sizeof(Eterm));
}
@@ -1783,8 +1798,17 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */
}
else
goto badarg;
- } else if (sel == am_allocator && arity == 2) {
- return erts_allocator_info_term(BIF_P, *tp, 0);
+ } else if (sel == am_allocator) {
+ switch (arity) {
+ case 2:
+ ERTS_BIF_PREP_TRAP1(ret, alloc_info_trap, BIF_P, *tp);
+ return ret;
+ case 3:
+ if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 0))
+ return am_true;
+ default:
+ goto badarg;
+ }
} else if (ERTS_IS_ATOM_STR("internal_cpu_topology", sel) && arity == 2) {
return erts_get_cpu_topology_term(BIF_P, *tp);
} else if (ERTS_IS_ATOM_STR("cpu_topology", sel) && arity == 2) {
@@ -2166,7 +2190,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
/* Need to be the only thread running... */
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
if (BIF_ARG_1 == am_info)
info(ERTS_PRINT_DSBUF, (void *) dsbufp);
@@ -2177,7 +2201,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
else
distribution_info(ERTS_PRINT_DSBUF, (void *) dsbufp);
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
ASSERT(dsbufp && dsbufp->str);
@@ -2189,7 +2213,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
i = 0;
/* Need to be the only thread running... */
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
for (dep = erts_visible_dist_entries; dep; dep = dep->next)
++i;
for (dep = erts_hidden_dist_entries; dep; dep = dep->next)
@@ -2212,7 +2236,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
res = CONS(hp, tpl, res);
hp += 2;
}
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(res);
} else if (BIF_ARG_1 == am_system_version) {
@@ -2629,8 +2653,12 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
res = erts_bld_uint(&hp, NULL, erts_dist_buf_busy_limit);
BIF_RET(res);
} else if (ERTS_IS_ATOM_STR("print_ethread_info", BIF_ARG_1)) {
+#if defined(ETHR_NATIVE_ATOMIC32_IMPL) \
+ || defined(ETHR_NATIVE_ATOMIC64_IMPL) \
+ || defined(ETHR_NATIVE_DW_ATOMIC_IMPL)
int i;
char **str;
+#endif
#ifdef ETHR_NATIVE_ATOMIC32_IMPL
erts_printf("32-bit native atomics: %s\n",
ETHR_NATIVE_ATOMIC32_IMPL);
@@ -2693,6 +2721,12 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
#endif
BIF_RET(am_true);
}
+#ifdef ERTS_SMP
+ else if (ERTS_IS_ATOM_STR("thread_progress", BIF_ARG_1)) {
+ erts_thr_progress_dbg_print_state();
+ BIF_RET(am_true);
+ }
+#endif
BIF_ERROR(BIF_P, BADARG);
}
@@ -3261,26 +3295,6 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
-BIF_RETTYPE memory_0(BIF_ALIST_0)
-{
- BIF_RETTYPE res = erts_memory(NULL, NULL, BIF_P, THE_NON_VALUE);
- switch (res) {
- case am_badarg: BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); /* never... */
- case am_notsup: BIF_ERROR(BIF_P, EXC_NOTSUP);
- default: BIF_RET(res);
- }
-}
-
-BIF_RETTYPE memory_1(BIF_ALIST_1)
-{
- BIF_RETTYPE res = erts_memory(NULL, NULL, BIF_P, BIF_ARG_1);
- switch (res) {
- case am_badarg: BIF_ERROR(BIF_P, BADARG);
- case am_notsup: BIF_ERROR(BIF_P, EXC_NOTSUP);
- default: BIF_RET(res);
- }
-}
-
BIF_RETTYPE error_logger_warning_map_0(BIF_ALIST_0)
{
BIF_RET(erts_error_logger_warnings);
@@ -3382,6 +3396,15 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
BIF_RET(am_false);
#endif
}
+ else if (ERTS_IS_ATOM_STR("memory", BIF_ARG_1)) {
+ Eterm res;
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_smp_thr_progress_block();
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ res = erts_memory(NULL, NULL, BIF_P, THE_NON_VALUE);
+ erts_smp_thr_progress_unblock();
+ BIF_RET(res);
+ }
}
else if (is_tuple(BIF_ARG_1)) {
Eterm* tp = tuple_val(BIF_ARG_1);
@@ -3584,6 +3607,7 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
static erts_smp_atomic_t hipe_test_reschedule_flag;
+
BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
{
/*
@@ -3634,10 +3658,10 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
if (ms > 0) {
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
if (block)
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
while (erts_milli_sleep((long) ms) != 0);
if (block)
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
}
BIF_RET(am_true);
@@ -3847,16 +3871,23 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
}
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
old_use_opt = !erts_disable_proc_not_running_opt;
erts_disable_proc_not_running_opt = !use_opt;
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(old_use_opt ? am_true : am_false);
#else
BIF_ERROR(BIF_P, EXC_NOTSUP);
#endif
}
+ else if (ERTS_IS_ATOM_STR("wait", BIF_ARG_1)) {
+ if (ERTS_IS_ATOM_STR("deallocations", BIF_ARG_2)) {
+ if (erts_debug_wait_deallocations(BIF_P)) {
+ ERTS_BIF_YIELD_RETURN(BIF_P, am_ok);
+ }
+ }
+ }
}
BIF_ERROR(BIF_P, BADARG);
@@ -4015,7 +4046,7 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1)
Eterm* hp;
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
erts_lcnt_set_rt_opt(ERTS_LCNT_OPT_SUSPEND);
data = erts_lcnt_get_data();
@@ -4033,17 +4064,17 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1)
erts_lcnt_clear_rt_opt(ERTS_LCNT_OPT_SUSPEND);
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(res);
} else if (BIF_ARG_1 == am_clear) {
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
erts_lcnt_clear_counters();
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(am_ok);
@@ -4054,7 +4085,7 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1)
case 2:
if (ERTS_IS_ATOM_STR("copy_save", tp[1])) {
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
if (tp[2] == am_true) {
res = erts_lcnt_set_rt_opt(ERTS_LCNT_OPT_COPYSAVE) ? am_true : am_false;
@@ -4064,17 +4095,17 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1)
res = erts_lcnt_clear_rt_opt(ERTS_LCNT_OPT_COPYSAVE) ? am_true : am_false;
} else {
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_ERROR(BIF_P, BADARG);
}
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(res);
} else if (ERTS_IS_ATOM_STR("process_locks", tp[1])) {
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
if (tp[2] == am_true) {
res = erts_lcnt_set_rt_opt(ERTS_LCNT_OPT_PROCLOCK) ? am_true : am_false;
@@ -4084,11 +4115,11 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1)
res = erts_lcnt_set_rt_opt(ERTS_LCNT_OPT_PROCLOCK) ? am_true : am_false;
} else {
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_ERROR(BIF_P, BADARG);
}
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
BIF_RET(res);
}
@@ -4130,6 +4161,8 @@ erts_bif_info_init(void)
erts_smp_atomic_init_nob(&available_internal_state, 0);
erts_smp_atomic_init_nob(&hipe_test_reschedule_flag, 0);
+ alloc_info_trap = erts_export_put(am_erlang, am_alloc_info, 1);
+ alloc_sizes_trap = erts_export_put(am_erlang, am_alloc_sizes, 1);
process_info_init();
os_info_init();
}
diff --git a/erts/emulator/beam/erl_bif_timer.c b/erts/emulator/beam/erl_bif_timer.c
index db771bd216..a922a33da3 100644
--- a/erts/emulator/beam/erl_bif_timer.c
+++ b/erts/emulator/beam/erl_bif_timer.c
@@ -26,6 +26,7 @@
#include "bif.h"
#include "error.h"
#include "big.h"
+#include "erl_thr_progress.h"
/****************************************************************************
** BIF Timer support
@@ -686,7 +687,7 @@ erts_bif_timer_foreach(void (*func)(Eterm, Eterm, ErlHeapFragment *, void *),
{
int i;
- ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
for (i = 0; i < TIMER_HASH_VEC_SZ; i++) {
ErtsBifTimer *btm;
diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c
index af49345410..b0a58c80ea 100644
--- a/erts/emulator/beam/erl_bif_trace.c
+++ b/erts/emulator/beam/erl_bif_trace.c
@@ -37,6 +37,7 @@
#include "erl_version.h"
#include "beam_bp.h"
#include "erl_binary.h"
+#include "erl_thr_progress.h"
#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
@@ -108,7 +109,7 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
Eterm meta_tracer_pid = p->id;
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
UseTmpHeap(3,p);
/*
@@ -337,7 +338,7 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
done:
UnUseTmpHeap(3,p);
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
return make_small(matches);
@@ -347,7 +348,7 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
MatchSetUnref(match_prog_set);
UnUseTmpHeap(3,p);
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
BIF_ERROR(p, BADARG);
}
@@ -644,7 +645,7 @@ Eterm trace_3(BIF_ALIST_3)
#ifdef ERTS_SMP
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
system_blocked = 1;
#endif
@@ -725,7 +726,7 @@ Eterm trace_3(BIF_ALIST_3)
#ifdef ERTS_SMP
if (system_blocked) {
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
}
#endif
@@ -740,7 +741,7 @@ Eterm trace_3(BIF_ALIST_3)
#ifdef ERTS_SMP
if (system_blocked) {
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
}
#endif
@@ -1076,7 +1077,7 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key)
#ifdef ERTS_SMP
if ( (key == am_call_time) || (key == am_all)) {
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
}
#endif
@@ -1084,7 +1085,7 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key)
#ifdef ERTS_SMP
if ( (key == am_call_time) || (key == am_all)) {
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
}
#endif
@@ -1870,7 +1871,7 @@ void erts_system_monitor_clear(Process *c_p) {
#ifdef ERTS_SMP
if (c_p) {
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
}
#endif
erts_set_system_monitor(NIL);
@@ -1880,7 +1881,7 @@ void erts_system_monitor_clear(Process *c_p) {
erts_system_monitor_flags.busy_dist_port = 0;
#ifdef ERTS_SMP
if (c_p) {
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
}
#endif
@@ -1981,7 +1982,7 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list)
system_blocked = 1;
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
if (!erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, monitor_pid, 0))
goto error;
@@ -2015,7 +2016,7 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list)
erts_system_monitor_flags.busy_port = !!busy_port;
erts_system_monitor_flags.busy_dist_port = !!busy_dist_port;
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
BIF_RET(prev);
}
@@ -2023,7 +2024,7 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list)
error:
if (system_blocked) {
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
}
@@ -2036,7 +2037,7 @@ void erts_system_profile_clear(Process *c_p) {
#ifdef ERTS_SMP
if (c_p) {
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
}
#endif
erts_set_system_profile(NIL);
@@ -2046,7 +2047,7 @@ void erts_system_profile_clear(Process *c_p) {
erts_system_profile_flags.exclusive = 0;
#ifdef ERTS_SMP
if (c_p) {
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
}
#endif
@@ -2110,7 +2111,7 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2)
system_blocked = 1;
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
/* Check if valid process, no locks are taken */
@@ -2152,7 +2153,7 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2)
erts_system_profile_flags.runnable_procs = !!runnable_procs;
erts_system_profile_flags.exclusive = !!exclusive;
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
BIF_RET(prev);
@@ -2161,7 +2162,7 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2)
error:
if (system_blocked) {
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
}
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index d8b4294a30..0079c13287 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -280,8 +280,7 @@ static void schedule_free_dbtable(DbTable* tb)
ASSERT(scheds >= 1);
ASSERT(erts_refc_read(&tb->common.ref, 0) == 0);
erts_refc_init(&tb->common.ref, scheds);
- ERTS_THR_MEMORY_BARRIER;
- erts_smp_schedule_misc_aux_work(0, scheds, chk_free_dbtable, tb);
+ erts_schedule_multi_misc_aux_work(0, scheds, chk_free_dbtable, tb);
#else
free_dbtable(tb);
#endif
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index 35e53aaa0e..4821a7d9fb 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -35,6 +35,7 @@
#include "bif.h"
#include "big.h"
#include "erl_binary.h"
+#include "erl_thr_progress.h"
#include "erl_db_util.h"
@@ -1746,14 +1747,14 @@ Eterm db_prog_match(Process *c_p, Binary *bprog,
if (! atomic_trace) { \
erts_refc_inc(&bprog->refc, 2); \
erts_smp_proc_unlock((p), ERTS_PROC_LOCK_MAIN); \
- erts_smp_block_system(0); \
+ erts_smp_thr_progress_block(); \
atomic_trace = !0; \
} \
} while (0)
#define END_ATOMIC_TRACE(p) \
do { \
if (atomic_trace) { \
- erts_smp_release_system(); \
+ erts_smp_thr_progress_unblock(); \
erts_smp_proc_lock((p), ERTS_PROC_LOCK_MAIN); \
if (erts_refc_dectest(&bprog->refc, 0) == 0) {\
erts_bin_free(bprog); \
diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h
index 401967a8de..ae0c9def90 100644
--- a/erts/emulator/beam/erl_driver.h
+++ b/erts/emulator/beam/erl_driver.h
@@ -28,6 +28,14 @@
# include "config.h"
#endif
+#define ERL_DRV_DEPRECATED_FUNC
+#ifdef __GNUC__
+# if __GNUC__ >= 3
+# undef ERL_DRV_DEPRECATED_FUNC
+# define ERL_DRV_DEPRECATED_FUNC __attribute__((deprecated))
+# endif
+#endif
+
#ifdef SIZEOF_CHAR
# define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR
# undef SIZEOF_CHAR
@@ -582,8 +590,11 @@ EXTERN long driver_async(ErlDrvPort ix,
void* async_data,
void (*async_free)(void*));
-
-EXTERN int driver_async_cancel(unsigned int key);
+/*
+ * driver_async_cancel() is deprecated. It is scheduled for removal
+ * in OTP-R16. For more information see the erl_driver(3) documentation.
+ */
+EXTERN int driver_async_cancel(unsigned int key) ERL_DRV_DEPRECATED_FUNC;
/* Locks the driver in the machine "forever", there is
no unlock function. Note that this is almost never useful, as an open
diff --git a/erts/emulator/beam/erl_drv_thread.c b/erts/emulator/beam/erl_drv_thread.c
index dc578f6d2a..a49a155701 100644
--- a/erts/emulator/beam/erl_drv_thread.c
+++ b/erts/emulator/beam/erl_drv_thread.c
@@ -158,7 +158,9 @@ erl_drv_mutex_create(char *name)
(sizeof(ErlDrvMutex)
+ (name ? sys_strlen(name) + 1 : 0)));
if (dmtx) {
- if (ethr_mutex_init(&dmtx->mtx) != 0) {
+ ethr_mutex_opt opt = ETHR_MUTEX_OPT_DEFAULT_INITER;
+ opt.posix_compliant = 1;
+ if (ethr_mutex_init_opt(&dmtx->mtx, &opt) != 0) {
erts_free(ERTS_ALC_T_DRV_MTX, (void *) dmtx);
dmtx = NULL;
}
@@ -226,7 +228,9 @@ erl_drv_cond_create(char *name)
(sizeof(ErlDrvCond)
+ (name ? sys_strlen(name) + 1 : 0)));
if (dcnd) {
- if (ethr_cond_init(&dcnd->cnd) != 0) {
+ ethr_cond_opt opt = ETHR_COND_OPT_DEFAULT_INITER;
+ opt.posix_compliant = 1;
+ if (ethr_cond_init_opt(&dcnd->cnd, &opt) != 0) {
erts_free(ERTS_ALC_T_DRV_CND, (void *) dcnd);
dcnd = NULL;
}
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 36615f913d..c29352a227 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -362,8 +362,6 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
}
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
- erts_smp_locked_activity_begin(ERTS_ACTIVITY_GC);
-
ERTS_CHK_OFFHEAP(p);
ErtsGcQuickSanityCheck(p);
@@ -397,8 +395,6 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
trace_gc(p, am_gc_end);
}
- erts_smp_locked_activity_end(ERTS_ACTIVITY_GC);
-
if (erts_system_monitor_long_gc != 0) {
Uint ms2, s2, us2;
Sint t;
@@ -482,7 +478,6 @@ erts_garbage_collect_hibernate(Process* p)
p->gcstatus = p->status;
p->status = P_GARBING;
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
- erts_smp_locked_activity_begin(ERTS_ACTIVITY_GC);
ErtsGcQuickSanityCheck(p);
ASSERT(p->mbuf_sz == 0);
ASSERT(p->mbuf == 0);
@@ -596,7 +591,6 @@ erts_garbage_collect_hibernate(Process* p)
erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
p->status = p->gcstatus;
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
- erts_smp_locked_activity_end(ERTS_ACTIVITY_GC);
}
@@ -621,7 +615,6 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
p->gcstatus = p->status;
p->status = P_GARBING;
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
- erts_smp_locked_activity_begin(ERTS_ACTIVITY_GC);
/*
* We assume that the caller has already done a major collection
@@ -724,7 +717,6 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
p->status = p->gcstatus;
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
- erts_smp_locked_activity_end(ERTS_ACTIVITY_GC);
}
static int
diff --git a/erts/emulator/beam/erl_goodfit_alloc.c b/erts/emulator/beam/erl_goodfit_alloc.c
index 8322b233ac..e7d4ac2b67 100644
--- a/erts/emulator/beam/erl_goodfit_alloc.c
+++ b/erts/emulator/beam/erl_goodfit_alloc.c
@@ -190,16 +190,20 @@ erts_gfalc_start(GFAllctr_t *gfallctr,
GFAllctrInit_t *gfinit,
AllctrInit_t *init)
{
- GFAllctr_t nulled_state = {{0}};
- /* {{0}} is used instead of {0}, in order to avoid (an incorrect) gcc
- warning. gcc warns if {0} is used as initializer of a struct when
- the first member is a struct (not if, for example, the third member
- is a struct). */
+ struct {
+ int dummy;
+ GFAllctr_t allctr;
+ } zero = {0};
+ /* The struct with a dummy element first is used in order to avoid (an
+ incorrect) gcc warning. gcc warns if {0} is used as initializer of
+ a struct when the first member is a struct (not if, for example,
+ the third member is a struct). */
+
Allctr_t *allctr = (Allctr_t *) gfallctr;
- init->sbmbct = 0; /* Small mbc not yet supported by goodfit */
+ sys_memcpy((void *) gfallctr, (void *) &zero.allctr, sizeof(GFAllctr_t));
- sys_memcpy((void *) gfallctr, (void *) &nulled_state, sizeof(GFAllctr_t));
+ init->sbmbct = 0; /* Small mbc not yet supported by goodfit */
allctr->mbc_header_size = sizeof(Carrier_t);
allctr->min_mbc_size = MIN_MBC_SZ;
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index 8a297cded0..7c047891d9 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -42,6 +42,9 @@
#include "erl_misc_utils.h"
#include "packet_parser.h"
#include "erl_cpu_topology.h"
+#include "erl_thr_progress.h"
+#include "erl_thr_queue.h"
+#include "erl_async.h"
#ifdef HIPE
#include "hipe_mode_switch.h" /* for hipe_mode_switch_init() */
@@ -68,6 +71,8 @@ static void erl_init(int ncpu);
#define ERTS_MIN_COMPAT_REL 7
+static erts_atomic_t exiting;
+
#ifdef ERTS_SMP
erts_smp_atomic32_t erts_writing_erl_crash_dump;
erts_tsd_key_t erts_is_crash_dumping_key;
@@ -99,8 +104,6 @@ int erts_backtrace_depth; /* How many functions to show in a backtrace
* in error codes.
*/
-int erts_async_max_threads; /* number of threads for async support */
-int erts_async_thread_suggested_stack_size;
erts_smp_atomic32_t erts_max_gen_gcs;
Eterm erts_error_logger_warnings; /* What to map warning logs to, am_error,
@@ -247,10 +250,6 @@ erl_init(int ncpu)
{
init_benchmarking();
-#ifdef ERTS_SMP
- erts_system_block_init();
-#endif
-
erts_init_monitors();
erts_init_gc();
erts_init_time();
@@ -260,6 +259,8 @@ erl_init(int ncpu)
no_schedulers,
no_schedulers_online);
erts_init_cpu_topology(); /* Must be after init_scheduling */
+ erts_alloc_late_init();
+
H_MIN_SIZE = erts_next_heap_size(H_MIN_SIZE, 0);
BIN_VH_MIN_SIZE = erts_next_heap_size(BIN_VH_MIN_SIZE, 0);
@@ -281,6 +282,7 @@ erl_init(int ncpu)
erts_init_node_tables();
init_dist();
erl_drv_thr_init();
+ erts_init_async();
init_io();
init_copy();
init_load();
@@ -607,6 +609,8 @@ early_init(int *argc, char **argv) /*
int max_main_threads;
int max_reader_groups;
int reader_groups;
+ char envbuf[21]; /* enough for any 64-bit integer */
+ size_t envbufsz;
use_multi_run_queue = 1;
erts_printf_eterm_func = erts_printf_term;
@@ -644,6 +648,10 @@ early_init(int *argc, char **argv) /*
erts_use_r9_pids_ports = 0;
erts_sys_pre_init();
+ erts_atomic_init_nob(&exiting, 0);
+#ifdef ERTS_SMP
+ erts_thr_progress_pre_init();
+#endif
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_init();
@@ -675,6 +683,16 @@ early_init(int *argc, char **argv) /*
schdlrs = no_schedulers;
schdlrs_onln = no_schedulers_online;
+ envbufsz = sizeof(envbuf);
+
+ /* erts_sys_getenv() not initialized yet; need erts_sys_getenv__() */
+ if (erts_sys_getenv__("ERL_THREAD_POOL_SIZE", envbuf, &envbufsz) == 0)
+ erts_async_max_threads = atoi(envbuf);
+ else
+ erts_async_max_threads = 0;
+ if (erts_async_max_threads > ERTS_MAX_NO_OF_ASYNC_THREADS)
+ erts_async_max_threads = ERTS_MAX_NO_OF_ASYNC_THREADS;
+
if (argc && argv) {
int i = 1;
while (i < *argc) {
@@ -702,6 +720,20 @@ early_init(int *argc, char **argv) /*
}
break;
}
+ case 'A': {
+ /* set number of threads in thread pool */
+ char *arg = get_arg(argv[i]+2, argv[i+1], &i);
+ if (((erts_async_max_threads = atoi(arg)) < 0) ||
+ (erts_async_max_threads > ERTS_MAX_NO_OF_ASYNC_THREADS)) {
+ erts_fprintf(stderr,
+ "bad number of async threads %s\n",
+ arg);
+ erts_usage();
+ VERBOSE(DEBUG_SYSTEM, ("using %d async-threads\n",
+ erts_async_max_threads));
+ }
+ break;
+ }
case 'S' : {
int tot, onln;
char *arg = get_arg(argv[i]+2, argv[i+1], &i);
@@ -767,11 +799,29 @@ early_init(int *argc, char **argv) /*
erts_no_schedulers = (Uint) no_schedulers;
#endif
+ erts_early_init_scheduling(no_schedulers);
+ alloc_opts.ncpu = ncpu;
erts_alloc_init(argc, argv, &alloc_opts); /* Handles (and removes)
-M flags. */
/* Require allocators */
- erts_early_init_scheduling();
+#ifdef ERTS_SMP
+ /*
+ * Thread progress management:
+ *
+ * * Managed threads:
+ * ** Scheduler threads (see erl_process.c)
+ * ** Aux thread (see erl_process.c)
+ * ** Sys message dispatcher thread (see erl_trace.c)
+ *
+ * * Unmanaged threads that need to register:
+ * ** Async threads (see erl_async.c)
+ */
+ erts_thr_progress_init(no_schedulers,
+ no_schedulers+2,
+ erts_async_max_threads);
+#endif
+ erts_thr_q_init();
erts_init_utils();
erts_early_init_cpu_topology(no_schedulers,
&max_main_threads,
@@ -851,7 +901,6 @@ erl_start(int argc, char **argv)
int have_break_handler = 1;
char envbuf[21]; /* enough for any 64-bit integer */
size_t envbufsz;
- int async_max_threads = erts_async_max_threads;
int ncpu = early_init(&argc, argv);
envbufsz = sizeof(envbuf);
@@ -867,11 +916,6 @@ erl_start(int argc, char **argv)
(erts_aint32_t) max_gen_gcs);
}
- envbufsz = sizeof(envbuf);
- if (erts_sys_getenv("ERL_THREAD_POOL_SIZE", envbuf, &envbufsz) == 0) {
- async_max_threads = atoi(envbuf);
- }
-
#if (defined(__APPLE__) && defined(__MACH__)) || defined(__DARWIN__)
/*
* The default stack size on MacOS X is too small for pcre.
@@ -1301,17 +1345,8 @@ erl_start(int argc, char **argv)
break;
}
- case 'A':
- /* set number of threads in thread pool */
- arg = get_arg(argv[i]+2, argv[i+1], &i);
- if (((async_max_threads = atoi(arg)) < 0) ||
- (async_max_threads > ERTS_MAX_NO_OF_ASYNC_THREADS)) {
- erts_fprintf(stderr, "bad number of async threads %s\n", arg);
- erts_usage();
- }
-
- VERBOSE(DEBUG_SYSTEM, ("using %d async-threads\n",
- async_max_threads));
+ case 'A': /* Was handled in early init just read past it */
+ (void) get_arg(argv[i]+2, argv[i+1], &i);
break;
case 'a':
@@ -1400,10 +1435,6 @@ erl_start(int argc, char **argv)
i++;
}
-#ifdef USE_THREADS
- erts_async_max_threads = async_max_threads;
-#endif
-
/* Delayed check of +P flag */
if (erts_max_processes < ERTS_MIN_PROCESSES
|| erts_max_processes > ERTS_MAX_PROCESSES
@@ -1449,6 +1480,10 @@ erl_start(int argc, char **argv)
erts_sys_main_thread(); /* May or may not return! */
#else
erts_thr_set_main_status(1, 1);
+#if ERTS_USE_ASYNC_READY_Q
+ erts_get_scheduler_data()->aux_work_data.async_ready.queue
+ = erts_get_async_ready_queue(1);
+#endif
set_main_stack_size();
process_main();
#endif
@@ -1474,6 +1509,29 @@ __decl_noreturn void erts_thr_fatal_error(int err, char *what)
static void
system_cleanup(int exit_code)
{
+ /*
+ * Make sure only one thread exits the runtime system.
+ */
+ if (erts_atomic_inc_read_nob(&exiting) != 1) {
+ /*
+ * Another thread is currently exiting the system;
+ * wait for it to do its job.
+ */
+#ifdef ERTS_SMP
+ if (erts_thr_progress_is_managed_thread()) {
+ /*
+ * The exiting thread might be waiting for
+ * us to block; need to update status...
+ */
+ erts_thr_progress_active(NULL, 0);
+ erts_thr_progress_prepare_wait(NULL);
+ }
+#endif
+ /* Wait forever... */
+ while (1)
+ erts_milli_sleep(10000000);
+ }
+
/* No cleanup wanted if ...
* 1. we are about to do an abnormal exit
* 2. we haven't finished initializing, or
@@ -1493,7 +1551,6 @@ system_cleanup(int exit_code)
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_check_exact(NULL, 0);
#endif
- erts_smp_block_system(ERTS_BS_FLG_ALLOW_GC); /* We never release it... */
#endif
#ifdef HYBRID
@@ -1522,17 +1579,7 @@ system_cleanup(int exit_code)
erts_cleanup_incgc();
#endif
-#if defined(USE_THREADS)
- exit_async();
-#endif
-#if HAVE_ERTS_MSEG
- erts_mseg_exit();
-#endif
-
- /*
- * A lot more cleaning could/should have been done...
- */
-
+ erts_exit_flush_async();
}
/*
@@ -1549,10 +1596,10 @@ __decl_noreturn void erl_exit0(char *file, int line, int n, char *fmt,...)
va_start(args, fmt);
- save_statistics();
-
system_cleanup(n);
+ save_statistics();
+
an = abs(n);
if (erts_mtrace_enabled)
@@ -1589,10 +1636,10 @@ __decl_noreturn void erl_exit(int n, char *fmt,...)
va_start(args, fmt);
- save_statistics();
-
system_cleanup(n);
+ save_statistics();
+
an = abs(n);
if (erts_mtrace_enabled)
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index 587d82f2bb..44da6b6c51 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -110,10 +110,6 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "fun_tab", NULL },
{ "environ", NULL },
#endif
- { "asyncq", "address" },
-#ifndef ERTS_SMP
- { "async_ready", NULL },
-#endif
{ "efile_drv", "address" },
#if defined(ENABLE_CHILD_WAITER_THREAD) || defined(ERTS_SMP)
{ "child_status", NULL },
@@ -125,7 +121,7 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "drv_ev_state", "address" },
{ "safe_hash", "address" },
{ "pollset_rm_list", NULL },
- { "removed_fd_pre_alloc_lock", NULL },
+ { "removed_fd_pre_alloc_lock", "address" },
{ "state_prealloc", NULL },
{ "schdlr_sspnd", NULL },
{ "run_queue", "address" },
@@ -138,6 +134,7 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "alcu_init_atoms", NULL },
{ "mseg_init_atoms", NULL },
{ "drv_tsd", NULL },
+ { "async_enq_mtx", NULL },
#ifdef ERTS_SMP
{ "sys_msg_q", NULL },
{ "atom_tab", NULL },
@@ -151,10 +148,8 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "mtrace_op", NULL },
{ "instr_x", NULL },
{ "instr", NULL },
- { "fix_alloc", "index" },
{ "alcu_allocator", "index" },
{ "sbmbc_alloc", "index" },
- { "alcu_delayed_free", "index" },
{ "mseg", NULL },
#if HALFWORD_HEAP
{ "pmmap", NULL },
@@ -175,15 +170,12 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "timeofday", NULL },
{ "breakpoints", NULL },
{ "pollsets_lock", NULL },
- { "async_id", NULL },
{ "pix_lock", "address" },
{ "run_queues_lists", NULL },
- { "misc_aux_work_queue", "index" },
- { "misc_aux_work_pre_alloc_lock", "address" },
{ "sched_stat", NULL },
{ "run_queue_sleep_list", "address" },
#endif
- { "alloc_thr_ix_lock", NULL },
+ { "async_init_mtx", NULL },
#ifdef ERTS_SMP
{ "proc_lck_qs_alloc", NULL },
#endif
diff --git a/erts/emulator/beam/erl_mtrace.c b/erts/emulator/beam/erl_mtrace.c
index b1478758a1..358c67bf20 100644
--- a/erts/emulator/beam/erl_mtrace.c
+++ b/erts/emulator/beam/erl_mtrace.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -503,12 +503,6 @@ write_trace_header(char *nodename, char *pid, char *hostname)
case ERTS_ALC_A_SYSTEM:
PUT_UI16(tracep, ERTS_MTRACE_SEGMENT_ID);
break;
- case ERTS_ALC_A_FIXED_SIZE:
- if (erts_allctrs_info[ERTS_FIX_CORE_ALLOCATOR].enabled)
- PUT_UI16(tracep, ERTS_FIX_CORE_ALLOCATOR);
- else
- PUT_UI16(tracep, ERTS_ALC_A_SYSTEM);
- break;
default:
PUT_UI16(tracep, ERTS_MTRACE_SEGMENT_ID);
break;
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index 1302eff114..62798bb2c1 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -32,6 +32,7 @@
#include "error.h"
#include "big.h"
#include "beam_bp.h"
+#include "erl_thr_progress.h"
#include <limits.h>
#include <stddef.h> /* offsetof */
@@ -1204,7 +1205,7 @@ enif_open_resource_type(ErlNifEnv* env,
ErlNifResourceFlags op = flags;
Eterm module_am, name_am;
- ASSERT(erts_smp_is_system_blocked(0));
+ ASSERT(erts_smp_thr_progress_is_blocking());
ASSERT(module_str == NULL); /* for now... */
module_am = make_atom(env->mod_nif->mod->module);
name_am = enif_make_atom(env, name_str);
@@ -1498,7 +1499,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
/* Block system (is this the right place to do it?) */
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
/* Find calling module */
ASSERT(BIF_P->current != NULL);
@@ -1687,7 +1688,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
erts_sys_ddll_free_error(&errdesc);
}
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_free(ERTS_ALC_T_TMP, lib_name);
BIF_RET(ret);
@@ -1699,7 +1700,7 @@ erts_unload_nif(struct erl_module_nif* lib)
{
ErlNifResourceType* rt;
ErlNifResourceType* next;
- ASSERT(erts_smp_is_system_blocked(0));
+ ASSERT(erts_smp_thr_progress_is_blocking());
ASSERT(lib != NULL);
ASSERT(lib->mod != NULL);
for (rt = resource_type_list.next;
diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c
index af3873995e..908ba755ed 100644
--- a/erts/emulator/beam/erl_node_tables.c
+++ b/erts/emulator/beam/erl_node_tables.c
@@ -26,6 +26,7 @@
#include "dist.h"
#include "big.h"
#include "error.h"
+#include "erl_thr_progress.h"
Hash erts_dist_table;
Hash erts_node_table;
@@ -907,7 +908,7 @@ erts_get_node_and_dist_references(struct process *proc)
#endif
erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN);
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
/* No need to lock any thing since we are alone... */
if (references_atoms_need_init) {
@@ -951,7 +952,7 @@ erts_get_node_and_dist_references(struct process *proc)
delete_reference_table();
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN);
return res;
}
diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c
index 6aa5161b08..87b8e5131b 100644
--- a/erts/emulator/beam/erl_port_task.c
+++ b/erts/emulator/beam/erl_port_task.c
@@ -711,23 +711,6 @@ typedef struct {
int *resp;
} ErtsPortTaskExeBlockData;
-static void
-prepare_for_block(void *vd)
-{
- ErtsPortTaskExeBlockData *d = (ErtsPortTaskExeBlockData *) vd;
- erts_smp_runq_unlock(d->runq);
-}
-
-static void
-resume_after_block(void *vd)
-{
- ErtsPortTaskExeBlockData *d = (ErtsPortTaskExeBlockData *) vd;
- erts_smp_runq_lock(d->runq);
- if (d->resp)
- *d->resp = (erts_smp_atomic_read_nob(&erts_port_task_outstanding_io_tasks)
- != (erts_aint_t) 0);
-}
-
/*
* Run all scheduled tasks for the first port in run queue. If
* new tasks appear while running reschedule port (free task is
@@ -752,11 +735,6 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
- erts_smp_activity_begin(ERTS_ACTIVITY_IO,
- prepare_for_block,
- resume_after_block,
- (void *) &blk_data);
-
ERTS_PT_CHK_PORTQ(runq);
pp = pop_port(runq);
@@ -988,10 +966,6 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
done:
blk_data.resp = &res;
- erts_smp_activity_end(ERTS_ACTIVITY_IO,
- prepare_for_block,
- resume_after_block,
- (void *) &blk_data);
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 5ceb4ce9a8..a3c1c9577b 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -39,6 +39,9 @@
#include "erl_binary.h"
#include "beam_bp.h"
#include "erl_cpu_topology.h"
+#include "erl_thr_progress.h"
+#include "erl_thr_queue.h"
+#include "erl_async.h"
#define ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED (2000*CONTEXT_REDS)
#define ERTS_RUNQ_CALL_CHECK_BALANCE_REDS \
@@ -124,9 +127,10 @@ ErtsLcPSDLocks erts_psd_required_locks[ERTS_PSD_SIZE];
#endif
#ifdef ERTS_SMP
-
int erts_disable_proc_not_running_opt;
+static ErtsAuxWorkData *aux_thread_aux_work_data;
+
#define ERTS_SCHDLR_SSPND_CHNG_WAITER (((erts_aint32_t) 1) << 0)
#define ERTS_SCHDLR_SSPND_CHNG_MSB (((erts_aint32_t) 1) << 1)
#define ERTS_SCHDLR_SSPND_CHNG_ONLN (((erts_aint32_t) 1) << 2)
@@ -213,8 +217,6 @@ Uint erts_no_run_queues;
ErtsAlignedSchedulerData *erts_aligned_scheduler_data;
-#ifdef ERTS_SMP
-
typedef union {
ErtsSchedulerSleepInfo ssi;
char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsSchedulerSleepInfo))];
@@ -222,8 +224,6 @@ typedef union {
static ErtsAlignedSchedulerSleepInfo *aligned_sched_sleep_info;
-#endif
-
#ifndef BM_COUNTERS
static int processes_busy;
#endif
@@ -285,8 +285,9 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(proclist,
ERTS_ALC_T_PROC_LIST)
#define ERTS_SCHED_SLEEP_INFO_IX(IX) \
- (ASSERT_EXPR(0 <= (IX) && (IX) < erts_no_schedulers), \
- &aligned_sched_sleep_info[(IX)].ssi)
+ (ASSERT_EXPR(-1 <= ((int) (IX)) \
+ && ((int) (IX)) < ((int) erts_no_schedulers)), \
+ &aligned_sched_sleep_info[(IX)].ssi)
#define ERTS_FOREACH_RUNQ(RQVAR, DO) \
do { \
@@ -339,6 +340,66 @@ static void exec_misc_ops(ErtsRunQueue *);
static void print_function_from_pc(int to, void *to_arg, BeamInstr* x);
static int stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp,
int yreg);
+
+static void aux_work_timeout(void *unused);
+static void aux_work_timeout_early_init(int no_schedulers);
+static void aux_work_timeout_late_init(void);
+static void setup_aux_work_timer(void);
+
+#if defined(DEBUG) || 0
+#define ERTS_DBG_CHK_AUX_WORK_VAL(V) dbg_chk_aux_work_val((V))
+static void
+dbg_chk_aux_work_val(erts_aint32_t value)
+{
+ erts_aint32_t valid = 0;
+
+#ifdef ERTS_SSI_AUX_WORK_SET_TMO
+ valid |= ERTS_SSI_AUX_WORK_SET_TMO;
+#endif
+#ifdef ERTS_SSI_AUX_WORK_CHECK_CHILDREN
+ valid |= ERTS_SSI_AUX_WORK_CHECK_CHILDREN;
+#endif
+#ifdef ERTS_SSI_AUX_WORK_MISC
+ valid |= ERTS_SSI_AUX_WORK_MISC;
+#endif
+#ifdef ERTS_SSI_AUX_WORK_MISC_THR_PRGR
+ valid |= ERTS_SSI_AUX_WORK_MISC_THR_PRGR;
+#endif
+#ifdef ERTS_SSI_AUX_WORK_ASYNC_READY
+ valid |= ERTS_SSI_AUX_WORK_ASYNC_READY;
+#endif
+#ifdef ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN
+ valid |= ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN;
+#endif
+
+#ifdef ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM
+ valid |= ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM;
+#endif
+#ifdef ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC
+ valid |= ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC;
+#endif
+#ifdef ERTS_SSI_AUX_WORK_DD
+ valid |= ERTS_SSI_AUX_WORK_DD;
+#endif
+#ifdef ERTS_SSI_AUX_WORK_DD
+ valid |= ERTS_SSI_AUX_WORK_DD_THR_PRGR;
+#endif
+#ifdef ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK
+ valid |= ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK;
+#endif
+
+ if (~valid & value)
+ erl_exit(ERTS_ABORT_EXIT,
+ "Invalid aux_work value found: 0x%x\n",
+ ~valid & value);
+}
+#define ERTS_DBG_CHK_SSI_AUX_WORK(SSI) \
+ ERTS_DBG_CHK_AUX_WORK_VAL(erts_atomic32_read_nob(&(SSI)->aux_work))
+#else
+#define ERTS_DBG_CHK_AUX_WORK_VAL(V)
+#define ERTS_DBG_CHK_SSI_AUX_WORK(SSI)
+#endif
+
#ifdef ERTS_SMP
static void handle_pending_exiters(ErtsProcList *);
@@ -577,6 +638,13 @@ erts_sched_finish_poke(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flags)
case ERTS_SSI_FLG_POLL_SLEEPING:
erts_sys_schedule_interrupt(1);
break;
+ case ERTS_SSI_FLG_POLL_SLEEPING|ERTS_SSI_FLG_TSE_SLEEPING:
+ /*
+ * Thread progress blocking while poll sleeping; need
+ * to signal on both...
+ */
+ erts_sys_schedule_interrupt(1);
+ /* fall through */
case ERTS_SSI_FLG_TSE_SLEEPING:
erts_tse_set(ssi->event);
break;
@@ -589,189 +657,712 @@ erts_sched_finish_poke(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flags)
}
}
+#endif
+
+static ERTS_INLINE void
+set_aux_work_flags_wakeup_nob(ErtsSchedulerSleepInfo *ssi,
+ erts_aint32_t flgs)
+{
+ erts_aint32_t old_flgs;
+
+ ERTS_DBG_CHK_SSI_AUX_WORK(ssi);
+
+ old_flgs = erts_atomic32_read_nob(&ssi->aux_work);
+ if ((old_flgs & flgs) == 0) {
+
+ old_flgs = erts_atomic32_read_bor_nob(&ssi->aux_work, flgs);
+
+ if ((old_flgs & flgs) == 0) {
+#ifdef ERTS_SMP
+ erts_sched_poke(ssi);
+#else
+ erts_sys_schedule_interrupt(1);
+#endif
+ }
+ }
+}
+
+#if 0 /* Currently not used */
+
+static ERTS_INLINE void
+set_aux_work_flags_wakeup_relb(ErtsSchedulerSleepInfo *ssi,
+ erts_aint32_t flgs)
+{
+ erts_aint32_t old_flgs;
+
+ ERTS_DBG_CHK_SSI_AUX_WORK(ssi);
+
+ old_flgs = erts_atomic32_read_bor_relb(&ssi->aux_work, flgs);
+
+ if ((old_flgs & flgs) == 0) {
+#ifdef ERTS_SMP
+ erts_sched_poke(ssi);
+#else
+ erts_sys_schedule_interrupt(1);
+#endif
+ }
+}
+
+#endif
+
+static ERTS_INLINE erts_aint32_t
+set_aux_work_flags(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flgs)
+{
+ return erts_atomic32_read_bor_nob(&ssi->aux_work, flgs);
+}
+
+static ERTS_INLINE erts_aint32_t
+unset_aux_work_flags(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flgs)
+{
+ return erts_atomic32_read_band_nob(&ssi->aux_work, ~flgs);
+}
+
typedef struct erts_misc_aux_work_t_ erts_misc_aux_work_t;
struct erts_misc_aux_work_t_ {
- erts_misc_aux_work_t *next;
void (*func)(void *);
void *arg;
};
-typedef struct {
- erts_smp_mtx_t mtx;
- erts_misc_aux_work_t *first;
- erts_misc_aux_work_t *last;
-} erts_misc_aux_work_q_t;
+ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(misc_aux_work,
+ erts_misc_aux_work_t,
+ 200,
+ ERTS_ALC_T_MISC_AUX_WORK)
typedef union {
- erts_misc_aux_work_q_t data;
- char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_misc_aux_work_q_t))];
+ ErtsThrQ_t q;
+ char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsThrQ_t))];
} erts_algnd_misc_aux_work_q_t;
static erts_algnd_misc_aux_work_q_t *misc_aux_work_queues;
-ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(misc_aux_work,
- erts_misc_aux_work_t,
- 200,
- ERTS_ALC_T_MISC_AUX_WORK)
+static void
+notify_aux_work(void *vssi)
+{
+ set_aux_work_flags_wakeup_nob((ErtsSchedulerSleepInfo *) vssi,
+ ERTS_SSI_AUX_WORK_MISC);
+}
static void
init_misc_aux_work(void)
{
int ix;
+ ErtsThrQInit_t qinit = ERTS_THR_Q_INIT_DEFAULT;
+ qinit.notify = notify_aux_work;
init_misc_aux_work_alloc();
misc_aux_work_queues =
erts_alloc_permanent_cache_aligned(ERTS_ALC_T_MISC_AUX_WORK_Q,
- erts_no_schedulers *
- sizeof(erts_algnd_misc_aux_work_q_t));
+ sizeof(erts_algnd_misc_aux_work_q_t)
+ * (erts_no_schedulers+1));
+
+#ifdef ERTS_SMP
+ ix = 0; /* aux_thread + schedulers */
+#else
+ ix = 1; /* scheduler only */
+#endif
- for (ix = 0; ix < erts_no_schedulers; ix++) {
- erts_smp_mtx_init_x(&misc_aux_work_queues[ix].data.mtx,
- "misc_aux_work_queue",
- make_small(ix + 1));
- misc_aux_work_queues[ix].data.first = NULL;
- misc_aux_work_queues[ix].data.last = NULL;
+ for (; ix <= erts_no_schedulers; ix++) {
+ qinit.arg = (void *) ERTS_SCHED_SLEEP_INFO_IX(ix-1);
+ erts_thr_q_initialize(&misc_aux_work_queues[ix].q, &qinit);
}
}
-static void
-handle_misc_aux_work(ErtsSchedulerData *esdp)
-{
- int ix = (int) esdp->no - 1;
- erts_misc_aux_work_t *mawp;
+static erts_aint32_t
+misc_aux_work_clean(ErtsThrQ_t *q,
+ ErtsAuxWorkData *awdp,
+ erts_aint32_t aux_work)
+{
+ switch (erts_thr_q_clean(q)) {
+ case ERTS_THR_Q_DIRTY:
+ set_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MISC);
+ return aux_work | ERTS_SSI_AUX_WORK_MISC;
+#ifdef ERTS_SMP
+ case ERTS_THR_Q_NEED_THR_PRGR:
+ set_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MISC_THR_PRGR);
+ erts_thr_progress_wakeup(awdp->esdp,
+ erts_thr_q_need_thr_progress(q));
+#endif
+ case ERTS_THR_Q_CLEAN:
+ break;
+ }
+ return aux_work;
+}
- erts_smp_mtx_lock(&misc_aux_work_queues[ix].data.mtx);
- mawp = misc_aux_work_queues[ix].data.first;
- misc_aux_work_queues[ix].data.first = NULL;
- misc_aux_work_queues[ix].data.last = NULL;
- erts_smp_mtx_unlock(&misc_aux_work_queues[ix].data.mtx);
+static erts_aint32_t
+handle_misc_aux_work(ErtsAuxWorkData *awdp,
+ erts_aint32_t aux_work)
+{
+ ErtsThrQ_t *q = &misc_aux_work_queues[awdp->sched_id].q;
- while (mawp) {
- erts_misc_aux_work_t *free_mawp;
+ unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MISC);
+ while (1) {
+ erts_misc_aux_work_t *mawp = erts_thr_q_dequeue(q);
+ if (!mawp)
+ break;
mawp->func(mawp->arg);
- free_mawp = mawp;
- mawp = mawp->next;
- misc_aux_work_free(free_mawp);
+ misc_aux_work_free(mawp);
}
+
+ return misc_aux_work_clean(q, awdp, aux_work & ~ERTS_SSI_AUX_WORK_MISC);
+}
+
+#ifdef ERTS_SMP
+
+static erts_aint32_t
+handle_misc_aux_work_thr_prgr(ErtsAuxWorkData *awdp,
+ erts_aint32_t aux_work)
+{
+ if (!erts_thr_progress_has_reached(awdp->misc.thr_prgr))
+ return aux_work;
+
+ unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MISC_THR_PRGR);
+
+ return misc_aux_work_clean(&misc_aux_work_queues[awdp->sched_id].q,
+ awdp,
+ aux_work & ~ERTS_SSI_AUX_WORK_MISC_THR_PRGR);
+}
+
+#endif
+
+static ERTS_INLINE void
+schedule_misc_aux_work(int sched_id,
+ void (*func)(void *),
+ void *arg)
+{
+ ErtsThrQ_t *q;
+ erts_misc_aux_work_t *mawp;
+
+#ifdef ERTS_SMP
+ ASSERT(0 <= sched_id && sched_id <= erts_no_schedulers);
+#else
+ ASSERT(sched_id == 1);
+#endif
+
+ q = &misc_aux_work_queues[sched_id].q;
+ mawp = misc_aux_work_alloc();
+ mawp->func = func;
+ mawp->arg = arg;
+ erts_thr_q_enqueue(q, mawp);
+}
+
+void
+erts_schedule_misc_aux_work(int sched_id,
+ void (*func)(void *),
+ void *arg)
+{
+ schedule_misc_aux_work(sched_id, func, arg);
}
void
-erts_smp_schedule_misc_aux_work(int ignore_self,
- int max_sched,
- void (*func)(void *),
- void *arg)
+erts_schedule_multi_misc_aux_work(int ignore_self,
+ int max_sched,
+ void (*func)(void *),
+ void *arg)
{
- int ix, ignore_ix = -1;
+ int id, self = 0;
if (ignore_self) {
ErtsSchedulerData *esdp = erts_get_scheduler_data();
if (esdp)
- ignore_ix = (int) esdp->no - 1;
+ self = (int) esdp->no;
}
- ASSERT(0 <= max_sched && max_sched <= erts_no_schedulers);
+ ASSERT(0 < max_sched && max_sched <= erts_no_schedulers);
- for (ix = 0; ix < max_sched; ix++) {
- erts_aint32_t aux_work;
- erts_misc_aux_work_t *mawp;
- ErtsSchedulerSleepInfo *ssi;
- if (ix == ignore_ix)
+ for (id = 1; id <= max_sched; id++) {
+ if (id == self)
continue;
+ schedule_misc_aux_work(id, func, arg);
+ }
+}
- mawp = misc_aux_work_alloc();
+#if ERTS_USE_ASYNC_READY_Q
- mawp->func = func;
- mawp->arg = arg;
- mawp->next = NULL;
+void
+erts_notify_check_async_ready_queue(void *vno)
+{
+ int ix = ((int) (SWord) vno) -1;
+ set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(ix),
+ ERTS_SSI_AUX_WORK_ASYNC_READY);
+}
- erts_smp_mtx_lock(&misc_aux_work_queues[ix].data.mtx);
- if (!misc_aux_work_queues[ix].data.last)
- misc_aux_work_queues[ix].data.first = mawp;
- else
- misc_aux_work_queues[ix].data.last->next = mawp;
- misc_aux_work_queues[ix].data.last = mawp;
- erts_smp_mtx_unlock(&misc_aux_work_queues[ix].data.mtx);
-
- ssi = ERTS_SCHED_SLEEP_INFO_IX(ix);
- aux_work = erts_smp_atomic32_read_bor_nob(&ssi->aux_work,
- ERTS_SSI_AUX_WORK_MISC);
- if ((aux_work & ERTS_SSI_AUX_WORK_MISC) == 0)
- erts_sched_poke(ssi);
- }
+static erts_aint32_t
+handle_async_ready(ErtsAuxWorkData *awdp,
+ erts_aint32_t aux_work)
+{
+ ErtsSchedulerSleepInfo *ssi = awdp->ssi;
+ unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY);
+ if (erts_check_async_ready(awdp->async_ready.queue)) {
+ if (set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY)
+ & ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN) {
+ unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN);
+ aux_work &= ~ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN;
+ }
+ return aux_work;
+ }
+#ifdef ERTS_SMP
+ awdp->async_ready.need_thr_prgr = 0;
+#endif
+ set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN);
+ return ((aux_work & ~ERTS_SSI_AUX_WORK_ASYNC_READY)
+ | ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN);
}
+static erts_aint32_t
+handle_async_ready_clean(ErtsAuxWorkData *awdp,
+ erts_aint32_t aux_work)
+{
+ void *thr_prgr_p;
+
+#ifdef ERTS_SMP
+ if (awdp->async_ready.need_thr_prgr
+ && !erts_thr_progress_has_reached(awdp->misc.thr_prgr)) {
+ return aux_work & ~ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN;
+ }
+
+ awdp->async_ready.need_thr_prgr = 0;
+ thr_prgr_p = (void *) &awdp->async_ready.thr_prgr;
+#else
+ thr_prgr_p = NULL;
+#endif
+
+ switch (erts_async_ready_clean(awdp->async_ready.queue, thr_prgr_p)) {
+ case ERTS_ASYNC_READY_CLEAN:
+ unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN);
+ return aux_work & ~ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN;
+#ifdef ERTS_SMP
+ case ERTS_ASYNC_READY_NEED_THR_PRGR:
+ erts_thr_progress_wakeup(awdp->esdp,
+ awdp->async_ready.thr_prgr);
+ awdp->async_ready.need_thr_prgr = 1;
+#endif
+ default:
+ return aux_work;
+ }
+}
+
+#endif
+
+static erts_aint32_t
+handle_fix_alloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work)
+{
+ ErtsSchedulerSleepInfo *ssi = awdp->ssi;
+ erts_aint32_t res;
+
+ unset_aux_work_flags(ssi, (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM
+ | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC));
+ aux_work &= ~(ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM
+ | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC);
+ res = erts_alloc_fix_alloc_shrink(awdp->sched_id, aux_work);
+ if (res) {
+ set_aux_work_flags(ssi, res);
+ aux_work |= res;
+ }
+
+ return aux_work;
+}
+
+#ifdef ERTS_SMP
+
+void
+erts_alloc_notify_delayed_dealloc(int ix)
+{
+ set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(ix-1),
+ ERTS_SSI_AUX_WORK_DD);
+}
+
+static erts_aint32_t
+handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work)
+{
+ ErtsSchedulerSleepInfo *ssi = awdp->ssi;
+ int need_thr_progress = 0;
+ int more_work = 0;
+
+ unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD);
+ erts_alloc_scheduler_handle_delayed_dealloc((void *) awdp->esdp,
+ &need_thr_progress,
+ &more_work);
+ if (more_work) {
+ if (set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD)
+ & ERTS_SSI_AUX_WORK_DD_THR_PRGR) {
+ unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD_THR_PRGR);
+ aux_work &= ~ERTS_SSI_AUX_WORK_DD_THR_PRGR;
+ }
+ return aux_work;
+ }
+
+ if (need_thr_progress) {
+ set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD_THR_PRGR);
+ awdp->dd.thr_prgr = erts_thr_progress_later();
+ erts_thr_progress_wakeup(awdp->esdp, awdp->dd.thr_prgr);
+ }
+ else if (awdp->dd.completed_callback) {
+ awdp->dd.completed_callback(awdp->dd.completed_arg);
+ awdp->dd.completed_callback = NULL;
+ awdp->dd.completed_arg = NULL;
+ }
+ return aux_work & ~ERTS_SSI_AUX_WORK_DD;
+}
+
+static erts_aint32_t
+handle_delayed_dealloc_thr_prgr(ErtsAuxWorkData *awdp, erts_aint32_t aux_work)
+{
+ ErtsSchedulerSleepInfo *ssi;
+ int need_thr_progress;
+ int more_work;
+
+ if (!erts_thr_progress_has_reached(awdp->dd.thr_prgr))
+ return aux_work & ~ERTS_SSI_AUX_WORK_DD_THR_PRGR;
+
+ ssi = awdp->ssi;
+ need_thr_progress = 0;
+ more_work = 0;
+
+ erts_alloc_scheduler_handle_delayed_dealloc((void *) awdp->esdp,
+ &need_thr_progress,
+ &more_work);
+ if (more_work) {
+ set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD);
+ unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD_THR_PRGR);
+ return ((aux_work & ~ERTS_SSI_AUX_WORK_DD_THR_PRGR)
+ | ERTS_SSI_AUX_WORK_DD);
+ }
+
+ if (need_thr_progress) {
+ awdp->dd.thr_prgr = erts_thr_progress_later();
+ erts_thr_progress_wakeup(awdp->esdp, awdp->dd.thr_prgr);
+ }
+ else {
+ unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD_THR_PRGR);
+ if (awdp->dd.completed_callback) {
+ awdp->dd.completed_callback(awdp->dd.completed_arg);
+ awdp->dd.completed_callback = NULL;
+ awdp->dd.completed_arg = NULL;
+ }
+ }
+
+ return aux_work & ~ERTS_SSI_AUX_WORK_DD_THR_PRGR;
+}
+
+static erts_atomic32_t completed_dealloc_count;
+
+static void
+completed_dealloc(void *vproc)
+{
+ if (erts_atomic32_dec_read_mb(&completed_dealloc_count) == 0) {
+ erts_resume((Process *) vproc, (ErtsProcLocks) 0);
+ erts_smp_proc_dec_refc((Process *) vproc);
+ }
+}
+
+static void
+setup_completed_dealloc(void *vproc)
+{
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ ErtsAuxWorkData *awdp = (esdp
+ ? &esdp->aux_work_data
+ : aux_thread_aux_work_data);
+ erts_alloc_fix_alloc_shrink(awdp->sched_id, 0);
+ set_aux_work_flags_wakeup_nob(awdp->ssi, ERTS_SSI_AUX_WORK_DD);
+ awdp->dd.completed_callback = completed_dealloc;
+ awdp->dd.completed_arg = vproc;
+}
+
+static void
+prep_setup_completed_dealloc(void *vproc)
+{
+ erts_aint32_t count = (erts_aint32_t) (erts_no_schedulers+1);
+ if (erts_atomic32_dec_read_mb(&completed_dealloc_count) == count) {
+ /* scheduler threads */
+ erts_schedule_multi_misc_aux_work(0,
+ erts_no_schedulers,
+ setup_completed_dealloc,
+ vproc);
+ /* aux_thread */
+ erts_schedule_misc_aux_work(0,
+ setup_completed_dealloc,
+ vproc);
+ }
+}
+
+#endif /* ERTS_SMP */
+
+int
+erts_debug_wait_deallocations(Process *c_p)
+{
+#ifndef ERTS_SMP
+ erts_alloc_fix_alloc_shrink(1, 0);
+ return 1;
+#else
+ /* Only one process at a time can do this */
+ erts_aint32_t count = (erts_aint32_t) (2*(erts_no_schedulers+1));
+ if (0 == erts_atomic32_cmpxchg_mb(&completed_dealloc_count,
+ count,
+ 0)) {
+ erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL);
+ erts_smp_proc_inc_refc(c_p);
+ /* scheduler threads */
+ erts_schedule_multi_misc_aux_work(0,
+ erts_no_schedulers,
+ prep_setup_completed_dealloc,
+ (void *) c_p);
+ /* aux_thread */
+ erts_schedule_misc_aux_work(0,
+ prep_setup_completed_dealloc,
+ (void *) c_p);
+ return 1;
+ }
+ return 0;
+#endif
+}
+
+
#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN
void
erts_smp_notify_check_children_needed(void)
{
int i;
+ for (i = 0; i < erts_no_schedulers; i++)
+ set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(i),
+ ERTS_SSI_AUX_WORK_CHECK_CHILDREN);
+}
- for (i = 0; i < erts_no_schedulers; i++) {
- erts_aint32_t aux_work;
- ErtsSchedulerSleepInfo *ssi;
- ssi = ERTS_SCHED_SLEEP_INFO_IX(i);
- aux_work = erts_smp_atomic32_read_bor_nob(&ssi->aux_work,
- ERTS_SSI_AUX_WORK_CHECK_CHILDREN);
- if (!(aux_work & ERTS_SSI_AUX_WORK_CHECK_CHILDREN))
- erts_sched_poke(ssi);
- }
+static erts_aint32_t
+handle_check_children(ErtsAuxWorkData *awdp, erts_aint32_t aux_work)
+{
+ unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_CHECK_CHILDREN);
+ erts_check_children();
+ return aux_work & ~ERTS_SSI_AUX_WORK_CHECK_CHILDREN;
+}
+
+#endif
+
+#ifdef ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK
+
+static erts_aint32_t
+handle_mseg_cache_check(ErtsAuxWorkData *awdp, erts_aint32_t aux_work)
+{
+ unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK);
+ erts_mseg_cache_check();
+ return aux_work & ~ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK;
}
+
#endif
-#ifdef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK
+static erts_aint32_t
+handle_setup_aux_work_timer(ErtsAuxWorkData *awdp, erts_aint32_t aux_work)
+{
+ unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_SET_TMO);
+ setup_aux_work_timer();
+ return aux_work & ~ERTS_SSI_AUX_WORK_SET_TMO;
+}
+
static ERTS_INLINE erts_aint32_t
-blockable_aux_work(ErtsSchedulerData *esdp,
- ErtsSchedulerSleepInfo *ssi,
- erts_aint32_t aux_work)
+handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t aux_work)
{
- if (aux_work & ERTS_SSI_BLOCKABLE_AUX_WORK_MASK) {
- if (aux_work & ERTS_SSI_AUX_WORK_MISC) {
- aux_work = erts_smp_atomic32_read_band_nob(&ssi->aux_work,
- ~ERTS_SSI_AUX_WORK_MISC);
- aux_work &= ~ERTS_SSI_AUX_WORK_MISC;
- handle_misc_aux_work(esdp);
- }
+ /*
+ * Handlers are *only* allowed to modify flags in return value
+ * and ssi flags that are explicity handled by the handler.
+ * Handlers are, e.g., not allowed to read the ssi flag field and
+ * then unconditionally return that value.
+ */
+ ERTS_DBG_CHK_AUX_WORK_VAL(aux_work);
+ if (aux_work & ERTS_SSI_AUX_WORK_SET_TMO) {
+ aux_work = handle_setup_aux_work_timer(awdp, aux_work);
+ ERTS_DBG_CHK_AUX_WORK_VAL(aux_work);
+ }
+#ifdef ERTS_SMP
+ if (aux_work & ERTS_SSI_AUX_WORK_MISC_THR_PRGR) {
+ aux_work = handle_misc_aux_work_thr_prgr(awdp, aux_work);
+ ERTS_DBG_CHK_AUX_WORK_VAL(aux_work);
+ }
+#endif
+ if (aux_work & ERTS_SSI_AUX_WORK_MISC) {
+ aux_work = handle_misc_aux_work(awdp, aux_work);
+ ERTS_DBG_CHK_AUX_WORK_VAL(aux_work);
+ }
+#if ERTS_USE_ASYNC_READY_Q
+ if (aux_work & ERTS_SSI_AUX_WORK_ASYNC_READY) {
+ aux_work = handle_async_ready(awdp, aux_work);
+ ERTS_DBG_CHK_AUX_WORK_VAL(aux_work);
+ }
+ if (aux_work & ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN) {
+ aux_work = handle_async_ready_clean(awdp, aux_work);
+ ERTS_DBG_CHK_AUX_WORK_VAL(aux_work);
+ }
+#endif
#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN
- if (aux_work & ERTS_SSI_AUX_WORK_CHECK_CHILDREN) {
- aux_work = erts_smp_atomic32_band_nob(&ssi->aux_work,
- ~ERTS_SSI_AUX_WORK_CHECK_CHILDREN);
- aux_work &= ~ERTS_SSI_AUX_WORK_CHECK_CHILDREN;
- erts_check_children();
- }
+ if (aux_work & ERTS_SSI_AUX_WORK_CHECK_CHILDREN) {
+ aux_work = handle_check_children(awdp, aux_work);
+ ERTS_DBG_CHK_AUX_WORK_VAL(aux_work);
+ }
+#endif
+ if (aux_work & (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM
+ | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC)) {
+ aux_work = handle_fix_alloc(awdp, aux_work);
+ ERTS_DBG_CHK_AUX_WORK_VAL(aux_work);
+ }
+#ifdef ERTS_SMP
+ if (aux_work & ERTS_SSI_AUX_WORK_DD) {
+ aux_work = handle_delayed_dealloc(awdp, aux_work);
+ ERTS_DBG_CHK_AUX_WORK_VAL(aux_work);
+ }
+ if (aux_work & ERTS_SSI_AUX_WORK_DD_THR_PRGR) {
+ aux_work = handle_delayed_dealloc_thr_prgr(awdp, aux_work);
+ ERTS_DBG_CHK_AUX_WORK_VAL(aux_work);
+ }
#endif
+#ifdef ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK
+ if (aux_work & ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK) {
+ aux_work = handle_mseg_cache_check(awdp, aux_work);
+ ERTS_DBG_CHK_AUX_WORK_VAL(aux_work);
}
+#endif
+ ERTS_DBG_CHK_AUX_WORK_VAL(aux_work);
return aux_work;
}
-#endif
+typedef struct {
+ union {
+ ErlTimer data;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErlTimer))];
+ } timer;
-#ifdef ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK
-static ERTS_INLINE erts_aint32_t
-nonblockable_aux_work(ErtsSchedulerData *esdp,
- ErtsSchedulerSleepInfo *ssi,
- erts_aint32_t aux_work)
+ int initialized;
+ erts_atomic32_t refc;
+ erts_atomic32_t type[1];
+} ErtsAuxWorkTmo;
+
+static ErtsAuxWorkTmo *aux_work_tmo;
+
+static void
+aux_work_timeout_early_init(int no_schedulers)
{
- if (aux_work & ERTS_SSI_NONBLOCKABLE_AUX_WORK_MASK) {
+ int i;
+ UWord p;
+
+ /*
+ * This is done really early. Our own allocators have
+ * not been started yet.
+ */
+
+ p = (UWord) malloc((sizeof(ErtsAuxWorkTmo)
+ + sizeof(erts_atomic32_t)*(no_schedulers+1))
+ + ERTS_CACHE_LINE_SIZE-1);
+ if (p & ERTS_CACHE_LINE_MASK)
+ p = (p & ~ERTS_CACHE_LINE_MASK) + ERTS_CACHE_LINE_SIZE;
+ ASSERT((p & ERTS_CACHE_LINE_MASK) == 0);
+
+ aux_work_tmo = (ErtsAuxWorkTmo *) p;
+ aux_work_tmo->initialized = 0;
+ erts_atomic32_init_nob(&aux_work_tmo->refc, 0);
+ for (i = 0; i <= no_schedulers; i++)
+ erts_atomic32_init_nob(&aux_work_tmo->type[i], 0);
+}
+void
+aux_work_timeout_late_init(void)
+{
+ aux_work_tmo->initialized = 1;
+ if (erts_atomic32_read_nob(&aux_work_tmo->refc)) {
+ aux_work_tmo->timer.data.active = 0;
+ erts_set_timer(&aux_work_tmo->timer.data,
+ aux_work_timeout,
+ NULL,
+ NULL,
+ 1000);
}
}
-#endif
static void
-prepare_for_block(void *vrq)
+aux_work_timeout(void *unused)
{
- erts_smp_runq_unlock((ErtsRunQueue *) vrq);
+ erts_aint32_t refc;
+ int i;
+#ifdef ERTS_SMP
+ i = 0;
+#else
+ i = 1;
+#endif
+
+ for (; i <= erts_no_schedulers; i++) {
+ erts_aint32_t type;
+ type = erts_atomic32_read_acqb(&aux_work_tmo->type[i]);
+ if (type)
+ set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(i-1),
+ type);
+ }
+
+ refc = erts_atomic32_read_nob(&aux_work_tmo->refc);
+ ASSERT(refc >= 1);
+ if (refc != 1
+ || 1 != erts_atomic32_cmpxchg_relb(&aux_work_tmo->refc, 0, 1)) {
+ /* Setup next timeout... */
+ aux_work_tmo->timer.data.active = 0;
+ erts_set_timer(&aux_work_tmo->timer.data,
+ aux_work_timeout,
+ NULL,
+ NULL,
+ 1000);
+ }
}
static void
-resume_after_block(void *vrq)
+setup_aux_work_timer(void)
{
- erts_smp_runq_lock((ErtsRunQueue *) vrq);
+#ifndef ERTS_SMP
+ if (!erts_get_scheduler_data())
+ set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(0),
+ ERTS_SSI_AUX_WORK_SET_TMO);
+ else
+#endif
+ {
+ aux_work_tmo->timer.data.active = 0;
+ erts_set_timer(&aux_work_tmo->timer.data,
+ aux_work_timeout,
+ NULL,
+ NULL,
+ 1000);
+ }
}
+erts_aint32_t
+erts_set_aux_work_timeout(int ix, erts_aint32_t type, int enable)
+{
+ erts_aint32_t old, refc;
+
+#ifndef ERTS_SMP
+ ix = 1;
#endif
+ ERTS_DBG_CHK_AUX_WORK_VAL(type);
+ ERTS_DBG_CHK_AUX_WORK_VAL(erts_atomic32_read_nob(&aux_work_tmo->type[ix]));
+// erts_fprintf(stderr, "t(%d, 0x%x, %d)\n", ix, type, enable);
+
+ if (!enable) {
+ old = erts_atomic32_read_band_mb(&aux_work_tmo->type[ix], ~type);
+ ERTS_DBG_CHK_AUX_WORK_VAL(erts_atomic32_read_nob(&aux_work_tmo->type[ix]));
+ if (old != 0 && (old & ~type) == 0)
+ erts_atomic32_dec_relb(&aux_work_tmo->refc);
+ return old;
+ }
+
+ old = erts_atomic32_read_bor_mb(&aux_work_tmo->type[ix], type);
+ ERTS_DBG_CHK_AUX_WORK_VAL(erts_atomic32_read_nob(&aux_work_tmo->type[ix]));
+ if (old == 0 && type != 0) {
+ refc = erts_atomic32_inc_read_acqb(&aux_work_tmo->refc);
+ if (refc == 1) {
+ erts_atomic32_inc_acqb(&aux_work_tmo->refc);
+ if (aux_work_tmo->initialized)
+ setup_aux_work_timer();
+ }
+ }
+ return old;
+}
+
+
+
static ERTS_INLINE void
sched_waiting_sys(Uint no, ErtsRunQueue *rq)
{
@@ -800,8 +1391,6 @@ sched_active_sys(Uint no, ErtsRunQueue *rq)
Uint
erts_active_schedulers(void)
{
- /* RRRRRRRRR */
-
Uint as = erts_no_schedulers;
ERTS_ATOMIC_FOREACH_RUNQ(rq, as -= abs(rq->waiting));
@@ -988,6 +1577,10 @@ sched_set_sleeptype(ErtsSchedulerSleepInfo *ssi, erts_aint32_t sleep_type)
if (sleep_type == ERTS_SSI_FLG_TSE_SLEEPING)
erts_tse_reset(ssi->event);
+ else {
+ ASSERT(sleep_type == ERTS_SSI_FLG_POLL_SLEEPING);
+ erts_sys_schedule_interrupt(0);
+ }
while (1) {
oflgs = erts_smp_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs);
@@ -1006,16 +1599,127 @@ sched_set_sleeptype(ErtsSchedulerSleepInfo *ssi, erts_aint32_t sleep_type)
(((FLGS) & (ERTS_SSI_FLG_WAITING|ERTS_SSI_FLG_SUSPENDED)) \
!= ERTS_SSI_FLG_WAITING)
+
+static void
+thr_prgr_wakeup(void *vssi)
+{
+ erts_sched_poke((ErtsSchedulerSleepInfo *) vssi);
+}
+
+static void
+thr_prgr_prep_wait(void *vssi)
+{
+ ErtsSchedulerSleepInfo *ssi = (ErtsSchedulerSleepInfo *) vssi;
+ erts_smp_atomic32_read_bor_acqb(&ssi->flags,
+ ERTS_SSI_FLG_SLEEPING);
+}
+
+static void
+thr_prgr_wait(void *vssi)
+{
+ ErtsSchedulerSleepInfo *ssi = (ErtsSchedulerSleepInfo *) vssi;
+ erts_aint32_t xflgs = ERTS_SSI_FLG_SLEEPING;
+
+ erts_tse_reset(ssi->event);
+
+ while (1) {
+ erts_aint32_t aflgs, nflgs;
+ nflgs = xflgs | ERTS_SSI_FLG_TSE_SLEEPING;
+ aflgs = erts_smp_atomic32_cmpxchg_acqb(&ssi->flags, nflgs, xflgs);
+ if (aflgs == xflgs) {
+ erts_tse_wait(ssi->event);
+ break;
+ }
+ if ((aflgs & ERTS_SSI_FLG_SLEEPING) == 0)
+ break;
+ xflgs = aflgs;
+ }
+}
+
+static void
+thr_prgr_fin_wait(void *vssi)
+{
+ ErtsSchedulerSleepInfo *ssi = (ErtsSchedulerSleepInfo *) vssi;
+ erts_smp_atomic32_read_band_nob(&ssi->flags,
+ ~(ERTS_SSI_FLG_SLEEPING
+ | ERTS_SSI_FLG_TSE_SLEEPING));
+}
+
+static void init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp);
+
+static void *
+aux_thread(void *unused)
+{
+ ErtsAuxWorkData *awdp = aux_thread_aux_work_data;
+ ErtsSchedulerSleepInfo *ssi = ERTS_SCHED_SLEEP_INFO_IX(-1);
+ erts_aint32_t aux_work;
+ ErtsThrPrgrCallbacks callbacks;
+ int thr_prgr_active = 1;
+
+ ssi->event = erts_tse_fetch();
+
+ callbacks.arg = (void *) ssi;
+ callbacks.wakeup = thr_prgr_wakeup;
+ callbacks.prepare_wait = thr_prgr_prep_wait;
+ callbacks.wait = thr_prgr_wait;
+ callbacks.finalize_wait = thr_prgr_fin_wait;
+
+ erts_thr_progress_register_managed_thread(NULL, &callbacks, 1);
+ init_aux_work_data(awdp, NULL);
+ awdp->ssi = ssi;
+
+ sched_prep_spin_wait(ssi);
+
+ while (1) {
+ erts_aint32_t flgs;
+
+ aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
+ if (aux_work) {
+ if (!thr_prgr_active)
+ erts_thr_progress_active(NULL, thr_prgr_active = 1);
+ aux_work = handle_aux_work(awdp, aux_work);
+ if (aux_work && erts_thr_progress_update(NULL))
+ erts_thr_progress_leader_update(NULL);
+ }
+
+ if (!aux_work) {
+ if (thr_prgr_active)
+ erts_thr_progress_active(NULL, thr_prgr_active = 0);
+ erts_thr_progress_prepare_wait(NULL);
+
+ flgs = sched_spin_wait(ssi, 0);
+
+ if (flgs & ERTS_SSI_FLG_SLEEPING) {
+ ASSERT(flgs & ERTS_SSI_FLG_WAITING);
+ flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_TSE_SLEEPING);
+ if (flgs & ERTS_SSI_FLG_SLEEPING) {
+ int res;
+ ASSERT(flgs & ERTS_SSI_FLG_TSE_SLEEPING);
+ ASSERT(flgs & ERTS_SSI_FLG_WAITING);
+ do {
+ res = erts_tse_wait(ssi->event);
+ } while (res == EINTR);
+ }
+ }
+ erts_thr_progress_finalize_wait(NULL);
+ }
+
+ flgs = sched_prep_spin_wait(ssi);
+ }
+ return NULL;
+}
+
+#endif /* ERTS_SMP */
+
static void
scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
{
ErtsSchedulerSleepInfo *ssi = esdp->ssi;
int spincount;
+ erts_aint32_t aux_work = 0;
+#ifdef ERTS_SMP
+ int thr_prgr_active = 1;
erts_aint32_t flgs;
-#if defined(ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK) \
- || defined(ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK)
- erts_aint32_t aux_work;
-#endif
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
@@ -1049,34 +1753,38 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
tse_wait:
-#ifdef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK
- aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work);
- tse_blockable_aux_work:
- aux_work = blockable_aux_work(esdp, ssi, aux_work);
-#endif
- erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL);
-
while (1) {
-#ifdef ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK
-#ifndef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK
- aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work);
-#endif
- nonblockable_aux_work(esdp, ssi, aux_work);
-#endif
+ aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
+ if (aux_work) {
+ if (!thr_prgr_active)
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
+ aux_work = handle_aux_work(&esdp->aux_work_data, aux_work);
+ if (aux_work && erts_thr_progress_update(esdp))
+ erts_thr_progress_leader_update(esdp);
+ }
- flgs = sched_spin_wait(ssi, spincount);
- if (flgs & ERTS_SSI_FLG_SLEEPING) {
- ASSERT(flgs & ERTS_SSI_FLG_WAITING);
- flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_TSE_SLEEPING);
+ if (aux_work)
+ flgs = erts_smp_atomic32_read_acqb(&ssi->flags);
+ else {
+ if (thr_prgr_active)
+ erts_thr_progress_active(esdp, thr_prgr_active = 0);
+ erts_thr_progress_prepare_wait(esdp);
+
+ flgs = sched_spin_wait(ssi, spincount);
if (flgs & ERTS_SSI_FLG_SLEEPING) {
- int res;
- ASSERT(flgs & ERTS_SSI_FLG_TSE_SLEEPING);
ASSERT(flgs & ERTS_SSI_FLG_WAITING);
- do {
- res = erts_tse_wait(ssi->event);
- } while (res == EINTR);
+ flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_TSE_SLEEPING);
+ if (flgs & ERTS_SSI_FLG_SLEEPING) {
+ int res;
+ ASSERT(flgs & ERTS_SSI_FLG_TSE_SLEEPING);
+ ASSERT(flgs & ERTS_SSI_FLG_WAITING);
+ do {
+ res = erts_tse_wait(ssi->event);
+ } while (res == EINTR);
+ }
}
+ erts_thr_progress_finalize_wait(esdp);
}
if (!(flgs & ERTS_SSI_FLG_WAITING)) {
@@ -1092,26 +1800,21 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
break;
}
-#ifdef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK
- aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work);
- if (aux_work & ERTS_SSI_BLOCKABLE_AUX_WORK_MASK) {
- erts_smp_activity_end(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL);
- goto tse_blockable_aux_work;
- }
-#endif
-
}
- erts_smp_activity_end(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL);
-
if (flgs & ~ERTS_SSI_FLG_SUSPENDED)
erts_smp_atomic32_read_band_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED);
+ if (!thr_prgr_active)
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
+
erts_smp_runq_lock(rq);
sched_active(esdp->no, rq);
}
- else {
+ else
+#endif
+ {
erts_aint_t dt;
erts_smp_atomic32_set_relb(&function_calls, 0);
@@ -1135,18 +1838,27 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
if (dt) erts_bump_timer(dt);
sys_aux_work:
-
-#ifdef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK
- aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work);
- aux_work = blockable_aux_work(esdp, ssi, aux_work);
+#ifndef ERTS_SMP
+ erts_sys_schedule_interrupt(0);
#endif
-#ifdef ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK
-#ifndef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK
- aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work);
+
+ aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
+ if (aux_work) {
+#ifdef ERTS_SMP
+ if (!thr_prgr_active)
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
#endif
- nonblockable_aux_work(esdp, ssi, aux_work);
+ aux_work = handle_aux_work(&esdp->aux_work_data, aux_work);
+#ifdef ERTS_SMP
+ if (aux_work && erts_thr_progress_update(esdp))
+ erts_thr_progress_leader_update(esdp);
#endif
+ }
+#ifndef ERTS_SMP
+ if (rq->len != 0 || rq->misc.start)
+ goto sys_woken;
+#else
flgs = erts_smp_atomic32_read_acqb(&ssi->flags);
if (!(flgs & ERTS_SSI_FLG_WAITING)) {
ASSERT(!(flgs & ERTS_SSI_FLG_SLEEPING));
@@ -1168,10 +1880,12 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
goto tse_wait;
}
}
+#endif
}
erts_smp_runq_lock(rq);
+#ifdef ERTS_SMP
/*
* If we got new I/O tasks we aren't allowed to
* sleep in erl_sys_schedule().
@@ -1183,64 +1897,88 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
* Got to check that we still got I/O tasks; otherwise
* we have to wait in erl_sys_schedule() after all...
*/
- if (prepare_for_sys_schedule())
- goto do_sys_schedule;
-
- /*
- * Not allowed to wait in erl_sys_schedule;
- * do tse wait instead...
- */
- sched_change_waiting_sys_to_waiting(esdp->no, rq);
+ if (!prepare_for_sys_schedule()) {
+ /*
+ * Not allowed to wait in erl_sys_schedule;
+ * do tse wait instead...
+ */
+ sched_change_waiting_sys_to_waiting(esdp->no, rq);
+ erts_smp_runq_unlock(rq);
+ spincount = 0;
+ goto tse_wait;
+ }
+ }
+#endif
+ if (aux_work) {
erts_smp_runq_unlock(rq);
- spincount = 0;
- goto tse_wait;
+ goto sys_poll_aux_work;
}
- else {
- do_sys_schedule:
- erts_sys_schedule_interrupt(0);
- flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_POLL_SLEEPING);
- if (!(flgs & ERTS_SSI_FLG_SLEEPING)) {
- if (!(flgs & ERTS_SSI_FLG_WAITING))
- goto sys_locked_woken;
- erts_smp_runq_unlock(rq);
- flgs = sched_prep_cont_spin_wait(ssi);
- if (!(flgs & ERTS_SSI_FLG_WAITING)) {
- ASSERT(!(flgs & ERTS_SSI_FLG_SLEEPING));
- goto sys_woken;
- }
- ASSERT(!erts_port_task_have_outstanding_io_tasks());
- goto sys_poll_aux_work;
+#ifdef ERTS_SMP
+ flgs = sched_set_sleeptype(ssi, ERTS_SSI_FLG_POLL_SLEEPING);
+ if (!(flgs & ERTS_SSI_FLG_SLEEPING)) {
+ if (!(flgs & ERTS_SSI_FLG_WAITING)) {
+ ASSERT(!(flgs & ERTS_SSI_FLG_SLEEPING));
+ goto sys_locked_woken;
+ }
+ erts_smp_runq_unlock(rq);
+ flgs = sched_prep_cont_spin_wait(ssi);
+ if (!(flgs & ERTS_SSI_FLG_WAITING)) {
+ ASSERT(!(flgs & ERTS_SSI_FLG_SLEEPING));
+ goto sys_woken;
}
+ ASSERT(!erts_port_task_have_outstanding_io_tasks());
+ goto sys_poll_aux_work;
+ }
- ASSERT(flgs & ERTS_SSI_FLG_POLL_SLEEPING);
- ASSERT(flgs & ERTS_SSI_FLG_WAITING);
+ ASSERT(flgs & ERTS_SSI_FLG_POLL_SLEEPING);
+ ASSERT(flgs & ERTS_SSI_FLG_WAITING);
+#endif
- erts_smp_runq_unlock(rq);
+ erts_smp_runq_unlock(rq);
- ASSERT(!erts_port_task_have_outstanding_io_tasks());
+#ifdef ERTS_SMP
+ if (thr_prgr_active)
+ erts_thr_progress_active(esdp, thr_prgr_active = 0);
+#endif
- erl_sys_schedule(0);
+ ASSERT(!erts_port_task_have_outstanding_io_tasks());
- dt = erts_do_time_read_and_reset();
- if (dt) erts_bump_timer(dt);
+ erl_sys_schedule(0);
- flgs = sched_prep_cont_spin_wait(ssi);
- if (flgs & ERTS_SSI_FLG_WAITING)
- goto sys_aux_work;
+ dt = erts_do_time_read_and_reset();
+ if (dt) erts_bump_timer(dt);
+
+#ifndef ERTS_SMP
+ if (rq->len == 0 && !rq->misc.start)
+ goto sys_aux_work;
+ sys_woken:
+#else
+ flgs = sched_prep_cont_spin_wait(ssi);
+ if (flgs & ERTS_SSI_FLG_WAITING)
+ goto sys_aux_work;
- sys_woken:
+ sys_woken:
+ if (!thr_prgr_active)
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
+ erts_smp_runq_lock(rq);
+ sys_locked_woken:
+ if (!thr_prgr_active) {
+ erts_smp_runq_unlock(rq);
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
erts_smp_runq_lock(rq);
- sys_locked_woken:
- clear_sys_scheduling();
- if (flgs & ~ERTS_SSI_FLG_SUSPENDED)
- erts_smp_atomic32_read_band_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED);
- sched_active_sys(esdp->no, rq);
}
+ clear_sys_scheduling();
+ if (flgs & ~ERTS_SSI_FLG_SUSPENDED)
+ erts_smp_atomic32_read_band_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED);
+#endif
+ sched_active_sys(esdp->no, rq);
}
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
}
+#ifdef ERTS_SMP
+
static ERTS_INLINE erts_aint32_t
ssi_flags_set_wake(ErtsSchedulerSleepInfo *ssi)
{
@@ -2547,8 +3285,9 @@ erts_debug_nbalance(void)
}
void
-erts_early_init_scheduling(void)
+erts_early_init_scheduling(int no_schedulers)
{
+ aux_work_timeout_early_init(no_schedulers);
wakeup_other_limit = ERTS_WAKEUP_OTHER_LIMIT_MEDIUM;
}
@@ -2569,12 +3308,32 @@ erts_sched_set_wakeup_limit(char *str)
return EINVAL;
return 0;
}
-
+
+static void
+init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp)
+{
+ awdp->sched_id = esdp ? (int) esdp->no : 0;
+ awdp->esdp = esdp;
+ awdp->ssi = esdp ? esdp->ssi : NULL;
+#ifdef ERTS_SMP
+ awdp->misc.thr_prgr = ERTS_THR_PRGR_VAL_WAITING;
+ awdp->dd.thr_prgr = ERTS_THR_PRGR_VAL_WAITING;
+ awdp->dd.completed_callback = NULL;
+ awdp->dd.completed_arg = NULL;
+#endif
+#ifdef ERTS_USE_ASYNC_READY_Q
+#ifdef ERTS_SMP
+ awdp->async_ready.need_thr_prgr = 0;
+ awdp->async_ready.thr_prgr = ERTS_THR_PRGR_VAL_WAITING;
+#endif
+ awdp->async_ready.queue = NULL;
+#endif
+}
void
erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online)
{
- int ix, n;
+ int ix, n, no_ssi;
#ifndef ERTS_SMP
mrq = 0;
@@ -2684,23 +3443,31 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online)
n = (int) no_schedulers;
erts_no_schedulers = n;
-#ifdef ERTS_SMP
/* Create and initialize scheduler sleep info */
-
+#ifdef ERTS_SMP
+ no_ssi = n+1;
+#else
+ no_ssi = 1;
+#endif
aligned_sched_sleep_info =
- erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_SLP_INFO,
- n * sizeof(ErtsAlignedSchedulerSleepInfo));
-
- for (ix = 0; ix < n; ix++) {
- ErtsSchedulerSleepInfo *ssi = ERTS_SCHED_SLEEP_INFO_IX(ix);
+ erts_alloc_permanent_cache_aligned(
+ ERTS_ALC_T_SCHDLR_SLP_INFO,
+ no_ssi*sizeof(ErtsAlignedSchedulerSleepInfo));
+ for (ix = 0; ix < no_ssi; ix++) {
+ ErtsSchedulerSleepInfo *ssi = &aligned_sched_sleep_info[ix].ssi;
+#ifdef ERTS_SMP
#if 0 /* no need to initialize these... */
ssi->next = NULL;
ssi->prev = NULL;
#endif
erts_smp_atomic32_init_nob(&ssi->flags, 0);
ssi->event = NULL; /* initialized in sched_thread_func */
- erts_smp_atomic32_init_nob(&ssi->aux_work, 0);
+#endif
+ erts_atomic32_init_nob(&ssi->aux_work, 0);
}
+
+#ifdef ERTS_SMP
+ aligned_sched_sleep_info++;
#endif
/* Create and initialize scheduler specific data */
@@ -2714,7 +3481,6 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online)
#ifdef ERTS_SMP
erts_bits_init_state(&esdp->erl_bits_state);
esdp->match_pseudo_process = NULL;
- esdp->ssi = ERTS_SCHED_SLEEP_INFO_IX(ix);
esdp->free_process = NULL;
#endif
esdp->x_reg_array =
@@ -2728,6 +3494,7 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online)
esdp->num_tmp_heap_used = 0;
#endif
esdp->no = (Uint) ix+1;
+ esdp->ssi = ERTS_SCHED_SLEEP_INFO_IX(ix);
esdp->current_process = NULL;
esdp->current_port = NULL;
@@ -2748,9 +3515,19 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online)
#ifdef ERTS_SMP
erts_smp_atomic32_init_nob(&esdp->chk_cpu_bind, 0);
#endif
+ init_aux_work_data(&esdp->aux_work_data, esdp);
}
+ init_misc_aux_work();
+
#ifdef ERTS_SMP
+
+ erts_atomic32_init_nob(&completed_dealloc_count, 0); /* debug only */
+
+ aux_thread_aux_work_data =
+ erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_DATA,
+ sizeof(ErtsAuxWorkData));
+
erts_smp_mtx_init(&schdlr_sspnd.mtx, "schdlr_sspnd");
erts_smp_cnd_init(&schdlr_sspnd.cnd);
@@ -2812,6 +3589,8 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online)
/* init port tasks */
erts_port_task_init();
+ aux_work_timeout_late_init();
+
#ifndef ERTS_SMP
#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC
erts_scheduler_data->verify_unused_temp_alloc
@@ -2946,18 +3725,6 @@ erts_get_max_no_executing_schedulers(void)
#ifdef ERTS_SMP
static void
-susp_sched_prep_block(void *unused)
-{
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
-}
-
-static void
-susp_sched_resume_block(void *unused)
-{
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
-}
-
-static void
scheduler_ix_resume_wake(Uint ix)
{
ErtsSchedulerSleepInfo *ssi = ERTS_SCHED_SLEEP_INFO_IX(ix);
@@ -3061,10 +3828,8 @@ suspend_scheduler(ErtsSchedulerData *esdp)
long active_schedulers;
int curr_online = 1;
int wake = 0;
-#if defined(ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK) \
- || defined(ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK)
erts_aint32_t aux_work;
-#endif
+ int thr_prgr_active = 1;
/*
* Schedulers may be suspended in two different ways:
@@ -3137,38 +3902,40 @@ suspend_scheduler(ErtsSchedulerData *esdp)
break;
erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
-
-#ifdef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK
- aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work);
- blockable_aux_work:
- blockable_aux_work(esdp, ssi, aux_work);
-#endif
-
- erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL);
while (1) {
erts_aint32_t flgs;
-#ifdef ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK
-#ifndef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK
- aux_work = erts_smp_atomic32_read(&ssi->aux_work);
-#endif
- nonblockable_aux_work(esdp, ssi, aux_work);
-#endif
- flgs = sched_spin_suspended(ssi,
- ERTS_SCHED_SUSPEND_SLEEP_SPINCOUNT);
- if (flgs == (ERTS_SSI_FLG_SLEEPING
- | ERTS_SSI_FLG_WAITING
- | ERTS_SSI_FLG_SUSPENDED)) {
- flgs = sched_set_suspended_sleeptype(ssi);
+ aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
+ if (aux_work) {
+ if (!thr_prgr_active)
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
+ aux_work = handle_aux_work(&esdp->aux_work_data, aux_work);
+ if (aux_work && erts_thr_progress_update(esdp))
+ erts_thr_progress_leader_update(esdp);
+ }
+
+ if (!aux_work) {
+ if (thr_prgr_active)
+ erts_thr_progress_active(esdp, thr_prgr_active = 0);
+ erts_thr_progress_prepare_wait(esdp);
+ flgs = sched_spin_suspended(ssi,
+ ERTS_SCHED_SUSPEND_SLEEP_SPINCOUNT);
if (flgs == (ERTS_SSI_FLG_SLEEPING
- | ERTS_SSI_FLG_TSE_SLEEPING
| ERTS_SSI_FLG_WAITING
| ERTS_SSI_FLG_SUSPENDED)) {
- int res;
- do {
- res = erts_tse_wait(ssi->event);
- } while (res == EINTR);
+ flgs = sched_set_suspended_sleeptype(ssi);
+ if (flgs == (ERTS_SSI_FLG_SLEEPING
+ | ERTS_SSI_FLG_TSE_SLEEPING
+ | ERTS_SSI_FLG_WAITING
+ | ERTS_SSI_FLG_SUSPENDED)) {
+ int res;
+
+ do {
+ res = erts_tse_wait(ssi->event);
+ } while (res == EINTR);
+ }
}
+ erts_thr_progress_finalize_wait(esdp);
}
flgs = sched_prep_spin_suspended(ssi, (ERTS_SSI_FLG_WAITING
@@ -3178,20 +3945,8 @@ suspend_scheduler(ErtsSchedulerData *esdp)
changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
if (changing & ~ERTS_SCHDLR_SSPND_CHNG_WAITER)
break;
-
-
-#ifdef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK
- aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work);
- if (aux_work & ERTS_SSI_BLOCKABLE_AUX_WORK_MASK) {
- erts_smp_activity_end(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL);
- goto blockable_aux_work;
- }
-#endif
-
}
- erts_smp_activity_end(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL);
-
erts_smp_mtx_lock(&schdlr_sspnd.mtx);
changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
}
@@ -3216,6 +3971,9 @@ suspend_scheduler(ErtsSchedulerData *esdp)
if (erts_system_profile_flags.scheduler)
profile_scheduler(make_small(esdp->no), am_active);
+ if (!thr_prgr_active)
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
+
erts_smp_runq_lock(esdp->run_queue);
non_empty_runq(esdp->run_queue);
@@ -3298,12 +4056,16 @@ erts_set_schedulers_online(Process *p,
Sint new_no,
Sint *old_no)
{
- int ix, res, no, have_unlocked_plocks;
+ ErtsSchedulerData *esdp;
+ int ix, res, no, have_unlocked_plocks, end_wait;
erts_aint32_t changing;
if (new_no < 1 || erts_no_schedulers < new_no)
return ERTS_SCHDLR_SSPND_EINVAL;
+ esdp = ERTS_PROC_GET_SCHDATA(p);
+ end_wait = 0;
+
erts_smp_mtx_lock(&schdlr_sspnd.mtx);
have_unlocked_plocks = 0;
@@ -3420,16 +4182,21 @@ erts_set_schedulers_online(Process *p,
}
}
- erts_smp_activity_begin(ERTS_ACTIVITY_WAIT,
- susp_sched_prep_block,
- susp_sched_resume_block,
- NULL);
+ if (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) {
+ erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ if (plocks && !have_unlocked_plocks) {
+ have_unlocked_plocks = 1;
+ erts_smp_proc_unlock(p, plocks);
+ }
+ erts_thr_progress_active(esdp, 0);
+ erts_thr_progress_prepare_wait(esdp);
+ end_wait = 1;
+ erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+ }
+
while (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online)
erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx);
- erts_smp_activity_end(ERTS_ACTIVITY_WAIT,
- susp_sched_prep_block,
- susp_sched_resume_block,
- NULL);
+
ASSERT(res != ERTS_SCHDLR_SSPND_DONE
? (ERTS_SCHDLR_SSPND_CHNG_WAITER
& erts_smp_atomic32_read_nob(&schdlr_sspnd.changing))
@@ -3437,10 +4204,15 @@ erts_set_schedulers_online(Process *p,
== erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)));
erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
~ERTS_SCHDLR_SSPND_CHNG_WAITER);
+
}
}
erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ if (end_wait) {
+ erts_thr_progress_finalize_wait(esdp);
+ erts_thr_progress_active(esdp, 1);
+ }
if (have_unlocked_plocks)
erts_smp_proc_lock(p, plocks);
@@ -3525,17 +4297,38 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all)
erts_smp_mtx_unlock(&balance_info.update_mtx);
erts_smp_mtx_lock(&schdlr_sspnd.mtx);
}
- erts_smp_activity_begin(ERTS_ACTIVITY_WAIT,
- susp_sched_prep_block,
- susp_sched_resume_block,
- NULL);
- while (erts_smp_atomic32_read_nob(&schdlr_sspnd.active)
- != schdlr_sspnd.msb.wait_active)
- erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx);
- erts_smp_activity_end(ERTS_ACTIVITY_WAIT,
- susp_sched_prep_block,
- susp_sched_resume_block,
- NULL);
+
+ if (erts_smp_atomic32_read_nob(&schdlr_sspnd.active)
+ != schdlr_sspnd.msb.wait_active) {
+ ErtsSchedulerData *esdp;
+
+ erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+
+ if (plocks && !have_unlocked_plocks) {
+ have_unlocked_plocks = 1;
+ erts_smp_proc_unlock(p, plocks);
+ }
+
+ esdp = ERTS_PROC_GET_SCHDATA(p);
+
+ erts_thr_progress_active(esdp, 0);
+ erts_thr_progress_prepare_wait(esdp);
+
+ erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+
+ while (erts_smp_atomic32_read_nob(&schdlr_sspnd.active)
+ != schdlr_sspnd.msb.wait_active)
+ erts_smp_cnd_wait(&schdlr_sspnd.cnd,
+ &schdlr_sspnd.mtx);
+
+ erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+
+ erts_thr_progress_active(esdp, 1);
+ erts_thr_progress_finalize_wait(esdp);
+
+ erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+
+ }
ASSERT(res != ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED
? (ERTS_SCHDLR_SSPND_CHNG_WAITER
& erts_smp_atomic32_read_nob(&schdlr_sspnd.changing))
@@ -3723,8 +4516,19 @@ erts_multi_scheduling_blockers(Process *p)
static void *
sched_thread_func(void *vesdp)
{
+ ErtsThrPrgrCallbacks callbacks;
+ ErtsSchedulerData *esdp = vesdp;
+ Uint no = esdp->no;
#ifdef ERTS_SMP
- Uint no = ((ErtsSchedulerData *) vesdp)->no;
+ ERTS_SCHED_SLEEP_INFO_IX(no - 1)->event = erts_tse_fetch();
+ callbacks.arg = (void *) esdp->ssi;
+ callbacks.wakeup = thr_prgr_wakeup;
+ callbacks.prepare_wait = thr_prgr_prep_wait;
+ callbacks.wait = thr_prgr_wait;
+ callbacks.finalize_wait = thr_prgr_fin_wait;
+
+ erts_thr_progress_register_managed_thread(esdp, &callbacks, 0);
+ erts_alloc_register_scheduler(vesdp);
#endif
#ifdef ERTS_ENABLE_LOCK_CHECK
{
@@ -3733,22 +4537,30 @@ sched_thread_func(void *vesdp)
erts_lc_set_thread_name(&buf[0]);
}
#endif
- erts_alloc_reg_scheduler_id(no);
erts_tsd_set(sched_data_key, vesdp);
#ifdef ERTS_SMP
+#if HAVE_ERTS_MSEG
+ erts_mseg_late_init();
+#endif
+#if ERTS_USE_ASYNC_READY_Q
+ esdp->aux_work_data.async_ready.queue = erts_get_async_ready_queue(no);
+#endif
- erts_sched_init_check_cpu_bind((ErtsSchedulerData *) vesdp);
+ erts_sched_init_check_cpu_bind(esdp);
erts_proc_lock_prepare_proc_lock_waiter();
- ERTS_SCHED_SLEEP_INFO_IX(no - 1)->event = erts_tse_fetch();
-
-
#endif
- erts_register_blockable_thread();
+
#ifdef HIPE
hipe_thread_signal_init();
#endif
erts_thread_init_float();
+
+ if (no == 1) {
+ erts_thr_progress_active(esdp, 0);
+ erts_thr_progress_prepare_wait(esdp);
+ }
+
erts_smp_mtx_lock(&schdlr_sspnd.mtx);
ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)
@@ -3757,41 +4569,39 @@ sched_thread_func(void *vesdp)
if (--schdlr_sspnd.curr_online == schdlr_sspnd.wait_curr_online) {
erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
~ERTS_SCHDLR_SSPND_CHNG_ONLN);
- if (((ErtsSchedulerData *) vesdp)->no != 1)
+ if (no != 1)
erts_smp_cnd_signal(&schdlr_sspnd.cnd);
}
- if (((ErtsSchedulerData *) vesdp)->no == 1) {
- if (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) {
- erts_smp_activity_begin(ERTS_ACTIVITY_WAIT,
- susp_sched_prep_block,
- susp_sched_resume_block,
- NULL);
- while (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online)
- erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx);
- erts_smp_activity_end(ERTS_ACTIVITY_WAIT,
- susp_sched_prep_block,
- susp_sched_resume_block,
- NULL);
- }
+ if (no == 1) {
+ while (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online)
+ erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx);
ERTS_SCHDLR_SSPND_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER);
}
erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ if (no == 1) {
+ erts_thr_progress_finalize_wait(esdp);
+ erts_thr_progress_active(esdp, 1);
+ }
+
#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC
- ((ErtsSchedulerData *) vesdp)->verify_unused_temp_alloc
+ esdp->verify_unused_temp_alloc
= erts_alloc_get_verify_unused_temp_alloc(
- &((ErtsSchedulerData *) vesdp)->verify_unused_temp_alloc_data);
+ &esdp->verify_unused_temp_alloc_data);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(NULL);
#endif
process_main();
/* No schedulers should *ever* terminate */
- erl_exit(ERTS_ABORT_EXIT, "Scheduler thread number %beu terminated\n",
- ((ErtsSchedulerData *) vesdp)->no);
+ erl_exit(ERTS_ABORT_EXIT,
+ "Scheduler thread number %beu terminated\n",
+ no);
return NULL;
}
+static ethr_tid aux_tid;
+
void
erts_start_schedulers(void)
{
@@ -3811,8 +4621,6 @@ erts_start_schedulers(void)
res = ENOTSUP;
}
- erts_block_system(0);
-
while (actual < wanted) {
ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(actual);
actual++;
@@ -3825,7 +4633,12 @@ erts_start_schedulers(void)
}
erts_no_schedulers = actual;
- erts_release_system();
+
+ ERTS_THR_MEMORY_BARRIER;
+
+ res = ethr_thr_create(&aux_tid, aux_thread, NULL, &opts);
+ if (res != 0)
+ erl_exit(1, "Failed to create aux thread\n");
if (actual < 1)
erl_exit(1,
@@ -5186,7 +5999,7 @@ Process *schedule(Process *p, int calls)
input_reductions = INPUT_REDUCTIONS;
}
- ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING);
+ ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
/*
* Clean up after the process being scheduled out.
@@ -5324,7 +6137,8 @@ Process *schedule(Process *p, int calls)
}
- ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING);
+ ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
+
check_activities_to_run: {
#ifdef ERTS_SMP
@@ -5334,7 +6148,7 @@ Process *schedule(Process *p, int calls)
check_balance(rq);
}
- ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING);
+ ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
if (rq->flags & ERTS_RUNQ_FLGS_IMMIGRATE_QMASK)
@@ -5358,42 +6172,38 @@ Process *schedule(Process *p, int calls)
}
}
-#if defined(ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK) \
- || defined(ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK)
{
- ErtsSchedulerSleepInfo *ssi = esdp->ssi;
- erts_aint32_t aux_work = erts_smp_atomic32_read_nob(&ssi->aux_work);
- if (aux_work) {
+ erts_aint32_t aux_work;
+ int leader_update = erts_thr_progress_update(esdp);
+ aux_work = erts_atomic32_read_acqb(&esdp->ssi->aux_work);
+ if (aux_work | leader_update) {
erts_smp_runq_unlock(rq);
-#ifdef ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK
- aux_work = blockable_aux_work(esdp, ssi, aux_work);
-#endif
-#ifdef ERTS_SCHED_NEED_NONBLOCKABLE_AUX_WORK
- nonblockable_aux_work(esdp, ssi, aux_work);
-#endif
+ if (leader_update)
+ erts_thr_progress_leader_update(esdp);
+ if (aux_work)
+ handle_aux_work(&esdp->aux_work_data, aux_work);
erts_smp_runq_lock(rq);
}
}
-#endif
-
- erts_smp_chk_system_block(prepare_for_block,
- resume_after_block,
- (void *) rq);
- ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING);
+ ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
-#endif
+#else /* ERTS_SMP */
+ {
+ erts_aint32_t aux_work;
+ aux_work = erts_atomic32_read_acqb(&esdp->ssi->aux_work);
+ if (aux_work)
+ handle_aux_work(&esdp->aux_work_data, aux_work);
+ }
+#endif /* ERTS_SMP */
ASSERT(rq->len == rq->procs.len + rq->ports.info.len);
-#ifndef ERTS_SMP
+ if (rq->len == 0 && !rq->misc.start) {
- if (rq->len == 0 && !rq->misc.start)
- goto do_sys_schedule;
+#ifdef ERTS_SMP
-#else /* ERTS_SMP */
- if (rq->len == 0 && !rq->misc.start) {
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
rq->wakeup_other = 0;
@@ -5424,26 +6234,17 @@ Process *schedule(Process *p, int calls)
}
}
+#endif
+
scheduler_wait(&fcalls, esdp, rq);
+#ifdef ERTS_SMP
non_empty_runq(rq);
+#endif
goto check_activities_to_run;
}
- else
-#endif /* ERTS_SMP */
- if (fcalls > input_reductions && prepare_for_sys_schedule()) {
- int runnable;
-
-#ifdef ERTS_SMP
- runnable = 1;
-#else
- do_sys_schedule:
- runnable = rq->len != 0;
- if (!runnable)
- sched_waiting_sys(esdp->no, rq);
-#endif
-
+ else if (fcalls > input_reductions && prepare_for_sys_schedule()) {
/*
* Schedule system-level activities.
*/
@@ -5453,11 +6254,11 @@ Process *schedule(Process *p, int calls)
ASSERT(!erts_port_task_have_outstanding_io_tasks());
-#ifdef ERTS_SMP
- /* erts_sys_schedule_interrupt(0); */
+#if 0 /* Not needed since we wont wait in sys schedule */
+ erts_sys_schedule_interrupt(0);
#endif
erts_smp_runq_unlock(rq);
- erl_sys_schedule(runnable);
+ erl_sys_schedule(1);
dt = erts_do_time_read_and_reset();
if (dt) erts_bump_timer(dt);
#ifdef ERTS_SMP
@@ -5465,8 +6266,6 @@ Process *schedule(Process *p, int calls)
clear_sys_scheduling();
goto continue_check_activities_to_run;
#else
- if (!runnable)
- sched_active_sys(esdp->no, rq);
goto check_activities_to_run;
#endif
}
@@ -5714,14 +6513,14 @@ erts_sched_stat_modify(int what)
int ix;
switch (what) {
case ERTS_SCHED_STAT_MODIFY_ENABLE:
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
erts_sched_stat.enabled = 1;
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
break;
case ERTS_SCHED_STAT_MODIFY_DISABLE:
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
erts_sched_stat.enabled = 1;
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
break;
case ERTS_SCHED_STAT_MODIFY_CLEAR:
erts_smp_spin_lock(&erts_sched_stat.lock);
@@ -5781,20 +6580,9 @@ erts_sched_stat_term(Process *p, int total)
void
erts_schedule_misc_op(void (*func)(void *), void *arg)
{
- ErtsRunQueue *rq;
- ErtsMiscOpList *molp = misc_op_list_alloc();
ErtsSchedulerData *esdp = erts_get_scheduler_data();
-
- if (esdp) {
- rq = esdp->run_queue;
- } else {
- /*
- * This can only happen when the sys msg dispatcher
- * thread schedules misc ops (this happens *very*
- * seldom; only when trace drivers are unloaded).
- */
- rq = ERTS_RUNQ_IX(0);
- }
+ ErtsRunQueue *rq = esdp ? esdp->run_queue : ERTS_RUNQ_IX(0);
+ ErtsMiscOpList *molp = misc_op_list_alloc();
erts_smp_runq_lock(rq);
@@ -5887,7 +6675,7 @@ erts_get_exact_total_reductions(Process *c_p, Uint *redsp, Uint *diffp)
* Wait for other schedulers to schedule out their processes
* and update 'reductions'.
*/
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
for (reds = 0, ix = 0; ix < erts_no_run_queues; ix++)
reds += ERTS_RUNQ_IX(ix)->procs.reductions;
if (redsp)
@@ -5895,7 +6683,7 @@ erts_get_exact_total_reductions(Process *c_p, Uint *redsp, Uint *diffp)
if (diffp)
*diffp = reds - last_exact_reductions;
last_exact_reductions = reds;
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
}
@@ -8700,6 +9488,22 @@ init_processes_bif(void)
* Debug stuff
*/
+#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+int
+erts_dbg_check_halloc_lock(Process *p)
+{
+ if (ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p))
+ return 1;
+ if (p->id == ERTS_INVALID_PID)
+ return 1;
+ if (p->scheduler_data && p == p->scheduler_data->match_pseudo_process)
+ return 1;
+ if (erts_thr_progress_is_blocking())
+ return 1;
+ return 0;
+}
+#endif
+
Eterm
erts_debug_processes(Process *c_p)
{
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 627f10b142..4027fade35 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -53,11 +53,18 @@ typedef struct process Process;
#include "erl_time.h"
#include "erl_atom_table.h"
#include "external.h"
+#include "erl_mseg.h"
+#include "erl_async.h"
#ifdef HIPE
#include "hipe_process.h"
#endif
+#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY
+#define ERL_THR_PROGRESS_TSD_TYPE_ONLY
+#include "erl_thr_progress.h"
+#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY
+
struct ErtsNodesMonitor_;
struct port;
@@ -242,16 +249,25 @@ typedef enum {
| ERTS_SSI_FLG_WAITING \
| ERTS_SSI_FLG_SUSPENDED)
-#define ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK
-
-#define ERTS_SSI_AUX_WORK_CHECK_CHILDREN (((erts_aint32_t) 1) << 0)
-#define ERTS_SSI_AUX_WORK_MISC (((erts_aint32_t) 1) << 1)
+#define ERTS_SSI_AUX_WORK_SET_TMO (((erts_aint32_t) 1) << 0)
+#define ERTS_SSI_AUX_WORK_CHECK_CHILDREN (((erts_aint32_t) 1) << 1)
+#define ERTS_SSI_AUX_WORK_MISC (((erts_aint32_t) 1) << 2)
+#ifdef ERTS_SMP
+#define ERTS_SSI_AUX_WORK_MISC_THR_PRGR (((erts_aint32_t) 1) << 3)
+#endif
+#define ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM (((erts_aint32_t) 1) << 4)
+#define ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC (((erts_aint32_t) 1) << 5)
+#define ERTS_SSI_AUX_WORK_ASYNC_READY (((erts_aint32_t) 1) << 6)
+#define ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN (((erts_aint32_t) 1) << 7)
+#ifdef ERTS_SMP
+#define ERTS_SSI_AUX_WORK_DD (((erts_aint32_t) 1) << 8)
+#define ERTS_SSI_AUX_WORK_DD_THR_PRGR (((erts_aint32_t) 1) << 9)
+#endif
+#define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK (((erts_aint32_t) 1) << 10)
-#define ERTS_SSI_BLOCKABLE_AUX_WORK_MASK \
- (ERTS_SSI_AUX_WORK_CHECK_CHILDREN \
- | ERTS_SSI_AUX_WORK_MISC)
-#define ERTS_SSI_NONBLOCKABLE_AUX_WORK_MASK \
- (0)
+#if !HAVE_ERTS_MSEG
+# undef ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK
+#endif
typedef struct ErtsSchedulerSleepInfo_ ErtsSchedulerSleepInfo;
@@ -261,11 +277,13 @@ typedef struct {
} ErtsSchedulerSleepList;
struct ErtsSchedulerSleepInfo_ {
+#ifdef ERTS_SMP
ErtsSchedulerSleepInfo *next;
ErtsSchedulerSleepInfo *prev;
erts_smp_atomic32_t flags;
erts_tse_t *event;
- erts_smp_atomic32_t aux_work;
+#endif
+ erts_atomic32_t aux_work;
};
/* times to reschedule low prio process before running */
@@ -386,6 +404,34 @@ do { \
(RQ)->wakeup_other_reds += (REDS); \
} while (0)
+typedef struct {
+ int sched_id;
+ ErtsSchedulerData *esdp;
+ ErtsSchedulerSleepInfo *ssi;
+ struct {
+ int ix;
+#ifdef ERTS_SMP
+ ErtsThrPrgrVal thr_prgr;
+#endif
+ } misc;
+#ifdef ERTS_SMP
+ struct {
+ ErtsThrPrgrVal thr_prgr;
+ void (*completed_callback)(void *);
+ void (*completed_arg)(void *);
+ } dd;
+#endif
+#ifdef ERTS_USE_ASYNC_READY_Q
+ struct {
+#ifdef ERTS_SMP
+ int need_thr_prgr;
+ ErtsThrPrgrVal thr_prgr;
+#endif
+ void *queue;
+ } async_ready;
+#endif
+} ErtsAuxWorkData;
+
struct ErtsSchedulerData_ {
/*
* Keep X registers first (so we get as many low
@@ -399,8 +445,8 @@ struct ErtsSchedulerData_ {
ethr_tid tid; /* Thread id */
struct erl_bits_state erl_bits_state; /* erl_bits.c state */
void *match_pseudo_process; /* erl_db_util.c:db_prog_match() */
- ErtsSchedulerSleepInfo *ssi;
Process *free_process;
+ ErtsThrPrgrData thr_progress_data;
#endif
#if !HEAP_ON_C_STACK
Eterm tmp_heap[TMP_HEAP_SIZE];
@@ -409,16 +455,19 @@ struct ErtsSchedulerData_ {
Eterm cmp_tmp_heap[CMP_TMP_HEAP_SIZE];
Eterm erl_arith_tmp_heap[ERL_ARITH_TMP_HEAP_SIZE];
#endif
-
+ ErtsSchedulerSleepInfo *ssi;
Process *current_process;
Uint no; /* Scheduler number */
struct port *current_port;
ErtsRunQueue *run_queue;
int virtual_reds;
int cpu_id; /* >= 0 when bound */
+ ErtsAuxWorkData aux_work_data;
ErtsAtomCacheMap atom_cache_map;
+ ErtsSchedAllocData alloc_data;
+
#ifdef ERTS_SMP
/* NOTE: These fields are modified under held mutexes by other threads */
erts_smp_atomic32_t chk_cpu_bind; /* Only used when common run queue */
@@ -1028,7 +1077,7 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags;
void erts_pre_init_process(void);
void erts_late_init_process(void);
-void erts_early_init_scheduling(void);
+void erts_early_init_scheduling(int);
void erts_init_scheduling(int, int, int);
ErtsProcList *erts_proclist_create(Process *);
@@ -1037,6 +1086,9 @@ int erts_proclist_same(ErtsProcList *, Process *);
int erts_sched_set_wakeup_limit(char *str);
+#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
+int erts_dbg_check_halloc_lock(Process *p);
+#endif
#ifdef DEBUG
void erts_dbg_multi_scheduling_return_trap(Process *, Eterm);
#endif
@@ -1054,13 +1106,20 @@ erts_block_multi_scheduling(Process *, ErtsProcLocks, int, int);
int erts_is_multi_scheduling_blocked(void);
Eterm erts_multi_scheduling_blockers(Process *);
void erts_start_schedulers(void);
+void erts_alloc_notify_delayed_dealloc(int);
void erts_smp_notify_check_children_needed(void);
-void
-erts_smp_schedule_misc_aux_work(int ignore_self,
- int max_sched,
- void (*func)(void *),
- void *arg);
#endif
+#if ERTS_USE_ASYNC_READY_Q
+void erts_notify_check_async_ready_queue(void *);
+#endif
+void erts_schedule_misc_aux_work(int sched_id,
+ void (*func)(void *),
+ void *arg);
+void erts_schedule_multi_misc_aux_work(int ignore_self,
+ int max_sched,
+ void (*func)(void *),
+ void *arg);
+erts_aint32_t erts_set_aux_work_timeout(int, erts_aint32_t, int);
void erts_sched_notify_check_cpu_bind(void);
Uint erts_active_schedulers(void);
void erts_init_process(int);
@@ -1144,6 +1203,7 @@ Sint erts_test_next_pid(int, Uint);
Eterm erts_debug_processes(Process *c_p);
Eterm erts_debug_processes_bif_info(Process *c_p);
Uint erts_debug_nbalance(void);
+int erts_debug_wait_deallocations(Process *c_p);
#ifdef ERTS_SMP
# define ERTS_GET_SCHEDULER_DATA_FROM_PROC(PROC) ((PROC)->scheduler_data)
@@ -1214,16 +1274,11 @@ erts_psd_get(Process *p, int ix)
#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
ErtsProcLocks locks = erts_proc_lc_my_proc_locks(p);
if (ERTS_LC_PSD_ANY_LOCK == erts_psd_required_locks[ix].get_locks)
- ERTS_SMP_LC_ASSERT(locks
- || erts_is_system_blocked(0)
- || (ERTS_IS_CRASH_DUMPING
- && erts_is_system_blocked(ERTS_BS_FLG_ALLOW_GC)));
+ ERTS_SMP_LC_ASSERT(locks || erts_thr_progress_is_blocking());
else {
locks &= erts_psd_required_locks[ix].get_locks;
ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].get_locks == locks
- || erts_is_system_blocked(0)
- || (ERTS_IS_CRASH_DUMPING
- && erts_is_system_blocked(ERTS_BS_FLG_ALLOW_GC)));
+ || erts_thr_progress_is_blocking());
}
#endif
ASSERT(0 <= ix && ix < ERTS_PSD_SIZE);
@@ -1240,16 +1295,11 @@ erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *data)
#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
ErtsProcLocks locks = erts_proc_lc_my_proc_locks(p);
if (ERTS_LC_PSD_ANY_LOCK == erts_psd_required_locks[ix].set_locks)
- ERTS_SMP_LC_ASSERT(locks
- || erts_is_system_blocked(0)
- || (ERTS_IS_CRASH_DUMPING
- && erts_is_system_blocked(ERTS_BS_FLG_ALLOW_GC)));
+ ERTS_SMP_LC_ASSERT(locks || erts_thr_progress_is_blocking());
else {
locks &= erts_psd_required_locks[ix].set_locks;
ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].set_locks == locks
- || erts_is_system_blocked(0)
- || (ERTS_IS_CRASH_DUMPING
- && erts_is_system_blocked(ERTS_BS_FLG_ALLOW_GC)));
+ || erts_thr_progress_is_blocking());
}
#endif
ASSERT(0 <= ix && ix < ERTS_PSD_SIZE);
@@ -1596,8 +1646,6 @@ erts_sched_poke(ErtsSchedulerSleepInfo *ssi)
erts_aint32_t flags;
ERTS_THR_MEMORY_BARRIER;
flags = erts_smp_atomic32_read_nob(&ssi->flags);
- ASSERT(!(flags & ERTS_SSI_FLG_SLEEPING)
- || (flags & ERTS_SSI_FLG_WAITING));
if (flags & ERTS_SSI_FLG_SLEEPING) {
flags = erts_smp_atomic32_read_band_nob(&ssi->flags, ~ERTS_SSI_FLGS_SLEEP);
erts_sched_finish_poke(ssi, flags);
diff --git a/erts/emulator/beam/erl_process_lock.h b/erts/emulator/beam/erl_process_lock.h
index cd3b2182fd..97f250138e 100644
--- a/erts/emulator/beam/erl_process_lock.h
+++ b/erts/emulator/beam/erl_process_lock.h
@@ -651,7 +651,7 @@ ERTS_GLB_INLINE int erts_smp_proc_trylock(Process *, ErtsProcLocks);
ERTS_GLB_INLINE void erts_smp_proc_inc_refc(Process *);
ERTS_GLB_INLINE void erts_smp_proc_dec_refc(Process *);
-
+ERTS_GLB_INLINE void erts_smp_proc_add_refc(Process *, Sint32);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
@@ -737,6 +737,21 @@ ERTS_GLB_INLINE void erts_smp_proc_dec_refc(Process *p)
#endif
}
+ERTS_GLB_INLINE void erts_smp_proc_add_refc(Process *p, Sint32 refc)
+{
+#ifdef ERTS_SMP
+ Process *fp;
+ erts_pix_lock_t *pixlck = ERTS_PID2PIXLOCK(p->id);
+ erts_pix_lock(pixlck);
+ ERTS_LC_ASSERT(p->lock.refc > 0);
+ p->lock.refc += refc;
+ fp = p->lock.refc == 0 ? p : NULL;
+ erts_pix_unlock(pixlck);
+ if (fp)
+ erts_free_proc(fp);
+#endif
+}
+
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
#ifdef ERTS_SMP
diff --git a/erts/emulator/beam/erl_sched_spec_pre_alloc.c b/erts/emulator/beam/erl_sched_spec_pre_alloc.c
new file mode 100644
index 0000000000..a7ccea7403
--- /dev/null
+++ b/erts/emulator/beam/erl_sched_spec_pre_alloc.c
@@ -0,0 +1,305 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2011. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/*
+ * Description: Scheduler specific pre-allocators. Each scheduler
+ * thread allocates memory in its own private chunk of
+ * memory. Memory blocks deallocated by remote
+ * schedulers (or other threads) are passed back to
+ * the chunk owner via a lock-free data structure.
+ *
+ * Author: Rickard Green
+ */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#ifdef ERTS_SMP
+
+#include "erl_process.h"
+#include "erl_thr_progress.h"
+
+erts_sspa_data_t *
+erts_sspa_create(size_t blk_sz, int pa_size)
+{
+ erts_sspa_data_t *data;
+ size_t tot_size;
+ size_t chunk_mem_size;
+ char *p;
+ char *chunk_start;
+ int cix;
+ int no_blocks = pa_size;
+ int no_blocks_per_chunk;
+
+ if (erts_no_schedulers == 1)
+ no_blocks_per_chunk = no_blocks;
+ else {
+ int extra = (no_blocks - 1)/4 + 1;
+ if (extra == 0)
+ extra = 1;
+ no_blocks_per_chunk = no_blocks;
+ no_blocks_per_chunk += extra*erts_no_schedulers;
+ no_blocks_per_chunk /= erts_no_schedulers;
+ }
+ no_blocks = no_blocks_per_chunk * erts_no_schedulers;
+ chunk_mem_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_sspa_chunk_header_t));
+ chunk_mem_size += blk_sz * no_blocks_per_chunk;
+ chunk_mem_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(chunk_mem_size);
+ tot_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_sspa_data_t));
+ tot_size += chunk_mem_size*erts_no_schedulers;
+
+ p = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_PRE_ALLOC_DATA, tot_size);
+ data = (erts_sspa_data_t *) p;
+ p += ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_sspa_data_t));
+ chunk_start = p;
+
+ data->chunks_mem_size = chunk_mem_size;
+ data->start = chunk_start;
+ data->end = chunk_start + chunk_mem_size*erts_no_schedulers;
+
+ /* Initialize all chunks */
+ for (cix = 0; cix < erts_no_schedulers; cix++) {
+ erts_sspa_chunk_t *chnk = erts_sspa_cix2chunk(data, cix);
+ erts_sspa_chunk_header_t *chdr = &chnk->aligned.header;
+ erts_sspa_blk_t *blk;
+ int i;
+
+ erts_atomic_init_nob(&chdr->tail.data.last, (erts_aint_t) &chdr->tail.data.marker);
+ erts_atomic_init_nob(&chdr->tail.data.marker.next_atmc, ERTS_AINT_NULL);
+ erts_atomic_init_nob(&chdr->tail.data.um_refc[0], 0);
+ erts_atomic_init_nob(&chdr->tail.data.um_refc[1], 0);
+ erts_atomic32_init_nob(&chdr->tail.data.um_refc_ix, 0);
+
+ chdr->head.no_thr_progress_check = 0;
+ chdr->head.used_marker = 1;
+ chdr->head.first = &chdr->tail.data.marker;
+ chdr->head.unref_end = &chdr->tail.data.marker;
+ chdr->head.next.thr_progress = erts_thr_progress_current();
+ chdr->head.next.thr_progress_reached = 1;
+ chdr->head.next.um_refc_ix = 1;
+ chdr->head.next.unref_end = &chdr->tail.data.marker;
+
+ p = &chnk->data[0];
+ chdr->local.first = (erts_sspa_blk_t *) p;
+ blk = (erts_sspa_blk_t *) p;
+ for (i = 0; i < no_blocks_per_chunk; i++) {
+ blk = (erts_sspa_blk_t *) p;
+ p += blk_sz;
+ blk->next_ptr = (erts_sspa_blk_t *) p;
+ }
+
+ blk->next_ptr = NULL;
+ chdr->local.last = blk;
+ chdr->local.cnt = no_blocks_per_chunk;
+ chdr->local.lim = no_blocks_per_chunk / 3;
+
+ ERTS_SSPA_DBG_CHK_LCL(chdr);
+ }
+
+ return data;
+}
+
+static ERTS_INLINE erts_aint_t
+enqueue_remote_managed_thread(erts_sspa_chunk_header_t *chdr,
+ erts_sspa_blk_t *this,
+ int want_last)
+{
+ erts_aint_t ilast, itmp;
+
+ erts_atomic_init_nob(&this->next_atmc, ERTS_AINT_NULL);
+
+ /* Enqueue at end of list... */
+
+ ilast = erts_atomic_read_nob(&chdr->tail.data.last);
+ while (1) {
+ erts_sspa_blk_t *last = (erts_sspa_blk_t *) ilast;
+ itmp = erts_atomic_cmpxchg_mb(&last->next_atmc,
+ (erts_aint_t) this,
+ ERTS_AINT_NULL);
+ if (itmp == ERTS_AINT_NULL)
+ break;
+ ilast = itmp;
+ }
+
+ /* Move last pointer forward... */
+ while (1) {
+ erts_aint_t itmp;
+ if (want_last) {
+ if (erts_atomic_read_rb(&this->next_atmc) != ERTS_AINT_NULL) {
+ /* Someone else will move it forward */
+ return erts_atomic_read_nob(&chdr->tail.data.last);
+ }
+ }
+ else {
+ if (erts_atomic_read_nob(&this->next_atmc) != ERTS_AINT_NULL) {
+ /* Someone else will move it forward */
+ return ERTS_AINT_NULL;
+ }
+ }
+ itmp = erts_atomic_cmpxchg_mb(&chdr->tail.data.last,
+ (erts_aint_t) this,
+ ilast);
+ if (ilast == itmp)
+ return want_last ? (erts_aint_t) this : ERTS_AINT_NULL;
+ ilast = itmp;
+ }
+}
+
+void
+erts_sspa_remote_free(erts_sspa_chunk_header_t *chdr, erts_sspa_blk_t *blk)
+{
+ int um_refc_ix = 0;
+ int managed_thread = erts_thr_progress_is_managed_thread();
+ if (!managed_thread) {
+ um_refc_ix = erts_atomic32_read_acqb(&chdr->tail.data.um_refc_ix);
+ while (1) {
+ int tmp_um_refc_ix;
+ erts_atomic_inc_acqb(&chdr->tail.data.um_refc[um_refc_ix]);
+ tmp_um_refc_ix = erts_atomic32_read_acqb(&chdr->tail.data.um_refc_ix);
+ if (tmp_um_refc_ix == um_refc_ix)
+ break;
+ erts_atomic_dec_relb(&chdr->tail.data.um_refc[um_refc_ix]);
+ um_refc_ix = tmp_um_refc_ix;
+ }
+ }
+
+ (void) enqueue_remote_managed_thread(chdr, blk, 0);
+
+ if (!managed_thread)
+ erts_atomic_dec_relb(&chdr->tail.data.um_refc[um_refc_ix]);
+}
+
+static ERTS_INLINE void
+fetch_remote(erts_sspa_chunk_header_t *chdr, int max)
+{
+ int new_local = 0;
+
+ if (chdr->head.no_thr_progress_check < ERTS_SSPA_FORCE_THR_CHECK_PROGRESS)
+ chdr->head.no_thr_progress_check++;
+ else {
+ erts_aint_t ilast;
+
+ chdr->head.no_thr_progress_check = 0;
+
+ ilast = erts_atomic_read_nob(&chdr->tail.data.last);
+ if (((erts_sspa_blk_t *) ilast) == &chdr->tail.data.marker
+ && chdr->head.first == &chdr->tail.data.marker)
+ return;
+
+ if (chdr->head.next.thr_progress_reached
+ || erts_thr_progress_has_reached(chdr->head.next.thr_progress)) {
+ int um_refc_ix;
+ chdr->head.next.thr_progress_reached = 1;
+ um_refc_ix = chdr->head.next.um_refc_ix;
+ if (erts_atomic_read_acqb(&chdr->tail.data.um_refc[um_refc_ix]) == 0) {
+
+ /* Move unreferenced end pointer forward... */
+
+ chdr->head.unref_end = chdr->head.next.unref_end;
+
+ if (!chdr->head.used_marker
+ && chdr->head.unref_end == (erts_sspa_blk_t *) ilast) {
+ /* Need to equeue marker */
+ chdr->head.used_marker = 1;
+ ilast = enqueue_remote_managed_thread(chdr,
+ &chdr->tail.data.marker,
+ 1);
+ }
+
+ if (chdr->head.unref_end == (erts_sspa_blk_t *) ilast)
+ ERTS_THR_MEMORY_BARRIER;
+ else {
+ chdr->head.next.unref_end = (erts_sspa_blk_t *) ilast;
+ ERTS_THR_MEMORY_BARRIER;
+ chdr->head.next.thr_progress = erts_thr_progress_later();
+ erts_atomic32_set_relb(&chdr->tail.data.um_refc_ix,
+ um_refc_ix);
+ chdr->head.next.um_refc_ix = um_refc_ix == 0 ? 1 : 0;
+ chdr->head.next.thr_progress_reached = 0;
+ }
+ }
+ }
+ }
+
+ if (new_local < max && chdr->head.first != chdr->head.unref_end) {
+ erts_sspa_blk_t *first, *this, *next, *last;
+ first = chdr->head.first;
+ if (first == &chdr->tail.data.marker) {
+ chdr->head.used_marker = 0;
+ first = ((erts_sspa_blk_t *)
+ erts_atomic_read_nob(&first->next_atmc));
+ chdr->head.first = first;
+ }
+ if (first != chdr->head.unref_end) {
+
+ ERTS_SSPA_DBG_CHK_LCL(chdr);
+
+ this = last = first;
+ do {
+ next = (erts_sspa_blk_t *) erts_atomic_read_nob(&this->next_atmc);
+ if (this == &chdr->tail.data.marker)
+ chdr->head.used_marker = 0;
+ else {
+ last->next_ptr = this;
+ last = this;
+ new_local++;
+ }
+ this = next;
+ } while (new_local < max && this != chdr->head.unref_end);
+ chdr->head.first = this;
+ if (!chdr->local.last)
+ chdr->local.first = first;
+ else
+ chdr->local.last->next_ptr = first;
+ chdr->local.last = last;
+ last->next_ptr = NULL;
+ chdr->local.cnt += new_local;
+
+ ERTS_SSPA_DBG_CHK_LCL(chdr);
+ }
+ }
+
+}
+
+erts_sspa_blk_t *
+erts_sspa_process_remote_frees(erts_sspa_chunk_header_t *chdr,
+ erts_sspa_blk_t *old_res)
+{
+ erts_sspa_blk_t *res = old_res;
+
+ fetch_remote(chdr, ERTS_SSPA_MAX_GET_NEW_LOCAL);
+
+ if (!res && chdr->local.first) {
+
+ ERTS_SSPA_DBG_CHK_LCL(chdr);
+
+ res = chdr->local.first;
+ chdr->local.first = res->next_ptr;
+ chdr->local.cnt--;
+ if (!chdr->local.first)
+ chdr->local.last = NULL;
+
+ ERTS_SSPA_DBG_CHK_LCL(chdr);
+ }
+
+ return res;
+}
+
+#endif /* ERTS_SMP */
diff --git a/erts/emulator/beam/erl_sched_spec_pre_alloc.h b/erts/emulator/beam/erl_sched_spec_pre_alloc.h
new file mode 100644
index 0000000000..d36066c399
--- /dev/null
+++ b/erts/emulator/beam/erl_sched_spec_pre_alloc.h
@@ -0,0 +1,239 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2011. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/*
+ * Description: Scheduler specific pre-allocators. Each scheduler
+ * thread allocates memory in its own private chunk of
+ * memory. Memory blocks deallocated by remote
+ * schedulers (or other threads) are passed back to
+ * the chunk owner via a lock-free data structure.
+ *
+ * Author: Rickard Green
+ */
+
+#ifndef ERTS_SCHED_SPEC_PRE_ALLOC_H__
+#define ERTS_SCHED_SPEC_PRE_ALLOC_H__
+
+#ifdef ERTS_SMP
+
+#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY
+#define ERL_THR_PROGRESS_TSD_TYPE_ONLY
+#include "erl_thr_progress.h"
+#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY
+
+#ifdef DEBUG
+#define ERTS_SPPA_DBG_CHK_IN_CHNK(A, C, P) \
+do { \
+ ASSERT((void *) (C) < (void *) (P)); \
+ ASSERT((void *) (P) \
+ < (void *) (((char *) (C)) + (A)->chunks_mem_size)); \
+} while (0)
+#else
+#define ERTS_SPPA_DBG_CHK_IN_CHNK(A, C, P)
+#endif
+
+#ifdef DEBUG
+extern Uint erts_no_schedulers;
+#endif
+
+#define ERTS_SSPA_FORCE_THR_CHECK_PROGRESS 10
+#define ERTS_SSPA_MAX_GET_NEW_LOCAL 5
+
+typedef struct {
+ char *start;
+ char *end;
+ int chunks_mem_size;
+} erts_sspa_data_t;
+
+typedef union erts_sspa_blk_t_ erts_sspa_blk_t;
+union erts_sspa_blk_t_ {
+ erts_atomic_t next_atmc;
+ erts_sspa_blk_t *next_ptr;
+};
+
+typedef struct {
+ erts_sspa_blk_t *first;
+ erts_sspa_blk_t *last;
+ int cnt;
+ int lim;
+} erts_sspa_local_freelist_t;
+
+typedef struct {
+ erts_sspa_blk_t marker;
+ erts_atomic_t last;
+ erts_atomic_t um_refc[2];
+ erts_atomic32_t um_refc_ix;
+} erts_sspa_tail_t;
+
+typedef struct {
+ /*
+ * This structure needs to be cache line aligned for best
+ * performance.
+ */
+ union {
+ /* Modified by threads returning memory to this chunk */
+ erts_sspa_tail_t data;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_sspa_tail_t))];
+ } tail;
+ /*
+ * Everything below this point is *only* accessed by the
+ * thread owning this chunk.
+ */
+ struct {
+ int no_thr_progress_check;
+ int used_marker;
+ erts_sspa_blk_t *first;
+ erts_sspa_blk_t *unref_end;
+ struct {
+ ErtsThrPrgrVal thr_progress;
+ int thr_progress_reached;
+ int um_refc_ix;
+ erts_sspa_blk_t *unref_end;
+ } next;
+ } head;
+ erts_sspa_local_freelist_t local;
+} erts_sspa_chunk_header_t;
+
+typedef struct {
+ union {
+ erts_sspa_chunk_header_t header;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(
+ sizeof(erts_sspa_chunk_header_t))];
+ } aligned;
+ char data[1];
+} erts_sspa_chunk_t;
+
+#ifdef DEBUG
+ERTS_GLB_INLINE void
+check_local_list(erts_sspa_chunk_header_t *chdr);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE void
+check_local_list(erts_sspa_chunk_header_t *chdr)
+{
+ erts_sspa_blk_t *blk;
+ int n = 0;
+ for (blk = chdr->local.first; blk; blk = blk->next_ptr)
+ n++;
+ ASSERT(n == chdr->local.cnt);
+}
+#endif
+#define ERTS_SSPA_DBG_CHK_LCL(CHDR) check_local_list((CHDR))
+#else
+#define ERTS_SSPA_DBG_CHK_LCL(CHDR)
+#endif
+
+erts_sspa_data_t *erts_sspa_create(size_t blk_sz,
+ int pa_size);
+void erts_sspa_remote_free(erts_sspa_chunk_header_t *chdr,
+ erts_sspa_blk_t *blk);
+erts_sspa_blk_t *erts_sspa_process_remote_frees(erts_sspa_chunk_header_t *chdr,
+ erts_sspa_blk_t *old_res);
+
+ERTS_GLB_INLINE erts_sspa_chunk_t *erts_sspa_cix2chunk(erts_sspa_data_t *data,
+ int cix);
+ERTS_GLB_INLINE int erts_sspa_ptr2cix(erts_sspa_data_t *data, void *ptr);
+ERTS_GLB_INLINE char *erts_sspa_alloc(erts_sspa_data_t *data, int cix);
+ERTS_GLB_INLINE int erts_sspa_free(erts_sspa_data_t *data, int cix, char *blk);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE erts_sspa_chunk_t *
+erts_sspa_cix2chunk(erts_sspa_data_t *data, int cix)
+{
+ ASSERT(0 <= cix && cix < erts_no_schedulers);
+ return (erts_sspa_chunk_t *) (data->start + cix*data->chunks_mem_size);
+}
+
+ERTS_GLB_INLINE int
+erts_sspa_ptr2cix(erts_sspa_data_t *data, void *ptr)
+{
+ int cix;
+ size_t diff;
+ if ((char *) ptr < data->start || data->end <= (char *) ptr)
+ return -1;
+ diff = ((char *) ptr) - data->start;
+ cix = (int) diff / data->chunks_mem_size;
+ ASSERT(0 <= cix && cix < erts_no_schedulers);
+ return cix;
+}
+
+ERTS_GLB_INLINE char *
+erts_sspa_alloc(erts_sspa_data_t *data, int cix)
+{
+ erts_sspa_chunk_t *chnk;
+ erts_sspa_chunk_header_t *chdr;
+ erts_sspa_blk_t *res;
+
+ chnk = erts_sspa_cix2chunk(data, cix);
+ chdr = &chnk->aligned.header;
+ res = chdr->local.first;
+ ERTS_SSPA_DBG_CHK_LCL(chdr);
+ if (res) {
+ ERTS_SSPA_DBG_CHK_LCL(chdr);
+ chdr->local.first = res->next_ptr;
+ chdr->local.cnt--;
+ if (!chdr->local.first)
+ chdr->local.last = NULL;
+ ERTS_SSPA_DBG_CHK_LCL(chdr);
+ }
+ if (chdr->local.cnt <= chdr->local.lim)
+ return (char *) erts_sspa_process_remote_frees(chdr, res);
+ else if (chdr->head.no_thr_progress_check < ERTS_SSPA_FORCE_THR_CHECK_PROGRESS)
+ chdr->head.no_thr_progress_check++;
+ ASSERT(res);
+ return (char *) res;
+}
+
+ERTS_GLB_INLINE int
+erts_sspa_free(erts_sspa_data_t *data, int cix, char *cblk)
+{
+ erts_sspa_chunk_t *chnk;
+ erts_sspa_chunk_header_t *chdr;
+ erts_sspa_blk_t *blk = (erts_sspa_blk_t *) cblk;
+ int chnk_cix = erts_sspa_ptr2cix(data, blk);
+
+ if (chnk_cix < 0)
+ return 0;
+
+ chnk = erts_sspa_cix2chunk(data, chnk_cix);
+ chdr = &chnk->aligned.header;
+ if (chnk_cix != cix) {
+ /* Remote chunk */
+ erts_sspa_remote_free(chdr, blk);
+ }
+ else {
+ /* Local chunk */
+ ERTS_SSPA_DBG_CHK_LCL(chdr);
+ blk->next_ptr = chdr->local.first;
+ chdr->local.first = blk;
+ if (!chdr->local.last)
+ chdr->local.last = blk;
+ chdr->local.cnt++;
+ ERTS_SSPA_DBG_CHK_LCL(chdr);
+ }
+
+ return 1;
+}
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+#endif /* ERTS_SMP */
+
+#endif /* ERTS_SCHED_SPEC_PRE_ALLOC_H__ */
diff --git a/erts/emulator/beam/erl_smp.h b/erts/emulator/beam/erl_smp.h
index a89ddfbcc1..63179dfad4 100644
--- a/erts/emulator/beam/erl_smp.h
+++ b/erts/emulator/beam/erl_smp.h
@@ -822,6 +822,16 @@ erts_smp_cnd_wait(erts_smp_cnd_t *cnd, erts_smp_mtx_t *mtx)
#endif
}
+/*
+ * IMPORTANT note about erts_smp_cnd_signal() and erts_smp_cnd_broadcast()
+ *
+ * POSIX allow a call to `pthread_cond_signal' or `pthread_cond_broadcast'
+ * even though the associated mutex/mutexes isn't/aren't locked by the
+ * caller. Our implementation do not allow that in order to avoid a
+ * performance penalty. That is, all associated mutexes *need* to be
+ * locked by the caller of erts_smp_cnd_signal()/erts_smp_cnd_broadcast()!
+ */
+
ERTS_GLB_INLINE void
erts_smp_cnd_signal(erts_smp_cnd_t *cnd)
{
diff --git a/erts/emulator/beam/erl_thr_progress.c b/erts/emulator/beam/erl_thr_progress.c
new file mode 100644
index 0000000000..9324bcde51
--- /dev/null
+++ b/erts/emulator/beam/erl_thr_progress.c
@@ -0,0 +1,1373 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2011. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/*
+ * Description: Thread progress information. Used by lock free algorithms
+ * to determine when all involved threads are guaranteed to
+ * have passed a specific point of execution.
+ *
+ * Usage instructions below.
+ *
+ * Author: Rickard Green
+ */
+
+/*
+ * ------ Usage instructions -----------------------------------------------
+ *
+ * This module keeps track of the progress of a set of managed threads. Only
+ * threads that behave well can be allowed to be managed. A managed thread
+ * should update its thread progress frequently. Currently only scheduler
+ * threads and the aux_thread are managed threads. We typically do not want
+ * any async threads as managed threads since they cannot guarantee a
+ * frequent update of thread progress, since they execute user implemented
+ * driver code.
+ *
+ * erts_thr_progress_current() returns the global current thread progress
+ * value of managed threads. I.e., the latest progress value that all
+ * managed threads have reached. Thread progress values are opaque.
+ *
+ * erts_thr_progress_has_reached(VAL) returns a value != 0 if current
+ * global thread progress has reached or passed VAL.
+ *
+ * erts_thr_progress_later() returns a thread progress value in the future
+ * which no managed thread have yet reached.
+ *
+ * All threads issue a full memory barrier when reaching a new thread
+ * progress value. They only reach new thread progress values in specific
+ * controlled states when calling erts_thr_progress_update(). Schedulers
+ * call erts_thr_progress_update() in between execution of processes,
+ * when going to sleep and when waking up.
+ *
+ * Sleeping managed threads are considered to have reached next thread
+ * progress value immediately. They are not woken and do therefore not
+ * issue any memory barriers when reaching a new thread progress value.
+ * A sleeping thread do however immediately issue a memory barrier upon
+ * wakeup.
+ *
+ * Both managed and registered unmanaged threads may request wakeup when
+ * the global thread progress reach a certain value using
+ * erts_thr_progress_wakeup().
+ *
+ * Note that thread progress values are opaque, and that you are only
+ * allowed to use thread progress values retrieved from this API!
+ *
+ * -------------------------------------------------------------------------
+ */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <stddef.h> /* offsetof() */
+#include "erl_thr_progress.h"
+#include "global.h"
+
+#ifdef ERTS_SMP
+
+/*
+ * We use a 64-bit value for thread progress. By this wrapping of
+ * the thread progress will more or less never occur.
+ *
+ * On 32-bit systems we therefore need a double word atomic.
+ */
+
+#define ERTS_THR_PRGR_PRINT_LEADER 0
+#define ERTS_THR_PRGR_PRINT_VAL 0
+#define ERTS_THR_PRGR_PRINT_BLOCKERS 0
+
+#define ERTS_THR_PRGR_FTL_ERR_BLCK_POLL_INTERVAL 100
+
+#define ERTS_THR_PRGR_LFLG_BLOCK (((erts_aint32_t) 1) << 31)
+#define ERTS_THR_PRGR_LFLG_NO_LEADER (((erts_aint32_t) 1) << 30)
+#define ERTS_THR_PRGR_LFLG_ACTIVE_MASK (~(ERTS_THR_PRGR_LFLG_NO_LEADER \
+ | ERTS_THR_PRGR_LFLG_BLOCK))
+
+#define ERTS_THR_PRGR_LFLGS_ACTIVE(LFLGS) \
+ ((LFLGS) & ERTS_THR_PRGR_LFLG_ACTIVE_MASK)
+
+#define ERTS_THR_PRGR_LFLGS_ALL_WAITING(LFLGS) \
+ (((LFLGS) & (ERTS_THR_PRGR_LFLG_NO_LEADER \
+ |ERTS_THR_PRGR_LFLG_ACTIVE_MASK)) \
+ == ERTS_THR_PRGR_LFLG_NO_LEADER)
+
+#define read_acqb erts_thr_prgr_read_acqb__
+
+#ifdef ARCH_64
+
+static ERTS_INLINE void
+set_mb(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val)
+{
+ erts_atomic_set_mb(atmc, val);
+}
+
+static ERTS_INLINE void
+set_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val)
+{
+ erts_atomic_set_nob(atmc, val);
+}
+
+static ERTS_INLINE ErtsThrPrgrVal
+read_nob(ERTS_THR_PRGR_ATOMIC *atmc)
+{
+ return (ErtsThrPrgrVal) erts_atomic_read_nob(atmc);
+}
+
+static ERTS_INLINE void
+init_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val)
+{
+ erts_atomic_init_nob(atmc, val);
+}
+
+#else
+
+#undef dw_sint_to_val
+#define dw_sint_to_val erts_thr_prgr_dw_sint_to_val__
+
+static void
+val_to_dw_sint(ethr_dw_sint_t *dw_sint, ErtsThrPrgrVal val)
+{
+#ifdef ETHR_SU_DW_NAINT_T__
+ dw_sint->dw_sint = (ETHR_SU_DW_NAINT_T__) val;
+#else
+ dw_sint->sint[ETHR_DW_SINT_LOW_WORD]
+ = (ethr_sint_t) (val & 0xffffffff);
+ dw_sint->sint[ETHR_DW_SINT_HIGH_WORD]
+ = (ethr_sint_t) ((val >> 32) & 0xffffffff);
+#endif
+}
+
+static ERTS_INLINE void
+set_mb(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val)
+{
+ ethr_dw_sint_t dw_sint;
+ val_to_dw_sint(&dw_sint, val);
+ erts_dw_atomic_set_mb(atmc, &dw_sint);
+}
+
+static ERTS_INLINE void
+set_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val)
+{
+ ethr_dw_sint_t dw_sint;
+ val_to_dw_sint(&dw_sint, val);
+ erts_dw_atomic_set_nob(atmc, &dw_sint);
+}
+
+static ERTS_INLINE ErtsThrPrgrVal
+read_nob(ERTS_THR_PRGR_ATOMIC *atmc)
+{
+ ethr_dw_sint_t dw_sint;
+ erts_dw_atomic_read_nob(atmc, &dw_sint);
+ return erts_thr_prgr_dw_sint_to_val__(&dw_sint);
+}
+
+static ERTS_INLINE void
+init_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val)
+{
+ ethr_dw_sint_t dw_sint;
+ val_to_dw_sint(&dw_sint, val);
+ erts_dw_atomic_init_nob(atmc, &dw_sint);
+}
+
+#endif
+
+/* #define ERTS_THR_PROGRESS_STATE_DEBUG */
+
+#ifdef ERTS_THR_PROGRESS_STATE_DEBUG
+
+#ifdef __GNUC__
+#warning "Thread progress state debug is on"
+#endif
+
+#define ERTS_THR_PROGRESS_STATE_DEBUG_LEADER (((erts_aint32_t) 1) << 0)
+#define ERTS_THR_PROGRESS_STATE_DEBUG_ACTIVE (((erts_aint32_t) 1) << 1)
+
+#define ERTS_THR_PROGRESS_STATE_DEBUG_INIT(ID) \
+ erts_atomic32_init_nob(&intrnl->thr[(ID)].data.state_debug, \
+ ERTS_THR_PROGRESS_STATE_DEBUG_ACTIVE)
+
+#define ERTS_THR_PROGRESS_STATE_DEBUG_SET_ACTIVE(ID, ON) \
+do { \
+ erts_aint32_t state_debug__; \
+ state_debug__ = erts_atomic32_read_nob(&intrnl->thr[(ID)].data.state_debug); \
+ if ((ON)) \
+ state_debug__ |= ERTS_THR_PROGRESS_STATE_DEBUG_ACTIVE; \
+ else \
+ state_debug__ &= ~ERTS_THR_PROGRESS_STATE_DEBUG_ACTIVE; \
+ erts_atomic32_set_nob(&intrnl->thr[(ID)].data.state_debug, state_debug__); \
+} while (0)
+
+#define ERTS_THR_PROGRESS_STATE_DEBUG_SET_LEADER(ID, ON) \
+do { \
+ erts_aint32_t state_debug__; \
+ state_debug__ = erts_atomic32_read_nob(&intrnl->thr[(ID)].data.state_debug); \
+ if ((ON)) \
+ state_debug__ |= ERTS_THR_PROGRESS_STATE_DEBUG_LEADER; \
+ else \
+ state_debug__ &= ~ERTS_THR_PROGRESS_STATE_DEBUG_LEADER; \
+ erts_atomic32_set_nob(&intrnl->thr[(ID)].data.state_debug, state_debug__); \
+} while (0)
+
+#else
+
+#define ERTS_THR_PROGRESS_STATE_DEBUG_INIT(ID)
+#define ERTS_THR_PROGRESS_STATE_DEBUG_SET_ACTIVE(ID, ON)
+#define ERTS_THR_PROGRESS_STATE_DEBUG_SET_LEADER(ID, ON)
+
+#endif /* ERTS_THR_PROGRESS_STATE_DEBUG */
+
+#define ERTS_THR_PRGR_BLCKR_INVALID (~((erts_aint32_t) 0))
+#define ERTS_THR_PRGR_BLCKR_UNMANAGED (((erts_aint32_t) 1) << 31)
+
+#define ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING (((erts_aint32_t) 1) << 31)
+
+#define ERTS_THR_PRGR_BM_BITS 32
+#define ERTS_THR_PRGR_BM_SHIFT 5
+#define ERTS_THR_PRGR_BM_MASK 0x1f
+
+#define ERTS_THR_PRGR_WAKEUP_DATA_MASK (ERTS_THR_PRGR_WAKEUP_DATA_SIZE - 1)
+
+#define ERTS_THR_PRGR_WAKEUP_IX(V) \
+ ((int) ((V) & ERTS_THR_PRGR_WAKEUP_DATA_MASK))
+
+typedef struct {
+ erts_atomic32_t len;
+ int id[1];
+} ErtsThrPrgrManagedWakeupData;
+
+typedef struct {
+ erts_atomic32_t len;
+ int high_sz;
+ int low_sz;
+ erts_atomic32_t *high;
+ erts_atomic32_t *low;
+} ErtsThrPrgrUnmanagedWakeupData;
+
+typedef struct {
+ erts_atomic32_t lflgs;
+ erts_atomic32_t block_count;
+ erts_atomic_t blocker_event;
+ erts_atomic32_t pref_wakeup_used;
+ erts_atomic32_t managed_count;
+ erts_atomic32_t managed_id;
+ erts_atomic32_t unmanaged_id;
+} ErtsThrPrgrMiscData;
+
+typedef struct {
+ ERTS_THR_PRGR_ATOMIC current;
+#ifdef ERTS_THR_PROGRESS_STATE_DEBUG
+ erts_atomic32_t state_debug;
+#endif
+} ErtsThrPrgrElement;
+
+typedef union {
+ ErtsThrPrgrElement data;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsThrPrgrElement))];
+} ErtsThrPrgrArray;
+
+typedef struct {
+ union {
+ ErtsThrPrgrMiscData data;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(
+ sizeof(ErtsThrPrgrMiscData))];
+ } misc;
+ ErtsThrPrgrArray *thr;
+ struct {
+ int no;
+ ErtsThrPrgrCallbacks *callbacks;
+ ErtsThrPrgrManagedWakeupData *data[ERTS_THR_PRGR_WAKEUP_DATA_SIZE];
+ } managed;
+ struct {
+ int no;
+ ErtsThrPrgrCallbacks *callbacks;
+ ErtsThrPrgrUnmanagedWakeupData *data[ERTS_THR_PRGR_WAKEUP_DATA_SIZE];
+ } unmanaged;
+} ErtsThrPrgrInternalData;
+
+static ErtsThrPrgrInternalData *intrnl;
+
+ErtsThrPrgr erts_thr_prgr__;
+
+erts_tsd_key_t erts_thr_prgr_data_key__;
+
+static void handle_wakeup_requests(ErtsThrPrgrVal current);
+static int got_sched_wakeups(void);
+static erts_aint32_t block_thread(ErtsThrPrgrData *tpd);
+
+static ERTS_INLINE void
+wakeup_managed(int id)
+{
+ ErtsThrPrgrCallbacks *cbp = &intrnl->managed.callbacks[id];
+ ASSERT(0 <= id && id < intrnl->managed.no);
+ cbp->wakeup(cbp->arg);
+}
+
+
+static ERTS_INLINE void
+wakeup_unmanaged(int id)
+{
+ ErtsThrPrgrCallbacks *cbp = &intrnl->unmanaged.callbacks[id];
+ ASSERT(0 <= id && id < intrnl->unmanaged.no);
+ cbp->wakeup(cbp->arg);
+}
+
+static ERTS_INLINE ErtsThrPrgrData *
+perhaps_thr_prgr_data(ErtsSchedulerData *esdp)
+{
+ if (esdp)
+ return &esdp->thr_progress_data;
+ else
+ return erts_tsd_get(erts_thr_prgr_data_key__);
+}
+
+static ERTS_INLINE ErtsThrPrgrData *
+thr_prgr_data(ErtsSchedulerData *esdp)
+{
+ ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(esdp);
+ ASSERT(tpd);
+ return tpd;
+}
+
+static void
+init_tmp_thr_prgr_data(ErtsThrPrgrData *tpd)
+{
+ tpd->id = -1;
+ tpd->is_managed = 0;
+ tpd->is_blocking = 0;
+ tpd->is_temporary = 1;
+
+ erts_tsd_set(erts_thr_prgr_data_key__, (void *) tpd);
+}
+
+static ERTS_INLINE ErtsThrPrgrData *
+tmp_thr_prgr_data(ErtsSchedulerData *esdp)
+{
+ ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(esdp);
+
+ if (!tpd) {
+ /*
+ * We only allocate the part up to the wakeup_request field
+ * which is the first field only used by registered threads
+ */
+ tpd = erts_alloc(ERTS_ALC_T_T_THR_PRGR_DATA,
+ offsetof(ErtsThrPrgrData, wakeup_request));
+ init_tmp_thr_prgr_data(tpd);
+ }
+
+ return tpd;
+}
+
+static ERTS_INLINE void
+return_tmp_thr_prgr_data(ErtsThrPrgrData *tpd)
+{
+ if (tpd->is_temporary) {
+ erts_tsd_set(erts_thr_prgr_data_key__, NULL);
+ erts_free(ERTS_ALC_T_T_THR_PRGR_DATA, tpd);
+ }
+}
+
+static ERTS_INLINE int
+block_count_dec(void)
+{
+ erts_aint32_t block_count;
+ block_count = erts_atomic32_dec_read_mb(&intrnl->misc.data.block_count);
+ if (block_count == 0) {
+ erts_tse_t *event;
+ event = ((erts_tse_t*)
+ erts_atomic_read_nob(&intrnl->misc.data.blocker_event));
+ if (event)
+ erts_tse_set(event);
+ return 1;
+ }
+
+ return (block_count & ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING) == 0;
+}
+
+static ERTS_INLINE int
+block_count_inc(void)
+{
+ erts_aint32_t block_count;
+ block_count = erts_atomic32_inc_read_mb(&intrnl->misc.data.block_count);
+ return (block_count & ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING) == 0;
+}
+
+
+void
+erts_thr_progress_pre_init(void)
+{
+ intrnl = NULL;
+ erts_tsd_key_create(&erts_thr_prgr_data_key__);
+ init_nob(&erts_thr_prgr__.current, 0);
+}
+
+void
+erts_thr_progress_init(int no_schedulers, int managed, int unmanaged)
+{
+ int i, j, um_low, um_high;
+ char *ptr;
+ size_t cb_sz, intrnl_sz, thr_arr_sz, m_wakeup_size, um_wakeup_size,
+ tot_size;
+
+ intrnl_sz = sizeof(ErtsThrPrgrInternalData);
+ intrnl_sz = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(intrnl_sz);
+
+ cb_sz = sizeof(ErtsThrPrgrCallbacks)*(managed+unmanaged);
+ cb_sz = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(cb_sz);
+
+ thr_arr_sz = sizeof(ErtsThrPrgrArray)*managed;
+ ASSERT(thr_arr_sz == ERTS_ALC_CACHE_LINE_ALIGN_SIZE(thr_arr_sz));
+
+ m_wakeup_size = sizeof(ErtsThrPrgrManagedWakeupData);
+ m_wakeup_size += (managed - 1)*sizeof(int);
+ m_wakeup_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(m_wakeup_size);
+
+ um_low = (unmanaged - 1)/ERTS_THR_PRGR_BM_BITS + 1;
+ um_high = (um_low - 1)/ERTS_THR_PRGR_BM_BITS + 1;
+
+ um_wakeup_size = sizeof(ErtsThrPrgrUnmanagedWakeupData);
+ um_wakeup_size += (um_high + um_low)*sizeof(erts_atomic32_t);
+ um_wakeup_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(um_wakeup_size);
+
+ tot_size = intrnl_sz;
+ tot_size += cb_sz;
+ tot_size += thr_arr_sz;
+ tot_size += m_wakeup_size*ERTS_THR_PRGR_WAKEUP_DATA_SIZE;
+ tot_size += um_wakeup_size*ERTS_THR_PRGR_WAKEUP_DATA_SIZE;
+
+ ptr = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_THR_PRGR_IDATA,
+ tot_size);
+
+ intrnl = (ErtsThrPrgrInternalData *) ptr;
+ ptr += intrnl_sz;
+
+ erts_atomic32_init_nob(&intrnl->misc.data.lflgs,
+ ERTS_THR_PRGR_LFLG_NO_LEADER);
+ erts_atomic32_init_nob(&intrnl->misc.data.block_count,
+ (ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING
+ | (erts_aint32_t) managed));
+ erts_atomic_init_nob(&intrnl->misc.data.blocker_event, ERTS_AINT_NULL);
+ erts_atomic32_init_nob(&intrnl->misc.data.pref_wakeup_used, 0);
+ erts_atomic32_init_nob(&intrnl->misc.data.managed_count, 0);
+ erts_atomic32_init_nob(&intrnl->misc.data.managed_id, no_schedulers);
+ erts_atomic32_init_nob(&intrnl->misc.data.unmanaged_id, -1);
+
+ intrnl->thr = (ErtsThrPrgrArray *) ptr;
+ ptr += thr_arr_sz;
+ for (i = 0; i < managed; i++)
+ init_nob(&intrnl->thr[i].data.current, 0);
+
+ intrnl->managed.callbacks = (ErtsThrPrgrCallbacks *) ptr;
+ intrnl->unmanaged.callbacks = &intrnl->managed.callbacks[managed];
+ ptr += cb_sz;
+
+ intrnl->managed.no = managed;
+ for (i = 0; i < managed; i++) {
+ intrnl->managed.callbacks[i].arg = NULL;
+ intrnl->managed.callbacks[i].wakeup = NULL;
+ }
+
+ intrnl->unmanaged.no = unmanaged;
+ for (i = 0; i < unmanaged; i++) {
+ intrnl->unmanaged.callbacks[i].arg = NULL;
+ intrnl->unmanaged.callbacks[i].wakeup = NULL;
+ }
+
+ for (i = 0; i < ERTS_THR_PRGR_WAKEUP_DATA_SIZE; i++) {
+ intrnl->managed.data[i] = (ErtsThrPrgrManagedWakeupData *) ptr;
+ erts_atomic32_init_nob(&intrnl->managed.data[i]->len, 0);
+ ptr += m_wakeup_size;
+ }
+
+ for (i = 0; i < ERTS_THR_PRGR_WAKEUP_DATA_SIZE; i++) {
+ erts_atomic32_t *bm;
+ intrnl->unmanaged.data[i] = (ErtsThrPrgrUnmanagedWakeupData *) ptr;
+ erts_atomic32_init_nob(&intrnl->unmanaged.data[i]->len, 0);
+ bm = (erts_atomic32_t *) (ptr + sizeof(ErtsThrPrgrUnmanagedWakeupData));
+ intrnl->unmanaged.data[i]->high = bm;
+ intrnl->unmanaged.data[i]->high_sz = um_high;
+ for (j = 0; j < um_high; j++)
+ erts_atomic32_init_nob(&intrnl->unmanaged.data[i]->high[j], 0);
+ intrnl->unmanaged.data[i]->low
+ = &intrnl->unmanaged.data[i]->high[um_high];
+ intrnl->unmanaged.data[i]->low_sz = um_low;
+ for (j = 0; j < um_low; j++)
+ erts_atomic32_init_nob(&intrnl->unmanaged.data[i]->low[j], 0);
+ ptr += um_wakeup_size;
+ }
+ ERTS_THR_MEMORY_BARRIER;
+}
+
+static void
+init_wakeup_request_array(ErtsThrPrgrVal *w)
+{
+ int i;
+ ErtsThrPrgrVal current;
+
+ current = read_acqb(&erts_thr_prgr__.current);
+ for (i = 0; i < ERTS_THR_PRGR_WAKEUP_DATA_SIZE; i++) {
+ w[i] = current - ((ErtsThrPrgrVal) (ERTS_THR_PRGR_WAKEUP_DATA_SIZE + i));
+ if (w[i] > current)
+ w[i]--;
+ }
+}
+
+void
+erts_thr_progress_register_unmanaged_thread(ErtsThrPrgrCallbacks *callbacks)
+{
+ ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(NULL);
+ int is_blocking = 0;
+
+ if (tpd) {
+ if (!tpd->is_temporary)
+ erl_exit(ERTS_ABORT_EXIT,
+ "%s:%d:%s(): Double register of thread\n",
+ __FILE__, __LINE__, __func__);
+ is_blocking = tpd->is_blocking;
+ return_tmp_thr_prgr_data(tpd);
+ }
+
+ /*
+ * We only allocate the part up to the leader field
+ * which is the first field only used by managed threads
+ */
+ tpd = erts_alloc(ERTS_ALC_T_THR_PRGR_DATA,
+ offsetof(ErtsThrPrgrData, leader));
+ tpd->id = (int) erts_atomic32_inc_read_nob(&intrnl->misc.data.unmanaged_id);
+ tpd->is_managed = 0;
+ tpd->is_blocking = is_blocking;
+ tpd->is_temporary = 0;
+ ASSERT(tpd->id >= 0);
+ if (tpd->id >= intrnl->unmanaged.no)
+ erl_exit(ERTS_ABORT_EXIT,
+ "%s:%d:%s(): Too many unmanaged registered threads\n",
+ __FILE__, __LINE__, __func__);
+
+ init_wakeup_request_array(&tpd->wakeup_request[0]);
+ erts_tsd_set(erts_thr_prgr_data_key__, (void *) tpd);
+
+ ASSERT(callbacks->wakeup);
+
+ intrnl->unmanaged.callbacks[tpd->id] = *callbacks;
+}
+
+
+void
+erts_thr_progress_register_managed_thread(ErtsSchedulerData *esdp,
+ ErtsThrPrgrCallbacks *callbacks,
+ int pref_wakeup)
+{
+ ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(NULL);
+ int is_blocking = 0, managed;
+
+ if (tpd) {
+ if (!tpd->is_temporary)
+ erl_exit(ERTS_ABORT_EXIT,
+ "%s:%d:%s(): Double register of thread\n",
+ __FILE__, __LINE__, __func__);
+ is_blocking = tpd->is_blocking;
+ return_tmp_thr_prgr_data(tpd);
+ }
+
+ if (esdp)
+ tpd = &esdp->thr_progress_data;
+ else
+ tpd = erts_alloc(ERTS_ALC_T_THR_PRGR_DATA, sizeof(ErtsThrPrgrData));
+
+ if (pref_wakeup
+ && !erts_atomic32_xchg_nob(&intrnl->misc.data.pref_wakeup_used, 1))
+ tpd->id = 0;
+ else if (esdp)
+ tpd->id = (int) esdp->no;
+ else
+ tpd->id = erts_atomic32_inc_read_nob(&intrnl->misc.data.managed_id);
+ ASSERT(tpd->id >= 0);
+ if (tpd->id >= intrnl->managed.no)
+ erl_exit(ERTS_ABORT_EXIT,
+ "%s:%d:%s(): Too many managed registered threads\n",
+ __FILE__, __LINE__, __func__);
+
+ tpd->is_managed = 1;
+ tpd->is_blocking = is_blocking;
+ tpd->is_temporary = 0;
+
+ init_wakeup_request_array(&tpd->wakeup_request[0]);
+
+ ERTS_THR_PROGRESS_STATE_DEBUG_INIT(tpd->id);
+
+ tpd->leader = 0;
+ tpd->active = 1;
+ tpd->previous.local = 0;
+ tpd->previous.current = ERTS_THR_PRGR_VAL_WAITING;
+ erts_tsd_set(erts_thr_prgr_data_key__, (void *) tpd);
+
+ erts_atomic32_inc_nob(&intrnl->misc.data.lflgs);
+
+ ASSERT(callbacks->wakeup);
+ ASSERT(callbacks->prepare_wait);
+ ASSERT(callbacks->wait);
+ ASSERT(callbacks->finalize_wait);
+
+ intrnl->managed.callbacks[tpd->id] = *callbacks;
+
+ callbacks->prepare_wait(callbacks->arg);
+ managed = erts_atomic32_inc_read_relb(&intrnl->misc.data.managed_count);
+ if (managed != intrnl->managed.no) {
+ /* Wait until all managed threads have registered... */
+ do {
+ callbacks->wait(callbacks->arg);
+ callbacks->prepare_wait(callbacks->arg);
+ managed = erts_atomic32_read_acqb(&intrnl->misc.data.managed_count);
+ } while (managed != intrnl->managed.no);
+ }
+ else {
+ int id;
+ /* All managed threads have registered; lets go... */
+ for (id = 0; id < managed; id++)
+ if (id != tpd->id)
+ wakeup_managed(id);
+ }
+ callbacks->finalize_wait(callbacks->arg);
+}
+
+static ERTS_INLINE int
+leader_update(ErtsThrPrgrData *tpd)
+{
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ erts_lc_check_exact(NULL, 0);
+#endif
+ if (!tpd->leader) {
+ /* Probably need to block... */
+ block_thread(tpd);
+ }
+ else {
+ erts_aint32_t lflgs;
+ ErtsThrPrgrVal next;
+ int ix, sz, make_progress;
+
+ if (tpd->previous.current == ERTS_THR_PRGR_VAL_WAITING) {
+ /* Took over as leader from another thread */
+ tpd->previous.current = read_acqb(&erts_thr_prgr__.current);
+ tpd->previous.next = tpd->previous.current;
+ tpd->previous.next++;
+ if (tpd->previous.next == ERTS_THR_PRGR_VAL_WAITING)
+ tpd->previous.next = 0;
+ }
+
+ if (tpd->previous.local == tpd->previous.current) {
+ ErtsThrPrgrVal val = tpd->previous.current + 1;
+ if (val == ERTS_THR_PRGR_VAL_WAITING)
+ val = 0;
+ tpd->previous.local = val;
+ set_mb(&intrnl->thr[tpd->id].data.current, val);
+ }
+
+ next = tpd->previous.next;
+
+ make_progress = 1;
+ sz = intrnl->managed.no;
+ for (ix = 0; ix < sz; ix++) {
+ ErtsThrPrgrVal tmp;
+ tmp = read_nob(&intrnl->thr[ix].data.current);
+ if (tmp != next && tmp != ERTS_THR_PRGR_VAL_WAITING) {
+ make_progress = 0;
+ ASSERT(erts_thr_progress_has_passed__(next, tmp));
+ break;
+ }
+ }
+
+ if (make_progress) {
+ ErtsThrPrgrVal current = next;
+
+ next++;
+ if (next == ERTS_THR_PRGR_VAL_WAITING)
+ next = 0;
+
+ set_nob(&intrnl->thr[tpd->id].data.current, next);
+ set_mb(&erts_thr_prgr__.current, current);
+ tpd->previous.local = next;
+ tpd->previous.next = next;
+ tpd->previous.current = current;
+
+#if ERTS_THR_PRGR_PRINT_VAL
+ if (current % 1000 == 0)
+ erts_fprintf(stderr, "%b64u\n", current);
+#endif
+ handle_wakeup_requests(current);
+ }
+
+ if (tpd->active) {
+ lflgs = erts_atomic32_read_nob(&intrnl->misc.data.lflgs);
+ if (lflgs & ERTS_THR_PRGR_LFLG_BLOCK)
+ (void) block_thread(tpd);
+ }
+ else {
+ tpd->leader = 0;
+ tpd->previous.current = ERTS_THR_PRGR_VAL_WAITING;
+#if ERTS_THR_PRGR_PRINT_LEADER
+ erts_fprintf(stderr, "L <- %d\n", tpd->id);
+#endif
+
+ ERTS_THR_PROGRESS_STATE_DEBUG_SET_LEADER(tpd->id, 0);
+
+ lflgs = erts_atomic32_read_bor_relb(&intrnl->misc.data.lflgs,
+ ERTS_THR_PRGR_LFLG_NO_LEADER);
+ if (lflgs & ERTS_THR_PRGR_LFLG_BLOCK)
+ lflgs = block_thread(tpd);
+ if (ERTS_THR_PRGR_LFLGS_ACTIVE(lflgs) == 0 && got_sched_wakeups())
+ wakeup_managed(0);
+ }
+ }
+
+ return tpd->leader;
+}
+
+static int
+update(ErtsThrPrgrData *tpd)
+{
+ int res;
+ ErtsThrPrgrVal val;
+
+ if (tpd->leader)
+ res = 1;
+ else {
+ erts_aint32_t lflgs;
+ res = 0;
+ val = read_acqb(&erts_thr_prgr__.current);
+ if (tpd->previous.local == val) {
+ val++;
+ if (val == ERTS_THR_PRGR_VAL_WAITING)
+ val = 0;
+ tpd->previous.local = val;
+ set_mb(&intrnl->thr[tpd->id].data.current, val);
+ }
+
+ lflgs = erts_atomic32_read_nob(&intrnl->misc.data.lflgs);
+ if (lflgs & ERTS_THR_PRGR_LFLG_BLOCK)
+ res = 1; /* Need to block in leader_update() */
+
+ if ((lflgs & ERTS_THR_PRGR_LFLG_NO_LEADER)
+ && (tpd->active || ERTS_THR_PRGR_LFLGS_ACTIVE(lflgs) == 0)) {
+ /* Try to take over leadership... */
+ erts_aint32_t olflgs;
+ olflgs = erts_atomic32_read_band_acqb(
+ &intrnl->misc.data.lflgs,
+ ~ERTS_THR_PRGR_LFLG_NO_LEADER);
+ if (olflgs & ERTS_THR_PRGR_LFLG_NO_LEADER) {
+ tpd->leader = 1;
+#if ERTS_THR_PRGR_PRINT_LEADER
+ erts_fprintf(stderr, "L -> %d\n", tpd->id);
+#endif
+ ERTS_THR_PROGRESS_STATE_DEBUG_SET_LEADER(tpd->id, 1);
+ }
+ }
+ res |= tpd->leader;
+ }
+ return res;
+}
+
+int
+erts_thr_progress_update(ErtsSchedulerData *esdp)
+{
+ return update(thr_prgr_data(esdp));
+}
+
+
+int
+erts_thr_progress_leader_update(ErtsSchedulerData *esdp)
+{
+ return leader_update(thr_prgr_data(esdp));
+}
+
+void
+erts_thr_progress_prepare_wait(ErtsSchedulerData *esdp)
+{
+ erts_aint32_t lflgs;
+ ErtsThrPrgrData *tpd = thr_prgr_data(esdp);
+
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ erts_lc_check_exact(NULL, 0);
+#endif
+
+ block_count_dec();
+
+ tpd->previous.local = ERTS_THR_PRGR_VAL_WAITING;
+ set_mb(&intrnl->thr[tpd->id].data.current, ERTS_THR_PRGR_VAL_WAITING);
+
+ lflgs = erts_atomic32_read_nob(&intrnl->misc.data.lflgs);
+ if (ERTS_THR_PRGR_LFLGS_ALL_WAITING(lflgs) && got_sched_wakeups())
+ wakeup_managed(0); /* Someone need to make progress */
+}
+
+void
+erts_thr_progress_finalize_wait(ErtsSchedulerData *esdp)
+{
+ ErtsThrPrgrData *tpd = thr_prgr_data(esdp);
+ ErtsThrPrgrVal current, val;
+
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ erts_lc_check_exact(NULL, 0);
+#endif
+
+ /*
+ * We aren't allowed to continue until our thread
+ * progress is past global current.
+ */
+ val = current = read_acqb(&erts_thr_prgr__.current);
+ while (1) {
+ val++;
+ if (val == ERTS_THR_PRGR_VAL_WAITING)
+ val = 0;
+ tpd->previous.local = val;
+ set_mb(&intrnl->thr[tpd->id].data.current, val);
+ val = read_acqb(&erts_thr_prgr__.current);
+ if (current == val)
+ break;
+ current = val;
+ }
+ if (block_count_inc())
+ block_thread(tpd);
+ if (update(tpd))
+ leader_update(tpd);
+}
+
+void
+erts_thr_progress_active(ErtsSchedulerData *esdp, int on)
+{
+ ErtsThrPrgrData *tpd = thr_prgr_data(esdp);
+
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ erts_lc_check_exact(NULL, 0);
+#endif
+
+ ERTS_THR_PROGRESS_STATE_DEBUG_SET_ACTIVE(tpd->id, on);
+
+ if (on) {
+ ASSERT(!tpd->active);
+ tpd->active = 1;
+ erts_atomic32_inc_nob(&intrnl->misc.data.lflgs);
+ }
+ else {
+ ASSERT(tpd->active);
+ tpd->active = 0;
+ erts_atomic32_dec_nob(&intrnl->misc.data.lflgs);
+ if (update(tpd))
+ leader_update(tpd);
+ }
+
+#ifdef DEBUG
+ {
+ erts_aint32_t n = erts_atomic32_read_nob(&intrnl->misc.data.lflgs);
+ n &= ERTS_THR_PRGR_LFLG_ACTIVE_MASK;
+ ASSERT(tpd->active <= n && n <= intrnl->managed.no);
+ }
+#endif
+
+}
+
+static ERTS_INLINE int
+has_reached_wakeup(ErtsThrPrgrVal wakeup)
+{
+ /*
+ * Exactly the same as erts_thr_progress_has_reached(), but
+ * also verify valid wakeup requests in debug mode.
+ */
+ ErtsThrPrgrVal current;
+
+ current = read_acqb(&erts_thr_prgr__.current);
+
+#if ERTS_THR_PRGR_DBG_CHK_WAKEUP_REQUEST_VALUE
+ {
+ ErtsThrPrgrVal limit;
+ /*
+ * erts_thr_progress_later() returns values which are
+ * equal to 'current + 2'. That is, users should never
+ * get a hold of values larger than that.
+ *
+ * That is, valid values are values less than 'current + 3'.
+ *
+ * Values larger than this won't work with the wakeup
+ * algorithm.
+ */
+
+ limit = current + 3;
+ if (limit == ERTS_THR_PRGR_VAL_WAITING)
+ limit = 0;
+ else if (limit < current) /* Wrapped */
+ limit + 1;
+
+ if (!erts_thr_progress_has_passed__(limit, wakeup))
+ erl_exit(ERTS_ABORT_EXIT,
+ "Invalid wakeup request value found:"
+ " current=%b64u, wakeup=%b64u, limit=%b64u",
+ current, wakeup, limit);
+ }
+#endif
+
+ if (current == wakeup)
+ return 1;
+ return erts_thr_progress_has_passed__(current, wakeup);
+}
+
+static void
+request_wakeup_managed(ErtsThrPrgrData *tpd, ErtsThrPrgrVal value)
+{
+ ErtsThrPrgrManagedWakeupData *mwd;
+ int ix, wix;
+
+ /*
+ * Only managed threads that aren't in waiting state
+ * are allowed to call this function.
+ */
+
+ ASSERT(tpd->is_managed);
+ ASSERT(tpd->previous.local != ERTS_THR_PRGR_VAL_WAITING);
+
+ if (has_reached_wakeup(value))
+ wakeup_managed(tpd->id);
+
+ wix = ERTS_THR_PRGR_WAKEUP_IX(value);
+ if (tpd->wakeup_request[wix] == value)
+ return; /* Already got a request registered */
+
+ ASSERT(erts_thr_progress_has_passed__(value,
+ tpd->wakeup_request[wix]));
+
+
+ if (tpd->previous.local == value) {
+ /*
+ * We have already confirmed this value. We need to request
+ * wakeup for a value later than our latest confirmed value in
+ * order to prevent progress from reaching the requested value
+ * while we are writing the request.
+ *
+ * It is ok to move the wakeup request forward since the only
+ * guarantee we make (and can make) is that the thread will be
+ * woken some time *after* the requested value has been reached.
+ */
+ value++;
+ if (value == ERTS_THR_PRGR_VAL_WAITING)
+ value = 0;
+
+ wix = ERTS_THR_PRGR_WAKEUP_IX(value);
+ if (tpd->wakeup_request[wix] == value)
+ return; /* Already got a request registered */
+
+ ASSERT(erts_thr_progress_has_passed__(value,
+ tpd->wakeup_request[wix]));
+ }
+
+ tpd->wakeup_request[wix] = value;
+
+ mwd = intrnl->managed.data[wix];
+
+ ix = erts_atomic32_inc_read_nob(&mwd->len) - 1;
+ mwd->id[ix] = tpd->id;
+
+ ASSERT(!erts_thr_progress_has_reached(value));
+
+ /*
+ * This thread is guarranteed to issue a full memory barrier:
+ * - after the request has been written, but
+ * - before the global thread progress reach the (possibly
+ * increased) requested wakeup value.
+ */
+}
+
+static void
+request_wakeup_unmanaged(ErtsThrPrgrData *tpd, ErtsThrPrgrVal value)
+{
+ int wix, ix, id, bit;
+ ErtsThrPrgrUnmanagedWakeupData *umwd;
+
+ ASSERT(!tpd->is_managed);
+
+ /*
+ * Thread progress *can* reach and pass our requested value while
+ * we are writing the request.
+ */
+
+ if (has_reached_wakeup(value))
+ wakeup_unmanaged(tpd->id);
+
+ wix = ERTS_THR_PRGR_WAKEUP_IX(value);
+
+ if (tpd->wakeup_request[wix] == value)
+ return; /* Already got a request registered */
+
+ ASSERT(erts_thr_progress_has_passed__(value,
+ tpd->wakeup_request[wix]));
+
+ umwd = intrnl->unmanaged.data[wix];
+
+ id = tpd->id;
+
+ bit = id & ERTS_THR_PRGR_BM_MASK;
+ ix = id >> ERTS_THR_PRGR_BM_SHIFT;
+ ASSERT(0 <= ix && ix < umwd->low_sz);
+ erts_atomic32_read_bor_nob(&umwd->low[ix], 1 << bit);
+
+ bit = ix & ERTS_THR_PRGR_BM_MASK;
+ ix >>= ERTS_THR_PRGR_BM_SHIFT;
+ ASSERT(0 <= ix && ix < umwd->high_sz);
+ erts_atomic32_read_bor_nob(&umwd->high[ix], 1 << bit);
+
+ erts_atomic32_inc_mb(&umwd->len);
+
+ if (erts_thr_progress_has_reached(value))
+ wakeup_unmanaged(tpd->id);
+ else
+ tpd->wakeup_request[wix] = value;
+}
+
+void
+erts_thr_progress_wakeup(ErtsSchedulerData *esdp,
+ ErtsThrPrgrVal value)
+{
+ ErtsThrPrgrData *tpd = thr_prgr_data(esdp);
+ ASSERT(!tpd->is_temporary);
+ if (tpd->is_managed)
+ request_wakeup_managed(tpd, value);
+ else
+ request_wakeup_unmanaged(tpd, value);
+}
+
+static void
+wakeup_unmanaged_threads(ErtsThrPrgrUnmanagedWakeupData *umwd)
+{
+ int hix;
+ for (hix = 0; hix < umwd->high_sz; hix++) {
+ erts_aint32_t hmask = erts_atomic32_read_nob(&umwd->high[hix]);
+ if (hmask) {
+ int hbase = hix << ERTS_THR_PRGR_BM_SHIFT;
+ int hbit;
+ for (hbit = 0; hbit < ERTS_THR_PRGR_BM_BITS; hbit++) {
+ if (hmask & (1 << hbit)) {
+ erts_aint_t lmask;
+ int lix = hbase + hbit;
+ ASSERT(0 <= lix && lix < umwd->low_sz);
+ lmask = erts_atomic32_read_nob(&umwd->low[lix]);
+ if (lmask) {
+ int lbase = lix << ERTS_THR_PRGR_BM_SHIFT;
+ int lbit;
+ for (lbit = 0; lbit < ERTS_THR_PRGR_BM_BITS; lbit++) {
+ if (lmask & (1 << lbit)) {
+ int id = lbase + lbit;
+ wakeup_unmanaged(id);
+ }
+ }
+ erts_atomic32_set_nob(&umwd->low[lix], 0);
+ }
+ }
+ }
+ erts_atomic32_set_nob(&umwd->high[hix], 0);
+ }
+ }
+}
+
+
+static void
+handle_wakeup_requests(ErtsThrPrgrVal current)
+{
+ ErtsThrPrgrManagedWakeupData *mwd;
+ ErtsThrPrgrUnmanagedWakeupData *umwd;
+ int wix, len, i;
+
+ wix = ERTS_THR_PRGR_WAKEUP_IX(current);
+
+ mwd = intrnl->managed.data[wix];
+ len = erts_atomic32_read_nob(&mwd->len);
+ ASSERT(len >= 0);
+ if (len) {
+ for (i = 0; i < len; i++)
+ wakeup_managed(mwd->id[i]);
+ erts_atomic32_set_nob(&mwd->len, 0);
+ }
+
+ umwd = intrnl->unmanaged.data[wix];
+ len = erts_atomic32_read_nob(&umwd->len);
+ ASSERT(len >= 0);
+ if (len) {
+ wakeup_unmanaged_threads(umwd);
+ erts_atomic32_set_nob(&umwd->len, 0);
+ }
+
+}
+
+static int
+got_sched_wakeups(void)
+{
+ int wix;
+
+ ERTS_THR_MEMORY_BARRIER;
+
+ for (wix = 0; wix < ERTS_THR_PRGR_WAKEUP_DATA_SIZE; wix++) {
+ ErtsThrPrgrManagedWakeupData **mwd = intrnl->managed.data;
+ if (erts_atomic32_read_nob(&mwd[wix]->len))
+ return 1;
+ }
+ for (wix = 0; wix < ERTS_THR_PRGR_WAKEUP_DATA_SIZE; wix++) {
+ ErtsThrPrgrUnmanagedWakeupData **umwd = intrnl->unmanaged.data;
+ if (erts_atomic32_read_nob(&umwd[wix]->len))
+ return 1;
+ }
+ return 0;
+}
+
+static erts_aint32_t
+block_thread(ErtsThrPrgrData *tpd)
+{
+ erts_aint32_t lflgs;
+ ErtsThrPrgrCallbacks *cbp = &intrnl->managed.callbacks[tpd->id];
+
+ do {
+ block_count_dec();
+
+ while (1) {
+ cbp->prepare_wait(cbp->arg);
+ lflgs = erts_atomic32_read_nob(&intrnl->misc.data.lflgs);
+ if (lflgs & ERTS_THR_PRGR_LFLG_BLOCK)
+ cbp->wait(cbp->arg);
+ else
+ break;
+ }
+
+ } while (block_count_inc());
+
+ cbp->finalize_wait(cbp->arg);
+
+ return lflgs;
+}
+
+static erts_aint32_t
+thr_progress_block(ErtsThrPrgrData *tpd, int wait)
+{
+ erts_tse_t *event = NULL; /* Remove erroneous warning... sigh... */
+ erts_aint32_t lflgs, bc;
+
+ if (tpd->is_blocking++)
+ return (erts_aint32_t) 0;
+
+ while (1) {
+ lflgs = erts_atomic32_read_bor_nob(&intrnl->misc.data.lflgs,
+ ERTS_THR_PRGR_LFLG_BLOCK);
+ if (lflgs & ERTS_THR_PRGR_LFLG_BLOCK)
+ block_thread(tpd);
+ else
+ break;
+ }
+
+#if ERTS_THR_PRGR_PRINT_BLOCKERS
+ erts_fprintf(stderr, "block(%d)\n", tpd->id);
+#endif
+
+ ASSERT(ERTS_AINT_NULL
+ == erts_atomic_read_nob(&intrnl->misc.data.blocker_event));
+
+ if (wait) {
+ event = erts_tse_fetch();
+ erts_tse_reset(event);
+ erts_atomic_set_nob(&intrnl->misc.data.blocker_event,
+ (erts_aint_t) event);
+ }
+ if (tpd->is_managed)
+ erts_atomic32_dec_nob(&intrnl->misc.data.block_count);
+ bc = erts_atomic32_read_band_mb(&intrnl->misc.data.block_count,
+ ~ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING);
+ bc &= ~ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING;
+ if (wait) {
+ while (bc != 0) {
+ erts_tse_wait(event);
+ erts_tse_reset(event);
+ bc = erts_atomic32_read_acqb(&intrnl->misc.data.block_count);
+ }
+ }
+ return bc;
+
+}
+
+void
+erts_thr_progress_block(void)
+{
+ thr_progress_block(tmp_thr_prgr_data(NULL), 1);
+}
+
+void
+erts_thr_progress_fatal_error_block(SWord timeout)
+{
+ ErtsThrPrgrData tpd_buf;
+ ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(NULL);
+ erts_aint32_t bc;
+ SWord time_left = timeout;
+ SysTimeval to;
+
+ /*
+ * Counting poll intervals may give us a too long timeout
+ * if cpu is busy. If we got tolerant time of day we use it
+ * to prevent this.
+ */
+ if (!erts_disable_tolerant_timeofday) {
+ erts_get_timeval(&to);
+ to.tv_sec += timeout / 1000;
+ to.tv_sec += timeout % 1000;
+ }
+
+ if (!tpd) {
+ /*
+ * We stack allocate since failure to allocate memory may
+ * have caused the problem in the first place. This is ok
+ * since we never complete an unblock after a fatal error
+ * block.
+ */
+ tpd = &tpd_buf;
+ init_tmp_thr_prgr_data(tpd);
+ }
+
+ bc = thr_progress_block(tpd, 0);
+ if (bc == 0)
+ return; /* Succefully blocked all managed threads */
+
+ while (1) {
+ if (erts_milli_sleep(ERTS_THR_PRGR_FTL_ERR_BLCK_POLL_INTERVAL) == 0)
+ time_left -= ERTS_THR_PRGR_FTL_ERR_BLCK_POLL_INTERVAL;
+ bc = erts_atomic32_read_acqb(&intrnl->misc.data.block_count);
+ if (bc == 0)
+ break; /* Succefully blocked all managed threads */
+ if (time_left <= 0)
+ break; /* Timeout */
+ if (!erts_disable_tolerant_timeofday) {
+ SysTimeval now;
+ erts_get_timeval(&now);
+ if (now.tv_sec > to.tv_sec)
+ break; /* Timeout */
+ if (now.tv_sec == to.tv_sec && now.tv_usec >= to.tv_usec)
+ break; /* Timeout */
+ }
+ }
+}
+
+void
+erts_thr_progress_unblock(void)
+{
+ erts_tse_t *event;
+ int id, break_id, sz, wakeup;
+ ErtsThrPrgrData *tpd = thr_prgr_data(NULL);
+
+ ASSERT(tpd->is_blocking);
+ if (--tpd->is_blocking)
+ return;
+
+ sz = intrnl->managed.no;
+
+ wakeup = 1;
+ if (!tpd->is_managed)
+ id = break_id = tpd->id < 0 ? 0 : tpd->id % sz;
+ else {
+ break_id = tpd->id;
+ id = break_id + 1;
+ if (id >= sz)
+ id = 0;
+ if (id == break_id)
+ wakeup = 0;
+ erts_atomic32_inc_nob(&intrnl->misc.data.block_count);
+ }
+
+ event = ((erts_tse_t *)
+ erts_atomic_read_nob(&intrnl->misc.data.blocker_event));
+ ASSERT(event);
+ erts_atomic_set_nob(&intrnl->misc.data.blocker_event, ERTS_AINT_NULL);
+
+ erts_atomic32_read_bor_relb(&intrnl->misc.data.block_count,
+ ERTS_THR_PRGR_BC_FLG_NOT_BLOCKING);
+#if ERTS_THR_PRGR_PRINT_BLOCKERS
+ erts_fprintf(stderr, "unblock(%d)\n", tpd->id);
+#endif
+ erts_atomic32_read_band_mb(&intrnl->misc.data.lflgs,
+ ~ERTS_THR_PRGR_LFLG_BLOCK);
+
+ if (wakeup) {
+ do {
+ ErtsThrPrgrVal tmp;
+ tmp = read_nob(&intrnl->thr[id].data.current);
+ if (tmp != ERTS_THR_PRGR_VAL_WAITING)
+ wakeup_managed(id);
+ if (++id >= sz)
+ id = 0;
+ } while (id != break_id);
+ }
+
+ return_tmp_thr_prgr_data(tpd);
+ erts_tse_return(event);
+}
+
+int
+erts_thr_progress_is_blocking(void)
+{
+ ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(NULL);
+ return tpd && tpd->is_blocking;
+}
+
+void erts_thr_progress_dbg_print_state(void)
+{
+ int id;
+ int sz = intrnl->managed.no;
+
+ erts_fprintf(stderr, "--- thread progress ---\n");
+ erts_fprintf(stderr,"current=%b64u\n", erts_thr_progress_current());
+ for (id = 0; id < sz; id++) {
+ ErtsThrPrgrVal current = read_nob(&intrnl->thr[id].data.current);
+#ifdef ERTS_THR_PROGRESS_STATE_DEBUG
+ erts_aint32_t state_debug;
+ char *active, *leader;
+
+ state_debug = erts_atomic32_read_nob(&intrnl->thr[id].data.state_debug);
+ active = (state_debug & ERTS_THR_PROGRESS_STATE_DEBUG_ACTIVE
+ ? "true"
+ : "false");
+ leader = (state_debug & ERTS_THR_PROGRESS_STATE_DEBUG_LEADER
+ ? "true"
+ : "false");
+#endif
+ if (current == ERTS_THR_PRGR_VAL_WAITING)
+ erts_fprintf(stderr,
+ " id=%d, current=WAITING"
+#ifdef ERTS_THR_PROGRESS_STATE_DEBUG
+ ", active=%s, leader=%s"
+#endif
+ "\n", id
+#ifdef ERTS_THR_PROGRESS_STATE_DEBUG
+ , active, leader
+#endif
+ );
+ else
+ erts_fprintf(stderr,
+ " id=%d, current=%b64u"
+#ifdef ERTS_THR_PROGRESS_STATE_DEBUG
+ ", active=%s, leader=%s"
+#endif
+ "\n", id, current
+#ifdef ERTS_THR_PROGRESS_STATE_DEBUG
+ , active, leader
+#endif
+ );
+ }
+ erts_fprintf(stderr, "-----------------------\n");
+
+
+}
+
+#endif
diff --git a/erts/emulator/beam/erl_thr_progress.h b/erts/emulator/beam/erl_thr_progress.h
new file mode 100644
index 0000000000..68d14174b9
--- /dev/null
+++ b/erts/emulator/beam/erl_thr_progress.h
@@ -0,0 +1,233 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2011. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/*
+ * Description: Thread progress information. Used by lock free algorithms
+ * to determine when all involved threads are guaranteed to
+ * have passed a specific point of execution.
+ *
+ * Usage instructions can be found in ert_thr_progress.c
+ *
+ * Author: Rickard Green
+ */
+
+#if !defined(ERL_THR_PROGRESS_H__TSD_TYPE__)
+#define ERL_THR_PROGRESS_H__TSD_TYPE__
+
+#include "sys.h"
+
+#ifndef ERTS_SMP
+
+#define erts_smp_thr_progress_block() ((void) 0)
+#define erts_smp_thr_progress_unblock() ((void) 0)
+#define erts_smp_thr_progress_is_blocking() 1
+
+#else /* ERTS_SMP */
+
+#define erts_smp_thr_progress_block erts_thr_progress_block
+#define erts_smp_thr_progress_unblock erts_thr_progress_unblock
+#define erts_smp_thr_progress_is_blocking erts_thr_progress_is_blocking
+
+void erts_thr_progress_fatal_error_block(SWord timeout);
+void erts_thr_progress_block(void);
+void erts_thr_progress_unblock(void);
+int erts_thr_progress_is_blocking(void);
+
+typedef Uint64 ErtsThrPrgrVal;
+
+#define ERTS_THR_PRGR_WAKEUP_DATA_SIZE 4 /* Need to be an even power of 2. */
+
+typedef struct {
+ int id;
+ int is_managed;
+ int is_blocking;
+ int is_temporary;
+
+ /* --- Part below only for registered threads --- */
+
+ ErtsThrPrgrVal wakeup_request[ERTS_THR_PRGR_WAKEUP_DATA_SIZE];
+
+ /* --- Part below only for managed threads --- */
+
+ int leader; /* Needs to be first in the managed threads part */
+ int active;
+ struct {
+ ErtsThrPrgrVal local;
+ ErtsThrPrgrVal next;
+ ErtsThrPrgrVal current;
+ } previous;
+} ErtsThrPrgrData;
+#endif /* ERTS_SMP */
+
+#endif
+
+#if !defined(ERL_THR_PROGRESS_H__) && !defined(ERL_THR_PROGRESS_TSD_TYPE_ONLY)
+#define ERL_THR_PROGRESS_H__
+
+#include "erl_threads.h"
+#include "erl_process.h"
+
+#ifdef ERTS_SMP
+
+#define ERTS_THR_PRGR_VAL_WAITING (~((ErtsThrPrgrVal) 0))
+
+extern erts_tsd_key_t erts_thr_prgr_data_key__;
+
+#ifdef ARCH_64
+# define ERTS_THR_PRGR_ATOMIC erts_atomic_t
+#else /* ARCH_32 */
+# define ERTS_THR_PRGR_ATOMIC erts_dw_atomic_t
+#endif
+
+typedef struct {
+ void *arg;
+ void (*wakeup)(void *);
+ void (*prepare_wait)(void *);
+ void (*wait)(void *);
+ void (*finalize_wait)(void *);
+} ErtsThrPrgrCallbacks;
+
+typedef struct {
+ ERTS_THR_PRGR_ATOMIC current;
+} ErtsThrPrgr;
+
+extern ErtsThrPrgr erts_thr_prgr__;
+
+void erts_thr_progress_pre_init(void);
+void erts_thr_progress_init(int no_schedulers, int managed, int unmanaged);
+void erts_thr_progress_register_managed_thread(ErtsSchedulerData *esdp,
+ ErtsThrPrgrCallbacks *,
+ int);
+void erts_thr_progress_register_unmanaged_thread(ErtsThrPrgrCallbacks *);
+void erts_thr_progress_active(ErtsSchedulerData *esdp, int on);
+void erts_thr_progress_wakeup(ErtsSchedulerData *esdp,
+ ErtsThrPrgrVal value);
+int erts_thr_progress_update(ErtsSchedulerData *esdp);
+int erts_thr_progress_leader_update(ErtsSchedulerData *esdp);
+void erts_thr_progress_prepare_wait(ErtsSchedulerData *esdp);
+void erts_thr_progress_finalize_wait(ErtsSchedulerData *esdp);
+
+void erts_thr_progress_dbg_print_state(void);
+
+#ifdef ARCH_32
+#define ERTS_THR_PRGR_ATOMIC erts_dw_atomic_t
+ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_dw_sint_to_val__(ethr_dw_sint_t *dw_sint);
+#endif
+ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_acqb__(ERTS_THR_PRGR_ATOMIC *atmc);
+
+ERTS_GLB_INLINE int erts_thr_progress_is_managed_thread(void);
+ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_progress_later(void);
+ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_progress_current(void);
+ERTS_GLB_INLINE int erts_thr_progress_has_passed__(ErtsThrPrgrVal val1, ErtsThrPrgrVal val2);
+ERTS_GLB_INLINE int erts_thr_progress_has_reached(ErtsThrPrgrVal val);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+#ifdef ARCH_64
+
+ERTS_GLB_INLINE ErtsThrPrgrVal
+erts_thr_prgr_read_acqb__(ERTS_THR_PRGR_ATOMIC *atmc)
+{
+ return (ErtsThrPrgrVal) erts_atomic_read_acqb(atmc);
+}
+
+#else /* ARCH_32 */
+
+ERTS_GLB_INLINE ErtsThrPrgrVal
+erts_thr_prgr_dw_sint_to_val__(ethr_dw_sint_t *dw_sint)
+{
+#ifdef ETHR_SU_DW_NAINT_T__
+ return (ErtsThrPrgrVal) dw_sint->dw_sint;
+#else
+ ErtsThrPrgrVal res;
+ res = (ErtsThrPrgrVal) ((Uint32) dw_sint->sint[ETHR_DW_SINT_HIGH_WORD]);
+ res <<= 32;
+ res |= (ErtsThrPrgrVal) ((Uint32) dw_sint->sint[ETHR_DW_SINT_LOW_WORD]);
+ return res;
+#endif
+}
+
+ERTS_GLB_INLINE ErtsThrPrgrVal
+erts_thr_prgr_read_acqb__(ERTS_THR_PRGR_ATOMIC *atmc)
+{
+ ethr_dw_sint_t dw_sint;
+ erts_dw_atomic_read_acqb(atmc, &dw_sint);
+ return erts_thr_prgr_dw_sint_to_val__(&dw_sint);
+}
+
+#endif
+
+ERTS_GLB_INLINE int
+erts_thr_progress_is_managed_thread(void)
+{
+ ErtsThrPrgrData *tpd = erts_tsd_get(erts_thr_prgr_data_key__);
+ return tpd && tpd->is_managed;
+}
+
+ERTS_GLB_INLINE ErtsThrPrgrVal
+erts_thr_progress_later(void)
+{
+ ErtsThrPrgrVal val = erts_thr_prgr_read_acqb__(&erts_thr_prgr__.current);
+ if (val == (ERTS_THR_PRGR_VAL_WAITING-((ErtsThrPrgrVal)2)))
+ return ((ErtsThrPrgrVal) 0);
+ else if (val == (ERTS_THR_PRGR_VAL_WAITING-((ErtsThrPrgrVal)1)))
+ return ((ErtsThrPrgrVal) 1);
+ else
+ return val + ((ErtsThrPrgrVal) 2);
+}
+
+ERTS_GLB_INLINE ErtsThrPrgrVal
+erts_thr_progress_current(void)
+{
+ return erts_thr_prgr_read_acqb__(&erts_thr_prgr__.current);
+}
+
+ERTS_GLB_INLINE int
+erts_thr_progress_has_passed__(ErtsThrPrgrVal val1, ErtsThrPrgrVal val0)
+{
+ if ((((((ErtsThrPrgrVal) 1) << 63) & val1)
+ ^ ((((ErtsThrPrgrVal) 1) << 63) & val0)) != 0) {
+ /* May have wrapped... */
+ if (val1 < (((ErtsThrPrgrVal) 1) << 62)
+ && val0 > (((ErtsThrPrgrVal) 3) << 62)) {
+ /*
+ * 'val1' has wrapped but 'val0' has not yet wrapped. While in
+ * these ranges 'current' is considered later than 'val0'.
+ */
+ return 1;
+ }
+ }
+ return val1 > val0;
+}
+
+ERTS_GLB_INLINE int
+erts_thr_progress_has_reached(ErtsThrPrgrVal val)
+{
+ ErtsThrPrgrVal current;
+ current = erts_thr_prgr_read_acqb__(&erts_thr_prgr__.current);
+ if (current == val)
+ return 1;
+ return erts_thr_progress_has_passed__(current, val);
+}
+
+#endif
+
+#endif /* ERTS_SMP */
+
+#endif
diff --git a/erts/emulator/beam/erl_thr_queue.c b/erts/emulator/beam/erl_thr_queue.c
new file mode 100644
index 0000000000..9ac4cd4b8e
--- /dev/null
+++ b/erts/emulator/beam/erl_thr_queue.c
@@ -0,0 +1,745 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2011. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/*
+ * Description: Lock-free queue for communication between threads.
+ *
+ * Currently only a many-to-one version has been,
+ * implemented, i.e., many threads can enqueue but
+ * only one thread can dequeue at a time. It doesn't
+ * have to be the same thread dequeuing every time, but
+ * synchronization so that only one thread dequeues
+ * at a time has to be provided by other means.
+ *
+ * When/If the need for a many-to-many queue arises,
+ * this implementation can relatively easy be extended
+ * to support that too.
+ *
+ * Usage instructions below.
+ *
+ * Author: Rickard Green
+ */
+
+/*
+ * ------ Usage instructions -----------------------------------------------
+ *
+ * Dequeuing generates garbage that needs to be cleaned up.
+ * erts_thr_q_dequeue() automatically cleans, but garbage may have to be
+ * cleaned up also when the queue is empty. This is done by calling
+ * erts_thr_q_clean(). In the SMP case thread progress may have to be made
+ * before cleaning can continue. If so, erts_thr_q_need_thr_progress() in
+ * combination with erts_thr_progress_wakeup() can be used in order to
+ * request a wakeup at appropriate time.
+ *
+ * Enqueuing implies memory allocation and dequeuing implies memory
+ * deallocation. Memory allocation can be moved to another more suitable
+ * thread using erts_thr_q_prepare_enqueue() together with
+ * erts_thr_q_enqueue_prepared() instead of using erts_thr_q_enqueue().
+ * Memory deallocation can can be moved to another more suitable thread by
+ * disabling auto_finalize_dequeue when initializing the queue and then use
+ * erts_thr_q_get_finalize_dequeue_data() together
+ * erts_thr_q_finalize_dequeue() after dequeuing or cleaning.
+ *
+ * Ending the life of the queue using either erts_thr_q_destroy()
+ * or erts_thr_q_finalize() impies cleaning the queue. Both functions
+ * return the cleaning result and may have to be called multiple times
+ * until the queue is clean. Once one of these functions have been called
+ * enqueuing is not allowed. This has to be synchronized by the user.
+ * If auto_finalize_dequeue has been disabled, the finalize dequeue
+ * functionality has to be called after ending the life of the queue just
+ * as when dequeuing or cleaning on a queue that is alive.
+ *
+ * -------------------------------------------------------------------------
+ */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include "erl_thr_queue.h"
+
+#if defined(DEBUG)
+#define ERTS_THR_Q_DBG_CHK_DATA 1
+#else
+#define ERTS_THR_Q_DBG_CHK_DATA 0
+#endif
+
+#define ERTS_THR_Q_MAX_CLEAN_REACHED_HEAD_COUNT 100
+#define ERTS_THR_Q_MAX_SCHED_CLEAN_OPS 50
+#define ERTS_THR_Q_MAX_DEQUEUE_CLEAN_OPS 3
+
+#define ERTS_THR_Q_MAX_FINI_DEQ_OPS 50
+
+#ifdef ERTS_SMP
+ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(sl_element,
+ ErtsThrQElement_t,
+ 1000,
+ ERTS_ALC_T_THR_Q_EL_SL)
+#else
+
+static void
+init_sl_element_alloc(void)
+{
+}
+
+static ErtsThrQElement_t *
+sl_element_alloc(void)
+{
+ return erts_alloc(ERTS_ALC_T_THR_Q_EL_SL,
+ sizeof(ErtsThrQElement_t));
+}
+
+static void
+sl_element_free(ErtsThrQElement_t *p)
+{
+ erts_free(ERTS_ALC_T_THR_Q_EL_SL, p);
+}
+
+#endif
+
+typedef union {
+ ErtsThrQ_t q;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsThrQ_t))];
+} ErtsAlignedThrQ_t;
+
+void
+erts_thr_q_init(void)
+{
+ init_sl_element_alloc();
+}
+
+static void noop_callback(void *arg) { }
+
+void
+erts_thr_q_initialize(ErtsThrQ_t *q, ErtsThrQInit_t *qi)
+{
+#ifndef USE_THREADS
+ q->init = *qi;
+ if (!q->init.notify)
+ q->init.notify = noop_callback;
+ q->first = NULL;
+ q->last = NULL;
+ q->q.blk = NULL;
+#else
+ erts_atomic_init_nob(&q->tail.data.marker.next.atmc, ERTS_AINT_NULL);
+ q->tail.data.marker.data.ptr = NULL;
+ erts_atomic_init_nob(&q->tail.data.last,
+ (erts_aint_t) &q->tail.data.marker);
+ erts_atomic_init_nob(&q->tail.data.um_refc[0], 0);
+ erts_atomic_init_nob(&q->tail.data.um_refc[1], 0);
+ erts_atomic32_init_nob(&q->tail.data.um_refc_ix, 0);
+ q->tail.data.live = qi->live.objects;
+ q->tail.data.arg = qi->arg;
+ q->tail.data.notify = qi->notify;
+ if (!q->tail.data.notify)
+ q->tail.data.notify = noop_callback;
+
+ q->head.head.ptr = &q->tail.data.marker;
+ q->head.live = qi->live.objects;
+ q->head.first = &q->tail.data.marker;
+ q->head.unref_end = &q->tail.data.marker;
+ q->head.clean_reached_head_count = 0;
+ q->head.deq_fini.automatic = qi->auto_finalize_dequeue;
+ q->head.deq_fini.start = NULL;
+ q->head.deq_fini.end = NULL;
+#ifdef ERTS_SMP
+ q->head.next.thr_progress = erts_thr_progress_current();
+ q->head.next.thr_progress_reached = 1;
+#endif
+ q->head.next.um_refc_ix = 1;
+ q->head.next.unref_end = &q->tail.data.marker;
+ q->head.used_marker = 1;
+ q->head.arg = qi->arg;
+ q->head.notify = q->tail.data.notify;
+ q->q.finalizing = 0;
+ q->q.live = qi->live.queue;
+ q->q.blk = NULL;
+#endif
+}
+
+ErtsThrQCleanState_t
+erts_thr_q_finalize(ErtsThrQ_t *q)
+{
+#ifdef USE_THREADS
+ q->q.finalizing = 1;
+#endif
+ while (erts_thr_q_dequeue(q));
+ return erts_thr_q_clean(q);
+}
+
+ErtsThrQ_t *
+erts_thr_q_create(ErtsThrQInit_t *qi)
+{
+ ErtsAlcType_t atype;
+ ErtsThrQ_t *q, *qblk;
+ UWord qw;
+
+ switch (qi->live.queue) {
+ case ERTS_THR_Q_LIVE_SHORT:
+ atype = ERTS_ALC_T_THR_Q_SL;
+ break;
+ case ERTS_THR_Q_LIVE_LONG:
+ atype = ERTS_ALC_T_THR_Q_LL;
+ break;
+ default:
+ atype = ERTS_ALC_T_THR_Q;
+ break;
+ }
+
+ qw = (UWord) erts_alloc(atype,
+ sizeof(ErtsThrQ_t) + (ERTS_CACHE_LINE_SIZE-1));
+ qblk = (ErtsThrQ_t *) qw;
+ if (qw & ERTS_CACHE_LINE_MASK)
+ qw = (qw & ~ERTS_CACHE_LINE_MASK) + ERTS_CACHE_LINE_SIZE;
+ ASSERT((qw & ERTS_CACHE_LINE_MASK) == 0);
+ q = (ErtsThrQ_t *) qw;
+ erts_thr_q_initialize(q, qi);
+ q->q.blk = qblk;
+ return q;
+}
+
+ErtsThrQCleanState_t
+erts_thr_q_destroy(ErtsThrQ_t *q)
+{
+ if (!q->q.blk)
+ erl_exit(ERTS_ABORT_EXIT,
+ "Trying to destroy not created thread queue\n");
+ return erts_thr_q_finalize(q);
+}
+
+#ifdef USE_THREADS
+
+static void
+destroy(ErtsThrQ_t *q)
+{
+ ErtsAlcType_t atype;
+ switch (q->q.live) {
+ case ERTS_THR_Q_LIVE_SHORT:
+ atype = ERTS_ALC_T_THR_Q_SL;
+ break;
+ case ERTS_THR_Q_LIVE_LONG:
+ atype = ERTS_ALC_T_THR_Q_LL;
+ break;
+ default:
+ atype = ERTS_ALC_T_THR_Q;
+ break;
+ }
+ erts_free(atype, q->q.blk);
+}
+
+#endif
+
+static ERTS_INLINE ErtsThrQElement_t *
+element_live_alloc(ErtsThrQLive_t live)
+{
+ switch (live) {
+ case ERTS_THR_Q_LIVE_SHORT:
+ return sl_element_alloc();
+ default:
+ return (ErtsThrQElement_t *) erts_alloc(ERTS_ALC_T_THR_Q_EL,
+ sizeof(ErtsThrQElement_t));
+ }
+}
+
+static ERTS_INLINE ErtsThrQElement_t *
+element_alloc(ErtsThrQ_t *q)
+{
+ ErtsThrQLive_t live;
+#ifdef USE_THREADS
+ live = q->tail.data.live;
+#else
+ live = q->init.live.objects;
+#endif
+ return element_live_alloc(live);
+}
+
+static ERTS_INLINE void
+element_live_free(ErtsThrQLive_t live, ErtsThrQElement_t *el)
+{
+ switch (live) {
+ case ERTS_THR_Q_LIVE_SHORT:
+ sl_element_free(el);
+ break;
+ default:
+ erts_free(ERTS_ALC_T_THR_Q_EL, el);
+ }
+}
+
+static ERTS_INLINE void
+element_free(ErtsThrQ_t *q, ErtsThrQElement_t *el)
+{
+ ErtsThrQLive_t live;
+#ifdef USE_THREADS
+ live = q->head.live;
+#else
+ live = q->init.live.objects;
+#endif
+ element_live_free(live, el);
+}
+
+#ifdef USE_THREADS
+
+static ERTS_INLINE ErtsThrQElement_t *
+enqueue_managed(ErtsThrQ_t *q, ErtsThrQElement_t *this, int want_last)
+{
+ erts_aint_t ilast, itmp;
+
+ erts_atomic_init_nob(&this->next.atmc, ERTS_AINT_NULL);
+ /* Enqueue at end of list... */
+
+ ilast = erts_atomic_read_nob(&q->tail.data.last);
+ while (1) {
+ ErtsThrQElement_t *last = (ErtsThrQElement_t *) ilast;
+ itmp = erts_atomic_cmpxchg_mb(&last->next.atmc,
+ (erts_aint_t) this,
+ ERTS_AINT_NULL);
+ if (itmp == ERTS_AINT_NULL)
+ break;
+ ilast = itmp;
+ }
+
+ /* Move last pointer forward... */
+ while (1) {
+ if (want_last) {
+ if (erts_atomic_read_rb(&this->next.atmc) != ERTS_AINT_NULL) {
+ /* Someone else will move it forward */
+ ilast = erts_atomic_read_rb(&q->tail.data.last);
+ return (ErtsThrQElement_t *) ilast;
+ }
+ }
+ else {
+ if (erts_atomic_read_nob(&this->next.atmc) != ERTS_AINT_NULL) {
+ /* Someone else will move it forward */
+ return NULL;
+ }
+ }
+ itmp = erts_atomic_cmpxchg_mb(&q->tail.data.last,
+ (erts_aint_t) this,
+ ilast);
+ if (ilast == itmp)
+ return want_last ? this : NULL;
+ ilast = itmp;
+ }
+}
+
+static ErtsThrQCleanState_t
+clean(ErtsThrQ_t *q, int max_ops, int do_notify)
+{
+ erts_aint_t ilast;
+ int um_refc_ix;
+ int ops;
+
+ for (ops = 0; ops < max_ops; ops++) {
+ ErtsThrQElement_t *tmp;
+ restart:
+ ASSERT(q->head.first);
+ if (q->head.first == q->head.head.ptr) {
+ q->head.clean_reached_head_count++;
+ if (q->head.clean_reached_head_count
+ >= ERTS_THR_Q_MAX_CLEAN_REACHED_HEAD_COUNT) {
+ q->head.clean_reached_head_count = 0;
+ break;
+ }
+ goto inspect_head;
+ }
+ if (q->head.first == q->head.unref_end)
+ break;
+ if (q->head.first == &q->tail.data.marker) {
+ q->head.used_marker = 0;
+ q->head.first = q->head.first->next.ptr;
+ goto restart;
+ }
+ tmp = q->head.first;
+ q->head.first = q->head.first->next.ptr;
+ if (q->head.deq_fini.automatic)
+ element_free(q, tmp);
+ else {
+ tmp->data.ptr = (void *) (UWord) q->head.live;
+ if (!q->head.deq_fini.start)
+ q->head.deq_fini.start = tmp;
+ else if (q->head.deq_fini.end->next.ptr == &q->tail.data.marker)
+ q->head.deq_fini.end->next.ptr = tmp;
+ q->head.deq_fini.end = tmp;
+ }
+ }
+
+ ilast = erts_atomic_read_nob(&q->tail.data.last);
+ if (q->head.first == ((ErtsThrQElement_t *) ilast)
+ && ((ErtsThrQElement_t *) ilast) == &q->tail.data.marker
+ && q->head.first == &q->tail.data.marker) {
+ /* Empty and clean queue */
+ if (q->q.finalizing)
+ destroy(q);
+ return ERTS_THR_Q_CLEAN;
+ }
+
+#ifdef ERTS_SMP
+ if (q->head.next.thr_progress_reached
+ || erts_thr_progress_has_reached(q->head.next.thr_progress)) {
+ q->head.next.thr_progress_reached = 1;
+#endif
+ um_refc_ix = q->head.next.um_refc_ix;
+ if (erts_atomic_read_acqb(&q->tail.data.um_refc[um_refc_ix]) == 0) {
+ /* Move unreferenced end pointer forward... */
+ q->head.clean_reached_head_count = 0;
+ q->head.unref_end = q->head.next.unref_end;
+
+ if (!q->head.used_marker
+ && q->head.unref_end == (ErtsThrQElement_t *) ilast) {
+ q->head.used_marker = 1;
+ ilast = (erts_aint_t) enqueue_managed(q,
+ &q->tail.data.marker,
+ 1);
+ if (q->head.head.ptr == q->head.unref_end) {
+ ErtsThrQElement_t *next;
+ next = ((ErtsThrQElement_t *)
+ erts_atomic_read_acqb(&q->head.head.ptr->next.atmc));
+ if (next == &q->tail.data.marker) {
+ q->head.head.ptr->next.ptr = &q->tail.data.marker;
+ q->head.head.ptr = &q->tail.data.marker;
+ }
+ }
+ }
+
+ if (q->head.unref_end == (ErtsThrQElement_t *) ilast)
+ ERTS_THR_MEMORY_BARRIER;
+ else {
+ q->head.next.unref_end = (ErtsThrQElement_t *) ilast;
+ ERTS_THR_MEMORY_BARRIER;
+#ifdef ERTS_SMP
+ q->head.next.thr_progress = erts_thr_progress_later();
+#endif
+ erts_atomic32_set_relb(&q->tail.data.um_refc_ix,
+ um_refc_ix);
+ q->head.next.um_refc_ix = um_refc_ix == 0 ? 1 : 0;
+#ifdef ERTS_SMP
+ q->head.next.thr_progress_reached = 0;
+#endif
+ }
+ }
+#ifdef ERTS_SMP
+ }
+#endif
+
+ if (q->head.first == q->head.head.ptr) {
+ inspect_head:
+ if (!q->head.used_marker) {
+ erts_aint_t inext;
+ inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc);
+ if (inext == ERTS_AINT_NULL) {
+ q->head.used_marker = 1;
+ (void) enqueue_managed(q, &q->tail.data.marker, 0);
+ inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc);
+ if (inext == (erts_aint_t) &q->tail.data.marker) {
+ q->head.head.ptr->next.ptr = &q->tail.data.marker;
+ q->head.head.ptr = &q->tail.data.marker;
+#ifdef ERTS_SMP
+ if (!q->head.next.thr_progress_reached)
+ return ERTS_THR_Q_NEED_THR_PRGR;
+#else
+ if (do_notify)
+ q->head.notify(q->head.arg);
+#endif
+ return ERTS_THR_Q_DIRTY;
+ }
+ }
+ }
+ return ERTS_THR_Q_CLEAN;
+ }
+
+ if (q->head.first != q->head.unref_end) {
+ if (do_notify)
+ q->head.notify(q->head.arg);
+ return ERTS_THR_Q_DIRTY;
+ }
+
+#ifdef ERTS_SMP
+ if (!q->head.next.thr_progress_reached)
+ return ERTS_THR_Q_NEED_THR_PRGR;
+#endif
+
+ return ERTS_THR_Q_CLEAN; /* Waiting for unmanaged threads to complete... */
+}
+
+#endif
+
+ErtsThrQCleanState_t
+erts_thr_q_clean(ErtsThrQ_t *q)
+{
+#ifdef USE_THREADS
+ return clean(q, ERTS_THR_Q_MAX_SCHED_CLEAN_OPS, 0);
+#else
+ return ERTS_THR_Q_CLEAN;
+#endif
+}
+
+ErtsThrQCleanState_t
+erts_thr_q_inspect(ErtsThrQ_t *q, int ensure_empty)
+{
+#ifdef USE_THREADS
+ if (ensure_empty) {
+ erts_aint_t inext;
+ inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc);
+ if (inext != ERTS_AINT_NULL) {
+ if (&q->tail.data.marker != (ErtsThrQElement_t *) inext)
+ return ERTS_THR_Q_DIRTY;
+ else {
+ q->head.head.ptr->next.ptr = (ErtsThrQElement_t *) inext;
+ q->head.head.ptr = (ErtsThrQElement_t *) inext;
+ inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc);
+ if (inext != ERTS_AINT_NULL)
+ return ERTS_THR_Q_DIRTY;
+ }
+ }
+ }
+
+ if (q->head.first == q->head.head.ptr) {
+ if (!q->head.used_marker) {
+ erts_aint_t inext;
+ inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc);
+ if (inext == ERTS_AINT_NULL)
+ return ERTS_THR_Q_DIRTY;
+ }
+ return ERTS_THR_Q_CLEAN;
+ }
+
+ if (q->head.first != q->head.unref_end)
+ return ERTS_THR_Q_DIRTY;
+
+#ifdef ERTS_SMP
+ if (!q->head.next.thr_progress_reached)
+ return ERTS_THR_Q_NEED_THR_PRGR;
+#endif
+#endif
+ return ERTS_THR_Q_CLEAN;
+}
+
+static void
+enqueue(ErtsThrQ_t *q, void *data, ErtsThrQElement_t *this)
+{
+#ifndef USE_THREADS
+ ASSERT(data);
+
+ this->next.ptr = NULL;
+ this->data.ptr = data;
+
+ if (q->last)
+ q->last->next.ptr = this;
+ else {
+ q->first = q->last = this;
+ q->init.notify(q->init.arg);
+ }
+#else
+ int notify;
+ int um_refc_ix = 0;
+#ifdef ERTS_SMP
+ int unmanaged_thread;
+#endif
+
+#if ERTS_THR_Q_DBG_CHK_DATA
+ if (!data)
+ erl_exit(ERTS_ABORT_EXIT, "Missing data in enqueue\n");
+#endif
+
+ ASSERT(!q->q.finalizing);
+
+ this->data.ptr = data;
+
+#ifdef ERTS_SMP
+ unmanaged_thread = !erts_thr_progress_is_managed_thread();
+ if (unmanaged_thread)
+#endif
+ {
+ um_refc_ix = erts_atomic32_read_acqb(&q->tail.data.um_refc_ix);
+ while (1) {
+ int tmp_um_refc_ix;
+ erts_atomic_inc_acqb(&q->tail.data.um_refc[um_refc_ix]);
+ tmp_um_refc_ix = erts_atomic32_read_acqb(&q->tail.data.um_refc_ix);
+ if (tmp_um_refc_ix == um_refc_ix)
+ break;
+ erts_atomic_dec_relb(&q->tail.data.um_refc[um_refc_ix]);
+ um_refc_ix = tmp_um_refc_ix;
+ }
+ }
+
+ notify = this == enqueue_managed(q, this, 1);
+
+
+#ifdef ERTS_SMP
+ if (unmanaged_thread)
+#endif
+ {
+ if (notify)
+ erts_atomic_dec_relb(&q->tail.data.um_refc[um_refc_ix]);
+ else if (erts_atomic_dec_read_relb(&q->tail.data.um_refc[um_refc_ix]) == 0)
+ notify = 1;
+ }
+ if (notify)
+ q->tail.data.notify(q->tail.data.arg);
+#endif
+}
+
+void
+erts_thr_q_enqueue(ErtsThrQ_t *q, void *data)
+{
+ enqueue(q, data, element_alloc(q));
+}
+
+ErtsThrQPrepEnQ_t *
+erts_thr_q_prepare_enqueue(ErtsThrQ_t *q)
+{
+ return (ErtsThrQPrepEnQ_t *) element_alloc(q);
+}
+
+int
+erts_thr_q_get_finalize_dequeue_data(ErtsThrQ_t *q, ErtsThrQFinDeQ_t *fdp)
+{
+#ifndef USE_THREADS
+ return 0;
+#else
+#ifdef DEBUG
+ if (!q->head.deq_fini.start) {
+ ASSERT(!q->head.deq_fini.end);
+ }
+ else {
+ ErtsThrQElement_t *e = q->head.deq_fini.start;
+ ErtsThrQElement_t *end = q->head.deq_fini.end;
+ while (e != end) {
+ ASSERT(q->head.head.ptr != e);
+ ASSERT(q->head.first != e);
+ ASSERT(q->head.unref_end != e);
+ e = e->next.ptr;
+ }
+ }
+#endif
+ fdp->start = q->head.deq_fini.start;
+ fdp->end = q->head.deq_fini.end;
+ if (fdp->end)
+ fdp->end->next.ptr = NULL;
+ q->head.deq_fini.start = NULL;
+ q->head.deq_fini.end = NULL;
+ return fdp->start != NULL;
+#endif
+}
+
+void
+erts_thr_q_append_finalize_dequeue_data(ErtsThrQFinDeQ_t *fdp0,
+ ErtsThrQFinDeQ_t *fdp1)
+{
+#ifdef USE_THREADS
+ if (fdp1->start) {
+ if (fdp0->end)
+ fdp0->end->next.ptr = fdp1->start;
+ else
+ fdp0->start = fdp1->start;
+ fdp0->end = fdp1->end;
+ }
+#endif
+}
+
+
+int erts_thr_q_finalize_dequeue(ErtsThrQFinDeQ_t *state)
+{
+#ifdef USE_THREADS
+ ErtsThrQElement_t *start = state->start;
+ if (start) {
+ ErtsThrQLive_t live;
+ int i;
+ for (i = 0; i < ERTS_THR_Q_MAX_FINI_DEQ_OPS; i++) {
+ ErtsThrQElement_t *tmp;
+ if (!start)
+ break;
+ tmp = start;
+ start = start->next.ptr;
+ live = (ErtsThrQLive_t) (UWord) tmp->data.ptr;
+ element_live_free(live, tmp);
+ }
+ state->start = start;
+ if (start)
+ return 1; /* More to do */
+ state->end = NULL;
+ }
+#endif
+ return 0;
+}
+
+void
+erts_thr_q_finalize_dequeue_state_init(ErtsThrQFinDeQ_t *state)
+{
+#ifdef USE_THREADS
+ state->start = NULL;
+ state->end = NULL;
+#endif
+}
+
+
+void
+erts_thr_q_enqueue_prepared(ErtsThrQ_t *q, void *data, ErtsThrQPrepEnQ_t *prep)
+{
+ ASSERT(prep);
+ enqueue(q, data, (ErtsThrQElement_t *) prep);
+}
+
+void *
+erts_thr_q_dequeue(ErtsThrQ_t *q)
+{
+#ifndef USE_THREADS
+ void *res;
+ ErtsThrQElement_t *tmp;
+
+ if (!q->first)
+ return NULL;
+ tmp = q->first;
+ res = tmp->data.ptr;
+ q->first = tmp->next.ptr;
+ if (!q->first)
+ q->last = NULL;
+
+ element_free(q, tmp);
+
+ return res;
+#else
+ erts_aint_t inext;
+ void *res;
+
+ inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc);
+ if (inext == ERTS_AINT_NULL)
+ return NULL;
+ q->head.head.ptr->next.ptr = (ErtsThrQElement_t *) inext;
+ q->head.head.ptr = (ErtsThrQElement_t *) inext;
+ if (q->head.head.ptr == &q->tail.data.marker) {
+ inext = erts_atomic_read_acqb(&q->head.head.ptr->next.atmc);
+ if (inext == ERTS_AINT_NULL)
+ return NULL;
+ q->head.head.ptr->next.ptr = (ErtsThrQElement_t *) inext;
+ q->head.head.ptr = (ErtsThrQElement_t *) inext;
+ }
+ res = q->head.head.ptr->data.ptr;
+#if ERTS_THR_Q_DBG_CHK_DATA
+ q->head.head.ptr->data.ptr = NULL;
+ if (!res)
+ erl_exit(ERTS_ABORT_EXIT, "Missing data in dequeue\n");
+#endif
+ clean(q,
+ (q->head.deq_fini.automatic
+ ? ERTS_THR_Q_MAX_DEQUEUE_CLEAN_OPS
+ : ERTS_THR_Q_MAX_SCHED_CLEAN_OPS), 1);
+ return res;
+#endif
+}
diff --git a/erts/emulator/beam/erl_thr_queue.h b/erts/emulator/beam/erl_thr_queue.h
new file mode 100644
index 0000000000..407c23f5eb
--- /dev/null
+++ b/erts/emulator/beam/erl_thr_queue.h
@@ -0,0 +1,211 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2011. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/*
+ * Description: Lock-free queue for communication between threads.
+ *
+ * Currently only a many-to-one version has been,
+ * implemented, i.e., many threads can enqueue but
+ * only one thread can dequeue at a time. It doesn't
+ * have to be the same thread dequeuing every time, but
+ * synchronization so that only one thread dequeues
+ * at a time has to be provided by other means.
+ *
+ * When/If the need for a many-to-many queue arises,
+ * this implementation can relatively easy be extended
+ * to support that too.
+ *
+ * Usage instructions can be found in erts_thr_queue.c
+ *
+ * Author: Rickard Green
+ */
+
+#ifndef ERL_THR_QUEUE_H__
+#define ERL_THR_QUEUE_H__
+
+#include "sys.h"
+#include "erl_threads.h"
+#include "erl_alloc.h"
+#include "erl_thr_progress.h"
+
+typedef enum {
+ ERTS_THR_Q_LIVE_UNDEF,
+ ERTS_THR_Q_LIVE_SHORT,
+ ERTS_THR_Q_LIVE_LONG
+} ErtsThrQLive_t;
+
+#define ERTS_THR_Q_INIT_DEFAULT \
+{ \
+ { \
+ ERTS_THR_Q_LIVE_UNDEF, \
+ ERTS_THR_Q_LIVE_SHORT \
+ }, \
+ NULL, \
+ NULL, \
+ 1 \
+}
+
+typedef struct ErtsThrQ_t_ ErtsThrQ_t;
+
+typedef struct {
+ struct {
+ ErtsThrQLive_t queue;
+ ErtsThrQLive_t objects;
+ } live;
+ void *arg;
+ void (*notify)(void *);
+ int auto_finalize_dequeue;
+} ErtsThrQInit_t;
+
+typedef struct ErtsThrQElement_t_ ErtsThrQElement_t;
+typedef struct ErtsThrQElement_t ErtsThrQPrepEnQ_t;
+
+typedef union {
+ erts_atomic_t atmc;
+ ErtsThrQElement_t *ptr;
+} ErtsThrQPtr_t;
+
+struct ErtsThrQElement_t_ {
+ ErtsThrQPtr_t next;
+ union {
+ erts_atomic_t atmc;
+ void *ptr;
+ } data;
+};
+
+typedef struct {
+ ErtsThrQElement_t *start;
+ ErtsThrQElement_t *end;
+} ErtsThrQFinDeQ_t;
+
+typedef enum {
+ ERTS_THR_Q_CLEAN,
+#ifdef ERTS_SMP
+ ERTS_THR_Q_NEED_THR_PRGR,
+#endif
+ ERTS_THR_Q_DIRTY,
+} ErtsThrQCleanState_t;
+
+#ifdef USE_THREADS
+
+typedef struct {
+ ErtsThrQElement_t marker;
+ erts_atomic_t last;
+ erts_atomic_t um_refc[2];
+ erts_atomic32_t um_refc_ix;
+ ErtsThrQLive_t live;
+#ifdef ERTS_SMP
+ erts_atomic32_t thr_prgr_clean_scheduled;
+#endif
+ void *arg;
+ void (*notify)(void *);
+} ErtsThrQTail_t;
+
+struct ErtsThrQ_t_ {
+ /*
+ * This structure needs to be cache line aligned for best
+ * performance.
+ */
+ union {
+ /* Modified by threads enqueuing */
+ ErtsThrQTail_t data;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsThrQTail_t))];
+ } tail;
+ /*
+ * Everything below this point is *only* accessed by the
+ * thread dequeuing.
+ */
+ struct {
+ ErtsThrQPtr_t head;
+ ErtsThrQLive_t live;
+ ErtsThrQElement_t *first;
+ ErtsThrQElement_t *unref_end;
+ int clean_reached_head_count;
+ struct {
+ int automatic;
+ ErtsThrQElement_t *start;
+ ErtsThrQElement_t *end;
+ } deq_fini;
+ struct {
+#ifdef ERTS_SMP
+ ErtsThrPrgrVal thr_progress;
+ int thr_progress_reached;
+#endif
+ int um_refc_ix;
+ ErtsThrQElement_t *unref_end;
+ } next;
+ int used_marker;
+ void *arg;
+ void (*notify)(void *);
+ } head;
+ struct {
+ int finalizing;
+ ErtsThrQLive_t live;
+ void *blk;
+ } q;
+};
+
+#else /* !USE_THREADS */
+
+struct ErtsThrQ_t_ {
+ ErtsThrQInit_t init;
+ ErtsThrQElement_t *first;
+ ErtsThrQElement_t *last;
+ struct {
+ void *blk;
+ } q;
+};
+
+#endif
+
+void erts_thr_q_init(void);
+void erts_thr_q_initialize(ErtsThrQ_t *, ErtsThrQInit_t *);
+ErtsThrQCleanState_t erts_thr_q_finalize(ErtsThrQ_t *);
+ErtsThrQ_t *erts_thr_q_create(ErtsThrQInit_t *);
+ErtsThrQCleanState_t erts_thr_q_destroy(ErtsThrQ_t *);
+ErtsThrQCleanState_t erts_thr_q_clean(ErtsThrQ_t *);
+ErtsThrQCleanState_t erts_thr_q_inspect(ErtsThrQ_t *, int);
+ErtsThrQPrepEnQ_t *erts_thr_q_prepare_enqueue(ErtsThrQ_t *);
+void erts_thr_q_enqueue_prepared(ErtsThrQ_t *, void *, ErtsThrQPrepEnQ_t *);
+void erts_thr_q_enqueue(ErtsThrQ_t *, void *);
+void * erts_thr_q_dequeue(ErtsThrQ_t *);
+int erts_thr_q_get_finalize_dequeue_data(ErtsThrQ_t *,
+ ErtsThrQFinDeQ_t *);
+void erts_thr_q_append_finalize_dequeue_data(ErtsThrQFinDeQ_t *,
+ ErtsThrQFinDeQ_t *);
+int erts_thr_q_finalize_dequeue(ErtsThrQFinDeQ_t *);
+void erts_thr_q_finalize_dequeue_state_init(ErtsThrQFinDeQ_t *);
+
+#ifdef ERTS_SMP
+ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_q_need_thr_progress(ErtsThrQ_t *q);
+#endif
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+#ifdef ERTS_SMP
+ERTS_GLB_INLINE ErtsThrPrgrVal
+erts_thr_q_need_thr_progress(ErtsThrQ_t *q)
+{
+ return q->head.next.thr_progress;
+}
+#endif
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+#endif /* ERL_THR_QUEUE_H__ */
diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h
index 12eaf39ec7..065e7077c0 100644
--- a/erts/emulator/beam/erl_threads.h
+++ b/erts/emulator/beam/erl_threads.h
@@ -92,6 +92,8 @@ typedef struct {
#endif
} erts_rwmtx_t;
+#define ERTS_MTX_OPT_DEFAULT_INITER ETHR_MUTEX_OPT_DEFAULT_INITER
+#define ERTS_CND_OPT_DEFAULT_INITER ETHR_COND_OPT_DEFAULT_INITER
#define ERTS_RWMTX_OPT_DEFAULT_INITER ETHR_RWMUTEX_OPT_DEFAULT_INITER
#define ERTS_RWMTX_TYPE_NORMAL ETHR_RWMUTEX_TYPE_NORMAL
#define ERTS_RWMTX_TYPE_FREQUENT_READ ETHR_RWMUTEX_TYPE_FREQUENT_READ
@@ -193,6 +195,8 @@ typedef struct { int gcc_is_buggy; } erts_rwlock_t;
#endif /* #ifdef USE_THREADS */
+#define ERTS_AINT_NULL ((erts_aint_t) NULL)
+
#define ERTS_AINT_T_MAX (~(((erts_aint_t) 1) << (sizeof(erts_aint_t)*8-1)))
#define ERTS_AINT_T_MIN ((((erts_aint_t) 1) << (sizeof(erts_aint_t)*8-1)))
#define ERTS_AINT32_T_MAX (~(((erts_aint32_t) 1) << (sizeof(erts_aint32_t)*8-1)))
@@ -1128,6 +1132,16 @@ erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx)
#endif
}
+/*
+ * IMPORTANT note about erts_cnd_signal() and erts_cnd_broadcast()
+ *
+ * POSIX allow a call to `pthread_cond_signal' or `pthread_cond_broadcast'
+ * even though the associated mutex/mutexes isn't/aren't locked by the
+ * caller. Our implementation do not allow that in order to avoid a
+ * performance penalty. That is, all associated mutexes *need* to be
+ * locked by the caller of erts_cnd_signal()/erts_cnd_broadcast()!
+ */
+
ERTS_GLB_INLINE void
erts_cnd_signal(erts_cnd_t *cnd)
{
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index 39509f363f..b487dbf054 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -36,6 +36,7 @@
#include "error.h"
#include "erl_binary.h"
#include "erl_bits.h"
+#include "erl_thr_progress.h"
#if 0
#define DEBUG_PRINTOUTS
@@ -159,7 +160,7 @@ static Uint active_sched;
void
erts_system_profile_setup_active_schedulers(void)
{
- ERTS_SMP_LC_ASSERT(erts_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_thr_progress_is_blocking());
active_sched = erts_active_schedulers();
}
@@ -1940,7 +1941,8 @@ trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data)
Eterm* hp;
int need;
- ERTS_SMP_LC_ASSERT((erts_proc_lc_my_proc_locks(t_p) != 0) || erts_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT((erts_proc_lc_my_proc_locks(t_p) != 0)
+ || erts_thr_progress_is_blocking());
if (is_internal_port(t_p->tracer_proc)) {
#define LOCAL_HEAP_SIZE (5+5)
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
@@ -2742,7 +2744,8 @@ trace_port(Port *t_p, Eterm what, Eterm data) {
Eterm mess;
Eterm* hp;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) || erts_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p)
+ || erts_thr_progress_is_blocking());
if (is_internal_port(t_p->tracer_proc)) {
#define LOCAL_HEAP_SIZE (5+5)
@@ -3018,8 +3021,6 @@ static ErtsSysMsgQ *sys_message_queue_end;
static erts_tid_t sys_msg_dispatcher_tid;
static erts_cnd_t smq_cnd;
-static int dispatcher_waiting;
-
ERTS_QUALLOC_IMPL(smq_element, ErtsSysMsgQ, 20, ERTS_ALC_T_SYS_MSG_Q)
static void
@@ -3063,18 +3064,6 @@ enqueue_sys_msg(enum ErtsSysMsgType type,
erts_smp_mtx_unlock(&smq_mtx);
}
-static void
-prepare_for_block(void *unused)
-{
- erts_smp_mtx_unlock(&smq_mtx);
-}
-
-static void
-resume_after_block(void *unused)
-{
- erts_smp_mtx_lock(&smq_mtx);
-}
-
void
erts_queue_error_logger_message(Eterm from, Eterm msg, ErlHeapFragment *bp)
{
@@ -3140,10 +3129,10 @@ sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver)
&& !erts_system_monitor_flags.busy_port
&& !erts_system_monitor_flags.busy_dist_port)
break; /* Everything is disabled */
- erts_smp_block_system(ERTS_BS_FLG_ALLOW_GC);
+ erts_smp_thr_progress_block();
if (system_monitor == receiver || receiver == NIL)
erts_system_monitor_clear(NULL);
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
break;
case SYS_MSG_TYPE_SYSPROF:
if (receiver == NIL
@@ -3153,11 +3142,11 @@ sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver)
&& !erts_system_profile_flags.scheduler)
break;
/* Block system to clear flags */
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
if (system_profile == receiver || receiver == NIL) {
erts_system_profile_clear(NULL);
}
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
break;
case SYS_MSG_TYPE_ERRLGR: {
char *no_elgger = "(no error logger present)";
@@ -3198,22 +3187,68 @@ sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver)
}
}
+static void
+sys_msg_dispatcher_wakeup(void *vwait_p)
+{
+ int *wait_p = (int *) vwait_p;
+ erts_smp_mtx_lock(&smq_mtx);
+ *wait_p = 0;
+ erts_smp_cnd_signal(&smq_cnd);
+ erts_smp_mtx_unlock(&smq_mtx);
+}
+
+static void
+sys_msg_dispatcher_prep_wait(void *vwait_p)
+{
+ int *wait_p = (int *) vwait_p;
+ erts_smp_mtx_lock(&smq_mtx);
+ *wait_p = 1;
+ erts_smp_mtx_unlock(&smq_mtx);
+}
+
+static void
+sys_msg_dispatcher_fin_wait(void *vwait_p)
+{
+ int *wait_p = (int *) vwait_p;
+ erts_smp_mtx_lock(&smq_mtx);
+ *wait_p = 0;
+ erts_smp_mtx_unlock(&smq_mtx);
+}
+
+static void
+sys_msg_dispatcher_wait(void *vwait_p)
+{
+ int *wait_p = (int *) vwait_p;
+ erts_smp_mtx_lock(&smq_mtx);
+ while (*wait_p)
+ erts_smp_cnd_wait(&smq_cnd, &smq_mtx);
+ erts_smp_mtx_unlock(&smq_mtx);
+}
+
static void *
sys_msg_dispatcher_func(void *unused)
{
+ ErtsThrPrgrCallbacks callbacks;
ErtsSysMsgQ *local_sys_message_queue = NULL;
+ int wait = 0;
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_set_thread_name("system message dispatcher");
#endif
- erts_register_blockable_thread();
- erts_smp_activity_begin(ERTS_ACTIVITY_IO, NULL, NULL, NULL);
+ callbacks.arg = (void *) &wait;
+ callbacks.wakeup = sys_msg_dispatcher_wakeup;
+ callbacks.prepare_wait = sys_msg_dispatcher_prep_wait;
+ callbacks.wait = sys_msg_dispatcher_wait;
+ callbacks.finalize_wait = sys_msg_dispatcher_fin_wait;
+
+ erts_thr_progress_register_managed_thread(NULL, &callbacks, 0);
while (1) {
+ int end_wait = 0;
ErtsSysMsgQ *smqp;
- ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING);
+ ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
erts_smp_mtx_lock(&smq_mtx);
@@ -3225,20 +3260,16 @@ sys_msg_dispatcher_func(void *unused)
}
/* Fetch current trace message queue ... */
- erts_smp_activity_change(ERTS_ACTIVITY_IO,
- ERTS_ACTIVITY_WAIT,
- prepare_for_block,
- resume_after_block,
- NULL);
- dispatcher_waiting = 1;
+ if (!sys_message_queue) {
+ erts_smp_mtx_unlock(&smq_mtx);
+ end_wait = 1;
+ erts_thr_progress_active(NULL, 0);
+ erts_thr_progress_prepare_wait(NULL);
+ erts_smp_mtx_lock(&smq_mtx);
+ }
+
while (!sys_message_queue)
erts_smp_cnd_wait(&smq_cnd, &smq_mtx);
- dispatcher_waiting = 0;
- erts_smp_activity_change(ERTS_ACTIVITY_WAIT,
- ERTS_ACTIVITY_IO,
- prepare_for_block,
- resume_after_block,
- NULL);
local_sys_message_queue = sys_message_queue;
sys_message_queue = NULL;
@@ -3246,6 +3277,11 @@ sys_msg_dispatcher_func(void *unused)
erts_smp_mtx_unlock(&smq_mtx);
+ if (end_wait) {
+ erts_thr_progress_finalize_wait(NULL);
+ erts_thr_progress_active(NULL, 1);
+ }
+
/* Send trace messages ... */
ASSERT(local_sys_message_queue);
@@ -3256,6 +3292,9 @@ sys_msg_dispatcher_func(void *unused)
Process *proc = NULL;
Port *port = NULL;
+ if (erts_thr_progress_update(NULL))
+ erts_thr_progress_leader_update(NULL);
+
#ifdef DEBUG_PRINTOUTS
print_msg_type(smqp);
#endif
@@ -3369,7 +3408,6 @@ sys_msg_dispatcher_func(void *unused)
}
}
- erts_smp_activity_end(ERTS_ACTIVITY_IO, NULL, NULL, NULL);
return NULL;
}
@@ -3419,7 +3457,6 @@ init_sys_msg_dispatcher(void)
sys_message_queue_end = NULL;
erts_smp_cnd_init(&smq_cnd);
erts_smp_mtx_init(&smq_mtx, "sys_msg_q");
- dispatcher_waiting = 0;
erts_smp_thr_create(&sys_msg_dispatcher_tid,
sys_msg_dispatcher_func,
NULL,
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index f810392e60..5dc307e383 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -83,11 +83,7 @@
#define CP_SIZE 1
#define ErtsHAllocLockCheck(P) \
- ERTS_SMP_LC_ASSERT((ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks((P))) \
- || ((P)->id == ERTS_INVALID_PID) \
- || ((P)->scheduler_data \
- && (P) == (P)->scheduler_data->match_pseudo_process) \
- || erts_is_system_blocked(0))
+ ERTS_SMP_LC_ASSERT(erts_dbg_check_halloc_lock((P)))
#ifdef DEBUG
diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c
index 5bc402fe22..18d62dac1d 100644
--- a/erts/emulator/beam/export.c
+++ b/erts/emulator/beam/export.c
@@ -208,7 +208,8 @@ erts_export_put(Eterm mod, Eterm func, unsigned int arity)
Export e;
int ix;
- ERTS_SMP_LC_ASSERT(erts_initialized == 0 || erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_initialized == 0
+ || erts_smp_thr_progress_is_blocking());
ASSERT(is_atom(mod));
ASSERT(is_atom(func));
e.code[0] = mod;
@@ -265,7 +266,8 @@ erts_export_consolidate(void)
HashInfo hi;
#endif
- ERTS_SMP_LC_ASSERT(erts_initialized == 0 || erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_initialized == 0
+ || erts_smp_thr_progress_is_blocking());
export_write_lock();
erts_index_merge(&secondary_export_table, &export_table);
diff --git a/erts/emulator/beam/fix_alloc.c b/erts/emulator/beam/fix_alloc.c
deleted file mode 100644
index 5637281597..0000000000
--- a/erts/emulator/beam/fix_alloc.c
+++ /dev/null
@@ -1,287 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
- *
- * The contents of this file are subject to the Erlang Public License,
- * Version 1.1, (the "License"); you may not use this file except in
- * compliance with the License. You should have received a copy of the
- * Erlang Public License along with this software. If not, it can be
- * retrieved online at http://www.erlang.org/.
- *
- * Software distributed under the License is distributed on an "AS IS"
- * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
- * the License for the specific language governing rights and limitations
- * under the License.
- *
- * %CopyrightEnd%
- */
-/* General purpose Memory allocator for fixed block size objects */
-/* This allocater is at least an order of magnitude faster than malloc() */
-
-
-#define NOPERBLOCK 20
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#include "erl_vm.h"
-#include "global.h"
-#include "erl_db.h"
-
-#ifdef ERTS_ALC_N_MIN_A_FIXED_SIZE
-
-#if ERTS_ALC_MTA_FIXED_SIZE
-#include "erl_threads.h"
-#include "erl_smp.h"
-# ifdef ERTS_SMP
-# define FA_LOCK(FA) erts_smp_spin_lock(&(FA)->slck)
-# define FA_UNLOCK(FA) erts_smp_spin_unlock(&(FA)->slck)
-# else
-# define FA_LOCK(FA) erts_mtx_lock(&(FA)->mtx)
-# define FA_UNLOCK(FA) erts_mtx_unlock(&(FA)->mtx)
-# endif
-#else
-# define FA_LOCK(FA)
-# define FA_UNLOCK(FA)
-#endif
-
-typedef union {double d; long l;} align_t;
-
-typedef struct fix_alloc_block {
- struct fix_alloc_block *next;
- align_t mem[1];
-} FixAllocBlock;
-
-typedef struct fix_alloc {
- Uint item_size;
- void *freelist;
- Uint no_free;
- Uint no_blocks;
- FixAllocBlock *blocks;
-#if ERTS_ALC_MTA_FIXED_SIZE
-# ifdef ERTS_SMP
- erts_smp_spinlock_t slck;
-# else
- erts_mtx_t mtx;
-# endif
-#endif
-} FixAlloc;
-
-static void *(*core_alloc)(Uint);
-static Uint xblk_sz;
-
-static FixAlloc **fa;
-#define FA_SZ (1 + ERTS_ALC_N_MAX_A_FIXED_SIZE - ERTS_ALC_N_MIN_A_FIXED_SIZE)
-
-#define FIX_IX(N) ((N) - ERTS_ALC_N_MIN_A_FIXED_SIZE)
-
-#define FIX_POOL_SZ(I_SZ) \
- ((I_SZ)*NOPERBLOCK + sizeof(FixAllocBlock) - sizeof(align_t))
-
-#if defined(DEBUG) && !ERTS_ALC_MTA_FIXED_SIZE
-static int first_time;
-#endif
-
-void erts_init_fix_alloc(Uint extra_block_size,
- void *(*alloc)(Uint))
-{
- int i;
-
- xblk_sz = extra_block_size;
- core_alloc = alloc;
-
- fa = (FixAlloc **) (*core_alloc)(FA_SZ * sizeof(FixAlloc *));
- if (!fa)
- erts_alloc_enomem(ERTS_ALC_T_UNDEF, FA_SZ * sizeof(FixAlloc *));
-
- for (i = 0; i < FA_SZ; i++)
- fa[i] = NULL;
-#if defined(DEBUG) && !ERTS_ALC_MTA_FIXED_SIZE
- first_time = 1;
-#endif
-}
-
-Uint
-erts_get_fix_size(ErtsAlcType_t type)
-{
- Uint i = FIX_IX(ERTS_ALC_T2N(type));
- return i < FA_SZ && fa[i] ? fa[i]->item_size : 0;
-}
-
-void
-erts_set_fix_size(ErtsAlcType_t type, Uint size)
-{
- Uint sz;
- Uint i;
- FixAlloc *fs;
- ErtsAlcType_t t_no = ERTS_ALC_T2N(type);
- sz = xblk_sz + size;
-
-#ifdef DEBUG
- ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= t_no);
- ASSERT(t_no <= ERTS_ALC_N_MAX_A_FIXED_SIZE);
-#endif
-
- while (sz % sizeof(align_t) != 0) /* Alignment */
- sz++;
-
- i = FIX_IX(t_no);
- fs = (FixAlloc *) (*core_alloc)(sizeof(FixAlloc));
- if (!fs)
- erts_alloc_n_enomem(t_no, sizeof(FixAlloc));
-
- fs->item_size = sz;
- fs->no_blocks = 0;
- fs->no_free = 0;
- fs->blocks = NULL;
- fs->freelist = NULL;
- if (fa[i])
- erl_exit(-1, "Attempt to overwrite existing fix size (%d)", i);
- fa[i] = fs;
-
-#if ERTS_ALC_MTA_FIXED_SIZE
-#ifdef ERTS_SMP
- erts_smp_spinlock_init_x(&fs->slck, "fix_alloc", make_small(i));
-#else
- erts_mtx_init_x(&fs->mtx, "fix_alloc", make_small(i));
-#endif
-#endif
-
-}
-
-void
-erts_fix_info(ErtsAlcType_t type, ErtsFixInfo *efip)
-{
- Uint i;
- FixAlloc *f;
-#ifdef DEBUG
- FixAllocBlock *b;
- void *fp;
-#endif
- Uint real_item_size;
- ErtsAlcType_t t_no = ERTS_ALC_T2N(type);
-
- ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= t_no);
- ASSERT(t_no <= ERTS_ALC_N_MAX_A_FIXED_SIZE);
-
- i = FIX_IX(t_no);
- f = fa[i];
-
- efip->total = sizeof(FixAlloc *);
- efip->used = 0;
- if (!f)
- return;
-
- real_item_size = f->item_size - xblk_sz;
-
- FA_LOCK(f);
-
- efip->total += sizeof(FixAlloc);
- efip->total += f->no_blocks*FIX_POOL_SZ(real_item_size);
- efip->used = efip->total - f->no_free*real_item_size;
-
-#ifdef DEBUG
- ASSERT(efip->total >= efip->used);
- for(i = 0, b = f->blocks; b; i++, b = b->next);
- ASSERT(f->no_blocks == i);
- for (i = 0, fp = f->freelist; fp; i++, fp = *((void **) fp));
- ASSERT(f->no_free == i);
-#endif
-
- FA_UNLOCK(f);
-
-}
-
-void
-erts_fix_free(ErtsAlcType_t t_no, void *extra, void* ptr)
-{
- Uint i;
- FixAlloc *f;
-
- ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= t_no);
- ASSERT(t_no <= ERTS_ALC_N_MAX_A_FIXED_SIZE);
-
- i = FIX_IX(t_no);
- f = fa[i];
-
- FA_LOCK(f);
- *((void **) ptr) = f->freelist;
- f->freelist = ptr;
- f->no_free++;
- FA_UNLOCK(f);
-}
-
-
-void *erts_fix_realloc(ErtsAlcType_t t_no, void *extra, void* ptr, Uint size)
-{
- erts_alc_fatal_error(ERTS_ALC_E_NOTSUP, ERTS_ALC_O_REALLOC, t_no);
- return NULL;
-}
-
-void *erts_fix_alloc(ErtsAlcType_t t_no, void *extra, Uint size)
-{
- void *ret;
- int i;
- FixAlloc *f;
-
-#if defined(DEBUG) && !ERTS_ALC_MTA_FIXED_SIZE
- ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= t_no);
- ASSERT(t_no <= ERTS_ALC_N_MAX_A_FIXED_SIZE);
- if (first_time) { /* Check that all sizes have been initialized */
- int i;
- for (i = 0; i < FA_SZ; i++)
- ASSERT(fa[i]);
- first_time = 0;
- }
-#endif
-
-
- i = FIX_IX(t_no);
- f = fa[i];
-
- ASSERT(f);
- ASSERT(f->item_size >= size);
-
- FA_LOCK(f);
- if (f->freelist == NULL) { /* Gotta alloc some more mem */
- char *ptr;
- FixAllocBlock *bl;
- Uint n;
-
-
- FA_UNLOCK(f);
- bl = (*core_alloc)(FIX_POOL_SZ(f->item_size));
- if (!bl)
- return NULL;
-
- FA_LOCK(f);
- bl->next = f->blocks; /* link in first */
- f->blocks = bl;
-
- n = NOPERBLOCK;
- ptr = (char *) &f->blocks->mem[0];
- while(n--) {
- *((void **) ptr) = f->freelist;
- f->freelist = (void *) ptr;
- ptr += f->item_size;
- }
-#if !ERTS_ALC_MTA_FIXED_SIZE
- ASSERT(f->no_free == 0);
-#endif
- f->no_free += NOPERBLOCK;
- f->no_blocks++;
- }
-
- ret = f->freelist;
- f->freelist = *((void **) f->freelist);
- ASSERT(f->no_free > 0);
- f->no_free--;
-
- FA_UNLOCK(f);
-
- return ret;
-}
-
-#endif /* #ifdef ERTS_ALC_N_MIN_A_FIXED_SIZE */
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 1005a7b941..4a4973baab 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -42,12 +42,6 @@
typedef struct port Port;
#include "erl_port_task.h"
-#define ERTS_MAX_NO_OF_ASYNC_THREADS 1024
-extern int erts_async_max_threads;
-#define ERTS_ASYNC_THREAD_MIN_STACK_SIZE 16 /* Kilo words */
-#define ERTS_ASYNC_THREAD_MAX_STACK_SIZE 8192 /* Kilo words */
-extern int erts_async_thread_suggested_stack_size;
-
typedef struct erts_driver_t_ erts_driver_t;
#define SMALL_IO_QUEUE 5 /* Number of fixed elements */
@@ -547,7 +541,7 @@ ERTS_GLB_INLINE void erts_may_save_closed_port(Port *prt)
tombstone = (Eterm*) erts_smp_atomic_add_read_nob(&erts_dead_ports_ptr,
-(erts_aint_t)sizeof(Eterm));
ASSERT(tombstone+1 != NULL);
- ASSERT(prt->snapshot == erts_smp_atomic_read_nob(&erts_ports_snapshot) - 1);
+ ASSERT(prt->snapshot == erts_smp_atomic32_read_nob(&erts_ports_snapshot) - 1);
*tombstone = prt->id;
}
/*else no ongoing snapshot or port was already included or created after snapshot */
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index 151c776a3d..fff720634d 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -42,6 +42,7 @@
#include "erl_bits.h"
#include "erl_version.h"
#include "error.h"
+#include "erl_async.h"
extern ErlDrvEntry fd_driver_entry;
extern ErlDrvEntry vanilla_driver_entry;
@@ -4579,7 +4580,10 @@ int driver_lock_driver(ErlDrvPort ix)
erts_smp_mtx_lock(&erts_driver_list_lock);
- if (prt == NULL) return -1;
+ if (prt == NULL) {
+ erts_smp_mtx_unlock(&erts_driver_list_lock);
+ return -1;
+ }
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
if ((dh = (DE_Handle*)prt->drv_ptr->handle ) == NULL) {
diff --git a/erts/emulator/beam/module.c b/erts/emulator/beam/module.c
index 91e4ccce70..b93b1ad09a 100644
--- a/erts/emulator/beam/module.c
+++ b/erts/emulator/beam/module.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -108,7 +108,8 @@ erts_put_module(Eterm mod)
int index;
ASSERT(is_atom(mod));
- ERTS_SMP_LC_ASSERT(erts_initialized == 0 || erts_smp_is_system_blocked(0));
+ ERTS_SMP_LC_ASSERT(erts_initialized == 0
+ || erts_smp_thr_progress_is_blocking());
e.module = atom_val(mod);
index = index_put(&module_table, (void*) &e);
return (Module*) erts_index_lookup(&module_table, index);
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index 669a601b35..f9cbcc5892 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -475,15 +475,6 @@ __decl_noreturn void __noreturn erl_exit(int n, char*, ...);
#define ERTS_ABORT_EXIT (INT_MIN + 1) /* no crash dump; only abort() */
#define ERTS_DUMP_EXIT (127) /* crash dump; then exit() */
-
-#ifndef ERTS_SMP
-int check_async_ready(void);
-#ifdef USE_THREADS
-void sys_async_ready(int hndl);
-int erts_register_async_ready_callback(void (*funcp)(void));
-#endif
-#endif
-
Eterm erts_check_io_info(void *p);
/* Size of misc memory allocated from system dependent code */
@@ -616,13 +607,10 @@ extern char *erts_sys_ddll_error(int code);
* System interfaces for startup.
*/
-
-#ifdef ERTS_SMP
void erts_sys_schedule_interrupt(int set);
+#ifdef ERTS_SMP
void erts_sys_schedule_interrupt_timed(int set, long msec);
void erts_sys_main_thread(void);
-#else
-#define erts_sys_schedule_interrupt(Set)
#endif
extern void erts_sys_prepare_crash_dump(void);
@@ -674,6 +662,8 @@ int erts_sys_putenv(char *key_value, int sep_ix);
*size), a value > 0 if value buffer is too small (*size is set to needed
size), and a value < 0 on failure. */
int erts_sys_getenv(char *key, char *value, size_t *size);
+/* erts_sys_getenv__() is only allowed to be used in early init phase */
+int erts_sys_getenv__(char *key, char *value, size_t *size);
/* Easier to use, but not as efficient, environment functions */
char *erts_read_env(char *key);
@@ -697,291 +687,14 @@ int erts_write_env(char *key, char *value);
int sys_alloc_opt(int, int);
typedef struct {
- Sint trim_threshold;
- Sint top_pad;
- Sint mmap_threshold;
- Sint mmap_max;
+ int trim_threshold;
+ int top_pad;
+ int mmap_threshold;
+ int mmap_max;
} SysAllocStat;
void sys_alloc_stat(SysAllocStat *);
-/* Block the whole system... */
-
-#define ERTS_BS_FLG_ALLOW_GC (((Uint32) 1) << 0)
-#define ERTS_BS_FLG_ALLOW_IO (((Uint32) 1) << 1)
-
-/* Activities... */
-typedef enum {
- ERTS_ACTIVITY_UNDEFINED, /* Undefined activity */
- ERTS_ACTIVITY_WAIT, /* Waiting */
- ERTS_ACTIVITY_GC, /* Garbage collecting */
- ERTS_ACTIVITY_IO /* I/O including message passing to erl procs */
-} erts_activity_t;
-
-#ifdef ERTS_SMP
-
-typedef enum {
- ERTS_ACT_ERR_LEAVE_WAIT_UNLOCKED,
- ERTS_ACT_ERR_LEAVE_UNKNOWN_ACTIVITY,
- ERTS_ACT_ERR_ENTER_UNKNOWN_ACTIVITY
-} erts_activity_error_t;
-
-typedef struct {
- erts_smp_atomic32_t do_block;
- struct {
- erts_smp_atomic32_t wait;
- erts_smp_atomic32_t gc;
- erts_smp_atomic32_t io;
- } in_activity;
-} erts_system_block_state_t;
-
-extern erts_system_block_state_t erts_system_block_state;
-
-int erts_is_system_blocked(erts_activity_t allowed_activities);
-void erts_block_me(void (*prepare)(void *), void (*resume)(void *), void *arg);
-void erts_register_blockable_thread(void);
-void erts_unregister_blockable_thread(void);
-void erts_note_activity_begin(erts_activity_t activity);
-void
-erts_check_block(erts_activity_t old_activity,
- erts_activity_t new_activity,
- int locked,
- void (*prepare)(void *),
- void (*resume)(void *),
- void *arg);
-void erts_block_system(Uint32 allowed_activities);
-int erts_emergency_block_system(long timeout, Uint32 allowed_activities);
-void erts_release_system(void);
-void erts_system_block_init(void);
-void erts_set_activity_error(erts_activity_error_t, char *, int);
-#ifdef ERTS_ENABLE_LOCK_CHECK
-void erts_lc_activity_change_begin(void);
-void erts_lc_activity_change_end(void);
-int erts_lc_is_blocking(void);
-#define ERTS_LC_IS_BLOCKING \
- (erts_smp_pending_system_block() && erts_lc_is_blocking())
-#endif
-#endif
-
-#define erts_smp_activity_begin(NACT, PRP, RSM, ARG) \
- erts_smp_set_activity(ERTS_ACTIVITY_UNDEFINED, \
- (NACT), \
- 0, \
- (PRP), \
- (RSM), \
- (ARG), \
- __FILE__, \
- __LINE__)
-#define erts_smp_activity_change(OACT, NACT, PRP, RSM, ARG) \
- erts_smp_set_activity((OACT), \
- (NACT), \
- 0, \
- (PRP), \
- (RSM), \
- (ARG), \
- __FILE__, \
- __LINE__)
-#define erts_smp_activity_end(OACT, PRP, RSM, ARG) \
- erts_smp_set_activity((OACT), \
- ERTS_ACTIVITY_UNDEFINED, \
- 0, \
- (PRP), \
- (RSM), \
- (ARG), \
- __FILE__, \
- __LINE__)
-
-#define erts_smp_locked_activity_begin(NACT) \
- erts_smp_set_activity(ERTS_ACTIVITY_UNDEFINED, \
- (NACT), \
- 1, \
- NULL, \
- NULL, \
- NULL, \
- __FILE__, \
- __LINE__)
-#define erts_smp_locked_activity_change(OACT, NACT) \
- erts_smp_set_activity((OACT), \
- (NACT), \
- 1, \
- NULL, \
- NULL, \
- NULL, \
- __FILE__, \
- __LINE__)
-#define erts_smp_locked_activity_end(OACT) \
- erts_smp_set_activity((OACT), \
- ERTS_ACTIVITY_UNDEFINED, \
- 1, \
- NULL, \
- NULL, \
- NULL, \
- __FILE__, \
- __LINE__)
-
-
-ERTS_GLB_INLINE int erts_smp_is_system_blocked(erts_activity_t allowed_activities);
-ERTS_GLB_INLINE void erts_smp_block_system(Uint32 allowed_activities);
-ERTS_GLB_INLINE int erts_smp_emergency_block_system(long timeout,
- Uint32 allowed_activities);
-ERTS_GLB_INLINE void erts_smp_release_system(void);
-ERTS_GLB_INLINE int erts_smp_pending_system_block(void);
-ERTS_GLB_INLINE void erts_smp_chk_system_block(void (*prepare)(void *),
- void (*resume)(void *),
- void *arg);
-ERTS_GLB_INLINE void
-erts_smp_set_activity(erts_activity_t old_activity,
- erts_activity_t new_activity,
- int locked,
- void (*prepare)(void *),
- void (*resume)(void *),
- void *arg,
- char *file,
- int line);
-
-#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-
-
-ERTS_GLB_INLINE int
-erts_smp_is_system_blocked(erts_activity_t allowed_activities)
-{
-#ifdef ERTS_SMP
- return erts_is_system_blocked(allowed_activities);
-#else
- return 1;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_block_system(Uint32 allowed_activities)
-{
-#ifdef ERTS_SMP
- erts_block_system(allowed_activities);
-#endif
-}
-
-ERTS_GLB_INLINE int
-erts_smp_emergency_block_system(long timeout, Uint32 allowed_activities)
-{
-#ifdef ERTS_SMP
- return erts_emergency_block_system(timeout, allowed_activities);
-#else
- return 0;
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_release_system(void)
-{
-#ifdef ERTS_SMP
- erts_release_system();
-#endif
-}
-
-ERTS_GLB_INLINE int
-erts_smp_pending_system_block(void)
-{
-#ifdef ERTS_SMP
- return (int) erts_smp_atomic32_read_nob(&erts_system_block_state.do_block);
-#else
- return 0;
-#endif
-}
-
-
-ERTS_GLB_INLINE void
-erts_smp_chk_system_block(void (*prepare)(void *),
- void (*resume)(void *),
- void *arg)
-{
-#ifdef ERTS_SMP
- if (erts_smp_pending_system_block())
- erts_block_me(prepare, resume, arg);
-#endif
-}
-
-ERTS_GLB_INLINE void
-erts_smp_set_activity(erts_activity_t old_activity,
- erts_activity_t new_activity,
- int locked,
- void (*prepare)(void *),
- void (*resume)(void *),
- void *arg,
- char *file,
- int line)
-{
-#ifdef ERTS_SMP
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_activity_change_begin();
-#endif
- switch (old_activity) {
- case ERTS_ACTIVITY_UNDEFINED:
- break;
- case ERTS_ACTIVITY_WAIT:
- erts_smp_atomic32_dec_acqb(&erts_system_block_state.in_activity.wait);
- if (locked) {
- /* You are not allowed to leave activity waiting
- * without supplying the possibility to block
- * unlocked.
- */
- erts_set_activity_error(ERTS_ACT_ERR_LEAVE_WAIT_UNLOCKED,
- file, line);
- }
- break;
- case ERTS_ACTIVITY_GC:
- erts_smp_atomic32_dec_acqb(&erts_system_block_state.in_activity.gc);
- break;
- case ERTS_ACTIVITY_IO:
- erts_smp_atomic32_dec_acqb(&erts_system_block_state.in_activity.io);
- break;
- default:
- erts_set_activity_error(ERTS_ACT_ERR_LEAVE_UNKNOWN_ACTIVITY,
- file, line);
- break;
- }
-
- /* We are not allowed to block when going to activity waiting... */
- if (new_activity != ERTS_ACTIVITY_WAIT && erts_smp_pending_system_block())
- erts_check_block(old_activity,new_activity,locked,prepare,resume,arg);
-
- switch (new_activity) {
- case ERTS_ACTIVITY_UNDEFINED:
- break;
- case ERTS_ACTIVITY_WAIT:
- erts_smp_atomic32_inc_mb(&erts_system_block_state.in_activity.wait);
- break;
- case ERTS_ACTIVITY_GC:
- erts_smp_atomic32_inc_mb(&erts_system_block_state.in_activity.gc);
- break;
- case ERTS_ACTIVITY_IO:
- erts_smp_atomic32_inc_mb(&erts_system_block_state.in_activity.io);
- break;
- default:
- erts_set_activity_error(ERTS_ACT_ERR_ENTER_UNKNOWN_ACTIVITY,
- file, line);
- break;
- }
-
- switch (new_activity) {
- case ERTS_ACTIVITY_WAIT:
- case ERTS_ACTIVITY_GC:
- case ERTS_ACTIVITY_IO:
- if (erts_smp_pending_system_block())
- erts_note_activity_begin(new_activity);
- break;
- default:
- break;
- }
-
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_activity_change_end();
-#endif
-
-#endif
-}
-
-#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
-
#if defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK)
#undef ERTS_REFC_DEBUG
#define ERTS_REFC_DEBUG
diff --git a/erts/emulator/beam/time.c b/erts/emulator/beam/time.c
index 8fa8c1cfe0..db9a24e0a3 100644
--- a/erts/emulator/beam/time.c
+++ b/erts/emulator/beam/time.c
@@ -444,7 +444,7 @@ erts_time_left(ErlTimer *p)
}
#ifdef DEBUG
-void erts_p_slpq()
+void erts_p_slpq(void)
{
int i;
ErlTimer* p;
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 825cb140b2..1bd178f280 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -42,6 +42,9 @@
#include "erl_threads.h"
#include "erl_smp.h"
#include "erl_time.h"
+#include "erl_thr_progress.h"
+#include "erl_thr_queue.h"
+#include "erl_sched_spec_pre_alloc.h"
#undef M_TRIM_THRESHOLD
#undef M_TOP_PAD
@@ -75,6 +78,7 @@ typedef struct {
#ifdef ERTS_SMP
+#if 0 /* Unused */
static void
dispatch_profile_msg_q(profile_sched_msg_q *psmq)
{
@@ -86,6 +90,7 @@ dispatch_profile_msg_q(profile_sched_msg_q *psmq)
profile_scheduler_q(make_small(msg->scheduler_id), msg->state, am_undefined, msg->Ms, msg->s, msg->us);
}
}
+#endif
#endif
@@ -3317,10 +3322,10 @@ erts_cancel_smp_ptimer(ErtsSmpPTimer *ptimer)
#endif
-static Sint trim_threshold;
-static Sint top_pad;
-static Sint mmap_threshold;
-static Sint mmap_max;
+static int trim_threshold;
+static int top_pad;
+static int mmap_threshold;
+static int mmap_max;
Uint tot_bin_allocated;
@@ -3343,8 +3348,8 @@ int
sys_alloc_opt(int opt, int value)
{
#if HAVE_MALLOPT
- Sint m_opt;
- Sint *curr_val;
+ int m_opt;
+ int *curr_val;
switch(opt) {
case SYS_ALLOC_OPT_TRIM_THRESHOLD:
@@ -3384,7 +3389,7 @@ sys_alloc_opt(int opt, int value)
}
if(mallopt(m_opt, value)) {
- *curr_val = (Sint) value;
+ *curr_val = value;
return 1;
}
@@ -3403,688 +3408,6 @@ sys_alloc_stat(SysAllocStat *sasp)
}
-#ifdef ERTS_SMP
-
-/* Local system block state */
-
-struct {
- int emergency;
- long emergency_timeout;
- erts_smp_cnd_t watchdog_cnd;
- erts_smp_tid_t watchdog_tid;
- int threads_to_block;
- int have_blocker;
- erts_smp_tid_t blocker_tid;
- int recursive_block;
- Uint32 allowed_activities;
- erts_smp_tsd_key_t blockable_key;
- erts_smp_mtx_t mtx;
- erts_smp_cnd_t cnd;
-#ifdef ERTS_ENABLE_LOCK_CHECK
- int activity_changing;
- int checking;
-#endif
-} system_block_state;
-
-/* Global system block state */
-erts_system_block_state_t erts_system_block_state;
-
-
-static ERTS_INLINE int
-is_blockable_thread(void)
-{
- return erts_smp_tsd_get(system_block_state.blockable_key) != NULL;
-}
-
-static ERTS_INLINE int
-is_blocker(void)
-{
- return (system_block_state.have_blocker
- && erts_smp_equal_tids(system_block_state.blocker_tid,
- erts_smp_thr_self()));
-}
-
-#ifdef ERTS_ENABLE_LOCK_CHECK
-int
-erts_lc_is_blocking(void)
-{
- int res;
- erts_smp_mtx_lock(&system_block_state.mtx);
- res = erts_smp_pending_system_block() && is_blocker();
- erts_smp_mtx_unlock(&system_block_state.mtx);
- return res;
-}
-#endif
-
-static ERTS_INLINE void
-block_me(void (*prepare)(void *),
- void (*resume)(void *),
- void *arg,
- int mtx_locked,
- int want_to_block,
- int update_act_changing,
- profile_sched_msg_q *psmq)
-{
- if (prepare)
- (*prepare)(arg);
-
- /* Locks might be held... */
-
- if (!mtx_locked)
- erts_smp_mtx_lock(&system_block_state.mtx);
-
- if (erts_smp_pending_system_block() && !is_blocker()) {
- int is_blockable = is_blockable_thread();
- ASSERT(is_blockable);
-
- if (is_blockable)
- system_block_state.threads_to_block--;
-
- if (erts_system_profile_flags.scheduler && psmq) {
- ErtsSchedulerData *esdp = erts_get_scheduler_data();
- if (esdp) {
- profile_sched_msg *msg = NULL;
-
- ASSERT(psmq->n < 2);
- msg = &((psmq->msg)[psmq->n]);
- msg->scheduler_id = esdp->no;
- get_now(&(msg->Ms), &(msg->s), &(msg->us));
- msg->no_schedulers = 0;
- msg->state = am_inactive;
- psmq->n++;
- }
- }
-
-#ifdef ERTS_ENABLE_LOCK_CHECK
- if (update_act_changing)
- system_block_state.activity_changing--;
-#endif
-
- erts_smp_cnd_broadcast(&system_block_state.cnd);
-
- do {
- erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx);
- } while (erts_smp_pending_system_block()
- && !(want_to_block && !system_block_state.have_blocker));
-
-#ifdef ERTS_ENABLE_LOCK_CHECK
- if (update_act_changing)
- system_block_state.activity_changing++;
-#endif
- if (erts_system_profile_flags.scheduler && psmq) {
- ErtsSchedulerData *esdp = erts_get_scheduler_data();
- if (esdp) {
- profile_sched_msg *msg = NULL;
-
- ASSERT(psmq->n < 2);
- msg = &((psmq->msg)[psmq->n]);
- msg->scheduler_id = esdp->no;
- get_now(&(msg->Ms), &(msg->s), &(msg->us));
- msg->no_schedulers = 0;
- msg->state = am_active;
- psmq->n++;
- }
- }
-
- if (is_blockable)
- system_block_state.threads_to_block++;
- }
-
- if (!mtx_locked)
- erts_smp_mtx_unlock(&system_block_state.mtx);
-
- if (resume)
- (*resume)(arg);
-}
-
-void
-erts_block_me(void (*prepare)(void *),
- void (*resume)(void *),
- void *arg)
-{
- profile_sched_msg_q psmq;
- psmq.n = 0;
- if (prepare)
- (*prepare)(arg);
-
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_check_exact(NULL, 0); /* No locks should be locked */
-#endif
-
- block_me(NULL, NULL, NULL, 0, 0, 0, &psmq);
-
- if (erts_system_profile_flags.scheduler && psmq.n > 0)
- dispatch_profile_msg_q(&psmq);
-
- if (resume)
- (*resume)(arg);
-}
-
-void
-erts_register_blockable_thread(void)
-{
- profile_sched_msg_q psmq;
- psmq.n = 0;
- if (!is_blockable_thread()) {
- erts_smp_mtx_lock(&system_block_state.mtx);
- system_block_state.threads_to_block++;
- erts_smp_tsd_set(system_block_state.blockable_key,
- (void *) &erts_system_block_state);
-
- /* Someone might be waiting for us to block... */
- if (erts_smp_pending_system_block())
- block_me(NULL, NULL, NULL, 1, 0, 0, &psmq);
- erts_smp_mtx_unlock(&system_block_state.mtx);
-
- if (erts_system_profile_flags.scheduler && psmq.n > 0)
- dispatch_profile_msg_q(&psmq);
- }
-}
-
-void
-erts_unregister_blockable_thread(void)
-{
- if (is_blockable_thread()) {
- erts_smp_mtx_lock(&system_block_state.mtx);
- system_block_state.threads_to_block--;
- ASSERT(system_block_state.threads_to_block >= 0);
- erts_smp_tsd_set(system_block_state.blockable_key, NULL);
-
- /* Someone might be waiting for us to block... */
- if (erts_smp_pending_system_block())
- erts_smp_cnd_broadcast(&system_block_state.cnd);
- erts_smp_mtx_unlock(&system_block_state.mtx);
- }
-}
-
-void
-erts_note_activity_begin(erts_activity_t activity)
-{
- erts_smp_mtx_lock(&system_block_state.mtx);
- if (erts_smp_pending_system_block()) {
- Uint32 broadcast = 0;
- switch (activity) {
- case ERTS_ACTIVITY_GC:
- broadcast = (system_block_state.allowed_activities
- & ERTS_BS_FLG_ALLOW_GC);
- break;
- case ERTS_ACTIVITY_IO:
- broadcast = (system_block_state.allowed_activities
- & ERTS_BS_FLG_ALLOW_IO);
- break;
- case ERTS_ACTIVITY_WAIT:
- broadcast = 1;
- break;
- default:
- abort();
- break;
- }
- if (broadcast)
- erts_smp_cnd_broadcast(&system_block_state.cnd);
- }
- erts_smp_mtx_unlock(&system_block_state.mtx);
-}
-
-void
-erts_check_block(erts_activity_t old_activity,
- erts_activity_t new_activity,
- int locked,
- void (*prepare)(void *),
- void (*resume)(void *),
- void *arg)
-{
- int do_block;
- profile_sched_msg_q psmq;
-
- psmq.n = 0;
- if (!locked && prepare)
- (*prepare)(arg);
-
- erts_smp_mtx_lock(&system_block_state.mtx);
-
- /* First check if it is ok to block... */
- if (!locked)
- do_block = 1;
- else {
- switch (old_activity) {
- case ERTS_ACTIVITY_UNDEFINED:
- do_block = 0;
- break;
- case ERTS_ACTIVITY_GC:
- do_block = (system_block_state.allowed_activities
- & ERTS_BS_FLG_ALLOW_GC);
- break;
- case ERTS_ACTIVITY_IO:
- do_block = (system_block_state.allowed_activities
- & ERTS_BS_FLG_ALLOW_IO);
- break;
- case ERTS_ACTIVITY_WAIT:
- /* You are not allowed to leave activity waiting
- * without supplying the possibility to block
- * unlocked.
- */
- erts_set_activity_error(ERTS_ACT_ERR_LEAVE_WAIT_UNLOCKED,
- __FILE__, __LINE__);
- do_block = 0;
- break;
- default:
- erts_set_activity_error(ERTS_ACT_ERR_LEAVE_UNKNOWN_ACTIVITY,
- __FILE__, __LINE__);
- do_block = 0;
- break;
- }
- }
-
- if (do_block) {
- /* ... then check if it is necessary to block... */
-
- switch (new_activity) {
- case ERTS_ACTIVITY_UNDEFINED:
- do_block = 1;
- break;
- case ERTS_ACTIVITY_GC:
- do_block = !(system_block_state.allowed_activities
- & ERTS_BS_FLG_ALLOW_GC);
- break;
- case ERTS_ACTIVITY_IO:
- do_block = !(system_block_state.allowed_activities
- & ERTS_BS_FLG_ALLOW_IO);
- break;
- case ERTS_ACTIVITY_WAIT:
- /* No need to block if we are going to wait */
- do_block = 0;
- break;
- default:
- erts_set_activity_error(ERTS_ACT_ERR_ENTER_UNKNOWN_ACTIVITY,
- __FILE__, __LINE__);
- break;
- }
- }
-
- if (do_block) {
-
-#ifdef ERTS_ENABLE_LOCK_CHECK
- if (!locked) {
- /* Only system_block_state.mtx should be held */
- erts_lc_check_exact(&system_block_state.mtx.lc, 1);
- }
-#endif
-
- block_me(NULL, NULL, NULL, 1, 0, 1, &psmq);
-
- }
-
- erts_smp_mtx_unlock(&system_block_state.mtx);
-
- if (erts_system_profile_flags.scheduler && psmq.n > 0)
- dispatch_profile_msg_q(&psmq);
-
- if (!locked && resume)
- (*resume)(arg);
-}
-
-
-
-void
-erts_set_activity_error(erts_activity_error_t error, char *file, int line)
-{
- switch (error) {
- case ERTS_ACT_ERR_LEAVE_WAIT_UNLOCKED:
- erl_exit(1, "%s:%d: Fatal error: Leaving activity waiting without "
- "supplying the possibility to block unlocked.",
- file, line);
- break;
- case ERTS_ACT_ERR_LEAVE_UNKNOWN_ACTIVITY:
- erl_exit(1, "%s:%d: Fatal error: Leaving unknown activity.",
- file, line);
- break;
- case ERTS_ACT_ERR_ENTER_UNKNOWN_ACTIVITY:
- erl_exit(1, "%s:%d: Fatal error: Leaving unknown activity.",
- file, line);
- break;
- default:
- erl_exit(1, "%s:%d: Internal error in erts_smp_set_activity()",
- file, line);
- break;
- }
-
-}
-
-
-static ERTS_INLINE erts_aint32_t
-threads_not_under_control(void)
-{
- erts_aint32_t res = system_block_state.threads_to_block;
-
- ERTS_THR_MEMORY_BARRIER;
-
- /* Waiting is always an allowed activity... */
- res -= erts_smp_atomic32_read_nob(&erts_system_block_state.in_activity.wait);
-
- if (system_block_state.allowed_activities & ERTS_BS_FLG_ALLOW_GC)
- res -= erts_smp_atomic32_read_nob(&erts_system_block_state.in_activity.gc);
-
- if (system_block_state.allowed_activities & ERTS_BS_FLG_ALLOW_IO)
- res -= erts_smp_atomic32_read_nob(&erts_system_block_state.in_activity.io);
-
- if (res < 0) {
- ASSERT(0);
- return 0;
- }
- return res;
-}
-
-/*
- * erts_block_system() blocks all threads registered as blockable.
- * It doesn't return until either all threads have blocked (0 is returned)
- * or it has timed out (ETIMEDOUT) is returned.
- *
- * If allowed activities == 0, blocked threads will release all locks
- * before blocking.
- *
- * If allowed_activities is != 0, erts_block_system() will allow blockable
- * threads to continue executing as long as they are doing an allowed
- * activity. When they are done with the allowed activity they will block,
- * *but* they will block holding locks. Therefore, the thread calling
- * erts_block_system() must *not* try to aquire any locks that might be
- * held by blocked threads holding locks from allowed activities.
- *
- * Currently allowed_activities are:
- * * ERTS_BS_FLG_ALLOW_GC Thread continues with garbage
- * collection and blocks with
- * main process lock on current
- * process locked.
- * * ERTS_BS_FLG_ALLOW_IO Thread continues with I/O
- */
-
-void
-erts_block_system(Uint32 allowed_activities)
-{
- int do_block;
- profile_sched_msg_q psmq;
-
- psmq.n = 0;
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_check_exact(NULL, 0); /* No locks should be locked */
-#endif
-
- erts_smp_mtx_lock(&system_block_state.mtx);
-
- do_block = erts_smp_pending_system_block();
- if (do_block
- && system_block_state.have_blocker
- && erts_smp_equal_tids(system_block_state.blocker_tid,
- erts_smp_thr_self())) {
- ASSERT(system_block_state.recursive_block >= 0);
- system_block_state.recursive_block++;
-
- /* You are not allowed to restrict allowed activites
- in a recursive block! */
- ERTS_SMP_LC_ASSERT((system_block_state.allowed_activities
- & ~allowed_activities) == 0);
- }
- else {
-
- erts_smp_atomic32_inc_nob(&erts_system_block_state.do_block);
-
- /* Someone else might be waiting for us to block... */
- if (do_block) {
- do_block_me:
- block_me(NULL, NULL, NULL, 1, 1, 0, &psmq);
- }
-
- ASSERT(!system_block_state.have_blocker);
- system_block_state.have_blocker = 1;
- system_block_state.blocker_tid = erts_smp_thr_self();
- system_block_state.allowed_activities = allowed_activities;
-
- if (is_blockable_thread())
- system_block_state.threads_to_block--;
-
- while (threads_not_under_control() && !system_block_state.emergency)
- erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx);
-
- if (system_block_state.emergency) {
- system_block_state.have_blocker = 0;
- goto do_block_me;
- }
- }
-
- erts_smp_mtx_unlock(&system_block_state.mtx);
-
- if (erts_system_profile_flags.scheduler && psmq.n > 0 )
- dispatch_profile_msg_q(&psmq);
-}
-
-/*
- * erts_emergency_block_system() should only be called when we are
- * about to write a crash dump...
- */
-
-int
-erts_emergency_block_system(long timeout, Uint32 allowed_activities)
-{
- int res = 0;
- long another_blocker;
-
- erts_smp_mtx_lock(&system_block_state.mtx);
-
- if (system_block_state.emergency) {
- /* Argh... */
- res = EINVAL;
- goto done;
- }
-
- another_blocker = erts_smp_pending_system_block();
- system_block_state.emergency = 1;
- erts_smp_atomic32_inc_nob(&erts_system_block_state.do_block);
-
- if (another_blocker) {
- if (is_blocker()) {
- erts_smp_atomic32_dec_nob(&erts_system_block_state.do_block);
- res = 0;
- goto done;
- }
- /* kick the other blocker */
- erts_smp_cnd_broadcast(&system_block_state.cnd);
- while (system_block_state.have_blocker)
- erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx);
- }
-
- ASSERT(!system_block_state.have_blocker);
- system_block_state.have_blocker = 1;
- system_block_state.blocker_tid = erts_smp_thr_self();
- system_block_state.allowed_activities = allowed_activities;
-
- if (is_blockable_thread())
- system_block_state.threads_to_block--;
-
- if (timeout < 0) {
- while (threads_not_under_control())
- erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx);
- }
- else {
- system_block_state.emergency_timeout = timeout;
- erts_smp_cnd_signal(&system_block_state.watchdog_cnd);
-
- while (system_block_state.emergency_timeout >= 0
- && threads_not_under_control()) {
- erts_smp_cnd_wait(&system_block_state.cnd,
- &system_block_state.mtx);
- }
- }
- done:
- erts_smp_mtx_unlock(&system_block_state.mtx);
- return res;
-}
-
-void
-erts_release_system(void)
-{
- long do_block;
- profile_sched_msg_q psmq;
-
- psmq.n = 0;
-
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_check_exact(NULL, 0); /* No locks should be locked */
-#endif
-
- erts_smp_mtx_lock(&system_block_state.mtx);
- ASSERT(is_blocker());
-
- ASSERT(system_block_state.recursive_block >= 0);
-
- if (system_block_state.recursive_block)
- system_block_state.recursive_block--;
- else {
- do_block = erts_smp_atomic32_dec_read_nob(&erts_system_block_state.do_block);
- system_block_state.have_blocker = 0;
- if (is_blockable_thread())
- system_block_state.threads_to_block++;
- else
- do_block = 0;
-
- /* Someone else might be waiting for us to block... */
- if (do_block)
- block_me(NULL, NULL, NULL, 1, 0, 0, &psmq);
- else
- erts_smp_cnd_broadcast(&system_block_state.cnd);
- }
-
- erts_smp_mtx_unlock(&system_block_state.mtx);
-
- if (erts_system_profile_flags.scheduler && psmq.n > 0)
- dispatch_profile_msg_q(&psmq);
-}
-
-#ifdef ERTS_ENABLE_LOCK_CHECK
-
-void
-erts_lc_activity_change_begin(void)
-{
- erts_smp_mtx_lock(&system_block_state.mtx);
- system_block_state.activity_changing++;
- erts_smp_mtx_unlock(&system_block_state.mtx);
-}
-
-void
-erts_lc_activity_change_end(void)
-{
- erts_smp_mtx_lock(&system_block_state.mtx);
- system_block_state.activity_changing--;
- if (system_block_state.checking && !system_block_state.activity_changing)
- erts_smp_cnd_broadcast(&system_block_state.cnd);
- erts_smp_mtx_unlock(&system_block_state.mtx);
-}
-
-#endif
-
-int
-erts_is_system_blocked(erts_activity_t allowed_activities)
-{
- int blkd;
-
- erts_smp_mtx_lock(&system_block_state.mtx);
- blkd = (erts_smp_pending_system_block()
- && system_block_state.have_blocker
- && erts_smp_equal_tids(system_block_state.blocker_tid,
- erts_smp_thr_self())
- && !(system_block_state.allowed_activities & ~allowed_activities));
-#ifdef ERTS_ENABLE_LOCK_CHECK
- if (blkd) {
- system_block_state.checking = 1;
- while (system_block_state.activity_changing)
- erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx);
- system_block_state.checking = 0;
- blkd = !threads_not_under_control();
- }
-#endif
- erts_smp_mtx_unlock(&system_block_state.mtx);
- return blkd;
-}
-
-static void *
-emergency_watchdog(void *unused)
-{
- erts_smp_mtx_lock(&system_block_state.mtx);
- while (1) {
- long timeout;
- while (system_block_state.emergency_timeout < 0)
- erts_smp_cnd_wait(&system_block_state.watchdog_cnd, &system_block_state.mtx);
- timeout = system_block_state.emergency_timeout;
- erts_smp_mtx_unlock(&system_block_state.mtx);
-
- if (erts_disable_tolerant_timeofday)
- erts_milli_sleep(timeout);
- else {
- SysTimeval to;
- erts_get_timeval(&to);
- to.tv_sec += timeout / 1000;
- to.tv_usec += timeout % 1000;
-
- while (1) {
- SysTimeval curr;
- erts_milli_sleep(timeout);
- erts_get_timeval(&curr);
- if (curr.tv_sec > to.tv_sec
- || (curr.tv_sec == to.tv_sec && curr.tv_usec >= to.tv_usec)) {
- break;
- }
- timeout = (to.tv_sec - curr.tv_sec)*1000;
- timeout += (to.tv_usec - curr.tv_usec)/1000;
- }
- }
-
- erts_smp_mtx_lock(&system_block_state.mtx);
- system_block_state.emergency_timeout = -1;
- erts_smp_cnd_broadcast(&system_block_state.cnd);
- }
- erts_smp_mtx_unlock(&system_block_state.mtx);
- return NULL;
-}
-
-void
-erts_system_block_init(void)
-{
- erts_smp_thr_opts_t thr_opts = ERTS_SMP_THR_OPTS_DEFAULT_INITER;
- /* Local state... */
- system_block_state.emergency = 0;
- system_block_state.emergency_timeout = -1;
- erts_smp_cnd_init(&system_block_state.watchdog_cnd);
- system_block_state.threads_to_block = 0;
- system_block_state.have_blocker = 0;
- /* system_block_state.block_tid */
- system_block_state.recursive_block = 0;
- system_block_state.allowed_activities = 0;
- erts_smp_tsd_key_create(&system_block_state.blockable_key);
- erts_smp_mtx_init(&system_block_state.mtx, "system_block");
- erts_smp_cnd_init(&system_block_state.cnd);
-#ifdef ERTS_ENABLE_LOCK_CHECK
- system_block_state.activity_changing = 0;
- system_block_state.checking = 0;
-#endif
-
- thr_opts.suggested_stack_size = 8;
- erts_smp_thr_create(&system_block_state.watchdog_tid,
- emergency_watchdog,
- NULL,
- &thr_opts);
-
- /* Global state... */
-
- erts_smp_atomic32_init_nob(&erts_system_block_state.do_block, 0);
- erts_smp_atomic32_init_nob(&erts_system_block_state.in_activity.wait, 0);
- erts_smp_atomic32_init_nob(&erts_system_block_state.in_activity.gc, 0);
- erts_smp_atomic32_init_nob(&erts_system_block_state.in_activity.io, 0);
-
- /* Make sure blockable threads unregister when exiting... */
- erts_smp_install_exit_handler(erts_unregister_blockable_thread);
-}
-
-
-#endif /* #ifdef ERTS_SMP */
-
char *
erts_read_env(char *key)
{
diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4
index 14fb04f609..48c7c1bc9b 100644
--- a/erts/emulator/hipe/hipe_bif_list.m4
+++ b/erts/emulator/hipe/hipe_bif_list.m4
@@ -144,7 +144,6 @@
/*
* Zero-arity BIFs that can fail.
*/
-standard_bif_interface_0(nbif_memory_0, memory_0)
standard_bif_interface_0(nbif_processes_0, processes_0)
/*
diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c
index 57321259f9..ba88fd1d39 100644
--- a/erts/emulator/sys/common/erl_check_io.c
+++ b/erts/emulator/sys/common/erl_check_io.c
@@ -35,6 +35,7 @@
#include "sys.h"
#include "global.h"
#include "erl_check_io.h"
+#include "erl_thr_progress.h"
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
# define ERTS_DRV_EV_STATE_EXTRA_SIZE 128
@@ -66,6 +67,9 @@ typedef char EventStateFlags;
#define ERTS_CIO_POLL_CTL ERTS_POLL_EXPORT(erts_poll_control)
#define ERTS_CIO_POLL_WAIT ERTS_POLL_EXPORT(erts_poll_wait)
+#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
+#define ERTS_CIO_POLL_AS_INTR ERTS_POLL_EXPORT(erts_poll_async_sig_interrupt)
+#endif
#define ERTS_CIO_POLL_INTR ERTS_POLL_EXPORT(erts_poll_interrupt)
#define ERTS_CIO_POLL_INTR_TMD ERTS_POLL_EXPORT(erts_poll_interrupt_timed)
#define ERTS_CIO_NEW_POLLSET ERTS_POLL_EXPORT(erts_poll_create_pollset)
@@ -1115,6 +1119,14 @@ eready(Eterm id, ErtsDrvEventState *state, ErlDrvEventData event_data)
static void bad_fd_in_pollset( ErtsDrvEventState *, Eterm, Eterm, ErtsPollEvents);
+#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
+void
+ERTS_CIO_EXPORT(erts_check_io_async_sig_interrupt)(void)
+{
+ ERTS_CIO_POLL_AS_INTR(pollset.ps);
+}
+#endif
+
void
ERTS_CIO_EXPORT(erts_check_io_interrupt)(int set)
{
@@ -1153,7 +1165,6 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_check_exact(NULL, 0); /* No locks should be locked */
#endif
- erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL);
pollres_len = sizeof(pollres)/sizeof(ErtsPollResFd);
erts_smp_atomic_set_nob(&pollset.in_poll_wait, 1);
@@ -1163,7 +1174,6 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_check_exact(NULL, 0); /* No locks should be locked */
#endif
- erts_smp_activity_end(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL);
erts_deliver_time(); /* sync the machine's idea of time */
@@ -1870,13 +1880,12 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(void)
erts_printf("--- fds in pollset --------------------------------------\n");
-#ifdef ERTS_SMP
-# ifdef ERTS_ENABLE_LOCK_CHECK
+#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
erts_lc_check_exact(NULL, 0); /* No locks should be locked */
-# endif
- erts_block_system(0); /* stop the world to avoid messy locking */
#endif
+ erts_smp_thr_progress_block(); /* stop the world to avoid messy locking */
+
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
counters.epep = erts_alloc(ERTS_ALC_T_TMP, sizeof(ErtsPollEvents)*max_fds);
ERTS_POLL_EXPORT(erts_poll_get_selected_events)(pollset.ps, counters.epep, max_fds);
@@ -1898,9 +1907,7 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(void)
safe_hash_for_each(&drv_ev_state_tab, &doit_erts_check_io_debug, (void *) &counters);
#endif
-#ifdef ERTS_SMP
- erts_release_system();
-#endif
+ erts_smp_thr_progress_unblock();
erts_printf("\n");
erts_printf("used fds=%d\n", counters.used_fds);
diff --git a/erts/emulator/sys/common/erl_check_io.h b/erts/emulator/sys/common/erl_check_io.h
index 9b45a63913..7cc1658062 100644
--- a/erts/emulator/sys/common/erl_check_io.h
+++ b/erts/emulator/sys/common/erl_check_io.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -40,6 +40,10 @@ Eterm erts_check_io_info_kp(void *);
Eterm erts_check_io_info_nkp(void *);
int erts_check_io_max_files_kp(void);
int erts_check_io_max_files_nkp(void);
+#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
+void erts_check_io_async_sig_interrupt_kp(void);
+void erts_check_io_async_sig_interrupt_nkp(void);
+#endif
void erts_check_io_interrupt_kp(int);
void erts_check_io_interrupt_nkp(int);
void erts_check_io_interrupt_timed_kp(int, long);
@@ -56,6 +60,9 @@ int erts_check_io_debug_nkp(void);
Uint erts_check_io_size(void);
Eterm erts_check_io_info(void *);
int erts_check_io_max_files(void);
+#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
+void erts_check_io_async_sig_interrupt(void);
+#endif
void erts_check_io_interrupt(int);
void erts_check_io_interrupt_timed(int, long);
void erts_check_io(int);
diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c
index eaef6680dd..49750ff6ce 100644
--- a/erts/emulator/sys/common/erl_mseg.c
+++ b/erts/emulator/sys/common/erl_mseg.c
@@ -36,14 +36,12 @@
#include "erl_threads.h"
#include "erl_mtrace.h"
#include "erl_time.h"
+#include "erl_alloc.h"
#include "big.h"
+#include "erl_thr_progress.h"
#if HAVE_ERTS_MSEG
-#if defined(USE_THREADS) && !defined(ERTS_SMP)
-# define ERTS_THREADS_NO_SMP
-#endif
-
#define SEGTYPE ERTS_MTRACE_SEGMENT_ID
#ifndef HAVE_GETPAGESIZE
@@ -75,16 +73,9 @@
static int atoms_initialized;
-static Uint cache_check_interval;
-
typedef struct mem_kind_t MemKind;
-static void check_cache(void *unused);
static void mseg_clear_cache(MemKind*);
-static int is_cache_check_scheduled;
-#ifdef ERTS_THREADS_NO_SMP
-static int is_cache_check_requested;
-#endif
#if HALFWORD_HEAP
static int initialize_pmmap(void);
@@ -138,7 +129,8 @@ const ErtsMsegOpt_t erts_mseg_default_opt = {
1, /* Use cache */
1, /* Preserv data */
0, /* Absolute shrink threshold */
- 0 /* Relative shrink threshold */
+ 0, /* Relative shrink threshold */
+ 0 /* Scheduler specific */
#if HALFWORD_HEAP
,0 /* need low memory */
#endif
@@ -157,11 +149,10 @@ typedef struct {
Uint32 no;
} CallCounter;
-static int is_init_done;
static Uint page_size;
static Uint page_shift;
-static struct {
+typedef struct {
CallCounter alloc;
CallCounter dealloc;
CallCounter realloc;
@@ -172,7 +163,9 @@ static struct {
#endif
CallCounter clear_cache;
CallCounter check_cache;
-} calls;
+} ErtsMsegCalls;
+
+typedef struct ErtsMsegAllctr_t_ ErtsMsegAllctr_t;
struct mem_kind_t {
cache_desc_t cache_descs[MAX_CACHE_SIZE];
@@ -201,25 +194,84 @@ struct mem_kind_t {
} max_ever;
} segments;
+ ErtsMsegAllctr_t *ma;
const char* name;
MemKind* next;
};/*MemKind*/
+struct ErtsMsegAllctr_t_ {
+ int ix;
+
+ int is_init_done;
+ int is_thread_safe;
+ erts_mtx_t mtx;
+
+ int is_cache_check_scheduled;
+
+ MemKind* mk_list;
+
#if HALFWORD_HEAP
-static MemKind low_mem, hi_mem;
+ MemKind low_mem;
+ MemKind hi_mem;
#else
-static MemKind the_mem;
+ MemKind the_mem;
#endif
-static MemKind* mk_list = NULL;
-static Uint max_cache_size;
-static Uint abs_max_cache_bad_fit;
-static Uint rel_max_cache_bad_fit;
+ Uint max_cache_size;
+ Uint abs_max_cache_bad_fit;
+ Uint rel_max_cache_bad_fit;
+
+ ErtsMsegCalls calls;
#if CAN_PARTLY_DESTROY
-static Uint min_seg_size;
+ Uint min_seg_size;
+#endif
+
+};
+
+typedef union {
+ ErtsMsegAllctr_t mseg_alloc;
+ char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsMsegAllctr_t))];
+} ErtsAlgndMsegAllctr_t;
+
+static int no_mseg_allocators;
+static ErtsAlgndMsegAllctr_t *aligned_mseg_allctr;
+
+#ifdef ERTS_SMP
+
+#define ERTS_MSEG_ALLCTR_IX(IX) \
+ (&aligned_mseg_allctr[(IX)].mseg_alloc)
+
+#define ERTS_MSEG_ALLCTR_SS() \
+ ERTS_MSEG_ALLCTR_IX((int) erts_get_scheduler_id())
+
+#define ERTS_MSEG_ALLCTR_OPT(OPT) \
+ ((OPT)->sched_spec ? ERTS_MSEG_ALLCTR_SS() : ERTS_MSEG_ALLCTR_IX(0))
+
+#else
+
+#define ERTS_MSEG_ALLCTR_IX(IX) \
+ (&aligned_mseg_allctr[0].mseg_alloc)
+
+#define ERTS_MSEG_ALLCTR_SS() \
+ (&aligned_mseg_allctr[0].mseg_alloc)
+
+#define ERTS_MSEG_ALLCTR_OPT(OPT) \
+ (&aligned_mseg_allctr[0].mseg_alloc)
+
#endif
+#define ERTS_MSEG_LOCK(MA) \
+do { \
+ if ((MA)->is_thread_safe) \
+ erts_mtx_lock(&(MA)->mtx); \
+} while (0)
+
+#define ERTS_MSEG_UNLOCK(MA) \
+do { \
+ if ((MA)->is_thread_safe) \
+ erts_mtx_unlock(&(MA)->mtx); \
+} while (0)
#define ERTS_MSEG_ALLOC_STAT(C,SZ) \
do { \
@@ -250,104 +302,44 @@ do { \
#define ONE_GIGA (1000000000)
-#define ZERO_CC(CC) (calls.CC.no = 0, calls.CC.giga_no = 0)
+#define ZERO_CC(MA, CC) ((MA)->calls.CC.no = 0, \
+ (MA)->calls.CC.giga_no = 0)
-#define INC_CC(CC) (calls.CC.no == ONE_GIGA - 1 \
- ? (calls.CC.giga_no++, calls.CC.no = 0) \
- : calls.CC.no++)
+#define INC_CC(MA, CC) ((MA)->calls.CC.no == ONE_GIGA - 1 \
+ ? ((MA)->calls.CC.giga_no++, \
+ (MA)->calls.CC.no = 0) \
+ : (MA)->calls.CC.no++)
-#define DEC_CC(CC) (calls.CC.no == 0 \
- ? (calls.CC.giga_no--, \
- calls.CC.no = ONE_GIGA - 1) \
- : calls.CC.no--)
+#define DEC_CC(MA, CC) ((MA)->calls.CC.no == 0 \
+ ? ((MA)->calls.CC.giga_no--, \
+ (MA)->calls.CC.no = ONE_GIGA - 1) \
+ : (MA)->calls.CC.no--)
-static erts_mtx_t mseg_mutex; /* Also needed when !USE_THREADS */
static erts_mtx_t init_atoms_mutex; /* Also needed when !USE_THREADS */
-#ifdef USE_THREADS
-#ifdef ERTS_THREADS_NO_SMP
-static erts_tid_t main_tid;
-static int async_handle = -1;
-#endif
-
-static void thread_safe_init(void)
-{
- erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms");
- erts_mtx_init(&mseg_mutex, "mseg");
-
-#ifdef ERTS_THREADS_NO_SMP
- main_tid = erts_thr_self();
-#endif
-}
-
-#endif
-
-static ErlTimer cache_check_timer;
static ERTS_INLINE void
-schedule_cache_check(void)
-{
- if (!is_cache_check_scheduled && is_init_done) {
-#ifdef ERTS_THREADS_NO_SMP
- if (!erts_equal_tids(erts_thr_self(), main_tid)) {
- if (!is_cache_check_requested) {
- is_cache_check_requested = 1;
- sys_async_ready(async_handle);
- }
- }
- else
-#endif
- {
- cache_check_timer.active = 0;
- erts_set_timer(&cache_check_timer,
- check_cache,
- NULL,
- NULL,
- cache_check_interval);
- is_cache_check_scheduled = 1;
-#ifdef ERTS_THREADS_NO_SMP
- is_cache_check_requested = 0;
-#endif
- }
- }
-}
-
-#ifdef ERTS_THREADS_NO_SMP
-
-static void
-check_schedule_cache_check(void)
+schedule_cache_check(ErtsMsegAllctr_t *ma)
{
- erts_mtx_lock(&mseg_mutex);
- if (is_cache_check_requested
- && !is_cache_check_scheduled) {
- schedule_cache_check();
- }
- erts_mtx_unlock(&mseg_mutex);
-}
-
-#endif
-static void
-mseg_shutdown(void)
-{
- MemKind* mk;
- erts_mtx_lock(&mseg_mutex);
- for (mk=mk_list; mk; mk=mk->next) {
- mseg_clear_cache(mk);
+ if (!ma->is_cache_check_scheduled && ma->is_init_done) {
+ erts_set_aux_work_timeout(ma->ix,
+ ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK,
+ 1);
+ ma->is_cache_check_scheduled = 1;
}
- erts_mtx_unlock(&mseg_mutex);
}
static ERTS_INLINE void *
-mseg_create(MemKind* mk, Uint size)
+mseg_create(ErtsMsegAllctr_t *ma, MemKind* mk, Uint size)
{
void *seg;
ASSERT(size % page_size == 0);
#if HALFWORD_HEAP
- if (mk == &low_mem) {
+ if (mk == &ma->low_mem) {
seg = pmmap(size);
if ((unsigned long) seg & CHECK_POINTER_MASK) {
erts_fprintf(stderr,"Pointer mask failure (0x%08lx)\n",(unsigned long) seg);
@@ -371,18 +363,18 @@ mseg_create(MemKind* mk, Uint size)
#endif
}
- INC_CC(create);
+ INC_CC(ma, create);
return seg;
}
static ERTS_INLINE void
-mseg_destroy(MemKind* mk, void *seg, Uint size)
+mseg_destroy(ErtsMsegAllctr_t *ma, MemKind* mk, void *seg, Uint size)
{
int res;
#if HALFWORD_HEAP
- if (mk == &low_mem) {
+ if (mk == &ma->low_mem) {
res = pmunmap((void *) seg, size);
}
else
@@ -401,14 +393,14 @@ mseg_destroy(MemKind* mk, void *seg, Uint size)
ASSERT(size % page_size == 0);
ASSERT(res == 0);
- INC_CC(destroy);
+ INC_CC(ma, destroy);
}
#if HAVE_MSEG_RECREATE
static ERTS_INLINE void *
-mseg_recreate(MemKind* mk, void *old_seg, Uint old_size, Uint new_size)
+mseg_recreate(ErtsMsegAllctr_t *ma, MemKind* mk, void *old_seg, Uint old_size, Uint new_size)
{
void *new_seg;
@@ -416,7 +408,7 @@ mseg_recreate(MemKind* mk, void *old_seg, Uint old_size, Uint new_size)
ASSERT(new_size % page_size == 0);
#if HALFWORD_HEAP
- if (mk == &low_mem) {
+ if (mk == &ma->low_mem) {
new_seg = (void *) pmremap((void *) old_seg,
(size_t) old_size,
(size_t) new_size);
@@ -447,19 +439,37 @@ mseg_recreate(MemKind* mk, void *old_seg, Uint old_size, Uint new_size)
#endif
}
- INC_CC(recreate);
+ INC_CC(ma, recreate);
return new_seg;
}
#endif /* #if HAVE_MSEG_RECREATE */
+#ifdef DEBUG
+#define ERTS_DBG_MA_CHK_THR_ACCESS(MA) \
+do { \
+ if ((MA)->is_thread_safe) \
+ ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&(MA)->mtx) \
+ || erts_smp_thr_progress_is_blocking() \
+ || ERTS_IS_CRASH_DUMPING); \
+ else \
+ ERTS_LC_ASSERT((MA)->ix == (int) erts_get_scheduler_id() \
+ || erts_smp_thr_progress_is_blocking() \
+ || ERTS_IS_CRASH_DUMPING); \
+} while (0)
+#define ERTS_DBG_MK_CHK_THR_ACCESS(MK) \
+ ERTS_DBG_MA_CHK_THR_ACCESS((MK)->ma)
+#else
+#define ERTS_DBG_MA_CHK_THR_ACCESS(MA)
+#define ERTS_DBG_MK_CHK_THR_ACCESS(MK)
+#endif
static ERTS_INLINE cache_desc_t *
alloc_cd(MemKind* mk)
{
cache_desc_t *cd = mk->free_cache_descs;
- ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex));
+ ERTS_DBG_MK_CHK_THR_ACCESS(mk);
if (cd)
mk->free_cache_descs = cd->next;
return cd;
@@ -468,7 +478,7 @@ alloc_cd(MemKind* mk)
static ERTS_INLINE void
free_cd(MemKind* mk, cache_desc_t *cd)
{
- ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex));
+ ERTS_DBG_MK_CHK_THR_ACCESS(mk);
cd->next = mk->free_cache_descs;
mk->free_cache_descs = cd;
}
@@ -477,7 +487,7 @@ free_cd(MemKind* mk, cache_desc_t *cd)
static ERTS_INLINE void
link_cd(MemKind* mk, cache_desc_t *cd)
{
- ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex));
+ ERTS_DBG_MK_CHK_THR_ACCESS(mk);
if (mk->cache)
mk->cache->prev = cd;
cd->next = mk->cache;
@@ -496,7 +506,7 @@ link_cd(MemKind* mk, cache_desc_t *cd)
static ERTS_INLINE void
end_link_cd(MemKind* mk, cache_desc_t *cd)
{
- ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex));
+ ERTS_DBG_MK_CHK_THR_ACCESS(mk);
if (mk->cache_end)
mk->cache_end->next = cd;
cd->next = NULL;
@@ -515,7 +525,7 @@ end_link_cd(MemKind* mk, cache_desc_t *cd)
static ERTS_INLINE void
unlink_cd(MemKind* mk, cache_desc_t *cd)
{
- ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex));
+ ERTS_DBG_MK_CHK_THR_ACCESS(mk);
if (cd->next)
cd->next->prev = cd->prev;
else
@@ -533,7 +543,7 @@ static ERTS_INLINE void
check_cache_limits(MemKind* mk)
{
cache_desc_t *cd;
- ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex));
+ ERTS_DBG_MK_CHK_THR_ACCESS(mk);
mk->max_cached_seg_size = 0;
mk->min_cached_seg_size = ~((Uint) 0);
for (cd = mk->cache; cd; cd = cd->next) {
@@ -551,7 +561,7 @@ adjust_cache_size(MemKind* mk, int force_check_limits)
int check_limits = force_check_limits;
Sint max_cached = ((Sint) mk->segments.current.watermark
- (Sint) mk->segments.current.no);
- ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex));
+ ERTS_DBG_MK_CHK_THR_ACCESS(mk);
while (((Sint) mk->cache_size) > max_cached && ((Sint) mk->cache_size) > 0) {
ASSERT(mk->cache_end);
cd = mk->cache_end;
@@ -562,7 +572,7 @@ adjust_cache_size(MemKind* mk, int force_check_limits)
}
if (erts_mtrace_enabled)
erts_mtrace_crr_free(SEGTYPE, SEGTYPE, cd->seg);
- mseg_destroy(mk, cd->seg, cd->size);
+ mseg_destroy(mk->ma, mk, cd->seg, cd->size);
unlink_cd(mk,cd);
free_cd(mk,cd);
}
@@ -571,7 +581,7 @@ adjust_cache_size(MemKind* mk, int force_check_limits)
check_cache_limits(mk);
}
-static void
+static Uint
check_one_cache(MemKind* mk)
{
if (mk->segments.current.watermark > mk->segments.current.no)
@@ -579,23 +589,37 @@ check_one_cache(MemKind* mk)
adjust_cache_size(mk, 0);
if (mk->cache_size)
- schedule_cache_check();
+ schedule_cache_check(mk->ma);
+ return mk->cache_size;
}
-static void check_cache(void* unused)
+static void do_cache_check(ErtsMsegAllctr_t *ma)
{
+ int empty_cache = 1;
MemKind* mk;
- erts_mtx_lock(&mseg_mutex);
- is_cache_check_scheduled = 0;
+ ERTS_MSEG_LOCK(ma);
- for (mk=mk_list; mk; mk=mk->next) {
- check_one_cache(mk);
+ for (mk=ma->mk_list; mk; mk=mk->next) {
+ if (check_one_cache(mk))
+ empty_cache = 0;
+ }
+
+ if (empty_cache) {
+ ma->is_cache_check_scheduled = 0;
+ erts_set_aux_work_timeout(ma->ix,
+ ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK,
+ 0);
}
- INC_CC(check_cache);
+ INC_CC(ma, check_cache);
- erts_mtx_unlock(&mseg_mutex);
+ ERTS_MSEG_UNLOCK(ma);
+}
+
+void erts_mseg_cache_check(void)
+{
+ do_cache_check(ERTS_MSEG_ALLCTR_SS());
}
static void
@@ -611,42 +635,44 @@ mseg_clear_cache(MemKind* mk)
mk->segments.current.watermark = mk->segments.current.no;
- INC_CC(clear_cache);
+ INC_CC(mk->ma, clear_cache);
}
-static ERTS_INLINE MemKind* memkind(const ErtsMsegOpt_t *opt)
+static ERTS_INLINE MemKind* memkind(ErtsMsegAllctr_t *ma,
+ const ErtsMsegOpt_t *opt)
{
#if HALFWORD_HEAP
- return opt->low_mem ? &low_mem : &hi_mem;
+ return opt->low_mem ? &ma->low_mem : &ma->hi_mem;
#else
- return &the_mem;
+ return &ma->the_mem;
#endif
}
static void *
-mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt)
+mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, Uint *size_p,
+ const ErtsMsegOpt_t *opt)
{
Uint max, min, diff_size, size;
cache_desc_t *cd, *cand_cd;
void *seg;
- MemKind* mk = memkind(opt);
+ MemKind* mk = memkind(ma, opt);
- INC_CC(alloc);
+ INC_CC(ma, alloc);
size = PAGE_CEILING(*size_p);
#if CAN_PARTLY_DESTROY
- if (size < min_seg_size)
- min_seg_size = size;
+ if (size < ma->min_seg_size)
+ ma->min_seg_size = size;
#endif
if (!opt->cache) {
create_seg:
adjust_cache_size(mk,0);
- seg = mseg_create(mk, size);
+ seg = mseg_create(ma, mk, size);
if (!seg) {
mseg_clear_cache(mk);
- seg = mseg_create(mk, size);
+ seg = mseg_create(ma, mk, size);
if (!seg)
size = 0;
}
@@ -667,10 +693,10 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt)
diff_size = mk->min_cached_seg_size - size;
- if (diff_size > abs_max_cache_bad_fit)
+ if (diff_size > ma->abs_max_cache_bad_fit)
goto create_seg;
- if (100*PAGES(diff_size) > rel_max_cache_bad_fit*PAGES(size))
+ if (100*PAGES(diff_size) > ma->rel_max_cache_bad_fit*PAGES(size))
goto create_seg;
}
@@ -708,8 +734,8 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt)
diff_size = cand_cd->size - size;
- if (diff_size > abs_max_cache_bad_fit
- || 100*PAGES(diff_size) > rel_max_cache_bad_fit*PAGES(size)) {
+ if (diff_size > ma->abs_max_cache_bad_fit
+ || 100*PAGES(diff_size) > ma->rel_max_cache_bad_fit*PAGES(size)) {
if (mk->max_cached_seg_size < cand_cd->size)
mk->max_cached_seg_size = cand_cd->size;
if (mk->min_cached_seg_size > cand_cd->size)
@@ -740,18 +766,18 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt)
static void
-mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size,
+mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, Uint size,
const ErtsMsegOpt_t *opt)
{
- MemKind* mk = memkind(opt);
+ MemKind* mk = memkind(ma, opt);
cache_desc_t *cd;
ERTS_MSEG_DEALLOC_STAT(mk,size);
- if (!opt->cache || max_cache_size == 0) {
+ if (!opt->cache || ma->max_cache_size == 0) {
if (erts_mtrace_enabled)
erts_mtrace_crr_free(atype, SEGTYPE, seg);
- mseg_destroy(mk, seg, size);
+ mseg_destroy(ma, mk, seg, size);
}
else {
int check_limits = 0;
@@ -769,7 +795,7 @@ mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size,
}
if (erts_mtrace_enabled)
erts_mtrace_crr_free(SEGTYPE, SEGTYPE, cd->seg);
- mseg_destroy(mk, cd->seg, cd->size);
+ mseg_destroy(ma, mk, cd->seg, cd->size);
unlink_cd(mk,cd);
free_cd(mk,cd);
}
@@ -790,33 +816,34 @@ mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size,
if (check_limits)
check_cache_limits(mk);
- schedule_cache_check();
+ schedule_cache_check(ma);
}
- INC_CC(dealloc);
+ INC_CC(ma, dealloc);
}
static void *
-mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p,
- const ErtsMsegOpt_t *opt)
+mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg,
+ Uint old_size, Uint *new_size_p, const ErtsMsegOpt_t *opt)
{
- MemKind* mk = memkind(opt);
+ MemKind* mk;
void *new_seg;
Uint new_size;
if (!seg || !old_size) {
- new_seg = mseg_alloc(atype, new_size_p, opt);
- DEC_CC(alloc);
+ new_seg = mseg_alloc(ma, atype, new_size_p, opt);
+ DEC_CC(ma, alloc);
return new_seg;
}
if (!(*new_size_p)) {
- mseg_dealloc(atype, seg, old_size, opt);
- DEC_CC(dealloc);
+ mseg_dealloc(ma, atype, seg, old_size, opt);
+ DEC_CC(ma, dealloc);
return NULL;
}
+ mk = memkind(ma, opt);
new_seg = seg;
new_size = PAGE_CEILING(*new_size_p);
@@ -826,8 +853,8 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p,
Uint shrink_sz = old_size - new_size;
#if CAN_PARTLY_DESTROY
- if (new_size < min_seg_size)
- min_seg_size = new_size;
+ if (new_size < ma->min_seg_size)
+ ma->min_seg_size = new_size;
#endif
if (shrink_sz < opt->abs_shrink_th
@@ -838,7 +865,7 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p,
#if CAN_PARTLY_DESTROY
- if (shrink_sz > min_seg_size
+ if (shrink_sz > ma->min_seg_size
&& mk->free_cache_descs
&& opt->cache) {
cache_desc_t *cd;
@@ -857,7 +884,7 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p,
new_size);
erts_mtrace_crr_alloc(cd->seg, SEGTYPE, SEGTYPE, cd->size);
}
- schedule_cache_check();
+ schedule_cache_check(ma);
}
else {
if (erts_mtrace_enabled)
@@ -866,7 +893,7 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p,
SEGTYPE,
seg,
new_size);
- mseg_destroy(mk, ((char *) seg) + new_size, shrink_sz);
+ mseg_destroy(ma, mk, ((char *) seg) + new_size, shrink_sz);
}
#elif HAVE_MSEG_RECREATE
@@ -875,14 +902,14 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p,
#else
- new_seg = mseg_alloc(atype, &new_size, opt);
+ new_seg = mseg_alloc(ma, atype, &new_size, opt);
if (!new_seg)
new_size = old_size;
else {
sys_memcpy(((char *) new_seg),
((char *) seg),
MIN(new_size, old_size));
- mseg_dealloc(atype, seg, old_size, opt);
+ mseg_dealloc(ma, atype, seg, old_size, opt);
}
#endif
@@ -892,34 +919,34 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p,
else {
if (!opt->preserv) {
- mseg_dealloc(atype, seg, old_size, opt);
- new_seg = mseg_alloc(atype, &new_size, opt);
+ mseg_dealloc(ma, atype, seg, old_size, opt);
+ new_seg = mseg_alloc(ma, atype, &new_size, opt);
}
else {
#if HAVE_MSEG_RECREATE
#if !CAN_PARTLY_DESTROY
do_recreate:
#endif
- new_seg = mseg_recreate(mk, (void *) seg, old_size, new_size);
+ new_seg = mseg_recreate(ma, mk, (void *) seg, old_size, new_size);
if (erts_mtrace_enabled)
erts_mtrace_crr_realloc(new_seg, atype, SEGTYPE, seg, new_size);
if (!new_seg)
new_size = old_size;
#else
- new_seg = mseg_alloc(atype, &new_size, opt);
+ new_seg = mseg_alloc(ma, atype, &new_size, opt);
if (!new_seg)
new_size = old_size;
else {
sys_memcpy(((char *) new_seg),
((char *) seg),
MIN(new_size, old_size));
- mseg_dealloc(atype, seg, old_size, opt);
+ mseg_dealloc(ma, atype, seg, old_size, opt);
}
#endif
}
}
- INC_CC(realloc);
+ INC_CC(ma, realloc);
*new_size_p = new_size;
@@ -937,7 +964,6 @@ static struct {
Eterm amcbf;
Eterm rmcbf;
Eterm mcs;
- Eterm cci;
Eterm memkind;
Eterm name;
@@ -973,13 +999,13 @@ static void ERTS_INLINE atom_init(Eterm *atom, char *name)
#define AM_INIT(AM) atom_init(&am.AM, #AM)
static void
-init_atoms(void)
+init_atoms(ErtsMsegAllctr_t *ma)
{
#ifdef DEBUG
Eterm *atom;
#endif
- erts_mtx_unlock(&mseg_mutex);
+ ERTS_MSEG_UNLOCK(ma);
erts_mtx_lock(&init_atoms_mutex);
if (!atoms_initialized) {
@@ -997,7 +1023,6 @@ init_atoms(void)
AM_INIT(amcbf);
AM_INIT(rmcbf);
AM_INIT(mcs);
- AM_INIT(cci);
AM_INIT(status);
AM_INIT(cached_segments);
@@ -1025,7 +1050,7 @@ init_atoms(void)
#endif
}
- erts_mtx_lock(&mseg_mutex);
+ ERTS_MSEG_LOCK(ma);
atoms_initialized = 1;
erts_mtx_unlock(&init_atoms_mutex);
}
@@ -1082,7 +1107,8 @@ add_4tup(Uint **hpp, Uint *szp, Eterm *lp,
}
static Eterm
-info_options(char *prefix,
+info_options(ErtsMsegAllctr_t *ma,
+ char *prefix,
int *print_to_p,
void *print_to_arg,
Uint **hpp,
@@ -1093,30 +1119,26 @@ info_options(char *prefix,
if (print_to_p) {
int to = *print_to_p;
void *arg = print_to_arg;
- erts_print(to, arg, "%samcbf: %beu\n", prefix, abs_max_cache_bad_fit);
- erts_print(to, arg, "%srmcbf: %beu\n", prefix, rel_max_cache_bad_fit);
- erts_print(to, arg, "%smcs: %beu\n", prefix, max_cache_size);
- erts_print(to, arg, "%scci: %beu\n", prefix, cache_check_interval);
+ erts_print(to, arg, "%samcbf: %beu\n", prefix, ma->abs_max_cache_bad_fit);
+ erts_print(to, arg, "%srmcbf: %beu\n", prefix, ma->rel_max_cache_bad_fit);
+ erts_print(to, arg, "%smcs: %beu\n", prefix, ma->max_cache_size);
}
if (hpp || szp) {
if (!atoms_initialized)
- init_atoms();
+ init_atoms(ma);
res = NIL;
add_2tup(hpp, szp, &res,
- am.cci,
- bld_uint(hpp, szp, cache_check_interval));
- add_2tup(hpp, szp, &res,
am.mcs,
- bld_uint(hpp, szp, max_cache_size));
+ bld_uint(hpp, szp, ma->max_cache_size));
add_2tup(hpp, szp, &res,
am.rmcbf,
- bld_uint(hpp, szp, rel_max_cache_bad_fit));
+ bld_uint(hpp, szp, ma->rel_max_cache_bad_fit));
add_2tup(hpp, szp, &res,
am.amcbf,
- bld_uint(hpp, szp, abs_max_cache_bad_fit));
+ bld_uint(hpp, szp, ma->abs_max_cache_bad_fit));
}
@@ -1124,18 +1146,18 @@ info_options(char *prefix,
}
static Eterm
-info_calls(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
+info_calls(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
{
Eterm res = THE_NON_VALUE;
if (print_to_p) {
-#define PRINT_CC(TO, TOA, CC) \
- if (calls.CC.giga_no == 0) \
- erts_print(TO, TOA, "mseg_%s calls: %b32u\n", #CC, calls.CC.no); \
- else \
+#define PRINT_CC(TO, TOA, CC) \
+ if (ma->calls.CC.giga_no == 0) \
+ erts_print(TO, TOA, "mseg_%s calls: %b32u\n", #CC, ma->calls.CC.no); \
+ else \
erts_print(TO, TOA, "mseg_%s calls: %b32u%09b32u\n", #CC, \
- calls.CC.giga_no, calls.CC.no)
+ ma->calls.CC.giga_no, ma->calls.CC.no)
int to = *print_to_p;
void *arg = print_to_arg;
@@ -1161,48 +1183,48 @@ info_calls(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
add_3tup(hpp, szp, &res,
am.mseg_check_cache,
- bld_unstable_uint(hpp, szp, calls.check_cache.giga_no),
- bld_unstable_uint(hpp, szp, calls.check_cache.no));
+ bld_unstable_uint(hpp, szp, ma->calls.check_cache.giga_no),
+ bld_unstable_uint(hpp, szp, ma->calls.check_cache.no));
add_3tup(hpp, szp, &res,
am.mseg_clear_cache,
- bld_unstable_uint(hpp, szp, calls.clear_cache.giga_no),
- bld_unstable_uint(hpp, szp, calls.clear_cache.no));
+ bld_unstable_uint(hpp, szp, ma->calls.clear_cache.giga_no),
+ bld_unstable_uint(hpp, szp, ma->calls.clear_cache.no));
#if HAVE_MSEG_RECREATE
add_3tup(hpp, szp, &res,
am.mseg_recreate,
- bld_unstable_uint(hpp, szp, calls.recreate.giga_no),
- bld_unstable_uint(hpp, szp, calls.recreate.no));
+ bld_unstable_uint(hpp, szp, ma->calls.recreate.giga_no),
+ bld_unstable_uint(hpp, szp, ma->calls.recreate.no));
#endif
add_3tup(hpp, szp, &res,
am.mseg_destroy,
- bld_unstable_uint(hpp, szp, calls.destroy.giga_no),
- bld_unstable_uint(hpp, szp, calls.destroy.no));
+ bld_unstable_uint(hpp, szp, ma->calls.destroy.giga_no),
+ bld_unstable_uint(hpp, szp, ma->calls.destroy.no));
add_3tup(hpp, szp, &res,
am.mseg_create,
- bld_unstable_uint(hpp, szp, calls.create.giga_no),
- bld_unstable_uint(hpp, szp, calls.create.no));
+ bld_unstable_uint(hpp, szp, ma->calls.create.giga_no),
+ bld_unstable_uint(hpp, szp, ma->calls.create.no));
add_3tup(hpp, szp, &res,
am.mseg_realloc,
- bld_unstable_uint(hpp, szp, calls.realloc.giga_no),
- bld_unstable_uint(hpp, szp, calls.realloc.no));
+ bld_unstable_uint(hpp, szp, ma->calls.realloc.giga_no),
+ bld_unstable_uint(hpp, szp, ma->calls.realloc.no));
add_3tup(hpp, szp, &res,
am.mseg_dealloc,
- bld_unstable_uint(hpp, szp, calls.dealloc.giga_no),
- bld_unstable_uint(hpp, szp, calls.dealloc.no));
+ bld_unstable_uint(hpp, szp, ma->calls.dealloc.giga_no),
+ bld_unstable_uint(hpp, szp, ma->calls.dealloc.no));
add_3tup(hpp, szp, &res,
am.mseg_alloc,
- bld_unstable_uint(hpp, szp, calls.alloc.giga_no),
- bld_unstable_uint(hpp, szp, calls.alloc.no));
+ bld_unstable_uint(hpp, szp, ma->calls.alloc.giga_no),
+ bld_unstable_uint(hpp, szp, ma->calls.alloc.no));
}
return res;
}
static Eterm
-info_status(MemKind* mk, int *print_to_p, void *print_to_arg,
+info_status(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, void *print_to_arg,
int begin_new_max_period, Uint **hpp, Uint *szp)
{
Eterm res = THE_NON_VALUE;
@@ -1258,7 +1280,7 @@ info_status(MemKind* mk, int *print_to_p, void *print_to_arg,
return res;
}
-static Eterm info_memkind(MemKind* mk, int *print_to_p, void *print_to_arg,
+static Eterm info_memkind(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, void *print_to_arg,
int begin_max_per, Uint **hpp, Uint *szp)
{
Eterm res = THE_NON_VALUE;
@@ -1274,8 +1296,8 @@ static Eterm info_memkind(MemKind* mk, int *print_to_p, void *print_to_arg,
atoms[2] = am.calls;
values[0] = erts_bld_string(hpp, szp, mk->name);
}
- values[1] = info_status(mk, print_to_p, print_to_arg, begin_max_per, hpp, szp);
- values[2] = info_calls(print_to_p, print_to_arg, hpp, szp);
+ values[1] = info_status(ma, mk, print_to_p, print_to_arg, begin_max_per, hpp, szp);
+ values[2] = info_calls(ma, print_to_p, print_to_arg, hpp, szp);
if (hpp || szp)
res = bld_2tup_list(hpp, szp, 3, atoms, values);
@@ -1285,7 +1307,7 @@ static Eterm info_memkind(MemKind* mk, int *print_to_p, void *print_to_arg,
static Eterm
-info_version(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
+info_version(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
{
Eterm res = THE_NON_VALUE;
@@ -1306,56 +1328,64 @@ info_version(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
\* */
Eterm
-erts_mseg_info_options(int *print_to_p, void *print_to_arg,
+erts_mseg_info_options(int ix,
+ int *print_to_p, void *print_to_arg,
Uint **hpp, Uint *szp)
{
+ ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_IX(ix);
Eterm res;
- erts_mtx_lock(&mseg_mutex);
+ ERTS_MSEG_LOCK(ma);
- res = info_options("option ", print_to_p, print_to_arg, hpp, szp);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
- erts_mtx_unlock(&mseg_mutex);
+ res = info_options(ma, "option ", print_to_p, print_to_arg, hpp, szp);
+
+ ERTS_MSEG_UNLOCK(ma);
return res;
}
Eterm
-erts_mseg_info(int *print_to_p,
+erts_mseg_info(int ix,
+ int *print_to_p,
void *print_to_arg,
int begin_max_per,
Uint **hpp,
Uint *szp)
{
+ ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_IX(ix);
Eterm res = THE_NON_VALUE;
Eterm atoms[4];
Eterm values[4];
Uint n = 0;
- erts_mtx_lock(&mseg_mutex);
+ ERTS_MSEG_LOCK(ma);
+
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
if (hpp || szp) {
if (!atoms_initialized)
- init_atoms();
+ init_atoms(ma);
atoms[0] = am.version;
atoms[1] = am.options;
atoms[2] = am.memkind;
atoms[3] = am.memkind;
}
- values[n++] = info_version(print_to_p, print_to_arg, hpp, szp);
- values[n++] = info_options("option ", print_to_p, print_to_arg, hpp, szp);
+ values[n++] = info_version(ma, print_to_p, print_to_arg, hpp, szp);
+ values[n++] = info_options(ma, "option ", print_to_p, print_to_arg, hpp, szp);
#if HALFWORD_HEAP
- values[n++] = info_memkind(&low_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp);
- values[n++] = info_memkind(&hi_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp);
+ values[n++] = info_memkind(ma, &ma->low_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp);
+ values[n++] = info_memkind(ma, &ma->hi_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp);
#else
- values[n++] = info_memkind(&the_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp);
+ values[n++] = info_memkind(ma, &ma->the_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp);
#endif
if (hpp || szp)
res = bld_2tup_list(hpp, szp, n, atoms, values);
- erts_mtx_unlock(&mseg_mutex);
+ ERTS_MSEG_UNLOCK(ma);
return res;
}
@@ -1363,10 +1393,12 @@ erts_mseg_info(int *print_to_p,
void *
erts_mseg_alloc_opt(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt)
{
+ ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt);
void *seg;
- erts_mtx_lock(&mseg_mutex);
- seg = mseg_alloc(atype, size_p, opt);
- erts_mtx_unlock(&mseg_mutex);
+ ERTS_MSEG_LOCK(ma);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
+ seg = mseg_alloc(ma, atype, size_p, opt);
+ ERTS_MSEG_UNLOCK(ma);
return seg;
}
@@ -1377,12 +1409,14 @@ erts_mseg_alloc(ErtsAlcType_t atype, Uint *size_p)
}
void
-erts_mseg_dealloc_opt(ErtsAlcType_t atype, void *seg, Uint size,
- const ErtsMsegOpt_t *opt)
+erts_mseg_dealloc_opt(ErtsAlcType_t atype, void *seg,
+ Uint size, const ErtsMsegOpt_t *opt)
{
- erts_mtx_lock(&mseg_mutex);
- mseg_dealloc(atype, seg, size, opt);
- erts_mtx_unlock(&mseg_mutex);
+ ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt);
+ ERTS_MSEG_LOCK(ma);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
+ mseg_dealloc(ma, atype, seg, size, opt);
+ ERTS_MSEG_UNLOCK(ma);
}
void
@@ -1392,44 +1426,60 @@ erts_mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size)
}
void *
-erts_mseg_realloc_opt(ErtsAlcType_t atype, void *seg, Uint old_size,
- Uint *new_size_p, const ErtsMsegOpt_t *opt)
+erts_mseg_realloc_opt(ErtsAlcType_t atype, void *seg,
+ Uint old_size, Uint *new_size_p,
+ const ErtsMsegOpt_t *opt)
{
+ ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt);
void *new_seg;
- erts_mtx_lock(&mseg_mutex);
- new_seg = mseg_realloc(atype, seg, old_size, new_size_p, opt);
- erts_mtx_unlock(&mseg_mutex);
+ ERTS_MSEG_LOCK(ma);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
+ new_seg = mseg_realloc(ma, atype, seg, old_size, new_size_p, opt);
+ ERTS_MSEG_UNLOCK(ma);
return new_seg;
}
void *
-erts_mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size,
- Uint *new_size_p)
+erts_mseg_realloc(ErtsAlcType_t atype, void *seg,
+ Uint old_size, Uint *new_size_p)
{
- return erts_mseg_realloc_opt(atype, seg, old_size, new_size_p, &erts_mseg_default_opt);
+ return erts_mseg_realloc_opt(atype, seg, old_size, new_size_p,
+ &erts_mseg_default_opt);
}
void
erts_mseg_clear_cache(void)
{
+ ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_SS();
MemKind* mk;
- erts_mtx_lock(&mseg_mutex);
- for (mk=mk_list; mk; mk=mk->next) {
+
+start:
+
+ ERTS_MSEG_LOCK(ma);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
+ for (mk=ma->mk_list; mk; mk=mk->next) {
mseg_clear_cache(mk);
}
- erts_mtx_unlock(&mseg_mutex);
+ ERTS_MSEG_UNLOCK(ma);
+
+ if (ma->ix != 0) {
+ ma = ERTS_MSEG_ALLCTR_IX(0);
+ goto start;
+ }
}
Uint
-erts_mseg_no(void)
+erts_mseg_no(const ErtsMsegOpt_t *opt)
{
+ ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt);
MemKind* mk;
Uint n = 0;
- erts_mtx_lock(&mseg_mutex);
- for (mk=mk_list; mk; mk=mk->next) {
+ ERTS_MSEG_LOCK(ma);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
+ for (mk=ma->mk_list; mk; mk=mk->next) {
n += mk->segments.current.no;
}
- erts_mtx_unlock(&mseg_mutex);
+ ERTS_MSEG_UNLOCK(ma);
return n;
}
@@ -1439,7 +1489,7 @@ erts_mseg_unit_size(void)
return page_size;
}
-static void mem_kind_init(MemKind* mk, const char* name)
+static void mem_kind_init(ErtsMsegAllctr_t *ma, MemKind* mk, const char* name)
{
unsigned i;
@@ -1450,10 +1500,10 @@ static void mem_kind_init(MemKind* mk, const char* name)
mk->cache_size = 0;
mk->cache_hits = 0;
- if (max_cache_size > 0) {
- for (i = 0; i < max_cache_size - 1; i++)
+ if (ma->max_cache_size > 0) {
+ for (i = 0; i < ma->max_cache_size - 1; i++)
mk->cache_descs[i].next = &mk->cache_descs[i + 1];
- mk->cache_descs[max_cache_size - 1].next = NULL;
+ mk->cache_descs[ma->max_cache_size - 1].next = NULL;
mk->free_cache_descs = &mk->cache_descs[0];
}
else
@@ -1467,30 +1517,38 @@ static void mem_kind_init(MemKind* mk, const char* name)
mk->segments.max_ever.no = 0;
mk->segments.max_ever.sz = 0;
+ mk->ma = ma;
mk->name = name;
- mk->next = mk_list;
- mk_list = mk;
+ mk->next = ma->mk_list;
+ ma->mk_list = mk;
}
+
+
void
erts_mseg_init(ErtsMsegInit_t *init)
{
- atoms_initialized = 0;
- is_init_done = 0;
+ int i;
+ UWord x;
- /* Options ... */
+#ifdef ERTS_SMP
+ no_mseg_allocators = init->nos + 1;
+#else
+ no_mseg_allocators = 1;
+#endif
- abs_max_cache_bad_fit = init->amcbf;
- rel_max_cache_bad_fit = init->rmcbf;
- max_cache_size = init->mcs;
- cache_check_interval = init->cci;
+ x = (UWord) malloc(sizeof(ErtsAlgndMsegAllctr_t)
+ *no_mseg_allocators
+ + (ERTS_CACHE_LINE_SIZE-1));
+ if (x & ERTS_CACHE_LINE_MASK)
+ x = (x & ~ERTS_CACHE_LINE_MASK) + ERTS_CACHE_LINE_SIZE;
+ ASSERT((x & ERTS_CACHE_LINE_MASK) == 0);
+ aligned_mseg_allctr = (ErtsAlgndMsegAllctr_t *) x;
- /* */
+ atoms_initialized = 0;
-#ifdef USE_THREADS
- thread_safe_init();
-#endif
+ erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms");
#if HAVE_MMAP && !defined(MAP_ANON)
mmap_fd = open("/dev/zero", O_RDWR);
@@ -1512,34 +1570,55 @@ erts_mseg_init(ErtsMsegInit_t *init)
page_shift++;
}
- sys_memzero((void *) &calls, sizeof(calls));
+ for (i = 0; i < no_mseg_allocators; i++) {
+ ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_IX(i);
-#if CAN_PARTLY_DESTROY
- min_seg_size = ~((Uint) 0);
-#endif
+ ma->ix = i;
+
+ ma->is_init_done = 0;
+
+ if (i != 0)
+ ma->is_thread_safe = 0;
+ else {
+ ma->is_thread_safe = 1;
+ erts_mtx_init(&ma->mtx, "mseg");
+ }
+
+ ma->is_cache_check_scheduled = 0;
+
+ /* Options ... */
+
+ ma->abs_max_cache_bad_fit = init->amcbf;
+ ma->rel_max_cache_bad_fit = init->rmcbf;
+ ma->max_cache_size = init->mcs;
- if (max_cache_size > MAX_CACHE_SIZE)
- max_cache_size = MAX_CACHE_SIZE;
+ if (ma->max_cache_size > MAX_CACHE_SIZE)
+ ma->max_cache_size = MAX_CACHE_SIZE;
+
+ ma->mk_list = NULL;
#if HALFWORD_HEAP
- mem_kind_init(&low_mem, "low memory");
- mem_kind_init(&hi_mem, "high memory");
+ mem_kind_init(ma, &ma->low_mem, "low memory");
+ mem_kind_init(ma, &ma->hi_mem, "high memory");
#else
- mem_kind_init(&the_mem, "all memory");
+ mem_kind_init(ma, &ma->the_mem, "all memory");
#endif
- is_cache_check_scheduled = 0;
-#ifdef ERTS_THREADS_NO_SMP
- is_cache_check_requested = 0;
+ sys_memzero((void *) &ma->calls, sizeof(ErtsMsegCalls));
+
+#if CAN_PARTLY_DESTROY
+ ma->min_seg_size = ~((Uint) 0);
#endif
+ }
}
-static ERTS_INLINE Uint tot_cache_size(void)
+static ERTS_INLINE Uint tot_cache_size(ErtsMsegAllctr_t *ma)
{
MemKind* mk;
Uint sz = 0;
- for (mk=mk_list; mk; mk=mk->next) {
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
+ for (mk=ma->mk_list; mk; mk=mk->next) {
sz += mk->cache_size;
}
return sz;
@@ -1552,25 +1631,13 @@ static ERTS_INLINE Uint tot_cache_size(void)
void
erts_mseg_late_init(void)
{
-#ifdef ERTS_THREADS_NO_SMP
- int handle =
- erts_register_async_ready_callback(
- check_schedule_cache_check);
-#endif
- erts_mtx_lock(&mseg_mutex);
- is_init_done = 1;
-#ifdef ERTS_THREADS_NO_SMP
- async_handle = handle;
-#endif
- if (tot_cache_size())
- schedule_cache_check();
- erts_mtx_unlock(&mseg_mutex);
-}
-
-void
-erts_mseg_exit(void)
-{
- mseg_shutdown();
+ ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_SS();
+ ERTS_MSEG_LOCK(ma);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
+ ma->is_init_done = 1;
+ if (tot_cache_size(ma))
+ schedule_cache_check(ma);
+ ERTS_MSEG_UNLOCK(ma);
}
#endif /* #if HAVE_ERTS_MSEG */
@@ -1599,12 +1666,13 @@ erts_mseg_test(unsigned long op,
erts_mseg_clear_cache();
return (unsigned long) 0;
case 0x405:
- return (unsigned long) erts_mseg_no();
+ return (unsigned long) erts_mseg_no(&erts_mseg_default_opt);
case 0x406: {
+ ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_IX(0);
unsigned long res;
- erts_mtx_lock(&mseg_mutex);
- res = (unsigned long) tot_cache_size();
- erts_mtx_unlock(&mseg_mutex);
+ ERTS_MSEG_LOCK(ma);
+ res = (unsigned long) tot_cache_size(ma);
+ ERTS_MSEG_UNLOCK(ma);
return res;
}
#else /* #if HAVE_ERTS_MSEG */
diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h
index 8f116030a8..741080fb78 100644
--- a/erts/emulator/sys/common/erl_mseg.h
+++ b/erts/emulator/sys/common/erl_mseg.h
@@ -44,7 +44,7 @@ typedef struct {
Uint amcbf;
Uint rmcbf;
Uint mcs;
- Uint cci;
+ Uint nos;
} ErtsMsegInit_t;
#define ERTS_MSEG_INIT_DEFAULT_INITIALIZER \
@@ -60,6 +60,7 @@ typedef struct {
int preserv;
UWord abs_shrink_th;
UWord rel_shrink_th;
+ int sched_spec;
#if HALFWORD_HEAP
int low_mem;
#endif
@@ -75,14 +76,14 @@ void *erts_mseg_realloc(ErtsAlcType_t, void *, Uint, Uint *);
void *erts_mseg_realloc_opt(ErtsAlcType_t, void *, Uint, Uint *,
const ErtsMsegOpt_t *);
void erts_mseg_clear_cache(void);
-Uint erts_mseg_no(void);
+void erts_mseg_cache_check(void);
+Uint erts_mseg_no( const ErtsMsegOpt_t *);
Uint erts_mseg_unit_size(void);
void erts_mseg_init(ErtsMsegInit_t *init);
void erts_mseg_late_init(void); /* Have to be called after all allocators,
threads and timers have been initialized. */
-void erts_mseg_exit(void);
-Eterm erts_mseg_info_options(int *, void*, Uint **, Uint *);
-Eterm erts_mseg_info(int *, void*, int, Uint **, Uint *);
+Eterm erts_mseg_info_options(int, int *, void*, Uint **, Uint *);
+Eterm erts_mseg_info(int, int *, void*, int, Uint **, Uint *);
#endif /* #if HAVE_ERTS_MSEG */
diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c
index 9bd64f5908..80db2055a2 100644
--- a/erts/emulator/sys/common/erl_poll.c
+++ b/erts/emulator/sys/common/erl_poll.c
@@ -68,6 +68,7 @@
# endif
# endif
#endif
+#include "erl_thr_progress.h"
#include "erl_driver.h"
#include "erl_alloc.h"
@@ -114,7 +115,7 @@
#endif
#define ERTS_POLL_USE_WAKEUP_PIPE \
- (ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP))
+ (ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(USE_THREADS))
#ifdef ERTS_SMP
@@ -261,7 +262,6 @@ struct ErtsPollSet_ {
#ifdef ERTS_SMP
erts_atomic32_t polled;
erts_smp_mtx_t mtx;
-#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
#endif
#if ERTS_POLL_USE_WAKEUP_PIPE
int wake_fds[2];
@@ -269,10 +269,8 @@ struct ErtsPollSet_ {
#if ERTS_POLL_USE_FALLBACK
int fallback_used;
#endif
-#ifdef ERTS_SMP
+#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
erts_atomic32_t wakeup_state;
-#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
- volatile int wakeup_state;
#endif
erts_smp_atomic32_t timeout;
#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS
@@ -345,21 +343,16 @@ static void print_misc_debug_info(void);
static ERTS_INLINE void
reset_wakeup_state(ErtsPollSet ps)
{
-#ifdef ERTS_SMP
- erts_atomic32_set_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN);
- ERTS_THR_MEMORY_BARRIER;
-#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
- ps->wakeup_state = 0;
+#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
+ erts_atomic32_set_mb(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN);
#endif
}
static ERTS_INLINE int
is_woken(ErtsPollSet ps)
{
-#ifdef ERTS_SMP
+#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
return erts_atomic32_read_acqb(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN;
-#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
- return ps->wakeup_state != ERTS_POLL_NOT_WOKEN;
#else
return 0;
#endif
@@ -368,13 +361,9 @@ is_woken(ErtsPollSet ps)
static ERTS_INLINE int
is_interrupted_reset(ErtsPollSet ps)
{
-#ifdef ERTS_SMP
+#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
return (erts_atomic32_xchg_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN)
== ERTS_POLL_WOKEN_INTR);
-#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
- int res = ps->wakeup_state == ERTS_POLL_WOKEN_INTR;
- ps->wakeup_state = ERTS_POLL_NOT_WOKEN;
- return res;
#else
return 0;
#endif
@@ -383,16 +372,13 @@ is_interrupted_reset(ErtsPollSet ps)
static ERTS_INLINE void
woke_up(ErtsPollSet ps)
{
-#ifdef ERTS_SMP
+#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
erts_aint32_t wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state);
if (wakeup_state == ERTS_POLL_NOT_WOKEN)
(void) erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
ERTS_POLL_WOKEN,
ERTS_POLL_NOT_WOKEN);
ASSERT(erts_atomic32_read_nob(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN);
-#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
- if (ps->wakeup_state == ERTS_POLL_NOT_WOKEN)
- ps->wakeup_state = ERTS_POLL_WOKEN;
#endif
}
@@ -403,28 +389,27 @@ woke_up(ErtsPollSet ps)
#if ERTS_POLL_USE_WAKEUP_PIPE
static ERTS_INLINE void
-wake_poller(ErtsPollSet ps, int interrupted)
+wake_poller(ErtsPollSet ps, int interrupted, int async_signal_safe)
{
- int wake = 0;
-#ifdef ERTS_SMP
- erts_aint32_t wakeup_state;
- if (!interrupted)
- wakeup_state = erts_atomic32_cmpxchg_relb(&ps->wakeup_state,
- ERTS_POLL_WOKEN,
- ERTS_POLL_NOT_WOKEN);
+ int wake;
+ if (async_signal_safe)
+ wake = 1;
else {
- /*
- * We might unnecessarily write to the pipe, however,
- * that isn't problematic.
- */
- wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state);
- erts_atomic32_set_relb(&ps->wakeup_state, ERTS_POLL_WOKEN_INTR);
+ erts_aint32_t wakeup_state;
+ if (!interrupted)
+ wakeup_state = erts_atomic32_cmpxchg_relb(&ps->wakeup_state,
+ ERTS_POLL_WOKEN,
+ ERTS_POLL_NOT_WOKEN);
+ else {
+ /*
+ * We might unnecessarily write to the pipe, however,
+ * that isn't problematic.
+ */
+ wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state);
+ erts_atomic32_set_relb(&ps->wakeup_state, ERTS_POLL_WOKEN_INTR);
+ }
+ wake = wakeup_state == ERTS_POLL_NOT_WOKEN;
}
- wake = wakeup_state == ERTS_POLL_NOT_WOKEN;
-#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
- wake = ps->wakeup_state == ERTS_POLL_NOT_WOKEN;
- ps->wakeup_state = interrupted ? ERTS_POLL_WOKEN_INTR : ERTS_POLL_NOT_WOKEN;
-#endif
/*
* NOTE: This function might be called from signal handlers in the
* non-smp case; therefore, it has to be async-signal safe in
@@ -439,9 +424,17 @@ wake_poller(ErtsPollSet ps, int interrupted)
res = write(ps->wake_fds[1], "!", 1);
} while (res < 0 && errno == EINTR);
if (res <= 0 && errno != ERRNO_BLOCK) {
- fatal_error_async_signal_safe(__FILE__
- ":XXX:wake_poller(): "
- "Failed to write on wakeup pipe\n");
+ if (async_signal_safe)
+ fatal_error_async_signal_safe(__FILE__
+ ":XXX:wake_poller(): "
+ "Failed to write on wakeup pipe\n");
+ else
+ fatal_error("%s:%d:wake_poller(): "
+ "Failed to write to wakeup pipe fd=%d: "
+ "%s (%d)\n",
+ __FILE__, __LINE__,
+ ps->wake_fds[1],
+ erl_errno_id(errno), errno);
}
}
}
@@ -449,11 +442,18 @@ wake_poller(ErtsPollSet ps, int interrupted)
static ERTS_INLINE void
cleanup_wakeup_pipe(ErtsPollSet ps)
{
+#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
+ int intr = 0;
+#endif
int fd = ps->wake_fds[0];
int res;
do {
char buf[32];
res = read(fd, buf, sizeof(buf));
+#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
+ if (res > 0)
+ intr = 1;
+#endif
} while (res > 0 || (res < 0 && errno == EINTR));
if (res < 0 && errno != ERRNO_BLOCK) {
fatal_error("%s:%d:cleanup_wakeup_pipe(): "
@@ -463,6 +463,10 @@ cleanup_wakeup_pipe(ErtsPollSet ps)
fd,
erl_errno_id(errno), errno);
}
+#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
+ if (intr)
+ erts_atomic32_set_nob(&ps->wakeup_state, ERTS_POLL_WOKEN_INTR);
+#endif
}
static void
@@ -1497,7 +1501,7 @@ ERTS_POLL_EXPORT(erts_poll_controlv)(ErtsPollSet ps,
#ifdef ERTS_SMP
if (final_do_wake)
- wake_poller(ps, 0);
+ wake_poller(ps, 0, 0);
#endif /* ERTS_SMP */
}
@@ -1520,7 +1524,7 @@ ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet ps,
#ifdef ERTS_SMP
if (*do_wake) {
- wake_poller(ps, 0);
+ wake_poller(ps, 0, 0);
}
#endif /* ERTS_SMP */
@@ -1893,9 +1897,9 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res,
}
static ERTS_INLINE int
-check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res, int *ps_locked)
+check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res)
{
- ASSERT(!*ps_locked);
+ int res;
if (erts_smp_atomic_read_nob(&ps->no_of_user_fds) == 0
&& tv->tv_usec == 0 && tv->tv_sec == 0) {
/* Nothing to poll and zero timeout; done... */
@@ -1915,16 +1919,23 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res, int *ps_locked)
timeout = INT_MAX;
if (max_res > ps->res_events_len)
grow_res_events(ps, max_res);
- return epoll_wait(ps->kp_fd, ps->res_events, max_res, (int)timeout);
+#ifdef ERTS_SMP
+ if (timeout)
+ erts_thr_progress_prepare_wait(NULL);
+#endif
+ res = epoll_wait(ps->kp_fd, ps->res_events, max_res, (int)timeout);
#elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */
struct timespec ts;
- ts.tv_sec = tv->tv_sec;
- ts.tv_nsec = tv->tv_usec*1000;
if (max_res > ps->res_events_len)
grow_res_events(ps, max_res);
- return kevent(ps->kp_fd, NULL, 0, ps->res_events, max_res, &ts);
+#ifdef ERTS_SMP
+ if (timeout)
+ erts_thr_progress_prepare_wait(NULL);
+#endif
+ ts.tv_sec = tv->tv_sec;
+ ts.tv_nsec = tv->tv_usec*1000;
+ res = kevent(ps->kp_fd, NULL, 0, ps->res_events, max_res, &ts);
#endif /* ----------------------------------------- */
-
}
else /* use fallback (i.e. poll() or select()) */
#endif /* ERTS_POLL_USE_FALLBACK */
@@ -1947,22 +1958,38 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res, int *ps_locked)
if (poll_res.dp_nfds > ps->res_events_len)
grow_res_events(ps, poll_res.dp_nfds);
poll_res.dp_fds = ps->res_events;
+#ifdef ERTS_SMP
+ if (timeout)
+ erts_thr_progress_prepare_wait(NULL);
+#endif
poll_res.dp_timeout = (int) timeout;
- return ioctl(ps->kp_fd, DP_POLL, &poll_res);
+ res = ioctl(ps->kp_fd, DP_POLL, &poll_res);
#elif ERTS_POLL_USE_POLL /* --- poll -------------------------------- */
if (timeout > INT_MAX)
timeout = INT_MAX;
- return poll(ps->poll_fds, ps->no_poll_fds, (int) timeout);
+#ifdef ERTS_SMP
+ if (timeout)
+ erts_thr_progress_prepare_wait(NULL);
+#endif
+ res = poll(ps->poll_fds, ps->no_poll_fds, (int) timeout);
#elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */
- int res;
+ SysTimeval to = *tv;
+
ps->res_input_fds = ps->input_fds;
ps->res_output_fds = ps->output_fds;
+
+#ifdef ERTS_SMP
+ if (to.tv_sec || to.tv_usec)
+ erts_thr_progress_prepare_wait(NULL);
+#endif
res = select(ps->max_fd + 1,
&ps->res_input_fds,
&ps->res_output_fds,
NULL,
- tv);
+ &to);
#ifdef ERTS_SMP
+ if (to.tv_sec || to.tv_usec)
+ erts_thr_progress_finalize_wait(NULL);
if (res < 0
&& errno == EBADF
&& ERTS_POLLSET_HAVE_UPDATE_REQUESTS(ps)) {
@@ -1978,15 +2005,16 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res, int *ps_locked)
* have triggered, we fake an EAGAIN error and let the caller
* restart us.
*/
- SysTimeval zero_tv = {0, 0};
- *ps_locked = 1;
+ to.tv_sec = 0;
+ to.tv_usec = 0;
ERTS_POLLSET_LOCK(ps);
handle_update_requests(ps);
+ ERTS_POLLSET_UNLOCK(ps);
res = select(ps->max_fd + 1,
&ps->res_input_fds,
&ps->res_output_fds,
NULL,
- &zero_tv);
+ &to);
if (res == 0) {
errno = EAGAIN;
res = -1;
@@ -1996,6 +2024,11 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res, int *ps_locked)
return res;
#endif /* ----------------------------------------- */
}
+#ifdef ERTS_SMP
+ if (timeout)
+ erts_thr_progress_finalize_wait(NULL);
+#endif
+ return res;
}
}
@@ -2007,7 +2040,9 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps,
{
int res, no_fds;
int ebadf = 0;
- int ps_locked;
+#ifdef ERTS_SMP
+ int ps_locked = 0;
+#endif
SysTimeval *tvp;
SysTimeval itv;
@@ -2049,8 +2084,7 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps,
}
#endif
- ps_locked = 0;
- res = check_fd_events(ps, tvp, no_fds, &ps_locked);
+ res = check_fd_events(ps, tvp, no_fds);
woke_up(ps);
@@ -2072,10 +2106,8 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps,
#endif
#ifdef ERTS_SMP
- if (!ps_locked) {
- ps_locked = 1;
- ERTS_POLLSET_LOCK(ps);
- }
+ ps_locked = 1;
+ ERTS_POLLSET_LOCK(ps);
#endif
no_fds = save_poll_result(ps, pr, no_fds, res, ebadf);
@@ -2111,19 +2143,26 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps,
void
ERTS_POLL_EXPORT(erts_poll_interrupt)(ErtsPollSet ps, int set)
{
-#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP)
- /*
- * NOTE: This function might be called from signal handlers in the
- * non-smp case; therefore, it has to be async-signal safe in
- * the non-smp case.
- */
+#if defined(USE_THREADS)
if (!set)
reset_wakeup_state(ps);
else
- wake_poller(ps, 1);
+ wake_poller(ps, 1, 0);
#endif
}
+#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
+void
+ERTS_POLL_EXPORT(erts_poll_async_sig_interrupt)(ErtsPollSet ps)
+{
+ /*
+ * NOTE: This function is called from signal handlers, it,
+ * therefore, it has to be async-signal safe.
+ */
+ wake_poller(ps, 1, 1);
+}
+#endif
+
/*
* erts_poll_interrupt_timed():
* If 'set' != 0, interrupt thread blocked in erts_poll_wait() if it
@@ -2139,7 +2178,7 @@ ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet ps,
reset_wakeup_state(ps);
else {
if (erts_smp_atomic32_read_acqb(&ps->timeout) > (erts_aint32_t) msec)
- wake_poller(ps, 1);
+ wake_poller(ps, 1, 0);
#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS
else {
if (ERTS_POLLSET_IS_POLLED(ps))
@@ -2266,10 +2305,8 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void)
erts_atomic32_init_nob(&ps->polled, 0);
erts_smp_mtx_init(&ps->mtx, "pollset");
#endif
-#ifdef ERTS_SMP
+#if defined(USE_THREADS) || ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
erts_atomic32_init_nob(&ps->wakeup_state, (erts_aint32_t) 0);
-#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT
- ps->wakeup_state = 0;
#endif
#if ERTS_POLL_USE_WAKEUP_PIPE
create_wakeup_pipe(ps);
diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h
index 725a77a152..e0296c6a33 100644
--- a/erts/emulator/sys/common/erl_poll.h
+++ b/erts/emulator/sys/common/erl_poll.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -216,6 +216,9 @@ typedef struct {
#endif
} ErtsPollInfo;
+#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
+void ERTS_POLL_EXPORT(erts_poll_async_sig_interrupt)(ErtsPollSet);
+#endif
void ERTS_POLL_EXPORT(erts_poll_interrupt)(ErtsPollSet,
int);
void ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet,
diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h
index d8d51b192c..9a5ed9f5bc 100644
--- a/erts/emulator/sys/unix/erl_unix_sys.h
+++ b/erts/emulator/sys/unix/erl_unix_sys.h
@@ -129,10 +129,12 @@
#define HAVE_ERTS_CHECK_IO_DEBUG
int erts_check_io_debug(void);
-
-#ifndef ENABLE_CHILD_WAITER_THREAD
+#ifndef ERTS_SMP
# undef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
# define ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
+#endif
+
+#ifndef ENABLE_CHILD_WAITER_THREAD
# ifdef ERTS_SMP
# define ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN
void erts_check_children(void);
diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c
index 20bfaad9aa..c6b63350e5 100644
--- a/erts/emulator/sys/unix/sys.c
+++ b/erts/emulator/sys/unix/sys.c
@@ -52,6 +52,7 @@
#define ERTS_WANT_GOT_SIGUSR1
#define WANT_NONBLOCKING /* must define this to pull in defs from sys.h */
#include "sys.h"
+#include "erl_thr_progress.h"
#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
#define __DARWIN__ 1
@@ -127,7 +128,6 @@ static ErtsSysReportExit *report_exit_list;
static ErtsSysReportExit *report_exit_transit_list;
#endif
-extern int check_async_ready(void);
extern int driver_interrupt(int, int);
extern void do_break(void);
@@ -263,6 +263,7 @@ int erts_use_kernel_poll = 0;
struct {
int (*select)(ErlDrvPort, ErlDrvEvent, int, int);
int (*event)(ErlDrvPort, ErlDrvEvent, ErlDrvEventData);
+ void (*check_io_as_interrupt)(void);
void (*check_io_interrupt)(int);
void (*check_io_interrupt_tmd)(int, long);
void (*check_io)(int);
@@ -302,6 +303,9 @@ init_check_io(void)
if (erts_use_kernel_poll) {
io_func.select = driver_select_kp;
io_func.event = driver_event_kp;
+#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
+ io_func.check_io_as_interrupt = erts_check_io_async_sig_interrupt_kp;
+#endif
io_func.check_io_interrupt = erts_check_io_interrupt_kp;
io_func.check_io_interrupt_tmd = erts_check_io_interrupt_timed_kp;
io_func.check_io = erts_check_io_kp;
@@ -314,6 +318,9 @@ init_check_io(void)
else {
io_func.select = driver_select_nkp;
io_func.event = driver_event_nkp;
+#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
+ io_func.check_io_as_interrupt = erts_check_io_async_sig_interrupt_nkp;
+#endif
io_func.check_io_interrupt = erts_check_io_interrupt_nkp;
io_func.check_io_interrupt_tmd = erts_check_io_interrupt_timed_nkp;
io_func.check_io = erts_check_io_nkp;
@@ -325,6 +332,11 @@ init_check_io(void)
}
}
+#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
+#define ERTS_CHK_IO_AS_INTR() (*io_func.check_io_as_interrupt)()
+#else
+#define ERTS_CHK_IO_AS_INTR() (*io_func.check_io_interrupt)(1)
+#endif
#define ERTS_CHK_IO_INTR (*io_func.check_io_interrupt)
#define ERTS_CHK_IO_INTR_TMD (*io_func.check_io_interrupt_tmd)
#define ERTS_CHK_IO (*io_func.check_io)
@@ -339,6 +351,11 @@ init_check_io(void)
max_files = erts_check_io_max_files();
}
+#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
+#define ERTS_CHK_IO_AS_INTR() erts_check_io_async_sig_interrupt()
+#else
+#define ERTS_CHK_IO_AS_INTR() erts_check_io_interrupt(1)
+#endif
#define ERTS_CHK_IO_INTR erts_check_io_interrupt
#define ERTS_CHK_IO_INTR_TMD erts_check_io_interrupt_timed
#define ERTS_CHK_IO erts_check_io
@@ -346,13 +363,13 @@ init_check_io(void)
#endif
-#ifdef ERTS_SMP
void
erts_sys_schedule_interrupt(int set)
{
ERTS_CHK_IO_INTR(set);
}
+#ifdef ERTS_SMP
void
erts_sys_schedule_interrupt_timed(int set, long msec)
{
@@ -731,7 +748,7 @@ break_requested(void)
erl_exit(ERTS_INTR_EXIT, "");
ERTS_SET_BREAK_REQUESTED;
- ERTS_CHK_IO_INTR(1); /* Make sure we don't sleep in poll */
+ ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */
}
/* set up signal handlers for break and quit */
@@ -1102,31 +1119,6 @@ struct erl_drv_entry vanilla_driver_entry = {
stop_select
};
-#if defined(USE_THREADS) && !defined(ERTS_SMP)
-static int async_drv_init(void);
-static ErlDrvData async_drv_start(ErlDrvPort, char*, SysDriverOpts*);
-static void async_drv_stop(ErlDrvData);
-static void async_drv_input(ErlDrvData, ErlDrvEvent);
-
-/* INTERNAL use only */
-
-struct erl_drv_entry async_driver_entry = {
- async_drv_init,
- async_drv_start,
- async_drv_stop,
- NULL,
- async_drv_input,
- NULL,
- "async",
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL
-};
-#endif
-
/* Handle SIGCHLD signals. */
#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL))
static RETSIGTYPE onchld(void)
@@ -1140,7 +1132,7 @@ static RETSIGTYPE onchld(int signum)
smp_sig_notify('C');
#else
children_died = 1;
- ERTS_CHK_IO_INTR(1); /* Make sure we don't sleep in poll */
+ ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */
#endif
}
@@ -2311,87 +2303,6 @@ static void stop_select(ErlDrvEvent fd, void* _)
close((int)fd);
}
-/*
-** Async opertation support
-*/
-#if defined(USE_THREADS) && !defined(ERTS_SMP)
-static void
-sys_async_ready_failed(int fd, int r, int err)
-{
- char buf[120];
- sprintf(buf, "sys_async_ready(): Fatal error: fd=%d, r=%d, errno=%d\n",
- fd, r, err);
- erts_silence_warn_unused_result(write(2, buf, strlen(buf)));
- abort();
-}
-
-/* called from threads !! */
-void sys_async_ready(int fd)
-{
- int r;
- while (1) {
- r = write(fd, "0", 1); /* signal main thread fd MUST be async_fd[1] */
- if (r == 1) {
- DEBUGF(("sys_async_ready(): r = 1\r\n"));
- break;
- }
- if (r < 0 && errno == EINTR) {
- DEBUGF(("sys_async_ready(): r = %d\r\n", r));
- continue;
- }
- sys_async_ready_failed(fd, r, errno);
- }
-}
-
-static int async_drv_init(void)
-{
- async_fd[0] = -1;
- async_fd[1] = -1;
- return 0;
-}
-
-static ErlDrvData async_drv_start(ErlDrvPort port_num,
- char* name, SysDriverOpts* opts)
-{
- if (async_fd[0] != -1)
- return ERL_DRV_ERROR_GENERAL;
- if (pipe(async_fd) < 0)
- return ERL_DRV_ERROR_GENERAL;
-
- DEBUGF(("async_drv_start: %d\r\n", port_num));
-
- SET_NONBLOCKING(async_fd[0]);
- driver_select(port_num, async_fd[0], ERL_DRV_READ, 1);
-
- if (init_async(async_fd[1]) < 0)
- return ERL_DRV_ERROR_GENERAL;
- return (ErlDrvData)port_num;
-}
-
-static void async_drv_stop(ErlDrvData e)
-{
- int port_num = (int)(long)e;
-
- DEBUGF(("async_drv_stop: %d\r\n", port_num));
-
- exit_async();
-
- driver_select(port_num, async_fd[0], ERL_DRV_READ, 0);
-
- close(async_fd[0]);
- close(async_fd[1]);
- async_fd[0] = async_fd[1] = -1;
-}
-
-
-static void async_drv_input(ErlDrvData e, ErlDrvEvent fd)
-{
- char *buf[32];
- DEBUGF(("async_drv_input\r\n"));
- while (read((int) fd, (void *) buf, 32) > 0); /* fd MUST be async_fd[0] */
- check_async_ready(); /* invoke all async_ready */
-}
-#endif
void erts_do_break_handling(void)
{
@@ -2403,11 +2314,7 @@ void erts_do_break_handling(void)
* therefore, make sure that all threads but this one are blocked before
* proceeding!
*/
- erts_smp_block_system(0);
- /*
- * NOTE: since we allow gc we are not allowed to lock
- * (any) process main locks while blocking system...
- */
+ erts_smp_thr_progress_block();
/* during break we revert to initial settings */
/* this is done differently for oldshell */
@@ -2435,7 +2342,7 @@ void erts_do_break_handling(void)
tcsetattr(0,TCSANOW,&temp_mode);
}
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
}
/* Fills in the systems representation of the jam/beam process identifier.
@@ -2469,12 +2376,10 @@ erts_sys_putenv(char *buffer, int sep_ix)
}
int
-erts_sys_getenv(char *key, char *value, size_t *size)
+erts_sys_getenv__(char *key, char *value, size_t *size)
{
- char *orig_value;
int res;
- erts_smp_rwmtx_rlock(&environ_rwmtx);
- orig_value = getenv(key);
+ char *orig_value = getenv(key);
if (!orig_value)
res = -1;
else {
@@ -2489,6 +2394,15 @@ erts_sys_getenv(char *key, char *value, size_t *size)
res = 0;
}
}
+ return res;
+}
+
+int
+erts_sys_getenv(char *key, char *value, size_t *size)
+{
+ int res;
+ erts_smp_rwmtx_rlock(&environ_rwmtx);
+ res = erts_sys_getenv__(key, value, size);
erts_smp_rwmtx_runlock(&environ_rwmtx);
return res;
}
@@ -2500,31 +2414,6 @@ sys_init_io(void)
erts_alloc(ERTS_ALC_T_FD_TAB, max_files * sizeof(struct fd_data));
erts_smp_atomic_add_nob(&sys_misc_mem_sz,
max_files * sizeof(struct fd_data));
-
-#ifdef USE_THREADS
-#ifdef ERTS_SMP
- if (init_async(-1) < 0)
- erl_exit(1, "Failed to initialize async-threads\n");
-#else
- {
- /* This is speical stuff, starting a driver from the
- * system routines, but is a nice way of handling stuff
- * the erlang way
- */
- SysDriverOpts dopts;
- int ret;
-
- sys_memset((void*)&dopts, 0, sizeof(SysDriverOpts));
- add_driver_entry(&async_driver_entry);
- ret = erts_open_driver(NULL, NIL, "async", &dopts, NULL);
- DEBUGF(("open_driver = %d\n", ret));
- if (ret < 0)
- erl_exit(1, "Failed to open async driver\n");
- erts_port[ret].status |= ERTS_PORT_SFLG_IMMORTAL;
- }
-#endif
-#endif
-
}
#if (0) /* unused? */
@@ -2751,15 +2640,7 @@ initiate_report_exit_status(ErtsSysReportExit *rep, int status)
rep->next = report_exit_transit_list;
rep->status = status;
report_exit_transit_list = rep;
- /*
- * We need the scheduler thread to call check_children().
- * If the scheduler thread is sleeping in a poll with a
- * timeout, we need to wake the scheduler thread. We use the
- * functionality of the async driver to do this, instead of
- * implementing yet another driver doing the same thing. A
- * little bit ugly, but it works...
- */
- sys_async_ready(async_fd[1]);
+ erts_sys_schedule_interrupt(1);
}
static int check_children(void)
@@ -2846,20 +2727,11 @@ erl_sys_schedule(int runnable)
{
#ifdef ERTS_SMP
ERTS_CHK_IO(!runnable);
- ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING);
#else
- ERTS_CHK_IO_INTR(0);
- if (runnable) {
- ERTS_CHK_IO(0); /* Poll for I/O */
- check_async_ready(); /* Check async completions */
- } else {
- int wait_for_io = !check_async_ready();
- if (wait_for_io)
- wait_for_io = !check_children();
- ERTS_CHK_IO(wait_for_io);
- }
- (void) check_children();
+ ERTS_CHK_IO(runnable ? 0 : !check_children());
#endif
+ ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
+ (void) check_children();
}
@@ -2916,15 +2788,15 @@ signal_dispatcher_thread_func(void *unused)
* to other threads.
*
* NOTE 2: The signal dispatcher thread is not a blockable
- * thread (i.e., it hasn't called
- * erts_register_blockable_thread()). This is
- * intentional. We want to be able to interrupt
- * writing of a crash dump by hitting C-c twice.
- * Since it isn't a blockable thread it is important
- * that it doesn't change the state of any data that
- * a blocking thread expects to have exclusive access
- * to (unless the signal dispatcher itself explicitly
- * is blocking all blockable threads).
+ * thread (i.e., not a thread managed by the
+ * erl_thr_progress module). This is intentional.
+ * We want to be able to interrupt writing of a crash
+ * dump by hitting C-c twice. Since it isn't a
+ * blockable thread it is important that it doesn't
+ * change the state of any data that a blocking thread
+ * expects to have exclusive access to (unless the
+ * signal dispatcher itself explicitly is blocking all
+ * blockable threads).
*/
switch (buf[i]) {
case 0: /* Emulator initialized */
@@ -2964,7 +2836,7 @@ signal_dispatcher_thread_func(void *unused)
buf[i]);
}
}
- ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING);
+ ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
}
return NULL;
}
diff --git a/erts/emulator/sys/vxworks/sys.c b/erts/emulator/sys/vxworks/sys.c
index a59e4ec26a..d6d1fe64e0 100644
--- a/erts/emulator/sys/vxworks/sys.c
+++ b/erts/emulator/sys/vxworks/sys.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -238,6 +238,12 @@ erl_sys_args(int* argc, char** argv)
ASSERT(max_files <= erts_vxworks_max_files);
}
+void
+erts_sys_schedule_interrupt(int set)
+{
+ erts_check_io_interrupt(set);
+}
+
/*
* Called from schedule() when it runs out of runnable processes,
* or when Erlang code has performed INPUT_REDUCTIONS reduction
@@ -246,7 +252,6 @@ erl_sys_args(int* argc, char** argv)
void
erl_sys_schedule(int runnable)
{
- erts_check_io_interrupt(0);
erts_check_io(!runnable);
}
@@ -309,7 +314,7 @@ static void request_break(void)
fprintf(stderr,"break!\n");
#endif
erts_break_requested = 1;
- erts_check_io_interrupt(1); /* Make sure we don't sleep in erts_poll_wait */
+ erts_check_io_async_sig_interrupt(1); /* Make sure we don't sleep in erts_poll_wait */
}
static void do_quit(void)
@@ -1515,6 +1520,12 @@ erts_sys_getenv(char *key, char *value, size_t *size)
return res;
}
+int
+erts_sys_getenv__(char *key, char *value, size_t *size)
+{
+ return erts_sys_getenv(key, value, size);
+}
+
void
sys_init_io(void)
{
diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c
index 735c420d8e..ab4ef05118 100644
--- a/erts/emulator/sys/win32/erl_poll.c
+++ b/erts/emulator/sys/win32/erl_poll.c
@@ -1159,7 +1159,13 @@ int erts_poll_wait(ErtsPollSet ps,
HARDDEBUGF(("Start waiting %d [%d]",num_h, (int) timeout));
ERTS_POLLSET_UNLOCK(ps);
+#ifdef ERTS_SMP
+ erts_thr_progress_prepare_wait(NULL);
+#endif
WaitForMultipleObjects(num_h, harr, FALSE, timeout);
+#ifdef ERTS_SMP
+ erts_thr_progress_finalize_wait(NULL);
+#endif
ERTS_POLLSET_LOCK(ps);
HARDDEBUGF(("Stop waiting %d [%d]",num_h, (int) timeout));
woke_up(ps);
diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c
index 3e151c26d5..6f33ef7ad6 100644
--- a/erts/emulator/sys/win32/sys.c
+++ b/erts/emulator/sys/win32/sys.c
@@ -216,6 +216,9 @@ void sys_tty_reset(int exit_code)
void erl_sys_args(int* argc, char** argv)
{
char *event_name;
+
+ erts_sys_env_init();
+
nohup = get_and_remove_option(argc, argv, "-nohup");
#ifdef DEBUG
@@ -566,51 +569,6 @@ struct erl_drv_entry vanilla_driver_entry = {
stop_select
};
-#if defined(USE_THREADS) && !defined(ERTS_SMP)
-
-static int async_drv_init(void);
-static ErlDrvData async_drv_start(ErlDrvPort, char*, SysDriverOpts*);
-static void async_drv_stop(ErlDrvData);
-static void async_drv_input(ErlDrvData, ErlDrvEvent);
-
-/* INTERNAL use only */
-
-void null_output(ErlDrvData drv_data, char* buf, int len)
-{
-}
-
-void null_ready_output(ErlDrvData drv_data, ErlDrvEvent event)
-{
-}
-
-struct erl_drv_entry async_driver_entry = {
- async_drv_init,
- async_drv_start,
- async_drv_stop,
- null_output,
- async_drv_input,
- null_ready_output,
- "async",
- NULL, /* finish */
- NULL, /* handle */
- NULL, /* control */
- NULL, /* timeout */
- NULL, /* outputv */
- NULL, /* ready_async */
- NULL, /* flush */
- NULL, /* call */
- NULL, /* event */
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- 0, /* ERL_DRV_FLAGs */
- NULL,
- NULL, /* process_exit */
- stop_select
-};
-
-#endif
-
/*
* Initialises a DriverData structure.
*
@@ -2825,30 +2783,6 @@ sys_init_io(void)
We estimate the number to twice the amount of ports.
We really dont know on windows, do we? */
max_files = 2*erts_max_ports;
-
-#ifdef USE_THREADS
-#ifdef ERTS_SMP
- if (init_async(-1) < 0)
- erl_exit(1, "Failed to initialize async-threads\n");
-#else
- {
- /* This is special stuff, starting a driver from the
- * system routines, but is a nice way of handling stuff
- * the erlang way
- */
- SysDriverOpts dopts;
- int ret;
-
- sys_memset((void*)&dopts, 0, sizeof(SysDriverOpts));
- add_driver_entry(&async_driver_entry);
- ret = erts_open_driver(NULL, NIL, "async", &dopts, NULL);
- DEBUGF(("open_driver = %d\n", ret));
- if (ret < 0)
- erl_exit(1, "Failed to open async driver\n");
- erts_port[ret].status |= ERTS_PORT_SFLG_IMMORTAL;
- }
-#endif
-#endif
}
#ifdef ERTS_SMP
@@ -3283,7 +3217,6 @@ erts_sys_pre_init(void)
}
#endif
erts_smp_atomic_init_nob(&sys_misc_mem_sz, 0);
- erts_sys_env_init();
}
void noinherit_std_handle(DWORD type)
@@ -3360,13 +3293,13 @@ void erl_sys_init(void)
SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX);
}
-#ifdef ERTS_SMP
void
erts_sys_schedule_interrupt(int set)
{
erts_check_io_interrupt(set);
}
+#ifdef ERTS_SMP
void
erts_sys_schedule_interrupt_timed(int set, long msec)
{
@@ -3382,76 +3315,7 @@ erts_sys_schedule_interrupt_timed(int set, long msec)
void
erl_sys_schedule(int runnable)
{
-#ifdef ERTS_SMP
erts_check_io(!runnable);
- ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING);
-#else
- erts_check_io_interrupt(0);
- if (runnable) {
- erts_check_io(0); /* Poll for I/O */
- check_async_ready(); /* Check async completions */
- } else {
- erts_check_io(check_async_ready() ? 0 : 1);
- }
-#endif
-}
-
-#if defined(USE_THREADS) && !defined(ERTS_SMP)
-/*
- * Async operation support.
- */
-
-static ErlDrvEvent async_drv_event;
-
-void
-sys_async_ready(int fd)
-{
- SetEvent((HANDLE)async_drv_event);
-}
-
-static int
-async_drv_init(void)
-{
- async_drv_event = (ErlDrvEvent) NULL;
- return 0;
-}
-
-static ErlDrvData
-async_drv_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts)
-{
- if (async_drv_event != (ErlDrvEvent) NULL) {
- return ERL_DRV_ERROR_GENERAL;
- }
- if ((async_drv_event = (ErlDrvEvent)CreateAutoEvent(FALSE)) == (ErlDrvEvent) NULL) {
- return ERL_DRV_ERROR_GENERAL;
- }
-
- driver_select(port_num, async_drv_event, ERL_DRV_READ|ERL_DRV_USE, 1);
- if (init_async(async_drv_event) < 0) {
- return ERL_DRV_ERROR_GENERAL;
- }
- return (ErlDrvData)port_num;
-}
-
-static void
-async_drv_stop(ErlDrvData port_num)
-{
- exit_async();
- driver_select((ErlDrvPort)port_num, async_drv_event, ERL_DRV_READ|ERL_DRV_USE, 0);
- /*CloseHandle((HANDLE)async_drv_event);*/
- async_drv_event = (ErlDrvEvent) NULL;
+ ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
}
-
-static void
-async_drv_input(ErlDrvData port_num, ErlDrvEvent e)
-{
- check_async_ready();
-
- /*
- * Our event is auto-resetting.
- */
-}
-
-#endif
-
diff --git a/erts/emulator/sys/win32/sys_env.c b/erts/emulator/sys/win32/sys_env.c
index 02c8433a10..7acc7f07ee 100644
--- a/erts/emulator/sys/win32/sys_env.c
+++ b/erts/emulator/sys/win32/sys_env.c
@@ -55,19 +55,17 @@ erts_sys_putenv(char *key_value, int sep_ix)
}
int
-erts_sys_getenv(char *key, char *value, size_t *size)
+erts_sys_getenv__(char *key, char *value, size_t *size)
{
size_t req_size = 0;
int res = 0;
DWORD new_size;
- erts_smp_rwmtx_rlock(&environ_rwmtx);
SetLastError(0);
new_size = GetEnvironmentVariable((LPCTSTR) key,
(LPTSTR) value,
(DWORD) *size);
res = !new_size && GetLastError() == ERROR_ENVVAR_NOT_FOUND ? -1 : 0;
- erts_smp_rwmtx_runlock(&environ_rwmtx);
if (res < 0)
return res;
res = new_size > *size ? 1 : 0;
@@ -75,6 +73,16 @@ erts_sys_getenv(char *key, char *value, size_t *size)
return res;
}
+int
+erts_sys_getenv(char *key, char *value, size_t *size)
+{
+ int res;
+ erts_smp_rwmtx_rlock(&environ_rwmtx);
+ res = erts_sys_getenv__(key, value, size);
+ erts_smp_rwmtx_runlock(&environ_rwmtx);
+ return res;
+}
+
struct win32_getenv_state {
char *env;
char *next;
diff --git a/erts/emulator/sys/win32/sys_interrupt.c b/erts/emulator/sys/win32/sys_interrupt.c
index 1d73edd30b..93aaa23f97 100644
--- a/erts/emulator/sys/win32/sys_interrupt.c
+++ b/erts/emulator/sys/win32/sys_interrupt.c
@@ -21,6 +21,7 @@
*/
#include "sys.h"
#include "erl_alloc.h"
+#include "erl_thr_progress.h"
#include "erl_driver.h"
#include "../../drivers/win32/win_con.h"
@@ -52,14 +53,14 @@ void erts_do_break_handling(void)
* therefore, make sure that all threads but this one are blocked before
* proceeding!
*/
- erts_smp_block_system(0);
+ erts_smp_thr_progress_block();
/* call the break handling function, reset the flag */
do_break();
ResetEvent(erts_sys_break_event);
ERTS_UNSET_BREAK_REQUESTED;
- erts_smp_release_system();
+ erts_smp_thr_progress_unblock();
}
diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl
index a77ea4f3be..c07dbc5871 100644
--- a/erts/emulator/test/driver_SUITE.erl
+++ b/erts/emulator/test/driver_SUITE.erl
@@ -75,7 +75,9 @@
smp_select/1,
driver_select_use/1,
thread_mseg_alloc_cache_clean/1,
- otp_9302/1]).
+ otp_9302/1,
+ thr_free_drv/1,
+ async_blast/1]).
-export([bin_prefix/2]).
@@ -143,7 +145,9 @@ all() ->
otp_6879, caller, many_events, missing_callbacks,
smp_select, driver_select_use,
thread_mseg_alloc_cache_clean,
- otp_9302].
+ otp_9302,
+ thr_free_drv,
+ async_blast].
groups() ->
[{timer, [],
@@ -1792,7 +1796,7 @@ driver_select_use0(Config) ->
thread_mseg_alloc_cache_clean(Config) when is_list(Config) ->
case {erlang:system_info(threads),
- erlang:system_info({allocator,mseg_alloc}),
+ mseg_inst_info(0),
driver_alloc_sbct()} of
{_, false, _} ->
?line {skipped, "No mseg_alloc"};
@@ -1804,13 +1808,13 @@ thread_mseg_alloc_cache_clean(Config) when is_list(Config) ->
?line {skipped, "driver_alloc() using too large single block threshold"};
{_, _, 0} ->
?line {skipped, "driver_alloc() using too low single block threshold"};
- {true, MsegAllocInfo, SBCT} ->
+ {true, _MsegAllocInfo, SBCT} ->
?line DrvName = 'thr_alloc_drv',
?line Path = ?config(data_dir, Config),
?line erl_ddll:start(),
?line ok = load_driver(Path, DrvName),
?line Port = open_port({spawn, DrvName}, []),
- ?line CCI = mseg_alloc_cci(MsegAllocInfo),
+ ?line CCI = 1000,
?line ?t:format("CCI = ~p~n", [CCI]),
?line CCC = mseg_alloc_ccc(),
?line ?t:format("CCC = ~p~n", [CCC]),
@@ -1831,7 +1835,7 @@ mseg_alloc_cci(MsegAllocInfo) ->
?line CCI.
mseg_alloc_ccc() ->
- mseg_alloc_ccc(erlang:system_info({allocator,mseg_alloc})).
+ mseg_alloc_ccc(mseg_inst_info(0)).
mseg_alloc_ccc(MsegAllocInfo) ->
?line {value,{memkind, MKL}} = lists:keysearch(memkind,1,MsegAllocInfo),
@@ -1841,7 +1845,7 @@ mseg_alloc_ccc(MsegAllocInfo) ->
?line GigaCCC*1000000000 + CCC.
mseg_alloc_cached_segments() ->
- mseg_alloc_cached_segments(erlang:system_info({allocator,mseg_alloc})).
+ mseg_alloc_cached_segments(mseg_inst_info(0)).
mseg_alloc_cached_segments(MsegAllocInfo) ->
MemName = case is_halfword_vm() of
@@ -1859,6 +1863,13 @@ mseg_alloc_cached_segments(MsegAllocInfo) ->
= lists:keysearch(cached_segments, 1, SL),
?line CS.
+mseg_inst_info(I) ->
+ {value, {instance, I, Value}}
+ = lists:keysearch(I,
+ 2,
+ erlang:system_info({allocator,mseg_alloc})),
+ Value.
+
is_halfword_vm() ->
case {erlang:system_info({wordsize, internal}),
erlang:system_info({wordsize, external})} of
@@ -1902,18 +1913,105 @@ otp_9302(Config) when is_list(Config) ->
?line port_command(Port, ""),
?line {msg, block} = get_port_msg(Port, infinity),
?line {msg, job} = get_port_msg(Port, infinity),
- ?line case erlang:system_info(thread_pool_size) of
- 0 ->
- {msg, cancel} = get_port_msg(Port, infinity);
- _ ->
- ok
- end,
- ?line {msg, job} = get_port_msg(Port, infinity),
+ ?line C = case erlang:system_info(thread_pool_size) of
+ 0 ->
+ ?line {msg, cancel} = get_port_msg(Port, infinity),
+ ?line {msg, job} = get_port_msg(Port, infinity),
+ ?line false;
+ _ ->
+ case get_port_msg(Port, infinity) of
+ {msg, cancel} -> %% Cancel always fail in Rel >= 15
+ ?line {msg, job} = get_port_msg(Port, infinity),
+ ?line false;
+ {msg, job} ->
+ ?line ok,
+ ?line true
+ end
+ end,
?line {msg, end_of_jobs} = get_port_msg(Port, infinity),
?line no_msg = get_port_msg(Port, 2000),
?line port_close(Port),
+ ?line case C of
+ true ->
+ ?line {comment, "Async job cancelled"};
+ false ->
+ ?line {comment, "Async job not cancelled"}
+ end.
+
+thr_free_drv(Config) when is_list(Config) ->
+ ?line Path = ?config(data_dir, Config),
+ ?line erl_ddll:start(),
+ ?line ok = load_driver(Path, thr_free_drv),
+ ?line MemBefore = driver_alloc_size(),
+% io:format("SID=~p", [erlang:system_info(scheduler_id)]),
+ ?line Port = open_port({spawn, thr_free_drv}, []),
+ ?line MemPeek = driver_alloc_size(),
+ ?line true = is_port(Port),
+ ?line ok = thr_free_drv_control(Port, 0),
+ ?line port_close(Port),
+ ?line MemAfter = driver_alloc_size(),
+ ?line io:format("MemPeek=~p~n", [MemPeek]),
+ ?line io:format("MemBefore=~p, MemAfter=~p~n", [MemBefore, MemAfter]),
+ ?line MemBefore = MemAfter,
+ ?line case MemPeek of
+ undefined -> ok;
+ _ ->
+ ?line true = MemPeek > MemBefore
+ end,
?line ok.
+thr_free_drv_control(Port, N) ->
+ case erlang:port_control(Port, 0, "") of
+ "done" ->
+ ok;
+ "more" ->
+ erlang:yield(),
+% io:format("N=~p, SID=~p", [N, erlang:system_info(scheduler_id)]),
+ thr_free_drv_control(Port, N+1)
+ end.
+
+async_blast(Config) when is_list(Config) ->
+ ?line Path = ?config(data_dir, Config),
+ ?line erl_ddll:start(),
+ ?line ok = load_driver(Path, async_blast_drv),
+ ?line SchedOnln = erlang:system_info(schedulers_online),
+ ?line MemBefore = driver_alloc_size(),
+ ?line Start = os:timestamp(),
+ ?line Blast = fun () ->
+ Port = open_port({spawn, async_blast_drv}, []),
+ true = is_port(Port),
+ port_command(Port, ""),
+ receive
+ {Port, done} ->
+ ok
+ end,
+ port_close(Port)
+ end,
+ ?line Ps = lists:map(fun (N) ->
+ spawn_opt(Blast,
+ [{scheduler,
+ (N rem SchedOnln)+ 1},
+ monitor])
+ end,
+ lists:seq(1, 100)),
+ ?line MemMid = driver_alloc_size(),
+ ?line lists:foreach(fun ({Pid, Mon}) ->
+ receive
+ {'DOWN',Mon,process,Pid,_} -> ok
+ end
+ end, Ps),
+ ?line End = os:timestamp(),
+ ?line MemAfter = driver_alloc_size(),
+ ?line io:format("MemBefore=~p, MemMid=~p, MemAfter=~p~n",
+ [MemBefore, MemMid, MemAfter]),
+ ?line AsyncBlastTime = timer:now_diff(End,Start)/1000000,
+ ?line io:format("AsyncBlastTime=~p~n", [AsyncBlastTime]),
+ ?line MemBefore = MemAfter,
+ ?line erlang:display({async_blast_time, AsyncBlastTime}),
+ ?line ok.
+
+
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Utilities
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -2077,3 +2175,33 @@ start_node(Config) when is_list(Config) ->
stop_node(Node) ->
?t:stop_node(Node).
+
+wait_deallocations() ->
+ try
+ erts_debug:set_internal_state(wait, deallocations)
+ catch error:undef ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ wait_deallocations()
+ end.
+
+driver_alloc_size() ->
+ wait_deallocations(),
+ case erlang:system_info({allocator_sizes, driver_alloc}) of
+ false ->
+ undefined;
+ MemInfo ->
+ CS = lists:foldl(
+ fun ({instance, _, L}, Acc) ->
+ {value,{_,SBMBCS}} = lists:keysearch(sbmbcs, 1, L),
+ {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L),
+ {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L),
+ [SBMBCS,MBCS,SBCS | Acc]
+ end,
+ [],
+ MemInfo),
+ lists:foldl(
+ fun(L, Sz0) ->
+ {value,{_,Sz,_,_}} = lists:keysearch(blocks_size, 1, L),
+ Sz0+Sz
+ end, 0, CS)
+ end.
diff --git a/erts/emulator/test/driver_SUITE_data/Makefile.src b/erts/emulator/test/driver_SUITE_data/Makefile.src
index 5b3ba1557e..dd48f6a0f7 100644
--- a/erts/emulator/test/driver_SUITE_data/Makefile.src
+++ b/erts/emulator/test/driver_SUITE_data/Makefile.src
@@ -12,7 +12,9 @@ MISC_DRVS = outputv_drv@dll@ \
many_events_drv@dll@ \
missing_callback_drv@dll@ \
thr_alloc_drv@dll@ \
- otp_9302_drv@dll@
+ otp_9302_drv@dll@ \
+ thr_free_drv@dll@ \
+ async_blast_drv@dll@
SYS_INFO_DRVS = sys_info_1_0_drv@dll@ \
sys_info_1_1_drv@dll@ \
diff --git a/erts/emulator/test/driver_SUITE_data/async_blast_drv.c b/erts/emulator/test/driver_SUITE_data/async_blast_drv.c
new file mode 100644
index 0000000000..3821f7e3dc
--- /dev/null
+++ b/erts/emulator/test/driver_SUITE_data/async_blast_drv.c
@@ -0,0 +1,124 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2011. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include "erl_driver.h"
+
+#define NO_ASYNC_JOBS 10000
+
+static void stop(ErlDrvData drv_data);
+static ErlDrvData start(ErlDrvPort port,
+ char *command);
+static void output(ErlDrvData drv_data,
+ char *buf, int len);
+static void ready_async(ErlDrvData drv_data,
+ ErlDrvThreadData thread_data);
+
+static ErlDrvEntry async_blast_drv_entry = {
+ NULL /* init */,
+ start,
+ stop,
+ output,
+ NULL /* ready_input */,
+ NULL /* ready_output */,
+ "async_blast_drv",
+ NULL /* finish */,
+ NULL /* handle */,
+ NULL /* control */,
+ NULL /* timeout */,
+ NULL /* outputv */,
+ ready_async,
+ NULL /* flush */,
+ NULL /* call */,
+ NULL /* event */,
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ ERL_DRV_FLAG_USE_PORT_LOCKING,
+ NULL /* handle2 */,
+ NULL /* handle_monitor */
+};
+
+typedef struct {
+ ErlDrvPort port;
+ ErlDrvTermData caller;
+ int counter;
+} async_blast_data_t;
+
+
+DRIVER_INIT(async_blast_drv)
+{
+ return &async_blast_drv_entry;
+}
+
+static void stop(ErlDrvData drv_data)
+{
+ driver_free((void *) drv_data);
+}
+
+static ErlDrvData start(ErlDrvPort port,
+ char *command)
+{
+ async_blast_data_t *abd;
+
+ abd = driver_alloc(sizeof(async_blast_data_t));
+ if (!abd)
+ return ERL_DRV_ERROR_GENERAL;
+
+ abd->port = port;
+ abd->counter = 0;
+ return (ErlDrvData) abd;
+}
+
+static void async_invoke(void *data)
+{
+
+}
+#include <stdio.h>
+
+static void ready_async(ErlDrvData drv_data,
+ ErlDrvThreadData thread_data)
+{
+ async_blast_data_t *abd = (async_blast_data_t *) drv_data;
+ if (--abd->counter == 0) {
+ ErlDrvTermData spec[] = {
+ ERL_DRV_PORT, driver_mk_port(abd->port),
+ ERL_DRV_ATOM, driver_mk_atom("done"),
+ ERL_DRV_TUPLE, 2
+ };
+ driver_send_term(abd->port, abd->caller,
+ spec, sizeof(spec)/sizeof(spec[0]));
+ }
+}
+
+static void output(ErlDrvData drv_data,
+ char *buf, int len)
+{
+ async_blast_data_t *abd = (async_blast_data_t *) drv_data;
+ if (abd->counter == 0) {
+ int i;
+ abd->caller = driver_caller(abd->port);
+ abd->counter = NO_ASYNC_JOBS;
+ for (i = 0; i < NO_ASYNC_JOBS; i++) {
+ if (0 > driver_async(abd->port, NULL, async_invoke, NULL, NULL)) {
+ driver_failure_atom(abd->port, "driver_async_failed");
+ break;
+ }
+ }
+ }
+}
diff --git a/erts/emulator/test/driver_SUITE_data/thr_free_drv.c b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c
new file mode 100644
index 0000000000..622a62ebea
--- /dev/null
+++ b/erts/emulator/test/driver_SUITE_data/thr_free_drv.c
@@ -0,0 +1,241 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2011. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+#include <stdlib.h>
+#include <errno.h>
+#include <string.h>
+#include "erl_driver.h"
+
+#define BLOCKS_PER_THREAD 100000
+#define NO_THREADS 10
+#define BLOCKS_PER_CTRL 1000
+
+typedef struct {
+ ErlDrvMutex *mtx;
+ ErlDrvCond *cnd;
+ int b;
+ int *go;
+ int *skip;
+ void *blocks[BLOCKS_PER_THREAD];
+} test_thread_data;
+
+typedef struct {
+ ErlDrvPort port;
+ int b;
+ int go;
+ int skip;
+ test_thread_data ttd[NO_THREADS+1];
+ ErlDrvTid tids[NO_THREADS+1];
+} test_data;
+
+static ErlDrvData start(ErlDrvPort port, char *command);
+static void stop(ErlDrvData data);
+static int control(ErlDrvData drv_data, unsigned int command, char *buf,
+ int len, char **rbuf, int rlen);
+
+static ErlDrvEntry thr_free_drv_entry = {
+ NULL /* init */,
+ start,
+ stop,
+ NULL /* output */,
+ NULL /* ready_input */,
+ NULL /* ready_output */,
+ "thr_free_drv",
+ NULL /* finish */,
+ NULL /* handle */,
+ control,
+ NULL /* timeout */,
+ NULL /* outputv */,
+ NULL /* ready_async */,
+ NULL /* flush */,
+ NULL /* call */,
+ NULL /* event */,
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ ERL_DRV_FLAG_USE_PORT_LOCKING,
+ NULL /* handle2 */,
+ NULL /* handle_monitor */
+};
+
+DRIVER_INIT(thr_free_drv)
+{
+ return &thr_free_drv_entry;
+}
+
+void *
+test_thread(void *vttd)
+{
+ test_thread_data *ttd = (test_thread_data *) vttd;
+ int i, skip;
+
+ erl_drv_mutex_lock(ttd->mtx);
+
+ while (!*ttd->go)
+ erl_drv_cond_wait(ttd->cnd, ttd->mtx);
+ skip = *ttd->skip;
+ erl_drv_mutex_unlock(ttd->mtx);
+
+ if (!skip) {
+ for (i = 0; i < BLOCKS_PER_THREAD; i++)
+ driver_free(ttd->blocks[i]);
+ }
+ return NULL;
+}
+
+ErlDrvData start(ErlDrvPort port, char *command)
+{
+ int join = 0, t, b, res;
+ test_thread_data *ttd;
+ test_data *td = driver_alloc(sizeof(test_data));
+ if (!td)
+ return ERL_DRV_ERROR_GENERAL;
+ ttd = td->ttd;
+ for (b = 0; b < BLOCKS_PER_THREAD; b++)
+ for (t = 0; t <= NO_THREADS; t++)
+ ttd[t].blocks[b] = NULL;
+ ttd[0].mtx = NULL;
+ ttd[0].cnd = NULL;
+
+ for (b = 0; b < BLOCKS_PER_THREAD; b++) {
+ for (t = 0; t <= NO_THREADS; t++) {
+ ttd[t].blocks[b] = driver_alloc(1);
+ if (ttd[t].blocks[b] == NULL)
+ goto fail;
+ }
+ }
+
+ td->b = -1;
+ td->go = 0;
+ td->skip = 0;
+
+ ttd[0].mtx = erl_drv_mutex_create("test_mutex");
+ if (!ttd[0].mtx)
+ goto fail;
+ ttd[0].cnd = erl_drv_cond_create("test_cnd");
+ if (!ttd[0].cnd)
+ goto fail;
+ ttd[0].go = &td->go;
+ ttd[0].skip = &td->skip;
+
+ for (t = 1; t <= NO_THREADS; t++) {
+ ttd[t].mtx = ttd[0].mtx;
+ ttd[t].cnd = ttd[0].cnd;
+ ttd[t].go = ttd[0].go;
+ ttd[t].skip = ttd[0].skip;
+ res = erl_drv_thread_create("test_thread",
+ &td->tids[t],
+ test_thread,
+ &ttd[t],
+ NULL);
+ if (res != 0)
+ goto fail;
+ join = t;
+ }
+
+ td->port = port;
+
+ return (ErlDrvData) td;
+
+fail:
+
+ if (join) {
+ erl_drv_mutex_lock(ttd[0].mtx);
+ td->go = 1;
+ td->skip = 1;
+ erl_drv_cond_broadcast(ttd[0].cnd);
+ erl_drv_mutex_unlock(ttd[0].mtx);
+ for (t = 1; t <= join; t++)
+ erl_drv_thread_join(td->tids[t], NULL);
+ }
+
+ if (ttd[0].mtx)
+ erl_drv_mutex_destroy(ttd[0].mtx);
+ if (ttd[0].cnd)
+ erl_drv_cond_destroy(ttd[0].cnd);
+
+ for (b = 0; b < BLOCKS_PER_THREAD; b++) {
+ for (t = 0; t <= NO_THREADS; t++) {
+ if (ttd[t].blocks[b] != NULL)
+ driver_free(ttd[t].blocks[b]);
+ }
+ }
+
+ return ERL_DRV_ERROR_GENERAL;
+}
+
+static void stop(ErlDrvData drv_data)
+{
+ test_data *td = (test_data *) drv_data;
+ int t, b;
+ for (t = 1; t <= NO_THREADS; t++)
+ erl_drv_thread_join(td->tids[t], NULL);
+ for (b = 0; b < BLOCKS_PER_THREAD; b++) {
+ if (td->ttd[0].blocks[b])
+ driver_free(td->ttd[0].blocks[b]);
+ }
+ erl_drv_mutex_destroy(td->ttd[0].mtx);
+ erl_drv_cond_destroy(td->ttd[0].cnd);
+ driver_free(td);
+}
+
+static int control(ErlDrvData drv_data, unsigned int command, char *buf,
+ int len, char **rbuf, int rlen)
+{
+ test_data *td = (test_data *) drv_data;
+ char *result = "failure";
+ int i, b;
+ int res;
+ int result_len;
+
+ if (td->b == -1) {
+ erl_drv_mutex_lock(td->ttd[0].mtx);
+ td->go = 1;
+ erl_drv_cond_broadcast(td->ttd[0].cnd);
+ erl_drv_mutex_unlock(td->ttd[0].mtx);
+ td->b = 0;
+ }
+
+ for (i = 0, b = td->b; i < BLOCKS_PER_CTRL && b < BLOCKS_PER_THREAD; i++, b++) {
+ driver_free(td->ttd[0].blocks[b]);
+ td->ttd[0].blocks[b] = NULL;
+ }
+
+ td->b = b;
+ if (b >= BLOCKS_PER_THREAD)
+ result = "done";
+ else
+ result = "more";
+
+ result_len = strlen(result);
+ if (result_len <= rlen) {
+ memcpy(*rbuf, result, result_len);
+ return result_len;
+ }
+ else {
+ *rbuf = driver_alloc(result_len);
+ if (!*rbuf) {
+ driver_failure_posix(td->port, ENOMEM);
+ return 0;
+ }
+ else {
+ memcpy(*rbuf, result, result_len);
+ return result_len;
+ }
+ }
+}
diff --git a/erts/emulator/test/mtx_SUITE.erl b/erts/emulator/test/mtx_SUITE.erl
index e0a7878bd8..879d2f61dd 100644
--- a/erts/emulator/test/mtx_SUITE.erl
+++ b/erts/emulator/test/mtx_SUITE.erl
@@ -62,16 +62,29 @@ init_per_suite(Config) when is_list(Config) ->
Config.
end_per_suite(Config) when is_list(Config) ->
+ catch erts_debug:set_internal_state(available_internal_state, false),
Config.
init_per_testcase(_Case, Config) ->
Dog = ?t:timetrap(?t:minutes(15)),
+ %% Wait for deallocations to complete since we measure
+ %% runtime in test cases.
+ wait_deallocations(),
[{watchdog, Dog}|Config].
end_per_testcase(_Func, Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog).
+wait_deallocations() ->
+ try
+ erts_debug:set_internal_state(wait, deallocations)
+ catch
+ error:undef ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ wait_deallocations()
+ end.
+
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl
index 9b782b35a2..0350eb671d 100644
--- a/erts/emulator/test/system_info_SUITE.erl
+++ b/erts/emulator/test/system_info_SUITE.erl
@@ -37,7 +37,7 @@
init_per_group/2,end_per_group/2,
init_per_testcase/2, end_per_testcase/2]).
--export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1]).
+-export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1, memory/1]).
-define(DEFAULT_TIMEOUT, ?t:minutes(2)).
@@ -45,7 +45,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[process_count, system_version, misc_smoke_tests,
- heap_size, wordsize].
+ heap_size, wordsize, memory].
groups() ->
[].
@@ -187,3 +187,312 @@ wordsize(Config) when is_list(Config) ->
Other ->
exit({unexpected_wordsizes,Other})
end.
+
+memory(doc) -> ["Verify that erlang:memory/0 and memory results in crashdump produce are similar"];
+memory(Config) when is_list(Config) ->
+ %%
+ %% Verify that erlang:memory/0 and memory results in
+ %% crashdump produce are similar.
+ %%
+ %% erlang:memory/0 requests information from each scheduler
+ %% thread and puts the information together in erlang code
+ %% (erlang.erl).
+ %%
+ %% When a crash dump is written we cannot use the
+ %% erlang:memory/0 implementation. The crashdump implementation
+ %% is a pure C implementation inspecting all allocator instances
+ %% after the system has been blocked (erts_memory() in erl_alloc.c).
+ %%
+ %% Since we got two implementations, modifications can easily
+ %% cause them to produce different results.
+ %%
+ %% erts_debug:get_internal_state(memory) blocks the system and
+ %% execute the same code as the crash dump writing uses.
+ %%
+
+ erts_debug:set_internal_state(available_internal_state, true),
+ %% Use a large heap size on the controling process in
+ %% order to avoid changes in its heap size during
+ %% comparisons.
+ MinHeapSize = process_flag(min_heap_size, 1024*1024),
+ Prio = process_flag(priority, max),
+ try
+ erlang:memory(), %% first call will init stat atoms
+ garbage_collect(), %% blow up heap
+ memory_test(Config)
+ catch
+ error:notsup -> {skipped, "erlang:memory() not supported"}
+ after
+ process_flag(min_heap_size, MinHeapSize),
+ process_flag(priority, Prio),
+ catch erts_debug:set_internal_state(available_internal_state, false)
+ end.
+
+memory_test(_Config) ->
+
+ MWs = spawn_mem_workers(),
+
+ DPs = mem_workers_call(MWs,
+ fun () ->
+ mapn(fun (_) ->
+ spawn(fun () ->
+ receive
+ after infinity ->
+ ok
+ end
+ end)
+ end,
+ 1000 div erlang:system_info(schedulers_online))
+ end,
+ []),
+ cmp_memory(MWs, "spawn procs"),
+
+ Ps = lists:flatten(DPs),
+
+ mem_workers_call(MWs,
+ fun () ->
+ lists:foreach(fun (P) -> link(P) end, Ps)
+ end,
+ []),
+ cmp_memory(MWs, "link procs"),
+ mem_workers_call(MWs,
+ fun () ->
+ lists:foreach(fun (P) -> unlink(P) end, Ps)
+ end,
+ []),
+ cmp_memory(MWs, "unlink procs"),
+
+ DMs = mem_workers_call(MWs,
+ fun () ->
+ lists:map(fun (P) ->
+ monitor(process, P)
+ end, Ps)
+ end,
+ []),
+ cmp_memory(MWs, "monitor procs"),
+ Ms = lists:flatten(DMs),
+ mem_workers_call(MWs,
+ fun () ->
+ lists:foreach(fun (M) ->
+ demonitor(M)
+ end, Ms)
+ end,
+ []),
+ cmp_memory(MWs, "demonitor procs"),
+
+ mem_workers_call(MWs,
+ fun () ->
+ lists:foreach(fun (P) ->
+ P ! {a, "message", make_ref()}
+ end, Ps)
+ end,
+ []),
+ cmp_memory(MWs, "message procs"),
+
+ mem_workers_call(MWs,
+ fun () ->
+ Mons = lists:map(fun (P) ->
+ exit(P, kill),
+ monitor(process, P)
+ end,
+ Ps),
+ lists:foreach(fun (Mon) ->
+ receive
+ {'DOWN', Mon, _, _, _} -> ok
+ end
+ end,
+ Mons)
+ end, []),
+ cmp_memory(MWs, "kill procs"),
+
+ mem_workers_call(MWs,
+ fun () ->
+ put(binary_data,
+ mapn(fun (_) -> list_to_binary(lists:duplicate(256,$?)) end, 100))
+ end,
+ []),
+
+ cmp_memory(MWs, "store binary data"),
+
+ mem_workers_call(MWs,
+ fun () ->
+ put(binary_data, false),
+ garbage_collect()
+ end,
+ []),
+ cmp_memory(MWs, "release binary data"),
+
+ mem_workers_call(MWs,
+ fun () ->
+ list_to_atom("an ugly atom "++integer_to_list(erlang:system_info(scheduler_id))),
+ list_to_atom("another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))),
+ list_to_atom("yet another ugly atom "++integer_to_list(erlang:system_info(scheduler_id)))
+ end,
+ []),
+ cmp_memory(MWs, "new atoms"),
+
+
+ mem_workers_call(MWs,
+ fun () ->
+ T = ets:new(?MODULE, []),
+ ets:insert(T, {gurka, lists:seq(1,10000)}),
+ ets:insert(T, {banan, lists:seq(1,1024)}),
+ ets:insert(T, {appelsin, make_ref()}),
+ put(ets_id, T)
+ end,
+ []),
+ cmp_memory(MWs, "store ets data"),
+
+ mem_workers_call(MWs,
+ fun () ->
+ ets:delete(get(ets_id)),
+ put(ets_id, false)
+ end,
+ []),
+ cmp_memory(MWs, "remove ets data"),
+
+ lists:foreach(fun (MW) ->
+ unlink(MW),
+ Mon = monitor(process, MW),
+ exit(MW, kill),
+ receive
+ {'DOWN', Mon, _, _, _} -> ok
+ end
+ end,
+ MWs),
+ ok.
+
+mem_worker() ->
+ receive
+ {call, From, Fun, Args} ->
+ From ! {reply, self(), apply(Fun, Args)},
+ mem_worker();
+ {cast, _From, Fun, Args} ->
+ apply(Fun, Args),
+ mem_worker()
+ end.
+
+mem_workers_call(MWs, Fun, Args) ->
+ lists:foreach(fun (MW) ->
+ MW ! {call, self(), Fun, Args}
+ end,
+ MWs),
+ lists:map(fun (MW) ->
+ receive
+ {reply, MW, Res} ->
+ Res
+ end
+ end,
+ MWs).
+
+mem_workers_cast(MWs, Fun, Args) ->
+ lists:foreach(fun (MW) ->
+ MW ! {cast, self(), Fun, Args}
+ end,
+ MWs).
+
+spawn_mem_workers() ->
+ spawn_mem_workers(erlang:system_info(schedulers_online)).
+
+spawn_mem_workers(0) ->
+ [];
+spawn_mem_workers(N) ->
+ [spawn_opt(fun () -> mem_worker() end,
+ [{scheduler, N rem erlang:system_info(schedulers_online) + 1},
+ link]) | spawn_mem_workers(N-1)].
+
+
+
+mem_get(X, Mem) ->
+ case lists:keyfind(X, 1, Mem) of
+ {X, Val} -> Val;
+ false -> false
+ end.
+
+cmp_memory(What, Mem1, Mem2, 1) ->
+ R1 = mem_get(What, Mem1),
+ R2 = mem_get(What, Mem2),
+ true = R1 == R2;
+cmp_memory(What, Mem1, Mem2, RelDiff) ->
+ %% We allow RealDiff diff
+ R1 = mem_get(What, Mem1),
+ R2 = mem_get(What, Mem2),
+ case R1 == R2 of
+ true ->
+ ok;
+ false ->
+ case R1 > R2 of
+ true ->
+ true = R2*RelDiff > R1;
+ false ->
+ true = R1*RelDiff > R2
+ end
+ end.
+
+pos_int(Val) when Val >= 0 ->
+ Val;
+pos_int(Val) ->
+ exit({not_pos_int, Val}).
+
+check_sane_memory(Mem) ->
+ Tot = pos_int(mem_get(total, Mem)),
+ Proc = pos_int(mem_get(processes, Mem)),
+ ProcUsed = pos_int(mem_get(processes_used, Mem)),
+ Sys = pos_int(mem_get(system, Mem)),
+ Atom = pos_int(mem_get(atom, Mem)),
+ AtomUsed = pos_int(mem_get(atom_used, Mem)),
+ Bin = pos_int(mem_get(binary, Mem)),
+ Code = pos_int(mem_get(code, Mem)),
+ Ets = pos_int(mem_get(ets, Mem)),
+
+ Tot = Proc + Sys,
+ true = Sys > Atom + Bin + Code + Ets,
+ true = Proc >= ProcUsed,
+ true = Atom >= AtomUsed,
+
+ case mem_get(maximum, Mem) of
+ false -> ok;
+ Max -> true = pos_int(Max) >= Tot
+ end,
+ ok.
+
+cmp_memory(MWs, Str) ->
+ erlang:display(Str),
+ lists:foreach(fun (MW) -> garbage_collect(MW) end, MWs),
+ garbage_collect(),
+ erts_debug:set_internal_state(wait, deallocations),
+
+ EDM = erts_debug:get_internal_state(memory),
+ EM = erlang:memory(),
+
+ io:format("~s:~n"
+ "erlang:memory() = ~p~n"
+ "crash dump memory = ~p~n",
+ [Str, EM, EDM]),
+
+ ?line check_sane_memory(EM),
+ ?line check_sane_memory(EDM),
+
+ %% We expect these to always give us exactly the same result
+
+ ?line cmp_memory(atom, EM, EDM, 1),
+ ?line cmp_memory(atom_used, EM, EDM, 1),
+ ?line cmp_memory(binary, EM, EDM, 1),
+ ?line cmp_memory(code, EM, EDM, 1),
+ ?line cmp_memory(ets, EM, EDM, 1),
+
+ %% Total, processes, processes_used, and system will seldom
+ %% give us exactly the same result since the two readings
+ %% aren't taken atomically.
+
+ ?line cmp_memory(total, EM, EDM, 1.05),
+ ?line cmp_memory(processes, EM, EDM, 1.05),
+ ?line cmp_memory(processes_used, EM, EDM, 1.05),
+ ?line cmp_memory(system, EM, EDM, 1.05),
+
+ ok.
+
+mapn(_Fun, 0) ->
+ [];
+mapn(Fun, N) ->
+ [Fun(N) | mapn(Fun, N-1)].
diff --git a/erts/etc/common/erlc.c b/erts/etc/common/erlc.c
index 35c360a99d..23f009ff4d 100644
--- a/erts/etc/common/erlc.c
+++ b/erts/etc/common/erlc.c
@@ -185,6 +185,7 @@ main(int argc, char** argv)
* Push initial arguments.
*/
+ PUSH("+sbtu");
PUSH("-noinput");
PUSH2("-mode", "minimal");
PUSH2("-boot", "start_clean");
diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c
index 2bd576d8e8..8d119984df 100644
--- a/erts/etc/common/erlexec.c
+++ b/erts/etc/common/erlexec.c
@@ -67,6 +67,7 @@ static const char plusM_au_allocs[]= {
'C', /* sbmbc_alloc */
'D', /* std_alloc */
'E', /* ets_alloc */
+ 'F', /* fix_alloc */
'H', /* eheap_alloc */
'L', /* ll_alloc */
'R', /* driver_alloc */
@@ -110,8 +111,6 @@ static char *plusM_other_switches[] = {
"Mamcbf",
"Mrmcbf",
"Mmcs",
- "Mcci",
- "Fe",
"Ye",
"Ym",
"Ytp",
diff --git a/erts/include/internal/ethr_mutex.h b/erts/include/internal/ethr_mutex.h
index a0685ea3c0..86a1e9fbdf 100644
--- a/erts/include/internal/ethr_mutex.h
+++ b/erts/include/internal/ethr_mutex.h
@@ -22,6 +22,23 @@
* Author: Rickard Green
*/
+/*
+ * IMPORTANT note about ethr_cond_signal() and ethr_cond_broadcast()
+ *
+ * POSIX allow a call to `pthread_cond_signal' or `pthread_cond_broadcast'
+ * even though the associated mutex/mutexes isn't/aren't locked by the
+ * caller. We do not allow that by default in order to avoid a performance
+ * penalty on some platforms.
+ *
+ * Mutexes and condition variables can, however, be initialized as POSIX
+ * compliant. When initialized as such ethr_cond_signal(), and
+ * ethr_cond_broadcast() are allowed to be called even though the associated
+ * mutexes aren't locked. This will, however, incur a performance penalty on
+ * some platforms.
+ *
+ * POSIX compliant mutexes and condition variables *need* to be used together.
+ */
+
#ifndef ETHR_MUTEX_H__
#define ETHR_MUTEX_H__
@@ -40,6 +57,14 @@
#endif
#endif
+/* #define ETHR_DBG_WIN_MTX_WITH_PTHREADS */
+#ifdef ETHR_DBG_WIN_MTX_WITH_PTHREADS
+typedef pthread_mutex_t CRITICAL_SECTION;
+int TryEnterCriticalSection(CRITICAL_SECTION *);
+void EnterCriticalSection(CRITICAL_SECTION *);
+void LeaveCriticalSection(CRITICAL_SECTION *);
+#endif
+
#ifdef ETHR_MTX_HARD_DEBUG
# ifdef __GNUC__
# warning ETHR_MTX_HARD_DEBUG
@@ -140,13 +165,19 @@ struct ethr_mutex_base_ {
typedef struct {
int main_spincount;
int aux_spincount;
+ int posix_compliant;
} ethr_mutex_opt;
+#define ETHR_MUTEX_OPT_DEFAULT_INITER {-1, -1, 0}
+
typedef struct {
int main_spincount;
int aux_spincount;
+ int posix_compliant;
} ethr_cond_opt;
+#define ETHR_COND_OPT_DEFAULT_INITER {-1, -1, 0}
+
#ifdef ETHR_USE_OWN_MTX_IMPL__
typedef struct ethr_mutex_ ethr_mutex;
@@ -179,7 +210,7 @@ struct ethr_cond_ {
#endif
};
-#else /* pthread */
+#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
typedef struct ethr_mutex_ ethr_mutex;
struct ethr_mutex_ {
@@ -197,7 +228,36 @@ struct ethr_cond_ {
#endif
};
-#endif /* pthread */
+#elif defined(ETHR_WIN32_THREADS) || defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
+# define ETHR_WIN_MUTEX__
+
+typedef struct ethr_mutex_ ethr_mutex;
+struct ethr_mutex_ {
+ int posix_compliant;
+ CRITICAL_SECTION cs;
+ ethr_ts_event *wakeups;
+ ethr_atomic32_t have_wakeups; /* only when posix compliant */
+ ethr_atomic32_t locked; /* only when posix compliant */
+ ethr_spinlock_t lock; /* only when posix compliant */
+#if ETHR_XCHK
+ int initialized;
+#endif
+};
+
+typedef struct ethr_cond_ ethr_cond;
+struct ethr_cond_ {
+ int posix_compliant;
+ CRITICAL_SECTION cs;
+ ethr_ts_event *waiters;
+ int spincount;
+#if ETHR_XCHK
+ int initialized;
+#endif
+};
+
+#else
+# error "no mutex implementation"
+#endif
int ethr_mutex_init_opt(ethr_mutex *, ethr_mutex_opt *);
int ethr_mutex_init(ethr_mutex *);
@@ -573,7 +633,7 @@ ETHR_INLINE_MTX_FUNC_NAME_(ethr_mutex_unlock)(ethr_mutex *mtx)
#endif /* ETHR_TRY_INLINE_FUNCS */
-#else /* pthread_mutex */
+#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_MUTEX_IMPL__)
@@ -605,7 +665,54 @@ ETHR_INLINE_MTX_FUNC_NAME_(ethr_mutex_unlock)(ethr_mutex *mtx)
#endif /* ETHR_TRY_INLINE_FUNCS */
-#endif /* pthread_mutex */
+#elif defined(ETHR_WIN32_THREADS) || defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
+
+#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_MUTEX_IMPL__)
+
+static ETHR_INLINE int
+ETHR_INLINE_MTX_FUNC_NAME_(ethr_mutex_trylock)(ethr_mutex *mtx)
+{
+ if (!TryEnterCriticalSection(&mtx->cs))
+ return EBUSY;
+ if (mtx->posix_compliant)
+ ethr_atomic32_set(&mtx->locked, 1);
+ return 0;
+}
+
+static ETHR_INLINE void
+ETHR_INLINE_MTX_FUNC_NAME_(ethr_mutex_lock)(ethr_mutex *mtx)
+{
+ EnterCriticalSection(&mtx->cs);
+ if (mtx->posix_compliant)
+ ethr_atomic32_set(&mtx->locked, 1);
+}
+
+void ethr_mutex_cond_wakeup__(ethr_mutex *mtx);
+
+static ETHR_INLINE void
+ETHR_INLINE_MTX_FUNC_NAME_(ethr_mutex_unlock)(ethr_mutex *mtx)
+{
+ if (mtx->posix_compliant) {
+ ethr_atomic32_set_mb(&mtx->locked, 0);
+ if (ethr_atomic32_read_acqb(&mtx->have_wakeups))
+ goto cond_wakeup;
+ else
+ goto leave_cs;
+ }
+
+ if (mtx->wakeups) {
+ cond_wakeup:
+ ethr_mutex_cond_wakeup__(mtx);
+ }
+ else {
+ leave_cs:
+ LeaveCriticalSection(&mtx->cs);
+ }
+}
+
+#endif /* ETHR_TRY_INLINE_FUNCS */
+
+#endif
#ifdef ETHR_USE_OWN_RWMTX_IMPL__
diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h
index 8ad0ded144..142c26c0ca 100644
--- a/erts/include/internal/ethread.h
+++ b/erts/include/internal/ethread.h
@@ -191,7 +191,6 @@ typedef DWORD ethr_tsd_key;
#undef ETHR_HAVE_ETHR_SIG_FUNCS
#define ETHR_USE_OWN_RWMTX_IMPL__
-#define ETHR_USE_OWN_MTX_IMPL__
#define ETHR_YIELD() (Sleep(0), 0)
diff --git a/erts/lib_src/common/ethr_mutex.c b/erts/lib_src/common/ethr_mutex.c
index 81fd6af80a..e363279f2e 100644
--- a/erts/lib_src/common/ethr_mutex.c
+++ b/erts/lib_src/common/ethr_mutex.c
@@ -223,9 +223,59 @@ rwmutex_try_complete_runlock(ethr_rwmutex *rwmtx,
int try_write_lock);
#endif
+/* -- Utilities used by multiple implementations -- */
+
+#if defined(ETHR_USE_OWN_RWMTX_IMPL__) || defined(ETHR_USE_OWN_MTX_IMPL__) \
+ || defined(ETHR_WIN32_THREADS)
+
+static ETHR_INLINE void
+enqueue(ethr_ts_event **queue,
+ ethr_ts_event *tse_start,
+ ethr_ts_event *tse_end)
+{
+ if (!*queue) {
+ *queue = tse_start;
+ tse_start->prev = tse_end;
+ tse_end->next = tse_start;
+ }
+ else {
+ tse_end->next = *queue;
+ tse_start->prev = (*queue)->prev;
+ (*queue)->prev->next = tse_start;
+ (*queue)->prev = tse_end;
+ }
+}
+
+
+static ETHR_INLINE void
+dequeue(ethr_ts_event **queue,
+ ethr_ts_event *tse_start,
+ ethr_ts_event *tse_end)
+{
+ if (tse_start->prev == tse_end) {
+ ETHR_ASSERT(*queue == tse_start && tse_end->next == tse_start);
+ *queue = NULL;
+ }
+ else {
+ if (*queue == tse_start)
+ *queue = tse_end->next;
+ tse_end->next->prev = tse_start->prev;
+ tse_start->prev->next = tse_end->next;
+ }
+}
+
+#endif
+
#if defined(ETHR_USE_OWN_RWMTX_IMPL__) || defined(ETHR_USE_OWN_MTX_IMPL__)
-/* -- Utilities operating both on ordinary mutexes and read write mutexes -- */
+static ETHR_INLINE void
+insert(ethr_ts_event *tse_pred, ethr_ts_event *tse)
+{
+ tse->next = tse_pred->next;
+ tse->prev = tse_pred;
+ tse_pred->next->prev = tse;
+ tse_pred->next = tse;
+}
static ETHR_INLINE void
rwmutex_freqread_wtng_rdrs_inc(ethr_rwmutex *rwmtx, ethr_ts_event *tse)
@@ -355,51 +405,6 @@ rwmutex_freqread_rdrs_read(ethr_rwmutex *rwmtx, int ix)
return res;
}
-
-static ETHR_INLINE void
-enqueue(ethr_ts_event **queue,
- ethr_ts_event *tse_start,
- ethr_ts_event *tse_end)
-{
- if (!*queue) {
- *queue = tse_start;
- tse_start->prev = tse_end;
- tse_end->next = tse_start;
- }
- else {
- tse_end->next = *queue;
- tse_start->prev = (*queue)->prev;
- (*queue)->prev->next = tse_start;
- (*queue)->prev = tse_end;
- }
-}
-
-static ETHR_INLINE void
-insert(ethr_ts_event *tse_pred, ethr_ts_event *tse)
-{
- tse->next = tse_pred->next;
- tse->prev = tse_pred;
- tse_pred->next->prev = tse;
- tse_pred->next = tse;
-}
-
-static ETHR_INLINE void
-dequeue(ethr_ts_event **queue,
- ethr_ts_event *tse_start,
- ethr_ts_event *tse_end)
-{
- if (tse_start->prev == tse_end) {
- ETHR_ASSERT(*queue == tse_start && tse_end->next == tse_start);
- *queue = NULL;
- }
- else {
- if (*queue == tse_start)
- *queue = tse_end->next;
- tse_end->next->prev = tse_start->prev;
- tse_start->prev->next = tse_end->next;
- }
-}
-
static void
event_wait(struct ethr_mutex_base_ *mtxb,
ethr_ts_event *tse,
@@ -1244,7 +1249,7 @@ ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx)
return 0;
}
-#else
+#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
/* -- pthread mutex and condition variables -------------------------------- */
int
@@ -1261,6 +1266,12 @@ ethr_mutex_init(ethr_mutex *mtx)
}
int
+ethr_mutex_init_opt(ethr_mutex *mtx, ethr_mutex_opt *opt)
+{
+ return ethr_mutex_init(mtx);
+}
+
+int
ethr_mutex_destroy(ethr_mutex *mtx)
{
#if ETHR_XCHK
@@ -1293,6 +1304,12 @@ ethr_cond_init(ethr_cond *cnd)
}
int
+ethr_cond_init_opt(ethr_cond *cnd, ethr_cond_opt *opt)
+{
+ return ethr_cond_init(cnd);
+}
+
+int
ethr_cond_destroy(ethr_cond *cnd)
{
#if ETHR_XCHK
@@ -1354,7 +1371,388 @@ ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx)
return res;
}
-#endif /* pthread_mutex */
+#elif defined(ETHR_WIN32_THREADS) || defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
+
+/*
+ * As of Vista/Server, 2008 Windows has condition variables that can be
+ * used with critical sections. However, we need to be able to run on
+ * older Windows versions too, so we need to implement condition variables
+ * ourselves.
+ */
+
+#ifdef ETHR_DBG_WIN_MTX_WITH_PTHREADS
+/*
+ * For debugging of this implementation on POSIX platforms...
+ */
+
+#define ethr_win_get_errno__() EINVAL
+#if defined(__GNUC__)
+#define __forceinline __inline__
+#else
+#define __forceinline
+#endif
+
+static int
+InitializeCriticalSectionAndSpinCount(CRITICAL_SECTION *cs, int sc)
+{
+ return 0 == pthread_mutex_init((pthread_mutex_t *) cs, NULL);
+}
+
+static void DeleteCriticalSection(CRITICAL_SECTION *cs)
+{
+ int res = pthread_mutex_destroy((pthread_mutex_t *) cs);
+ if (res != 0)
+ ETHR_FATAL_ERROR__(res);
+}
+
+int TryEnterCriticalSection(CRITICAL_SECTION *cs)
+{
+ int res;
+ res = pthread_mutex_trylock((pthread_mutex_t *) cs);
+ if (res != 0 && res != EBUSY)
+ ETHR_FATAL_ERROR__(res);
+ return res == 0;
+}
+
+void EnterCriticalSection(CRITICAL_SECTION *cs)
+{
+ int res = pthread_mutex_lock((pthread_mutex_t *) cs);
+ if (res != 0)
+ ETHR_FATAL_ERROR__(res);
+}
+
+void LeaveCriticalSection(CRITICAL_SECTION *cs)
+{
+ int res = pthread_mutex_unlock((pthread_mutex_t *) cs);
+ if (res != 0)
+ ETHR_FATAL_ERROR__(res);
+}
+
+#endif
+
+#define ETHR_CND_WAIT__ ((ethr_sint32_t) 0x11dead11)
+#define ETHR_CND_WAKEUP__ ((ethr_sint32_t) 0x11beef11)
+
+static __forceinline void
+cond_wakeup(ethr_ts_event *tse)
+{
+ ETHR_ASSERT(ethr_atomic32_read(&tse->uaflgs) == ETHR_CND_WAIT__);
+
+ ethr_atomic32_set_relb(&tse->uaflgs, ETHR_CND_WAKEUP__);
+ ethr_event_set(&tse->event);
+}
+
+void
+ethr_mutex_cond_wakeup__(ethr_mutex *mtx)
+{
+ /*
+ * Called by ethr_mutex_unlock() when we have
+ * cond signal/broadcast wakeups waiting to
+ * be completed.
+ */
+ ethr_ts_event *tse;
+
+ if (!mtx->posix_compliant) {
+ tse = mtx->wakeups;
+ dequeue(&mtx->wakeups, tse, tse);
+ }
+ else {
+ ethr_spin_lock(&mtx->lock);
+ tse = mtx->wakeups;
+ if (tse)
+ dequeue(&mtx->wakeups, tse, tse);
+ if (!mtx->wakeups)
+ ethr_atomic32_set_relb(&mtx->have_wakeups, 0);
+ ethr_spin_unlock(&mtx->lock);
+ }
+
+ LeaveCriticalSection(&mtx->cs);
+
+ ETHR_ASSERT(tse || mtx->posix_compliant);
+
+ /*
+ * We delay actual condition variable wakeup until
+ * this point when we have left the critical section.
+ * This in order to avoid that the other thread is
+ * woken and then right away have to go to sleep
+ * waiting for the critical section that we are in.
+ *
+ * We also only wake one thread at a time even if
+ * there are multiple threads waiting to be woken.
+ * Otherwise all but one will be woken and then right
+ * away have to go to sleep on the critical section.
+ * Since each wakeup is guaranteed to generate at
+ * least one lock/unlock sequence on this mutex, all
+ * threads will eventually be woken.
+ */
+
+ if (tse)
+ cond_wakeup(tse);
+}
+
+int
+ethr_mutex_init_opt(ethr_mutex *mtx, ethr_mutex_opt *opt)
+{
+ int spincount;
+#if ETHR_XCHK
+ if (!mtx) {
+ ETHR_ASSERT(0);
+ return EINVAL;
+ }
+ mtx->initialized = ETHR_MUTEX_INITIALIZED;
+#endif
+
+ spincount = opt ? opt->aux_spincount : 0;
+ if (spincount < 0)
+ spincount = 0;
+
+ if (!InitializeCriticalSectionAndSpinCount(&mtx->cs, spincount)) {
+#if ETHR_XCHK
+ mtx->initialized = 0;
+#endif
+ return ethr_win_get_errno__();
+ }
+
+ mtx->posix_compliant = opt ? opt->posix_compliant : 0;
+ mtx->wakeups = NULL;
+ if (mtx->posix_compliant) {
+ ethr_atomic32_init(&mtx->locked, 0);
+ ethr_atomic32_init(&mtx->have_wakeups, 0);
+ ethr_spinlock_init(&mtx->lock);
+ }
+ return 0;
+}
+
+int
+ethr_mutex_init(ethr_mutex *mtx)
+{
+ return ethr_mutex_init_opt(mtx, NULL);
+}
+
+int
+ethr_mutex_destroy(ethr_mutex *mtx)
+{
+ DeleteCriticalSection(&mtx->cs);
+ if (mtx->posix_compliant)
+ return ethr_spinlock_destroy(&mtx->lock);
+ else
+ return 0;
+}
+
+int
+ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx)
+{
+ void *udata;
+ ethr_ts_event *tse = ethr_get_ts_event();
+ int spincount;
+
+ udata = tse->udata;
+ tse->udata = (void *) mtx;
+ ethr_atomic32_set_relb(&tse->uaflgs, ETHR_CND_WAIT__);
+
+ EnterCriticalSection(&cnd->cs);
+ enqueue(&cnd->waiters, tse, tse);
+ LeaveCriticalSection(&cnd->cs);
+
+ ethr_mutex_unlock(mtx);
+
+ spincount = cnd->spincount;
+
+ while (ethr_atomic32_read_acqb(&tse->uaflgs) != ETHR_CND_WAKEUP__) {
+ ethr_event_reset(&tse->event);
+ if (ethr_atomic32_read_acqb(&tse->uaflgs) == ETHR_CND_WAKEUP__)
+ break;
+ ethr_event_swait(&tse->event, spincount);
+ spincount = 0;
+ }
+
+ tse->udata = udata;
+ ethr_leave_ts_event(tse);
+
+ ethr_mutex_lock(mtx);
+
+ return 0;
+}
+
+static __forceinline void
+posix_compliant_mtx_enqueue(ethr_mutex *mtx,
+ ethr_ts_event *tse_start,
+ ethr_ts_event *tse_end)
+{
+ ethr_ts_event *tse_wakeup = NULL; /* Avoid erroneous compiler warning... */
+ /*
+ * The associated mutex might not be locked, so we need to
+ * check if it is. If locked, enqueue for wakeup at unlock;
+ * otherwise, wakeup the first one now and enqueue the rest.
+ */
+ if (tse_start == tse_end && !ethr_atomic32_read(&mtx->locked)) {
+ tse_wakeup = tse_start;
+ wakeup:
+ cond_wakeup(tse_wakeup);
+ }
+ else {
+ int need_wakeup;
+ ethr_spin_lock(&mtx->lock);
+ if (!mtx->wakeups)
+ ethr_atomic32_set_mb(&mtx->have_wakeups, 1);
+ need_wakeup = !ethr_atomic32_read(&mtx->locked);
+ if (need_wakeup) {
+ if (tse_start == tse_end) {
+ if (!mtx->wakeups)
+ ethr_atomic32_set_relb(&mtx->have_wakeups, 0);
+ ethr_spin_unlock(&mtx->lock);
+ tse_wakeup = tse_start;
+ goto wakeup;
+ }
+ tse_wakeup = tse_start;
+ tse_start = tse_start->next;
+ }
+ enqueue(&mtx->wakeups, tse_start, tse_end);
+ ethr_spin_unlock(&mtx->lock);
+ if (need_wakeup)
+ goto wakeup;
+ }
+}
+
+static __forceinline void
+enqueue_cond_wakeups(ethr_ts_event *queue, int posix_compliant)
+{
+ if (queue) {
+ int more;
+ ethr_ts_event *q = queue;
+
+ /*
+ * Waiters may be using different mutexes...
+ */
+
+ do {
+ ethr_mutex *mtx;
+ ethr_ts_event *tse, *tse_start, *tse_end;
+
+ more = 0;
+ tse_start = q;
+ mtx = (ethr_mutex *) tse_start->udata;
+
+ ETHR_ASSERT(posix_compliant
+ ? mtx->posix_compliant
+ : !mtx->posix_compliant);
+
+ ETHR_ASSERT(ethr_atomic32_read(&tse_start->uaflgs)
+ == ETHR_CND_WAIT__);
+ ETHR_ASSERT(mtx->initialized == ETHR_MUTEX_INITIALIZED);
+
+ tse_end = tse_start->prev;
+
+ for (tse = tse_start->next; tse != tse_start; tse = tse->next) {
+
+ ETHR_ASSERT(ethr_atomic32_read(&tse->uaflgs)
+ == ETHR_CND_WAIT__);
+
+ if (mtx != (ethr_mutex *) tse->udata) {
+ tse_end = tse->prev;
+ dequeue(&q, tse_start, tse_end);
+ more = 1;
+ break;
+ }
+ }
+
+ if (posix_compliant)
+ posix_compliant_mtx_enqueue(mtx, tse_start, tse_end);
+ else
+ enqueue(&mtx->wakeups, tse_start, tse_end);
+
+ } while (more);
+ }
+}
+
+void
+ethr_cond_broadcast(ethr_cond *cnd)
+{
+ ethr_ts_event *waiters;
+
+ EnterCriticalSection(&cnd->cs);
+ waiters = cnd->waiters;
+ cnd->waiters = NULL;
+ LeaveCriticalSection(&cnd->cs);
+
+ if (cnd->posix_compliant)
+ enqueue_cond_wakeups(waiters, 1);
+ else
+ enqueue_cond_wakeups(waiters, 0);
+}
+
+void
+ethr_cond_signal(ethr_cond *cnd)
+{
+ ethr_mutex *mtx;
+ ethr_ts_event *tse;
+
+ EnterCriticalSection(&cnd->cs);
+ tse = cnd->waiters;
+ if (tse)
+ dequeue(&cnd->waiters, tse, tse);
+ LeaveCriticalSection(&cnd->cs);
+
+ if (tse) {
+ mtx = (ethr_mutex *) tse->udata;
+
+ ETHR_ASSERT(ethr_atomic32_read(&tse->uaflgs) == ETHR_CND_WAIT__);
+ ETHR_ASSERT(mtx->initialized == ETHR_MUTEX_INITIALIZED);
+ ETHR_ASSERT(cnd->posix_compliant
+ ? mtx->posix_compliant
+ : !mtx->posix_compliant);
+
+ if (cnd->posix_compliant)
+ posix_compliant_mtx_enqueue(mtx, tse, tse);
+ else
+ enqueue(&mtx->wakeups, tse, tse);
+ }
+}
+
+int
+ethr_cond_init_opt(ethr_cond *cnd, ethr_cond_opt *opt)
+{
+ int spincount;
+
+#if ETHR_XCHK
+ if (!cnd) {
+ ETHR_ASSERT(0);
+ return EINVAL;
+ }
+ cnd->initialized = ETHR_COND_INITIALIZED;
+#endif
+
+ spincount = opt ? opt->aux_spincount : 0;
+ if (spincount < 0)
+ spincount = 0;
+
+ if (!InitializeCriticalSectionAndSpinCount(&cnd->cs, spincount)) {
+#if ETHR_XCHK
+ cnd->initialized = 0;
+#endif
+ return ethr_win_get_errno__();
+ }
+
+ cnd->posix_compliant = opt ? opt->posix_compliant : 0;
+ cnd->waiters = NULL;
+ cnd->spincount = spincount;
+ return 0;
+}
+
+int
+ethr_cond_init(ethr_cond *cnd)
+{
+ return ethr_cond_init_opt(cnd, NULL);
+}
+
+int
+ethr_cond_destroy(ethr_cond *cnd)
+{
+ DeleteCriticalSection(&cnd->cs);
+ return 0;
+}
+
+#endif
/* -- Exported symbols of inline functions --------------------------------- */
@@ -1969,7 +2367,7 @@ dbg_unlock_wake(ethr_rwmutex *rwmtx,
exp = have_w ? ETHR_RWMTX_W_FLG__ : 0;
if (rwmtx->type != ETHR_RWMUTEX_TYPE_NORMAL)
- imask = ETHR_RWMTX_R_PEND_UNLCK_MASK__;
+ imask = ETHR_RWMTX_R_PEND_UNLCK_MASK__|ETHR_RWMTX_R_ABRT_UNLCK_FLG__;
else {
#ifdef ETHR_RLOCK_WITH_INC_DEC
imask = ETHR_RWMTX_RS_MASK__;
diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam
index c7daf923c5..ffee1f489f 100644
--- a/erts/preloaded/ebin/erl_prim_loader.beam
+++ b/erts/preloaded/ebin/erl_prim_loader.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index f704135ce8..dda24d4405 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
Binary files differ
diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam
index 4adb3dedf2..37fd8bb832 100644
--- a/erts/preloaded/ebin/init.beam
+++ b/erts/preloaded/ebin/init.beam
Binary files differ
diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam
index 09216fd9d8..e255cc803f 100644
--- a/erts/preloaded/ebin/otp_ring0.beam
+++ b/erts/preloaded/ebin/otp_ring0.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam
index 7ac18352c4..6227b562a1 100644
--- a/erts/preloaded/ebin/prim_file.beam
+++ b/erts/preloaded/ebin/prim_file.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam
index 78481e2b00..22c51c79c0 100644
--- a/erts/preloaded/ebin/prim_inet.beam
+++ b/erts/preloaded/ebin/prim_inet.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam
index cad777b272..7e1a5d1fdb 100644
--- a/erts/preloaded/ebin/prim_zip.beam
+++ b/erts/preloaded/ebin/prim_zip.beam
Binary files differ
diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam
index 44dd264346..ebf9f8e6d6 100644
--- a/erts/preloaded/ebin/zlib.beam
+++ b/erts/preloaded/ebin/zlib.beam
Binary files differ
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index ff3633a3cc..e9a59a7aaf 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -40,6 +40,8 @@
-export([flush_monitor_message/2]).
-export([set_cpu_topology/1, format_cpu_topology/1]).
-export([await_proc_exit/3]).
+-export([memory/0, memory/1]).
+-export([alloc_info/1, alloc_sizes/1]).
-deprecated([hash/2]).
@@ -800,3 +802,405 @@ min(A, _) -> A.
Maximum :: term().
max(A, B) when A < B -> B;
max(A, _) -> A.
+
+
+%%
+%% erlang:memory/[0,1]
+%%
+%% NOTE! When updating these functions, make sure to also update
+%% erts_memory() in $ERL_TOP/erts/emulator/beam/erl_alloc.c
+%%
+
+-type memory_type() :: 'total' | 'processes' | 'processes_used' | 'system' | 'atom' | 'atom_used' | 'binary' | 'code' | 'ets' | 'low' | 'maximum'.
+
+-define(CARRIER_ALLOCS, [mseg_alloc, sbmbc_alloc, sbmbc_low_alloc]).
+-define(LOW_ALLOCS, [sbmbc_low_alloc, ll_low_alloc, std_low_alloc]).
+-define(ALL_NEEDED_ALLOCS, (erlang:system_info(alloc_util_allocators)
+ -- ?CARRIER_ALLOCS)).
+
+-record(memory, {total = 0,
+ processes = 0,
+ processes_used = 0,
+ system = 0,
+ atom = 0,
+ atom_used = 0,
+ binary = 0,
+ code = 0,
+ ets = 0,
+ low = 0,
+ maximum = 0}).
+
+-spec memory() -> [{memory_type(), non_neg_integer()}].
+memory() ->
+ case aa_mem_data(au_mem_data(?ALL_NEEDED_ALLOCS)) of
+ 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},
+ {system, Mem#memory.system},
+ {atom, Mem#memory.atom},
+ {atom_used, Mem#memory.atom_used},
+ {binary, Mem#memory.binary},
+ {code, Mem#memory.code},
+ {ets, Mem#memory.ets} | Tail]
+ end.
+
+-spec memory(memory_type()|[memory_type()]) -> non_neg_integer() | [{memory_type(), non_neg_integer()}].
+memory(Type) when is_atom(Type) ->
+ {AA, ALCU, ChkSup, BadArgZero} = need_mem_info(Type),
+ case get_mem_data(ChkSup, ALCU, AA) of
+ notsup ->
+ erlang:error(notsup, [Type]);
+ Mem ->
+ Value = get_memval(Type, Mem),
+ case {BadArgZero, Value} of
+ {true, 0} -> erlang:error(badarg, [Type]);
+ _ -> Value
+ end
+ end;
+memory(Types) when is_list(Types) ->
+ {AA, ALCU, ChkSup, BadArgZeroList} = need_mem_info_list(Types),
+ case get_mem_data(ChkSup, ALCU, AA) of
+ notsup ->
+ erlang:error(notsup, [Types]);
+ Mem ->
+ case memory_result_list(Types, BadArgZeroList, Mem) of
+ badarg -> erlang:error(badarg, [Types]);
+ Result -> Result
+ end
+ end.
+
+memory_result_list([], [], _Mem) ->
+ [];
+memory_result_list([T|Ts], [BAZ|BAZs], Mem) ->
+ case memory_result_list(Ts, BAZs, Mem) of
+ badarg -> badarg;
+ TVs ->
+ V = get_memval(T, Mem),
+ case {BAZ, V} of
+ {true, 0} -> badarg;
+ _ -> [{T, V}| TVs]
+ end
+ end.
+
+get_mem_data(true, AlcUAllocs, NeedAllocatedAreas) ->
+ case memory_is_supported() of
+ false -> notsup;
+ true -> get_mem_data(false, AlcUAllocs, NeedAllocatedAreas)
+ end;
+get_mem_data(false, AlcUAllocs, NeedAllocatedAreas) ->
+ AlcUMem = case AlcUAllocs of
+ [] -> #memory{};
+ _ ->
+ au_mem_data(AlcUAllocs)
+ end,
+ case NeedAllocatedAreas of
+ true -> aa_mem_data(AlcUMem);
+ false -> AlcUMem
+ end.
+
+need_mem_info_list([]) ->
+ {false, [], false, []};
+need_mem_info_list([T|Ts]) ->
+ {MAA, MALCU, MChkSup, MBadArgZero} = need_mem_info_list(Ts),
+ {AA, ALCU, ChkSup, BadArgZero} = need_mem_info(T),
+ {case AA of
+ true -> true;
+ _ -> MAA
+ end,
+ ALCU ++ (MALCU -- ALCU),
+ case ChkSup of
+ true -> true;
+ _ -> MChkSup
+ end,
+ [BadArgZero|MBadArgZero]}.
+
+need_mem_info(Type) when Type == total;
+ Type == system ->
+ {true, ?ALL_NEEDED_ALLOCS, false, false};
+need_mem_info(Type) when Type == processes;
+ Type == processes_used ->
+ {true, [eheap_alloc, fix_alloc], true, false};
+need_mem_info(Type) when Type == atom;
+ Type == atom_used;
+ Type == code ->
+ {true, [], true, false};
+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}.
+
+get_memval(total, #memory{total = V}) -> V;
+get_memval(processes, #memory{processes = V}) -> V;
+get_memval(processes_used, #memory{processes_used = V}) -> V;
+get_memval(system, #memory{system = V}) -> V;
+get_memval(atom, #memory{atom = V}) -> V;
+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() ->
+ {_, _, FeatureList, _} = erlang:system_info(allocator),
+ case ((erlang:system_info(alloc_util_allocators)
+ -- ?CARRIER_ALLOCS)
+ -- FeatureList) of
+ [] -> true;
+ _ -> false
+ end.
+
+get_blocks_size([{blocks_size, Sz, _, _} | Rest], Acc) ->
+ get_blocks_size(Rest, Acc+Sz);
+get_blocks_size([{_, _, _, _} | Rest], Acc) ->
+ get_blocks_size(Rest, Acc);
+get_blocks_size([], Acc) ->
+ Acc.
+
+blocks_size([{Carriers, SizeList} | Rest], Acc) when Carriers == mbcs;
+ Carriers == sbcs;
+ Carriers == sbmbcs ->
+ blocks_size(Rest, get_blocks_size(SizeList, Acc));
+blocks_size([_ | Rest], Acc) ->
+ blocks_size(Rest, Acc);
+blocks_size([], Acc) ->
+ Acc.
+
+get_fix_proc([{ProcType, A1, U1}| Rest], {A0, U0}) when ProcType == proc;
+ ProcType == monitor_sh;
+ ProcType == nlink_sh;
+ ProcType == msg_ref ->
+ get_fix_proc(Rest, {A0+A1, U0+U1});
+get_fix_proc([_|Rest], Acc) ->
+ get_fix_proc(Rest, Acc);
+get_fix_proc([], Acc) ->
+ Acc.
+
+fix_proc([{fix_types, SizeList} | _Rest], Acc) ->
+ get_fix_proc(SizeList, Acc);
+fix_proc([_ | Rest], Acc) ->
+ 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} | _]) ->
+ notsup;
+au_mem_data(#memory{total = Tot,
+ processes = Proc,
+ processes_used = ProcU} = Mem,
+ [{eheap_alloc, _, Data} | Rest]) ->
+ Sz = blocks_size(Data, 0),
+ au_mem_data(Mem#memory{total = Tot+Sz,
+ processes = Proc+Sz,
+ processes_used = ProcU+Sz},
+ Rest);
+au_mem_data(#memory{total = Tot,
+ system = Sys,
+ ets = Ets} = Mem,
+ [{ets_alloc, _, Data} | Rest]) ->
+ Sz = blocks_size(Data, 0),
+ au_mem_data(Mem#memory{total = Tot+Sz,
+ system = Sys+Sz,
+ ets = Ets+Sz},
+ Rest);
+au_mem_data(#memory{total = Tot,
+ system = Sys,
+ binary = Bin} = Mem,
+ [{binary_alloc, _, Data} | Rest]) ->
+ Sz = blocks_size(Data, 0),
+ au_mem_data(Mem#memory{total = Tot+Sz,
+ system = Sys+Sz,
+ binary = Bin+Sz},
+ Rest);
+au_mem_data(#memory{total = Tot,
+ processes = Proc,
+ processes_used = ProcU,
+ system = Sys} = Mem,
+ [{fix_alloc, _, Data} | Rest]) ->
+ {A, U} = fix_proc(Data, {0, 0}),
+ Sz = blocks_size(Data, 0),
+ au_mem_data(Mem#memory{total = Tot+Sz,
+ processes = Proc+A,
+ processes_used = ProcU+U,
+ system = Sys+Sz-A},
+ Rest);
+au_mem_data(#memory{total = Tot,
+ system = Sys,
+ low = Low} = Mem,
+ [{A, _, 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},
+ Rest);
+au_mem_data(EMD, []) ->
+ EMD.
+
+au_mem_data(Allocs) ->
+ Ref = make_ref(),
+ erlang:system_info({allocator_sizes, Ref, Allocs}),
+ receive_emd(Ref).
+
+receive_emd(_Ref, EMD, 0) ->
+ EMD;
+receive_emd(Ref, EMD, N) ->
+ receive
+ {Ref, _, Data} ->
+ receive_emd(Ref, au_mem_data(EMD, Data), N-1)
+ end.
+
+receive_emd(Ref) ->
+ receive_emd(Ref, #memory{}, erlang:system_info(schedulers)).
+
+aa_mem_data(notsup, _) ->
+ notsup;
+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
+ Rest);
+aa_mem_data(#memory{atom = Atom,
+ atom_used = AtomU} = Mem,
+ [{atom_space, Alloced, Used} | Rest]) ->
+ aa_mem_data(Mem#memory{atom = Atom+Alloced,
+ atom_used = AtomU+Used},
+ Rest);
+aa_mem_data(#memory{atom = Atom,
+ atom_used = AtomU} = Mem,
+ [{atom_table, Sz} | Rest]) ->
+ aa_mem_data(Mem#memory{atom = Atom+Sz,
+ atom_used = AtomU+Sz},
+ Rest);
+aa_mem_data(#memory{ets = Ets} = Mem,
+ [{ets_misc, Sz} | Rest]) ->
+ aa_mem_data(Mem#memory{ets = Ets+Sz},
+ Rest);
+aa_mem_data(#memory{processes = Proc,
+ processes_used = ProcU,
+ system = Sys} = Mem,
+ [{ProcData, Sz} | Rest]) when ProcData == bif_timer;
+ ProcData == link_lh;
+ ProcData == process_table ->
+ aa_mem_data(Mem#memory{processes = Proc+Sz,
+ processes_used = ProcU+Sz,
+ system = Sys-Sz},
+ Rest);
+aa_mem_data(#memory{code = Code} = Mem,
+ [{CodeData, Sz} | Rest]) when CodeData == module_table;
+ CodeData == export_table;
+ CodeData == export_list;
+ CodeData == fun_table;
+ CodeData == module_refs;
+ CodeData == loaded_code ->
+ aa_mem_data(Mem#memory{code = Code+Sz},
+ Rest);
+aa_mem_data(EMD, [{_, _} | Rest]) ->
+ aa_mem_data(EMD, Rest);
+aa_mem_data(#memory{total = Tot,
+ processes = Proc,
+ system = Sys} = Mem,
+ []) when Sys =< 0 ->
+ %% Instrumented runtime system -> Sys = Tot - Proc
+ Mem#memory{system = Tot - Proc};
+aa_mem_data(EMD, []) ->
+ EMD.
+
+aa_mem_data(notsup) ->
+ notsup;
+aa_mem_data(EMD) ->
+ aa_mem_data(EMD, erlang:system_info(allocated_areas)).
+
+%%
+%% alloc_info/1 and alloc_sizes/1 are for internal use only (used by
+%% erlang:system_info({allocator|allocator_sizes, _})).
+%%
+
+alloc_info(Allocs) ->
+ get_alloc_info(allocator, Allocs).
+
+alloc_sizes(Allocs) ->
+ get_alloc_info(allocator_sizes, Allocs).
+
+get_alloc_info(Type, AAtom) when is_atom(AAtom) ->
+ [{AAtom, Result}] = get_alloc_info(Type, [AAtom]),
+ Result;
+get_alloc_info(Type, AList) when is_list(AList) ->
+ Ref = make_ref(),
+ erlang:system_info({Type, Ref, AList}),
+ receive_allocator(Ref,
+ erlang:system_info(schedulers),
+ mk_res_list(AList)).
+
+mk_res_list([]) ->
+ [];
+mk_res_list([Alloc | Rest]) ->
+ [{Alloc, []} | mk_res_list(Rest)].
+
+insert_instance(I, N, []) ->
+ [{instance, N, I}];
+insert_instance(I, N, [{instance, M, _}|_] = Rest) when N < M ->
+ [{instance, N, I} | Rest];
+insert_instance(I, N, [Prev|Rest]) ->
+ [Prev | insert_instance(I, N, Rest)].
+
+insert_info([], Ys) ->
+ Ys;
+insert_info([{A, false}|Xs], [{A, _IList}|Ys]) ->
+ insert_info(Xs, [{A, false}|Ys]);
+insert_info([{A, N, I}|Xs], [{A, IList}|Ys]) ->
+ insert_info(Xs, [{A, insert_instance(I, N, IList)}|Ys]);
+insert_info([{A1, _}|_] = Xs, [{A2, _} = Y | Ys]) when A1 /= A2 ->
+ [Y | insert_info(Xs, Ys)];
+insert_info([{A1, _, _}|_] = Xs, [{A2, _} = Y | Ys]) when A1 /= A2 ->
+ [Y | insert_info(Xs, Ys)].
+
+receive_allocator(_Ref, 0, Acc) ->
+ Acc;
+receive_allocator(Ref, N, Acc) ->
+ receive
+ {Ref, _, InfoList} ->
+ receive_allocator(Ref, N-1, insert_info(InfoList, Acc))
+ end.
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index 10fe333d18..802c1991de 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -154,7 +154,7 @@ static ERL_NIF_TERM exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM rc2_40_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM rc2_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -234,7 +234,7 @@ static ErlNifFunc nif_funcs[] = {
{"rc4_encrypt", 2, rc4_encrypt},
{"rc4_set_key", 1, rc4_set_key},
{"rc4_encrypt_with_state", 2, rc4_encrypt_with_state},
- {"rc2_40_cbc_crypt", 4, rc2_40_cbc_crypt},
+ {"rc2_cbc_crypt", 4, rc2_cbc_crypt},
{"rsa_sign_nif", 3, rsa_sign_nif},
{"dss_sign_nif", 3, dss_sign_nif},
{"rsa_public_crypt", 4, rsa_public_crypt},
@@ -1237,30 +1237,31 @@ static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_N
return enif_make_tuple2(env,new_state,new_data);
}
-static ERL_NIF_TERM rc2_40_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+static ERL_NIF_TERM rc2_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Key,IVec,Data,IsEncrypt) */
ErlNifBinary key_bin, ivec_bin, data_bin;
RC2_KEY rc2_key;
ERL_NIF_TERM ret;
-
+ unsigned char iv_copy[8];
+
if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
- || key_bin.size != 5
+ || (key_bin.size != 5 && key_bin.size != 8 && key_bin.size != 16)
|| !enif_inspect_binary(env, argv[1], &ivec_bin)
|| ivec_bin.size != 8
- || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)) {
-
+ || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)
+ || data_bin.size % 8 != 0) {
return enif_make_badarg(env);
}
-
- RC2_set_key(&rc2_key, 5, key_bin.data, 40);
+
+ RC2_set_key(&rc2_key, key_bin.size, key_bin.data, key_bin.size*8);
+ memcpy(iv_copy, ivec_bin.data, 8);
RC2_cbc_encrypt(data_bin.data,
- enif_make_new_binary(env, data_bin.size, &ret),
+ enif_make_new_binary(env, data_bin.size, &ret),
data_bin.size, &rc2_key,
- ivec_bin.data,
+ iv_copy,
(argv[3] == atom_true));
-
return ret;
-}
+}
static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Type,Data,Key=[E,N,D]) */
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index 824be09438..48243fd693 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="latin1" ?>
+<?xml version="1.0" encoding="iso-8859-1" ?>
<!DOCTYPE erlref SYSTEM "erlref.dtd">
<erlref>
@@ -334,14 +334,16 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]>
</func>
<func>
<name>sha_mac(Key, Data) -> Mac</name>
+ <name>sha_mac(Key, Data, MacLength) -> Mac</name>
<fsummary>Compute an <c>MD5 MAC</c>message authentification code</fsummary>
<type>
<v>Key = Data = iolist() | binary()</v>
<v>Mac = binary()</v>
+ <v>MacLenength = integer() =&lt; 20 </v>
</type>
<desc>
<p>Computes an <c>SHA MAC</c> message authentification code
- from <c>Key</c> and <c>Data</c>, where the length of the Mac
+ from <c>Key</c> and <c>Data</c>, where the default length of the Mac
is 160 bits (20 bytes).</p>
</desc>
</func>
@@ -1046,6 +1048,30 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]>
</func>
<func>
+ <name>rc2_cbc_encrypt(Key, IVec, Text) -> Cipher</name>
+ <fsummary>Encrypt <c>Text</c>according to RC2 in CBC mode</fsummary>
+ <type>
+ <v>Key = Text = iolist() | binary()</v>
+ <v>Ivec = Cipher = binary()</v>
+ </type>
+ <desc>
+ <p>Encrypts <c>Text</c> according to RC2 in CBC mode.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>rc2_cbc_decrypt(Key, IVec, Cipher) -> Text</name>
+ <fsummary>Decrypts <c>Cipher</c>according to RC2 in CBC mode</fsummary>
+ <type>
+ <v>Key = Text = iolist() | binary()</v>
+ <v>Ivec = Cipher = binary()</v>
+ </type>
+ <desc>
+ <p>Decrypts <c>Cipher</c> according to RC2 in CBC mode.</p>
+ </desc>
+ </func>
+
+ <func>
<name>rc4_encrypt(Key, Data) -> Result</name>
<fsummary>Encrypt data using RC4</fsummary>
<type>
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index e3b921f9fa..0714cb686d 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -27,7 +27,7 @@
-export([sha/1, sha_init/0, sha_update/2, sha_final/1]).
%-export([sha256/1, sha256_init/0, sha256_update/2, sha256_final/1]).
%-export([sha512/1, sha512_init/0, sha512_update/2, sha512_final/1]).
--export([md5_mac/2, md5_mac_96/2, sha_mac/2, sha_mac_96/2]).
+-export([md5_mac/2, md5_mac_96/2, sha_mac/2, sha_mac/3, sha_mac_96/2]).
-export([hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]).
-export([des_cbc_encrypt/3, des_cbc_decrypt/3, des_cbc_ivec/1]).
-export([des_ecb_encrypt/2, des_ecb_decrypt/2]).
@@ -42,7 +42,7 @@
-export([aes_cfb_128_encrypt/3, aes_cfb_128_decrypt/3]).
-export([exor/2]).
-export([rc4_encrypt/2, rc4_set_key/1, rc4_encrypt_with_state/2]).
--export([rc2_40_cbc_encrypt/3, rc2_40_cbc_decrypt/3]).
+-export([rc2_cbc_encrypt/3, rc2_cbc_decrypt/3, rc2_40_cbc_encrypt/3, rc2_40_cbc_decrypt/3]).
-export([dss_verify/3, dss_verify/4, rsa_verify/3, rsa_verify/4]).
-export([dss_sign/2, dss_sign/3, rsa_sign/2, rsa_sign/3]).
-export([rsa_public_encrypt/3, rsa_private_decrypt/3]).
@@ -83,7 +83,7 @@
dss_verify,dss_sign,
rsa_verify,rsa_sign,
rsa_public_encrypt,rsa_private_decrypt,
- rsa_private_encrypt,rsa_public_decrypt,
+ rsa_private_encrypt,rsa_public_decrypt,
dh_generate_key, dh_compute_key,
aes_cbc_128_encrypt, aes_cbc_128_decrypt,
exor,
@@ -91,7 +91,7 @@
rc2_40_cbc_encrypt, rc2_40_cbc_decrypt,
%% idea_cbc_encrypt, idea_cbc_decrypt,
aes_cbc_256_encrypt, aes_cbc_256_decrypt,
- aes_ctr_encrypt, aes_ctr_decrypt,
+ aes_ctr_encrypt, aes_ctr_decrypt,
aes_ctr_stream_init, aes_ctr_stream_encrypt, aes_ctr_stream_decrypt,
info_lib]).
@@ -260,6 +260,9 @@ md5_mac_n(_Key,_Data,_MacSz) -> ?nif_stub.
sha_mac(Key, Data) ->
sha_mac_n(Key,Data,20).
+sha_mac(Key, Data, Size) ->
+ sha_mac_n(Key, Data, Size).
+
sha_mac_96(Key, Data) ->
sha_mac_n(Key,Data,12).
@@ -689,16 +692,25 @@ rc4_encrypt(_Key, _Data) -> ?nif_stub.
rc4_set_key(_Key) -> ?nif_stub.
rc4_encrypt_with_state(_State, _Data) -> ?nif_stub.
+
+%% RC2 block cipher
+
+rc2_cbc_encrypt(Key, IVec, Data) ->
+ rc2_cbc_crypt(Key,IVec,Data,true).
+
+rc2_cbc_decrypt(Key, IVec, Data) ->
+ rc2_cbc_crypt(Key,IVec,Data,false).
+
+rc2_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+
%%
-%% RC2 - 40 bits block cipher
+%% RC2 - 40 bits block cipher - Backwards compatibility not documented.
%%
-rc2_40_cbc_encrypt(Key, IVec, Data) ->
- rc2_40_cbc_crypt(Key,IVec,Data,true).
-
-rc2_40_cbc_decrypt(Key, IVec, Data) ->
- rc2_40_cbc_crypt(Key,IVec,Data,false).
+rc2_40_cbc_encrypt(Key, IVec, Data) when erlang:byte_size(Key) == 5 ->
+ rc2_cbc_crypt(Key,IVec,Data,true).
-rc2_40_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+rc2_40_cbc_decrypt(Key, IVec, Data) when erlang:byte_size(Key) == 5 ->
+ rc2_cbc_crypt(Key,IVec,Data,false).
%%
%% DH Diffie-Hellman functions
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 53b4c2a7e1..86acdc27df 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -49,6 +49,7 @@
des_ecb/1,
des3_cbc/1,
des3_cfb/1,
+ rc2_cbc/1,
aes_cfb/1,
aes_cbc/1,
aes_cbc_iter/1,
@@ -79,8 +80,10 @@ all() ->
md5_mac_io, sha, sha_update,
hmac_update_sha, hmac_update_sha_n, hmac_update_md5_n, hmac_update_md5_io, hmac_update_md5,
%% sha256, sha256_update, sha512,sha512_update,
- des_cbc, des_cfb, des3_cbc, des3_cfb, aes_cfb, aes_cbc,
+ des_cbc, des_cfb, des3_cbc, des3_cfb, rc2_cbc, aes_cfb, aes_cbc,
aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_cfb_iter, des_ecb,
+ des_cbc, rc2_cbc, aes_cfb, aes_cbc,
+ aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_ecb,
rand_uniform_test, strong_rand_test,
rsa_verify_test, dsa_verify_test, rsa_sign_test,
dsa_sign_test, rsa_encrypt_decrypt, dh, exor_test,
@@ -347,7 +350,7 @@ hmac_update_md5(Config) when is_list(Config) ->
Key2 = "A fine speach by a fine man!",
?line Long1 = "Four score and seven years ago our fathers brought forth on this continent a new nation, conceived in liberty, and dedicated to the proposition that all men are created equal.",
?line Long2 = "Now we are engaged in a great civil war, testing whether that nation, or any nation, so conceived and so dedicated, can long endure. We are met on a great battle-field of that war. We have come to dedicate a portion of that field, as a final resting place for those who here gave their lives that that nation might live. It is altogether fitting and proper that we should do this.",
- ?line Long3 = "But, in a larger sense, we can not dedicate, we can not consecrate, we can not hallow this ground. The brave men, living and dead, who struggled here, have consecrated it, far above our poor power to add or detract. The world will little note, nor long remember what we say here, but it can never forget what they did here. It is for us the living, rather, to be dedicated here to the unfinished work which they who fought here have thus far so nobly advanced. It is rather for us to be here dedicated to the great task remaining before us-that from these honored dead we take increased devotion to that cause for which they gave the last full measure of devotion—that we here highly resolve that these dead shall not have died in vain-that this nation, under God, shall have a new birth of freedom-and that government of the people, by the people, for the people, shall not perish from the earth.",
+ ?line Long3 = "But, in a larger sense, we can not dedicate, we can not consecrate, we can not hallow this ground. The brave men, living and dead, who struggled here, have consecrated it, far above our poor power to add or detract. The world will little note, nor long remember what we say here, but it can never forget what they did here. It is for us the living, rather, to be dedicated here to the unfinished work which they who fought here have thus far so nobly advanced. It is rather for us to be here dedicated to the great task remaining before us-that from these honored dead we take increased devotion to that cause for which they gave the last full measure of devotion that we here highly resolve that these dead shall not have died in vain-that this nation, under God, shall have a new birth of freedom-and that government of the people, by the people, for the people, shall not perish from the earth.",
?line CtxA = crypto:hmac_init(md5, Key2),
?line CtxB = crypto:hmac_update(CtxA, Long1),
?line CtxC = crypto:hmac_update(CtxB, Long2),
@@ -604,6 +607,21 @@ des_ecb(Config) when is_list(Config) ->
?line m(Cipher5, <<"he time ">>),
?line Cipher6 = crypto:des_ecb_decrypt(Key, hexstr2bin("893d51ec4b563b53")),
?line m(Cipher6, <<"for all ">>).
+%%
+%%
+rc2_cbc(doc) ->
+ "Encrypt and decrypt according to RC2 CBC and check the result. "
+ "Example stripped out from public_key application test";
+rc2_cbc(Config) when is_list(Config) ->
+
+ Key = <<146,210,160,124,215,227,153,239,227,17,222,140,3,93,27,191>>,
+ IV = <<72,91,135,182,25,42,35,210>>,
+
+ Cipher = <<36,245,206,158,168,230,58,69,148,137,32,192,250,41,237,181,181,251, 192,2,175,135,177,171,57,30,111,117,159,149,15,28,88,158,28,81,28,115, 85,219,241,82,117,222,91,85,73,117,164,25,182,52,191,64,123,57,26,19, 211,27,253,31,194,219,231,104,247,240,172,130,119,21,225,154,101,247, 32,216,42,216,133,169,78,22,97,27,227,26,196,224,172,168,17,9,148,55, 203,91,252,40,61,226,236,221,215,160,78,63,13,181,68,57,196,241,185, 207, 116,129,152,237,60,139,247,153,27,146,161,246,222,98,185,222,152, 187,135, 236,86,34,7,110,91,230,173,34,160,242,202,222,121,127,181,140, 101,203,195, 190,88,250,86,147,127,87,72,126,171,16,71,47,110,248,88, 14,29,143,161,152, 129,236,148,22,152,186,208,119,70,8,174,193,203,100, 193,203,200,117,102,242, 134,142,96,125,135,200,217,190,76,117,50,70, 209,186,101,241,200,91,40,193,54, 90,195,38,47,59,197,38,234,86,223,16, 51,253,204,129,20,171,66,21,241,26,135,216, 196,114,110,91,15,53,40, 164,201,136,113,95,247,51,181,208,241,68,168,98,151,36, 155,72,24,57, 42,191,14,125,204,10,167,214,233,138,115,125,234,121,134,227,26,247, 77,200,117,110,117,111,168,156,206,67,159,149,189,173,150,193,91,199, 216,153,22, 189,137,185,89,160,13,131,132,58,109,28,110,246,252,251,14, 232,91,38,52,29,101,188,69,123,50,0,130,178,93,73,239,118,7,77,35,59, 253,10,159,45,86,142,37,78,232,48>>,
+ Text = <<48,130,1,85,2,1,0,48,13,6,9,42,134,72,134,247,13,1,1,1,5,0,4,130,1,63,48,130, 1,59,2,1,0,2,65,0,222,187,252,44,9,214,27,173,162,169,70,47,36,34,78,84,204, 107,60,192,117,95,21,206,49,142,245,126,121,223,23,2,107,106,133,204,161,36, 40,2,114,69,4,93,242,5,42,50,154,47,154,211,209,123,120,161,5,114,173,155,34, 191,52,59,2,3,1,0,1,2,64,45,144,169,106,220,236,71,39,67,82,123,192,35,21,61, 143,13,110,150,180,12,142,210,40,39,109,70,125,132,51,6,66,159,134,112,85, 155,243,118,221,65,133,127,99,151,194,252,141,149,224,229,62,214,45,228,32, 184,85,67,14,228,161,184,161,2,33,0,255,202,240,131,130,57,49,224,115,255,83, 79,6,165,212,21,179,212,20,188,97,74,69,68,163,223,247,237,39,24,23,235,2,33, 0,222,234,48,36,33,23,219,45,59,136,55,245,143,29,165,48,255,131,207,146,131, 104,13,163,54,131,236,78,88,54,16,241,2,33,0,230,2,99,129,173,176,166,131, 241,106,143,76,9,107,70,41,121,185,228,39,124,200,159,62,216,169,5,180,111, 169,255,159,2,33,0,151,193,70,212,209,210,179,219,175,83,165,4,255,81,103,76, 92,39,24,0,222,132,208,3,244,241,10,198,171,54,227,129,2,32,43,250,20,31,16, 189,168,116,225,1,125,132,94,130,118,124,28,56,232,39,69,218,244,33,240,200, 205,9,215,101,35,135,7,7,7,7,7,7,7>>,
+
+ Text = crypto:rc2_cbc_decrypt(Key, IV, Cipher),
+ Cipher = crypto:rc2_cbc_encrypt(Key, IV, Text).
%%
%%
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index bcdcf2685d..84b926a17a 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -480,7 +480,7 @@ invalid_contract_warning({M, F, A}, FileLine, SuccType, RecDict) ->
extra_range_warning({M, F, A}, FileLine, ExtraRanges, STRange) ->
ERangesStr = erl_types:t_to_string(ExtraRanges),
STRangeStr = erl_types:t_to_string(STRange),
- {?WARN_CONTRACT_TYPES, FileLine,
+ {?WARN_CONTRACT_SUPERTYPE, FileLine,
{extra_range, [M, F, A, ERangesStr, STRangeStr]}}.
picky_contract_check(CSig0, Sig0, MFA, FileLine, Contract, RecDict, Acc) ->
diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl
index 30aec59d22..92868b6878 100644
--- a/lib/dialyzer/src/dialyzer_typesig.erl
+++ b/lib/dialyzer/src/dialyzer_typesig.erl
@@ -2161,13 +2161,21 @@ get_apply_constr(FunLabels, Dst, ArgTypes, #state{callgraph = CG} = State) ->
case lists:member(error, MFAs) of
true -> error;
false ->
- Constrs = [begin
- State1 = state__new_constraint_context(State),
- State2 = get_plt_constr(MFA, Dst, ArgTypes, State1),
- state__cs(State2)
- end || {ok, MFA} <- MFAs],
- ApplyConstr = mk_disj_constraint_list(Constrs),
- {ok, state__store_conj(ApplyConstr, State)}
+ Constrs0 =
+ [begin
+ State1 = state__new_constraint_context(State),
+ try get_plt_constr(MFA, Dst, ArgTypes, State1) of
+ State2 -> state__cs(State2)
+ catch
+ throw:error -> error
+ end
+ end || {ok, MFA} <- MFAs],
+ case [C || C <- Constrs0, C =/= error] of
+ [] -> throw(error);
+ Constrs ->
+ ApplyConstr = mk_disj_constraint_list(Constrs),
+ {ok, state__store_conj(ApplyConstr, State)}
+ end
end.
state__scc(#state{scc = SCC}) ->
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/crash b/lib/dialyzer/test/opaque_SUITE_data/results/crash
index 6bdd934169..1ddae5149f 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/crash
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/crash
@@ -1,5 +1,4 @@
-crash_1.erl:42: The specification for crash_1:empty/0 states that the function might also return crash_1:targetlist() but the inferred return is none()
crash_1.erl:45: Record construction #targetlist{list::[]} violates the declared type of field list::'undefined' | crash_1:target()
crash_1.erl:48: The call crash_1:get_using_branch2(Branch::maybe_improper_list(),L::'undefined' | crash_1:target()) contains an opaque term as 2nd argument when terms of different types are expected in these positions
crash_1.erl:50: The pattern <_Branch, []> can never match the type <maybe_improper_list(),'undefined' | crash_1:target()>
diff --git a/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy b/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy
new file mode 100644
index 0000000000..7ce440a60d
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy
@@ -0,0 +1,4 @@
+
+higher_order_discrepancy.erl:11: The call higher_order_discrepancy:g('foo') will never return since it differs in the 1st argument from the success typing arguments: ('bar')
+higher_order_discrepancy.erl:14: Function g/1 has no local return
+higher_order_discrepancy.erl:14: The pattern 'bar' can never match the type 'foo'
diff --git a/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy_2 b/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy_2
new file mode 100644
index 0000000000..c1c7dbbfcc
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/results/higher_order_discrepancy_2
@@ -0,0 +1,8 @@
+
+higher_order_discrepancy_2.erl:11: The call higher_order_discrepancy_2:f('foo') will never return since it differs in the 1st argument from the success typing arguments: ('bar')
+higher_order_discrepancy_2.erl:11: The call higher_order_discrepancy_2:g('foo') will never return since it differs in the 1st argument from the success typing arguments: ('baz')
+higher_order_discrepancy_2.erl:13: Function f/1 has no local return
+higher_order_discrepancy_2.erl:13: The pattern 'bar' can never match the type 'foo'
+higher_order_discrepancy_2.erl:14: Function g/1 has no local return
+higher_order_discrepancy_2.erl:14: The pattern 'baz' can never match the type 'foo'
+higher_order_discrepancy_2.erl:5: Function test/1 has no local return
diff --git a/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash b/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash
index 191d3d4173..8c9df56a4b 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash
+++ b/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash
@@ -12,4 +12,3 @@ tuple_set_crash.erl:179: The pattern <<AudioVolume:16/integer-little-unit:1,Rest
tuple_set_crash.erl:182: The pattern <<Delay:16/integer-little-unit:1,_Padding/binary-unit:8>> can never match the type <<_:8>>
tuple_set_crash.erl:62: The pattern {'play_list', _Playlist} can never match the type 'ok' | {'device_properties',[{atom(),_}]} | {'error',[{atom(),_}]}
tuple_set_crash.erl:64: The pattern {'error', 17} can never match the type 'ok' | {'device_properties',[{atom(),_}]} | {'error',[{atom(),_}]}
-tuple_set_crash.erl:83: The specification for tuple_set_crash:parse_message/1 states that the function might also return {'media_item_url_reply',integer(),binary()} but the inferred return is 'ok' | {'audio_device_info' | 'audio_output_info' | 'audio_target_info' | 'device_properties' | 'error' | 'video_device_info' | 'video_output_info' | 'video_target_info',[{'address' | 'audio_volume' | 'controller_description' | 'controller_name' | 'controller_status' | 'device_id' | 'display_type' | 'fw_version' | 'master_volume' | 'model' | 'output_id' | 'status' | 'target_id',binary() | non_neg_integer()}] | 1..255}
diff --git a/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy.erl b/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy.erl
new file mode 100644
index 0000000000..ff5ee6bac4
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy.erl
@@ -0,0 +1,14 @@
+-module(higher_order_discrepancy).
+
+-export([test/1]).
+
+test(X) ->
+ F =
+ case X of
+ 1 -> fun f/1;
+ 2 -> fun g/1
+ end,
+ F(foo).
+
+f(foo) -> ok.
+g(bar) -> ok.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy_2.erl b/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy_2.erl
new file mode 100644
index 0000000000..4b0d4f6b45
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/higher_order_discrepancy_2.erl
@@ -0,0 +1,14 @@
+-module(higher_order_discrepancy_2).
+
+-export([test/1]).
+
+test(X) ->
+ F =
+ case X of
+ 1 -> fun f/1;
+ 2 -> fun g/1
+ end,
+ F(foo).
+
+f(bar) -> ok.
+g(baz) -> ok.
diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml
index 43c497f50a..2d8edb1301 100644
--- a/lib/diameter/doc/src/diameter.xml
+++ b/lib/diameter/doc/src/diameter.xml
@@ -431,7 +431,7 @@ eval(F) ->
</code>
<p>
-Evaluating an evaluable() <c>E</c> on an argument list <c>A</c>
+Applying an evaluable() <c>E</c> to an argument list <c>A</c>
is meant in the sense of <c>eval([E|A])</c>.</p>
<p>
@@ -565,7 +565,7 @@ Pkt = #diameter_packet{}
</code>
<p>
-Reports that the RFC 3539 watchdog state machine has
+The RFC 3539 watchdog state machine has
transitioned into (<c>up</c>) or out of (<c>down</c>) the open
state.
If a <c>diameter_packet</c> record is present in an <c>up</c> tuple
@@ -576,9 +576,9 @@ connectivity.</p>
<p>
Note that a single up/down event for a given peer corresponds to
-as many peer_up/down callbacks as there are Diameter
-applications shared by the peer, as determined during capablilities
-exchange.
+as many <seealso marker="diameter_app#peer_up">peer_up/peer_down</seealso>
+callbacks as there are Diameter applications shared by the peer,
+as determined during capablilities exchange.
That is, the event communicates connectivity with the
peer as a whole while the callbacks communicate connectivity with
respect to individual Diameter applications.</p>
@@ -597,12 +597,96 @@ transport connection with a peer following <c>reconnect_timer</c> or
<c>watchdog_timer</c> expiry.</p>
</item>
+<tag><c>{closed, Ref, Reason, Config}</c></tag>
+<item>
+<code>
+Ref = transport_ref()
+Config = {connect|listen, [transport_opt()]}
+</code>
+
+<p>
+Capabilities exchange has failed. <c>Reason</c> can be one of
+the following.</p>
+
+<taglist>
+
+<tag><c>{'CER', Result, Caps, Pkt}</c></tag>
+<item>
+<code>
+Result = ResultCode | {capabilities_cb, CB, ResultCode|discard}
+Caps = #diameter_caps{}
+Pkt = #diameter_packet{}
+ResultCode = integer()
+CB = evaluable()
+</code>
+
+<p>
+An incoming CER has been answered with the indicated result code or
+discarded.
+The capabilities record contains pairs of values for the the local
+node and remote peer.
+The packet record contains the CER in question.
+In the case of rejection by a capabilities callback, the tuple
+indicates the rejecting callback.</p>
+</item>
+
+<tag><c>{'CER', Caps, {ResultCode, Pkt}}</c></tag>
+<item>
+<code>
+ResultCode = integer()
+Caps = #diameter_caps{}
+Pkt = #diameter_packet{}
+</code>
+
+<p>
+An incoming CER contained errors and has been answered with the
+indicated result code.
+The capabilities record contains only values for the the local
+node.
+The packet record contains the CER in question.</p>
+</item>
+
+<tag><c>{'CEA', Result, Caps, Pkt}</c></tag>
+<item>
+<code>
+Result = integer() | atom() | {capabilities_cb, CB, ResultCode|discard}
+Caps = #diameter_caps{}
+Pkt = #diameter_packet{}
+ResultCode = integer()
+</code>
+
+<p>
+An incoming CEA has been rejected for the indicated reason.
+An integer-valued <c>Result</c> indicates the result code sent
+by the peer.
+The capabilities record contains pairs of values for the the local
+node and remote peer.
+The packet record contains the CEA in question.
+In the case of rejection by a capabilities callback, the tuple
+indicates the rejecting callback.</p>
+</item>
+
+<tag><c>{'CEA', Caps, Pkt}</c></tag>
+<item>
+<code>
+Caps = #diameter_caps{}
+Pkt = #diameter_packet{}
+</code>
+
+<p>
+An incoming CER contained errors and has been rejected.
+The capabilities record contains only values for the the local node.
+The packet record contains the CEA in question.</p>
+</item>
+
+</taglist>
+</item>
+
</taglist>
<p>
For forward compatibility, a subscriber should be prepared to receive
-<c>diameter_event.info</c> of forms other than those documented
-above.</p>
+info fields of forms other than the above.</p>
<marker id="service_name"/>
</item>
@@ -706,6 +790,31 @@ not over SCTP as implemented by
<seealso marker="diameter_sctp">diameter_sctp(3)</seealso>.</p>
</item>
+<tag><c>{capabilities_cb, evaluable()}</c></tag>
+<item>
+<p>
+A callback invoked upon reception of CER/CEA during capabilities
+exchange in order to ask whether or not the connection should
+be accepted.
+Applied to the transport reference (as returned by <seealso
+marker="#add_transport">add_transport/2</seealso>) and
+<c>diameter_caps</c> record of the connection.
+Returning <c>ok</c> accepts the connection.
+Returning <c>integer()</c> causes an incoming
+CER to be answered with the specified Result-Code.
+Returning <c>discard</c> causes an incoming CER to
+be discarded.
+Returning <c>unknown</c> is equivalent to returning <c>3010</c>,
+DIAMETER_UNKNOWN_PEER.
+Returning anything but <c>ok</c> or a 2xxx series result
+code causes the transport connection to be broken.</p>
+
+<p>
+Multiple <c>capabilities_cb</c> options can be specified, in which
+case the corresponding callbacks are applied until either all return
+<c>ok</c> or one does not.</p>
+</item>
+
<tag><c>{watchdog_timer, TwInit}</c></tag>
<item>
<code>
diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl
index d037e1044a..13a6c462af 100644
--- a/lib/diameter/include/diameter_gen.hrl
+++ b/lib/diameter/include/diameter_gen.hrl
@@ -40,14 +40,14 @@ encode_avps(Name, Rec) ->
list_to_binary(encode(Name, Rec))
catch
throw: {?MODULE, Reason} ->
- diameter_dbg:log({encode, error},
+ diameter_lib:log({encode, error},
?MODULE,
?LINE,
{Reason, Name, Rec}),
erlang:error(list_to_tuple(Reason ++ [Name]));
error: Reason ->
Stack = erlang:get_stacktrace(),
- diameter_dbg:log({encode, failure},
+ diameter_lib:log({encode, failure},
?MODULE,
?LINE,
{Reason, Name, Rec, Stack}),
@@ -159,7 +159,7 @@ d_rc(Name, {Avps, {Rec, [] = Failed}}) ->
{Rec, Avps, Failed}
catch
throw: {?MODULE, {AvpName, Reason}} ->
- diameter_dbg:log({decode, error},
+ diameter_lib:log({decode, error},
?MODULE,
?LINE,
{AvpName, Reason, Rec}),
@@ -260,7 +260,7 @@ d(Name, Avp, {Avps, Acc}) ->
%% respond sensibly to. Log the occurence for traceability,
%% but the peer will also receive info in the resulting
%% answer-message.
- diameter_dbg:log({decode, failure},
+ diameter_lib:log({decode, failure},
?MODULE,
?LINE,
{Reason, Avp, erlang:get_stacktrace()}),
diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile
index a057632d15..eea2aa894d 100644
--- a/lib/diameter/src/Makefile
+++ b/lib/diameter/src/Makefile
@@ -177,7 +177,7 @@ else
include $(ERL_TOP)/make/otp_release_targets.mk
endif
-# Can't $(INSTALL_DIR) more than on directory at a time on Solaris.
+# Can't $(INSTALL_DIR) more than one directory at a time on Solaris.
release_spec: opt
for d in bin ebin examples include src/dict $(TARGET_DIRS:%/=src/%); do \
@@ -209,7 +209,7 @@ gen/diameter_gen_base_accounting.hrl gen/diameter_gen_relay.hrl: \
gen/diameter_gen_base_rfc3588.erl gen/diameter_gen_base_rfc3588.hrl: \
$(COMPILER_MODULES:compiler/%=$(EBIN)/%.$(EMULATOR))
-$(DICT_MODULES:%=$(EBIN)/%.$(EMULATOR)): \
+$(DICT_MODULES:gen/%=$(EBIN)/%.$(EMULATOR)): \
$(INCDIR)/diameter.hrl \
$(INCDIR)/diameter_gen.hrl
diff --git a/lib/diameter/src/base/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl
index 138e76411e..842a9e6103 100644
--- a/lib/diameter/src/base/diameter_capx.erl
+++ b/lib/diameter/src/base/diameter_capx.erl
@@ -57,9 +57,9 @@
-include("diameter_types.hrl").
-include("diameter_gen_base_rfc3588.hrl").
--define(SUCCESS, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS').
--define(NOAPP, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_APPLICATION').
--define(NOSECURITY, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_SECURITY').
+-define(SUCCESS, 2001). %% DIAMETER_SUCCESS
+-define(NOAPP, 5010). %% DIAMETER_NO_COMMON_APPLICATION
+-define(NOSECURITY, 5017). %% DIAMETER_NO_COMMON_SECURITY
-define(NO_INBAND_SECURITY, 0).
-define(TLS, 1).
@@ -96,7 +96,7 @@ try_it([Fun | Args]) ->
try apply(Fun, Args) of
T -> {ok, T}
catch
- throw: ?FAILURE(Reason) -> {error, {Reason, Args}}
+ throw: ?FAILURE(Reason) -> {error, Reason}
end.
%% mk_caps/2
@@ -224,10 +224,6 @@ rCER(CER, #diameter_service{capabilities = LCaps} = Svc) ->
RCaps,
CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS})}.
-%% TODO: 5.3 of RFC 3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION
-%% in the CEA and SHOULD disconnect the transport. However, we have
-%% no way to guarantee the send before disconnecting.
-
build_CEA([], _, _, CEA) ->
CEA#diameter_base_CEA{'Result-Code' = ?NOAPP};
@@ -292,25 +288,12 @@ to_cea(CER, Field, CEA) ->
%% rCEA/2
-rCEA(#diameter_base_CEA{'Result-Code' = RC}
- = CEA,
- #diameter_service{capabilities = LCaps}
- = Svc) ->
- RC == ?SUCCESS orelse ?THROW({'Result-Code', RC}),
-
+rCEA(CEA, #diameter_service{capabilities = LCaps} = Svc) ->
RCaps = capx_to_caps(CEA),
SApps = common_applications(LCaps, RCaps, Svc),
-
- [] == SApps andalso ?THROW(no_common_applications),
-
IS = common_security(LCaps, RCaps),
- [] == IS andalso ?THROW(no_common_security),
-
- {SApps, IS, RCaps};
-
-rCEA(CEA, _Svc) ->
- ?THROW({invalid, CEA}).
+ {SApps, IS, RCaps}.
%% capx_to_caps/1
diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl
index d88f42fb7c..fe1212b7e0 100644
--- a/lib/diameter/src/base/diameter_codec.erl
+++ b/lib/diameter/src/base/diameter_codec.erl
@@ -190,26 +190,13 @@ encode_avps(Avps) ->
%% msg_header/3
-msg_header(Mod, MsgName, Header) ->
- {Code, Flags, ApplId} = h(Mod, MsgName, Header),
- {Code, p(Flags, Header), ApplId}.
-
-%% 6.2 of 3588 requires the same 'P' bit on an answer as on the
-%% request.
-
-p(Flags, #diameter_header{is_request = true,
- is_proxiable = P}) ->
- Flags band (2#10110000 bor choose(P, 2#01000000, 0));
-p(Flags, _) ->
- Flags.
-
-h(Mod, 'answer-message' = MsgName, Header) ->
+msg_header(Mod, 'answer-message' = MsgName, Header) ->
?BASE = Mod,
#diameter_header{cmd_code = Code} = Header,
{_, Flags, ApplId} = ?BASE:msg_header(MsgName),
{Code, Flags, ApplId};
-h(Mod, MsgName, _) ->
+msg_header(Mod, MsgName, _) ->
Mod:msg_header(MsgName).
%% rec2msg/2
@@ -554,8 +541,3 @@ pack_avp(Code, Flags, Vid, Sz, Bin) ->
pack_avp(Code, Flags, Sz, Bin) ->
Length = Sz + 8,
<<Code:32, Flags:8, Length:24, Bin/binary>>.
-
-%% ===========================================================================
-
-choose(true, X, _) -> X;
-choose(false, _, X) -> X.
diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl
index 282fa2742f..fae5d763dc 100644
--- a/lib/diameter/src/base/diameter_peer_fsm.erl
+++ b/lib/diameter/src/base/diameter_peer_fsm.erl
@@ -55,7 +55,8 @@
-define(NO_INBAND_SECURITY, 0).
-define(TLS, 1).
--define(LOOP_TIMEOUT, 2000).
+%% A 2xxx series Result-Code. Not necessarily 2001.
+-define(IS_SUCCESS(N), 2 == (N) div 1000).
%% RFC 3588:
%%
@@ -142,9 +143,12 @@ init(T) ->
proc_lib:init_ack({ok, self()}),
gen_server:enter_loop(?MODULE, [], i(T)).
-i({WPid, {M, _} = T, Opts, #diameter_service{capabilities = Caps} = Svc0}) ->
+i({WPid, T, Opts, #diameter_service{capabilities = Caps} = Svc0}) ->
putr(dwa, dwa(Caps)),
- {ok, TPid, Svc} = start_transport(T, Opts, Svc0),
+ {M, Ref} = T,
+ {[Ts], Rest} = proplists:split(Opts, [capabilities_cb]),
+ putr(capabilities_cb, {Ref, [F || {_,F} <- Ts]}),
+ {ok, TPid, Svc} = start_transport(T, Rest, Svc0),
erlang:monitor(process, TPid),
erlang:monitor(process, WPid),
#state{parent = WPid,
@@ -198,10 +202,13 @@ handle_info(T, #state{} = State) ->
?LOG(stop, T),
x(T, State)
catch
- throw: {?MODULE, Tag, Reason} ->
+ {?MODULE, Tag, Reason} ->
?LOG(Tag, {Reason, T}),
{stop, {shutdown, Reason}, State}
end.
+%% The form of the exception caught here is historical. It's
+%% significant that it's not a 2-tuple, as in ?FAILURE(Reason),
+%% since these are caught elsewhere.
x(Reason, #state{} = S) ->
close_wd(Reason, S),
@@ -226,6 +233,9 @@ putr(Key, Val) ->
getr(Key) ->
get({?MODULE, Key}).
+eraser(Key) ->
+ erase({?MODULE, Key}).
+
%% transition/2
%% Connection to peer.
@@ -316,9 +326,10 @@ send_CER(#state{mode = {connect, Remote},
service = #diameter_service{capabilities = Caps},
transport = TPid}
= S) ->
- req_send_CER(Caps#diameter_caps.origin_host, Remote)
+ OH = Caps#diameter_caps.origin_host,
+ req_send_CER(OH, Remote)
orelse
- close(connected, S),
+ close({already_connected, Remote, Caps}, S),
CER = build_CER(S),
?LOG(send, 'CER'),
send(TPid, encode(CER)),
@@ -460,20 +471,20 @@ handle_request(Type, #diameter_packet{} = Pkt, S) ->
%% send_answer/3
send_answer(Type, ReqPkt, #state{transport = TPid} = S) ->
- #diameter_packet{header = #diameter_header{version = V,
- end_to_end_id = Eid,
- hop_by_hop_id = Hid,
- is_proxiable = P},
+ #diameter_packet{header = H,
transport_data = TD}
= ReqPkt,
- {Answer, PostF} = build_answer(Type, V, ReqPkt, S),
+ {Msg, PostF} = build_answer(Type, ReqPkt, S),
- Pkt = #diameter_packet{header = #diameter_header{version = V,
- end_to_end_id = Eid,
- hop_by_hop_id = Hid,
- is_proxiable = P},
- msg = Answer,
+ %% An answer message clears the R and T flags and retains the P
+ %% flag. The E flag is set at encode.
+ Pkt = #diameter_packet{header
+ = H#diameter_header{version = ?DIAMETER_VERSION,
+ is_request = false,
+ is_error = undefined,
+ is_retransmitted = false},
+ msg = Msg,
transport_data = TD},
send(TPid, diameter_codec:encode(?BASE, Pkt)),
@@ -484,56 +495,104 @@ eval([F|A], S) ->
eval(ok, S) ->
S.
-%% build_answer/4
+%% build_answer/3
build_answer('CER',
- ?DIAMETER_VERSION,
#diameter_packet{msg = CER,
- header = #diameter_header{is_error = false},
+ header = #diameter_header{version
+ = ?DIAMETER_VERSION,
+ is_error = false},
errors = []}
= Pkt,
- #state{service = Svc}
- = S) ->
- #diameter_service{capabilities = #diameter_caps{origin_host = OH}}
- = Svc,
-
- {SupportedApps,
- #diameter_caps{origin_host = DH} = RCaps,
- #diameter_base_CEA{'Result-Code' = RC}
- = CEA}
+ S) ->
+ {SupportedApps, RCaps, #diameter_base_CEA{'Result-Code' = RC,
+ 'Inband-Security-Id' = IS}
+ = CEA}
= recv_CER(CER, S),
+ #diameter_caps{origin_host = {OH, DH}}
+ = Caps
+ = capz(caps(S), RCaps),
+
try
2001 == RC %% DIAMETER_SUCCESS
- orelse ?THROW({sent_CEA, RC}),
+ orelse ?THROW(RC),
register_everywhere({?MODULE, connection, OH, DH})
- orelse ?THROW({election_lost, 4003}),
- #diameter_base_CEA{'Inband-Security-Id' = [IS]}
- = CEA,
- {CEA, [fun open/5, Pkt, SupportedApps, RCaps, {accept, IS}]}
+ orelse ?THROW(4003), %% DIAMETER_ELECTION_LOST
+ caps_cb(Caps)
+ of
+ N -> {cea(CEA, N), [fun open/5, Pkt,
+ SupportedApps,
+ Caps,
+ {accept, hd([_] = IS)}]}
catch
- ?FAILURE({Reason, RC}) ->
- {answer('CER', S) ++ [{'Result-Code', RC}],
- [fun close/2, {'CER', Reason, DH}]}
+ ?FAILURE(Reason) ->
+ rejected(Reason, {'CER', Reason, Caps, Pkt}, S)
end;
%% The error checks below are similar to those in diameter_service for
%% other messages. Should factor out the commonality.
-build_answer(Type, V, #diameter_packet{header = H, errors = Es} = Pkt, S) ->
- FailedAvp = failed_avp([A || {_,A} <- Es]),
- Ans = answer(answer(Type, S), V, H, Es),
- {set(Ans, FailedAvp), if 'CER' == Type ->
- [fun close/2, {Type, V, Pkt}];
- true ->
- ok
- end}.
+build_answer(Type,
+ #diameter_packet{header = H,
+ errors = Es}
+ = Pkt,
+ S) ->
+ RC = rc(H, Es),
+ {answer(Type, RC, Es, S), post(Type, RC, Pkt, S)}.
+
+cea(CEA, ok) ->
+ CEA;
+cea(CEA, 2001) ->
+ CEA;
+cea(CEA, RC) ->
+ CEA#diameter_base_CEA{'Result-Code' = RC}.
+
+post('CER' = T, RC, Pkt, S) ->
+ [fun close/2, {T, caps(S), {RC, Pkt}}];
+post(_, _, _, _) ->
+ ok.
+
+rejected({capabilities_cb, _F, Reason}, T, S) ->
+ rejected(Reason, T, S);
+
+rejected(discard, T, S) ->
+ close(T, S);
+rejected({N, Es}, T, S) ->
+ {answer('CER', N, Es, S), [fun close/2, T]};
+rejected(N, T, S) ->
+ rejected({N, []}, T, S).
+
+answer(Type, RC, Es, S) ->
+ set(answer(Type, RC, S), failed_avp([A || {_,A} <- Es])).
+
+answer(Type, RC, S) ->
+ answer_message(answer(Type, S), RC).
+%% answer_message/2
+
+answer_message([_ | Avps], RC)
+ when 3000 =< RC, RC < 4000 ->
+ ['answer-message', {'Result-Code', RC}
+ | lists:filter(fun is_origin/1, Avps)];
+
+answer_message(Msg, RC) ->
+ Msg ++ [{'Result-Code', RC}].
+
+is_origin({N, _}) ->
+ N == 'Origin-Host'
+ orelse N == 'Origin-Realm'
+ orelse N == 'Origin-State-Id'.
+
+%% failed_avp/1
+
failed_avp([] = No) ->
No;
failed_avp(Avps) ->
[{'Failed-AVP', [[{'AVP', Avps}]]}].
+%% set/2
+
set(Ans, []) ->
Ans;
set(['answer-message' | _] = Ans, FailedAvp) ->
@@ -541,18 +600,22 @@ set(['answer-message' | _] = Ans, FailedAvp) ->
set([_|_] = Ans, FailedAvp) ->
Ans ++ FailedAvp.
-answer([_, OH, OR | _], _, #diameter_header{is_error = true}, _) ->
- ['answer-message', OH, OR, {'Result-Code', 3008}];
+%% rc/2
+
+rc(#diameter_header{is_error = true}, _) ->
+ 3008; %% DIAMETER_INVALID_HDR_BITS
-answer([_, OH, OR | _], _, _, [Bs|_])
+rc(_, [Bs|_])
when is_bitstring(Bs) ->
- ['answer-message', OH, OR, {'Result-Code', 3009}];
+ 3009; %% DIAMETER_INVALID_HDR_BITS
-answer(Ans, ?DIAMETER_VERSION, _, Es) ->
- Ans ++ [{'Result-Code', rc(Es)}];
+rc(#diameter_header{version = ?DIAMETER_VERSION}, Es) ->
+ rc(Es);
-answer(Ans, _, _, _) ->
- Ans ++ [{'Result-Code', 5011}]. %% DIAMETER_UNSUPPORTED_VERSION
+rc(_, _) ->
+ 5011. %% DIAMETER_UNSUPPORTED_VERSION
+
+%% rc/1
rc([]) ->
2001; %% DIAMETER_SUCCESS
@@ -595,12 +658,14 @@ a('CER', #diameter_caps{vendor_id = Vid,
origin_host = Host,
origin_realm = Realm,
host_ip_address = Addrs,
- product_name = Name}) ->
+ product_name = Name,
+ origin_state_id = OSI}) ->
['CEA', {'Origin-Host', Host},
{'Origin-Realm', Realm},
{'Host-IP-Address', Addrs},
{'Vendor-Id', Vid},
- {'Product-Name', Name}];
+ {'Product-Name', Name},
+ {'Origin-State-Id', OSI}];
a('DPR', #diameter_caps{origin_host = Host,
origin_realm = Realm}) ->
@@ -615,27 +680,25 @@ recv_CER(CER, #state{service = Svc}) ->
%% handle_CEA/1
-handle_CEA(#diameter_packet{header = #diameter_header{version = V},
- bin = Bin}
+handle_CEA(#diameter_packet{bin = Bin}
= Pkt,
#state{service = #diameter_service{capabilities = LCaps}}
= S)
when is_binary(Bin) ->
?LOG(recv, 'CEA'),
- ?DIAMETER_VERSION == V orelse close({version, V}, S),
-
- #diameter_packet{msg = CEA, errors = Errors}
+ #diameter_packet{msg = CEA}
= DPkt
= diameter_codec:decode(?BASE, Pkt),
- [] == Errors orelse close({errors, Errors}, S),
+ {SApps, IS, RCaps} = recv_CEA(DPkt, S),
- {SApps, [IS], #diameter_caps{origin_host = DH} = RCaps}
- = recv_CEA(CEA, S),
+ #diameter_caps{origin_host = {OH, DH}}
+ = Caps
+ = capz(LCaps, RCaps),
- #diameter_caps{origin_host = OH}
- = LCaps,
+ #diameter_base_CEA{'Result-Code' = RC}
+ = CEA,
%% Ensure that we don't already have a connection to the peer in
%% question. This isn't the peer election of 3588 except in the
@@ -643,60 +706,101 @@ handle_CEA(#diameter_packet{header = #diameter_header{version = V},
%% receive a CER/CEA, the first that arrives wins the right to a
%% connection with the peer.
- register_everywhere({?MODULE, connection, OH, DH})
- orelse close({'CEA', DH}, S),
-
- open(DPkt, SApps, RCaps, {connect, IS}, S).
+ try
+ ?IS_SUCCESS(RC)
+ orelse ?THROW(RC),
+ [] == SApps
+ andalso ?THROW(no_common_application),
+ [] == IS
+ andalso ?THROW(no_common_security),
+ register_everywhere({?MODULE, connection, OH, DH})
+ orelse ?THROW(election_lost),
+ caps_cb(Caps)
+ of
+ _ -> open(DPkt, SApps, Caps, {connect, hd([_] = IS)}, S)
+ catch
+ ?FAILURE(Reason) -> close({'CEA', Reason, Caps, DPkt}, S)
+ end.
+%% Check more than the result code since the peer could send success
+%% regardless. If not 2001 then a peer_up callback could do anything
+%% required. It's not unimaginable that a peer agreeing to TLS after
+%% capabilities exchange could send DIAMETER_LIMITED_SUCCESS = 2002,
+%% even if this isn't required by RFC 3588.
%% recv_CEA/2
-recv_CEA(CEA, #state{service = Svc} = S) ->
- case diameter_capx:recv_CEA(CEA, Svc) of
- {ok, {_,_}} -> %% return from old code
- close({'CEA', update}, S);
- {ok, {[], _, _}} ->
- close({'CEA', no_common_application}, S);
- {ok, {_, [], _}} ->
- close({'CEA', no_common_security}, S);
- {ok, {_,_,_} = T} ->
- T;
- {error, Reason} ->
- close({'CEA', Reason}, S)
+recv_CEA(#diameter_packet{header = #diameter_header{version
+ = ?DIAMETER_VERSION,
+ is_error = false},
+ msg = CEA,
+ errors = []},
+ #state{service = Svc}) ->
+ {ok, T} = diameter_capx:recv_CEA(CEA, Svc),
+ T;
+
+recv_CEA(Pkt, S) ->
+ close({'CEA', caps(S), Pkt}, S).
+
+caps(#diameter_service{capabilities = Caps}) ->
+ Caps;
+caps(#state{service = Svc}) ->
+ caps(Svc).
+
+%% caps_cb/1
+
+caps_cb(Caps) ->
+ {Ref, Ts} = eraser(capabilities_cb),
+ ccb(Ts, [Ref, Caps]).
+
+ccb([], _) ->
+ ok;
+ccb([F | Rest], T) ->
+ case diameter_lib:eval([F|T]) of
+ ok ->
+ ccb(Rest, T);
+ N when ?IS_SUCCESS(N) -> %% 2xxx result code: accept immediately
+ N;
+ Res ->
+ ?THROW({capabilities_cb, F, rejected(Res)})
end.
+%% Note that returning 2xxx causes the capabilities exchange to be
+%% accepted directly, without further callbacks.
+
+rejected(discard = T) ->
+ T;
+rejected(unknown) ->
+ 3010; %% DIAMETER_UNKNOWN_PEER
+rejected(N)
+ when is_integer(N) ->
+ N.
%% open/5
-open(Pkt, SupportedApps, RCaps, {Type, IS}, #state{parent = Pid,
- service = Svc}
- = S) ->
- #diameter_service{capabilities = #diameter_caps{origin_host = OH,
- inband_security_id = LS}
- = LCaps}
- = Svc,
- #diameter_caps{origin_host = DH}
- = RCaps,
+open(Pkt, SupportedApps, Caps, {Type, IS}, #state{parent = Pid} = S) ->
+ #diameter_caps{origin_host = {_,_} = H,
+ inband_security_id = {LS,_}}
+ = Caps,
- tls_ack(lists:member(?TLS, LS), Type, IS, S),
- Pid ! {open, self(), {OH,DH}, {capz(LCaps, RCaps), SupportedApps, Pkt}},
+ tls_ack(lists:member(?TLS, LS), Caps, Type, IS, S),
+ Pid ! {open, self(), H, {Caps, SupportedApps, Pkt}},
S#state{state = 'Open'}.
%% We've advertised TLS support: tell the transport the result
%% and expect a reply when the handshake is complete.
-tls_ack(true, Type, IS, #state{transport = TPid} = S) ->
+tls_ack(true, Caps, Type, IS, #state{transport = TPid} = S) ->
Ref = make_ref(),
- MRef = erlang:monitor(process, TPid),
TPid ! {diameter, {tls, Ref, Type, IS == ?TLS}},
receive
{diameter, {tls, Ref}} ->
- erlang:demonitor(MRef, [flush]);
- {'DOWN', MRef, process, _, _} = T ->
- close({tls_ack, T}, S)
+ ok;
+ {'DOWN', _, process, TPid, Reason} ->
+ close({tls_ack, Reason, Caps}, S)
end;
%% Or not. Don't send anything to the transport so that transports
%% not supporting TLS work as before without modification.
-tls_ack(false, _, _, _) ->
+tls_ack(false, _, _, _, _) ->
ok.
capz(#diameter_caps{} = L, #diameter_caps{} = R) ->
diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl
index 421e36ccf5..7adcf1c265 100644
--- a/lib/diameter/src/base/diameter_service.erl
+++ b/lib/diameter/src/base/diameter_service.erl
@@ -983,7 +983,8 @@ peer_cb(MFA, Alias) ->
connection_down(Pid, #state{peerT = PeerT,
connT = ConnT}
= S) ->
- #peer{conn = TPid}
+ #peer{op_state = ?STATE_UP, %% assert
+ conn = TPid}
= P
= fetch(PeerT, Pid),
@@ -993,6 +994,9 @@ connection_down(Pid, #state{peerT = PeerT,
%% connection_down/3
+connection_down(#peer{op_state = ?STATE_DOWN}, _, S) ->
+ S;
+
connection_down(#peer{conn = TPid,
op_state = ?STATE_UP}
= P,
@@ -1034,13 +1038,23 @@ down_conn(Id, Alias, TC, {SvcName, Apps}) ->
%% Peer process has died.
-peer_down(Pid, _Reason, #state{peerT = PeerT} = S) ->
+peer_down(Pid, Reason, #state{peerT = PeerT} = S) ->
P = fetch(PeerT, Pid),
ets:delete_object(PeerT, P),
+ closed(Reason, P, S),
restart(P,S),
peer_down(P,S).
-%% peer_down/2
+%% Send an event at connection establishment failure.
+closed({shutdown, {close, _TPid, Reason}},
+ #peer{op_state = ?STATE_DOWN,
+ ref = Ref,
+ type = Type,
+ options = Opts},
+ #state{service_name = SvcName}) ->
+ send_event(SvcName, {closed, Ref, Reason, {type(Type), Opts}});
+closed(_, _, _) ->
+ ok.
%% The peer has never come up ...
peer_down(#peer{conn = B}, S)
@@ -1048,27 +1062,9 @@ peer_down(#peer{conn = B}, S)
S;
%% ... or it has.
-peer_down(#peer{ref = Ref,
- conn = TPid,
- type = Type,
- options = Opts}
- = P,
- #state{service_name = SvcName,
- connT = ConnT}
- = S) ->
- #conn{caps = Caps}
- = C
- = fetch(ConnT, TPid),
+peer_down(#peer{conn = TPid} = P, #state{connT = ConnT} = S) ->
+ #conn{} = C = fetch(ConnT, TPid),
ets:delete_object(ConnT, C),
- try
- pd(P,C,S)
- after
- send_event(SvcName, {closed, Ref, {TPid, Caps}, {type(Type), Opts}})
- end.
-
-pd(#peer{op_state = ?STATE_DOWN}, _, S) ->
- S;
-pd(#peer{op_state = ?STATE_UP} = P, C, S) ->
connection_down(P,C,S).
%% restart/2
@@ -1259,11 +1255,11 @@ send_request({TPid, Caps, App}, Msg, Opts, Caller, SvcName) ->
#diameter_app{module = ModX}
= App,
- Pkt = make_packet(Msg),
+ Pkt = make_request_packet(Msg),
case cb(ModX, prepare_request, [Pkt, SvcName, {TPid, Caps}]) of
{send, P} ->
- send_request(make_packet(P, Pkt),
+ send_request(make_request_packet(P, Pkt),
TPid,
Caps,
App,
@@ -1278,70 +1274,73 @@ send_request({TPid, Caps, App}, Msg, Opts, Caller, SvcName) ->
?ERROR({invalid_return, prepare_request, App, T})
end.
-%% make_packet/1
+%% make_request_packet/1
%%
%% Turn an outgoing request as passed to call/4 into a diameter_packet
%% record in preparation for a prepare_request callback.
-make_packet(Bin)
+make_request_packet(Bin)
when is_binary(Bin) ->
#diameter_packet{header = diameter_codec:decode_header(Bin),
bin = Bin};
-make_packet(#diameter_packet{msg = [#diameter_header{} = Hdr | Avps]} = Pkt) ->
- Pkt#diameter_packet{msg = [make_header(Hdr) | Avps]};
+make_request_packet(#diameter_packet{msg = [#diameter_header{} = Hdr | Avps]}
+ = Pkt) ->
+ Pkt#diameter_packet{msg = [make_request_header(Hdr) | Avps]};
-make_packet(#diameter_packet{header = Hdr} = Pkt) ->
- Pkt#diameter_packet{header = make_header(Hdr)};
+make_request_packet(#diameter_packet{header = Hdr} = Pkt) ->
+ Pkt#diameter_packet{header = make_request_header(Hdr)};
-make_packet(Msg) ->
- make_packet(#diameter_packet{msg = Msg}).
+make_request_packet(Msg) ->
+ make_request_packet(#diameter_packet{msg = Msg}).
-%% make_header/1
+%% make_request_header/1
-make_header(undefined) ->
+make_request_header(undefined) ->
Seq = diameter_session:sequence(),
- make_header(#diameter_header{end_to_end_id = Seq,
- hop_by_hop_id = Seq});
+ make_request_header(#diameter_header{end_to_end_id = Seq,
+ hop_by_hop_id = Seq});
-make_header(#diameter_header{version = undefined} = Hdr) ->
- make_header(Hdr#diameter_header{version = ?DIAMETER_VERSION});
+make_request_header(#diameter_header{version = undefined} = Hdr) ->
+ make_request_header(Hdr#diameter_header{version = ?DIAMETER_VERSION});
-make_header(#diameter_header{end_to_end_id = undefined} = H) ->
+make_request_header(#diameter_header{end_to_end_id = undefined} = H) ->
Seq = diameter_session:sequence(),
- make_header(H#diameter_header{end_to_end_id = Seq});
+ make_request_header(H#diameter_header{end_to_end_id = Seq});
-make_header(#diameter_header{hop_by_hop_id = undefined} = H) ->
+make_request_header(#diameter_header{hop_by_hop_id = undefined} = H) ->
Seq = diameter_session:sequence(),
- make_header(H#diameter_header{hop_by_hop_id = Seq});
+ make_request_header(H#diameter_header{hop_by_hop_id = Seq});
-make_header(#diameter_header{} = Hdr) ->
+make_request_header(#diameter_header{} = Hdr) ->
Hdr;
-make_header(T) ->
+make_request_header(T) ->
?ERROR({invalid_header, T}).
-%% make_packet/2
+%% make_request_packet/2
%%
%% Reconstruct a diameter_packet from the return value of
%% prepare_request or prepare_retransmit callback.
-make_packet(Bin, _)
+make_request_packet(Bin, _)
when is_binary(Bin) ->
- make_packet(Bin);
+ make_request_packet(Bin);
-make_packet(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _) ->
+make_request_packet(#diameter_packet{msg = [#diameter_header{} | _]}
+ = Pkt,
+ _) ->
Pkt;
%% Returning a diameter_packet with no header from a prepare_request
%% or prepare_retransmit callback retains the header passed into it.
%% This is primarily so that the end to end and hop by hop identifiers
%% are retained.
-make_packet(#diameter_packet{header = Hdr} = Pkt,
+make_request_packet(#diameter_packet{header = Hdr} = Pkt,
#diameter_packet{header = Hdr0}) ->
Pkt#diameter_packet{header = fold_record(Hdr0, Hdr)};
-make_packet(Msg, Pkt) ->
+make_request_packet(Msg, Pkt) ->
Pkt#diameter_packet{msg = Msg}.
%% fold_record/2
@@ -1533,7 +1532,7 @@ retransmit({TPid, Caps, #diameter_app{alias = Alias} = App},
case cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]) of
{send, P} ->
- retransmit(make_packet(P, Pkt), TPid, Caps, Req, Timeout);
+ retransmit(make_request_packet(P, Pkt), TPid, Caps, Req, Timeout);
{discard, Reason} ->
?THROW(Reason);
discard ->
@@ -1946,7 +1945,7 @@ reply(Msg, Dict, TPid, #diameter_packet{errors = Es,
= ReqPkt)
when [] == Es;
is_record(hd(Msg), diameter_header) ->
- Pkt = diameter_codec:encode(Dict, make_reply_packet(Msg, ReqPkt)),
+ Pkt = diameter_codec:encode(Dict, make_answer_packet(Msg, ReqPkt)),
incr(send, Pkt, Dict, TPid), %% count result codes in sent answers
send(TPid, Pkt#diameter_packet{transport_data = TD});
@@ -1957,18 +1956,19 @@ reply(Msg, Dict, TPid, #diameter_packet{errors = [H|_] = Es} = Pkt) ->
TPid,
Pkt#diameter_packet{errors = []}).
-%% make_reply_packet/2
+%% make_answer_packet/2
%% Binaries and header/avp lists are sent as-is.
-make_reply_packet(Bin, _)
+make_answer_packet(Bin, _)
when is_binary(Bin) ->
#diameter_packet{bin = Bin};
-make_reply_packet([#diameter_header{} | _] = Msg, _) ->
+make_answer_packet([#diameter_header{} | _] = Msg, _) ->
#diameter_packet{msg = Msg};
%% Otherwise a reply message clears the R and T flags and retains the
-%% P flag. The E flag will be set at encode.
-make_reply_packet(Msg, #diameter_packet{header = ReqHdr}) ->
+%% P flag. The E flag will be set at encode. 6.2 of 3588 requires the
+%% same P flag on an answer as on the request.
+make_answer_packet(Msg, #diameter_packet{header = ReqHdr}) ->
Hdr = ReqHdr#diameter_header{version = ?DIAMETER_VERSION,
is_request = false,
is_error = undefined,
diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl
index b7c1491f4b..6dc53d9f31 100644
--- a/lib/diameter/src/base/diameter_watchdog.erl
+++ b/lib/diameter/src/base/diameter_watchdog.erl
@@ -179,11 +179,11 @@ transition({close, TPid, _Reason}, #watchdog{transport = TPid}) ->
%% state okay as the result of the Peer State Machine reaching the
%% Open state.
%%
-%% If we're an acceptor then we may be resuming a connection that went
-%% down in another acceptor process, in which case this is the
-%% transition below, from down into reopen. That is, it's not until
-%% we know the identity of the peer (ie. now) that we know that we're
-%% in state down rather than initial.
+%% If we're accepting then we may be resuming a connection that went
+%% down in another watchdog process, in which case this is the
+%% transition below, from down to reopen. That is, it's not until we
+%% know the identity of the peer (ie. now) that we know that we're in
+%% state down rather than initial.
transition({open, TPid, Hosts, T} = Open,
#watchdog{transport = TPid,
diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile
index 69bcabbfbb..97d9069f4a 100644
--- a/lib/diameter/test/Makefile
+++ b/lib/diameter/test/Makefile
@@ -58,16 +58,18 @@ SUITES = $(SUITE_MODULES:diameter_%_SUITE=%)
# target like 'all' below. Target release_tests only installs source.
ERL_COMPILE_FLAGS += +warn_export_vars \
+warn_unused_vars \
- -DDIAMETER_CT=true \
+ -I ../include \
-I ../src/gen
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-all: $(SUITES)
+all: opt
-beam tests debug opt: $(TARGET_FILES)
+run: $(SUITES)
+
+debug opt: $(TARGET_FILES)
clean:
rm -f $(TARGET_FILES)
@@ -94,22 +96,22 @@ help:
@echo "Useful targets:"
@echo
@echo " all:"
+ @echo " Compile all test suites."
+ @echo
+ @echo " run:"
@echo " Compile and run all test suites."
@echo
@echo " $(SUITES):"
@echo " Compile and run a specific test suite."
@echo
- @echo " beam:"
- @echo " Compile all test-code."
- @echo
@echo " clean | realclean:"
@echo " Remove generated files."
@echo
@echo " info:"
- @echo " Echo some interesting variables."
+ @echo " Echo some relevant variables."
@echo ========================================
-.PHONY: all beam clean debug docs help info opt realclean tests
+.PHONY: all run clean debug docs help info opt realclean
# ----------------------------------------------------
# Special Targets
@@ -118,12 +120,12 @@ help:
# Exit with a non-zero status if the output looks to indicate failure.
# diameter_ct:run/1 itself can't tell (it seems). The absolute -pa is
# because ct will change directories.
-$(SUITES): log tests
+$(SUITES): log opt
$(ERL) -noshell \
- -pa $(realpath ../ebin) \
- -sname diameter_test_$@ \
- -s diameter_ct run diameter_$@_SUITE \
- -s init stop \
+ -pa $(realpath ../ebin) \
+ -sname diameter_test_$@ \
+ -s diameter_ct run diameter_$@_SUITE \
+ -s init stop \
| awk '1{rc=0} {print} / FAILED /{rc=1} END{exit rc}'
# Shorter in sed but requires a GNU extension (ie. Q).
@@ -136,6 +138,9 @@ log:
# Release Targets
# ----------------------------------------------------
+/%: % force
+ sed -f release.sed $< > $(RELSYSDIR)$@
+
ifeq ($(ERL_TOP),)
include $(DIAMETER_TOP)/make/release_targets.mk
else
@@ -151,10 +156,16 @@ release_tests_spec:
$(INSTALL_DATA) $(TEST_SPEC_FILE) \
$(COVER_SPEC_FILE) \
$(HRL_FILES) \
- $(ERL_FILES) \
$(RELSYSDIR)
+ $(MAKE) $(ERL_FILES:%=/%)
+
+force:
.PHONY: release_spec release_docs_spec release_test_specs
+.PHONY: force
+
+# Can't just make $(ERL_FILES:%=/%) phony since then implicit rule
+# searching is skipped.
# ----------------------------------------------------
@@ -163,7 +174,7 @@ depend: depend.mk
# Generate dependencies makefile.
depend.mk: depend.sed $(MODULES:%=%.erl) Makefile
(for f in $(MODULES); do \
- sed -f $< $$f.erl | sed "s@/@/$$f@"; \
+ (echo $$f; cat $$f.erl) | sed -f $<; \
done) \
> $@
diff --git a/lib/diameter/test/depend.sed b/lib/diameter/test/depend.sed
index a399eb45f0..95dca44984 100644
--- a/lib/diameter/test/depend.sed
+++ b/lib/diameter/test/depend.sed
@@ -18,14 +18,24 @@
#
#
-# Extract local include dependencies from .erl files. The output is massaged
-# further in Makefile.
+# Extract local include dependencies from an .erl file. The first
+# input line is the module name.
#
-/^-include/!d
+# Store the module name in the hold space.
+1{
+ h
+ d
+}
+
+# Throw away everything but local includes.
/^-include_lib/d
+/^-include/!d
/diameter_gen/d
+/diameter\./d
+# Output a dependency of the beam on the included file.
s@^-include("@@
s@".*@@
-s@^@$(EBIN)/.$(EMULATOR): @
+G
+s@^\(.*\)\n\(.*\)@$(EBIN)/\2.$(EMULATOR): \1@
diff --git a/lib/diameter/test/diameter_capx_SUITE.erl b/lib/diameter/test/diameter_capx_SUITE.erl
new file mode 100644
index 0000000000..e6b1558bf6
--- /dev/null
+++ b/lib/diameter/test/diameter_capx_SUITE.erl
@@ -0,0 +1,432 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests of capabilities exchange between Diameter nodes. In
+%% particular, of error and event handling.
+%%
+
+-module(diameter_capx_SUITE).
+
+-export([suite/0,
+ all/0,
+ groups/0,
+ init_per_group/2,
+ end_per_group/2,
+ init_per_testcase/2,
+ end_per_testcase/2]).
+
+%% testcases
+-export([start/1,
+ start_services/1,
+ add_listeners/1,
+ s_no_common_application/1,
+ c_no_common_application/1,
+ s_no_common_security/1,
+ c_no_common_security/1,
+ s_unknown_peer/1,
+ c_unknown_peer/1,
+ s_unable/1,
+ c_unable/1,
+ s_client_reject/1,
+ c_client_reject/1,
+ remove_listeners/1,
+ stop_services/1,
+ stop/1]).
+
+%% diameter callbacks
+-export([peer_up/4,
+ peer_down/4]).
+
+-include("diameter.hrl").
+-include("diameter_gen_base_rfc3588.hrl").
+
+%% ===========================================================================
+
+-define(util, diameter_util).
+
+-define(CLIENT, client).
+-define(SERVER, server).
+
+-define(ADDR, {127,0,0,1}).
+
+-define(REALM, "erlang.org").
+-define(HOST(Name), Name ++ "." ++ ?REALM).
+
+%% Config for diameter:start_service/2.
+-define(SERVICE(Name),
+ [{'Origin-Realm', ?REALM},
+ {'Host-IP-Address', [?ADDR]},
+ {'Vendor-Id', 12345},
+ {'Product-Name', "OTP/diameter"},
+ {'Auth-Application-Id', [?DIAMETER_APP_ID_COMMON]},
+ {'Acct-Application-Id', [?DIAMETER_APP_ID_ACCOUNTING]}
+ | [{application, [{alias, A},
+ {dictionary, D},
+ {module, [?MODULE, A]}]}
+ || {A,D} <- [{common, ?DIAMETER_DICT_COMMON},
+ {accounting, ?DIAMETER_DICT_ACCOUNTING}]]]).
+
+-define(A, list_to_atom).
+-define(L, atom_to_list).
+
+-define(event, #diameter_event).
+-define(caps, #diameter_caps).
+-define(packet, #diameter_packet).
+
+-define(cea, #diameter_base_CEA).
+-define(answer_message, #'diameter_base_answer-message').
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [start, start_services, add_listeners
+ | [{group, N} || {N, _, _} <- groups()]]
+ ++ [remove_listeners, stop_services, stop].
+
+groups() ->
+ Ts = testcases(),
+ [{grp(P), P, Ts} || P <- [[], [parallel]]].
+
+grp([]) ->
+ sequential;
+grp([parallel = P]) ->
+ P.
+
+init_per_group(_Name, Config) ->
+ Config.
+
+end_per_group(_, _) ->
+ ok.
+
+%% Generate a unique hostname for each testcase so that watchdogs
+%% don't prevent a connection from being brought up immediately.
+init_per_testcase(Name, Config) ->
+ Uniq = ["." ++ integer_to_list(N) || N <- tuple_to_list(now())],
+ [{host, lists:flatten([?L(Name) | Uniq])} | Config].
+
+end_per_testcase(N, _)
+ when N == start;
+ N == start_services;
+ N == add_listeners;
+ N == remove_listeners;
+ N == stop_services;
+ N == stop ->
+ ok;
+end_per_testcase(Name, Config) ->
+ CRef = ?util:read_priv(Config, Name),
+ ok = diameter:remove_transport(?CLIENT, CRef).
+
+%% Testcases all come in two flavours, client and server.
+testcases() ->
+ lists:flatmap(fun tc/1, tc()).
+
+tc(Name) ->
+ [?A([C,$_|?L(Name)]) || C <- "cs"].
+
+tc() ->
+ [no_common_application,
+ no_common_security,
+ unknown_peer,
+ unable,
+ client_reject].
+
+%% ===========================================================================
+%% start/stop testcases
+
+start(_Config) ->
+ ok = diameter:start().
+
+start_services(_Config) ->
+ ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)),
+ ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)).
+
+%% One server that responds only to base accounting, one that responds
+%% to both this and the common application. Share a common service just
+%% to simplify config, and because we can.
+add_listeners(Config) ->
+ Acct = listen(?SERVER,
+ [{capabilities, [{'Origin-Host', ?HOST("acct-srv")},
+ {'Auth-Application-Id', []}]},
+ {applications, [accounting]},
+ {capabilities_cb, [fun server_capx/3, acct]}]),
+ Base = listen(?SERVER,
+ [{capabilities, [{'Origin-Host', ?HOST("base-srv")}]},
+ {capabilities_cb, [fun server_capx/3, base]}]),
+ ?util:write_priv(Config, ?MODULE, {Base, Acct}). %% lref/2 reads
+
+remove_listeners(_Config) ->
+ ok = diameter:remove_transport(?SERVER, true).
+
+stop_services(_Config) ->
+ ok = diameter:stop_service(?CLIENT),
+ ok = diameter:stop_service(?SERVER).
+
+stop(_Config) ->
+ ok = diameter:stop().
+
+%% ===========================================================================
+%% All the testcases come in pairs, one for receiving an event on the
+%% client side, one on the server side. Note that testcases will
+%% receive events resulting from other testcases when running in
+%% parallel since the events are per service. The unique client
+%% Origin-Host for each testcase plus transport references are used to
+%% ensure that only the relevant event is extracted from the mailbox.
+%% Don't bother extracting events that aren't relevant.
+
+%% ====================
+%% Ask the accounting server to speak the common application and expect
+%% DIAMETER_NO_COMMON_APPLICATION = 5010.
+
+s_no_common_application(Config) ->
+ server_closed(Config, fun no_common_application/1, 5010).
+
+c_no_common_application(Config) ->
+ client_closed(Config, "acct-srv", fun no_common_application/1, 5010).
+
+no_common_application(Config) ->
+ connect(Config, acct, [{capabilities, [{'Acct-Application-Id', []}]},
+ {applications, [common]}]).
+
+%% ====================
+%% Ask the base server to speak accounting with an unknown security
+%% method and expect DIAMETER_NO_COMMON_SECURITY = 5017.
+
+s_no_common_security(Config) ->
+ server_closed(Config, fun no_common_security/1, 5017).
+
+c_no_common_security(Config) ->
+ client_closed(Config, "base-srv", fun no_common_security/1, 5017).
+
+no_common_security(Config) ->
+ connect(Config, base, [{capabilities, [{'Acct-Application-Id', []},
+ {'Inband-Security-Id', [17, 18]}]},
+ {applications, [common]}]).
+
+%% ====================
+%% Have the base server reject a decent CER with the protocol error
+%% DIAMETER_UNKNOWN_PEER = 3010.
+
+s_unknown_peer(Config) ->
+ server_reject(Config, fun base/1, 3010).
+
+c_unknown_peer(Config) ->
+ true = diameter:subscribe(?CLIENT),
+ OH = ?HOST("base-srv"),
+
+ {CRef, _} = base(Config),
+
+ {'CEA', ?caps{},
+ ?packet{msg = ?answer_message{'Origin-Host' = OH,
+ 'Result-Code' = 3010}}}
+ = client_recv(CRef).
+
+base(Config) ->
+ connect(Config, base, []).
+
+%% ====================
+%% Have the base server reject a decent CER with the non-protocol
+%% error DIAMETER_UNABLE_TO_COMPLY = 5012.
+
+s_unable(Config) ->
+ server_reject(Config, fun base/1, 5012).
+
+c_unable(Config) ->
+ client_closed(Config, "base-srv", fun base/1, 5012).
+
+%% ====================
+%% Have the client reject a decent CEA.
+
+s_client_reject(Config) ->
+ true = diameter:subscribe(?SERVER),
+ OH = host(Config),
+
+ {_, LRef} = client_reject(Config),
+
+ receive
+ ?event{service = ?SERVER,
+ info = {up, LRef,
+ {_, ?caps{origin_host = {_, OH}}},
+ {listen, _},
+ ?packet{}}}
+ = Info ->
+ Info
+ after 2000 ->
+ fail({LRef, OH})
+ end.
+
+c_client_reject(Config) ->
+ true = diameter:subscribe(?CLIENT),
+ OH = ?HOST("acct-srv"),
+
+ {CRef, _} = client_reject(Config),
+
+ {'CEA', {capabilities_cb, _, discard},
+ ?caps{origin_host = {_, OH}},
+ ?packet{msg = ?cea{'Result-Code' = 2001}}}
+ = client_recv(CRef).
+
+client_reject(Config) ->
+ connect(Config, acct, [{capabilities_cb, fun client_capx/2}]).
+
+%% ===========================================================================
+
+%% server_closed/3
+
+server_closed(Config, F, RC) ->
+ true = diameter:subscribe(?SERVER),
+ OH = host(Config),
+
+ {_, LRef} = F(Config),
+
+ receive
+ ?event{service = ?SERVER,
+ info = {closed, LRef,
+ {'CER', RC,
+ ?caps{origin_host = {_, OH}},
+ ?packet{}}
+ = Reason,
+ {listen, _}}} ->
+ Reason
+ after 2000 ->
+ fail({LRef, OH})
+ end.
+
+%% server_reject/3
+
+server_reject(Config, F, RC) ->
+ true = diameter:subscribe(?SERVER),
+ OH = host(Config),
+
+ {_, LRef} = F(Config),
+
+ receive
+ ?event{service = ?SERVER,
+ info = {closed, LRef,
+ {'CER', {capabilities_cb, _, RC},
+ ?caps{origin_host = {_, OH}},
+ ?packet{}}
+ = Reason,
+ {listen, _}}} ->
+ Reason
+ after 2000 ->
+ fail({LRef, OH})
+ end.
+
+%% cliient_closed/4
+
+client_closed(Config, Host, F, RC) ->
+ true = diameter:subscribe(?CLIENT),
+ OH = ?HOST(Host),
+
+ {CRef, _} = F(Config),
+
+ {'CEA', RC, ?caps{origin_host = {_, OH}}, ?packet{}}
+ = client_recv(CRef).
+
+%% client_recv/1
+
+client_recv(CRef) ->
+ receive
+ ?event{service = ?CLIENT,
+ info = {closed, CRef, Reason, {connect, _}}} ->
+ Reason
+ after 2000 ->
+ fail(CRef)
+ end.
+
+%% server_capx/3
+
+server_capx(_, ?caps{origin_host = {_, [_,$_|"unknown_peer." ++ _]}}, _) ->
+ unknown;
+
+server_capx(_, ?caps{origin_host = {_, [_,$_|"unable." ++ _]}}, _) ->
+ 5012; %% DIAMETER_UNABLE_TO_COMPLY
+
+server_capx(_, ?caps{origin_host = {OH,DH}}, _) ->
+ io:format("connection: ~p -> ~p~n", [DH,OH]),
+ ok.
+
+%% client_capx/2
+
+client_capx(_, ?caps{origin_host = {[_,$_|"client_reject." ++ _], _}}) ->
+ discard.
+
+%% ===========================================================================
+
+fail(T) ->
+ erlang:error({T, process_info(self(), messages)}).
+
+host(Config) ->
+ {_, H} = lists:keyfind(host, 1, Config),
+ ?HOST(H).
+
+listen(Name, Opts) ->
+ ?util:listen(Name, tcp, Opts).
+
+connect(Config, T, Opts) ->
+ {_, H} = lists:keyfind(host, 1, Config),
+ LRef = lref(Config, T),
+ CRef = connect(LRef, [{capabilities, [{'Origin-Host', ?HOST(H)}]}
+ | Opts]),
+ Name = lists:takewhile(fun(C) -> C /= $. end, H),
+ ?util:write_priv(Config, Name, CRef), %% end_per_testcase reads
+ {CRef, LRef}.
+
+connect(LRef, Opts) ->
+ [PortNr] = ?util:lport(tcp, LRef, 20),
+ {ok, CRef} = diameter:add_transport(?CLIENT,
+ {connect, opts(PortNr, Opts)}),
+ CRef.
+
+opts(PortNr, Opts) ->
+ [{transport_module, diameter_tcp},
+ {transport_config, [{raddr, ?ADDR},
+ {rport, PortNr},
+ {ip, ?ADDR},
+ {port, 0}]}
+ | Opts].
+
+lref(Config, T) ->
+ case ?util:read_priv(Config, ?MODULE) of
+ {LRef, _} when T == base ->
+ LRef;
+ {_, LRef} when T == acct ->
+ LRef
+ end.
+
+%% ===========================================================================
+%% diameter callbacks
+
+peer_up(?SERVER,
+ {_, ?caps{origin_host = {"acct-srv." ++ _,
+ [_,$_|"client_reject." ++ _]}}},
+ State,
+ _) ->
+ State.
+
+peer_down(?SERVER,
+ {_, ?caps{origin_host = {"acct-srv." ++ _,
+ [_,$_|"client_reject." ++ _]}}},
+ State,
+ _) ->
+ State.
diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl
index aab7ab35cc..8046ca4c04 100644
--- a/lib/diameter/test/diameter_codec_test.erl
+++ b/lib/diameter/test/diameter_codec_test.erl
@@ -25,7 +25,7 @@
%% Test encode/decode of dictionary-related modules.
%%
--include_lib("diameter/include/diameter.hrl").
+-include("diameter.hrl").
-define(BASE, diameter_gen_base_rfc3588).
-define(BOOL, [true, false]).
diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl
index c25e9682f0..f4d62f94c6 100644
--- a/lib/diameter/test/diameter_failover_SUITE.erl
+++ b/lib/diameter/test/diameter_failover_SUITE.erl
@@ -57,13 +57,8 @@
handle_error/4,
handle_request/3]).
--ifdef(DIAMETER_CT).
+-include("diameter.hrl").
-include("diameter_gen_base_rfc3588.hrl").
--else.
--include_lib("diameter/include/diameter_gen_base_rfc3588.hrl").
--endif.
-
--include_lib("diameter/include/diameter.hrl").
-include("diameter_ct.hrl").
%% ===========================================================================
diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl
index 03f1115496..40cbdf805a 100644
--- a/lib/diameter/test/diameter_relay_SUITE.erl
+++ b/lib/diameter/test/diameter_relay_SUITE.erl
@@ -64,13 +64,8 @@
handle_error/4,
handle_request/3]).
--ifdef(DIAMETER_CT).
+-include("diameter.hrl").
-include("diameter_gen_base_rfc3588.hrl").
--else.
--include_lib("diameter/include/diameter_gen_base_rfc3588.hrl").
--endif.
-
--include_lib("diameter/include/diameter.hrl").
-include("diameter_ct.hrl").
%% ===========================================================================
diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl
index 99f92ca0e0..127e3435dc 100644
--- a/lib/diameter/test/diameter_tls_SUITE.erl
+++ b/lib/diameter/test/diameter_tls_SUITE.erl
@@ -67,13 +67,8 @@
handle_error/4,
handle_request/3]).
--ifdef(DIAMETER_CT).
+-include("diameter.hrl").
-include("diameter_gen_base_rfc3588.hrl").
--else.
--include_lib("diameter/include/diameter_gen_base_rfc3588.hrl").
--endif.
-
--include_lib("diameter/include/diameter.hrl").
-include("diameter_ct.hrl").
%% ===========================================================================
diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl
index 6704f24532..55c5fc7c54 100644
--- a/lib/diameter/test/diameter_traffic_SUITE.erl
+++ b/lib/diameter/test/diameter_traffic_SUITE.erl
@@ -87,13 +87,8 @@
handle_error/5,
handle_request/3]).
--ifdef(DIAMETER_CT).
+-include("diameter.hrl").
-include("diameter_gen_base_rfc3588.hrl").
--else.
--include_lib("diameter/include/diameter_gen_base_rfc3588.hrl").
--endif.
-
--include_lib("diameter/include/diameter.hrl").
-include("diameter_ct.hrl").
%% ===========================================================================
@@ -251,7 +246,7 @@ start_services(_Config) ->
ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)).
add_transports(Config) ->
- LRef = ?util:listen(?SERVER, tcp),
+ LRef = ?util:listen(?SERVER, tcp, [{capabilities_cb, fun capx/2}]),
CRef = ?util:connect(?CLIENT, tcp, LRef),
?util:write_priv(Config, "transport", {LRef, CRef}).
@@ -266,6 +261,10 @@ stop_services(_Config) ->
stop(_Config) ->
ok = diameter:stop().
+capx(_, #diameter_caps{origin_host = {OH,DH}}) ->
+ io:format("connection: ~p -> ~p~n", [DH,OH]),
+ ok.
+
%% ===========================================================================
%% Ensure that result codes have the expected values.
diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl
index a9520ef5bd..c22adc3334 100644
--- a/lib/diameter/test/diameter_transport_SUITE.erl
+++ b/lib/diameter/test/diameter_transport_SUITE.erl
@@ -45,7 +45,7 @@
init/2]).
-include_lib("kernel/include/inet_sctp.hrl").
--include_lib("diameter/include/diameter.hrl").
+-include("diameter.hrl").
-include("diameter_ct.hrl").
-define(util, diameter_util).
diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl
index 3fe8ea5363..6b1dc1f0c9 100644
--- a/lib/diameter/test/diameter_util.erl
+++ b/lib/diameter/test/diameter_util.erl
@@ -33,8 +33,8 @@
%% diameter-specific
-export([lport/2,
lport/3,
- listen/2,
- connect/3,
+ listen/2, listen/3,
+ connect/3, connect/4,
disconnect/4]).
%% common_test-specific
@@ -254,22 +254,28 @@ lp(M, Ref, T) ->
end.
%% ---------------------------------------------------------------------------
-%% listen/2
+%% listen/2-3
%%
%% Add a listening transport on the loopback address and a free port.
listen(SvcName, Prot) ->
- add_transport(SvcName, {listen, opts(Prot, listen)}).
+ listen(SvcName, Prot, []).
+
+listen(SvcName, Prot, Opts) ->
+ add_transport(SvcName, {listen, opts(Prot, listen) ++ Opts}).
%% ---------------------------------------------------------------------------
-%% connect/3
+%% connect/2-3
%%
%% Add a connecting transport on and connect to a listening transport
%% with the specified reference.
connect(Client, Prot, LRef) ->
+ connect(Client, Prot, LRef, []).
+
+connect(Client, Prot, LRef, Opts) ->
[PortNr] = lport(Prot, LRef, 20),
- Ref = add_transport(Client, {connect, opts(Prot, PortNr)}),
+ Ref = add_transport(Client, {connect, opts(Prot, PortNr) ++ Opts}),
true = diameter:subscribe(Client),
ok = receive
{diameter_event, Client, {up, Ref, _, _, _}} -> ok
diff --git a/lib/diameter/test/diameter_watchdog_SUITE.erl b/lib/diameter/test/diameter_watchdog_SUITE.erl
index dec307529a..b40d7c104d 100644
--- a/lib/diameter/test/diameter_watchdog_SUITE.erl
+++ b/lib/diameter/test/diameter_watchdog_SUITE.erl
@@ -36,7 +36,7 @@
id/1, %% jitter callback
run/1]).
--include_lib("diameter/include/diameter.hrl").
+-include("diameter.hrl").
-include("diameter_ct.hrl").
%% ===========================================================================
diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk
index 75fdd0bd1d..f88258c232 100644
--- a/lib/diameter/test/modules.mk
+++ b/lib/diameter/test/modules.mk
@@ -33,6 +33,7 @@ MODULES = \
diameter_stats_SUITE \
diameter_watchdog_SUITE \
diameter_transport_SUITE \
+ diameter_capx_SUITE \
diameter_traffic_SUITE \
diameter_relay_SUITE \
diameter_tls_SUITE \
diff --git a/lib/diameter/test/release.sed b/lib/diameter/test/release.sed
new file mode 100644
index 0000000000..2720b778f2
--- /dev/null
+++ b/lib/diameter/test/release.sed
@@ -0,0 +1,35 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2010-2011. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+#
+# This bit of gymnastics is to replace the include of diameter's
+# public hrls by include_lib when releasing testsuites, so that they
+# compile both in the development filesystem (where generated hrls
+# aren't in diameter/include) and with common_test's autocompilation
+# on an installed release. Solving the problem by installing generated
+# hrls to ../include is anathema: that directory is for handwritten
+# source.)
+#
+
+/^-include("/!b
+/"diameter_gen_/b s
+/"diameter\./!b
+
+:s
+s@("@_lib&diameter/include/@
diff --git a/lib/megaco/doc/src/notes.xml b/lib/megaco/doc/src/notes.xml
index dfbc5895d1..baf8c6a201 100644
--- a/lib/megaco/doc/src/notes.xml
+++ b/lib/megaco/doc/src/notes.xml
@@ -55,6 +55,13 @@
</item>
<item>
+ <p>ASN.1 no longer makes use of a driver to accelerate encode/decode,
+ instead it uses NIFs. The encoding config option is <em>still</em>
+ the same, i.e. <c>driver</c>. </p>
+ <p>Own Id: OTP-9672</p>
+ </item>
+
+ <item>
<p>The profiling test tool has been rewritten. </p>
<p>H&aring;kan Mattsson</p>
<p>Own Id: OTP-9679</p>
diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml
index 8ef573a948..1bb80f8fe3 100644
--- a/lib/mnesia/doc/src/notes.xml
+++ b/lib/mnesia/doc/src/notes.xml
@@ -38,7 +38,35 @@
thus constitutes one section in this document. The title of each
section is the version number of Mnesia.</p>
- <section><title>Mnesia 4.5</title>
+ <section><title>Mnesia 4.5.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix deadlock in mnesia:del_table_copy/2.</p>
+ <p>
+ Own Id: OTP-9689 Aux Id: seq11927 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Allow schema operations when using different mnesia
+ versions.</p>
+ <p>
+ Own Id: OTP-9657 Aux Id: seq11926 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Mnesia 4.5</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/mnesia/src/mnesia.appup.src b/lib/mnesia/src/mnesia.appup.src
index fe4e5e2e7a..e0954ad206 100644
--- a/lib/mnesia/src/mnesia.appup.src
+++ b/lib/mnesia/src/mnesia.appup.src
@@ -1,12 +1,14 @@
%% -*- erlang -*-
-{"%VSN%",
+{"%VSN%",
[
+ {"4.5", [{restart_application, mnesia}]},
{"4.4.19", [{restart_application, mnesia}]},
{"4.4.18", [{restart_application, mnesia}]},
{"4.4.17", [{restart_application, mnesia}]},
{"4.4.16", [{restart_application, mnesia}]}
],
[
+ {"4.5", [{restart_application, mnesia}]},
{"4.4.19", [{restart_application, mnesia}]},
{"4.4.18", [{restart_application, mnesia}]},
{"4.4.17", [{restart_application, mnesia}]},
diff --git a/lib/mnesia/src/mnesia_bup.erl b/lib/mnesia/src/mnesia_bup.erl
index 47dcdad7ac..14414537b9 100644
--- a/lib/mnesia/src/mnesia_bup.erl
+++ b/lib/mnesia/src/mnesia_bup.erl
@@ -372,7 +372,9 @@ mk_str() ->
lists:concat([node()] ++ Now ++ ".TMP").
make_initial_backup(Ns, Opaque, Mod) ->
- Schema = [{schema, schema, mnesia_schema:get_initial_schema(disc_copies, Ns)}],
+ Orig = mnesia_schema:get_initial_schema(disc_copies, Ns),
+ Modded = proplists:delete(storage_properties, proplists:delete(majority, Orig)),
+ Schema = [{schema, schema, Modded}],
O2 = do_apply(Mod, open_write, [Opaque], Opaque),
O3 = do_apply(Mod, write, [O2, [mnesia_log:backup_log_header()]], O2),
O4 = do_apply(Mod, write, [O3, Schema], O3),
diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl
index 1d3bd55b48..6a561394d5 100644
--- a/lib/mnesia/src/mnesia_controller.erl
+++ b/lib/mnesia/src/mnesia_controller.erl
@@ -289,40 +289,7 @@ get_remote_cstructs() ->
get_cstructs() ->
{cstructs, Cstructs, Running} = call(get_cstructs),
Node = node(group_leader()),
- {cstructs, normalize_cstructs(Cstructs, Node), Running}.
-
-normalize_cstructs(Cstructs, Node) ->
- %% backward-compatibility hack; normalize before returning
- case rpc:call(Node, mnesia_lib, val, [{schema,cstruct}]) of
- {badrpc, _} ->
- %% assume it's not a schema merge
- Cstructs;
- #cstruct{} ->
- %% same format
- Cstructs;
- Cstruct ->
- %% some other format
- RemoteFields = [F || {F,_} <- rpc:call(Node, mnesia_schema, cs2list, [Cstruct])],
- [convert_cs(Cs, RemoteFields) || Cs <- Cstructs]
- end.
-
-convert_cs(Cs, Fields) ->
- MyFields = record_info(fields, cstruct),
- convert(tl(tuple_to_list(Cs)), MyFields, Fields, []).
-
-convert([H|T], [F|FsL], [F|FsR], Acc) ->
- convert(T, FsL, FsR, [H|Acc]);
-convert([H|T], [Fl|FsL] = L, [Fr|FsR] = R, Acc) ->
- case {lists:member(Fl, FsR), lists:member(Fr, FsL)} of
- {true, false} ->
- convert(T, L, FsR, [H|Acc]);
- {false, true} ->
- %% Field Fl doesn't exist on receiver side; skip.
- convert(T, FsL, R, Acc)
- end;
-convert([], _, _, Acc) ->
- list_to_tuple([cstruct|lists:reverse(Acc)]).
-
+ {cstructs, mnesia_schema:normalize_cs(Cstructs, Node), Running}.
update(Fun) ->
call({update,Fun}).
diff --git a/lib/mnesia/src/mnesia_event.erl b/lib/mnesia/src/mnesia_event.erl
index ec6b99ecaa..5a060a28ff 100644
--- a/lib/mnesia/src/mnesia_event.erl
+++ b/lib/mnesia/src/mnesia_event.erl
@@ -121,7 +121,7 @@ handle_system_event({mnesia_up, Node}, State) ->
{ok, State#state{nodes = Nodes}};
handle_system_event({mnesia_down, Node}, State) ->
- case mnesia:system_info(fallback_activated) of
+ case mnesia:system_info(fallback_activated) andalso Node =/= node() of
true ->
case mnesia_monitor:get_env(fallback_error_function) of
{mnesia, lkill} ->
@@ -129,8 +129,8 @@ handle_system_event({mnesia_down, Node}, State) ->
"must be restarted. Forcing shutdown "
"after mnesia_down from ~p...~n",
report_fatal(Msg, [Node], nocore, State#state.dumped_core),
- mnesia:lkill(),
- exit(fatal);
+ catch exit(whereis(mnesia_monitor), fatal),
+ {ok, State};
{UserMod, UserFunc} ->
Msg = "Warning: A fallback is installed and Mnesia got mnesia_down "
"from ~p. ~n",
diff --git a/lib/mnesia/src/mnesia_frag.erl b/lib/mnesia/src/mnesia_frag.erl
index 9e77fe0b9f..4a1616e054 100644
--- a/lib/mnesia/src/mnesia_frag.erl
+++ b/lib/mnesia/src/mnesia_frag.erl
@@ -758,7 +758,7 @@ make_activate(Tab, Props) ->
[] ->
Cs2 = Cs#cstruct{frag_properties = Props},
[Cs3] = expand_cstruct(Cs2, activate),
- TabDef = mnesia_schema:cs2list(Cs3),
+ TabDef = mnesia_schema:vsn_cs2list(Cs3),
Op = {op, change_table_frag, activate, TabDef},
[[Op]];
BadProps ->
@@ -783,7 +783,7 @@ make_deactivate(Tab) ->
mnesia:abort({combine_error, Tab, "Too many fragments"});
true ->
Cs2 = Cs#cstruct{frag_properties = []},
- TabDef = mnesia_schema:cs2list(Cs2),
+ TabDef = mnesia_schema:vsn_cs2list(Cs2),
Op = {op, change_table_frag, deactivate, TabDef},
[[Op]]
end.
@@ -850,7 +850,7 @@ make_add_frag(Tab, SortedNs) ->
SplitOps = split(Tab, FH2, FromIndecies, FragNames, []),
Cs2 = replace_frag_hash(Cs, FH2),
- TabDef = mnesia_schema:cs2list(Cs2),
+ TabDef = mnesia_schema:vsn_cs2list(Cs2),
BaseOp = {op, change_table_frag, {add_frag, SortedNs}, TabDef},
[BaseOp, NewOp | SplitOps].
@@ -962,7 +962,7 @@ make_del_frag(Tab) ->
LastFrag = element(N, FragNames),
[LastOp] = mnesia_schema:make_delete_table(LastFrag, single_frag),
Cs2 = replace_frag_hash(Cs, FH2),
- TabDef = mnesia_schema:cs2list(Cs2),
+ TabDef = mnesia_schema:vsn_cs2list(Cs2),
BaseOp = {op, change_table_frag, del_frag, TabDef},
[BaseOp, LastOp | MergeOps];
_ ->
@@ -1075,7 +1075,7 @@ make_add_node(Tab, Node) when is_atom(Node) ->
Props = Cs#cstruct.frag_properties,
Props2 = lists:keyreplace(node_pool, 1, Props, {node_pool, Pool2}),
Cs2 = Cs#cstruct{frag_properties = Props2},
- TabDef = mnesia_schema:cs2list(Cs2),
+ TabDef = mnesia_schema:vsn_cs2list(Cs2),
Op = {op, change_table_frag, {add_node, Node}, TabDef},
[Op];
true ->
@@ -1104,7 +1104,7 @@ make_del_node(Tab, Node) when is_atom(Node) ->
Pool2 = Pool -- [Node],
Props = lists:keyreplace(node_pool, 1, Cs#cstruct.frag_properties, {node_pool, Pool2}),
Cs2 = Cs#cstruct{frag_properties = Props},
- TabDef = mnesia_schema:cs2list(Cs2),
+ TabDef = mnesia_schema:vsn_cs2list(Cs2),
Op = {op, change_table_frag, {del_node, Node}, TabDef},
[Op];
false ->
diff --git a/lib/mnesia/src/mnesia_monitor.erl b/lib/mnesia/src/mnesia_monitor.erl
index e110ad3241..8cb2e92c08 100644
--- a/lib/mnesia/src/mnesia_monitor.erl
+++ b/lib/mnesia/src/mnesia_monitor.erl
@@ -536,7 +536,11 @@ handle_info({'EXIT', Pid, R}, State) when Pid == State#state.supervisor ->
handle_info({'EXIT', Pid, fatal}, State) when node(Pid) == node() ->
dbg_out("~p got FATAL ERROR from: ~p~n",[?MODULE, Pid]),
- exit(State#state.supervisor, shutdown),
+ %% This may hang supervisor if a shutdown happens at the same time as an fatal
+ %% is in progress
+ %% exit(State#state.supervisor, shutdown),
+ %% It is better to kill an innocent process
+ catch exit(whereis(mnesia_locker), kill),
{noreply, State};
handle_info(Msg = {'EXIT',Pid,_}, State) ->
diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl
index 05be474aea..179e15197e 100644
--- a/lib/mnesia/src/mnesia_schema.erl
+++ b/lib/mnesia/src/mnesia_schema.erl
@@ -39,9 +39,10 @@
change_table_load_order/2,
change_table_majority/2,
change_table_frag/2,
- clear_table/1,
+%% clear_table/1, %% removed since it is not a schema op anymore
create_table/1,
cs2list/1,
+ vsn_cs2list/1,
del_snmp/1,
del_table_copy/2,
del_table_index/2,
@@ -65,6 +66,7 @@
merge_schema/0,
merge_schema/1,
move_table/3,
+ normalize_cs/2,
opt_create_dir/2,
prepare_commit/3,
purge_dir/2,
@@ -626,6 +628,17 @@ do_insert_schema_ops(Store, [Head | Tail]) ->
do_insert_schema_ops(_Store, []) ->
ok.
+api_list2cs(List) when is_list(List) ->
+ Name = pick(unknown, name, List, must),
+ Keys = check_keys(Name, List, record_info(fields, cstruct)),
+ check_duplicates(Name, Keys),
+ list2cs(List);
+api_list2cs(Other) ->
+ mnesia:abort({badarg, Other}).
+
+vsn_cs2list(Cs) ->
+ cs2list(need_old_cstructs(), Cs).
+
cs2list(Cs) when is_record(Cs, cstruct) ->
Tags = record_info(fields, cstruct),
rec2list(Tags, Tags, 2, Cs);
@@ -648,7 +661,7 @@ cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 17 ->
cs2list(false, Cs) ->
cs2list(Cs);
-cs2list(ver4_4_18, Cs) ->
+cs2list(ver4_4_18, Cs) -> %% Or earlier
Orig = record_info(fields, cstruct),
Tags = [name,type,ram_copies,disc_copies,disc_only_copies,
load_order,access_mode,index,snmp,local_content,
@@ -671,13 +684,19 @@ rec2list([], _, _Pos, _Rec) ->
rec2list(Tags, [_|Orig], Pos, Rec) ->
rec2list(Tags, Orig, Pos+1, Rec).
-api_list2cs(List) when is_list(List) ->
- Name = pick(unknown, name, List, must),
- Keys = check_keys(Name, List, record_info(fields, cstruct)),
- check_duplicates(Name, Keys),
- list2cs(List);
-api_list2cs(Other) ->
- mnesia:abort({badarg, Other}).
+normalize_cs(Cstructs, Node) ->
+ %% backward-compatibility hack; normalize before returning
+ case need_old_cstructs([Node]) of
+ false ->
+ Cstructs;
+ Version ->
+ %% some other format
+ [convert_cs(Version, Cs) || Cs <- Cstructs]
+ end.
+
+convert_cs(Version, Cs) ->
+ Fields = [Value || {_, Value} <- cs2list(Version, Cs)],
+ list_to_tuple([cstruct|Fields]).
list2cs(List) when is_list(List) ->
Name = pick(unknown, name, List, must),
@@ -1048,7 +1067,7 @@ unsafe_make_create_table(Cs) ->
Nodes = mnesia_lib:intersect(mnesia_lib:cs_to_nodes(Cs), RunningNodes),
Store = Ts#tidstore.store,
mnesia_locker:wlock_no_exist(Tid, Store, Tab, Nodes),
- [{op, create_table, cs2list(Cs)}].
+ [{op, create_table, vsn_cs2list(Cs)}].
check_if_exists(Tab) ->
TidTs = get_tid_ts_and_lock(schema, write),
@@ -1133,7 +1152,7 @@ make_delete_table2(Tab) ->
Cs = val({Tab, cstruct}),
ensure_active(Cs),
ensure_writable(Tab),
- {op, delete_table, cs2list(Cs)}.
+ {op, delete_table, vsn_cs2list(Cs)}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Change fragmentation of a table
@@ -1152,10 +1171,6 @@ do_change_table_frag(Tab, _Change) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Clear a table
-%% No need for a schema transaction
-clear_table(Tab) ->
- schema_transaction(fun() -> do_clear_table(Tab) end).
-
do_clear_table(schema) ->
mnesia:abort({bad_type, schema});
do_clear_table(Tab) ->
@@ -1166,7 +1181,7 @@ do_clear_table(Tab) ->
make_clear_table(Tab) ->
Cs = val({Tab, cstruct}),
ensure_writable(Tab),
- [{op, clear_table, cs2list(Cs)}].
+ [{op, clear_table, vsn_cs2list(Cs)}].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1206,7 +1221,7 @@ make_add_table_copy(Tab, Node, Storage) ->
IsRunning == false ->
mnesia:abort({not_active, schema, Node})
end,
- [{op, add_table_copy, Storage, Node, cs2list(Cs2)}].
+ [{op, add_table_copy, Storage, Node, vsn_cs2list(Cs2)}].
del_table_copy(Tab, Node) ->
schema_transaction(fun() -> do_del_table_copy(Tab, Node) end).
@@ -1235,11 +1250,11 @@ make_del_table_copy(Tab, Node) ->
ensure_not_active(Tab, Node),
verify_cstruct(Cs2),
Ops = remove_node_from_tabs(val({schema, tables}), Node),
- [{op, del_table_copy, ram_copies, Node, cs2list(Cs2)} | Ops];
+ [{op, del_table_copy, ram_copies, Node, vsn_cs2list(Cs2)} | Ops];
_ ->
ensure_active(Cs),
verify_cstruct(Cs2),
- [{op, del_table_copy, Storage, Node, cs2list(Cs2)}]
+ [{op, del_table_copy, Storage, Node, vsn_cs2list(Cs2)}]
end.
remove_node_from_tabs([], _Node) ->
@@ -1253,7 +1268,7 @@ remove_node_from_tabs([Tab|Rest], Node) ->
unknown ->
case IsFragModified of
true ->
- [{op, change_table_frag, {del_node, Node}, cs2list(Cs)} |
+ [{op, change_table_frag, {del_node, Node}, vsn_cs2list(Cs)} |
remove_node_from_tabs(Rest, Node)];
false ->
remove_node_from_tabs(Rest, Node)
@@ -1262,11 +1277,11 @@ remove_node_from_tabs([Tab|Rest], Node) ->
Cs2 = new_cs(Cs, Node, Storage, del),
case mnesia_lib:cs_to_nodes(Cs2) of
[] ->
- [{op, delete_table, cs2list(Cs)} |
+ [{op, delete_table, vsn_cs2list(Cs)} |
remove_node_from_tabs(Rest, Node)];
_Ns ->
verify_cstruct(Cs2),
- [{op, del_table_copy, ram_copies, Node, cs2list(Cs2)}|
+ [{op, del_table_copy, ram_copies, Node, vsn_cs2list(Cs2)}|
remove_node_from_tabs(Rest, Node)]
end
end.
@@ -1318,9 +1333,9 @@ make_move_table(Tab, FromNode, ToNode) ->
Cs2 = new_cs(Cs, ToNode, Storage, add),
Cs3 = new_cs(Cs2, FromNode, Storage, del),
verify_cstruct(Cs3),
- [{op, add_table_copy, Storage, ToNode, cs2list(Cs2)},
+ [{op, add_table_copy, Storage, ToNode, vsn_cs2list(Cs2)},
{op, sync_trans},
- {op, del_table_copy, Storage, FromNode, cs2list(Cs3)}].
+ {op, del_table_copy, Storage, FromNode, vsn_cs2list(Cs3)}].
%% end of functions to add and delete nodes to tables
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1357,7 +1372,7 @@ make_change_table_copy_type(Tab, Node, ToS) ->
Cs3 = new_cs(Cs2, Node, ToS, add),
verify_cstruct(Cs3),
- [{op, change_table_copy_type, Node, FromS, ToS, cs2list(Cs3)}].
+ [{op, change_table_copy_type, Node, FromS, ToS, vsn_cs2list(Cs3)}].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% change index functions ....
@@ -1383,7 +1398,7 @@ make_add_table_index(Tab, Pos) ->
Ix2 = lists:sort([Pos | Ix]),
Cs2 = Cs#cstruct{index = Ix2},
verify_cstruct(Cs2),
- [{op, add_index, Pos, cs2list(Cs2)}].
+ [{op, add_index, Pos, vsn_cs2list(Cs2)}].
del_table_index(Tab, Pos) ->
schema_transaction(fun() -> do_del_table_index(Tab, Pos) end).
@@ -1404,7 +1419,7 @@ make_del_table_index(Tab, Pos) ->
verify(true, lists:member(Pos, Ix), {no_exists, Tab, Pos}),
Cs2 = Cs#cstruct{index = lists:delete(Pos, Ix)},
verify_cstruct(Cs2),
- [{op, del_index, Pos, cs2list(Cs2)}].
+ [{op, del_index, Pos, vsn_cs2list(Cs2)}].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1427,7 +1442,7 @@ make_add_snmp(Tab, Ustruct) ->
verify(true, mnesia_snmp_hook:check_ustruct(Ustruct), Error),
Cs2 = Cs#cstruct{snmp = Ustruct},
verify_cstruct(Cs2),
- [{op, add_snmp, Ustruct, cs2list(Cs2)}].
+ [{op, add_snmp, Ustruct, vsn_cs2list(Cs2)}].
del_snmp(Tab) ->
schema_transaction(fun() -> do_del_snmp(Tab) end).
@@ -1445,7 +1460,7 @@ make_del_snmp(Tab) ->
ensure_active(Cs),
Cs2 = Cs#cstruct{snmp = []},
verify_cstruct(Cs2),
- [{op, del_snmp, cs2list(Cs2)}].
+ [{op, del_snmp, vsn_cs2list(Cs2)}].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
@@ -1477,26 +1492,26 @@ make_transform(Tab, Fun, NewAttrs, NewRecName) ->
[] ->
Cs2 = Cs#cstruct{attributes = NewAttrs, record_name = NewRecName},
verify_cstruct(Cs2),
- [{op, transform, Fun, cs2list(Cs2)}];
+ [{op, transform, Fun, vsn_cs2list(Cs2)}];
PosList ->
DelIdx = fun(Pos, Ncs) ->
Ix = Ncs#cstruct.index,
Ncs1 = Ncs#cstruct{index = lists:delete(Pos, Ix)},
- Op = {op, del_index, Pos, cs2list(Ncs1)},
+ Op = {op, del_index, Pos, vsn_cs2list(Ncs1)},
{Op, Ncs1}
end,
AddIdx = fun(Pos, Ncs) ->
Ix = Ncs#cstruct.index,
Ix2 = lists:sort([Pos | Ix]),
Ncs1 = Ncs#cstruct{index = Ix2},
- Op = {op, add_index, Pos, cs2list(Ncs1)},
+ Op = {op, add_index, Pos, vsn_cs2list(Ncs1)},
{Op, Ncs1}
end,
{DelOps, Cs1} = lists:mapfoldl(DelIdx, Cs, PosList),
Cs2 = Cs1#cstruct{attributes = NewAttrs, record_name = NewRecName},
{AddOps, Cs3} = lists:mapfoldl(AddIdx, Cs2, PosList),
verify_cstruct(Cs3),
- lists:flatten([DelOps, {op, transform, Fun, cs2list(Cs2)}, AddOps])
+ lists:flatten([DelOps, {op, transform, Fun, vsn_cs2list(Cs2)}, AddOps])
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1520,7 +1535,7 @@ make_change_table_access_mode(Tab, Mode) ->
verify(false, OldMode == Mode, {already_exists, Tab, Mode}),
Cs2 = Cs#cstruct{access_mode = Mode},
verify_cstruct(Cs2),
- [{op, change_table_access_mode, cs2list(Cs2), OldMode, Mode}].
+ [{op, change_table_access_mode, vsn_cs2list(Cs2), OldMode, Mode}].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1541,7 +1556,7 @@ make_change_table_load_order(Tab, LoadOrder) ->
OldLoadOrder = Cs#cstruct.load_order,
Cs2 = Cs#cstruct{load_order = LoadOrder},
verify_cstruct(Cs2),
- [{op, change_table_load_order, cs2list(Cs2), OldLoadOrder, LoadOrder}].
+ [{op, change_table_load_order, vsn_cs2list(Cs2), OldLoadOrder, LoadOrder}].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1571,14 +1586,14 @@ make_change_table_majority(Tab, Majority) ->
ensure_active(CsT),
CsT2 = CsT#cstruct{majority = Majority},
verify_cstruct(CsT2),
- {op, change_table_majority, cs2list(CsT2),
+ {op, change_table_majority, vsn_cs2list(CsT2),
OldMajority, Majority}
end, FragNames);
false -> [];
{_, _} -> mnesia:abort({bad_type, Tab})
end,
verify_cstruct(Cs2),
- [{op, change_table_majority, cs2list(Cs2), OldMajority, Majority} | FragOps].
+ [{op, change_table_majority, vsn_cs2list(Cs2), OldMajority, Majority} | FragOps].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1619,7 +1634,7 @@ make_write_table_properties(Tab, [Prop | Props], Cs) ->
MergedProps = lists:merge(DelProps, [Prop]),
Cs2 = Cs#cstruct{user_properties = MergedProps},
verify_cstruct(Cs2),
- [{op, write_property, cs2list(Cs2), Prop} |
+ [{op, write_property, vsn_cs2list(Cs2), Prop} |
make_write_table_properties(Tab, Props, Cs2)];
make_write_table_properties(_Tab, [], _Cs) ->
[].
@@ -1740,7 +1755,7 @@ make_delete_table_properties(Tab, [PropKey | PropKeys], Cs) ->
Props = lists:keydelete(PropKey, 1, OldProps),
Cs2 = Cs#cstruct{user_properties = Props},
verify_cstruct(Cs2),
- [{op, delete_property, cs2list(Cs2), PropKey} |
+ [{op, delete_property, vsn_cs2list(Cs2), PropKey} |
make_delete_table_properties(Tab, PropKeys, Cs2)];
make_delete_table_properties(_Tab, [], _Cs) ->
[].
@@ -2166,12 +2181,17 @@ receive_sync(Nodes, Pids) ->
{abort, Else}
end.
-lock_del_table(Tab, Node, Cs, Father) ->
+lock_del_table(Tab, NewNode, Cs0, Father) ->
Ns = val({schema, active_replicas}),
process_flag(trap_exit,true),
Lock = fun() ->
mnesia:write_lock_table(Tab),
- {Res, []} = rpc:multicall(Ns, ?MODULE, set_where_to_read, [Tab, Node, Cs]),
+ %% Sigh using cs record
+ Set = fun(Node) ->
+ [Cs] = normalize_cs([Cs0], Node),
+ rpc:call(Node, ?MODULE, set_where_to_read, [Tab, NewNode, Cs])
+ end,
+ Res = [Set(Node) || Node <- Ns],
Filter = fun(ok) ->
false;
({badrpc, {'EXIT', {undef, _}}}) ->
@@ -2353,11 +2373,12 @@ undo_prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}) ->
undo_prepare_op(_Tid, {op, del_table_copy, _, Node, TabDef})
when Node == node() ->
+ WriteLocker = get(mnesia_lock),
+ WriteLocker =/= undefined andalso (WriteLocker ! die),
Cs = list2cs(TabDef),
Tab = Cs#cstruct.name,
mnesia_lib:set({Tab, where_to_read}, Node);
-
undo_prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef})
when N == node() ->
Cs = list2cs(TabDef),
@@ -2829,6 +2850,9 @@ fetch_cstructs(Node) ->
rpc:call(Node, mnesia_controller, get_remote_cstructs, [])
end.
+need_old_cstructs() ->
+ need_old_cstructs(val({schema, where_to_write})).
+
need_old_cstructs(Nodes) ->
Filter = fun(Node) -> not mnesia_monitor:needs_protocol_conversion(Node) end,
case lists:dropwhile(Filter, Nodes) of
diff --git a/lib/mnesia/test/mnesia_evil_backup.erl b/lib/mnesia/test/mnesia_evil_backup.erl
index 63f4146d98..9e0a8db1ae 100644
--- a/lib/mnesia/test/mnesia_evil_backup.erl
+++ b/lib/mnesia/test/mnesia_evil_backup.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -244,9 +244,9 @@ restore(Config, Op) ->
[rpc:call(Node, ?MODULE, check_tab, [Res31, ?LINE]) || Node <- Nodes],
%% Restore all tables on it's nodes
- mnesia_schema:clear_table(Tab1),
- mnesia_schema:clear_table(Tab2),
- mnesia_schema:clear_table(Tab3),
+ mnesia:clear_table(Tab1),
+ mnesia:clear_table(Tab2),
+ mnesia:clear_table(Tab3),
[mnesia:dirty_write({Tab1, N, N+1}) || N <- lists:seq(1, 11)],
[mnesia:dirty_write({Tab2, N, N+1}) || N <- lists:seq(1, 11)],
[mnesia:dirty_write({Tab3, N, N+1}) || N <- lists:seq(1, 11)],
diff --git a/lib/mnesia/test/mnesia_evil_coverage_test.erl b/lib/mnesia/test/mnesia_evil_coverage_test.erl
index 668eba176f..17d6c6c212 100644
--- a/lib/mnesia/test/mnesia_evil_coverage_test.erl
+++ b/lib/mnesia/test/mnesia_evil_coverage_test.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -1795,7 +1795,7 @@ subscribe_extended(Config) when is_list(Config) ->
?match({mnesia_table_event, {delete, schema, {schema, Tab1}, [{schema, Tab1, _}],_}}, recv_event()),
?match({mnesia_table_event, {write, schema, {schema, Tab1, _}, [], _}}, recv_event()),
- ?match({atomic, ok}, mnesia_schema:clear_table(Tab2)),
+ ?match({atomic, ok}, mnesia:clear_table(Tab2)),
?match({mnesia_table_event, {delete, schema, {schema, Tab2}, [{schema, Tab2, _}],_}},
recv_event()),
?match({mnesia_table_event, {write, schema, {schema, Tab2, _}, [], _}}, recv_event()),
diff --git a/lib/mnesia/test/mnesia_install_test.erl b/lib/mnesia/test/mnesia_install_test.erl
index 5d55fcac0e..3a2d44aa95 100644
--- a/lib/mnesia/test/mnesia_install_test.erl
+++ b/lib/mnesia/test/mnesia_install_test.erl
@@ -205,7 +205,7 @@ silly_upgrade(Config) when is_list(Config) ->
?match(ok, mnesia:install_fallback(Bup2)),
file:delete(Bup2),
%% Will generate intentional crash, fatal error
- ?match([], mnesia_test_lib:stop_mnesia([Node2])),
+ ?match([], mnesia_test_lib:stop_mnesia([Node2])),
wait_till_dead([Node1, Node2]),
?match([], mnesia_test_lib:start_mnesia([Node1, Node2], [Tab1, Tab2])),
?match(match, verify_state(Tab1, Tab2, CpState)),
@@ -213,22 +213,29 @@ silly_upgrade(Config) when is_list(Config) ->
?match(ok, mnesia:install_fallback(Bup)),
file:delete(Bup),
%% Will generate intentional crash, fatal error
- ?match([], mnesia_test_lib:stop_mnesia([Node1, Node2])),
+ ?match([], mnesia_test_lib:stop_mnesia([Node1, Node2])),
wait_till_dead([Node1, Node2]),
?match([], mnesia_test_lib:start_mnesia([Node1, Node2], [Tab1, Tab2])),
CpState2 = [X || X <- CpState, element(1, X) /= Tab1],
?match(match, verify_state(Tab1, Tab2, CpState2)),
?verify_mnesia(Nodes, []).
-wait_till_dead([]) -> ok;
-wait_till_dead([N|Ns]) ->
+wait_till_dead([]) ->
+ ok; %% timer:sleep(5);
+wait_till_dead(Repeat = [N|Ns]) ->
Apps = rpc:call(N, application, which_applications, []),
case lists:keymember(mnesia, 1, Apps) of
- true ->
+ true ->
timer:sleep(10),
- wait_till_dead([N|Ns]);
- false ->
- wait_till_dead(Ns)
+ wait_till_dead(Repeat);
+ false ->
+ case rpc:call(N, erlang, whereis, [mnesia_monitor]) of
+ undefined ->
+ wait_till_dead(Ns);
+ _ ->
+ timer:sleep(10),
+ wait_till_dead(Repeat)
+ end
end.
add_some_records(Tab1, Tab2, Old) ->
diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk
index a21ab007ef..ebf79dd2ae 100644
--- a/lib/mnesia/vsn.mk
+++ b/lib/mnesia/vsn.mk
@@ -1 +1 @@
-MNESIA_VSN = 4.5
+MNESIA_VSN = 4.5.1
diff --git a/lib/public_key/asn1/InformationFramework.asn1 b/lib/public_key/asn1/InformationFramework.asn1
new file mode 100644
index 0000000000..40fbd11a2a
--- /dev/null
+++ b/lib/public_key/asn1/InformationFramework.asn1
@@ -0,0 +1,682 @@
+InformationFramework {joint-iso-itu-t ds(5) module(1) informationFramework(1)
+ 6} DEFINITIONS ::=
+BEGIN
+
+-- EXPORTS All
+-- The types and values defined in this module are exported for use in the other ASN.1 modules contained
+-- within the Directory Specifications, and for the use of other applications which will use them to access
+-- Directory services. Other applications may use them for their own purposes, but this will not constrain
+-- extensions and modifications needed to maintain or improve the Directory service.
+IMPORTS
+ -- from ITU-T Rec. X.501 | ISO/IEC 9594-2
+ directoryAbstractService, id-ar, id-at, id-mr, id-nf, id-oa, id-oc,
+ id-sc, selectedAttributeTypes, serviceAdministration
+ FROM UsefulDefinitions {joint-iso-itu-t ds(5) module(1)
+ usefulDefinitions(0) 6}
+ SearchRule
+ FROM ServiceAdministration serviceAdministration
+ -- from ITU-T Rec. X.511 | ISO/IEC 9594-3
+ TypeAndContextAssertion
+ FROM DirectoryAbstractService directoryAbstractService
+ -- from ITU-T Rec. X.520 | ISO/IEC 9594-6
+ booleanMatch, commonName, generalizedTimeMatch, generalizedTimeOrderingMatch,
+ integerFirstComponentMatch, integerMatch, integerOrderingMatch,
+ objectIdentifierFirstComponentMatch, UnboundedDirectoryString
+ FROM SelectedAttributeTypes selectedAttributeTypes;
+
+-- attribute data types
+Attribute{ATTRIBUTE:SupportedAttributes} ::= SEQUENCE {
+ type ATTRIBUTE.&id({SupportedAttributes}),
+ values
+ SET SIZE (0..MAX) OF ATTRIBUTE.&Type({SupportedAttributes}{@type}),
+ valuesWithContext
+ SET SIZE (1..MAX) OF
+ SEQUENCE {value ATTRIBUTE.&Type({SupportedAttributes}{@type}),
+ contextList SET SIZE (1..MAX) OF Context} OPTIONAL
+}
+
+AttributeType ::= ATTRIBUTE.&id
+
+AttributeValue ::= ATTRIBUTE.&Type
+
+Context ::= SEQUENCE {
+ contextType CONTEXT.&id({SupportedContexts}),
+ contextValues
+ SET SIZE (1..MAX) OF CONTEXT.&Type({SupportedContexts}{@contextType}),
+ fallback BOOLEAN DEFAULT FALSE
+}
+
+AttributeValueAssertion ::= SEQUENCE {
+ type ATTRIBUTE.&id({SupportedAttributes}),
+ assertion
+ ATTRIBUTE.&equality-match.&AssertionType
+ ({SupportedAttributes}{@type}),
+ assertedContexts
+ CHOICE {allContexts [0] NULL,
+ selectedContexts [1] SET SIZE (1..MAX) OF ContextAssertion
+ } OPTIONAL
+}
+
+ContextAssertion ::= SEQUENCE {
+ contextType CONTEXT.&id({SupportedContexts}),
+ contextValues
+ SET SIZE (1..MAX) OF
+ CONTEXT.&Assertion({SupportedContexts}{@contextType})
+}
+
+AttributeTypeAssertion ::= SEQUENCE {
+ type ATTRIBUTE.&id({SupportedAttributes}),
+ assertedContexts SEQUENCE SIZE (1..MAX) OF ContextAssertion OPTIONAL
+}
+
+-- Definition of the following information object set is deferred, perhaps to standardized
+-- profiles or to protocol implementation conformance statements. The set is required to
+-- specify a table constraint on the values component of Attribute, the value component
+-- of AttributeTypeAndValue, and the assertion component of AttributeValueAssertion.
+SupportedAttributes ATTRIBUTE ::=
+ {objectClass | aliasedEntryName, ...}
+
+-- Definition of the following information object set is deferred, perhaps to standardized
+-- profiles or to protocol implementation conformance statements. The set is required to
+-- specify a table constraint on the context specifications
+SupportedContexts CONTEXT ::=
+ {...}
+
+-- naming data types
+Name ::= CHOICE { -- only one possibility for now --rdnSequence RDNSequence
+}
+
+RDNSequence ::= SEQUENCE OF RelativeDistinguishedName
+
+DistinguishedName ::= RDNSequence
+
+RelativeDistinguishedName ::=
+ SET SIZE (1..MAX) OF AttributeTypeAndDistinguishedValue
+
+AttributeTypeAndDistinguishedValue ::= SEQUENCE {
+ type ATTRIBUTE.&id({SupportedAttributes}),
+ value ATTRIBUTE.&Type({SupportedAttributes}{@type}),
+ primaryDistinguished BOOLEAN DEFAULT TRUE,
+ valuesWithContext
+ SET SIZE (1..MAX) OF
+ SEQUENCE {distingAttrValue
+ [0] ATTRIBUTE.&Type({SupportedAttributes}{@type})
+ OPTIONAL,
+ contextList SET SIZE (1..MAX) OF Context} OPTIONAL
+}
+
+-- subtree data types
+SubtreeSpecification ::= SEQUENCE {
+ base [0] LocalName DEFAULT {},
+ COMPONENTS OF ChopSpecification,
+ specificationFilter [4] Refinement OPTIONAL
+}
+
+-- empty sequence specifies whole administrative area
+LocalName ::= RDNSequence
+
+ChopSpecification ::= SEQUENCE {
+ specificExclusions
+ [1] SET SIZE (1..MAX) OF
+ CHOICE {chopBefore [0] LocalName,
+ chopAfter [1] LocalName} OPTIONAL,
+ minimum [2] BaseDistance DEFAULT 0,
+ maximum [3] BaseDistance OPTIONAL
+}
+
+BaseDistance ::= INTEGER(0..MAX)
+
+Refinement ::= CHOICE {
+ item [0] OBJECT-CLASS.&id,
+ and [1] SET SIZE (1..MAX) OF Refinement,
+ or [2] SET SIZE (1..MAX) OF Refinement,
+ not [3] Refinement
+}
+
+-- OBJECT-CLASS information object class specification
+OBJECT-CLASS ::= CLASS {
+ &Superclasses OBJECT-CLASS OPTIONAL,
+ &kind ObjectClassKind DEFAULT structural,
+ &MandatoryAttributes ATTRIBUTE OPTIONAL,
+ &OptionalAttributes ATTRIBUTE OPTIONAL,
+ &id OBJECT IDENTIFIER UNIQUE
+}
+WITH SYNTAX {
+ [SUBCLASS OF &Superclasses]
+ [KIND &kind]
+ [MUST CONTAIN &MandatoryAttributes]
+ [MAY CONTAIN &OptionalAttributes]
+ ID &id
+}
+
+ObjectClassKind ::= ENUMERATED {abstract(0), structural(1), auxiliary(2)}
+
+-- object classes
+top OBJECT-CLASS ::= {
+ KIND abstract
+ MUST CONTAIN {objectClass}
+ ID id-oc-top
+}
+
+alias OBJECT-CLASS ::= {
+ SUBCLASS OF {top}
+ MUST CONTAIN {aliasedEntryName}
+ ID id-oc-alias
+}
+
+parent OBJECT-CLASS ::= {KIND abstract
+ ID id-oc-parent
+}
+
+child OBJECT-CLASS ::= {KIND auxiliary
+ ID id-oc-child
+}
+
+-- ATTRIBUTE information object class specification
+ATTRIBUTE ::= CLASS {
+ &derivation ATTRIBUTE OPTIONAL,
+ &Type OPTIONAL, -- either &Type or &derivation required
+ &equality-match MATCHING-RULE OPTIONAL,
+ &ordering-match MATCHING-RULE OPTIONAL,
+ &substrings-match MATCHING-RULE OPTIONAL,
+ &single-valued BOOLEAN DEFAULT FALSE,
+ &collective BOOLEAN DEFAULT FALSE,
+ &dummy BOOLEAN DEFAULT FALSE,
+ -- operational extensions
+ &no-user-modification BOOLEAN DEFAULT FALSE,
+ &usage AttributeUsage DEFAULT userApplications,
+ &id OBJECT IDENTIFIER UNIQUE
+}
+WITH SYNTAX {
+ [SUBTYPE OF &derivation]
+ [WITH SYNTAX &Type]
+ [EQUALITY MATCHING RULE &equality-match]
+ [ORDERING MATCHING RULE &ordering-match]
+ [SUBSTRINGS MATCHING RULE &substrings-match]
+ [SINGLE VALUE &single-valued]
+ [COLLECTIVE &collective]
+ [DUMMY &dummy]
+ [NO USER MODIFICATION &no-user-modification]
+ [USAGE &usage]
+ ID &id
+}
+
+AttributeUsage ::= ENUMERATED {
+ userApplications(0), directoryOperation(1), distributedOperation(2),
+ dSAOperation(3)}
+
+-- attributes
+objectClass ATTRIBUTE ::= {
+ WITH SYNTAX OBJECT IDENTIFIER
+ EQUALITY MATCHING RULE objectIdentifierMatch
+ ID id-at-objectClass
+}
+
+aliasedEntryName ATTRIBUTE ::= {
+ WITH SYNTAX DistinguishedName
+ EQUALITY MATCHING RULE distinguishedNameMatch
+ SINGLE VALUE TRUE
+ ID id-at-aliasedEntryName
+}
+
+-- MATCHING-RULE information object class specification
+MATCHING-RULE ::= CLASS {
+ &ParentMatchingRules MATCHING-RULE OPTIONAL,
+ &AssertionType OPTIONAL,
+ &uniqueMatchIndicator ATTRIBUTE OPTIONAL,
+ &id OBJECT IDENTIFIER UNIQUE
+}
+WITH SYNTAX {
+ [PARENT &ParentMatchingRules]
+ [SYNTAX &AssertionType]
+ [UNIQUE-MATCH-INDICATOR &uniqueMatchIndicator]
+ ID &id
+}
+
+-- matching rules
+objectIdentifierMatch MATCHING-RULE ::= {
+ SYNTAX OBJECT IDENTIFIER
+ ID id-mr-objectIdentifierMatch
+}
+
+distinguishedNameMatch MATCHING-RULE ::= {
+ SYNTAX DistinguishedName
+ ID id-mr-distinguishedNameMatch
+}
+
+MAPPING-BASED-MATCHING{SelectedBy, BOOLEAN:combinable, MappingResult,
+ OBJECT IDENTIFIER:matchingRule} ::= CLASS {
+ &selectBy SelectedBy OPTIONAL,
+ &ApplicableTo ATTRIBUTE,
+ &subtypesIncluded BOOLEAN DEFAULT TRUE,
+ &combinable BOOLEAN(combinable),
+ &mappingResults MappingResult OPTIONAL,
+ &userControl BOOLEAN DEFAULT FALSE,
+ &exclusive BOOLEAN DEFAULT TRUE,
+ &matching-rule MATCHING-RULE.&id(matchingRule),
+ &id OBJECT IDENTIFIER UNIQUE
+}
+WITH SYNTAX {
+ [SELECT BY &selectBy]
+ APPLICABLE TO &ApplicableTo
+ [SUBTYPES INCLUDED &subtypesIncluded]
+ COMBINABLE &combinable
+ [MAPPING RESULTS &mappingResults]
+ [USER CONTROL &userControl]
+ [EXCLUSIVE &exclusive]
+ MATCHING RULE &matching-rule
+ ID &id
+}
+
+-- NAME-FORM information object class specification
+NAME-FORM ::= CLASS {
+ &namedObjectClass OBJECT-CLASS,
+ &MandatoryAttributes ATTRIBUTE,
+ &OptionalAttributes ATTRIBUTE OPTIONAL,
+ &id OBJECT IDENTIFIER UNIQUE
+}
+WITH SYNTAX {
+ NAMES &namedObjectClass
+ WITH ATTRIBUTES &MandatoryAttributes
+ [AND OPTIONALLY &OptionalAttributes]
+ ID &id
+}
+
+-- STRUCTURE-RULE class and DIT structure rule data types
+DITStructureRule ::= SEQUENCE {
+ ruleIdentifier RuleIdentifier,
+ -- shall be unique within the scope of the subschema
+ nameForm NAME-FORM.&id,
+ superiorStructureRules SET SIZE (1..MAX) OF RuleIdentifier OPTIONAL
+}
+
+RuleIdentifier ::= INTEGER
+
+STRUCTURE-RULE ::= CLASS {
+ &nameForm NAME-FORM,
+ &SuperiorStructureRules STRUCTURE-RULE OPTIONAL,
+ &id RuleIdentifier
+}
+WITH SYNTAX {
+ NAME FORM &nameForm
+ [SUPERIOR RULES &SuperiorStructureRules]
+ ID &id
+}
+
+-- DIT content rule data type and CONTENT-RULE class
+DITContentRule ::= SEQUENCE {
+ structuralObjectClass OBJECT-CLASS.&id,
+ auxiliaries SET SIZE (1..MAX) OF OBJECT-CLASS.&id OPTIONAL,
+ mandatory [1] SET SIZE (1..MAX) OF ATTRIBUTE.&id OPTIONAL,
+ optional [2] SET SIZE (1..MAX) OF ATTRIBUTE.&id OPTIONAL,
+ precluded [3] SET SIZE (1..MAX) OF ATTRIBUTE.&id OPTIONAL
+}
+
+CONTENT-RULE ::= CLASS {
+ &structuralClass OBJECT-CLASS.&id UNIQUE,
+ &Auxiliaries OBJECT-CLASS OPTIONAL,
+ &Mandatory ATTRIBUTE OPTIONAL,
+ &Optional ATTRIBUTE OPTIONAL,
+ &Precluded ATTRIBUTE OPTIONAL
+}
+WITH SYNTAX {
+ STRUCTURAL OBJECT-CLASS &structuralClass
+ [AUXILIARY OBJECT-CLASSES &Auxiliaries]
+ [MUST CONTAIN &Mandatory]
+ [MAY CONTAIN &Optional]
+ [MUST-NOT CONTAIN &Precluded]
+}
+
+CONTEXT ::= CLASS {
+ &Type ,
+ &DefaultValue OPTIONAL,
+ &Assertion OPTIONAL,
+ &absentMatch BOOLEAN DEFAULT TRUE,
+ &id OBJECT IDENTIFIER UNIQUE
+}
+WITH SYNTAX {
+ WITH SYNTAX &Type
+ [DEFAULT-VALUE &DefaultValue]
+ [ASSERTED AS &Assertion]
+ [ABSENT-MATCH &absentMatch]
+ ID &id
+}
+
+DITContextUse ::= SEQUENCE {
+ attributeType ATTRIBUTE.&id,
+ mandatoryContexts [1] SET SIZE (1..MAX) OF CONTEXT.&id OPTIONAL,
+ optionalContexts [2] SET SIZE (1..MAX) OF CONTEXT.&id OPTIONAL
+}
+
+DIT-CONTEXT-USE-RULE ::= CLASS {
+ &attributeType ATTRIBUTE.&id UNIQUE,
+ &Mandatory CONTEXT OPTIONAL,
+ &Optional CONTEXT OPTIONAL
+}
+WITH SYNTAX {
+ ATTRIBUTE TYPE &attributeType
+ [MANDATORY CONTEXTS &Mandatory]
+ [OPTIONAL CONTEXTS &Optional]
+}
+
+FRIENDS ::= CLASS {
+ &anchor ATTRIBUTE.&id UNIQUE,
+ &Friends ATTRIBUTE
+}WITH SYNTAX {ANCHOR &anchor
+ FRIENDS &Friends
+}
+
+-- system schema information objects
+-- object classes
+subentry OBJECT-CLASS ::= {
+ SUBCLASS OF {top}
+ KIND structural
+ MUST CONTAIN {commonName | subtreeSpecification}
+ ID id-sc-subentry
+}
+
+subentryNameForm NAME-FORM ::= {
+ NAMES subentry
+ WITH ATTRIBUTES {commonName}
+ ID id-nf-subentryNameForm
+}
+
+subtreeSpecification ATTRIBUTE ::= {
+ WITH SYNTAX SubtreeSpecification
+ USAGE directoryOperation
+ ID id-oa-subtreeSpecification
+}
+
+administrativeRole ATTRIBUTE ::= {
+ WITH SYNTAX OBJECT-CLASS.&id
+ EQUALITY MATCHING RULE objectIdentifierMatch
+ USAGE directoryOperation
+ ID id-oa-administrativeRole
+}
+
+createTimestamp ATTRIBUTE ::= {
+ WITH SYNTAX GeneralizedTime
+ -- as per 46.3 b) or c) of ITU-T Rec. X.680 | ISO/IEC 8824-1
+ EQUALITY MATCHING RULE generalizedTimeMatch
+ ORDERING MATCHING RULE generalizedTimeOrderingMatch
+ SINGLE VALUE TRUE
+ NO USER MODIFICATION TRUE
+ USAGE directoryOperation
+ ID id-oa-createTimestamp
+}
+
+modifyTimestamp ATTRIBUTE ::= {
+ WITH SYNTAX GeneralizedTime
+ -- as per 46.3 b) or c) of ITU-T Rec. X.680 | ISO/IEC 8824-1
+ EQUALITY MATCHING RULE generalizedTimeMatch
+ ORDERING MATCHING RULE generalizedTimeOrderingMatch
+ SINGLE VALUE TRUE
+ NO USER MODIFICATION TRUE
+ USAGE directoryOperation
+ ID id-oa-modifyTimestamp
+}
+
+subschemaTimestamp ATTRIBUTE ::= {
+ WITH SYNTAX GeneralizedTime
+ -- as per 46.3 b) or c) of ITU-T Rec. X.680 | ISO/IEC 8824-1
+ EQUALITY MATCHING RULE generalizedTimeMatch
+ ORDERING MATCHING RULE generalizedTimeOrderingMatch
+ SINGLE VALUE TRUE
+ NO USER MODIFICATION TRUE
+ USAGE directoryOperation
+ ID id-oa-subschemaTimestamp
+}
+
+creatorsName ATTRIBUTE ::= {
+ WITH SYNTAX DistinguishedName
+ EQUALITY MATCHING RULE distinguishedNameMatch
+ SINGLE VALUE TRUE
+ NO USER MODIFICATION TRUE
+ USAGE directoryOperation
+ ID id-oa-creatorsName
+}
+
+modifiersName ATTRIBUTE ::= {
+ WITH SYNTAX DistinguishedName
+ EQUALITY MATCHING RULE distinguishedNameMatch
+ SINGLE VALUE TRUE
+ NO USER MODIFICATION TRUE
+ USAGE directoryOperation
+ ID id-oa-modifiersName
+}
+
+subschemaSubentryList ATTRIBUTE ::= {
+ WITH SYNTAX DistinguishedName
+ EQUALITY MATCHING RULE distinguishedNameMatch
+ SINGLE VALUE TRUE
+ NO USER MODIFICATION TRUE
+ USAGE directoryOperation
+ ID id-oa-subschemaSubentryList
+}
+
+accessControlSubentryList ATTRIBUTE ::= {
+ WITH SYNTAX DistinguishedName
+ EQUALITY MATCHING RULE distinguishedNameMatch
+ NO USER MODIFICATION TRUE
+ USAGE directoryOperation
+ ID id-oa-accessControlSubentryList
+}
+
+collectiveAttributeSubentryList ATTRIBUTE ::= {
+ WITH SYNTAX DistinguishedName
+ EQUALITY MATCHING RULE distinguishedNameMatch
+ NO USER MODIFICATION TRUE
+ USAGE directoryOperation
+ ID id-oa-collectiveAttributeSubentryList
+}
+
+contextDefaultSubentryList ATTRIBUTE ::= {
+ WITH SYNTAX DistinguishedName
+ EQUALITY MATCHING RULE distinguishedNameMatch
+ NO USER MODIFICATION TRUE
+ USAGE directoryOperation
+ ID id-oa-contextDefaultSubentryList
+}
+
+serviceAdminSubentryList ATTRIBUTE ::= {
+ WITH SYNTAX DistinguishedName
+ EQUALITY MATCHING RULE distinguishedNameMatch
+ NO USER MODIFICATION TRUE
+ USAGE directoryOperation
+ ID id-oa-serviceAdminSubentryList
+}
+
+hasSubordinates ATTRIBUTE ::= {
+ WITH SYNTAX BOOLEAN
+ EQUALITY MATCHING RULE booleanMatch
+ SINGLE VALUE TRUE
+ NO USER MODIFICATION TRUE
+ USAGE directoryOperation
+ ID id-oa-hasSubordinates
+}
+
+accessControlSubentry OBJECT-CLASS ::= {
+ KIND auxiliary
+ ID id-sc-accessControlSubentry
+}
+
+collectiveAttributeSubentry OBJECT-CLASS ::= {
+ KIND auxiliary
+ ID id-sc-collectiveAttributeSubentry
+}
+
+collectiveExclusions ATTRIBUTE ::= {
+ WITH SYNTAX OBJECT IDENTIFIER
+ EQUALITY MATCHING RULE objectIdentifierMatch
+ USAGE directoryOperation
+ ID id-oa-collectiveExclusions
+}
+
+contextAssertionSubentry OBJECT-CLASS ::= {
+ KIND auxiliary
+ MUST CONTAIN {contextAssertionDefaults}
+ ID id-sc-contextAssertionSubentry
+}
+
+contextAssertionDefaults ATTRIBUTE ::= {
+ WITH SYNTAX TypeAndContextAssertion
+ EQUALITY MATCHING RULE objectIdentifierFirstComponentMatch
+ USAGE directoryOperation
+ ID id-oa-contextAssertionDefault
+}
+
+serviceAdminSubentry OBJECT-CLASS ::= {
+ KIND auxiliary
+ MUST CONTAIN {searchRules}
+ ID id-sc-serviceAdminSubentry
+}
+
+searchRules ATTRIBUTE ::= {
+ WITH SYNTAX SearchRuleDescription
+ EQUALITY MATCHING RULE integerFirstComponentMatch
+ USAGE directoryOperation
+ ID id-oa-searchRules
+}
+
+SearchRuleDescription ::= SEQUENCE {
+ COMPONENTS OF SearchRule,
+ name [28] SET SIZE (1..MAX) OF UnboundedDirectoryString OPTIONAL,
+ description [29] UnboundedDirectoryString OPTIONAL
+}
+
+hierarchyLevel ATTRIBUTE ::= {
+ WITH SYNTAX HierarchyLevel
+ EQUALITY MATCHING RULE integerMatch
+ ORDERING MATCHING RULE integerOrderingMatch
+ SINGLE VALUE TRUE
+ NO USER MODIFICATION TRUE
+ USAGE directoryOperation
+ ID id-oa-hierarchyLevel
+}
+
+HierarchyLevel ::= INTEGER
+
+hierarchyBelow ATTRIBUTE ::= {
+ WITH SYNTAX HierarchyBelow
+ EQUALITY MATCHING RULE booleanMatch
+ SINGLE VALUE TRUE
+ NO USER MODIFICATION TRUE
+ USAGE directoryOperation
+ ID id-oa-hierarchyBelow
+}
+
+HierarchyBelow ::= BOOLEAN
+
+hierarchyParent ATTRIBUTE ::= {
+ WITH SYNTAX DistinguishedName
+ EQUALITY MATCHING RULE distinguishedNameMatch
+ SINGLE VALUE TRUE
+ USAGE directoryOperation
+ ID id-oa-hierarchyParent
+}
+
+hierarchyTop ATTRIBUTE ::= {
+ WITH SYNTAX DistinguishedName
+ EQUALITY MATCHING RULE distinguishedNameMatch
+ SINGLE VALUE TRUE
+ USAGE directoryOperation
+ ID id-oa-hierarchyTop
+}
+
+-- object identifier assignments
+-- object classes
+id-oc-top OBJECT IDENTIFIER ::=
+ {id-oc 0}
+
+id-oc-alias OBJECT IDENTIFIER ::= {id-oc 1}
+
+id-oc-parent OBJECT IDENTIFIER ::= {id-oc 28}
+
+id-oc-child OBJECT IDENTIFIER ::= {id-oc 29}
+
+-- attributes
+id-at-objectClass OBJECT IDENTIFIER ::= {id-at 0}
+
+id-at-aliasedEntryName OBJECT IDENTIFIER ::= {id-at 1}
+
+-- matching rules
+id-mr-objectIdentifierMatch OBJECT IDENTIFIER ::= {id-mr 0}
+
+id-mr-distinguishedNameMatch OBJECT IDENTIFIER ::= {id-mr 1}
+
+-- operational attributes
+id-oa-excludeAllCollectiveAttributes OBJECT IDENTIFIER ::=
+ {id-oa 0}
+
+id-oa-createTimestamp OBJECT IDENTIFIER ::= {id-oa 1}
+
+id-oa-modifyTimestamp OBJECT IDENTIFIER ::= {id-oa 2}
+
+id-oa-creatorsName OBJECT IDENTIFIER ::= {id-oa 3}
+
+id-oa-modifiersName OBJECT IDENTIFIER ::= {id-oa 4}
+
+id-oa-administrativeRole OBJECT IDENTIFIER ::= {id-oa 5}
+
+id-oa-subtreeSpecification OBJECT IDENTIFIER ::= {id-oa 6}
+
+id-oa-collectiveExclusions OBJECT IDENTIFIER ::= {id-oa 7}
+
+id-oa-subschemaTimestamp OBJECT IDENTIFIER ::= {id-oa 8}
+
+id-oa-hasSubordinates OBJECT IDENTIFIER ::= {id-oa 9}
+
+id-oa-subschemaSubentryList OBJECT IDENTIFIER ::= {id-oa 10}
+
+id-oa-accessControlSubentryList OBJECT IDENTIFIER ::= {id-oa 11}
+
+id-oa-collectiveAttributeSubentryList OBJECT IDENTIFIER ::= {id-oa 12}
+
+id-oa-contextDefaultSubentryList OBJECT IDENTIFIER ::= {id-oa 13}
+
+id-oa-contextAssertionDefault OBJECT IDENTIFIER ::= {id-oa 14}
+
+id-oa-serviceAdminSubentryList OBJECT IDENTIFIER ::= {id-oa 15}
+
+id-oa-searchRules OBJECT IDENTIFIER ::= {id-oa 16}
+
+id-oa-hierarchyLevel OBJECT IDENTIFIER ::= {id-oa 17}
+
+id-oa-hierarchyBelow OBJECT IDENTIFIER ::= {id-oa 18}
+
+id-oa-hierarchyParent OBJECT IDENTIFIER ::= {id-oa 19}
+
+id-oa-hierarchyTop OBJECT IDENTIFIER ::= {id-oa 20}
+
+-- subentry classes
+id-sc-subentry OBJECT IDENTIFIER ::= {id-sc 0}
+
+id-sc-accessControlSubentry OBJECT IDENTIFIER ::= {id-sc 1}
+
+id-sc-collectiveAttributeSubentry OBJECT IDENTIFIER ::= {id-sc 2}
+
+id-sc-contextAssertionSubentry OBJECT IDENTIFIER ::= {id-sc 3}
+
+id-sc-serviceAdminSubentry OBJECT IDENTIFIER ::= {id-sc 4}
+
+-- Name forms
+id-nf-subentryNameForm OBJECT IDENTIFIER ::= {id-nf 16}
+
+-- administrative roles
+id-ar-autonomousArea OBJECT IDENTIFIER ::= {id-ar 1}
+
+id-ar-accessControlSpecificArea OBJECT IDENTIFIER ::= {id-ar 2}
+
+id-ar-accessControlInnerArea OBJECT IDENTIFIER ::= {id-ar 3}
+
+id-ar-subschemaAdminSpecificArea OBJECT IDENTIFIER ::= {id-ar 4}
+
+id-ar-collectiveAttributeSpecificArea OBJECT IDENTIFIER ::= {id-ar 5}
+
+id-ar-collectiveAttributeInnerArea OBJECT IDENTIFIER ::= {id-ar 6}
+
+id-ar-contextDefaultSpecificArea OBJECT IDENTIFIER ::= {id-ar 7}
+
+id-ar-serviceSpecificArea OBJECT IDENTIFIER ::= {id-ar 8}
+
+END -- InformationFramework
diff --git a/lib/public_key/asn1/Makefile b/lib/public_key/asn1/Makefile
index c4f8d65aa7..2ce1168349 100644
--- a/lib/public_key/asn1/Makefile
+++ b/lib/public_key/asn1/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2008-2010. All Rights Reserved.
+# Copyright Ericsson AB 2008-2011. All Rights Reserved.
#
# The contents of this file are subject to the Erlang Public License,
# Version 1.1, (the "License"); you may not use this file except in
@@ -38,12 +38,12 @@ RELSYSDIR = $(RELEASE_PATH)/lib/public_key-$(VSN)
.SUFFIXES: .asn1
.PRECIOUS: %.erl
-ASN_TOP = OTP-PUB-KEY
+ASN_TOP = OTP-PUB-KEY PKCS-FRAME
ASN_MODULES = PKIX1Explicit88 PKIX1Implicit88 PKIX1Algorithms88 \
- PKIXAttributeCertificate PKCS-1 PKCS-3 OTP-PKIX
+ PKIXAttributeCertificate PKCS-1 PKCS-3 PKCS-8 InformationFramework PKCS5v2-0 OTP-PKIX
ASN_ASNS = $(ASN_MODULES:%=%.asn1)
-ASN_ERLS = $(ASN_TOP).erl
-ASN_HRLS = $(ASN_TOP).hrl
+ASN_ERLS = $(ASN_TOP:%=%.erl)
+ASN_HRLS = $(ASN_TOP:%=%.hrl)
ASN_CONFIGS = OTP-PUB-KEY.asn1config
ASN_DBS = $(ASN_MODULES:%=%.asn1db) OTP-PUB-KEY.asn1db
ASN_TABLES = $(ASN_MODULES:%=%.table)
@@ -82,8 +82,8 @@ docs:
%.erl %.hrl: %.set.asn
erlc $(ASN_FLAGS) $<
-$(HRL_FILES): $(ASN_HRLS)
- cp -p $(ASN_HRLS) $(INCLUDE)
+$(INCLUDE)/%.hrl: %.hrl
+ cp -p $< $@
# ----------------------------------------------------
# Release Target
@@ -113,3 +113,9 @@ OTP-PUB-KEY.asn1db: PKIX1Algorithms88.asn1 \
PKCS-1.asn1\
PKCS-3.asn1\
OTP-PKIX.asn1
+
+$(EBIN)/PKCS-FRAME.beam: PKCS-FRAME.erl PKCS-FRAME.hrl
+PKCS-FRAME.erl PKCS-FRAME.hrl: PKCS-FRAME.asn1db
+PKCS-FRAME.asn1db: PKCS-8.asn1\
+ InformationFramework.asn1\
+ PKCS5v2-0.asn1 \ No newline at end of file
diff --git a/lib/public_key/asn1/PKCS-8.asn1 b/lib/public_key/asn1/PKCS-8.asn1
new file mode 100644
index 0000000000..7413519b57
--- /dev/null
+++ b/lib/public_key/asn1/PKCS-8.asn1
@@ -0,0 +1,83 @@
+PKCS-8 {iso(1) member-body(2) us(840) rsadsi(113549) pkcs(1) pkcs-8(8)
+ modules(1) pkcs-8(1)}
+
+-- $Revision: 1.5 $
+
+-- This module has been checked for conformance with the ASN.1
+-- standard by the OSS ASN.1 Tools
+
+DEFINITIONS IMPLICIT TAGS ::=
+
+BEGIN
+
+-- EXPORTS All --
+-- All types and values defined in this module is exported for use in other
+-- ASN.1 modules.
+
+IMPORTS
+
+-- informationFramework
+-- FROM UsefulDefinitions {joint-iso-itu-t(2) ds(5) module(1)
+-- usefulDefinitions(0) 3}
+
+Attribute
+-- FROM InformationFramework informationFramework
+ FROM InformationFramework;
+
+-- This import is really unnecessary since ALGORITHM-IDENTIFIER is defined as a
+-- TYPE-IDENTIFIER
+-- Renome this import and replace all occurences of ALGORITHM-IDENTIFIER with
+-- TYPE-IDENTIFIER as a workaround for weaknesses in the ASN.1 compiler
+--AlgorithmIdentifier, ALGORITHM-IDENTIFIER
+-- FROM PKCS5v2-0 {iso(1) member-body(2) us(840) rsadsi(113549)
+-- pkcs(1) pkcs-5(5) modules(16) pkcs-5(1)};
+
+-- Inlined from PKCS5v2-0 since it is the only thing imported from that module
+-- AlgorithmIdentifier { ALGORITHM-IDENTIFIER:InfoObjectSet } ::=
+AlgorithmIdentifier { TYPE-IDENTIFIER:InfoObjectSet } ::=
+SEQUENCE {
+-- algorithm ALGORITHM-IDENTIFIER.&id({InfoObjectSet}),
+ algorithm TYPE-IDENTIFIER.&id({InfoObjectSet}),
+-- parameters ALGORITHM-IDENTIFIER.&Type({InfoObjectSet}
+ parameters TYPE-IDENTIFIER.&Type({InfoObjectSet}
+ {@algorithm}) OPTIONAL }
+
+-- Private-key information syntax
+
+PrivateKeyInfo ::= SEQUENCE {
+ version Version,
+-- privateKeyAlgorithm AlgorithmIdentifier {{PrivateKeyAlgorithms}},
+ privateKeyAlgorithm AlgorithmIdentifier {{...}},
+ privateKey PrivateKey,
+ attributes [0] Attributes OPTIONAL }
+
+Version ::= INTEGER {v1(0)} (v1,...)
+
+PrivateKey ::= OCTET STRING
+
+-- Attributes ::= SET OF Attribute
+Attributes ::= SET OF Attribute {{...}}
+
+-- Encrypted private-key information syntax
+
+EncryptedPrivateKeyInfo ::= SEQUENCE {
+-- encryptionAlgorithm AlgorithmIdentifier {{KeyEncryptionAlgorithms}},
+ encryptionAlgorithm AlgorithmIdentifier {{...}},
+ encryptedData EncryptedData
+}
+
+EncryptedData ::= OCTET STRING
+
+-- PrivateKeyAlgorithms ALGORITHM-IDENTIFIER ::= {
+PrivateKeyAlgorithms TYPE-IDENTIFIER ::= {
+ ... -- For local profiles
+}
+
+-- KeyEncryptionAlgorithms ALGORITHM-IDENTIFIER ::= {
+KeyEncryptionAlgorithms TYPE-IDENTIFIER ::= {
+ ... -- For local profiles
+}
+
+END
+
+
diff --git a/lib/public_key/asn1/PKCS-FRAME.set.asn b/lib/public_key/asn1/PKCS-FRAME.set.asn
new file mode 100644
index 0000000000..a0777ff260
--- /dev/null
+++ b/lib/public_key/asn1/PKCS-FRAME.set.asn
@@ -0,0 +1,3 @@
+PKCS-8.asn1
+InformationFramework.asn1
+PKCS5v2-0.asn1
diff --git a/lib/public_key/asn1/PKCS5v2-0.asn1 b/lib/public_key/asn1/PKCS5v2-0.asn1
new file mode 100644
index 0000000000..fe7e16c7fa
--- /dev/null
+++ b/lib/public_key/asn1/PKCS5v2-0.asn1
@@ -0,0 +1,142 @@
+-- PKCS #5 v2.0 ASN.1 Module
+-- Revised March 25, 1999
+
+-- This module has been checked for conformance with the
+-- ASN.1 standard by the OSS ASN.1 Tools
+
+PKCS5v2-0 {iso(1) member-body(2) us(840) rsadsi(113549)
+ pkcs(1) pkcs-5(5) modules(16) pkcs5v2-0(1)}
+
+DEFINITIONS ::= BEGIN
+
+-- Basic object identifiers
+
+rsadsi OBJECT IDENTIFIER ::=
+ {iso(1) member-body(2) us(840) 113549}
+pkcs OBJECT IDENTIFIER ::= {rsadsi 1}
+pkcs-5 OBJECT IDENTIFIER ::= {pkcs 5}
+
+-- Basic types and classes
+
+AlgorithmIdentifier { TYPE-IDENTIFIER:InfoObjectSet } ::=
+SEQUENCE {
+ algorithm TYPE-IDENTIFIER.&id({InfoObjectSet}),
+ parameters TYPE-IDENTIFIER.&Type({InfoObjectSet}
+ {@algorithm}) OPTIONAL }
+
+--ALGORITHM-IDENTIFIER ::= TYPE-IDENTIFIER
+
+-- PBKDF2
+
+-- PBKDF2Algorithms ALGORITHM-IDENTIFIER ::=
+-- { {PBKDF2-params IDENTIFIED BY id-PBKDF2}, ...}
+
+id-PBKDF2 OBJECT IDENTIFIER ::= {pkcs-5 12}
+
+-- algid-hmacWithSHA1 AlgorithmIdentifier {{PBKDF2-PRFs}} ::=
+-- {algorithm id-hmacWithSHA1, parameters NULL : NULL}
+
+PBKDF2-params ::= SEQUENCE {
+ salt CHOICE {
+ specified OCTET STRING,
+ otherSource AlgorithmIdentifier {{PBKDF2-SaltSources}}
+ },
+ iterationCount INTEGER (1..MAX),
+ keyLength INTEGER (1..MAX) OPTIONAL,
+ prf AlgorithmIdentifier {{PBKDF2-PRFs}} DEFAULT
+{algorithm id-hmacWithSHA1, parameters NULL : NULL}}
+-- algid-hmacWithSHA1 }
+
+PBKDF2-SaltSources TYPE-IDENTIFIER ::= { ... }
+
+PBKDF2-PRFs TYPE-IDENTIFIER ::=
+ { {NULL IDENTIFIED BY id-hmacWithSHA1}, ... }
+
+ -- PBES1
+
+PBES1Algorithms TYPE-IDENTIFIER ::=
+ { {PBEParameter IDENTIFIED BY pbeWithMD2AndDES-CBC} |
+ {PBEParameter IDENTIFIED BY pbeWithMD2AndRC2-CBC} |
+ {PBEParameter IDENTIFIED BY pbeWithMD5AndDES-CBC} |
+ {PBEParameter IDENTIFIED BY pbeWithMD5AndRC2-CBC} |
+ {PBEParameter IDENTIFIED BY pbeWithSHA1AndDES-CBC} |
+ {PBEParameter IDENTIFIED BY pbeWithSHA1AndRC2-CBC}, ...}
+
+pbeWithMD2AndDES-CBC OBJECT IDENTIFIER ::= {pkcs-5 1}
+pbeWithMD2AndRC2-CBC OBJECT IDENTIFIER ::= {pkcs-5 4}
+pbeWithMD5AndDES-CBC OBJECT IDENTIFIER ::= {pkcs-5 3}
+pbeWithMD5AndRC2-CBC OBJECT IDENTIFIER ::= {pkcs-5 6}
+pbeWithSHA1AndDES-CBC OBJECT IDENTIFIER ::= {pkcs-5 10}
+pbeWithSHA1AndRC2-CBC OBJECT IDENTIFIER ::= {pkcs-5 11}
+
+PBEParameter ::= SEQUENCE {
+ salt OCTET STRING (SIZE(8)),
+ iterationCount INTEGER }
+
+-- PBES2
+
+PBES2Algorithms TYPE-IDENTIFIER ::=
+ { {PBES2-params IDENTIFIED BY id-PBES2}, ...}
+
+id-PBES2 OBJECT IDENTIFIER ::= {pkcs-5 13}
+
+PBES2-params ::= SEQUENCE {
+ keyDerivationFunc AlgorithmIdentifier {{PBES2-KDFs}},
+ encryptionScheme AlgorithmIdentifier {{PBES2-Encs}} }
+
+PBES2-KDFs TYPE-IDENTIFIER ::=
+ { {PBKDF2-params IDENTIFIED BY id-PBKDF2}, ... }
+
+PBES2-Encs TYPE-IDENTIFIER ::= { ... }
+
+-- PBMAC1
+
+PBMAC1Algorithms TYPE-IDENTIFIER ::=
+ { {PBMAC1-params IDENTIFIED BY id-PBMAC1}, ...}
+
+id-PBMAC1 OBJECT IDENTIFIER ::= {pkcs-5 14}
+
+PBMAC1-params ::= SEQUENCE {
+ keyDerivationFunc AlgorithmIdentifier {{PBMAC1-KDFs}},
+ messageAuthScheme AlgorithmIdentifier {{PBMAC1-MACs}} }
+
+PBMAC1-KDFs TYPE-IDENTIFIER ::=
+ { {PBKDF2-params IDENTIFIED BY id-PBKDF2}, ... }
+
+PBMAC1-MACs TYPE-IDENTIFIER ::= { ... }
+
+-- Supporting techniques
+
+digestAlgorithm OBJECT IDENTIFIER ::= {rsadsi 2}
+encryptionAlgorithm OBJECT IDENTIFIER ::= {rsadsi 3}
+
+SupportingAlgorithms TYPE-IDENTIFIER ::=
+ { {NULL IDENTIFIED BY id-hmacWithSHA1} |
+ {OCTET STRING (SIZE(8)) IDENTIFIED BY desCBC} |
+ {OCTET STRING (SIZE(8)) IDENTIFIED BY des-EDE3-CBC} |
+ {RC2-CBC-Parameter IDENTIFIED BY rc2CBC} |
+ {RC5-CBC-Parameters IDENTIFIED BY rc5-CBC-PAD}, ... }
+
+id-hmacWithSHA1 OBJECT IDENTIFIER ::= {digestAlgorithm 7}
+
+desCBC OBJECT IDENTIFIER ::=
+ {iso(1) identified-organization(3) oiw(14) secsig(3)
+ algorithms(2) 7} -- from OIW
+
+des-EDE3-CBC OBJECT IDENTIFIER ::= {encryptionAlgorithm 7}
+
+rc2CBC OBJECT IDENTIFIER ::= {encryptionAlgorithm 2}
+
+RC2-CBC-Parameter ::= SEQUENCE {
+ rc2ParameterVersion INTEGER OPTIONAL,
+ iv OCTET STRING (SIZE(8)) }
+
+rc5-CBC-PAD OBJECT IDENTIFIER ::= {encryptionAlgorithm 9}
+
+RC5-CBC-Parameters ::= SEQUENCE {
+ version INTEGER {v1-0(16)}, -- (v1-0),
+ rounds INTEGER (8..127),
+ blockSizeInBits INTEGER (64 | 128),
+ iv OCTET STRING OPTIONAL }
+
+END
diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml
index 9a3832c68b..821e7a2300 100644
--- a/lib/public_key/doc/src/public_key.xml
+++ b/lib/public_key/doc/src/public_key.xml
@@ -61,11 +61,14 @@
<p><code>string = [bytes()]</code></p>
<p><code>pki_asn1_type() = 'Certificate' | 'RSAPrivateKey'| 'RSAPublicKey'
- 'DSAPrivateKey' | 'DSAPublicKey' | 'DHParameter' | 'SubjectPublicKeyInfo'</code></p>
+ 'DSAPrivateKey' | 'DSAPublicKey' | 'DHParameter' | 'SubjectPublicKeyInfo'| 'PrivateKeyInfo'</code></p>
<p><code>pem_entry () = {pki_asn1_type(), binary(), %% DER or encrypted DER
- not_encrypted | {"DES-CBC" | "DES-EDE3-CBC", crypto:rand_bytes(8)}}.</code></p>
-
+ not_encrypted | cipher_info()} </code></p>
+
+ <p><code>cipher_info() = {"RC2-CBC | "DES-CBC" | "DES-EDE3-CBC", crypto:rand_bytes(8)} |
+ 'PBES2-params'} </code></p>
+
<p><code>rsa_public_key() = #'RSAPublicKey'{}</code></p>
<p><code>rsa_private_key() = #'RSAPrivateKey'{} </code></p>
@@ -118,7 +121,8 @@
<funcs>
<func>
- <name>decrypt_private(CipherText, Key [, Options]) -> binary()</name>
+ <name>decrypt_private(CipherText, Key) -> binary()</name>
+ <name>decrypt_private(CipherText, Key, Options) -> binary()</name>
<fsummary>Public key decryption.</fsummary>
<type>
<v>CipherText = binary()</v>
@@ -131,7 +135,8 @@
</func>
<func>
- <name>decrypt_public(CipherText, Key [, Options]) - > binary()</name>
+ <name>decrypt_public(CipherText, Key) - > binary()</name>
+ <name>decrypt_public(CipherText, Key, Options) - > binary()</name>
<fsummary></fsummary>
<type>
<v>CipherText = binary()</v>
@@ -198,7 +203,8 @@
</func>
<func>
- <name>pem_entry_decode(PemEntry [, Password]) -> term()</name>
+ <name>pem_entry_decode(PemEntry) -> term()</name>
+ <name>pem_entry_decode(PemEntry, Password) -> term()</name>
<fsummary>Decodes a pem entry.</fsummary>
<type>
<v> PemEntry = pem_entry() </v>
@@ -213,7 +219,8 @@
</func>
<func>
- <name>pem_entry_encode(Asn1Type, Entity [,{CipherInfo, Password}]) -> pem_entry()</name>
+ <name>pem_entry_encode(Asn1Type, Entity) -> pem_entry()</name>
+ <name>pem_entry_encode(Asn1Type, Entity, {CipherInfo, Password}) -> pem_entry()</name>
<fsummary> Creates a pem entry that can be fed to pem_encode/1.</fsummary>
<type>
<v>Asn1Type = pki_asn1_type()</v>
@@ -224,7 +231,7 @@
dsa_public_key() and this function will create the appropriate
'SubjectPublicKeyInfo' entry.
</d>
- <v>CipherInfo = {"DES-CBC" | "DES-EDE3-CBC", crypto:rand_bytes(8)}</v>
+ <v>CipherInfo = cipher_info()</v>
<v>Password = string()</v>
</type>
<desc>
diff --git a/lib/public_key/include/public_key.hrl b/lib/public_key/include/public_key.hrl
index 5f97d80f7e..2475295974 100644
--- a/lib/public_key/include/public_key.hrl
+++ b/lib/public_key/include/public_key.hrl
@@ -23,6 +23,7 @@
-define(public_key, true).
-include("OTP-PUB-KEY.hrl").
+-include("PKCS-FRAME.hrl").
-record('SubjectPublicKeyInfoAlgorithm', {
algorithm,
diff --git a/lib/public_key/src/Makefile b/lib/public_key/src/Makefile
index 5a24b02d2a..062c495a65 100644
--- a/lib/public_key/src/Makefile
+++ b/lib/public_key/src/Makefile
@@ -42,10 +42,11 @@ MODULES = \
public_key \
pubkey_pem \
pubkey_ssh \
+ pubkey_pbe \
pubkey_cert \
- pubkey_cert_records
+ pubkey_cert_records
-HRL_FILES = $(INCLUDE)/public_key.hrl
+HRL_FILES = $(INCLUDE)/public_key.hrl
INTERNAL_HRL_FILES =
@@ -109,4 +110,3 @@ release_spec: opt
$(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) $(RELSYSDIR)/ebin
release_docs_spec:
-
diff --git a/lib/public_key/src/pubkey_pbe.erl b/lib/public_key/src/pubkey_pbe.erl
new file mode 100644
index 0000000000..43f6c42f10
--- /dev/null
+++ b/lib/public_key/src/pubkey_pbe.erl
@@ -0,0 +1,213 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2011-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Description: Implements Password Based Encryption PKCS-5, RFC-2898
+
+-module(pubkey_pbe).
+
+-include("public_key.hrl").
+
+-export([encode/4, decode/4, decrypt_parameters/1]).
+-export([pbdkdf1/4, pbdkdf2/6]).
+
+-define(DEFAULT_SHA_MAC_KEYLEN, 20).
+-define(ASN1_OCTET_STR_TAG, 4).
+-define(IV_LEN, 8).
+
+%%====================================================================
+%% Internal application API
+%%====================================================================
+
+%%--------------------------------------------------------------------
+-spec encode(binary(), string(), string(), term()) -> binary().
+%%
+%% Description: Performs password based encoding
+%%--------------------------------------------------------------------
+encode(Data, Password, "DES-CBC" = Cipher, KeyDevParams) ->
+ {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams),
+ crypto:des_cbc_encrypt(Key, IV, Data);
+
+encode(Data, Password, "DES-EDE3-CBC" = Cipher, KeyDevParams) ->
+ {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams),
+ <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key,
+ crypto:des_ede3_cbc_encrypt(Key1, Key2, Key3, IV, Data);
+
+encode(Data, Password, "RC2-CBC" = Cipher, KeyDevParams) ->
+ {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams),
+ crypto:rc2_cbc_encrypt(Key, IV, Data).
+%%--------------------------------------------------------------------
+-spec decode(binary(), string(), string(), term()) -> binary().
+%%
+%% Description: Performs password based decoding
+%%--------------------------------------------------------------------
+decode(Data, Password,"DES-CBC"= Cipher, KeyDevParams) ->
+ {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams),
+ crypto:des_cbc_decrypt(Key, IV, Data);
+
+decode(Data, Password,"DES-EDE3-CBC" = Cipher, KeyDevParams) ->
+ {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams),
+ <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key,
+ crypto:des_ede3_cbc_decrypt(Key1, Key2, Key3, IV, Data);
+
+decode(Data, Password,"RC2-CBC"= Cipher, KeyDevParams) ->
+ {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams),
+ crypto:rc2_cbc_decrypt(Key, IV, Data).
+
+%%--------------------------------------------------------------------
+-spec pbdkdf1(string(), iodata(), integer(), atom()) -> binary().
+%%
+%% Description: Implements password based decryption key derive function 1.
+%% Exported mainly for testing purposes.
+%%--------------------------------------------------------------------
+pbdkdf1(_, _, 0, Acc) ->
+ Acc;
+pbdkdf1(Password, Salt, Count, Hash) ->
+ Result = crypto:Hash([Password, Salt]),
+ do_pbdkdf1(Result, Count-1, Result, Hash).
+
+%%--------------------------------------------------------------------
+-spec pbdkdf2(string(), iodata(), integer(), integer(), fun(), integer())
+ -> binary().
+%%
+%% Description: Implements password based decryption key derive function 2.
+%% Exported mainly for testing purposes.
+%%--------------------------------------------------------------------
+pbdkdf2(Password, Salt, Count, DerivedKeyLen, Prf, PrfOutputLen)->
+ NumBlocks = ceiling(DerivedKeyLen / PrfOutputLen),
+ NumLastBlockOctets = DerivedKeyLen - (NumBlocks - 1) * PrfOutputLen ,
+ blocks(NumBlocks, NumLastBlockOctets, 1, Password, Salt,
+ Count, Prf, PrfOutputLen, <<>>).
+%%--------------------------------------------------------------------
+-spec decrypt_parameters(#'EncryptedPrivateKeyInfo_encryptionAlgorithm'{}) ->
+ {Cipher::string(), #'PBES2-params'{}}.
+%%
+%% Description: Performs ANS1-decoding of encryption parameters.
+%%--------------------------------------------------------------------
+decrypt_parameters(#'EncryptedPrivateKeyInfo_encryptionAlgorithm'{
+ algorithm = Oid, parameters = Param}) ->
+ decrypt_parameters(Oid, Param).
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+password_to_key_and_iv(Password, _, #'PBES2-params'{} = Params) ->
+ {Salt, ItrCount, KeyLen, PseudoRandomFunction, PseudoOtputLen, IV} =
+ key_derivation_params(Params),
+ <<Key:KeyLen/binary, _/binary>> =
+ pbdkdf2(Password, Salt, ItrCount, KeyLen, PseudoRandomFunction, PseudoOtputLen),
+ {Key, IV};
+password_to_key_and_iv(Password, Cipher, Salt) ->
+ KeyLen = derived_key_length(Cipher, undefined),
+ <<Key:KeyLen/binary, _/binary>> =
+ pem_encrypt(<<>>, Password, Salt, ceiling(KeyLen div 16), <<>>, md5),
+ %% Old PEM encryption does not use standard encryption method
+ %% pbdkdf1 and uses then salt as IV
+ {Key, Salt}.
+
+pem_encrypt(_, _, _, 0, Acc, _) ->
+ Acc;
+pem_encrypt(Prev, Password, Salt, Count, Acc, Hash) ->
+ Result = crypto:Hash([Prev, Password, Salt]),
+ pem_encrypt(Result, Password, Salt, Count-1 , <<Acc/binary, Result/binary>>, Hash).
+
+do_pbdkdf1(_, 0, Acc, _) ->
+ Acc;
+do_pbdkdf1(Prev, Count, Acc, Hash) ->
+ Result = crypto:Hash(Prev),
+ do_pbdkdf1(Result, Count-1 , <<Result/binary, Acc/binary>>, Hash).
+
+iv(#'PBES2-params_encryptionScheme'{algorithm = Algo,
+ parameters = ASNIV}) when (Algo == ?'desCBC') or
+ (Algo == ?'des-EDE3-CBC') ->
+ %% This is an so called open ASN1-type that in this
+ %% case will be an octet-string of length 8
+ <<?ASN1_OCTET_STR_TAG, ?IV_LEN, IV:?IV_LEN/binary>> = ASNIV,
+ IV;
+iv(#'PBES2-params_encryptionScheme'{algorithm = ?'rc2CBC',
+ parameters = ASN1IV}) ->
+ {ok, #'RC2-CBC-Parameter'{iv = IV}} = 'PKCS-FRAME':decode('RC2-CBC-Parameter', ASN1IV),
+ iolist_to_binary(IV).
+
+blocks(1, N, Index, Password, Salt, Count, Prf, PrfLen, Acc) ->
+ <<XorSum:N/binary, _/binary>> = xor_sum(Password, Salt, Count, Index, Prf, PrfLen),
+ <<Acc/binary, XorSum/binary>>;
+blocks(NumBlocks, N, Index, Password, Salt, Count, Prf, PrfLen, Acc) ->
+ XorSum = xor_sum(Password, Salt, Count, Index, Prf, PrfLen),
+ blocks(NumBlocks -1, N, Index +1, Password, Salt, Count, Prf,
+ PrfLen, <<Acc/binary, XorSum/binary>>).
+
+xor_sum(Password, Salt, Count, Index, Prf, PrfLen) ->
+ Result = Prf(Password, [Salt,<<Index:32/unsigned-big-integer>>], PrfLen),
+ do_xor_sum(Prf, PrfLen, Result, Password, Count-1, Result).
+
+do_xor_sum(_, _, _, _, 0, Acc) ->
+ Acc;
+do_xor_sum(Prf, PrfLen, Prev, Password, Count, Acc)->
+ Result = Prf(Password, Prev, PrfLen),
+ do_xor_sum(Prf, PrfLen, Result, Password, Count-1, crypto:exor(Acc, Result)).
+
+decrypt_parameters(?'id-PBES2', DekParams) ->
+ {ok, Params} = 'PKCS-FRAME':decode('PBES2-params', DekParams),
+ {cipher(Params#'PBES2-params'.encryptionScheme), Params}.
+
+key_derivation_params(#'PBES2-params'{keyDerivationFunc = KeyDerivationFunc,
+ encryptionScheme = EncScheme}) ->
+ #'PBES2-params_keyDerivationFunc'{algorithm = ?'id-PBKDF2',
+ parameters =
+ #'PBKDF2-params'{salt = {specified, OctetSalt},
+ iterationCount = Count,
+ keyLength = Length,
+ prf = Prf}} = KeyDerivationFunc,
+ #'PBES2-params_encryptionScheme'{algorithm = Algo} = EncScheme,
+ {PseudoRandomFunction, PseudoOtputLen} = pseudo_random_function(Prf),
+ KeyLen = derived_key_length(Algo, Length),
+ {OctetSalt, Count, KeyLen,
+ PseudoRandomFunction, PseudoOtputLen, iv(EncScheme)}.
+
+%% This function currently matches a tuple that ougth to be the value
+%% ?'id-hmacWithSHA1, but we need some kind of ASN1-fix for this.
+pseudo_random_function(#'PBKDF2-params_prf'{algorithm =
+ {_,_, _,'id-hmacWithSHA1'}}) ->
+ {fun crypto:sha_mac/3, pseudo_output_length(?'id-hmacWithSHA1')};
+pseudo_random_function(#'PBKDF2-params_prf'{algorithm = ?'id-hmacWithSHA1'}) ->
+ {fun crypto:sha_mac/3, pseudo_output_length(?'id-hmacWithSHA1')}.
+
+pseudo_output_length(?'id-hmacWithSHA1') ->
+ ?DEFAULT_SHA_MAC_KEYLEN.
+
+derived_key_length(_, Len) when is_integer(Len) ->
+ Len;
+derived_key_length(Cipher,_) when (Cipher == ?'desCBC') or
+ (Cipher == "DES-CBC") ->
+ 8;
+derived_key_length(Cipher,_) when (Cipher == ?'rc2CBC') or
+ (Cipher == "RC2-CBC") ->
+ 16;
+derived_key_length(Cipher,_) when (Cipher == ?'des-EDE3-CBC') or
+ (Cipher == "DES-EDE3-CBC") ->
+ 24.
+
+cipher(#'PBES2-params_encryptionScheme'{algorithm = ?'desCBC'}) ->
+ "DES-CBC";
+cipher(#'PBES2-params_encryptionScheme'{algorithm = ?'des-EDE3-CBC'}) ->
+ "DES-EDE3-CBC";
+cipher(#'PBES2-params_encryptionScheme'{algorithm = ?'rc2CBC'}) ->
+ "RC2-CBC".
+
+ceiling(Float) ->
+ erlang:round(Float + 0.5).
diff --git a/lib/public_key/src/pubkey_pem.erl b/lib/public_key/src/pubkey_pem.erl
index c26815bc04..910473d629 100644
--- a/lib/public_key/src/pubkey_pem.erl
+++ b/lib/public_key/src/pubkey_pem.erl
@@ -43,8 +43,6 @@
-include("public_key.hrl").
-export([encode/1, decode/1, decipher/2, cipher/3]).
-%% Backwards compatibility
--export([decode_key/2]).
-define(ENCODED_LINE_LENGTH, 64).
@@ -69,23 +67,23 @@ encode(PemEntries) ->
encode_pem_entries(PemEntries).
%%--------------------------------------------------------------------
--spec decipher({pki_asn1_type(), DerEncrypted::binary(),{Cipher :: string(),
- Salt :: binary()}},
+-spec decipher({pki_asn1_type(), DerEncrypted::binary(),
+ {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{}}},
string()) -> Der::binary().
%%
%% Description: Deciphers a decrypted pem entry.
%%--------------------------------------------------------------------
-decipher({_, DecryptDer, {Cipher,Salt}}, Password) ->
- decode_key(DecryptDer, Password, Cipher, Salt).
+decipher({_, DecryptDer, {Cipher, KeyDevParams}}, Password) ->
+ pubkey_pbe:decode(DecryptDer, Password, Cipher, KeyDevParams).
%%--------------------------------------------------------------------
--spec cipher(Der::binary(),{Cipher :: string(), Salt :: binary()} ,
+-spec cipher(Der::binary(), {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{}} ,
string()) -> binary().
%%
%% Description: Ciphers a PEM entry
%%--------------------------------------------------------------------
-cipher(Der, {Cipher,Salt}, Password)->
- encode_key(Der, Password, Cipher, Salt).
+cipher(Der, {Cipher, KeyDevParams}, Password)->
+ pubkey_pbe:encode(Der, Password, Cipher, KeyDevParams).
%%--------------------------------------------------------------------
%%% Internal functions
@@ -127,8 +125,20 @@ decode_pem_entry(Start, Lines) ->
Type = asn1_type(Start),
Cs = erlang:iolist_to_binary(Lines),
Decoded = base64:mime_decode(Cs),
- {Type, Decoded, not_encrypted}.
-
+ case Type of
+ 'EncryptedPrivateKeyInfo'->
+ decode_encrypted_private_keyinfo(Decoded);
+ _ ->
+ {Type, Decoded, not_encrypted}
+ end.
+
+decode_encrypted_private_keyinfo(Der) ->
+ #'EncryptedPrivateKeyInfo'{encryptionAlgorithm = AlgorithmInfo,
+ encryptedData = Data} =
+ public_key:der_decode('EncryptedPrivateKeyInfo', Der),
+ DecryptParams = pubkey_pbe:decrypt_parameters(AlgorithmInfo),
+ {'PrivateKeyInfo', iolist_to_binary(Data), DecryptParams}.
+
split_bin(Bin) ->
split_bin(0, Bin).
@@ -160,37 +170,6 @@ join_entry([<<"-----END ", _/binary>>| Lines], Entry) ->
join_entry([Line | Lines], Entry) ->
join_entry(Lines, [Line | Entry]).
-decode_key(Data, Password, "DES-CBC", Salt) ->
- Key = password_to_key(Password, Salt, 8),
- IV = Salt,
- crypto:des_cbc_decrypt(Key, IV, Data);
-decode_key(Data, Password, "DES-EDE3-CBC", Salt) ->
- Key = password_to_key(Password, Salt, 24),
- IV = Salt,
- <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key,
- crypto:des_ede3_cbc_decrypt(Key1, Key2, Key3, IV, Data).
-
-encode_key(Data, Password, "DES-CBC", Salt) ->
- Key = password_to_key(Password, Salt, 8),
- IV = Salt,
- crypto:des_cbc_encrypt(Key, IV, Data);
-encode_key(Data, Password, "DES-EDE3-CBC", Salt) ->
- Key = password_to_key(Password, Salt, 24),
- IV = Salt,
- <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key,
- crypto:des_ede3_cbc_encrypt(Key1, Key2, Key3, IV, Data).
-
-password_to_key(Data, Salt, KeyLen) ->
- <<Key:KeyLen/binary, _/binary>> =
- password_to_key(<<>>, Data, Salt, KeyLen, <<>>),
- Key.
-
-password_to_key(_, _, _, Len, Acc) when Len =< 0 ->
- Acc;
-password_to_key(Prev, Data, Salt, Len, Acc) ->
- M = crypto:md5([Prev, Data, Salt]),
- password_to_key(M, Data, Salt, Len - size(M), <<Acc/binary, M/binary>>).
-
unhex(S) ->
unhex(S, []).
@@ -228,6 +207,10 @@ pem_end(<<"-----BEGIN DSA PRIVATE KEY-----">>) ->
<<"-----END DSA PRIVATE KEY-----">>;
pem_end(<<"-----BEGIN DH PARAMETERS-----">>) ->
<<"-----END DH PARAMETERS-----">>;
+pem_end(<<"-----BEGIN PRIVATE KEY-----">>) ->
+ <<"-----END PRIVATE KEY-----">>;
+pem_end(<<"-----BEGIN ENCRYPTED PRIVATE KEY-----">>) ->
+ <<"-----END ENCRYPTED PRIVATE KEY-----">>;
pem_end(_) ->
undefined.
@@ -242,18 +225,14 @@ asn1_type(<<"-----BEGIN PUBLIC KEY-----">>) ->
asn1_type(<<"-----BEGIN DSA PRIVATE KEY-----">>) ->
'DSAPrivateKey';
asn1_type(<<"-----BEGIN DH PARAMETERS-----">>) ->
- 'DHParameter'.
+ 'DHParameter';
+asn1_type(<<"-----BEGIN PRIVATE KEY-----">>) ->
+ 'PrivateKeyInfo';
+asn1_type(<<"-----BEGIN ENCRYPTED PRIVATE KEY-----">>) ->
+ 'EncryptedPrivateKeyInfo'.
pem_decrypt() ->
<<"Proc-Type: 4,ENCRYPTED">>.
pem_decrypt_info(Cipher, Salt) ->
io_lib:format("DEK-Info: ~s,~s", [Cipher, lists:flatten(hexify(Salt))]).
-
-%%--------------------------------------------------------------------
-%%% Deprecated
-%%--------------------------------------------------------------------
-decode_key({_Type, Bin, not_encrypted}, _) ->
- Bin;
-decode_key({_Type, Bin, {Chipher,Salt}}, Password) ->
- decode_key(Bin, Password, Chipher, Salt).
diff --git a/lib/public_key/src/public_key.app.src b/lib/public_key/src/public_key.app.src
index 1963bd05d4..4cc81ea573 100644
--- a/lib/public_key/src/public_key.app.src
+++ b/lib/public_key/src/public_key.app.src
@@ -3,10 +3,12 @@
{vsn, "%VSN%"},
{modules, [ public_key,
pubkey_pem,
+ pubkey_pbe,
pubkey_ssh,
pubkey_cert,
pubkey_cert_records,
- 'OTP-PUB-KEY'
+ 'OTP-PUB-KEY',
+ 'PKCS-FRAME'
]},
{applications, [crypto, kernel, stdlib]},
{registered, []},
diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl
index 33fcce2c44..753322b46d 100644
--- a/lib/public_key/src/public_key.erl
+++ b/lib/public_key/src/public_key.erl
@@ -45,13 +45,6 @@
ssh_decode/2, ssh_encode/2
]).
-%% Deprecated
--export([decode_private_key/1, decode_private_key/2, pem_to_der/1]).
-
--deprecated({pem_to_der, 1, next_major_release}).
--deprecated({decode_private_key, 1, next_major_release}).
--deprecated({decode_private_key, 2, next_major_release}).
-
-type rsa_padding() :: 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding'
| 'rsa_no_padding'.
-type public_crypt_options() :: [{rsa_pad, rsa_padding()}].
@@ -104,22 +97,23 @@ pem_entry_decode({Asn1Type, Der, not_encrypted}) when is_atom(Asn1Type),
pem_entry_decode({Asn1Type, Der, not_encrypted}, _) when is_atom(Asn1Type),
is_binary(Der) ->
der_decode(Asn1Type, Der);
+pem_entry_decode({Asn1Type, CryptDer, {Cipher, #'PBES2-params'{}}} = PemEntry,
+ Password) when is_atom(Asn1Type) andalso
+ is_binary(CryptDer) andalso
+ is_list(Cipher) ->
+ do_pem_entry_decode(PemEntry, Password);
pem_entry_decode({Asn1Type, CryptDer, {Cipher, Salt}} = PemEntry,
- Password) when is_atom(Asn1Type),
- is_binary(CryptDer),
- is_list(Cipher),
- is_binary(Salt),
- erlang:byte_size(Salt) == 8
- ->
- Der = pubkey_pem:decipher(PemEntry, Password),
- der_decode(Asn1Type, Der).
+ Password) when is_atom(Asn1Type) andalso
+ is_binary(CryptDer) andalso
+ is_list(Cipher) andalso
+ is_binary(Salt) andalso
+ erlang:byte_size(Salt) == 8 ->
+ do_pem_entry_decode(PemEntry, Password).
%%--------------------------------------------------------------------
-spec pem_entry_encode(pki_asn1_type(), term()) -> pem_entry().
--spec pem_entry_encode(pki_asn1_type(), term(),
- {{Cipher :: string(), Salt :: binary()}, string()}) ->
- pem_entry().
-%
+-spec pem_entry_encode(pki_asn1_type(), term(), term()) -> pem_entry().
+%%
%% Description: Creates a pem entry that can be feed to pem_encode/1.
%%--------------------------------------------------------------------
pem_entry_encode('SubjectPublicKeyInfo', Entity=#'RSAPublicKey'{}) ->
@@ -137,21 +131,36 @@ pem_entry_encode('SubjectPublicKeyInfo',
pem_entry_encode(Asn1Type, Entity) when is_atom(Asn1Type) ->
Der = der_encode(Asn1Type, Entity),
{Asn1Type, Der, not_encrypted}.
-pem_entry_encode(Asn1Type, Entity,
- {{Cipher, Salt}= CipherInfo, Password}) when is_atom(Asn1Type),
- is_list(Cipher),
- is_binary(Salt),
- erlang:byte_size(Salt) == 8,
- is_list(Password)->
- Der = der_encode(Asn1Type, Entity),
- DecryptDer = pubkey_pem:cipher(Der, CipherInfo, Password),
- {Asn1Type, DecryptDer, CipherInfo}.
-
+pem_entry_encode(Asn1Type, Entity, {{Cipher, #'PBES2-params'{}} = CipherInfo,
+ Password}) when is_atom(Asn1Type) andalso
+ is_list(Password) andalso
+ is_list(Cipher) ->
+ do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password);
+
+pem_entry_encode(Asn1Type, Entity, {{Cipher, Salt} = CipherInfo,
+ Password}) when is_atom(Asn1Type) andalso
+ is_list(Password) andalso
+ is_list(Cipher) andalso
+ is_binary(Salt) andalso
+ erlang:byte_size(Salt) == 8 ->
+ do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password).
+
%%--------------------------------------------------------------------
-spec der_decode(asn1_type(), Der::binary()) -> term().
%%
%% Description: Decodes a public key asn1 der encoded entity.
%%--------------------------------------------------------------------
+der_decode(Asn1Type, Der) when (Asn1Type == 'PrivateKeyInfo') or
+ (Asn1Type == 'EncryptedPrivateKeyInfo')
+ andalso is_binary(Der) ->
+ try
+ {ok, Decoded} = 'PKCS-FRAME':decode(Asn1Type, Der),
+ Decoded
+ catch
+ error:{badmatch, {error, _}} = Error ->
+ erlang:error(Error)
+ end;
+
der_decode(Asn1Type, Der) when is_atom(Asn1Type), is_binary(Der) ->
try
{ok, Decoded} = 'OTP-PUB-KEY':decode(Asn1Type, Der),
@@ -166,6 +175,16 @@ der_decode(Asn1Type, Der) when is_atom(Asn1Type), is_binary(Der) ->
%%
%% Description: Encodes a public key entity with asn1 DER encoding.
%%--------------------------------------------------------------------
+der_encode(Asn1Type, Entity) when (Asn1Type == 'PrivateKeyInfo') or
+ (Asn1Type == 'EncryptedPrivateKeyInfo') ->
+ try
+ {ok, Encoded} = 'PKCS-FRAME':encode(Asn1Type, Entity),
+ iolist_to_binary(Encoded)
+ catch
+ error:{badmatch, {error, _}} = Error ->
+ erlang:error(Error)
+ end;
+
der_encode(Asn1Type, Entity) when is_atom(Asn1Type) ->
try
{ok, Encoded} = 'OTP-PUB-KEY':encode(Asn1Type, Entity),
@@ -535,6 +554,14 @@ ssh_encode(Entries, Type) when is_list(Entries),
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
+do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password) ->
+ Der = der_encode(Asn1Type, Entity),
+ DecryptDer = pubkey_pem:cipher(Der, CipherInfo, Password),
+ {Asn1Type, DecryptDer, CipherInfo}.
+
+do_pem_entry_decode({Asn1Type,_, _} = PemEntry, Password) ->
+ Der = pubkey_pem:decipher(PemEntry, Password),
+ der_decode(Asn1Type, Der).
encrypt_public(PlainText, N, E, Options)->
Padding = proplists:get_value(rsa_pad, Options, rsa_pkcs1_padding),
@@ -632,20 +659,3 @@ validate(DerCert, #path_validation_state{working_issuer_name = Issuer,
sized_binary(Binary) ->
Size = size(Binary),
<<?UINT32(Size), Binary/binary>>.
-
-%%--------------------------------------------------------------------
-%%% Deprecated functions
-%%--------------------------------------------------------------------
-pem_to_der(CertSource) ->
- {ok, Bin} = file:read_file(CertSource),
- {ok, pubkey_pem:decode(Bin)}.
-
-decode_private_key(KeyInfo) ->
- decode_private_key(KeyInfo, no_passwd).
-
-decode_private_key(KeyInfo = {'RSAPrivateKey', _, _}, Password) ->
- DerEncoded = pubkey_pem:decode_key(KeyInfo, Password),
- 'OTP-PUB-KEY':decode('RSAPrivateKey', DerEncoded);
-decode_private_key(KeyInfo = {'DSAPrivateKey', _, _}, Password) ->
- DerEncoded = pubkey_pem:decode_key(KeyInfo, Password),
- 'OTP-PUB-KEY':decode('DSAPrivateKey', DerEncoded).
diff --git a/lib/public_key/test/Makefile b/lib/public_key/test/Makefile
index 6889ae9a8a..b7f91981a5 100644
--- a/lib/public_key/test/Makefile
+++ b/lib/public_key/test/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2008-2010. All Rights Reserved.
+# Copyright Ericsson AB 2008-2011. All Rights Reserved.
#
# The contents of this file are subject to the Erlang Public License,
# Version 1.1, (the "License"); you may not use this file except in
@@ -30,6 +30,7 @@ INCLUDES= -I. -I ../include
MODULES= \
erl_make_certs \
public_key_SUITE \
+ pbe_SUITE \
pkits_SUITE
ERL_FILES= $(MODULES:%=%.erl)
diff --git a/lib/public_key/test/pbe_SUITE.erl b/lib/public_key/test/pbe_SUITE.erl
new file mode 100644
index 0000000000..380a67db7b
--- /dev/null
+++ b/lib/public_key/test/pbe_SUITE.erl
@@ -0,0 +1,259 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2011-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(pbe_SUITE).
+
+-include_lib("test_server/include/test_server.hrl").
+-include_lib("public_key/include/public_key.hrl").
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+%% Test server callback functions
+%%--------------------------------------------------------------------
+%% Function: init_per_suite(Config) -> Config
+%% Config - [tuple()]
+%% A list of key/value pairs, holding the test case configuration.
+%% Description: Initialization before the whole suite
+%%
+%% Note: This function is free to add any key/value pairs to the Config
+%% variable, but should NOT alter/remove any existing entries.
+%%--------------------------------------------------------------------
+init_per_suite(Config) ->
+ try crypto:start() of
+ ok ->
+ Config
+ catch _:_ ->
+ {skip, "Crypto did not start"}
+ end.
+%%--------------------------------------------------------------------
+%% Function: end_per_suite(Config) -> _
+%% Config - [tuple()]
+%% A list of key/value pairs, holding the test case configuration.
+%% Description: Cleanup after the whole suite
+%%--------------------------------------------------------------------
+end_per_suite(_Config) ->
+ application:stop(crypto).
+
+%%--------------------------------------------------------------------
+%% Function: init_per_testcase(TestCase, Config) -> Config
+%% Case - atom()
+%% Name of the test case that is about to be run.
+%% Config - [tuple()]
+%% A list of key/value pairs, holding the test case configuration.
+%%
+%% Description: Initialization before each test case
+%%
+%% Note: This function is free to add any key/value pairs to the Config
+%% variable, but should NOT alter/remove any existing entries.
+%% Description: Initialization before each test case
+%%--------------------------------------------------------------------
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+%%--------------------------------------------------------------------
+%% Function: end_per_testcase(TestCase, Config) -> _
+%% Case - atom()
+%% Name of the test case that is about to be run.
+%% Config - [tuple()]
+%% A list of key/value pairs, holding the test case configuration.
+%% Description: Cleanup after each test case
+%%--------------------------------------------------------------------
+end_per_testcase(_TestCase, _Config) ->
+ ok.
+
+%%--------------------------------------------------------------------
+%% Function: all(Clause) -> TestCases
+%% Clause - atom() - suite | doc
+%% TestCases - [Case]
+%% Case - atom()
+%% Name of a test case.
+%% Description: Returns a list of all test cases in this test suite
+%%--------------------------------------------------------------------
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [
+ pbdkdf1,
+ pbdkdf2,
+ encrypted_private_key_info].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+%% Test cases starts here.
+%%--------------------------------------------------------------------
+pbdkdf1(doc) ->
+ ["Test with PKCS #5 PBKDF1 Test Vectors"];
+pbdkdf1(Config) when is_list(Config) ->
+ %%Password = "password"
+ %% = (0x)70617373776F7264
+ %%Salt = (0x)78578E5A5D63CB06
+ %%Count = 1000
+ %%kLen = 16
+ %%Key = PBKDF1(Password, Salt, Count, kLen)
+ %%= (0x)DC19847E05C64D2FAF10EBFB4A3D2A20
+
+ Password = "password",
+ Salt = <<16#78,16#57,16#8E,16#5A,16#5D,16#63,16#CB,16#06>>,
+ Count = 1000,
+
+ <<16#DC, 16#19, 16#84, 16#7E,
+ 16#05, 16#C6, 16#4D, 16#2F,
+ 16#AF, 16#10, 16#EB, 16#FB,
+ 16#4A, 16#3D, 16#2A, 16#20, _/binary>> =
+ pubkey_pbe:pbdkdf1(Password, Salt, Count, sha).
+
+pbdkdf2(doc) ->
+ ["Test with PKCS #5 PBKDF2 Test Vectors"];
+pbdkdf2(Config) when is_list(Config) ->
+ %% Input:
+ %% P = "password" (8 octets)
+ %% S = "salt" (4 octets)
+ %% c = 1
+ %% dkLen = 20
+
+ %% Output:
+ %% DK = 0c 60 c8 0f 96 1f 0e 71
+ %% f3 a9 b5 24 af 60 12 06
+ %% 2f e0 37 a6 (20 octets)
+
+ <<16#0c, 16#60, 16#c8, 16#0f, 16#96, 16#1f, 16#0e, 16#71,
+ 16#f3, 16#a9, 16#b5, 16#24, 16#af, 16#60, 16#12, 16#06,
+ 16#2f, 16#e0, 16#37, 16#a6>> = pubkey_pbe:pbdkdf2("password", "salt", 1, 20, fun crypto:sha_mac/3, 20),
+
+ %% Input:
+ %% P = "password" (8 octets)
+ %% S = "salt" (4 octets)
+ %% c = 2
+ %% dkLen = 20
+
+ %% Output:
+ %% DK = ea 6c 01 4d c7 2d 6f 8c
+ %% cd 1e d9 2a ce 1d 41 f0
+ %% d8 de 89 57 (20 octets)
+
+ <<16#ea, 16#6c, 16#01, 16#4d, 16#c7, 16#2d, 16#6f, 16#8c,
+ 16#cd, 16#1e, 16#d9, 16#2a, 16#ce, 16#1d, 16#41, 16#f0,
+ 16#d8, 16#de, 16#89, 16#57>> =
+ pubkey_pbe:pbdkdf2("password", "salt", 2, 20, fun crypto:sha_mac/3, 20),
+
+ %% Input:
+ %% P = "password" (8 octets)
+ %% S = "salt" (4 octets)
+ %% c = 4096
+ %% dkLen = 20
+
+ %% Output:
+ %% DK = 4b 00 79 01 b7 65 48 9a
+ %% be ad 49 d9 26 f7 21 d0
+ %% 65 a4 29 c1 (20 octets)
+
+ <<16#4b, 16#00, 16#79, 16#01, 16#b7, 16#65, 16#48, 16#9a,
+ 16#be, 16#ad, 16#49, 16#d9, 16#26, 16#f7, 16#21, 16#d0,
+ 16#65, 16#a4, 16#29, 16#c1>> = pubkey_pbe:pbdkdf2("password", "salt", 4096, 20, fun crypto:sha_mac/3, 20),
+
+ %% Input:
+ %% P = "password" (8 octets)
+ %% S = "salt" (4 octets)
+ %% c = 16777216
+ %% dkLen = 20
+
+ %% Output:
+ %% DK = ee fe 3d 61 cd 4d a4 e4
+ %% e9 94 5b 3d 6b a2 15 8c
+ %% 26 34 e9 84 (20 octets)
+
+
+ <<16#ee, 16#fe, 16#3d, 16#61, 16#cd, 16#4d, 16#a4, 16#e4,
+ 16#e9, 16#94, 16#5b, 16#3d, 16#6b, 16#a2, 16#15, 16#8c,
+ 16#26, 16#34, 16#e9, 16#84>> = pubkey_pbe:pbdkdf2("password", "salt", 16777216, 20, fun crypto:sha_mac/3, 20),
+
+ %% Input:
+ %% P = "passwordPASSWORDpassword" (24 octets)
+ %% S = "saltSALTsaltSALTsaltSALTsaltSALTsalt" (36 octets)
+ %% c = 4096
+ %% dkLen = 25
+
+ %% Output:
+ %% DK = 3d 2e ec 4f e4 1c 84 9b
+ %% 80 c8 d8 36 62 c0 e4 4a
+ %% 8b 29 1a 96 4c f2 f0 70
+ %% 38 (25 octets)
+
+ <<16#3d, 16#2e, 16#ec, 16#4f, 16#e4, 16#1c, 16#84, 16#9b,
+ 16#80, 16#c8, 16#d8, 16#36, 16#62, 16#c0, 16#e4, 16#4a,
+ 16#8b, 16#29, 16#1a, 16#96, 16#4c, 16#f2, 16#f0, 16#70,
+ 16#38>>
+ = pubkey_pbe:pbdkdf2("passwordPASSWORDpassword",
+ "saltSALTsaltSALTsaltSALTsaltSALTsalt", 4096, 25, fun crypto:sha_mac/3, 20),
+
+ %% Input:
+ %% P = "pass\0word" (9 octets)
+ %% S = "sa\0lt" (5 octets)
+ %% c = 4096
+ %% dkLen = 16
+
+ %% Output:
+ %% DK = 56 fa 6a a7 55 48 09 9d
+ %% cc 37 d7 f0 34 25 e0 c3 (16 octets)
+
+ <<16#56, 16#fa, 16#6a, 16#a7, 16#55, 16#48, 16#09, 16#9d,
+ 16#cc, 16#37, 16#d7, 16#f0, 16#34, 16#25, 16#e0, 16#c3>>
+ = pubkey_pbe:pbdkdf2("pass\0word",
+ "sa\0lt", 4096, 16, fun crypto:sha_mac/3, 20).
+
+encrypted_private_key_info(doc) ->
+ ["Tests reading a EncryptedPrivateKeyInfo file encrypted with different ciphers"];
+encrypted_private_key_info(Config) when is_list(Config) ->
+ Datadir = ?config(data_dir, Config),
+ {ok, PemDes} = file:read_file(filename:join(Datadir, "des_cbc_enc_key.pem")),
+
+ PemDesEntry = public_key:pem_decode(PemDes),
+ test_server:format("Pem entry: ~p" , [PemDesEntry]),
+ [{'PrivateKeyInfo', _, {"DES-CBC",_}} = PubEntry0] = PemDesEntry,
+ KeyInfo = public_key:pem_entry_decode(PubEntry0, "password"),
+
+ {ok, Pem3Des} = file:read_file(filename:join(Datadir, "des_ede3_cbc_enc_key.pem")),
+
+ Pem3DesEntry = public_key:pem_decode(Pem3Des),
+ test_server:format("Pem entry: ~p" , [Pem3DesEntry]),
+ [{'PrivateKeyInfo', _, {"DES-EDE3-CBC",_}} = PubEntry1] = Pem3DesEntry,
+ KeyInfo = public_key:pem_entry_decode(PubEntry1, "password"),
+
+ {ok, PemRc2} = file:read_file(filename:join(Datadir, "rc2_cbc_enc_key.pem")),
+
+ PemRc2Entry = public_key:pem_decode(PemRc2),
+ test_server:format("Pem entry: ~p" , [PemRc2Entry]),
+ [{'PrivateKeyInfo', _, {"RC2-CBC",_}} = PubEntry2] = PemRc2Entry,
+ KeyInfo = public_key:pem_entry_decode(PubEntry2, "password"),
+
+ check_key_info(KeyInfo).
+
+
+check_key_info(#'PrivateKeyInfo'{privateKeyAlgorithm =
+ #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?rsaEncryption},
+ privateKey = Key}) ->
+ #'RSAPrivateKey'{} = public_key:der_decode('RSAPrivateKey', iolist_to_binary(Key)).
diff --git a/lib/public_key/test/pbe_SUITE_data/des_cbc_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/des_cbc_enc_key.pem
new file mode 100644
index 0000000000..eaa06145aa
--- /dev/null
+++ b/lib/public_key/test/pbe_SUITE_data/des_cbc_enc_key.pem
@@ -0,0 +1,11 @@
+-----BEGIN ENCRYPTED PRIVATE KEY-----
+MIIBozA9BgkqhkiG9w0BBQ0wMDAbBgkqhkiG9w0BBQwwDgQIfWBDXwLp4K4CAggA
+MBEGBSsOAwIHBAiaCF/AvOgQ6QSCAWDWX4BdAzCRNSQSANSuNsT5X8mWYO27mr3Y
+9c9LoBVXGNmYWKA77MI4967f7SmjNcgXj3xNE/jmnVz6hhsjS8E5VPT3kfyVkpdZ
+0lr5e9Yk2m3JWpPU7++v5zBkZmC4V/MwV/XuIs6U+vykgzMgpxQg0oZKS9zgmiZo
+f/4dOCL0UtCDnyOSvqT7mCVIcMDIEKu8QbVlgZYBop08l60EuEU3gARUo8WsYQmO
+Dz/ldx0Z+znIT0SXVuOwc+RVItC5T/Qx+aijmmpt+9l14nmaGBrEkmuhmtdvU/4v
+aptewGRgmjOfD6cqK+zs0O5NrrJ3P/6ZSxXj91CQgrThGfOv72bUncXEMNtc8pks
+2jpHFjGMdKufnadAD7XuMgzkkaklEXZ4f5tU6heIIwr51g0GBEGF96gYPFnjnSQM
+75JE02Clo+DfcfXpcybPTwwFg2jd6JTTOfkdf6OdSlA/1XNK43FA
+-----END ENCRYPTED PRIVATE KEY-----
diff --git a/lib/public_key/test/pbe_SUITE_data/des_ede3_cbc_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/des_ede3_cbc_enc_key.pem
new file mode 100644
index 0000000000..22ea46d56f
--- /dev/null
+++ b/lib/public_key/test/pbe_SUITE_data/des_ede3_cbc_enc_key.pem
@@ -0,0 +1,11 @@
+-----BEGIN ENCRYPTED PRIVATE KEY-----
+MIIBpjBABgkqhkiG9w0BBQ0wMzAbBgkqhkiG9w0BBQwwDgQIeFeOWl1jywYCAggA
+MBQGCCqGSIb3DQMHBAjUJ5eGBhQGtQSCAWBrHrRgqO8UUMLcWzZEtpk1l3mjxiF/
+koCMkHsFwowgyWhEbgIkTgbSViK54LVK8PskekcGNLph+rB6bGZ7pPbL5pbXASJ8
++MkQcG3FZdlS4Ek9tTJDApj3O1UubZGFG4uvTlJJFbF1BOJ3MkY3XQ9Gl1qwv7j5
+6e103Da7Cq9+oIDKmznza78XXQYrUsPo8mJGjUxPskEYlzwvHjKubRnYm/K6RKhi
+5f4zX4BQ/Dt3H812ZjRXrsjAJP0KrD/jyD/jCT7zNBVPH1izBds+RwizyQAHwfNJ
+BFR78TH4cgzB619X47FDVOnT0LqQNVd0O3cSwnPrXE9XR3tPayE+iOB15llFSmi8
+z0ByOXldEpkezCn92Umk++suzIVj1qfsK+bv2phZWJPbLEIWPDRHUbYf76q5ArAr
+u4xtxT/hoK3krEs/IN3d70qjlUJ36SEw1UaZ82PWhakQbdtu39ZraMJB
+-----END ENCRYPTED PRIVATE KEY-----
diff --git a/lib/public_key/test/pbe_SUITE_data/rc2_cbc_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/rc2_cbc_enc_key.pem
new file mode 100644
index 0000000000..618cddcfd7
--- /dev/null
+++ b/lib/public_key/test/pbe_SUITE_data/rc2_cbc_enc_key.pem
@@ -0,0 +1,12 @@
+-----BEGIN ENCRYPTED PRIVATE KEY-----
+MIIBrjBIBgkqhkiG9w0BBQ0wOzAeBgkqhkiG9w0BBQwwEQQIrHyQPBZqWLUCAggA
+AgEQMBkGCCqGSIb3DQMCMA0CAToECEhbh7YZKiPSBIIBYCT1zp6o5jpFlIkgwPop
+7bW1+8ACr4exqzkeb3WflQ8cWJ4cURxzVdvxUnXeW1VJdaQZtjS/QHs5GhPTG/0f
+wtvnaPfwrIJ3FeGaZfcg2CrYhalOFmEb4xrE4KyoEQmUN8tb/Cg94uzd16BOPw21
+RDnE8bnPdIGY7TyL95kbkqH23mK53pi7h+xWIgduW+atIqDyyt55f7WMZcvDvlj6
+VpN/V0h+qxBHL274WA4dj6GYgeyUFpi60HdGCK7By2TBy8h1ZvKGjmB9h8jZvkx1
+MkbRumXxyFsowTZawyYvO8Um6lbfEDP9zIEUq0IV8RqH2MRyblsPNSikyYhxX/cz
+tdDxRKhilySbSBg5Kr8OfcwKp9bpinN96nmG4xr3Tch1bnVvqJzOQ5+Vva2WwVvH
+2JkWvYm5WaANg4Q6bRxu9vz7DuhbJjQdZbxFezIAgrJdSe92B00jO/0Kny1WjiVO
+6DA=
+-----END ENCRYPTED PRIVATE KEY-----
diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl
index b11e4d092a..a91dcfa029 100644
--- a/lib/public_key/test/public_key_SUITE.erl
+++ b/lib/public_key/test/public_key_SUITE.erl
@@ -23,8 +23,8 @@
%% Note: This directive should only be used in test suites.
-compile(export_all).
--include_lib("common_test/include/ct.hrl").
--include_lib("test_server/include/test_server_line.hrl").
+%%-include_lib("common_test/include/ct.hrl").
+-include_lib("test_server/include/test_server.hrl").
-include_lib("public_key/include/public_key.hrl").
@@ -107,7 +107,7 @@ all() ->
{group, ssh_public_key_decode_encode},
encrypt_decrypt,
{group, sign_verify},
- pkix, pkix_path_validation, deprecated].
+ pkix, pkix_path_validation].
groups() ->
[{pem_decode_encode, [], [dsa_pem, rsa_pem, encrypted_pem,
@@ -699,27 +699,6 @@ pkix_path_validation(Config) when is_list(Config) ->
VerifyFunAndState1}]),
ok.
-%%--------------------------------------------------------------------
-deprecated(doc) ->
- ["Check deprecated functions."];
-deprecated(suite) ->
- [];
-deprecated(Config) when is_list(Config) ->
- Datadir = ?config(data_dir, Config),
- {ok, [DsaKey = {'DSAPrivateKey', _DsaKey, _}]} =
- public_key:pem_to_der(filename:join(Datadir, "dsa.pem")),
- {ok, [RsaKey = {'RSAPrivateKey', _RsaKey,_}]} =
- public_key:pem_to_der(filename:join(Datadir, "client_key.pem")),
- {ok, [ProtectedRsaKey = {'RSAPrivateKey', _ProtectedRsaKey,_}]} =
- public_key:pem_to_der(filename:join(Datadir, "rsa.pem")),
-
- {ok, #'DSAPrivateKey'{}} = public_key:decode_private_key(DsaKey),
- {ok, #'RSAPrivateKey'{}} = public_key:decode_private_key(RsaKey),
- {ok, #'RSAPrivateKey'{}} = public_key:decode_private_key(ProtectedRsaKey, "abcd1234"),
- ok.
-
-%%--------------------------------------------------------------------
-
check_entry_type(#'DSAPrivateKey'{}, 'DSAPrivateKey') ->
true;
check_entry_type(#'RSAPrivateKey'{}, 'RSAPrivateKey') ->
diff --git a/lib/runtime_tools/src/erts_alloc_config.erl b/lib/runtime_tools/src/erts_alloc_config.erl
index 0bcb202fd8..1a57c94443 100644
--- a/lib/runtime_tools/src/erts_alloc_config.erl
+++ b/lib/runtime_tools/src/erts_alloc_config.erl
@@ -1,6 +1,7 @@
+%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -16,6 +17,7 @@
%% The Initial Developer of the Original Code is Ericsson AB.
%%
%% %CopyrightEnd%
+%%
%%%-------------------------------------------------------------------
%%% File : erts_alloc_config.erl
@@ -71,6 +73,7 @@
A == binary_alloc;
A == std_alloc;
A == ets_alloc;
+ A == fix_alloc;
A == eheap_alloc;
A == ll_alloc;
A == sl_alloc;
@@ -94,6 +97,7 @@
[{binary_alloc, 131072},
{std_alloc, 131072},
{ets_alloc, 131072},
+ {fix_alloc, 131072},
{eheap_alloc, 524288},
{ll_alloc, 2097152},
{sl_alloc, 131072},
@@ -104,6 +108,7 @@
[{binary_alloc, 10},
{std_alloc, 10},
{ets_alloc, 10},
+ {fix_alloc, 10},
{eheap_alloc, 10},
{ll_alloc, 0},
{sl_alloc, 10},
@@ -438,9 +443,6 @@ conf_alloc(#conf{format_to = FTO} = Conf, #alloc{name = A} = Alc) ->
chk_xnote(Conf, Alc).
chk_xnote(#conf{format_to = FTO},
- #alloc{name = fix_alloc}) ->
- fcp(FTO, "Cannot be configured.");
-chk_xnote(#conf{format_to = FTO},
#alloc{name = sys_alloc}) ->
fcp(FTO, "Cannot be configured. Default malloc implementation used.");
chk_xnote(#conf{format_to = FTO},
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index 70122e4393..50268ae206 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -71,7 +71,8 @@
{fail_if_no_peer_cert, boolean()}
{depth, integer()} |
{cert, der_encoded()}| {certfile, path()} |
- {key, der_encoded()} | {keyfile, path()} | {password, string()} |
+ {key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'PrivateKeyInfo', der_encoded()}} |
+ {keyfile, path()} | {password, string()} |
{cacerts, [der_encoded()]} | {cacertfile, path()} |
|{dh, der_encoded()} | {dhfile, path()} | {ciphers, ciphers()} |
{ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | {reuse_session, fun()}
@@ -139,7 +140,7 @@
<tag>{certfile, path()}</tag>
<item>Path to a file containing the user's certificate.</item>
- <tag>{key, der_encoded()}</tag>
+ <tag>{key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'PrivateKeyInfo', der_encoded()}}</tag>
<item> The DER encoded users private key. If this option
is supplied it will override the keyfile option.</item>
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 35f9410562..d0693445e0 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -608,8 +608,11 @@ validate_option(certfile, Value) when Value == undefined; is_list(Value) ->
validate_option(key, undefined) ->
undefined;
validate_option(key, {KeyType, Value}) when is_binary(Value),
- KeyType == rsa;
- KeyType == dsa ->
+ KeyType == rsa; %% Backwards compatibility
+ KeyType == dsa; %% Backwards compatibility
+ KeyType == 'RSAPrivateKey';
+ KeyType == 'DSAPrivateKey';
+ KeyType == 'PrivateKeyInfo' ->
{KeyType, Value};
validate_option(keyfile, Value) when is_list(Value) ->
Value;
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index c772697f1d..59b0132ff5 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -1126,18 +1126,38 @@ init_private_key(DbHandle, undefined, KeyFile, Password, _) ->
{ok, List} = ssl_manager:cache_pem_file(KeyFile, DbHandle),
[PemEntry] = [PemEntry || PemEntry = {PKey, _ , _} <- List,
PKey =:= 'RSAPrivateKey' orelse
- PKey =:= 'DSAPrivateKey'],
- public_key:pem_entry_decode(PemEntry, Password)
+ PKey =:= 'DSAPrivateKey' orelse
+ PKey =:= 'PrivateKeyInfo'
+ ],
+ private_key(public_key:pem_entry_decode(PemEntry, Password))
catch
Error:Reason ->
handle_file_error(?LINE, Error, Reason, KeyFile, ekeyfile,
erlang:get_stacktrace())
end;
+%% First two clauses are for backwards compatibility
init_private_key(_,{rsa, PrivateKey}, _, _,_) ->
- public_key:der_decode('RSAPrivateKey', PrivateKey);
+ init_private_key('RSAPrivateKey', PrivateKey);
init_private_key(_,{dsa, PrivateKey},_,_,_) ->
- public_key:der_decode('DSAPrivateKey', PrivateKey).
+ init_private_key('DSAPrivateKey', PrivateKey);
+init_private_key(_,{Asn1Type, PrivateKey},_,_,_) ->
+ private_key(init_private_key(Asn1Type, PrivateKey)).
+
+init_private_key(Asn1Type, PrivateKey) ->
+ public_key:der_decode(Asn1Type, PrivateKey).
+
+private_key(#'PrivateKeyInfo'{privateKeyAlgorithm =
+ #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?'rsaEncryption'},
+ privateKey = Key}) ->
+ public_key:der_decode('RSAPrivateKey', iolist_to_binary(Key));
+
+private_key(#'PrivateKeyInfo'{privateKeyAlgorithm =
+ #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?'id-dsa'},
+ privateKey = Key}) ->
+ public_key:der_decode('DSAPrivateKey', iolist_to_binary(Key));
+private_key(Key) ->
+ Key.
-spec(handle_file_error(_,_,_,_,_,_) -> no_return()).
handle_file_error(Line, Error, {badmatch, Reason}, File, Throw, Stack) ->
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index a9109c5a6e..42dc44c39b 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -2784,7 +2784,7 @@ extended_key_usage_verify_peer(Config) when is_list(Config) ->
KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"),
[KeyEntry] = ssl_test_lib:pem_to_der(KeyFile),
- Key = public_key:pem_entry_decode(KeyEntry),
+ Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)),
ServerCertFile = proplists:get_value(certfile, ServerOpts),
NewServerCertFile = filename:join(PrivDir, "server/new_cert.pem"),
@@ -2846,7 +2846,7 @@ extended_key_usage_verify_none(Config) when is_list(Config) ->
KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"),
[KeyEntry] = ssl_test_lib:pem_to_der(KeyFile),
- Key = public_key:pem_entry_decode(KeyEntry),
+ Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)),
ServerCertFile = proplists:get_value(certfile, ServerOpts),
NewServerCertFile = filename:join(PrivDir, "server/new_cert.pem"),
@@ -2908,7 +2908,7 @@ no_authority_key_identifier(Config) when is_list(Config) ->
KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"),
[KeyEntry] = ssl_test_lib:pem_to_der(KeyFile),
- Key = public_key:pem_entry_decode(KeyEntry),
+ Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)),
CertFile = proplists:get_value(certfile, ServerOpts),
NewCertFile = filename:join(PrivDir, "server/new_cert.pem"),
@@ -2966,7 +2966,7 @@ invalid_signature_server(Config) when is_list(Config) ->
KeyFile = filename:join(PrivDir, "server/key.pem"),
[KeyEntry] = ssl_test_lib:pem_to_der(KeyFile),
- Key = public_key:pem_entry_decode(KeyEntry),
+ Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)),
ServerCertFile = proplists:get_value(certfile, ServerOpts),
NewServerCertFile = filename:join(PrivDir, "server/invalid_cert.pem"),
@@ -3006,7 +3006,7 @@ invalid_signature_client(Config) when is_list(Config) ->
KeyFile = filename:join(PrivDir, "client/key.pem"),
[KeyEntry] = ssl_test_lib:pem_to_der(KeyFile),
- Key = public_key:pem_entry_decode(KeyEntry),
+ Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)),
ClientCertFile = proplists:get_value(certfile, ClientOpts),
NewClientCertFile = filename:join(PrivDir, "client/invalid_cert.pem"),
@@ -3083,7 +3083,7 @@ cert_expired(Config) when is_list(Config) ->
KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"),
[KeyEntry] = ssl_test_lib:pem_to_der(KeyFile),
- Key = public_key:pem_entry_decode(KeyEntry),
+ Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)),
ServerCertFile = proplists:get_value(certfile, ServerOpts),
NewServerCertFile = filename:join(PrivDir, "server/expired_cert.pem"),
@@ -3358,14 +3358,14 @@ der_input_opts(Opts) ->
Keyfile = proplists:get_value(keyfile, Opts),
Dhfile = proplists:get_value(dhfile, Opts),
[{_, Cert, _}] = ssl_test_lib:pem_to_der(Certfile),
- [{_, Key, _}] = ssl_test_lib:pem_to_der(Keyfile),
+ [{Asn1Type, Key, _}] = ssl_test_lib:pem_to_der(Keyfile),
[{_, DHParams, _}] = ssl_test_lib:pem_to_der(Dhfile),
CaCerts =
lists:map(fun(Entry) ->
{_, CaCert, _} = Entry,
CaCert
end, ssl_test_lib:pem_to_der(CaCertsfile)),
- {Cert, {rsa, Key}, CaCerts, DHParams}.
+ {Cert, {Asn1Type, Key}, CaCerts, DHParams}.
%%--------------------------------------------------------------------
%% different_ca_peer_sign(doc) ->
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index b7916b96eb..46a8112a41 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -22,6 +22,7 @@
-include("test_server.hrl").
-include("test_server_line.hrl").
+-include_lib("public_key/include/public_key.hrl").
%% Note: This directive should only be used in test suites.
-compile(export_all).
@@ -673,3 +674,16 @@ cipher_result(Socket, Result) ->
session_info_result(Socket) ->
ssl:session_info(Socket).
+
+
+public_key(#'PrivateKeyInfo'{privateKeyAlgorithm =
+ #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?rsaEncryption},
+ privateKey = Key}) ->
+ public_key:der_decode('RSAPrivateKey', iolist_to_binary(Key));
+
+public_key(#'PrivateKeyInfo'{privateKeyAlgorithm =
+ #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?'id-dsa'},
+ privateKey = Key}) ->
+ public_key:der_decode('DSAPrivateKey', iolist_to_binary(Key));
+public_key(Key) ->
+ Key.
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index 64a6a9eaf8..8ccbb3ffa1 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -109,6 +109,9 @@ special_init(TestCase, Config)
TestCase == erlang_server_openssl_client_no_wrap_sequence_number ->
check_sane_openssl_renegotaite(Config);
+special_init(ssl2_erlang_server_openssl_client, Config) ->
+ check_sane_openssl_sslv2(Config);
+
special_init(_, Config) ->
Config.
@@ -1433,3 +1436,11 @@ check_sane_openssl_renegotaite(Config) ->
_ ->
Config
end.
+
+check_sane_openssl_sslv2(Config) ->
+ case os:cmd("openssl version") of
+ "OpenSSL 1.0.0e" ++ _ ->
+ {skip, "Known option bug"};
+ _ ->
+ Config
+ end.
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 2f4958760b..0e8849b5b3 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -74,7 +74,7 @@
-export([bad_table/1, types/1]).
-export([otp_9423/1]).
--export([init_per_testcase/2, end_per_testcase/2]).
+-export([init_per_testcase/2]).
%% Convenience for manual testing
-export([random_test/0]).
@@ -176,6 +176,7 @@ groups() ->
meta_newdel_unnamed, meta_newdel_named]}].
init_per_suite(Config) ->
+ erts_debug:set_internal_state(available_internal_state, true),
Config.
end_per_suite(_Config) ->
@@ -304,7 +305,6 @@ t_match_spec_run(Config) when is_list(Config) ->
end,
repeat_for_permutations(F, N_MS)
end,
-
test_terms(Fun, skip_refc_check),
?line verify_etsmem(EtsMem).
@@ -324,7 +324,7 @@ t_match_spec_run_test(List, MS, Result) ->
%% Check that tracing agree
Self = self(),
- {Tracee, MonRef} = spawn_monitor(fun() -> ms_tracee(Self, List) end),
+ {Tracee, MonRef} = my_spawn_monitor(fun() -> ms_tracee(Self, List) end),
receive {Tracee, ready} -> ok end,
MST = lists:map(fun(Clause) -> ms_clause_ets_to_trace(Clause) end, MS),
@@ -585,7 +585,6 @@ select_fail_do(Opts) ->
memory(doc) -> ["Whitebox test of ets:info(X,memory)"];
memory(suite) -> [];
memory(Config) when is_list(Config) ->
- ?line erts_debug:set_internal_state(available_internal_state, true),
?line ok = chk_normal_tab_struct_size(),
repeat_for_opts(memory_do,[compressed]),
?line catch erts_debug:set_internal_state(available_internal_state, false).
@@ -1947,7 +1946,7 @@ evil_update_counter(Config) when is_list(Config) ->
evil_update_counter_do(Opts) ->
?line EtsMem = etsmem(),
?line process_flag(trap_exit, true),
- ?line Pids = [spawn_link(fun() -> evil_counter(I,Opts) end) || I <- lists:seq(1, 40)],
+ ?line Pids = [my_spawn_link(fun() -> evil_counter(I,Opts) end) || I <- lists:seq(1, 40)],
?line wait_for_all(gb_sets:from_list(Pids)),
?line verify_etsmem(EtsMem),
ok.
@@ -2153,24 +2152,24 @@ heir_do(Opts) ->
Combos),
%% No heir
- {Founder1,MrefF1} = spawn_monitor(fun()->heir_founder(Master,foo_data,Opts)end),
+ {Founder1,MrefF1} = my_spawn_monitor(fun()->heir_founder(Master,foo_data,Opts)end),
Founder1 ! {go, none},
?line {"No heir",Founder1} = receive_any(),
?line {'DOWN', MrefF1, process, Founder1, normal} = receive_any(),
?line undefined = ets:info(foo),
%% An already dead heir
- {Heir2,MrefH2} = spawn_monitor(fun()->die end),
+ {Heir2,MrefH2} = my_spawn_monitor(fun()->die end),
?line {'DOWN', MrefH2, process, Heir2, normal} = receive_any(),
- {Founder2,MrefF2} = spawn_monitor(fun()->heir_founder(Master,foo_data,Opts)end),
+ {Founder2,MrefF2} = my_spawn_monitor(fun()->heir_founder(Master,foo_data,Opts)end),
Founder2 ! {go, Heir2},
?line {"No heir",Founder2} = receive_any(),
?line {'DOWN', MrefF2, process, Founder2, normal} = receive_any(),
?line undefined = ets:info(foo),
%% When heir dies before founder
- {Founder3,MrefF3} = spawn_monitor(fun()->heir_founder(Master,"The dying heir",Opts)end),
- {Heir3,MrefH3} = spawn_monitor(fun()->heir_heir(Founder3)end),
+ {Founder3,MrefF3} = my_spawn_monitor(fun()->heir_founder(Master,"The dying heir",Opts)end),
+ {Heir3,MrefH3} = my_spawn_monitor(fun()->heir_heir(Founder3)end),
Founder3 ! {go, Heir3},
?line {'DOWN', MrefH3, process, Heir3, normal} = receive_any(),
Founder3 ! die_please,
@@ -2178,14 +2177,12 @@ heir_do(Opts) ->
?line undefined = ets:info(foo),
%% When heir dies and pid reused before founder dies
- erts_debug:set_internal_state(available_internal_state,true),
NextPidIx = erts_debug:get_internal_state(next_pid),
- {Founder4,MrefF4} = spawn_monitor(fun()->heir_founder(Master,"The dying heir",Opts)end),
- {Heir4,MrefH4} = spawn_monitor(fun()->heir_heir(Founder4)end),
+ {Founder4,MrefF4} = my_spawn_monitor(fun()->heir_founder(Master,"The dying heir",Opts)end),
+ {Heir4,MrefH4} = my_spawn_monitor(fun()->heir_heir(Founder4)end),
Founder4 ! {go, Heir4},
?line {'DOWN', MrefH4, process, Heir4, normal} = receive_any(),
erts_debug:set_internal_state(next_pid, NextPidIx),
- erts_debug:set_internal_state(available_internal_state,false),
{Heir4,MrefH4_B} = spawn_monitor_with_pid(Heir4,
fun()-> ?line die_please = receive_any() end),
Founder4 ! die_please,
@@ -2261,9 +2258,9 @@ heir_heir(Founder, Mode) ->
heir_1(HeirData,Mode,Opts) ->
io:format("test with heir_data = ~p\n", [HeirData]),
Master = self(),
- ?line Founder = spawn_link(fun() -> heir_founder(Master,HeirData,Opts) end),
+ ?line Founder = my_spawn_link(fun() -> heir_founder(Master,HeirData,Opts) end),
io:format("founder spawned = ~p\n", [Founder]),
- ?line {Heir,Mref} = spawn_monitor(fun() -> heir_heir(Founder,Mode) end),
+ ?line {Heir,Mref} = my_spawn_monitor(fun() -> heir_heir(Founder,Mode) end),
io:format("heir spawned = ~p\n", [{Heir,Mref}]),
?line Founder ! {go, Heir},
?line {'DOWN', Mref, process, Heir, normal} = receive_any().
@@ -2280,7 +2277,7 @@ give_away_do(Opts) ->
Parent = self(),
%% Give and then give back
- ?line {Receiver,Mref} = spawn_monitor(fun()-> give_away_receiver(T,Parent) end),
+ ?line {Receiver,Mref} = my_spawn_monitor(fun()-> give_away_receiver(T,Parent) end),
?line give_me = receive_any(),
?line true = ets:give_away(T,Receiver,here_you_are),
?line {'EXIT',{badarg,_}} = (catch ets:lookup(T,key)),
@@ -2291,7 +2288,7 @@ give_away_do(Opts) ->
%% Give and then let receiver keep it
?line true = ets:insert(T,{key,1}),
- ?line {Receiver3,Mref3} = spawn_monitor(fun()-> give_away_receiver(T,Parent) end),
+ ?line {Receiver3,Mref3} = my_spawn_monitor(fun()-> give_away_receiver(T,Parent) end),
?line give_me = receive_any(),
?line true = ets:give_away(T,Receiver3,here_you_are),
?line {'EXIT',{badarg,_}} = (catch ets:lookup(T,key)),
@@ -2303,7 +2300,7 @@ give_away_do(Opts) ->
?line T2 = ets_new(foo,[private | Opts]),
?line true = ets:insert(T2,{key,1}),
?line ets:setopts(T2,{heir,self(),"Som en gummiboll..."}),
- ?line {Receiver2,Mref2} = spawn_monitor(fun()-> give_away_receiver(T2,Parent) end),
+ ?line {Receiver2,Mref2} = my_spawn_monitor(fun()-> give_away_receiver(T2,Parent) end),
?line give_me = receive_any(),
?line true = ets:give_away(T2,Receiver2,here_you_are),
?line {'EXIT',{badarg,_}} = (catch ets:lookup(T2,key)),
@@ -2318,12 +2315,12 @@ give_away_do(Opts) ->
?line {'EXIT',{badarg,_}} = (catch ets:give_away(T2,"not a pid","To wrong type")),
?line true = ets:delete(T2),
- ?line {ReceiverNeg,MrefNeg} = spawn_monitor(fun()-> give_away_receiver(T2,Parent) end),
+ ?line {ReceiverNeg,MrefNeg} = my_spawn_monitor(fun()-> give_away_receiver(T2,Parent) end),
?line give_me = receive_any(),
?line {'EXIT',{badarg,_}} = (catch ets:give_away(T2,ReceiverNeg,"A deleted table")),
?line T3 = ets_new(foo,[public | Opts]),
- spawn_link(fun()-> {'EXIT',{badarg,_}} = (catch ets:give_away(T3,ReceiverNeg,"From non owner")),
+ my_spawn_link(fun()-> {'EXIT',{badarg,_}} = (catch ets:give_away(T3,ReceiverNeg,"From non owner")),
Parent ! done
end),
?line done = receive_any(),
@@ -2359,7 +2356,7 @@ setopts_do(Opts) ->
Self = self(),
?line T = ets_new(foo,[named_table, private | Opts]),
?line none = ets:info(T,heir),
- Heir = spawn_link(fun()->heir_heir(Self) end),
+ Heir = my_spawn_link(fun()->heir_heir(Self) end),
?line ets:setopts(T,{heir,Heir,"Data"}),
?line Heir = ets:info(T,heir),
?line ets:setopts(T,{heir,self(),"Data"}),
@@ -2410,14 +2407,14 @@ bad_table(Config) when is_list(Config) ->
bad_table_do(Opts, DummyFile) ->
Parent = self(),
- {Pid,Mref} = spawn_opt(fun()-> ets_new(priv,[private,named_table | Opts]),
- Priv = ets_new(priv,[private | Opts]),
- ets_new(prot,[protected,named_table | Opts]),
- Prot = ets_new(prot,[protected | Opts]),
- Parent ! {self(),Priv,Prot},
- die_please = receive_any()
- end,
- [link, monitor]),
+ {Pid,Mref} = my_spawn_opt(fun()-> ets_new(priv,[private,named_table | Opts]),
+ Priv = ets_new(priv,[private | Opts]),
+ ets_new(prot,[protected,named_table | Opts]),
+ Prot = ets_new(prot,[protected | Opts]),
+ Parent ! {self(),Priv,Prot},
+ die_please = receive_any()
+ end,
+ [link, monitor]),
{Pid,Priv,Prot} = receive_any(),
MatchSpec = {{key,'_'}, [], ['$$']},
Fun = fun(X,_) -> X end,
@@ -3263,7 +3260,7 @@ delete_large_named_table_1(Name, Flags, Data, Fix) ->
?line lists:foreach(fun({K,_}) -> ets:delete(Tab, K) end, Data)
end,
Parent = self(),
- Pid = spawn_link(fun() ->
+ Pid = my_spawn_link(fun() ->
receive
{trace,Parent,call,_} ->
ets_new(Name, [named_table])
@@ -3625,7 +3622,7 @@ cycle(Tab, L) ->
ets:insert(Tab,list_to_tuple(L)),
cycle(Tab, tl(L)++[hd(L)]).
-dynamic_go() -> spawn_link(fun dynamic_init/0).
+dynamic_go() -> my_spawn_link(fun dynamic_init/0).
dynamic_init() -> [dyn_lookup(?MODULE) || _ <- lists:seq(1, 10)].
@@ -3852,7 +3849,7 @@ safe_fixtable_do(Opts) ->
Self = self(),
?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed),
%% Test that an unjustified 'unfix' is a no-op.
- {Pid,MRef} = spawn_monitor(fun() -> true = ets:safe_fixtable(Tab,false) end),
+ {Pid,MRef} = my_spawn_monitor(fun() -> true = ets:safe_fixtable(Tab,false) end),
{'DOWN', MRef, process, Pid, normal} = receive M -> M end,
?line true = ets:info(Tab,fixed),
?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed),
@@ -4256,7 +4253,7 @@ do_heavy_concurrent(Opts) ->
?line ok = fill_tab2(Tab, 0, Size),
?line Procs = lists:map(
fun (N) ->
- spawn_link(
+ my_spawn_link(
fun () ->
do_heavy_concurrent_proc(Tab, Size, N)
end)
@@ -4860,12 +4857,7 @@ otp_7665_act(Tab,Min,Max,DelNr) ->
%% Whitebox testing of meta name table hashing.
meta_wb(Config) when is_list(Config) ->
?line EtsMem = etsmem(),
- ?line erts_debug:set_internal_state(available_internal_state, true),
- try
- repeat_for_opts(meta_wb_do)
- after
- erts_debug:set_internal_state(available_internal_state, false)
- end,
+ repeat_for_opts(meta_wb_do),
?line verify_etsmem(EtsMem).
@@ -4934,12 +4926,15 @@ colliding_names(Name) ->
grow_shrink(Config) when is_list(Config) ->
?line EtsMem = etsmem(),
- grow_shrink_0(lists:seq(3071, 5000), EtsMem).
+ ?line grow_shrink_0(lists:seq(3071, 5000), EtsMem),
+ ?line verify_etsmem(EtsMem).
grow_shrink_0([N|Ns], EtsMem) ->
?line grow_shrink_1(N, [set]),
?line grow_shrink_1(N, [ordered_set]),
- ?line verify_etsmem(EtsMem),
+ %% Verifying ets-memory here takes too long time, since
+ %% lock-free allocators were introduced...
+ %% ?line verify_etsmem(EtsMem),
grow_shrink_0(Ns, EtsMem);
grow_shrink_0([], _) -> ok.
@@ -4986,13 +4981,13 @@ grow_pseudo_deleted_do(Type) ->
?line Left = ets:info(T,size),
?line Mult = get_kept_objects(T),
filltabstr(T,Mult),
- spawn_opt(fun()-> ?line true = ets:info(T,fixed),
- Self ! start,
- io:format("Starting to filltabstr... ~p\n",[now()]),
- filltabstr(T,Mult,Mult+10000),
- io:format("Done with filltabstr. ~p\n",[now()]),
- Self ! done
- end, [link, {scheduler,2}]),
+ my_spawn_opt(fun()-> ?line true = ets:info(T,fixed),
+ Self ! start,
+ io:format("Starting to filltabstr... ~p\n",[now()]),
+ filltabstr(T,Mult,Mult+10000),
+ io:format("Done with filltabstr. ~p\n",[now()]),
+ Self ! done
+ end, [link, {scheduler,2}]),
?line start = receive_any(),
io:format("Unfixing table...~p nitems=~p\n",[now(),ets:info(T,size)]),
?line true = ets:safe_fixtable(T,false),
@@ -5026,13 +5021,13 @@ shrink_pseudo_deleted_do(Type) ->
[true]}]),
?line Half = ets:info(T,size),
?line Half = get_kept_objects(T),
- spawn_opt(fun()-> ?line true = ets:info(T,fixed),
- Self ! start,
- io:format("Starting to delete... ~p\n",[now()]),
- del_one_by_one_set(T,1,Half+1),
- io:format("Done with delete. ~p\n",[now()]),
- Self ! done
- end, [link, {scheduler,2}]),
+ my_spawn_opt(fun()-> ?line true = ets:info(T,fixed),
+ Self ! start,
+ io:format("Starting to delete... ~p\n",[now()]),
+ del_one_by_one_set(T,1,Half+1),
+ io:format("Done with delete. ~p\n",[now()]),
+ Self ! done
+ end, [link, {scheduler,2}]),
?line start = receive_any(),
io:format("Unfixing table...~p nitems=~p\n",[now(),ets:info(T,size)]),
?line true = ets:safe_fixtable(T,false),
@@ -5189,24 +5184,24 @@ smp_unfix_fix_do() ->
?line Deleted = get_kept_objects(T),
{Child, Mref} =
- spawn_opt(fun()-> ?line true = ets:info(T,fixed),
- Parent ! start,
- io:format("Child waiting for table to be unfixed... now=~p mem=~p\n",
- [now(),ets:info(T,memory)]),
- repeat_while(fun()-> ets:info(T,fixed) end),
- io:format("Table unfixed. Child Fixating! now=~p mem=~p\n",
- [now(),ets:info(T,memory)]),
- ?line true = ets:safe_fixtable(T,true),
- repeat_while(fun(Key) when Key =< NumOfObjs ->
- ets:delete(T,Key), {true,Key+1};
- (Key) -> {false,Key}
- end,
- Deleted),
- ?line 0 = ets:info(T,size),
- ?line true = get_kept_objects(T) >= Left,
- ?line done = receive_any()
- end,
- [link, monitor, {scheduler,2}]),
+ my_spawn_opt(fun()-> ?line true = ets:info(T,fixed),
+ Parent ! start,
+ io:format("Child waiting for table to be unfixed... now=~p mem=~p\n",
+ [now(),ets:info(T,memory)]),
+ repeat_while(fun()-> ets:info(T,fixed) end),
+ io:format("Table unfixed. Child Fixating! now=~p mem=~p\n",
+ [now(),ets:info(T,memory)]),
+ ?line true = ets:safe_fixtable(T,true),
+ repeat_while(fun(Key) when Key =< NumOfObjs ->
+ ets:delete(T,Key), {true,Key+1};
+ (Key) -> {false,Key}
+ end,
+ Deleted),
+ ?line 0 = ets:info(T,size),
+ ?line true = get_kept_objects(T) >= Left,
+ ?line done = receive_any()
+ end,
+ [link, monitor, {scheduler,2}]),
?line start = receive_any(),
?line true = ets:info(T,fixed),
@@ -5237,11 +5232,11 @@ otp_8166_do(WC) ->
Deleted = NumOfObjs div 2,
filltabint(T,NumOfObjs),
{ReaderPid, ReaderMref} =
- spawn_opt(fun()-> otp_8166_reader(T,NumOfObjs) end,
- [link, monitor, {scheduler,2}]),
+ my_spawn_opt(fun()-> otp_8166_reader(T,NumOfObjs) end,
+ [link, monitor, {scheduler,2}]),
{ZombieCrPid, ZombieCrMref} =
- spawn_opt(fun()-> otp_8166_zombie_creator(T,Deleted) end,
- [link, monitor, {scheduler,3}]),
+ my_spawn_opt(fun()-> otp_8166_zombie_creator(T,Deleted) end,
+ [link, monitor, {scheduler,3}]),
repeat(fun() -> ZombieCrPid ! {loop, self()},
zombies_created = receive_any(),
@@ -5501,7 +5496,7 @@ run_workers_do(InitF,ExecF,FiniF,Laps, Exclude) ->
io:format("smp starting ~p workers\n",[NumOfProcs]),
Seeds = [{ProcN,random:uniform(9999)} || ProcN <- lists:seq(1,NumOfProcs)],
Parent = self(),
- Pids = [spawn_link(fun()-> worker(Seed,InitF,ExecF,FiniF,Laps,Parent,NumOfProcs) end)
+ Pids = [my_spawn_link(fun()-> worker(Seed,InitF,ExecF,FiniF,Laps,Parent,NumOfProcs) end)
|| Seed <- Seeds],
case Laps of
infinite -> Pids;
@@ -5550,31 +5545,30 @@ my_tab_to_list(_Ts,'$end_of_table', Acc) -> lists:reverse(Acc);
my_tab_to_list(Ts,Key, Acc) ->
my_tab_to_list(Ts,ets:next(Ts,Key),[ets:lookup(Ts, Key)| Acc]).
-wait_for_all_schedulers_online_to_execute() ->
- PMs = lists:map(fun (Sched) ->
- spawn_opt(fun () -> ok end,
- [monitor, {scheduler, Sched}])
- end,
- lists:seq(1,erlang:system_info(schedulers_online))),
- lists:foreach(fun ({P, M}) ->
- receive
- {'DOWN', M, process, P, _} -> ok
- end
- end,
- PMs),
- ok.
+
+wait_for_memory_deallocations() ->
+ try
+ erts_debug:set_internal_state(wait, deallocations)
+ catch
+ error:undef ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ wait_for_memory_deallocations()
+ end.
+
etsmem() ->
- %% Wait until it is guaranteed that all already scheduled
- %% deallocations of DbTable structures have completed.
- wait_for_all_schedulers_online_to_execute(),
+ wait_for_memory_deallocations(),
AllTabs = lists:map(fun(T) -> {T,ets:info(T,name),ets:info(T,size),
ets:info(T,memory),ets:info(T,type)}
end, ets:all()),
+
+ EtsAllocInfo = erlang:system_info({allocator,ets_alloc}),
+ ErlangMemoryEts = try erlang:memory(ets) catch error:notsup -> notsup end,
+
Mem =
- {try erlang:memory(ets) catch error:notsup -> notsup end,
- case erlang:system_info({allocator,ets_alloc}) of
+ {ErlangMemoryEts,
+ case EtsAllocInfo of
false -> undefined;
MemInfo ->
CS = lists:foldl(
@@ -5651,6 +5645,7 @@ spawn_logger(Procs) ->
true -> exit(Proc, kill);
_ -> ok
end,
+ erlang:display(process_info(Proc)),
receive
{'DOWN', Mon, _, _, _} ->
ok
@@ -5686,7 +5681,7 @@ wait_for_test_procs(Kill) ->
ets_test_spawn_logger ! {sync_test_procs, Kill, self()},
receive test_procs_synced -> ok end.
-log_test_proc(Proc) ->
+log_test_proc(Proc) when is_pid(Proc) ->
ets_test_spawn_logger ! {new_test_proc, Proc},
Proc.
@@ -5698,9 +5693,17 @@ my_spawn_link(Fun) -> log_test_proc(spawn_link(Fun)).
my_spawn_link(M,F,A) -> log_test_proc(spawn_link(M,F,A)).
%%my_spawn_link(N,M,F,A) -> log_test_proc(spawn_link(N,M,F,A)).
-my_spawn_opt(Fun,Opts) -> log_test_proc(spawn_opt(Fun,Opts)).
-%%my_spawn_opt(M,F,A,Opts) -> log_test_proc(spawn_opt(M,F,A,Opts)).
-%%my_spawn_opt(N,M,F,A,Opts) -> log_test_proc(spawn_opt(N,M,F,A,Opts)).
+my_spawn_opt(Fun,Opts) ->
+ case spawn_opt(Fun,Opts) of
+ Pid when is_pid(Pid) -> log_test_proc(Pid);
+ {Pid, _} = Res when is_pid(Pid) -> log_test_proc(Pid), Res
+ end.
+
+my_spawn_monitor(Fun) ->
+ Res = spawn_monitor(Fun),
+ {Pid, _} = Res,
+ log_test_proc(Pid),
+ Res.
repeat(_Fun, 0) ->
ok;
@@ -5763,11 +5766,11 @@ spawn_monitor_with_pid(Pid, Fun, N, M) when N > M*10 ->
spawn_monitor_with_pid(Pid, Fun, N, M*10);
spawn_monitor_with_pid(Pid, Fun, N, M) ->
?line false = is_process_alive(Pid),
- case spawn(fun()-> case self() of
- Pid -> Fun();
- _ -> die
- end
- end) of
+ case my_spawn(fun()-> case self() of
+ Pid -> Fun();
+ _ -> die
+ end
+ end) of
Pid ->
{Pid, erlang:monitor(process, Pid)};
Other ->
diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl
index e709cf62ba..da6996cc9f 100644
--- a/lib/stdlib/test/supervisor_SUITE.erl
+++ b/lib/stdlib/test/supervisor_SUITE.erl
@@ -120,7 +120,9 @@ end_per_group(_GroupName, Config) ->
init_per_testcase(count_children_memory, Config) ->
try erlang:memory() of
- _ -> Config
+ _ ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ Config
catch error:notsup ->
{skip, "+Meamin used during test; erlang:memory/1 not available"}
end;
@@ -128,6 +130,9 @@ init_per_testcase(_Case, Config) ->
erlang:display(_Case),
Config.
+end_per_testcase(count_children_memory, _Config) ->
+ catch erts_debug:set_internal_state(available_internal_state, false),
+ ok;
end_per_testcase(_Case, _Config) ->
ok.
@@ -1136,25 +1141,25 @@ count_children_memory(Config) when is_list(Config) ->
[supervisor:start_child(sup_test, []) || _Ignore <- lists:seq(1,1000)],
garbage_collect(),
- _Size1 = erlang:memory(processes_used),
+ _Size1 = proc_memory(),
Children = supervisor:which_children(sup_test),
- _Size2 = erlang:memory(processes_used),
+ _Size2 = proc_memory(),
ChildCount = get_child_counts(sup_test),
- _Size3 = erlang:memory(processes_used),
+ _Size3 = proc_memory(),
[supervisor:start_child(sup_test, []) || _Ignore2 <- lists:seq(1,1000)],
garbage_collect(),
Children2 = supervisor:which_children(sup_test),
- Size4 = erlang:memory(processes_used),
+ Size4 = proc_memory(),
ChildCount2 = get_child_counts(sup_test),
- Size5 = erlang:memory(processes_used),
+ Size5 = proc_memory(),
garbage_collect(),
Children3 = supervisor:which_children(sup_test),
- Size6 = erlang:memory(processes_used),
+ Size6 = proc_memory(),
ChildCount3 = get_child_counts(sup_test),
- Size7 = erlang:memory(processes_used),
+ Size7 = proc_memory(),
1000 = length(Children),
[1,1000,0,1000] = ChildCount,
@@ -1180,6 +1185,10 @@ count_children_memory(Config) when is_list(Config) ->
[terminate(SupPid, Pid, child, kill) || {undefined, Pid, worker, _Modules} <- Children3],
[1,0,0,0] = get_child_counts(sup_test).
+proc_memory() ->
+ erts_debug:set_internal_state(wait, deallocations),
+ erlang:memory(processes_used).
+
%%-------------------------------------------------------------------------
do_not_save_start_parameters_for_temporary_children(doc) ->
["Temporary children shall not be restarted so they should not "
diff --git a/lib/xmerl/include/xmerl.hrl b/lib/xmerl/include/xmerl.hrl
index 7bb3f4de9b..3760a5cce0 100644
--- a/lib/xmerl/include/xmerl.hrl
+++ b/lib/xmerl/include/xmerl.hrl
@@ -61,10 +61,11 @@
}).
%% namespace node - i.e. a {Prefix, URI} pair
-%% TODO: these are not currently used?? /RC
-record(xmlNsNode,{
- prefix,
- uri = []
+ parents = [], % [{atom(),integer()}]
+ pos, % integer()
+ prefix, % string()
+ uri = [] % [] | atom()
}).
%% XML Element
@@ -103,9 +104,10 @@
%% processing instruction
-record(xmlPI,{
- name, % atom()
- pos, % integer()
- value % IOlist()
+ name, % atom()
+ parents = [], % [{atom(),integer()}]
+ pos, % integer()
+ value % IOlist()
}).
-record(xmlDocument,{
@@ -154,6 +156,9 @@
declarations = [], % [{Name, Attrs}]
doctype_name,
doctype_DTD = internal, % internal | DTDId
+ comments = true,
+ document = false,
+ default_attrs = false,
rules,
keep_rules = false, % delete (ets) tab if false
namespace_conformant = false, % true | false
diff --git a/lib/xmerl/src/xmerl_lib.erl b/lib/xmerl/src/xmerl_lib.erl
index 6402f1cbeb..aeb821f411 100644
--- a/lib/xmerl/src/xmerl_lib.erl
+++ b/lib/xmerl/src/xmerl_lib.erl
@@ -160,8 +160,9 @@ expand_element(E = #xmlText{}, Pos, Parents, Norm) ->
E#xmlText{pos = Pos,
parents = Parents,
value = expand_text(E#xmlText.value, Norm)};
-expand_element(E = #xmlPI{}, Pos, _Parents, Norm) ->
+expand_element(E = #xmlPI{}, Pos, Parents, Norm) ->
E#xmlPI{pos = Pos,
+ parents = Parents,
value = expand_text(E#xmlPI.value, Norm)};
expand_element(E = #xmlComment{}, Pos, Parents, Norm) ->
E#xmlComment{pos = Pos,
diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
index 3b9eaa309c..ec9178ea25 100644
--- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
@@ -944,14 +944,19 @@ parse_att_value(?STRING_REST("&", Rest), State, Stop, Acc) ->
{unparsed, Name, _} ->
?fatal_error(State1, "Unparsed entity reference in attribute value: " ++ Name)
end;
-parse_att_value(?STRING_UNBOUND_REST(Stop, Rest), State, Stop, Acc) ->
+parse_att_value(?STRING_UNBOUND_REST(Stop, Rest), State, Stop, Acc) ->
{lists:reverse(Acc), Rest, State};
-parse_att_value(?STRING_UNBOUND_REST($<, _Rest), State, _Stop, _Acc) ->
+parse_att_value(?STRING_UNBOUND_REST($<, _Rest), State, _Stop, _Acc) ->
?fatal_error(State, "< not allowed in attribute value");
-parse_att_value(?STRING_UNBOUND_REST(C, Rest), State, Stop, Acc) ->
- parse_att_value(Rest, State, Stop, [C|Acc]);
-parse_att_value(Bytes, State, Stop, Acc) ->
- unicode_incomplete_check([Bytes, State, Stop, Acc, fun parse_att_value/4],
+parse_att_value(?STRING_UNBOUND_REST(C, Rest), State, Stop, Acc) ->
+ if
+ ?is_char(C) ->
+ parse_att_value(Rest, State, Stop, [C|Acc]);
+ true ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character in attribute value: ~p", [C])))
+ end;
+parse_att_value(Bytes, State, Stop, Acc) ->
+ unicode_incomplete_check([Bytes, State, Stop, Acc, fun parse_att_value/4],
undefined).
@@ -1120,10 +1125,10 @@ parse_content(?STRING_UNBOUND_REST(C, Rest), State, Acc, _IgnorableWS) ->
?is_char(C) ->
parse_content(Rest, State, [C|Acc], false);
true ->
- ?fatal_error(State, "Bad character in content: " ++ C)
- end;
-parse_content(Bytes, State, Acc, IgnorableWS) ->
- unicode_incomplete_check([Bytes, State, Acc, IgnorableWS, fun parse_content/4],
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character in content: ~p", [C])))
+ end;
+parse_content(Bytes, State, Acc, IgnorableWS) ->
+ unicode_incomplete_check([Bytes, State, Acc, IgnorableWS, fun parse_content/4],
undefined).
@@ -2522,11 +2527,16 @@ parse_entity_value(?STRING_REST("%", Rest), #xmerl_sax_parser_state{file_type=Ty
end
end;
-parse_entity_value(?STRING_UNBOUND_REST(Stop, Rest), State, Stop, Acc) ->
+parse_entity_value(?STRING_UNBOUND_REST(Stop, Rest), State, Stop, Acc) ->
{lists:reverse(Acc), Rest, State};
-parse_entity_value(?STRING_UNBOUND_REST(C, Rest), State, Stop, Acc) ->
- parse_entity_value(Rest, State, Stop, [C|Acc]);
-parse_entity_value(Bytes, State, Stop, Acc) ->
+parse_entity_value(?STRING_UNBOUND_REST(C, Rest), State, Stop, Acc) ->
+ if
+ ?is_char(C) ->
+ parse_entity_value(Rest, State, Stop, [C|Acc]);
+ true ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Bad character in entity value: ~p", [C])))
+ end;
+parse_entity_value(Bytes, State, Stop, Acc) ->
unicode_incomplete_check([Bytes, State, Stop, Acc, fun parse_entity_value/4],
undefined).
diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl
index 25c6547497..ec7ea534d6 100644
--- a/lib/xmerl/src/xmerl_scan.erl
+++ b/lib/xmerl/src/xmerl_scan.erl
@@ -100,7 +100,21 @@
%% <dd>Set default character set used (default UTF-8).
%% This character set is used only if not explicitly given by the XML
%% declaration. </dd>
+%% <dt><code>{document, Flag}</code></dt>
+%% <dd>Set to 'true' if xmerl should return a complete XML document
+%% as an xmlDocument record (default 'false').</dd>
+%% <dt><code>{comments, Flag}</code></dt>
+%% <dd>Set to 'false' if xmerl should skip comments otherwise they will
+%% be returned as xmlComment records (default 'true').</dd>
+%% <dt><code>{default_attrs, Flag}</code></dt>
+%% <dd>Set to 'true' if xmerl should add to elements missing attributes
+%% with a defined default value (default 'false').</dd>
%% </dl>
+%% @type document() = xmlElement() | xmlDocument(). <p>
+%% The document returned by <tt>xmerl_scan:string/[1,2]</tt> and
+%% <tt>xmerl_scan:file/[1,2]</tt>. The type of the returned record depends on
+%% the value of the document option passed to the function.
+%% </p>
-module(xmerl_scan).
@@ -224,7 +238,7 @@ cont_state(X, S=#xmerl_scanner{fun_states = FS}) ->
file(F) ->
file(F, []).
-%% @spec file(Filename::string(), Options::option_list()) -> {xmlElement(),Rest}
+%% @spec file(Filename::string(), Options::option_list()) -> {document(),Rest}
%% Rest = list()
%%% @doc Parse file containing an XML document
file(F, Options) ->
@@ -264,7 +278,7 @@ int_file_decl(F, Options,_ExtCharset) ->
string(Str) ->
string(Str, []).
-%% @spec string(Text::list(),Options::option_list()) -> {xmlElement(),Rest}
+%% @spec string(Text::list(),Options::option_list()) -> {document(),Rest}
%% Rest = list()
%%% @doc Parse string containing an XML document
string(Str, Options) ->
@@ -381,6 +395,12 @@ initial_state([{quiet, F}|T], S) when F==true; F==false ->
initial_state(T, S#xmerl_scanner{quiet = F});
initial_state([{doctype_DTD,DTD}|T], S) ->
initial_state(T,S#xmerl_scanner{doctype_DTD = DTD});
+initial_state([{document, F}|T], S) when is_boolean(F) ->
+ initial_state(T,S#xmerl_scanner{document = F});
+initial_state([{comments, F}|T], S) when is_boolean(F) ->
+ initial_state(T,S#xmerl_scanner{comments = F});
+initial_state([{default_attrs, F}|T], S) when is_boolean(F) ->
+ initial_state(T,S#xmerl_scanner{default_attrs = F});
initial_state([{text_decl,Bool}|T], S) ->
initial_state(T,S#xmerl_scanner{text_decl=Bool});
initial_state([{environment,Env}|T], S) ->
@@ -518,6 +538,7 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event,
line = L, col = C,
environment=Env,
encoding=Charset,
+ document=Document,
validation=ValidateResult}) ->
S1 = Event(#xmerl_event{event = started,
line = L,
@@ -530,8 +551,8 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event,
Str=if
Charset == "utf-8" ->
Str0;
- Charset=/=undefined -> % Default character set is UTF-8
- xmerl_ucs:to_unicode(Str0,list_to_atom(Charset));
+ Charset =/= undefined -> % Default character set is UTF-8
+ xmerl_ucs:to_unicode(Str0, list_to_atom(Charset));
true -> %% Charset is undefined if no external input is
%% given, and no auto detection of character
%% encoding was made.
@@ -539,17 +560,17 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event,
end,
%% M1 = erlang:memory(),
%% io:format("Memory status before prolog: ~p~n",[M1]),
- {T1, S2} = scan_prolog(Str, S1, _StartPos = 1),
+ {Prolog, Pos, T1, S2} = scan_prolog(Str, S1, _StartPos = 1),
%% M2 = erlang:memory(),
%% io:format("Memory status after prolog: ~p~n",[M2]),
%%io:format("scan_document 2, prolog parsed~n",[]),
- T2 = scan_mandatory("<",T1,1,S2,expected_element_start_tag),
+ T2 = scan_mandatory("<", T1, 1, S2, expected_element_start_tag),
%% M3 = erlang:memory(),
%% io:format("Memory status before element: ~p~n",[M3]),
- {Res, T3, S3} =scan_element(T2,S2,_StartPos = 1),
+ {Res, T3, S3} = scan_element(T2,S2,Pos),
%% M4 = erlang:memory(),
%% io:format("Memory status after element: ~p~n",[M4]),
- {Tail, S4}=scan_misc(T3, S3, _StartPos = 1),
+ {Misc, _Pos1, Tail, S4}=scan_misc(T3, S3, Pos + 1),
%% M5 = erlang:memory(),
%% io:format("Memory status after misc: ~p~n",[M5]),
@@ -558,44 +579,52 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event,
col = S4#xmerl_scanner.col,
data = document}, S4),
- {Res2,S6} = case validation_mode(ValidateResult) of
+ {Res2, S6} = case validation_mode(ValidateResult) of
off ->
- {Res,cleanup(S5)};
+ {Res, cleanup(S5)};
dtd when Env == element; Env == prolog ->
check_decl2(S5),
- case xmerl_validate:validate(S5,Res) of
- {'EXIT',{error,Reason}} ->
- S5b=cleanup(S5),
- ?fatal({failed_validation,Reason}, S5b);
- {'EXIT',Reason} ->
- S5b=cleanup(S5),
- ?fatal({failed_validation,Reason}, S5b);
- {error,Reason} ->
- S5b=cleanup(S5),
- ?fatal({failed_validation,Reason}, S5b);
- {error,Reason,_Next} ->
- S5b=cleanup(S5),
- ?fatal({failed_validation,Reason}, S5b);
+ case xmerl_validate:validate(S5, Res) of
+ {'EXIT', {error, Reason}} ->
+ S5b = cleanup(S5),
+ ?fatal({failed_validation, Reason}, S5b);
+ {'EXIT', Reason} ->
+ S5b = cleanup(S5),
+ ?fatal({failed_validation, Reason}, S5b);
+ {error, Reason} ->
+ S5b = cleanup(S5),
+ ?fatal({failed_validation, Reason}, S5b);
+ {error, Reason, _Next} ->
+ S5b = cleanup(S5),
+ ?fatal({failed_validation, Reason}, S5b);
_XML ->
- {Res,cleanup(S5)}
+ {Res, cleanup(S5)}
end;
schema ->
- case schemaLocations(Res,S5) of
- {ok,Schemas} ->
+ case schemaLocations(Res, S5) of
+ {ok, Schemas} ->
cleanup(S5),
%%io:format("Schemas: ~p~nRes: ~p~ninhertih_options(S): ~p~n",
%% [Schemas,Res,inherit_options(S5)]),
- XSDRes = xmerl_xsd:process_validate(Schemas,Res,
+ XSDRes = xmerl_xsd:process_validate(Schemas, Res,
inherit_options(S5)),
- handle_schema_result(XSDRes,S5);
+ handle_schema_result(XSDRes, S5);
_ ->
- {Res,cleanup(S5)}
+ {Res, cleanup(S5)}
end;
_ ->
- {Res,cleanup(S5)}
+ {Res, cleanup(S5)}
end,
- {Res2, Tail, S6}.
+ Res3 =
+ case Document of
+ true ->
+ Content = lists:reverse(Prolog, [Res2 | lists:reverse(Misc)]),
+ #xmlDocument{content = Content};
+ false ->
+ Res2
+ end,
+ {Res3, Tail, S6}.
scan_decl(Str, S=#xmerl_scanner{event_fun = Event,
@@ -609,11 +638,11 @@ scan_decl(Str, S=#xmerl_scanner{event_fun = Event,
data = document}, S),
case scan_prolog(Str, S1, _StartPos = 1) of
- {T2="<"++_, S2} ->
+ {_,_,T2="<"++_, S2} ->
{{S2#xmerl_scanner.user_state,T2},[],S2};
- {[], S2}->
+ {_,_,[], S2}->
{[],[],S2};
- {T2, S2} ->
+ {_,_,T2, S2} ->
{_,_,S3} = scan_content(T2,S2,[],_Attrs=[],S2#xmerl_scanner.space,
_Lang=[],_Parents=[],#xmlNamespace{}),
{T2,[],S3}
@@ -624,14 +653,17 @@ scan_decl(Str, S=#xmerl_scanner{event_fun = Event,
%%% prolog ::= XMLDecl? Misc* (doctypedecl Misc*)?
%%%
%% empty text declarations are handled by the first function clause.
-scan_prolog([], S=#xmerl_scanner{continuation_fun = F}, Pos) ->
+scan_prolog(T, S, Pos) ->
+ scan_prolog(T, S, Pos, []).
+scan_prolog([], S=#xmerl_scanner{continuation_fun = F}, Pos, Acc) ->
?dbg("cont()...~n", []),
- F(fun(MoreBytes, S1) -> scan_prolog(MoreBytes, S1, Pos) end,
- fun(S1) -> {[], S1} end,
+ F(fun(MoreBytes, S1) -> scan_prolog(MoreBytes, S1, Pos, Acc) end,
+ fun(S1) -> {Acc, Pos, [], S1} end,
S);
-scan_prolog("<?xml"++T,S0=#xmerl_scanner{encoding=Charset0,col=Col,line=L},Pos)
- when ?whitespace(hd(T)) ->
- {Charset,T3, S3}=
+scan_prolog("<?xml"++T,
+ S0=#xmerl_scanner{encoding=Charset0,col=Col,line=L},
+ Pos,Acc) when ?whitespace(hd(T)) ->
+ {Charset, T3, S3} =
if
Col==1,L==1,S0#xmerl_scanner.text_decl==true ->
?dbg("prolog(\"<?xml\")~n", []),
@@ -639,13 +671,13 @@ scan_prolog("<?xml"++T,S0=#xmerl_scanner{encoding=Charset0,col=Col,line=L},Pos)
{_,T1,S1} = mandatory_strip(T,S),
{Decl,T2, S2}=scan_text_decl(T1,S1),
Encoding=Decl#xmlDecl.encoding,
- {Encoding,T2, S2#xmerl_scanner{encoding=Encoding}};
+ {Encoding, T2, S2#xmerl_scanner{encoding=Encoding}};
Col==1,L==1 ->
?dbg("prolog(\"<?xml\")~n", []),
?bump_col(5),
{Decl,T2, S2}=scan_xml_decl(T, S),
Encoding=Decl#xmlDecl.encoding,
- {Encoding,T2, S2#xmerl_scanner{encoding=Encoding}};
+ {Encoding, T2, S2#xmerl_scanner{encoding=Encoding}};
true ->
?fatal({xml_declaration_must_be_first_in_doc,Col,L},S0)
end,
@@ -659,7 +691,7 @@ scan_prolog("<?xml"++T,S0=#xmerl_scanner{encoding=Charset0,col=Col,line=L},Pos)
%% Now transform to declared character set.
if
Charset==Charset0 -> % Document already transformed to this charset!
- scan_prolog(T3, S3, Pos);
+ scan_prolog(T3, S3, Pos, Acc);
Charset0=/=undefined ->
%% For example may an external entity
%% have the BOM for utf-16 and the internal
@@ -668,17 +700,18 @@ scan_prolog("<?xml"++T,S0=#xmerl_scanner{encoding=Charset0,col=Col,line=L},Pos)
%% 'iso-10646-utf-1', and Charset will be 'utf-16', all
%% legal.
%%
- scan_prolog(T3,S3#xmerl_scanner{encoding=Charset0},Pos);
+ scan_prolog(T3,S3#xmerl_scanner{encoding=Charset0},Pos,Acc);
Charset == "utf-8" ->
- scan_prolog(T3, S3, Pos);
+ scan_prolog(T3, S3, Pos, Acc);
Charset=/=undefined -> % Document not previously transformed
T4=xmerl_ucs:to_unicode(T3,list_to_atom(Charset)),
- scan_prolog(T4, S3, Pos);
+ scan_prolog(T4, S3, Pos, Acc);
true -> % No encoding info given
- scan_prolog(T3, S3, Pos)
+ scan_prolog(T3, S3, Pos, Acc)
end;
-scan_prolog("<!DOCTYPE" ++ T, S0=#xmerl_scanner{environment=prolog,
- encoding=_Charset}, Pos) ->
+scan_prolog("<!DOCTYPE" ++ T,
+ S0=#xmerl_scanner{environment=prolog,encoding=_Charset},
+ Pos, Acc) ->
?dbg("prolog(\"<!DOCTYPE\")~n", []),
?bump_col(9),
%% If no known character set assume it is UTF-8
@@ -687,10 +720,13 @@ scan_prolog("<!DOCTYPE" ++ T, S0=#xmerl_scanner{environment=prolog,
true -> T
end,
{T2, S1} = scan_doctype(T1, S),
- scan_misc(T2, S1, Pos);
-scan_prolog(Str="%"++_T,S=#xmerl_scanner{environment={external,_}},_Pos) ->
- scan_ext_subset(Str,S);
-scan_prolog(Str, S0 = #xmerl_scanner{user_state=_US,encoding=_Charset},Pos) ->
+ scan_misc(T2, S1, Pos, Acc);
+scan_prolog(Str="%"++_T,S=#xmerl_scanner{environment={external,_}},
+ Pos,Acc) ->
+ {T, S1} = scan_ext_subset(Str,S),
+ {Acc, Pos, T, S1};
+scan_prolog(Str, S0 = #xmerl_scanner{user_state=_US,encoding=_Charset},
+ Pos,Acc) ->
?dbg("prolog(\"<\")~n", []),
%% Check for Comments, PI before possible DOCTYPE declaration
@@ -700,26 +736,28 @@ scan_prolog(Str, S0 = #xmerl_scanner{user_state=_US,encoding=_Charset},Pos) ->
%% Charset==undefined -> xmerl_ucs:to_unicode(Str,'utf-8');
true -> Str
end,
- {T1, S1}=scan_misc(T, S, Pos),
- scan_prolog2(T1,S1,Pos).
+ {Acc1, Pos1, T1, S1}=scan_misc(T, S, Pos, Acc),
+ scan_prolog2(T1,S1,Pos1,Acc1).
-scan_prolog2([], S=#xmerl_scanner{continuation_fun = F}, Pos) ->
+scan_prolog2([], S=#xmerl_scanner{continuation_fun = F}, Pos, Acc) ->
?dbg("cont()...~n", []),
- F(fun(MoreBytes, S1) -> scan_prolog2(MoreBytes, S1, Pos) end,
- fun(S1) -> {[], S1} end,
+ F(fun(MoreBytes, S1) -> scan_prolog2(MoreBytes, S1, Pos, Acc) end,
+ fun(S1) -> {Acc, Pos, [], S1} end,
S);
-scan_prolog2("<!DOCTYPE" ++ T, S0=#xmerl_scanner{environment=prolog}, Pos) ->
+scan_prolog2("<!DOCTYPE" ++ T, S0=#xmerl_scanner{environment=prolog},
+ Pos, Acc) ->
?dbg("prolog(\"<!DOCTYPE\")~n", []),
?bump_col(9),
{T1, S1} = scan_doctype(T, S),
- scan_misc(T1, S1, Pos);
-scan_prolog2(Str = "<!" ++ _, S, _Pos) ->
+ scan_misc(T1, S1, Pos, Acc);
+scan_prolog2(Str = "<!" ++ _, S, Pos, Acc) ->
?dbg("prolog(\"<!\")~n", []),
%% In e.g. a DTD, we jump directly to markup declarations
- scan_ext_subset(Str, S);
-scan_prolog2(Str, S0 = #xmerl_scanner{user_state=_US},Pos) ->
+ {T, S1} = scan_ext_subset(Str, S),
+ {Acc, Pos, T, S1};
+scan_prolog2(Str, S0 = #xmerl_scanner{user_state=_US},Pos,Acc) ->
?dbg("prolog(\"<\")~n", []),
%% Here we consider the DTD provided by doctype_DTD option,
@@ -733,7 +771,7 @@ scan_prolog2(Str, S0 = #xmerl_scanner{user_state=_US},Pos) ->
end,
%% Check for more Comments and PI after DOCTYPE declaration
% ?bump_col(1),
- scan_misc(Str, S1, Pos).
+ scan_misc(Str, S1, Pos, Acc).
@@ -743,26 +781,46 @@ scan_prolog2(Str, S0 = #xmerl_scanner{user_state=_US},Pos) ->
%% - Neither of Comment and PI are returned in the resulting parsed
%% structure.
%% - scan_misc/3 implements Misc* as that is how the rule is always used
-scan_misc([], S=#xmerl_scanner{continuation_fun = F}, Pos) ->
+scan_misc(T, S, Pos) ->
+ scan_misc(T, S, Pos, []).
+scan_misc([], S=#xmerl_scanner{continuation_fun = F}, Pos, Acc) ->
?dbg("cont()...~n", []),
- F(fun(MoreBytes, S1) -> scan_misc(MoreBytes, S1, Pos) end,
- fun(S1) -> {[], S1} end,
+ F(fun(MoreBytes, S1) -> scan_misc(MoreBytes, S1, Pos, Acc) end,
+ fun(S1) -> {Acc, Pos, [], S1} end,
S);
-scan_misc("<!--" ++ T, S0, Pos) -> % Comment
+scan_misc("<!--" ++ T, S0=#xmerl_scanner{acc_fun = F, comments=CF}, Pos, Acc) -> % Comment
?bump_col(4),
- {_, T1, S1} = scan_comment(T, S, Pos, _Parents = [], _Lang = []),
- scan_misc(T1,S1,Pos);
-scan_misc("<?" ++ T, S0, Pos) -> % PI
+ {C, T1, S1} = scan_comment(T, S, Pos, _Parents = [], _Lang = []),
+ case CF of
+ true ->
+ {Acc2, Pos2, S3} =
+ case F(C, Acc, S1) of
+ {Acc1, S2} ->
+ {Acc1, Pos + 1, S2};
+ {Acc1, Pos1, S2} ->
+ {Acc1, Pos1, S2}
+ end,
+ scan_misc(T1, S3, Pos2, Acc2);
+ false ->
+ scan_misc(T1, S1, Pos, Acc)
+ end;
+scan_misc("<?" ++ T, S0=#xmerl_scanner{acc_fun = F}, Pos, Acc) -> % PI
?dbg("prolog(\"<?\")~n", []),
?bump_col(2),
- {_PI, T1, S1} = scan_pi(T, S, Pos),
- scan_misc(T1,S1,Pos);
-scan_misc(T=[H|_T], S, Pos) when ?whitespace(H) ->
+ {PI, T1, S1} = scan_pi(T, S, Pos, []),
+ {Acc2, Pos2, S3} = case F(PI, Acc, S1) of
+ {Acc1, S2} ->
+ {Acc1, Pos + 1, S2};
+ {Acc1, Pos1, S2} ->
+ {Acc1, Pos1, S2}
+ end,
+ scan_misc(T1,S3,Pos2,Acc2);
+scan_misc(T=[H|_T], S, Pos, Acc) when ?whitespace(H) ->
?dbg("prolog(whitespace)~n", []),
{_,T1,S1}=strip(T,S),
- scan_misc(T1,S1,Pos);
-scan_misc(T,S,_Pos) ->
- {T,S}.
+ scan_misc(T1,S1,Pos,Acc);
+scan_misc(T,S,Pos,Acc) ->
+ {Acc,Pos,T,S}.
cleanup(S=#xmerl_scanner{keep_rules = false,
@@ -789,7 +847,8 @@ scan_xml_decl(T, S) ->
Attr = #xmlAttribute{name = version,
parents = [{xml, _XMLPos = 1}],
value = Vsn},
- scan_xml_decl(T4, S4, #xmlDecl{attributes = [Attr]}).
+ scan_xml_decl(T4, S4, #xmlDecl{vsn = Vsn,
+ attributes = [Attr]}).
scan_xml_decl([], S=#xmerl_scanner{continuation_fun = F}, Decl) ->
?dbg("cont()...~n", []),
@@ -1025,50 +1084,53 @@ xml_vsn([H|T], S=#xmerl_scanner{col = C}, Delim, Acc) ->
%%%%%%% [16] PI ::= '<?' PITarget (S (Char* - (Char* '?>' Char*)))? '?>'
-scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Pos) ->
+scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Pos, Ps) ->
?dbg("cont()...~n", []),
- F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Pos) end,
+ F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Pos, Ps) end,
fun(S1) -> ?fatal(unexpected_end, S1) end,
S);
-scan_pi(Str = [H1,H2,H3 | T],S0=#xmerl_scanner{line = L, col = C}, Pos)
+scan_pi(Str = [H1,H2,H3 | T],S0=#xmerl_scanner{line = L, col = C}, Pos, Ps)
when H1==$x;H1==$X ->
%% names beginning with [xX][mM][lL] are reserved for future use.
?bump_col(3),
if
((H2==$m) or (H2==$M)) and
((H3==$l) or (H3==$L)) ->
- scan_wellknown_pi(T,S,Pos);
+ scan_wellknown_pi(T,S,Pos,Ps);
true ->
{Target, _NamespaceInfo, T1, S1} = scan_name(Str, S),
- scan_pi(T1, S1, Target, L, C, Pos, [])
+ scan_pi(T1, S1, Target, L, C, Pos, Ps, [])
end;
-scan_pi(Str, S=#xmerl_scanner{line = L, col = C}, Pos) ->
+scan_pi(Str, S=#xmerl_scanner{line = L, col = C}, Pos, Ps) ->
{Target, _NamespaceInfo, T1, S1} = scan_name(Str, S),
- scan_pi(T1, S1, Target, L, C, Pos,[]).
+ scan_pi(T1, S1, Target, L, C, Pos, Ps, []).
%%% More info on xml-stylesheet can be found at:
%%% "Associating Style Sheets with XML documents", Version 1.0,
%%% W3C Recommendation 29 June 1999 (http://www.w3.org/TR/xml-stylesheet/)
-scan_wellknown_pi("-stylesheet"++T, S0=#xmerl_scanner{line=L,col=C},Pos) ->
+scan_wellknown_pi("-stylesheet"++T, S0=#xmerl_scanner{line=L,col=C},Pos,Ps) ->
?dbg("prolog(\"<?xml-stylesheet\")~n", []),
?bump_col(16),
- scan_pi(T, S, "xml-stylesheet",L,C,Pos,[]);
-scan_wellknown_pi(Str,S,_Pos) ->
+ scan_pi(T, S, "xml-stylesheet",L,C,Pos,Ps,[]);
+scan_wellknown_pi(Str,S,_Pos,_Ps) ->
?fatal({invalid_target_name, lists:sublist(Str, 1, 10)}, S).
-scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Target,L, C, Pos, Acc) ->
+scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Target,
+ L, C, Pos, Ps, Acc) ->
?dbg("cont()...~n", []),
- F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Target, L, C, Pos, Acc) end,
+ F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Target,
+ L, C, Pos, Ps, Acc) end,
fun(S1) -> ?fatal(unexpected_end, S1) end,
S);
scan_pi("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook,
event_fun = Event},
- Target, L, C, Pos, Acc) ->
+ Target, L, C, Pos, Ps, Acc) ->
?bump_col(2),
PI = #xmlPI{name = Target,
+ parents = Ps,
pos = Pos,
value = lists:reverse(Acc)},
S1 = #xmerl_scanner{} = Event(#xmerl_event{event = ended,
@@ -1077,22 +1139,25 @@ scan_pi("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook,
data = PI}, S),
{Ret, S2} = Hook(PI, S1),
{Ret, T, S2};
-scan_pi([H|T], S, Target, L, C, Pos, Acc) when ?whitespace(H) ->
+scan_pi([H|T], S, Target, L, C, Pos, Ps, Acc) when ?whitespace(H) ->
?strip1,
- scan_pi2(T1, S1, Target, L, C, Pos, Acc);
-scan_pi([H|_T],S,_Target, _L, _C, _Pos, _Acc) ->
+ scan_pi2(T1, S1, Target, L, C, Pos, Ps, Acc);
+scan_pi([H|_T],S,_Target, _L, _C, _Pos, _Ps, _Acc) ->
?fatal({expected_whitespace_OR_end_of_PI,{char,H}}, S).
-scan_pi2([], S=#xmerl_scanner{continuation_fun = F}, Target,L, C, Pos, Acc) ->
+scan_pi2([], S=#xmerl_scanner{continuation_fun = F}, Target,
+ L, C, Pos, Ps, Acc) ->
?dbg("cont()...~n", []),
- F(fun(MoreBytes, S1) -> scan_pi2(MoreBytes, S1, Target, L, C, Pos, Acc) end,
+ F(fun(MoreBytes, S1) -> scan_pi2(MoreBytes, S1, Target,
+ L, C, Pos, Ps, Acc) end,
fun(S1) -> ?fatal(unexpected_end, S1) end,
S);
scan_pi2("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook,
event_fun = Event},
- Target, L, C, Pos, Acc) ->
+ Target, L, C, Pos, Ps, Acc) ->
?bump_col(2),
PI = #xmlPI{name = Target,
+ parents = Ps,
pos = Pos,
value = lists:reverse(Acc)},
S1 = #xmerl_scanner{} = Event(#xmerl_event{event = ended,
@@ -1101,10 +1166,10 @@ scan_pi2("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook,
data = PI}, S),
{Ret, S2} = Hook(PI, S1),
{Ret, T, S2};
-scan_pi2(Str, S0, Target, L, C, Pos, Acc) ->
+scan_pi2(Str, S0, Target, L, C, Pos, Ps, Acc) ->
?bump_col(1),
{Ch,T} = wfc_legal_char(Str,S),
- scan_pi2(T, S, Target, L, C, Pos, [Ch|Acc]).
+ scan_pi2(T, S, Target, L, C, Pos, Ps, [Ch|Acc]).
@@ -1575,7 +1640,7 @@ scan_markup_decl("<!--" ++ T, S0) ->
scan_comment(T, S);
scan_markup_decl("<?" ++ T, S0) ->
?bump_col(2),
- {_PI, T1, S1} = scan_pi(T, S,_Pos=markup),
+ {_PI, T1, S1} = scan_pi(T, S,_Pos=markup,[]),
strip(T1, S1);
scan_markup_decl("<!ELEMENT" ++ T,
#xmerl_scanner{rules_read_fun = Read,
@@ -1981,7 +2046,7 @@ scan_element(T, S, Pos) ->
scan_element(T, S=#xmerl_scanner{line=L,col=C},
Pos, SpaceDefault,Lang, Parents, NS) ->
{Name, NamespaceInfo, T1, S1} = scan_name(T, S),
- vc_Element_valid(Name,S),
+ vc_Element_valid(Name,NamespaceInfo,S),
?strip2,
scan_element(T2, S2, Pos, Name, L, C, _Attrs = [],
Lang, Parents, NamespaceInfo, NS,
@@ -2016,7 +2081,8 @@ scan_element("/>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook,
Attrs = lists:reverse(Attrs0),
E=processed_whole_element(S, Pos, Name, Attrs, Lang, Parents,NSI,Namespace),
- wfc_unique_att_spec(Attrs,S),
+ #xmlElement{attributes = Attrs1} = E,
+ wfc_unique_att_spec(Attrs1,S),
S1 = #xmerl_scanner{} = Event(#xmerl_event{event = ended,
line = L,
col = C,
@@ -2086,9 +2152,10 @@ scan_element(T, S, Pos, Name, StartL, StartC, Attrs, Lang, Parents,
P+1
end,
Attr = #xmlAttribute{name = AttName,
+ parents = [{Name, Pos}|Parents],
pos = AttrPos,
language = Lang,
- namespace = NamespaceInfo,
+ nsinfo = NamespaceInfo,
value = AttValue,
normalized = IsNorm},
XMLBase=if
@@ -2110,6 +2177,14 @@ scan_element(T, S, Pos, Name, StartL, StartC, Attrs, Lang, Parents,
scan_element(T4, S5, Pos, Name, StartL, StartC, [Attr|Attrs],
Lang, Parents, NSI, NewNS, SpaceDefault).
+get_default_attrs(S = #xmerl_scanner{rules_read_fun = Read}, ElemName) ->
+ case Read(elem_def, ElemName, S) of
+ #xmlElement{attributes = Attrs} ->
+ [ {AttName, AttValue} ||
+ {AttName, _, AttValue, _, _} <- Attrs, AttValue =/= no_value ];
+ _ -> []
+ end.
+
get_att_type(S=#xmerl_scanner{rules_read_fun=Read},AttName,ElemName) ->
case Read(elem_def,ElemName,S) of
#xmlElement{attributes = Attrs} ->
@@ -2139,6 +2214,23 @@ processed_whole_element(S=#xmerl_scanner{hook_fun = _Hook,
Pos, Name, Attrs, Lang, Parents, NSI, Namespace) ->
Language = check_language(Attrs, Lang),
+ AllAttrs =
+ case S#xmerl_scanner.default_attrs of
+ true ->
+ [ #xmlAttribute{name = AttName,
+ parents = [{Name, Pos} | Parents],
+ language = Lang,
+ nsinfo = NSI,
+ namespace = Namespace,
+ value = AttValue,
+ normalized = true} ||
+ {AttName, AttValue} <- get_default_attrs(S, Name),
+ AttValue =/= no_value,
+ not lists:keymember(AttName, #xmlAttribute.name, Attrs) ];
+ false ->
+ Attrs
+ end,
+
{ExpName, ExpAttrs} =
case S#xmerl_scanner.namespace_conformant of
true ->
@@ -2153,14 +2245,15 @@ processed_whole_element(S=#xmerl_scanner{hook_fun = _Hook,
TempNamespace = Namespace#xmlNamespace{default = []},
ExpAttrsX =
[A#xmlAttribute{
+ namespace=Namespace,
expanded_name=expanded_name(
A#xmlAttribute.name,
- A#xmlAttribute.namespace,
+ A#xmlAttribute.nsinfo,
% NSI,
- TempNamespace, S)} || A <- Attrs],
+ TempNamespace, S)} || A <- AllAttrs],
{expanded_name(Name, NSI, Namespace, S), ExpAttrsX};
false ->
- {Name, Attrs}
+ {Name, AllAttrs}
end,
#xmlElement{name = Name,
@@ -2194,10 +2287,32 @@ check_namespace(_, _, _, NS) ->
expanded_name(Name, [], #xmlNamespace{default = []}, _S) ->
Name;
-expanded_name(Name, [], #xmlNamespace{default = URI}, _S) ->
- {URI, Name};
-expanded_name(_Name, {"xmlns", Local}, _NS, _S) -> % CHECK THIS /JB
- {"xmlns",Local};
+expanded_name(Name, [], #xmlNamespace{default = URI}, S) ->
+ case URI of
+ 'http://www.w3.org/XML/1998/namespace' ->
+ ?fatal(cannot_bind_default_namespace_to_xml_namespace_name, S);
+ 'http://www.w3.org/2000/xmlns/' ->
+ ?fatal(cannot_bind_default_namespace_to_xmlns_namespace_name, S);
+ _ ->
+ {URI, Name}
+ end;
+expanded_name(Name, N = {"xmlns", Local}, #xmlNamespace{nodes = Ns}, S) ->
+ {_, Value} = lists:keyfind(Local, 1, Ns),
+ case Name of
+ 'xmlns:xml' when Value =/= 'http://www.w3.org/XML/1998/namespace' ->
+ ?fatal({xml_prefix_cannot_be_redeclared, Value}, S);
+ 'xmlns:xmlns' ->
+ ?fatal({xmlns_prefix_cannot_be_declared, Value}, S);
+ _ ->
+ case Value of
+ 'http://www.w3.org/XML/1998/namespace' ->
+ ?fatal({cannot_bind_prefix_to_xml_namespace, Local}, S);
+ 'http://www.w3.org/2000/xmlns/' ->
+ ?fatal({cannot_bind_prefix_to_xmlns_namespace, Local}, S);
+ _ ->
+ N
+ end
+ end;
expanded_name(_Name, {Prefix, Local}, #xmlNamespace{nodes = Ns}, S) ->
case lists:keysearch(Prefix, 1, Ns) of
{value, {_, URI}} ->
@@ -2449,9 +2564,23 @@ scan_content("&" ++ T, S0, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) -
_ ->
scan_content(string_to_char_set(S1#xmerl_scanner.encoding,ExpRef)++T1,S1,Pos,Name,Attrs,Space,Lang,Parents,NS,Acc,[])
end;
-scan_content("<!--" ++ T, S, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) ->
- {_, T1, S1} = scan_comment(T, S, Pos, Parents, Lang),
- scan_content(T1, S1, Pos+1, Name, Attrs, Space, Lang, Parents, NS, Acc,[]);
+scan_content("<!--" ++ T, S0=#xmerl_scanner{acc_fun = F, comments=CF}, Pos, Name, Attrs, Space,
+ Lang, Parents, NS, Acc,[]) ->
+ ?bump_col(4),
+ {C, T1, S1} = scan_comment(T, S, Pos, Parents, Lang),
+ case CF of
+ true ->
+ {Acc2, Pos2, S3} =
+ case F(C, Acc, S1) of
+ {Acc1, S2} ->
+ {Acc1, Pos + 1, S2};
+ {Acc1, Pos1, S2} ->
+ {Acc1, Pos1, S2}
+ end,
+ scan_content(T1, S3, Pos2, Name, Attrs, Space, Lang, Parents, NS, Acc2,[]);
+ false ->
+ scan_content(T1, S1, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[])
+ end;
scan_content("<" ++ T, S0, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) ->
?bump_col(1),
{Markup, T1, S1} =
@@ -2508,9 +2637,9 @@ scan_content_markup("![CDATA[" ++ T, S0, Pos, _Name, _Attrs,
_Space, _Lang, Parents, _NS) ->
?bump_col(8),
scan_cdata(T, S, Pos, Parents);
-scan_content_markup("?"++T,S0,Pos,_Name,_Attrs,_Space,_Lang,_Parents,_NS) ->
+scan_content_markup("?"++T,S0,Pos,_Name,_Attrs,_Space,_Lang,Parents,_NS) ->
?bump_col(1),
- scan_pi(T, S, Pos);
+ scan_pi(T, S, Pos, Parents);
scan_content_markup(T, S, Pos, _Name, _Attrs, Space, Lang, Parents, NS) ->
scan_element(T, S, Pos, Space, Lang, Parents, NS).
@@ -3259,12 +3388,18 @@ mandatory_delimeter_wfc(T,S) ->
wfc_unique_att_spec([],_S) ->
ok;
-wfc_unique_att_spec([#xmlAttribute{name=N}|Atts],S) ->
+wfc_unique_att_spec([#xmlAttribute{name=N,expanded_name=EN}|Atts],S) ->
case lists:keymember(N,#xmlAttribute.name,Atts) of
true ->
?fatal({error,{unique_att_spec_required,N}},S);
_ ->
- wfc_unique_att_spec(Atts,S)
+ case S#xmerl_scanner.namespace_conformant andalso
+ lists:keymember(EN, #xmlAttribute.expanded_name, Atts) of
+ true ->
+ ?fatal({error,{unique_att_spec_required,EN}},S);
+ _ ->
+ wfc_unique_att_spec(Atts,S)
+ end
end.
wfc_legal_char(Chars,S) when is_list(Chars)->
@@ -3313,6 +3448,11 @@ wfc_Internal_parsed_entity(internal,Value,S) ->
wfc_Internal_parsed_entity(_,_,_) ->
ok.
+vc_Element_valid(_Name, {"xmlns", _},
+ S = #xmerl_scanner{namespace_conformant = true}) ->
+ ?fatal({error,{illegal_element_prefix,xmlns}},S);
+vc_Element_valid(Name, _, S) ->
+ vc_Element_valid(Name, S).
vc_Element_valid(_Name,#xmerl_scanner{environment=internal_parsed_entity}) ->
ok;
@@ -3917,7 +4057,7 @@ schemaLocations(El,#xmerl_scanner{schemaLocation=SL}) ->
schemaLocations(#xmlElement{attributes=Atts,xmlbase=_Base}) ->
Pred = fun(#xmlAttribute{name=schemaLocation}) -> false;
- (#xmlAttribute{namespace={_,"schemaLocation"}}) -> false;
+ (#xmlAttribute{nsinfo={_,"schemaLocation"}}) -> false;
(_) -> true
end,
case lists:dropwhile(Pred,Atts) of
diff --git a/lib/xmerl/src/xmerl_validate.erl b/lib/xmerl/src/xmerl_validate.erl
index 893e23ca34..4028fef2b9 100644
--- a/lib/xmerl/src/xmerl_validate.erl
+++ b/lib/xmerl/src/xmerl_validate.erl
@@ -399,25 +399,28 @@ test_attribute_value(_Rule,Attr,_,_) ->
%% +type valid_contents([rule()],[xmlElement()])->
%% [xmlElement() | {error,???}.
-valid_contents(Rule,XMLS,Rules,S,WSActionMode)->
- case parse(Rule,XMLS,Rules,WSActionMode,S) of
- {XML_N,[]}->
- lists:flatten(XML_N);
- {_,[#xmlElement{name=Name}|_T]} ->
- exit({error,{element,Name,isnt_comprise_in_the_rule,Rule}});
- {_,[#xmlText{}=Txt|_T]} ->
- exit({error,{element,text,Txt,isnt_comprise_in_the_rule,Rule}});
- {error,Reason} ->
- {error,Reason};
- {error,Reason,N} ->
- {error,Reason,N}
+valid_contents(Rule, XMLS, Rules, S, WSActionMode)->
+ case parse(Rule, XMLS, Rules, WSActionMode, S) of
+ {error, Reason} ->
+ {error, Reason};
+ {error, Reason, N} ->
+ {error, Reason, N};
+ {XML_N, Rest} -> %The list may consist of xmlComment{} records
+ case lists:dropwhile(fun(X) when is_record(X, xmlComment) -> true; (_) -> false end, Rest) of
+ [] ->
+ lists:flatten(XML_N);
+ [#xmlElement{name=Name} |_T] ->
+ exit({error, {element, Name, isnt_comprise_in_the_rule, Rule}});
+ [#xmlText{} = Txt |_T] ->
+ exit({error, {element, text, Txt, isnt_comprise_in_the_rule, Rule}})
+ end
end.
-parse({'*',SubRule},XMLS,Rules,WSaction,S)->
- star(SubRule,XMLS,Rules,WSaction,[],S);
-parse({'+',SubRule},XMLS,Rules,WSaction,S) ->
- plus(SubRule,XMLS,Rules,WSaction,S);
-parse({choice,CHOICE},XMLS,Rules,WSaction,S)->
+parse({'*', SubRule}, XMLS, Rules, WSaction, S)->
+ star(SubRule, XMLS, Rules, WSaction, [], S);
+parse({'+',SubRule}, XMLS, Rules, WSaction, S) ->
+ plus(SubRule, XMLS, Rules, WSaction, S);
+parse({choice,CHOICE}, XMLS, Rules, WSaction, S)->
% case XMLS of
% [] ->
% io:format("~p~n",[{choice,CHOICE,[]}]);
@@ -426,47 +429,49 @@ parse({choice,CHOICE},XMLS,Rules,WSaction,S)->
% [#xmlText{value=V}|_] ->
% io:format("~p~n",[{choice,CHOICE,{text,V}}])
% end,
- choice(CHOICE,XMLS,Rules,WSaction,S);
-parse(empty,[],_Rules,_WSaction,_S) ->
- {[],[]};
-parse({'?',SubRule},XMLS,Rules,_WSaction,S)->
- question(SubRule,XMLS,Rules,S);
-parse({seq,List},XMLS,Rules,WSaction,S) ->
- seq(List,XMLS,Rules,WSaction,S);
-parse(El_Name,[#xmlElement{name=El_Name}=XML|T],Rules,_WSaction,S)
+ choice(CHOICE, XMLS, Rules, WSaction, S);
+parse(empty, [], _Rules, _WSaction, _S) ->
+ {[], []};
+parse({'?', SubRule}, XMLS, Rules, _WSaction, S)->
+ question(SubRule, XMLS, Rules, S);
+parse({seq,List}, XMLS, Rules, WSaction, S) ->
+ seq(List, XMLS, Rules, WSaction, S);
+parse(El_Name, [#xmlElement{name=El_Name} = XML |T], Rules, _WSaction, S)
when is_atom(El_Name)->
- case do_validation(read_rules(Rules,El_Name),XML,Rules,S) of
- {error,R} ->
+ case do_validation(read_rules(Rules, El_Name), XML, Rules, S) of
+ {error, R} ->
% {error,R};
exit(R);
- {error,R,_N}->
+ {error, R, _N}->
% {error,R,N};
exit(R);
XML_->
- {[XML_],T}
+ {[XML_], T}
end;
-parse(any,Cont,Rules,_WSaction,S) ->
- case catch parse_any(Cont,Rules,S) of
- Err = {error,_} -> Err;
- ValidContents -> {ValidContents,[]}
+parse(any, Cont, Rules, _WSaction, S) ->
+ case catch parse_any(Cont, Rules, S) of
+ Err = {error, _} -> Err;
+ ValidContents -> {ValidContents, []}
end;
-parse(El_Name,[#xmlElement{name=Name}|_T]=S,_Rules,_WSa,_S) when is_atom(El_Name)->
+parse(El_Name, [#xmlElement{name=Name} |_T] = XMLS, _Rules, _WSa, _S) when is_atom(El_Name) ->
{error,
- {element_seq_not_conform,{wait,El_Name},{is,Name}},
- {{next,S},{act,[]}} };
-parse(_El_Name,[#xmlPI{}=H|T],_Rules,_WSa,_S) ->
- {[H],T};
-parse('#PCDATA',XML,_Rules,_WSa,_S)->
+ {element_seq_not_conform,{wait, El_Name}, {is, Name}},
+ {{next, XMLS}, {act, []}}};
+parse(El_Name, [#xmlComment{} |T], Rules, WSa, S) ->
+ parse(El_Name, T, Rules, WSa, S);
+parse(_El_Name, [#xmlPI{} = H |T], _Rules, _WSa, _S) ->
+ {[H], T};
+parse('#PCDATA', XMLS, _Rules, _WSa, _S)->
%%% PCDATA it is 0 , 1 or more #xmlText{}.
- parse_pcdata(XML);
-parse(El_Name,[#xmlText{}|_T]=S,_Rules,_WSa,_S)->
+ parse_pcdata(XMLS);
+parse(El_Name, [#xmlText{}|_T] = XMLS, _Rules, _WSa, _S)->
{error,
- {text_in_place_of,El_Name},
- {{next,S},{act,[]}}};
-parse([],_,_,_,_) ->
- {error,no_rule};
-parse(Rule,[],_,_,_) ->
- {error,{no_xml_element,Rule}}.
+ {text_in_place_of, El_Name},
+ {{next, XMLS}, {act, []}}};
+parse([], _, _, _, _) ->
+ {error, no_rule};
+parse(Rule, [], _, _, _) ->
+ {error, {no_xml_element, Rule}}.
parse_any([],_Rules,_S) ->
[];
@@ -618,11 +623,15 @@ el_name(#xmlElement{name=Name})->
parse_pcdata([#xmlText{}=H|T])->
parse_pcdata(T,[H]);
+parse_pcdata([#xmlComment{}|T])->
+ parse_pcdata(T,[]);
parse_pcdata(H) ->
{[],H}.
parse_pcdata([#xmlText{}=H|T],Acc)->
parse_pcdata(T,Acc++[H]);
+parse_pcdata([#xmlComment{}|T],Acc)->
+ parse_pcdata(T,Acc);
parse_pcdata(H,Acc) ->
{Acc,H}.
diff --git a/lib/xmerl/src/xmerl_xpath.erl b/lib/xmerl/src/xmerl_xpath.erl
index db3d3ac2d6..b3301f2faf 100644
--- a/lib/xmerl/src/xmerl_xpath.erl
+++ b/lib/xmerl/src/xmerl_xpath.erl
@@ -41,18 +41,13 @@
% xmerl_xpath_parse:parse(xmerl_xpath_scan:tokens("parent::processing-instruction('foo')")).
%% </pre>
%%
-%% @type docEntity() =
+%% @type nodeEntity() =
%% xmlElement()
%% | xmlAttribute()
%% | xmlText()
%% | xmlPI()
%% | xmlComment()
-%% @type nodeEntity() =
-%% xmlElement()
-%% | xmlAttribute()
-%% | xmlText()
-%% | xmlPI()
-%% | xmlNamespace()
+%% | xmlNsNode()
%% | xmlDocument()
%% @type option_list(). <p>Options allows to customize the behaviour of the
%% XPath scanner.
@@ -303,6 +298,17 @@ write_node(#xmlNode{pos = Pos,
node = #xmlText{value = Txt,
parents = Ps}}) ->
{text, Pos, Txt, Ps};
+write_node(#xmlNode{pos = Pos,
+ node = #xmlComment{parents = Ps}}) ->
+ {comment, Pos, '', Ps};
+write_node(#xmlNode{pos = Pos,
+ node = #xmlPI{name = Name,
+ parents = Ps}}) ->
+ {processing_instruction, Pos, Name, Ps};
+write_node(#xmlNode{pos = Pos,
+ node = #xmlNsNode{parents = Ps,
+ prefix = Prefix}}) ->
+ {namespace, Pos, Prefix, Ps};
write_node(_) ->
other.
@@ -330,18 +336,16 @@ eval_path(rel, PathExpr, C = #xmlContext{}) ->
Context = C#xmlContext{nodeset = NodeSet},
S = #state{context = Context},
path_expr(PathExpr, S);
-eval_path(filter, {PathExpr, PredExpr}, C = #xmlContext{}) ->
+eval_path(filter, {PathExpr, {pred, Pred}}, C = #xmlContext{}) ->
S = #state{context = C},
- S1 = path_expr(PathExpr, S),
- pred_expr(PredExpr, S1).
+ S1 = match_expr(PathExpr, S),
+ eval_pred(Pred, S1).
-eval_primary_expr(FC = {function_call,_,_},S = #state{context = Context}) ->
+eval_primary_expr(PrimExpr, S = #state{context = Context}) ->
%% NewNodeSet = xmerl_xpath_pred:eval(FC, Context),
- NewNodeSet = xmerl_xpath_lib:eval(primary_expr, FC, Context),
+ NewNodeSet = xmerl_xpath_lib:eval(primary_expr, PrimExpr, Context),
NewContext = Context#xmlContext{nodeset = NewNodeSet},
- S#state{context = NewContext};
-eval_primary_expr(PrimExpr,_S) ->
- exit({primary_expression,{not_implemented, PrimExpr}}).
+ S#state{context = NewContext}.
%% axis(Axis,NodeTest,Context::xmlContext()) -> xmlContext()
@@ -384,8 +388,8 @@ axis1(preceding, Tok, N, Acc, Context) ->
match_preceding(Tok, N, Acc, Context);
axis1(attribute, Tok, N, Acc, Context) ->
match_attribute(Tok, N, Acc, Context);
-%axis1(namespace, Tok, N, Acc, Context) ->
-% match_namespace(Tok, N, Acc, Context);
+axis1(namespace, Tok, N, Acc, Context) ->
+ match_namespace(Tok, N, Acc, Context);
axis1(ancestor_or_self, Tok, N, Acc, Context) ->
match_ancestor_or_self(Tok, N, Acc, Context);
axis1(descendant_or_self, Tok, N, Acc, Context) ->
@@ -627,14 +631,58 @@ node_type(#xmlAttribute{}) -> attribute;
node_type(#xmlElement{}) -> element;
node_type(#xmlText{}) -> text;
node_type(#xmlPI{}) -> processing_instruction;
-node_type(#xmlNamespace{}) -> namespace;
+node_type(#xmlNsNode{}) -> namespace;
+node_type(#xmlComment{}) -> comment;
node_type(#xmlDocument{}) -> root_node.
%% "The namespace axis contains the namespace nodes of the context node;
%% the axis will be empty unless the context node is an element."
-%match_namespace(_Tok, _N, _Acc, _Context) ->
- %% TODO: IMPLEMENT NAMESPACE AXIS
-% erlang:fault(not_yet_implemented).
+match_namespace(Tok, N, Acc, Context) ->
+ case N#xmlNode.type of
+ element ->
+ #xmlNode{parents = Ps, node = E} = N,
+ #xmlElement{name = Name,
+ namespace = NS,
+ parents = EPs,
+ pos = Pos} = E,
+ #xmlNamespace{default = Default, nodes = NSPairs} = NS,
+ ThisEPs = [{Name, Pos}|EPs],
+ ThisPs = [N|Ps],
+ Acc0 =
+ case Default of
+ D when D =:= []; D =:= '' ->
+ {[], 1};
+ URI ->
+ DefaultNSNode = #xmlNsNode{parents = ThisEPs,
+ pos = 1,
+ prefix = [],
+ uri = URI},
+ Node = #xmlNode{type = namespace,
+ node = DefaultNSNode,
+ parents = ThisPs},
+ {[Node], 2}
+ end,
+ {Nodes, _I} =
+ lists:foldr(
+ fun ({Prefix, URI}, {AccX, I}) ->
+ NSNode = #xmlNsNode{parents = ThisEPs,
+ pos = I,
+ prefix = Prefix,
+ uri = URI},
+ ThisN = #xmlNode{pos = I,
+ type = namespace,
+ node = NSNode,
+ parents = ThisPs},
+ {[ThisN | AccX], I + 1}
+ end, Acc0, NSPairs),
+ lists:foldr(
+ fun (ThisN, AccX) ->
+ match_self(Tok, ThisN, AccX, Context)
+ end, Acc, Nodes);
+ _Other ->
+ %%[]
+ Acc
+ end.
update_nodeset(Context = #xmlContext{axis_type = AxisType}, NodeSet) ->
@@ -655,8 +703,15 @@ update_nodeset(Context = #xmlContext{axis_type = AxisType}, NodeSet) ->
node_test(F, N, Context) when is_function(F) ->
F(N, Context);
+node_test(_Test, #xmlNode{type=attribute,node=#xmlAttribute{name=xmlns}},
+ _Context) ->
+ false;
+node_test(_Test,
+ #xmlNode{type=attribute,node=#xmlAttribute{nsinfo={"xmlns",_Local}}},
+ _Context) ->
+ false;
node_test({wildcard, _}, #xmlNode{type=ElAt}, _Context)
- when ElAt==element; ElAt==attribute ->
+ when ElAt==element; ElAt==attribute; ElAt==namespace ->
true;
node_test({prefix_test, Prefix}, #xmlNode{node = N}, _Context) ->
case N of
@@ -720,6 +775,9 @@ node_test({name, {_Tag, Prefix, Local}},
[{_Tag, Prefix, Local}, write_node(NSNodes)]),
false
end;
+node_test({name, {_Tag, [], Local}},
+ #xmlNode{node = #xmlNsNode{prefix = Local}}, _Context) ->
+ true;
node_test({node_type, NT}, #xmlNode{node = N}, _Context) ->
case {NT, N} of
{text, #xmlText{}} ->
@@ -728,14 +786,18 @@ node_test({node_type, NT}, #xmlNode{node = N}, _Context) ->
true;
{attribute, #xmlAttribute{}} ->
true;
- {namespace, #xmlNamespace{}} ->
+ {namespace, #xmlNsNode{}} ->
+ true;
+ {comment, #xmlComment{}} ->
+ true;
+ {processing_instruction, #xmlPI{}} ->
true;
_ ->
false
end;
-node_test({processing_instruction, {literal, _, Name}},
- #xmlNode{node = {processing_instruction, Name, _Data}}, _Context) ->
- true;
+node_test({processing_instruction, Name1},
+ #xmlNode{node = #xmlPI{name = Name2}}, _Context) ->
+ Name1 == atom_to_list(Name2);
node_test(_Other, _N, _Context) ->
%io:format("node_test(~p, ~p) -> false.~n", [_Other, write_node(_N)]),
false.
diff --git a/lib/xmerl/src/xmerl_xpath_lib.erl b/lib/xmerl/src/xmerl_xpath_lib.erl
index cfd0e36667..096f54ec30 100644
--- a/lib/xmerl/src/xmerl_xpath_lib.erl
+++ b/lib/xmerl/src/xmerl_xpath_lib.erl
@@ -49,5 +49,7 @@ primary_expr({function_call, F, Args}, C) ->
%% here, we should look up the function in the context provided
%% by the caller, but we haven't figured this out yet.
exit({not_a_core_function, F})
- end.
+ end;
+primary_expr(PrimExpr, _C) ->
+ exit({primary_expression, {not_implemented, PrimExpr}}).
diff --git a/lib/xmerl/src/xmerl_xpath_parse.yrl b/lib/xmerl/src/xmerl_xpath_parse.yrl
index 37576b9e61..f60cea0a2e 100644
--- a/lib/xmerl/src/xmerl_xpath_parse.yrl
+++ b/lib/xmerl/src/xmerl_xpath_parse.yrl
@@ -144,6 +144,7 @@ Expect 2.
%% [7]
'NodeTest' -> 'NameTest' : '$1' .
'NodeTest' -> 'node_type' '(' ')' : {node_type, value('$1')} .
+'NodeTest' -> 'processing-instruction' '(' ')' : {node_type, value('$1')} .
'NodeTest' -> 'processing-instruction' '(' 'literal' ')'
: {processing_instruction, value('$3')} .
diff --git a/lib/xmerl/src/xmerl_xpath_pred.erl b/lib/xmerl/src/xmerl_xpath_pred.erl
index 451a09bee3..855b8599fe 100644
--- a/lib/xmerl/src/xmerl_xpath_pred.erl
+++ b/lib/xmerl/src/xmerl_xpath_pred.erl
@@ -337,6 +337,9 @@ local_name1([#xmlNode{type=element,node=El}|_]) ->
local_name1([#xmlNode{type=attribute,node=Att}|_]) ->
#xmlAttribute{name=Name,nsinfo=NSI} = Att,
local_name2(Name,NSI);
+local_name1([#xmlNode{type=namespace,node=N}|_]) ->
+ #xmlNsNode{prefix=Prefix} = N,
+ ?string(Prefix);
local_name1([#xmlElement{name = Name, nsinfo = NSI}|_]) ->
local_name2(Name,NSI).
local_name2(Name, NSI) ->
@@ -431,6 +434,9 @@ string_value(N=#xmlObj{}) ->
string_value(A=#xmlNode{type=attribute}) ->
#xmlAttribute{value=AttVal}=A#xmlNode.node,
?string(AttVal);
+string_value(N=#xmlNode{type=namespace}) ->
+ #xmlNsNode{uri=URI}=N#xmlNode.node,
+ ?string(atom_to_list(URI));
string_value(El=#xmlNode{type=element}) ->
#xmlElement{content=C} = El#xmlNode.node,
TextValue = fun(#xmlText{value=T},_Fun) -> T;
@@ -442,6 +448,9 @@ string_value(El=#xmlNode{type=element}) ->
string_value(T=#xmlNode{type=text}) ->
#xmlText{value=Txt} = T#xmlNode.node,
?string(Txt);
+string_value(T=#xmlNode{type=comment}) ->
+ #xmlComment{value=Txt} = T#xmlNode.node,
+ ?string(Txt);
string_value(infinity) -> ?string("Infinity");
string_value(neg_infinity) -> ?string("-Infinity");
string_value(A) when is_atom(A) ->
diff --git a/lib/xmerl/src/xmerl_xsd.erl b/lib/xmerl/src/xmerl_xsd.erl
index dfdc6138ef..ed0890f0d0 100644
--- a/lib/xmerl/src/xmerl_xsd.erl
+++ b/lib/xmerl/src/xmerl_xsd.erl
@@ -245,21 +245,27 @@ process_validate2({SE,_},Schema,Xml,Opts) ->
S4 = validation_options(S3,Opts),
validate3(Schema,Xml,S4).
-validate3(Schema,Xml,S=#xsd_state{errors=[]}) ->
- Ret = {_,S2} =
- case catch validate_xml(Xml,S) of
- {[XML2],[],Sx} ->
- {XML2,Sx};
- {XML2,[],Sx} ->
- {XML2,Sx};
- {_,UnValidated,Sx} ->
- {Xml,acc_errs(Sx,{error_path(UnValidated,Xml#xmlElement.name),?MODULE,
- {unvalidated_rest,UnValidated}})};
- _Err = {error,Reason} ->
- {Xml,acc_errs(S,Reason)};
- {'EXIT',Reason} ->
- {Xml,acc_errs(S,{error_path(Xml,Xml#xmlElement.name),?MODULE,
- {undefined,{internal_error,Reason}}})}
+validate3(Schema, Xml,S =#xsd_state{errors=[]}) ->
+ Ret = {_, S2} =
+ case catch validate_xml(Xml, S) of
+ _Err = {error, Reason} ->
+ {Xml, acc_errs(S, Reason)};
+ {'EXIT', Reason} ->
+ {Xml, acc_errs(S, {error_path(Xml, Xml#xmlElement.name), ?MODULE,
+ {undefined, {internal_error, Reason}}})};
+ {XML2, Rest, Sx} ->
+ case lists:dropwhile(fun(X) when is_record(X, xmlComment) -> true; (_) -> false end, Rest) of
+ [] ->
+ case XML2 of
+ [XML3] ->
+ {XML3,Sx};
+ XML3 ->
+ {XML3,Sx}
+ end;
+ UnValidated ->
+ {Xml,acc_errs(Sx,{error_path(UnValidated,Xml#xmlElement.name),?MODULE,
+ {unvalidated_rest,UnValidated}})}
+ end
end,
save_to_file(S2,filename:rootname(Schema)++".tab2"),
case S2#xsd_state.errors of
@@ -1950,7 +1956,7 @@ fetch_external_schema(Path,S) when is_list(Path) ->
{EXSD,S#xsd_state{schema_name=File}}
end;
{_,{string,String},_} -> %% this is for a user defined fetch fun that returns an xml document on string format.
- ?debug("scanning string: ~p~n",[File]),
+ ?debug("scanning string: ~p~n",[String]),
case xmerl_scan:string(String,S#xsd_state.xml_options) of
{error,Reason} ->
{error,acc_errs(S,{[],?MODULE,{parsing_external_schema_failed,Path,Reason}})};
@@ -2520,9 +2526,9 @@ check_element_type([],#schema_complex_type{name=_Name,block=_Bl,content=C},
{error,{error_path(Checked,undefined),?MODULE,
{empty_content_not_allowed,C}}}
end;
-check_element_type(C,{anyType,_},_Env,_Block,S,_Checked) ->
+check_element_type(C, {anyType, _}, _Env, _Block, S, _Checked) ->
%% permitt anything
- {C,[],S};
+ {lists:reverse(C), [], S};
check_element_type(XML=[#xmlText{}|_],Type=#schema_simple_type{},
_Env,_Block,S,_Checked) ->
@@ -2585,7 +2591,7 @@ check_element_type(XML=[XMLEl=#xmlElement{name=Name}|RestXML],
S6 = check_form(ElName,Name,XMLEl,
actual_form_value(CMEl#schema_element.form,
S5#xsd_state.elementFormDefault),
- S5),
+ S5),
%Step into content of XML element.
{Content,_,S7} =
case
@@ -2605,12 +2611,12 @@ check_element_type(XML=[XMLEl=#xmlElement{name=Name}|RestXML],
RestXML,
set_scope(S5#xsd_state.scope,set_num_el(S7,S6))};
true ->
- {error,{error_path(XMLEl,Name),?MODULE,
- {element_not_suitable_with_schema,ElName,S}}};
+ {error,{error_path(XMLEl, Name), ?MODULE,
+ {element_not_suitable_with_schema, ElName, S}}};
_ when S#xsd_state.num_el >= Min ->
%% it may be a match error or an optional element not
%% present
- {[],XML,S#xsd_state{num_el=0}};
+ {[], XML, S#xsd_state{num_el=0}};
_ ->
{error,{error_path(XMLEl,Name),?MODULE,
{element_not_suitable_with_schema,ElName,CMName,CMEl,S}}}
@@ -2645,7 +2651,7 @@ check_element_type(XML=[#xmlElement{}|_Rest],
check_element_type(XML=[E=#xmlElement{name=Name}|Rest],
Any={any,{Namespace,_Occ={Min,_},ProcessorContents}},Env,
_Block,S,_Checked) ->
- ?debug("check any: {any,{~p,~p,~p}}~n",[Namespace,Occ,ProcessorContents]),
+ ?debug("check any: {any,{~p,~p,~p}}~n",[Namespace,_Occ,ProcessorContents]),
%% ProcessorContents any of lax | strict | skip
%% lax: may validate if schema is found
%% strict: must validate
@@ -2710,8 +2716,11 @@ check_element_type([],CM,_Env,_Block,S,Checked) ->
{error,{error_path(Checked,undefined),?MODULE,
{empty_content_not_allowed,CM}}}
end;
+check_element_type([C = #xmlComment{} |Rest],CM,Env,Block,S,Checked) ->
+ check_element_type(Rest,CM,Env,Block,S,[C |Checked]);
check_element_type(XML,CM,_Env,_Block,S,_Checked) ->
{error,{error_path(XML,undefined),?MODULE,{match_failure,XML,CM,S}}}.
+
%% single xml content object and single schema object
check_text_type(XML=[#xmlText{}|_],optional_text,S) ->
% {XMLTxt,optional_text};
@@ -2730,7 +2739,7 @@ check_text_type([XMLTxt=#xmlText{}|_],CMEl,_S) ->
{cannot_contain_text,XMLTxt,CMEl}}}.
split_xmlText(XML) ->
- splitwith(fun(#xmlText{}) -> true;(_) -> false end,XML).
+ splitwith(fun(#xmlText{}) -> true;(#xmlComment{}) -> true;(_) -> false end,XML).
%% Sequence
check_sequence([T=#xmlText{}|Rest],Els,Occ,Env,S,Checked) ->
@@ -2773,6 +2782,8 @@ check_sequence(Seq=[_InstEl=#xmlElement{}|_],[El|Els],Occ={_Min,_Max},Env,S,Chec
count_num_el(set_num_el(S3,S2)),
Ret++Checked)
end;
+check_sequence([C = #xmlComment{} |Rest], Els, Occ, Env, S, Checked) ->
+ check_sequence(Rest,Els,Occ,Env,S,[C |Checked]);
check_sequence(Rest,[],_Occ,_Env,S,Checked) ->
{Checked,Rest,set_num_el(S,0)};
check_sequence([],Els,_Occ,_Env,S,Checked) ->
@@ -2869,6 +2880,8 @@ check_all(XML=[E=#xmlElement{name=Name}|RestXML],CM,Occ,Env,S,
{element_not_in_all,ElName,E,CM}},
check_all(RestXML,CM,Occ,Env,acc_errs(S,Err),[E|Checked],PrevXML)
end;
+check_all([C=#xmlComment{} |RestXML], CM, Occ, Env, S, Checked, XML) ->
+ check_all(RestXML, CM, Occ, Env, S, [C |Checked], XML);
check_all(XML,[],_,_,S,Checked,_) ->
{Checked,XML,S};
check_all([],CM,_Occ,_,S,Checked,_PrevXML) ->
@@ -2920,7 +2933,7 @@ check_target_namespace(XMLEl,S) ->
schemaLocations(El=#xmlElement{attributes=Atts},S) ->
Pred = fun(#xmlAttribute{name=schemaLocation}) -> false;
- (#xmlAttribute{namespace={_,"schemaLocation"}}) -> false;
+ (#xmlAttribute{nsinfo={_,"schemaLocation"}}) -> false;
(_) -> true
end,
case lists:dropwhile(Pred,Atts) of
diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl
index 94c38d4d48..55b6d1844c 100644
--- a/lib/xmerl/test/xmerl_SUITE.erl
+++ b/lib/xmerl/test/xmerl_SUITE.erl
@@ -58,7 +58,7 @@ groups() ->
{ticket_tests, [],
[ticket_5998, ticket_7211, ticket_7214, ticket_7430,
ticket_6873, ticket_7496, ticket_8156, ticket_8697,
- ticket_9411, ticket_9457]},
+ ticket_9411, ticket_9457, ticket_9664_schema, ticket_9664_dtd]},
{app_test, [], [{xmerl_app_test, all}]},
{appup_test, [], [{xmerl_appup_test, all}]}].
@@ -284,7 +284,7 @@ export(Config) ->
?line {E,_} = xmerl_scan:file(TestFile),
?line Exported = xmerl:export([E],xmerl_xml,[{prolog,Prolog}]),
B = list_to_binary(Exported++"\n"),
- ?line {ok,B} = file:read_file(TestFile),
+ ?line {ok, B} = file:read_file(TestFile),
ok.
%%----------------------------------------------------------------------
@@ -609,6 +609,38 @@ ticket_9457_cont(Continue, Exception, GlobalState) ->
Exception(GlobalState)
end.
+
+ticket_9664_schema(suite) -> [];
+ticket_9664_schema(doc) ->
+ ["Test that comments are handled correct whith"];
+ticket_9664_schema(Config) ->
+
+ ?line {E, _} = xmerl_scan:file(filename:join([?config(data_dir, Config), misc,
+ "ticket_9664_schema.xml"]),[]),
+ ?line {ok, S} = xmerl_xsd:process_schema(filename:join([?config(data_dir, Config), misc,
+ "motorcycles.xsd"])),
+ ?line {E1, _} = xmerl_xsd:validate(E, S),
+
+ ?line {E1,_} = xmerl_xsd:process_validate(filename:join([?config(data_dir,Config), misc,
+ "motorcycles.xsd"]),E,[]),
+
+ ?line {E1,_} = xmerl_scan:file(filename:join([?config(data_dir,Config), misc,
+ "ticket_9664_schema.xml"]),
+ [{schemaLocation, [{"mc", "motorcycles.xsd"}]},
+ {validation, schema}]),
+ ok.
+
+ticket_9664_dtd(suite) -> [];
+ticket_9664_dtd(doc) ->
+ ["Test that comments are handled correct whith"];
+ticket_9664_dtd(Config) ->
+ ?line {E, _} = xmerl_scan:file(filename:join([?config(data_dir, Config), misc,
+ "ticket_9664_dtd.xml"]),[]),
+ ?line {E, _} = xmerl_scan:file(filename:join([?config(data_dir, Config), misc,
+ "ticket_9664_dtd.xml"]),[{validation, true}]),
+ ok.
+
+
%%======================================================================
%% Support Functions
%%======================================================================
diff --git a/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz b/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz
index fef7431845..ffc1d327a5 100644
--- a/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz
+++ b/lib/xmerl/test/xmerl_SUITE_data/misc.tar.gz
Binary files differ
diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl
index 850b7f8135..7b6f1e95b3 100644
--- a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl
+++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl
@@ -210,7 +210,7 @@ ticket_7496() ->
?line {Doc3,_} = xmerl_scan:file("documentRoot.xml"),
?line ok = Test(Doc3,"//child",[child,child,child]),
?line ok = Test(Doc3,"//child[@name='beta']",[child]),
- ?line [{xmlAttribute,id,[],[],[],[],1,[],"2",false}] =
+ ?line [{xmlAttribute,id,[],[],[],_,1,[],"2",false}] =
xmerl_xpath:string("/documentRoot/parent/child[@name='beta']/@id",Doc3),
?line ok = Test(Doc3,"/documentRoot/parent/child|/documentRoot/parent/pet",
[child,child,child,pet,pet]),
diff --git a/lib/xmerl/vsn.mk b/lib/xmerl/vsn.mk
index 82df8fdeef..de47e3418b 100644
--- a/lib/xmerl/vsn.mk
+++ b/lib/xmerl/vsn.mk
@@ -1 +1 @@
-XMERL_VSN = 1.2.10
+XMERL_VSN = 1.3