aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--bootstrap/lib/kernel/ebin/gen_sctp.beambin3524 -> 3588 bytes
-rw-r--r--erts/doc/src/erlang.xml2
-rw-r--r--erts/doc/src/erts_alloc.xml59
-rw-r--r--erts/emulator/Makefile.in1
-rw-r--r--erts/emulator/beam/beam_emu.c3
-rw-r--r--erts/emulator/beam/beam_load.c16
-rw-r--r--erts/emulator/beam/big.c8
-rw-r--r--erts/emulator/beam/break.c5
-rw-r--r--erts/emulator/beam/dist.c4
-rw-r--r--erts/emulator/beam/erl_alloc.c70
-rw-r--r--erts/emulator/beam/erl_alloc_util.c20
-rw-r--r--erts/emulator/beam/erl_alloc_util.h6
-rw-r--r--erts/emulator/beam/erl_ao_firstfit_alloc.c3
-rw-r--r--erts/emulator/beam/erl_bestfit_alloc.c3
-rwxr-xr-xerts/emulator/beam/erl_bif_info.c5
-rw-r--r--erts/emulator/beam/erl_binary.h6
-rw-r--r--erts/emulator/beam/erl_db.c4
-rw-r--r--erts/emulator/beam/erl_db_util.h2
-rw-r--r--erts/emulator/beam/erl_lock_check.c5
-rw-r--r--erts/emulator/beam/erl_node_container_utils.h10
-rw-r--r--erts/emulator/beam/erl_process.c4
-rw-r--r--erts/emulator/beam/erl_process.h4
-rw-r--r--erts/emulator/beam/erl_trace.c38
-rw-r--r--erts/emulator/beam/erl_unicode.c3
-rw-r--r--erts/emulator/beam/erl_utils.h10
-rw-r--r--erts/emulator/beam/erl_vm.h14
-rw-r--r--erts/emulator/beam/external.h4
-rwxr-xr-xerts/emulator/beam/global.h6
-rw-r--r--erts/emulator/beam/io.c2
-rw-r--r--erts/emulator/beam/sys.h23
-rw-r--r--erts/emulator/beam/utils.c4
-rw-r--r--erts/emulator/drivers/common/inet_drv.c2
-rw-r--r--erts/emulator/drivers/unix/ttsl_drv.c8
-rw-r--r--erts/emulator/drivers/win32/win_efile.c2
-rw-r--r--erts/emulator/sys/common/erl_mmap.c2832
-rw-r--r--erts/emulator/sys/common/erl_mmap.h134
-rw-r--r--erts/emulator/sys/common/erl_mseg.c876
-rw-r--r--erts/emulator/sys/common/erl_mseg.h36
-rw-r--r--erts/emulator/sys/unix/sys.c10
-rwxr-xr-xerts/emulator/sys/win32/sys.c2
-rw-r--r--erts/emulator/test/alloc_SUITE.erl69
-rw-r--r--erts/emulator/test/big_SUITE_data/eq_big.dat1
-rw-r--r--erts/emulator/test/call_trace_SUITE.erl2
-rw-r--r--erts/emulator/test/driver_SUITE.erl6
-rw-r--r--erts/emulator/test/statistics_SUITE.erl12
-rw-r--r--erts/emulator/test/time_SUITE.erl22
-rw-r--r--erts/emulator/test/trace_SUITE.erl2
-rw-r--r--erts/emulator/test/trace_port_SUITE.erl2
-rw-r--r--erts/etc/common/erlexec.c4
-rw-r--r--erts/preloaded/ebin/erlang.beambin94156 -> 94244 bytes
-rw-r--r--erts/preloaded/src/erlang.erl2
-rw-r--r--lib/asn1/src/Makefile4
-rw-r--r--lib/asn1/src/asn1ct_check.erl105
-rw-r--r--lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl3
-rw-r--r--lib/asn1/src/asn1ct_constructed_per.erl71
-rw-r--r--lib/asn1/src/asn1ct_gen.erl44
-rw-r--r--lib/asn1/src/asn1ct_imm.erl44
-rw-r--r--lib/asn1/src/asn1ct_value.erl17
-rw-r--r--lib/asn1/src/asn1rtt_check.erl91
-rw-r--r--lib/asn1/src/asn1rtt_per_common.erl41
-rw-r--r--lib/asn1/src/prepare_templates.erl72
-rw-r--r--lib/asn1/test/asn1_SUITE.erl36
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Constraints.py5
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Default.asn3
-rw-r--r--lib/asn1/test/asn1_SUITE_data/PrimStrings.asn18
-rw-r--r--lib/asn1/test/testConstraints.erl64
-rw-r--r--lib/asn1/test/testParamBasic.erl7
-rw-r--r--lib/asn1/test/testPrimStrings.erl41
-rw-r--r--lib/asn1/test/testSeqSetDefaultVal.erl191
-rw-r--r--lib/common_test/src/cth_log_redirect.erl12
-rw-r--r--lib/common_test/test/common_test.cover1
-rw-r--r--lib/common_test/test/ct_pre_post_test_io_SUITE.erl43
-rw-r--r--lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl3
-rw-r--r--lib/compiler/src/beam_clean.erl2
-rw-r--r--lib/compiler/src/beam_type.erl2
-rw-r--r--lib/compiler/src/compile.erl4
-rw-r--r--lib/compiler/src/core_scan.erl4
-rw-r--r--lib/compiler/src/v3_core.erl2
-rw-r--r--lib/compiler/src/v3_kernel.erl8
-rw-r--r--lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl4
-rw-r--r--lib/debugger/test/int_SUITE_data/lists1.erl4
-rw-r--r--lib/debugger/test/int_SUITE_data/my_lists.erl16
-rw-r--r--lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl2
-rw-r--r--lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl2
-rw-r--r--lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl4
-rw-r--r--lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl4
-rw-r--r--lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl4
-rw-r--r--lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl2
-rw-r--r--lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl6
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/trec12
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/contract3.erl11
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl6
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/gencall.erl2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl17
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl10
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/trec.erl16
-rw-r--r--lib/erl_interface/src/legacy/erl_eterm.c2
-rw-r--r--lib/erl_interface/test/all_SUITE_data/ei_runner.c4
-rw-r--r--lib/erl_interface/test/all_SUITE_data/runner.c4
-rw-r--r--lib/erl_interface/test/ei_accept_SUITE.erl2
-rw-r--r--lib/erl_interface/test/erl_connect_SUITE.erl2
-rw-r--r--lib/erl_interface/test/erl_eterm_SUITE.erl10
-rw-r--r--lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c8
-rw-r--r--lib/hipe/cerl/erl_types.erl13
-rw-r--r--lib/inets/doc/src/httpc.xml7
-rw-r--r--lib/inets/src/http_client/httpc.erl23
-rw-r--r--lib/inets/src/http_client/httpc_handler.erl69
-rw-r--r--lib/inets/src/http_client/httpc_internal.hrl6
-rw-r--r--lib/inets/src/http_client/httpc_manager.erl128
-rw-r--r--lib/inets/test/httpc_SUITE.erl17
-rw-r--r--lib/kernel/doc/src/gen_sctp.xml2
-rw-r--r--lib/kernel/src/gen_sctp.erl4
-rw-r--r--lib/kernel/src/inet.erl15
-rw-r--r--lib/observer/doc/src/ttb.xml7
-rw-r--r--lib/orber/test/multi_ORB_SUITE.erl47
-rw-r--r--lib/orber/test/orber_nat_SUITE.erl107
-rw-r--r--lib/public_key/doc/src/using_public_key.xml4
-rw-r--r--lib/ssh/doc/src/ssh.xml4
-rw-r--r--lib/ssl/src/ssl_cipher.erl2
-rw-r--r--lib/ssl/src/ssl_handshake.erl74
-rw-r--r--lib/ssl/src/ssl_handshake.hrl3
-rw-r--r--lib/ssl/src/tls_connection.erl31
-rw-r--r--lib/ssl/src/tls_handshake.erl9
-rw-r--r--lib/stdlib/src/dict.erl2
-rw-r--r--lib/stdlib/src/erl_eval.erl4
-rw-r--r--lib/stdlib/src/erl_tar.erl4
-rw-r--r--lib/stdlib/src/filelib.erl4
-rw-r--r--lib/stdlib/src/gen_server.erl2
-rw-r--r--lib/stdlib/src/io_lib.erl2
-rw-r--r--lib/stdlib/src/lists.erl4
-rw-r--r--lib/stdlib/src/string.erl4
-rw-r--r--lib/stdlib/test/slave_SUITE.erl2
-rw-r--r--lib/test_server/src/ts.erl2
-rw-r--r--lib/tools/emacs/erlang-eunit.el4
-rw-r--r--lib/tools/emacs/erlang-start.el2
-rw-r--r--lib/tools/emacs/erlang.el38
-rw-r--r--lib/tools/src/tags.erl4
-rw-r--r--lib/tools/test/eprof_SUITE_data/eed.erl8
-rw-r--r--lib/xmerl/src/xmerl_regexp.erl12
-rw-r--r--system/doc/top/src/erl_html_tools.erl2
141 files changed, 4465 insertions, 1659 deletions
diff --git a/bootstrap/lib/kernel/ebin/gen_sctp.beam b/bootstrap/lib/kernel/ebin/gen_sctp.beam
index 1f33d85cb2..e1384d1b5e 100644
--- a/bootstrap/lib/kernel/ebin/gen_sctp.beam
+++ b/bootstrap/lib/kernel/ebin/gen_sctp.beam
Binary files differ
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index d3b21de8cf..bc38055b62 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -2467,7 +2467,7 @@ os_prompt% </pre>
fails, a <c>nodedown</c> message is delivered.</p>
<p>Nodes connected through hidden connections can be monitored
as any other node.</p>
- <p>Failure: <c>badarg</c>if the local node is not alive.</p>
+ <p>Failure: <c>badarg</c> if the local node is not alive.</p>
</desc>
</func>
<func>
diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml
index 6ce2261430..9dab5b3876 100644
--- a/erts/doc/src/erts_alloc.xml
+++ b/erts/doc/src/erts_alloc.xml
@@ -271,6 +271,65 @@
memory segment cache is not reused if its size exceeds the
requested size with more than relative max cache bad fit
percent of the requested size. Default value is 20.</item>
+ <tag><marker id="MMscmgc"><c><![CDATA[+MMscmgc <amount>]]></c></marker></tag>
+ <item>
+ Set <seealso marker="#MMscs">super carrier</seealso> max guaranteed
+ no of carriers. This parameter defaults to <c>65536</c>. This
+ parameter determines an amount of pre-allocated structures that is
+ needed in order to keep track of different areas in the super carrier.
+ When the system runs out of such structures it may crash due to an
+ out of memory condition.
+ </item>
+ <tag><marker id="MMsco"><c><![CDATA[+MMsco true|false]]></c></marker></tag>
+ <item>
+ Set <seealso marker="#MMscs">super carrier</seealso> only flag. This
+ flag defaults to <c>true</c>. When a super carrier is used and this
+ flag is <c>true</c>, the system will crash when a carrier request
+ cannot be satisfied by the super carrier. When the flag is <c>false</c>
+ the system will try to create requested carrier by other means.
+ <br/><br/>
+ <em>NOTE</em>: Setting this flag to <c>false</c> may not be supported
+ on all systems. This flag will in that case be ignored.
+ <br/><br/>
+ <em>NOTE</em>: The super carrier cannot be enabled nor
+ disabled on halfword heap systems. This flag will be
+ ignored on halfword heap systems.
+ </item>
+ <tag><marker id="MMscrpm"><c><![CDATA[+MMscrpm true|false]]></c></marker></tag>
+ <item>
+ Set <seealso marker="#MMscs">super carrier</seealso> reserve physical
+ memory flag. This flag defaults to <c>true</c>. When this flag is
+ <c>true</c>, physical memory will be reserved for the whole super
+ carrier at once when it is created. The reservation will after that
+ be left unchanged. When this flag is set to <c>false</c> only virtual
+ address space will be reserved for the super carrier upon creation.
+ The system will attempt to reserve physical memory upon carrier
+ creations in the super carrier, and attempt to unreserve physical
+ memory upon carrier destructions in the super carrier.
+ <br/><br/>
+ <em>NOTE</em>: What reservation of physical memory actually means
+ highly depends on the operating system, and how it is configured. For
+ example, different memory overcommit settings on Linux drastically
+ change the behaviour. Also note, setting this flag to <c>false</c>
+ may not be supported on all systems. This flag will in that case
+ be ignored.
+ <br/><br/>
+ <em>NOTE</em>: The super carrier cannot be enabled nor
+ disabled on halfword heap systems. This flag will be
+ ignored on halfword heap systems.
+ </item>
+ <tag><marker id="MMscs"><c><![CDATA[+MMscs <size in MB>]]></c></marker></tag>
+ <item>
+ Set super carrier size (in MB). The super carrier size defaults to
+ zero; i.e, the super carrier is by default disabled. The super
+ carrier is a large continuous area in the virtual address space.
+ The system will always try to create new carriers in the super
+ carrier.
+ <br/><br/>
+ <em>NOTE</em>: The super carrier cannot be enabled nor
+ disabled on halfword heap systems. This flag will be
+ ignored on halfword heap systems.
+ </item>
<tag><marker id="MMmcs"><c><![CDATA[+MMmcs <amount>]]></c></marker></tag>
<item>
Max cached segments. The maximum number of memory segments
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 9751982103..f442540f49 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -808,6 +808,7 @@ OS_OBJS += $(OBJDIR)/erl_poll.o \
endif
OS_OBJS += $(OBJDIR)/erl_mseg.o \
+ $(OBJDIR)/erl_mmap.o \
$(OBJDIR)/erl_$(ERLANG_OSTYPE)_sys_ddll.o \
$(OBJDIR)/erl_mtrace_sys_wrap.o \
$(OBJDIR)/erl_sys_common_misc.o
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index da36c4437e..78ab6fa30f 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -5654,7 +5654,6 @@ build_stacktrace(Process* c_p, Eterm exc) {
return res;
}
-
static BeamInstr*
call_error_handler(Process* p, BeamInstr* fi, Eterm* reg, Eterm func)
{
@@ -5702,7 +5701,6 @@ call_error_handler(Process* p, BeamInstr* fi, Eterm* reg, Eterm func)
return ep->addressv[erts_active_code_ix()];
}
-
static Export*
apply_setup_error_handler(Process* p, Eterm module, Eterm function, Uint arity, Eterm* reg)
{
@@ -6208,7 +6206,6 @@ new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free)
return make_fun(funp);
}
-
int catchlevel(Process *p)
{
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 4193eb4f3f..938fd8f2c9 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -535,7 +535,6 @@ static int must_swap_floats;
Uint erts_total_code_size;
/**********************************************************************/
-
void init_load(void)
{
FloatDef f;
@@ -1209,7 +1208,6 @@ verify_chunks(LoaderState* stp)
return 0;
}
-
static int
load_atom_table(LoaderState* stp)
{
@@ -1255,7 +1253,6 @@ load_atom_table(LoaderState* stp)
return 0;
}
-
static int
load_import_table(LoaderState* stp)
{
@@ -1308,7 +1305,6 @@ load_import_table(LoaderState* stp)
return 0;
}
-
static int
read_export_table(LoaderState* stp)
{
@@ -1641,7 +1637,6 @@ read_line_table(LoaderState* stp)
return 0;
}
-
static int
read_code_header(LoaderState* stp)
{
@@ -1711,7 +1706,6 @@ read_code_header(LoaderState* stp)
return 0;
}
-
#define VerifyTag(Stp, Actual, Expected) \
if (Actual != Expected) { \
LoadError2(Stp, "bad tag %d; expected %d", Actual, Expected); \
@@ -1730,7 +1724,6 @@ read_code_header(LoaderState* stp)
#define TermWords(t) (((t) / (sizeof(BeamInstr)/sizeof(Eterm))) + !!((t) % (sizeof(BeamInstr)/sizeof(Eterm))))
-
static int
load_code(LoaderState* stp)
{
@@ -2512,7 +2505,6 @@ load_code(LoaderState* stp)
return retval;
}
-
#define succ(St, X, Y) ((X).type == (Y).type && (X).val + 1 == (Y).val)
#define succ2(St, X, Y) ((X).type == (Y).type && (X).val + 2 == (Y).val)
#define succ3(St, X, Y) ((X).type == (Y).type && (X).val + 3 == (Y).val)
@@ -3958,7 +3950,6 @@ tuple_append_put(LoaderState* stp, GenOpArg Arity, GenOpArg Dst,
}
-
/*
* Freeze the code in memory, move the string table into place,
* resolve all labels.
@@ -4276,7 +4267,6 @@ freeze_code(LoaderState* stp)
return 0;
}
-
static void
final_touch(LoaderState* stp)
{
@@ -4378,7 +4368,6 @@ final_touch(LoaderState* stp)
}
}
-
static int
transform_engine(LoaderState* st)
{
@@ -4716,7 +4705,6 @@ transform_engine(LoaderState* st)
return rval;
}
-
static void
short_file(int line, LoaderState* stp, unsigned needed)
{
@@ -4724,7 +4712,6 @@ short_file(int line, LoaderState* stp, unsigned needed)
stp->file_name, needed);
}
-
static void
load_printf(int line, LoaderState* context, char *fmt,...)
{
@@ -5190,7 +5177,6 @@ native_addresses(Process* p, Eterm mod)
return result;
}
-
/*
* Builds a list of all exported functions in the given module:
* [{Name, Arity},...]
@@ -5240,7 +5226,6 @@ exported_from_module(Process* p, /* Process whose heap to use. */
return result;
}
-
/*
* Returns a list of all attributes for the module.
*
@@ -5281,7 +5266,6 @@ attributes_for_module(Process* p, /* Process whose heap to use. */
return result;
}
-
/*
* Returns a list containing compilation information.
*
diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c
index 6b43c53985..2b27b111d8 100644
--- a/erts/emulator/beam/big.c
+++ b/erts/emulator/beam/big.c
@@ -1325,9 +1325,9 @@ static dsize_t I_lshift(ErtsDigit* x, dsize_t xl, Sint y,
return 1;
}
else {
- SWord ay = (y < 0) ? -y : y;
- int bw = ay / D_EXP;
- int sw = ay % D_EXP;
+ Uint ay = (y < 0) ? -y : y;
+ Uint bw = ay / D_EXP;
+ Uint sw = ay % D_EXP;
dsize_t rl;
ErtsDigit a1=0;
ErtsDigit a0=0;
@@ -1368,7 +1368,7 @@ static dsize_t I_lshift(ErtsDigit* x, dsize_t xl, Sint y,
}
if (sign) {
- int zl = bw;
+ Uint zl = bw;
ErtsDigit* z = x;
while(zl--) {
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index ad9a89b642..99604fa3bc 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -76,7 +76,10 @@ process_info(int to, void *to_arg)
for (i = 0; i < max; i++) {
Process *p = erts_pix2proc(i);
if (p && p->i != ENULL) {
- if (!ERTS_PROC_IS_EXITING(p))
+ /* Do not include processes with no heap,
+ * they are most likely just created and has invalid data
+ */
+ if (!ERTS_PROC_IS_EXITING(p) && p->heap != NULL)
print_process_info(to, to_arg, p);
}
}
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index 44f4eb9d43..aabccac822 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -353,7 +353,7 @@ static void doit_link_net_exits_sub(ErtsLink *sublnk, void *vlnecp)
static void doit_link_net_exits(ErtsLink *lnk, void *vnecp)
{
LinkNetExitsContext lnec = {(NetExitsContext *) vnecp, lnk};
- ASSERT(lnk->type == LINK_PID)
+ ASSERT(lnk->type == LINK_PID);
erts_sweep_links(ERTS_LINK_ROOT(lnk), &doit_link_net_exits_sub, (void *) &lnec);
#ifdef DEBUG
ERTS_LINK_ROOT(lnk) = NULL;
@@ -369,7 +369,7 @@ static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp)
Process *rp;
ErtsLink *rlnk;
Uint i,n;
- ASSERT(lnk->type == LINK_NODE)
+ ASSERT(lnk->type == LINK_NODE);
if (is_internal_pid(lnk->pid)) {
ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK;
rp = erts_pid2proc(NULL, 0, lnk->pid, rp_locks);
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 6dec383cee..d8da616d05 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -718,6 +718,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
init.mseg.nos = erts_no_schedulers;
erts_mseg_init(&init.mseg);
#endif
+
erts_alcu_init(&init.alloc_util);
erts_afalc_init();
erts_bfalc_init();
@@ -1174,6 +1175,25 @@ get_kb_value(char *param_end, char** argv, int* ip)
return ((Uint) tmp)*1024;
}
+static UWord
+get_mb_value(char *param_end, char** argv, int* ip)
+{
+ SWord tmp;
+ UWord max = ((~((UWord) 0))/(1024*1024)) + 1;
+ char *rest;
+ char *param = argv[*ip]+1;
+ char *value = get_value(param_end, argv, ip);
+ errno = 0;
+ tmp = (SWord) ErtsStrToSint(value, &rest, 10);
+ if (errno != 0 || rest == value || tmp < 0 || max < ((UWord) tmp))
+ bad_value(param, param_end, value);
+ if (max == (UWord) tmp)
+ return ~((UWord) 0);
+ else
+ return ((UWord) tmp)*1024*1024;
+}
+
+
#if 0
static Uint
get_byte_value(char *param_end, char** argv, int* ip)
@@ -1448,6 +1468,30 @@ 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("scs", argv[i]+3)) {
+#if HAVE_ERTS_MSEG
+ init->mseg.mmap.scs =
+#endif
+ get_mb_value(argv[i]+6, argv, &i);
+ }
+ else if (has_prefix("sco", argv[i]+3)) {
+#if HAVE_ERTS_MSEG
+ init->mseg.mmap.sco =
+#endif
+ get_bool_value(argv[i]+6, argv, &i);
+ }
+ else if (has_prefix("scrpm", argv[i]+3)) {
+#if HAVE_ERTS_MSEG
+ init->mseg.mmap.scrpm =
+#endif
+ get_bool_value(argv[i]+8, argv, &i);
+ }
+ else if (has_prefix("scmgc", argv[i]+3)) {
+#if HAVE_ERTS_MSEG
+ init->mseg.mmap.scmgc =
+#endif
+ get_amount_value(argv[i]+8, argv, &i);
+ }
else {
bad_param(param, param+2);
}
@@ -2668,6 +2712,7 @@ erts_allocator_info(int to, void *arg)
#if HAVE_ERTS_MSEG
{
+ struct erts_mmap_info_struct emis;
#ifdef ERTS_SMP
int max = (int) erts_no_schedulers;
#else
@@ -2678,6 +2723,8 @@ erts_allocator_info(int to, void *arg)
erts_print(to, arg, "=allocator:mseg_alloc[%d]\n", i);
erts_mseg_info(i, &to, arg, 0, NULL, NULL);
}
+ erts_print(to, arg, "=allocator:mseg_alloc.erts_mmap\n");
+ erts_mmap_info(&to, arg, NULL, NULL, &emis);
}
#endif
@@ -2904,6 +2951,7 @@ reply_alloc_info(void *vair)
Uint sz, *szp;
ErlOffHeap *ohp = NULL;
ErlHeapFragment *bp = NULL;
+ struct erts_mmap_info_struct emis;
int i;
Eterm (*info_func)(Allctr_t *,
int,
@@ -3016,15 +3064,23 @@ reply_alloc_info(void *vair)
? NIL
: erts_mseg_info(0, NULL, NULL, hpp != NULL,
hpp, szp));
- ainfo = erts_bld_tuple(hpp, szp, 3,
- alloc_atom,
- make_small(0),
- ainfo);
+ ainfo = erts_bld_tuple3(hpp, szp,
+ alloc_atom,
+ make_small(0),
+ ainfo);
+
+ ai_list = erts_bld_cons(hpp, szp,
+ ainfo, ai_list);
+ ainfo = (air->only_sz ? NIL : erts_mmap_info(NULL, NULL, hpp, szp, &emis));
+ ainfo = erts_bld_tuple3(hpp, szp,
+ alloc_atom,
+ erts_bld_atom(hpp,szp,"erts_mmap"),
+ ainfo);
#else
- ainfo = erts_bld_tuple(hpp, szp, 2, alloc_atom,
- am_false);
+ ainfo = erts_bld_tuple2(hpp, szp, alloc_atom,
+ am_false);
#endif
- break;
+ break;
default:
alloc_atom = erts_bld_atom(hpp, szp,
(char *) ERTS_ALC_A2AD(ai));
diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c
index 825b68bb85..1fdee4db2c 100644
--- a/erts/emulator/beam/erl_alloc_util.c
+++ b/erts/emulator/beam/erl_alloc_util.c
@@ -87,9 +87,6 @@ static int initialized = 0;
#define SYS_ALLOC_CARRIER_CEILING(X) \
SYS_ALLOC_CARRIER_FLOOR((X) + INV_SYS_ALLOC_CARRIER_MASK)
-#undef ASSERT
-#define ASSERT ASSERT_EXPR
-
#if 0
/* Can be useful for debugging */
#define MBC_REALLOC_ALWAYS_MOVES
@@ -759,8 +756,9 @@ static ERTS_INLINE void *
alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
{
void *res;
-
- res = erts_mseg_alloc_opt(allctr->alloc_no, size_p, flags, &allctr->mseg_opt);
+ UWord size = (UWord) *size_p;
+ res = erts_mseg_alloc_opt(allctr->alloc_no, &size, flags, &allctr->mseg_opt);
+ *size_p = (Uint) size;
INC_CC(allctr->calls.mseg_alloc);
return res;
}
@@ -769,9 +767,10 @@ static ERTS_INLINE void *
alcu_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p)
{
void *res;
-
- res = erts_mseg_realloc_opt(allctr->alloc_no, seg, old_size, new_size_p,
+ UWord new_size = (UWord) *new_size_p;
+ res = erts_mseg_realloc_opt(allctr->alloc_no, seg, (UWord) old_size, &new_size,
ERTS_MSEG_FLG_NONE, &allctr->mseg_opt);
+ *new_size_p = (Uint) new_size;
INC_CC(allctr->calls.mseg_realloc);
return res;
}
@@ -779,7 +778,7 @@ alcu_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p)
static ERTS_INLINE void
alcu_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, Uint flags)
{
- erts_mseg_dealloc_opt(allctr->alloc_no, seg, size, flags, &allctr->mseg_opt);
+ erts_mseg_dealloc_opt(allctr->alloc_no, seg, (UWord) size, flags, &allctr->mseg_opt);
INC_CC(allctr->calls.mseg_dealloc);
}
@@ -3226,10 +3225,12 @@ static void CHECK_1BLK_CARRIER(Allctr_t* A, int SBC, int MSEGED, Carrier_t* C,
ASSERT(IS_MBC_BLK((B)));
ASSERT(IS_MB_CARRIER((C)));
ASSERT(FBLK_TO_MBC(B) == (C));
+ if ((MSEGED)) {
+ ASSERT_ERTS_SACRR_UNIT_SIZE_MULTIPLE((CSZ));
+ }
}
if ((MSEGED)) {
ASSERT(IS_MSEG_CARRIER((C)));
- ASSERT_ERTS_SACRR_UNIT_SIZE_MULTIPLE((CSZ));
}
else {
ASSERT(IS_SYS_ALLOC_CARRIER((C)));
@@ -3601,7 +3602,6 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk, Carrier_t **busy_pcrr_pp)
#if HAVE_ERTS_MSEG
if (IS_MSEG_CARRIER(crr)) {
- ASSERT(crr_sz % ERTS_SACRR_UNIT_SZ == 0);
STAT_MSEG_SBC_FREE(allctr, crr_sz, blk_sz);
}
else
diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h
index 70ecf28172..222f137024 100644
--- a/erts/emulator/beam/erl_alloc_util.h
+++ b/erts/emulator/beam/erl_alloc_util.h
@@ -254,9 +254,9 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t);
# define MBC_ABLK_SZ_MASK (~FLG_MASK)
#endif
-#define MBC_ABLK_SZ(B) (ASSERT_EXPR(!is_sbc_blk(B)), (B)->bhdr & MBC_ABLK_SZ_MASK)
-#define MBC_FBLK_SZ(B) (ASSERT_EXPR(!is_sbc_blk(B)), (B)->bhdr & MBC_FBLK_SZ_MASK)
-#define SBC_BLK_SZ(B) (ASSERT_EXPR(is_sbc_blk(B)), (B)->bhdr & SBC_BLK_SZ_MASK)
+#define MBC_ABLK_SZ(B) (ASSERT(!is_sbc_blk(B)), (B)->bhdr & MBC_ABLK_SZ_MASK)
+#define MBC_FBLK_SZ(B) (ASSERT(!is_sbc_blk(B)), (B)->bhdr & MBC_FBLK_SZ_MASK)
+#define SBC_BLK_SZ(B) (ASSERT(is_sbc_blk(B)), (B)->bhdr & SBC_BLK_SZ_MASK)
#define CARRIER_SZ(C) \
((C)->chdr & CARRIER_SZ_MASK)
diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c
index 4e6c8b317e..396aa88e0b 100644
--- a/erts/emulator/beam/erl_ao_firstfit_alloc.c
+++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c
@@ -85,9 +85,6 @@
#define SET_RED(N) (((AOFF_RBTree_t *) (N))->flags |= RED_FLG)
#define SET_BLACK(N) (((AOFF_RBTree_t *) (N))->flags &= ~RED_FLG)
-#undef ASSERT
-#define ASSERT ASSERT_EXPR
-
#if 1
#define RBT_ASSERT ASSERT
#else
diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c
index 41f449bb28..59c14899a2 100644
--- a/erts/emulator/beam/erl_bestfit_alloc.c
+++ b/erts/emulator/beam/erl_bestfit_alloc.c
@@ -75,9 +75,6 @@
#define BF_BLK_SZ(B) MBC_FBLK_SZ(&(B)->hdr)
-#undef ASSERT
-#define ASSERT ASSERT_EXPR
-
#if 1
#define RBT_ASSERT ASSERT
#else
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 3b25efd9af..5fbcbbe250 100755
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -2091,7 +2091,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(res);
} else if (BIF_ARG_1 == am_sequential_tracer) {
val = erts_get_system_seq_tracer();
- ASSERT(is_internal_pid(val) || is_internal_port(val) || val==am_false)
+ ASSERT(is_internal_pid(val) || is_internal_port(val) || val==am_false);
hp = HAlloc(BIF_P, 3);
res = TUPLE2(hp, am_sequential_tracer, val);
BIF_RET(res);
@@ -3289,6 +3289,9 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
erts_smp_thr_progress_unblock();
BIF_RET(res);
}
+ else if (ERTS_IS_ATOM_STR("mmap", BIF_ARG_1)) {
+ BIF_RET(erts_mmap_debug_info(BIF_P));
+ }
}
else if (is_tuple(BIF_ARG_1)) {
Eterm* tp = tuple_val(BIF_ARG_1);
diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h
index 506c4813fa..f7dc20f5e6 100644
--- a/erts/emulator/beam/erl_binary.h
+++ b/erts/emulator/beam/erl_binary.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2013. 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
@@ -153,7 +153,7 @@ do { \
#define binary_bytes(Bin) \
(*binary_val(Bin) == HEADER_PROC_BIN ? \
((ProcBin *) binary_val(Bin))->bytes : \
- (ASSERT_EXPR(thing_subtag(*binary_val(Bin)) == HEAP_BINARY_SUBTAG), \
+ (ASSERT(thing_subtag(*binary_val(Bin)) == HEAP_BINARY_SUBTAG), \
(byte *)(&(((ErlHeapBin *) binary_val(Bin))->data))))
void erts_init_binary(void);
@@ -183,7 +183,7 @@ BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen);
#endif
#define ERTS_CHK_BIN_ALIGNMENT(B) \
- do { ASSERT(!(B) || (((UWord) &((Binary *)(B))->orig_bytes[0]) & ERTS_BIN_ALIGNMENT_MASK) == ((UWord) 0)) } while(0)
+ do { ASSERT(!(B) || (((UWord) &((Binary *)(B))->orig_bytes[0]) & ERTS_BIN_ALIGNMENT_MASK) == ((UWord) 0)); } while(0)
ERTS_GLB_INLINE byte* erts_get_aligned_binary_bytes(Eterm bin, byte** base_ptr);
ERTS_GLB_INLINE void erts_free_aligned_binary_bytes(byte* buf);
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index 40b8eaf8fb..41e64fcd4f 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -2236,7 +2236,7 @@ static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1)
CHECK_TABLES();
tptr = tuple_val(a1);
- ASSERT(arityval(*tptr) >= 1)
+ ASSERT(arityval(*tptr) >= 1);
if ((tb = db_get_table(p, tptr[1], DB_READ, kind)) == NULL) {
BIF_ERROR(p, BADARG);
@@ -2403,7 +2403,7 @@ static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1)
CHECK_TABLES();
tptr = tuple_val(a1);
- ASSERT(arityval(*tptr) >= 1)
+ ASSERT(arityval(*tptr) >= 1);
if ((tb = db_get_table(p, tptr[1], DB_READ, kind)) == NULL) {
BIF_ERROR(p, BADARG);
}
diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h
index 90b79e6044..328b19dfc9 100644
--- a/erts/emulator/beam/erl_db_util.h
+++ b/erts/emulator/beam/erl_db_util.h
@@ -457,7 +457,7 @@ int erts_db_is_compiled_ms(Eterm term);
&& ERTS_MAGIC_BIN_DESTRUCTOR((BP)) == erts_db_match_prog_destructor)
#define Binary2MatchProg(BP) \
- (ASSERT_EXPR(IsMatchProgBinary((BP))), \
+ (ASSERT(IsMatchProgBinary((BP))), \
((MatchProg *) ERTS_MAGIC_BIN_DATA((BP))))
/*
** Debugging
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index 2114d0c001..0dd83fa6ed 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -132,6 +132,7 @@ static erts_lc_lock_order_t erts_lock_order[] = {
#endif /* __WIN32__ */
{ "alcu_init_atoms", NULL },
{ "mseg_init_atoms", NULL },
+ { "mmap_init_atoms", NULL },
{ "drv_tsd", NULL },
{ "async_enq_mtx", NULL },
#ifdef ERTS_SMP
@@ -185,7 +186,9 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "sys_gethrtime", NULL },
#endif
#endif
- { "erts_alloc_hard_debug", NULL }
+ { "erts_alloc_hard_debug", NULL },
+ { "hard_dbg_mseg", NULL },
+ { "erts_mmap", NULL }
};
#define ERTS_LOCK_ORDER_SIZE \
diff --git a/erts/emulator/beam/erl_node_container_utils.h b/erts/emulator/beam/erl_node_container_utils.h
index 0f93a3a9f0..17f6b32bb1 100644
--- a/erts/emulator/beam/erl_node_container_utils.h
+++ b/erts/emulator/beam/erl_node_container_utils.h
@@ -106,7 +106,7 @@
#define dist_entry_channel_no(x) \
((x) == erts_this_dist_entry \
? ((Uint) 0) \
- : (ASSERT_EXPR(is_atom((x)->sysname)), \
+ : (ASSERT(is_atom((x)->sysname)), \
(Uint) atom_val((x)->sysname)))
#define internal_channel_no(x) ((Uint) ERST_INTERNAL_CHANNEL_NO)
#define external_channel_no(x) \
@@ -122,10 +122,10 @@ extern ErtsPTab erts_proc;
(D), \
_TAG_IMMED1_PID)
-#define internal_pid_index(PID) (ASSERT_EXPR(is_internal_pid((PID))), \
+#define internal_pid_index(PID) (ASSERT(is_internal_pid((PID))), \
erts_ptab_id2pix(&erts_proc, (PID)))
-#define internal_pid_data(PID) (ASSERT_EXPR(is_internal_pid((PID))), \
+#define internal_pid_data(PID) (ASSERT(is_internal_pid((PID))), \
erts_ptab_id2data(&erts_proc, (PID)))
#define internal_pid_number(x) _GET_PID_NUM(internal_pid_data((x)))
@@ -193,10 +193,10 @@ extern ErtsPTab erts_port;
(D), \
_TAG_IMMED1_PORT)
-#define internal_port_index(PRT) (ASSERT_EXPR(is_internal_port((PRT))), \
+#define internal_port_index(PRT) (ASSERT(is_internal_port((PRT))), \
erts_ptab_id2pix(&erts_port, (PRT)))
-#define internal_port_data(PRT) (ASSERT_EXPR(is_internal_port((PRT))), \
+#define internal_port_data(PRT) (ASSERT(is_internal_port((PRT))), \
erts_ptab_id2data(&erts_port, (PRT)))
#define internal_port_number(x) _GET_PORT_NUM(internal_port_data((x)))
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 434d5ca147..1efd070afd 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -294,7 +294,7 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(proclist,
ERTS_ALC_T_PROC_LIST)
#define ERTS_SCHED_SLEEP_INFO_IX(IX) \
- (ASSERT_EXPR(-1 <= ((int) (IX)) \
+ (ASSERT(-1 <= ((int) (IX)) \
&& ((int) (IX)) < ((int) erts_no_schedulers)), \
&aligned_sched_sleep_info[(IX)].ssi)
@@ -7471,6 +7471,7 @@ alloc_process(ErtsRunQueue *rq, erts_aint32_t state)
p->approx_started = erts_get_approx_time();
p->rcount = 0;
+ p->heap = NULL;
ASSERT(p == (Process *) (erts_ptab_pix2intptr_nob(
@@ -7583,7 +7584,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
hipe_init_process_smp(&p->hipe_smp);
#endif
#endif
-
p->heap = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm)*sz);
p->old_hend = p->old_htop = p->old_heap = NULL;
p->high_water = p->heap;
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 8e5467f196..8d136f6e8b 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -1135,10 +1135,10 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags;
} while (0)
#define ERTS_RUNQ_IX(IX) \
- (ASSERT_EXPR(0 <= (IX) && (IX) < erts_no_run_queues), \
+ (ASSERT(0 <= (IX) && (IX) < erts_no_run_queues), \
&erts_aligned_run_queues[(IX)].runq)
#define ERTS_SCHEDULER_IX(IX) \
- (ASSERT_EXPR(0 <= (IX) && (IX) < erts_no_schedulers), \
+ (ASSERT(0 <= (IX) && (IX) < erts_no_schedulers), \
&erts_aligned_scheduler_data[(IX)].esd)
void erts_pre_init_process(void);
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index fa015ee4b9..ff7fdfcfca 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -2184,7 +2184,7 @@ trace_gc(Process *p, Eterm what)
AM_bin_old_vheap_block_size
};
- Uint values[] = {
+ UWord values[] = {
OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0,
HEAP_SIZE(p),
MBUF_SIZE(p),
@@ -2198,7 +2198,7 @@ trace_gc(Process *p, Eterm what)
BIN_OLD_VHEAP_SZ(p)
};
#define LOCAL_HEAP_SIZE \
- (sizeof(values)/sizeof(Eterm)) * \
+ (sizeof(values)/sizeof(*values)) * \
(2/*cons*/ + 3/*2-tuple*/ + BIG_UINT_HEAP_SIZE) + \
5/*4-tuple */ + TS_HEAP_WORDS
DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p);
@@ -2206,7 +2206,7 @@ trace_gc(Process *p, Eterm what)
Eterm* limit;
#endif
- ASSERT(sizeof(values)/sizeof(Uint) == sizeof(tags)/sizeof(Eterm));
+ ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(Eterm));
UseTmpHeap(LOCAL_HEAP_SIZE,p);
@@ -2214,9 +2214,9 @@ trace_gc(Process *p, Eterm what)
hp = local_heap;
#ifdef DEBUG
size = 0;
- (void) erts_bld_atom_uint_2tup_list(NULL,
+ (void) erts_bld_atom_uword_2tup_list(NULL,
&size,
- sizeof(values)/sizeof(Uint),
+ sizeof(values)/sizeof(*values),
tags,
values);
size += 5/*4-tuple*/ + TS_SIZE(p);
@@ -2229,9 +2229,9 @@ trace_gc(Process *p, Eterm what)
ERTS_TRACE_FLAGS(p));
size = 0;
- (void) erts_bld_atom_uint_2tup_list(NULL,
+ (void) erts_bld_atom_uword_2tup_list(NULL,
&size,
- sizeof(values)/sizeof(Uint),
+ sizeof(values)/sizeof(*values),
tags,
values);
size += 5/*4-tuple*/ + TS_SIZE(p);
@@ -2244,9 +2244,9 @@ trace_gc(Process *p, Eterm what)
ASSERT(size <= LOCAL_HEAP_SIZE);
#endif
- msg = erts_bld_atom_uint_2tup_list(&hp,
+ msg = erts_bld_atom_uword_2tup_list(&hp,
NULL,
- sizeof(values)/sizeof(Uint),
+ sizeof(values)/sizeof(*values),
tags,
values);
@@ -2415,7 +2415,7 @@ monitor_long_gc(Process *p, Uint time) {
am_old_heap_size,
am_heap_size
};
- Eterm values[] = {
+ UWord values[] = {
time,
OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0,
HEAP_SIZE(p),
@@ -2436,9 +2436,9 @@ monitor_long_gc(Process *p, Uint time) {
#endif
hsz = 0;
- (void) erts_bld_atom_uint_2tup_list(NULL,
+ (void) erts_bld_atom_uword_2tup_list(NULL,
&hsz,
- sizeof(values)/sizeof(Uint),
+ sizeof(values)/sizeof(*values),
tags,
values);
hsz += 5 /* 4-tuple */;
@@ -2449,9 +2449,9 @@ monitor_long_gc(Process *p, Uint time) {
hp_end = hp + hsz;
#endif
- list = erts_bld_atom_uint_2tup_list(&hp,
+ list = erts_bld_atom_uword_2tup_list(&hp,
NULL,
- sizeof(values)/sizeof(Uint),
+ sizeof(values)/sizeof(*values),
tags,
values);
msg = TUPLE4(hp, am_monitor, p->common.id, am_long_gc, list);
@@ -2489,7 +2489,7 @@ monitor_large_heap(Process *p) {
am_old_heap_size,
am_heap_size
};
- Uint values[] = {
+ UWord values[] = {
OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0,
HEAP_SIZE(p),
MBUF_SIZE(p),
@@ -2511,9 +2511,9 @@ monitor_large_heap(Process *p) {
#endif
hsz = 0;
- (void) erts_bld_atom_uint_2tup_list(NULL,
+ (void) erts_bld_atom_uword_2tup_list(NULL,
&hsz,
- sizeof(values)/sizeof(Uint),
+ sizeof(values)/sizeof(*values),
tags,
values);
hsz += 5 /* 4-tuple */;
@@ -2524,9 +2524,9 @@ monitor_large_heap(Process *p) {
hp_end = hp + hsz;
#endif
- list = erts_bld_atom_uint_2tup_list(&hp,
+ list = erts_bld_atom_uword_2tup_list(&hp,
NULL,
- sizeof(values)/sizeof(Uint),
+ sizeof(values)/sizeof(*values),
tags,
values);
msg = TUPLE4(hp, am_monitor, p->common.id, am_large_heap, list);
diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c
index e00440b905..569c0a7d31 100644
--- a/erts/emulator/beam/erl_unicode.c
+++ b/erts/emulator/beam/erl_unicode.c
@@ -1476,6 +1476,9 @@ static Eterm do_utf8_to_list_normalize(Process *p, Uint num, byte *bytes, Uint s
Uint16 savepoints[4];
int numpoints = 0;
+ if (num == 0)
+ return NIL;
+
ASSERT(num > 0);
hp = HAlloc(p,num * 2); /* May be to much */
diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h
index 80d29d554a..292d135946 100644
--- a/erts/emulator/beam/erl_utils.h
+++ b/erts/emulator/beam/erl_utils.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2013. 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
@@ -168,6 +168,10 @@ Eterm erts_bld_uint64(Uint **hpp, Uint *szp, Uint64 ui64);
Eterm erts_bld_sint64(Uint **hpp, Uint *szp, Sint64 si64);
Eterm erts_bld_cons(Uint **hpp, Uint *szp, Eterm car, Eterm cdr);
Eterm erts_bld_tuple(Uint **hpp, Uint *szp, Uint arity, ...);
+#define erts_bld_tuple2(H,S,E1,E2) erts_bld_tuple(H,S,2,E1,E2)
+#define erts_bld_tuple3(H,S,E1,E2,E3) erts_bld_tuple(H,S,3,E1,E2,E3)
+#define erts_bld_tuple4(H,S,E1,E2,E3,E4) erts_bld_tuple(H,S,4,E1,E2,E3,E4)
+#define erts_bld_tuple5(H,S,E1,E2,E3,E4,E5) erts_bld_tuple(H,S,5,E1,E2,E3,E4,E5)
Eterm erts_bld_tuplev(Uint **hpp, Uint *szp, Uint arity, Eterm terms[]);
Eterm erts_bld_string_n(Uint **hpp, Uint *szp, const char *str, Sint len);
#define erts_bld_string(hpp,szp,str) erts_bld_string_n(hpp,szp,str,strlen(str))
@@ -175,8 +179,8 @@ Eterm erts_bld_list(Uint **hpp, Uint *szp, Sint length, Eterm terms[]);
Eterm erts_bld_2tup_list(Uint **hpp, Uint *szp,
Sint length, Eterm terms1[], Uint terms2[]);
Eterm
-erts_bld_atom_uint_2tup_list(Uint **hpp, Uint *szp,
- Sint length, Eterm atoms[], Uint uints[]);
+erts_bld_atom_uword_2tup_list(Uint **hpp, Uint *szp,
+ Sint length, Eterm atoms[], UWord uints[]);
Eterm
erts_bld_atom_2uint_3tup_list(Uint **hpp, Uint *szp, Sint length,
Eterm atoms[], Uint uints1[], Uint uints2[]);
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index c962955de9..337422eead 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2013. 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
@@ -80,7 +80,7 @@
# ifdef CHECK_FOR_HOLES
# define INIT_HEAP_MEM(p,sz) erts_set_hole_marker(HEAP_TOP(p), (sz))
# else
-# define INIT_HEAP_MEM(p,sz) memset(HEAP_TOP(p),DEBUG_BAD_BYTE,(sz)*sizeof(Eterm*))
+# define INIT_HEAP_MEM(p,sz) memset(HEAP_TOP(p),0x01,(sz)*sizeof(Eterm*))
# endif
#else
# define INIT_HEAP_MEM(p,sz) ((void)0)
@@ -98,7 +98,7 @@
* failing that, in a heap fragment.
*/
#define HAllocX(p, sz, xtra) \
- (ASSERT_EXPR((sz) >= 0), \
+ (ASSERT((sz) >= 0), \
ErtsHAllocLockCheck(p), \
(IS_FORCE_HEAP_FRAGS || (((HEAP_LIMIT(p) - HEAP_TOP(p)) < (sz))) \
? erts_heap_alloc((p),(sz),(xtra)) \
@@ -135,14 +135,14 @@
*/
#ifdef CHECK_FOR_HOLES
# define HeapOnlyAlloc(p, sz) \
- (ASSERT_EXPR((sz) >= 0), \
- (ASSERT_EXPR(((HEAP_LIMIT(p) - HEAP_TOP(p)) >= (sz))), \
+ (ASSERT((sz) >= 0), \
+ (ASSERT(((HEAP_LIMIT(p) - HEAP_TOP(p)) >= (sz))), \
(erts_set_hole_marker(HEAP_TOP(p), (sz)), \
(HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz)))))
#else
# define HeapOnlyAlloc(p, sz) \
- (ASSERT_EXPR((sz) >= 0), \
- (ASSERT_EXPR(((HEAP_LIMIT(p) - HEAP_TOP(p)) >= (sz))), \
+ (ASSERT((sz) >= 0), \
+ (ASSERT(((HEAP_LIMIT(p) - HEAP_TOP(p)) >= (sz))), \
(HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz))))
#endif
diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h
index e37d47919e..ff29e84972 100644
--- a/erts/emulator/beam/external.h
+++ b/erts/emulator/beam/external.h
@@ -138,8 +138,8 @@ typedef struct {
#define ERTS_DIST_EXT_SIZE(EDEP) \
(sizeof(ErtsDistExternal) \
- (((EDEP)->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB) \
- ? (ASSERT_EXPR(0 <= (EDEP)->attab.size \
- && (EDEP)->attab.size <= ERTS_ATOM_CACHE_SIZE), \
+ ? (ASSERT(0 <= (EDEP)->attab.size \
+ && (EDEP)->attab.size <= ERTS_ATOM_CACHE_SIZE), \
sizeof(Eterm)*(ERTS_ATOM_CACHE_SIZE - (EDEP)->attab.size)) \
: sizeof(ErtsAtomTranslationTable)))
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index bacd5a5752..063d16c0c7 100755
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -866,13 +866,13 @@ Eterm store_external_or_ref_in_proc_(Process *, Eterm);
Eterm store_external_or_ref_(Uint **, ErlOffHeap*, Eterm);
#define NC_HEAP_SIZE(NC) \
- (ASSERT_EXPR(is_node_container((NC))), \
+ (ASSERT(is_node_container((NC))), \
IS_CONST((NC)) ? 0 : (thing_arityval(*boxed_val((NC))) + 1))
#define STORE_NC(Hpp, ETpp, NC) \
- (ASSERT_EXPR(is_node_container((NC))), \
+ (ASSERT(is_node_container((NC))), \
IS_CONST((NC)) ? (NC) : store_external_or_ref_((Hpp), (ETpp), (NC)))
#define STORE_NC_IN_PROC(Pp, NC) \
- (ASSERT_EXPR(is_node_container((NC))), \
+ (ASSERT(is_node_container((NC))), \
IS_CONST((NC)) ? (NC) : store_external_or_ref_in_proc_((Pp), (NC)))
/* duplicates from big.h */
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index c1e66b59af..db19f6c142 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -1330,7 +1330,7 @@ force_imm_drv_call(ErtsTryImmDrvCallState *sp)
erts_aint32_t invalid_state;
Port *prt = sp->port;
- ASSERT(ERTS_IS_CRASH_DUMPING)
+ ASSERT(ERTS_IS_CRASH_DUMPING);
ASSERT(is_atom(sp->port_op));
invalid_state = sp->state;
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index 096394b878..9561c0be96 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -149,19 +149,14 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType;
# define ERTS_EXIT_AFTER_DUMP exit
#endif
+#define ERTS_ASSERT(e) \
+ ((void) ((e) ? 1 : (erl_assert_error(#e, __func__, __FILE__, __LINE__), 0)))
+void erl_assert_error(const char* expr, const char *func, const char* file, int line);
+
#ifdef DEBUG
-# define ASSERT(e) \
- if (e) { \
- ; \
- } else { \
- erl_assert_error(#e, __FILE__, __LINE__); \
- }
-# define ASSERT_EXPR(e) \
- ((void) ((e) ? 1 : (erl_assert_error(#e, __FILE__, __LINE__), 0)))
-void erl_assert_error(char* expr, char* file, int line);
+# define ASSERT(e) ERTS_ASSERT(e)
#else
-# define ASSERT(e)
-# define ASSERT_EXPR(e) ((void) 1)
+# define ASSERT(e) ((void) 1)
#endif
/*
@@ -282,16 +277,19 @@ typedef unsigned long UWord;
typedef long SWord;
#define SWORD_CONSTANT(Const) Const##L
#define UWORD_CONSTANT(Const) Const##UL
+#define ERTS_SWORD_MAX LONG_MAX
#elif SIZEOF_VOID_P == SIZEOF_INT
typedef unsigned int UWord;
typedef int SWord;
#define SWORD_CONSTANT(Const) Const
#define UWORD_CONSTANT(Const) Const##U
+#define ERTS_SWORD_MAX INT_MAX
#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG
typedef unsigned long long UWord;
typedef long long SWord;
#define SWORD_CONSTANT(Const) Const##LL
#define UWORD_CONSTANT(Const) Const##ULL
+#define ERTS_SWORD_MAX LLONG_MAX
#else
#error Found no appropriate type to use for 'Eterm', 'Uint' and 'Sint'
#endif
@@ -304,6 +302,7 @@ typedef unsigned long Uint;
typedef long Sint;
#define SWORD_CONSTANT(Const) Const##L
#define UWORD_CONSTANT(Const) Const##UL
+#define ERTS_SWORD_MAX LONG_MAX
#define ERTS_SIZEOF_ETERM SIZEOF_LONG
#define ErtsStrToSint strtol
#elif SIZEOF_VOID_P == SIZEOF_INT
@@ -312,6 +311,7 @@ typedef unsigned int Uint;
typedef int Sint;
#define SWORD_CONSTANT(Const) Const
#define UWORD_CONSTANT(Const) Const##U
+#define ERTS_SWORD_MAX INT_MAX
#define ERTS_SIZEOF_ETERM SIZEOF_INT
#define ErtsStrToSint strtol
#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG
@@ -320,6 +320,7 @@ typedef unsigned long long Uint;
typedef long long Sint;
#define SWORD_CONSTANT(Const) Const##LL
#define UWORD_CONSTANT(Const) Const##ULL
+#define ERTS_SWORD_MAX LLONG_MAX
#define ERTS_SIZEOF_ETERM SIZEOF_LONG_LONG
#if defined(__WIN32__)
#define ErtsStrToSint _strtoi64
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index bd2be7afca..0d75bbcc77 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -576,8 +576,8 @@ erts_bld_2tup_list(Uint **hpp, Uint *szp,
}
Eterm
-erts_bld_atom_uint_2tup_list(Uint **hpp, Uint *szp,
- Sint length, Eterm atoms[], Uint uints[])
+erts_bld_atom_uword_2tup_list(Uint **hpp, Uint *szp,
+ Sint length, Eterm atoms[], UWord uints[])
{
Sint i;
Eterm res = THE_NON_VALUE;
diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c
index 60db50e80a..12f45245b5 100644
--- a/erts/emulator/drivers/common/inet_drv.c
+++ b/erts/emulator/drivers/common/inet_drv.c
@@ -4433,7 +4433,7 @@ static ErlDrvSSizeT inet_ctl_getiflist(inet_descriptor* desc,
case AF_INET6:
#endif
case AF_INET:
- ASSERT(sp+IFNAMSIZ+1 < sbuf+ifc.ifc_len+1)
+ ASSERT(sp+IFNAMSIZ+1 < sbuf+ifc.ifc_len+1);
strncpy(sp, ifrp->ifr_name, IFNAMSIZ);
sp[IFNAMSIZ] = '\0';
sp += strlen(sp), ++sp;
diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c
index 1e436830e7..491e0a090e 100644
--- a/erts/emulator/drivers/unix/ttsl_drv.c
+++ b/erts/emulator/drivers/unix/ttsl_drv.c
@@ -745,7 +745,7 @@ static Sint16 get_sint16(char *s)
{
return ((*s << 8) | ((byte*)s)[1]);
}
-
+
static int start_lbuf(void)
{
if (!lbuf && !(lbuf = ( Uint32*) driver_alloc(lbuf_size * sizeof(Uint32))))
@@ -1091,7 +1091,7 @@ static int move_cursor(int from, int to)
move_left(-dc);
return TRUE;
}
-
+
static int start_termcap(void)
{
int eres;
@@ -1187,7 +1187,7 @@ static int move_down(int n)
tputs(down, 1, outc);
return TRUE;
}
-
+
/*
* Updates cols if terminal has resized (SIGWINCH). Should be called
@@ -1209,7 +1209,7 @@ static void update_cols(void)
cols = width;
}
}
-
+
/*
* Put a terminal device into non-canonical mode with ECHO off.
diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c
index b36a103f8e..319065f57b 100644
--- a/erts/emulator/drivers/win32/win_efile.c
+++ b/erts/emulator/drivers/win32/win_efile.c
@@ -1216,7 +1216,7 @@ int flags;
return 1;
}
-
+
/*
* is_root_unc_name - returns TRUE if the argument is a UNC name specifying
* a root share. That is, if it is of the form \\server\share\.
diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c
new file mode 100644
index 0000000000..a9da7430fb
--- /dev/null
+++ b/erts/emulator/sys/common/erl_mmap.c
@@ -0,0 +1,2832 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2002-2013. 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%
+ */
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include "sys.h"
+#include "erl_process.h"
+#include "erl_smp.h"
+#include "atom.h"
+#include "erl_mmap.h"
+#include <stddef.h>
+
+/* #define ERTS_MMAP_OP_RINGBUF_SZ 100 */
+
+#if defined(DEBUG) || 0
+# undef ERTS_MMAP_DEBUG
+# define ERTS_MMAP_DEBUG
+# ifndef ERTS_MMAP_OP_RINGBUF_SZ
+# define ERTS_MMAP_OP_RINGBUF_SZ 100
+# endif
+#endif
+
+#ifndef ERTS_MMAP_OP_RINGBUF_SZ
+# define ERTS_MMAP_OP_RINGBUF_SZ 0
+#endif
+
+/* #define ERTS_MMAP_DEBUG_FILL_AREAS */
+
+#ifdef ERTS_MMAP_DEBUG
+# define ERTS_MMAP_ASSERT ERTS_ASSERT
+#else
+# define ERTS_MMAP_ASSERT(A) ((void) 1)
+#endif
+
+/*
+ * `mmap_state.sa.bot` and `mmap_state.sua.top` are read only after
+ * initialization, but the other pointers are not; i.e., only
+ * ERTS_MMAP_IN_SUPERCARRIER() is allowed without the mutex held.
+ */
+#define ERTS_MMAP_IN_SUPERCARRIER(PTR) \
+ (((UWord) (PTR)) - ((UWord) mmap_state.sa.bot) \
+ < ((UWord) mmap_state.sua.top) - ((UWord) mmap_state.sa.bot))
+#define ERTS_MMAP_IN_SUPERALIGNED_AREA(PTR) \
+ (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mmap_state.mtx)), \
+ (((UWord) (PTR)) - ((UWord) mmap_state.sa.bot) \
+ < ((UWord) mmap_state.sa.top) - ((UWord) mmap_state.sa.bot)))
+#define ERTS_MMAP_IN_SUPERUNALIGNED_AREA(PTR) \
+ (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mmap_state.mtx)), \
+ (((UWord) (PTR)) - ((UWord) mmap_state.sua.bot) \
+ < ((UWord) mmap_state.sua.top) - ((UWord) mmap_state.sua.bot)))
+
+int erts_have_erts_mmap;
+UWord erts_page_inv_mask;
+
+#if defined(DEBUG) || defined(ERTS_MMAP_DEBUG)
+# undef RBT_DEBUG
+# define RBT_DEBUG
+#endif
+#ifdef RBT_DEBUG
+# define RBT_ASSERT ERTS_ASSERT
+# define IF_RBT_DEBUG(C) C
+#else
+# define RBT_ASSERT(x)
+# define IF_RBT_DEBUG(C)
+#endif
+
+typedef struct RBTNode_ RBTNode;
+struct RBTNode_ {
+ UWord parent_and_color; /* color in bit 0 of parent ptr */
+ RBTNode *left;
+ RBTNode *right;
+};
+
+#define RED_FLG (1)
+#define IS_RED(N) ((N) && ((N)->parent_and_color & RED_FLG))
+#define IS_BLACK(N) (!IS_RED(N))
+#define SET_RED(N) ((N)->parent_and_color |= RED_FLG)
+#define SET_BLACK(N) ((N)->parent_and_color &= ~RED_FLG)
+
+static ERTS_INLINE RBTNode* parent(RBTNode* node)
+{
+ return (RBTNode*) (node->parent_and_color & ~RED_FLG);
+}
+
+static ERTS_INLINE void set_parent(RBTNode* node, RBTNode* parent)
+{
+ RBT_ASSERT(!((UWord)parent & RED_FLG));
+ node->parent_and_color = ((UWord)parent) | (node->parent_and_color & RED_FLG);
+}
+
+static ERTS_INLINE UWord parent_and_color(RBTNode* parent, int color)
+{
+ RBT_ASSERT(!((UWord)parent & RED_FLG));
+ RBT_ASSERT(!(color & ~RED_FLG));
+ return ((UWord)parent) | color;
+}
+
+
+enum SortOrder {
+ ADDR_ORDER, /* only address order */
+ SA_SZ_ADDR_ORDER, /* first super-aligned size then address order */
+ SZ_REVERSE_ADDR_ORDER /* first size then reverse address order */
+};
+#ifdef HARD_DEBUG
+static const char* sort_order_names[] = {"Address","SuperAlignedSize-Address","Size-RevAddress"};
+#endif
+
+typedef struct {
+ RBTNode* root;
+ enum SortOrder order;
+}RBTree;
+
+#ifdef HARD_DEBUG
+# define HARD_CHECK_IS_MEMBER(ROOT,NODE) rbt_assert_is_member(ROOT,NODE)
+# define HARD_CHECK_TREE(TREE,SZ) check_tree(TREE, SZ)
+static int rbt_assert_is_member(RBTNode* root, RBTNode* node);
+static RBTNode* check_tree(RBTree* tree, Uint);
+#else
+# define HARD_CHECK_IS_MEMBER(ROOT,NODE)
+# define HARD_CHECK_TREE(TREE,SZ)
+#endif
+
+#if ERTS_MMAP_OP_RINGBUF_SZ
+
+static int mmap_op_ix;
+
+typedef enum {
+ ERTS_OP_TYPE_NONE,
+ ERTS_OP_TYPE_MMAP,
+ ERTS_OP_TYPE_MUNMAP,
+ ERTS_OP_TYPE_MREMAP
+} ErtsMMapOpType;
+
+typedef struct {
+ ErtsMMapOpType type;
+ void *result;
+ UWord in_size;
+ UWord out_size;
+ void *old_ptr;
+ UWord old_size;
+} ErtsMMapOp;
+
+static ErtsMMapOp mmap_ops[ERTS_MMAP_OP_RINGBUF_SZ];
+
+#define ERTS_MMAP_OP_RINGBUF_INIT() \
+ do { \
+ int ix__; \
+ for (ix__ = 0; ix__ < ERTS_MMAP_OP_RINGBUF_SZ; ix__++) {\
+ mmap_ops[ix__].type = ERTS_OP_TYPE_NONE; \
+ mmap_ops[ix__].result = NULL; \
+ mmap_ops[ix__].in_size = 0; \
+ mmap_ops[ix__].out_size = 0; \
+ mmap_ops[ix__].old_ptr = NULL; \
+ mmap_ops[ix__].old_size = 0; \
+ } \
+ mmap_op_ix = ERTS_MMAP_OP_RINGBUF_SZ-1; \
+ } while (0)
+
+#define ERTS_MMAP_OP_START(SZ) \
+ do { \
+ int ix__; \
+ if (++mmap_op_ix >= ERTS_MMAP_OP_RINGBUF_SZ) \
+ mmap_op_ix = 0; \
+ ix__ = mmap_op_ix; \
+ mmap_ops[ix__].type = ERTS_OP_TYPE_MMAP; \
+ mmap_ops[ix__].result = NULL; \
+ mmap_ops[ix__].in_size = (SZ); \
+ mmap_ops[ix__].out_size = 0; \
+ mmap_ops[ix__].old_ptr = NULL; \
+ mmap_ops[ix__].old_size = 0; \
+ } while (0)
+
+#define ERTS_MMAP_OP_END(PTR, SZ) \
+ do { \
+ int ix__ = mmap_op_ix; \
+ mmap_ops[ix__].result = (PTR); \
+ mmap_ops[ix__].out_size = (SZ); \
+ } while (0)
+
+#define ERTS_MMAP_OP_LCK(RES, IN_SZ, OUT_SZ) \
+ do { \
+ erts_smp_mtx_lock(&mmap_state.mtx); \
+ ERTS_MMAP_OP_START((IN_SZ)); \
+ ERTS_MMAP_OP_END((RES), (OUT_SZ)); \
+ erts_smp_mtx_unlock(&mmap_state.mtx); \
+ } while (0)
+
+#define ERTS_MUNMAP_OP(PTR, SZ) \
+ do { \
+ int ix__; \
+ if (++mmap_op_ix >= ERTS_MMAP_OP_RINGBUF_SZ) \
+ mmap_op_ix = 0; \
+ ix__ = mmap_op_ix; \
+ mmap_ops[ix__].type = ERTS_OP_TYPE_MUNMAP; \
+ mmap_ops[ix__].result = NULL; \
+ mmap_ops[ix__].in_size = 0; \
+ mmap_ops[ix__].out_size = 0; \
+ mmap_ops[ix__].old_ptr = (PTR); \
+ mmap_ops[ix__].old_size = (SZ); \
+ } while (0)
+
+#define ERTS_MUNMAP_OP_LCK(PTR, SZ) \
+ do { \
+ erts_smp_mtx_lock(&mmap_state.mtx); \
+ ERTS_MUNMAP_OP((PTR), (SZ)); \
+ erts_smp_mtx_unlock(&mmap_state.mtx); \
+ } while (0)
+
+#define ERTS_MREMAP_OP_START(OLD_PTR, OLD_SZ, IN_SZ) \
+ do { \
+ int ix__; \
+ if (++mmap_op_ix >= ERTS_MMAP_OP_RINGBUF_SZ) \
+ mmap_op_ix = 0; \
+ ix__ = mmap_op_ix; \
+ mmap_ops[ix__].type = ERTS_OP_TYPE_MREMAP; \
+ mmap_ops[ix__].result = NULL; \
+ mmap_ops[ix__].in_size = (IN_SZ); \
+ mmap_ops[ix__].out_size = (OLD_SZ); \
+ mmap_ops[ix__].old_ptr = (OLD_PTR); \
+ mmap_ops[ix__].old_size = (OLD_SZ); \
+ } while (0)
+
+#define ERTS_MREMAP_OP_END(PTR, SZ) \
+ do { \
+ int ix__ = mmap_op_ix; \
+ mmap_ops[ix__].result = (PTR); \
+ mmap_ops[mmap_op_ix].out_size = (SZ); \
+ } while (0)
+
+#define ERTS_MREMAP_OP_LCK(RES, OLD_PTR, OLD_SZ, IN_SZ, OUT_SZ) \
+ do { \
+ erts_smp_mtx_lock(&mmap_state.mtx); \
+ ERTS_MREMAP_OP_START((OLD_PTR), (OLD_SZ), (IN_SZ)); \
+ ERTS_MREMAP_OP_END((RES), (OUT_SZ)); \
+ erts_smp_mtx_unlock(&mmap_state.mtx); \
+ } while (0)
+
+#define ERTS_MMAP_OP_ABORT() \
+ do { \
+ int ix__ = mmap_op_ix; \
+ mmap_ops[ix__].type = ERTS_OP_TYPE_NONE; \
+ mmap_ops[ix__].result = NULL; \
+ mmap_ops[ix__].in_size = 0; \
+ mmap_ops[ix__].out_size = 0; \
+ mmap_ops[ix__].old_ptr = NULL; \
+ mmap_ops[ix__].old_size = 0; \
+ if (--mmap_op_ix < 0) \
+ mmap_op_ix = ERTS_MMAP_OP_RINGBUF_SZ-1; \
+ } while (0)
+
+#else
+
+#define ERTS_MMAP_OP_RINGBUF_INIT()
+#define ERTS_MMAP_OP_START(SZ)
+#define ERTS_MMAP_OP_END(PTR, SZ)
+#define ERTS_MMAP_OP_LCK(RES, IN_SZ, OUT_SZ)
+#define ERTS_MUNMAP_OP(PTR, SZ)
+#define ERTS_MUNMAP_OP_LCK(PTR, SZ)
+#define ERTS_MREMAP_OP_START(OLD_PTR, OLD_SZ, IN_SZ)
+#define ERTS_MREMAP_OP_END(PTR, SZ)
+#define ERTS_MREMAP_OP_LCK(RES, OLD_PTR, OLD_SZ, IN_SZ, OUT_SZ)
+#define ERTS_MMAP_OP_ABORT()
+
+#endif
+
+typedef struct {
+ RBTNode snode; /* node in 'stree' */
+ RBTNode anode; /* node in 'atree' */
+ char* start;
+ char* end;
+}ErtsFreeSegDesc;
+
+typedef struct {
+ RBTree stree; /* size ordered tree */
+ RBTree atree; /* address ordered tree */
+ Uint nseg;
+}ErtsFreeSegMap;
+
+static struct {
+ int (*reserve_physical)(char *, UWord);
+ void (*unreserve_physical)(char *, UWord);
+ int supercarrier;
+ int no_os_mmap;
+ /*
+ * Super unaligend area is located above super aligned
+ * area. That is, `sa.bot` is beginning of the super
+ * carrier, `sua.top` is the end of the super carrier,
+ * and sa.top and sua.bot moves towards eachother.
+ */
+ struct {
+ char *top;
+ char *bot;
+ ErtsFreeSegMap map;
+ } sua;
+ struct {
+ char *top;
+ char *bot;
+ ErtsFreeSegMap map;
+ } sa;
+#if HAVE_MMAP && (!defined(MAP_ANON) && !defined(MAP_ANONYMOUS))
+ int mmap_fd;
+#endif
+ erts_smp_mtx_t mtx;
+ struct {
+ char *free_list;
+ char *unused_start;
+ char *unused_end;
+ char *new_area_hint;
+ Uint reserved;
+ } desc;
+ struct {
+ UWord free_seg_descs;
+ struct {
+ UWord curr;
+ UWord max;
+ } free_segs;
+ } no;
+ struct {
+ struct {
+ UWord total;
+ struct {
+ UWord total;
+ UWord sa;
+ UWord sua;
+ } used;
+ } supercarrier;
+ struct {
+ UWord used;
+ } os;
+ } size;
+} mmap_state;
+
+#define ERTS_MMAP_SIZE_SC_SA_INC(SZ) \
+ do { \
+ mmap_state.size.supercarrier.used.total += (SZ); \
+ mmap_state.size.supercarrier.used.sa += (SZ); \
+ ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total \
+ <= mmap_state.size.supercarrier.total); \
+ ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sa \
+ <= mmap_state.size.supercarrier.used.total); \
+ } while (0)
+#define ERTS_MMAP_SIZE_SC_SA_DEC(SZ) \
+ do { \
+ ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total >= (SZ)); \
+ mmap_state.size.supercarrier.used.total -= (SZ); \
+ ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sa >= (SZ)); \
+ mmap_state.size.supercarrier.used.sa -= (SZ); \
+ } while (0)
+#define ERTS_MMAP_SIZE_SC_SUA_INC(SZ) \
+ do { \
+ mmap_state.size.supercarrier.used.total += (SZ); \
+ mmap_state.size.supercarrier.used.sua += (SZ); \
+ ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total \
+ <= mmap_state.size.supercarrier.total); \
+ ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sua \
+ <= mmap_state.size.supercarrier.used.total); \
+ } while (0)
+#define ERTS_MMAP_SIZE_SC_SUA_DEC(SZ) \
+ do { \
+ ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total >= (SZ)); \
+ mmap_state.size.supercarrier.used.total -= (SZ); \
+ ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sua >= (SZ)); \
+ mmap_state.size.supercarrier.used.sua -= (SZ); \
+ } while (0)
+#define ERTS_MMAP_SIZE_OS_INC(SZ) \
+ do { \
+ ERTS_MMAP_ASSERT(mmap_state.size.os.used + (SZ) >= (SZ)); \
+ mmap_state.size.os.used += (SZ); \
+ } while (0)
+#define ERTS_MMAP_SIZE_OS_DEC(SZ) \
+ do { \
+ ERTS_MMAP_ASSERT(mmap_state.size.os.used >= (SZ)); \
+ mmap_state.size.os.used -= (SZ); \
+ } while (0)
+
+
+static void
+add_free_desc_area(char *start, char *end)
+{
+ ERTS_MMAP_ASSERT(end == (void *) 0 || end > start);
+ if (sizeof(ErtsFreeSegDesc) <= ((UWord) end) - ((UWord) start)) {
+ UWord no;
+ ErtsFreeSegDesc *prev_desc, *desc;
+ char *desc_end;
+
+ no = 1;
+ prev_desc = (ErtsFreeSegDesc *) start;
+ prev_desc->start = mmap_state.desc.free_list;
+ desc = (ErtsFreeSegDesc *) (start + sizeof(ErtsFreeSegDesc));
+ desc_end = start + 2*sizeof(ErtsFreeSegDesc);
+
+ while (desc_end <= end) {
+ desc->start = (char *) prev_desc;
+ prev_desc = desc;
+ desc = (ErtsFreeSegDesc *) desc_end;
+ desc_end += sizeof(ErtsFreeSegDesc);
+ no++;
+ }
+ mmap_state.desc.free_list = (char *) prev_desc;
+ mmap_state.no.free_seg_descs += no;
+ }
+}
+
+static ErtsFreeSegDesc *
+add_unused_free_desc_area(void)
+{
+ char *ptr;
+ if (!mmap_state.desc.unused_start)
+ return NULL;
+
+ ERTS_MMAP_ASSERT(mmap_state.desc.unused_end);
+ ERTS_MMAP_ASSERT(ERTS_PAGEALIGNED_SIZE
+ <= mmap_state.desc.unused_end - mmap_state.desc.unused_start);
+
+ ptr = mmap_state.desc.unused_start + ERTS_PAGEALIGNED_SIZE;
+ add_free_desc_area(mmap_state.desc.unused_start, ptr);
+
+ if ((mmap_state.desc.unused_end - ptr) >= ERTS_PAGEALIGNED_SIZE)
+ mmap_state.desc.unused_start = ptr;
+ else
+ mmap_state.desc.unused_end = mmap_state.desc.unused_start = NULL;
+
+ ERTS_MMAP_ASSERT(mmap_state.desc.free_list);
+ return (ErtsFreeSegDesc *) mmap_state.desc.free_list;
+}
+
+static ERTS_INLINE ErtsFreeSegDesc *
+alloc_desc(void)
+{
+ ErtsFreeSegDesc *res;
+ res = (ErtsFreeSegDesc *) mmap_state.desc.free_list;
+ if (!res) {
+ res = add_unused_free_desc_area();
+ if (!res)
+ return NULL;
+ }
+ mmap_state.desc.free_list = res->start;
+ ASSERT(mmap_state.no.free_segs.curr < mmap_state.no.free_seg_descs);
+ mmap_state.no.free_segs.curr++;
+ if (mmap_state.no.free_segs.max < mmap_state.no.free_segs.curr)
+ mmap_state.no.free_segs.max = mmap_state.no.free_segs.curr;
+ return res;
+}
+
+static ERTS_INLINE void
+free_desc(ErtsFreeSegDesc *desc)
+{
+ desc->start = mmap_state.desc.free_list;
+ mmap_state.desc.free_list = (char *) desc;
+ ERTS_MMAP_ASSERT(mmap_state.no.free_segs.curr > 0);
+ mmap_state.no.free_segs.curr--;
+}
+
+static ERTS_INLINE ErtsFreeSegDesc* anode_to_desc(RBTNode* anode)
+{
+ return (ErtsFreeSegDesc*) ((char*)anode - offsetof(ErtsFreeSegDesc, anode));
+}
+
+static ERTS_INLINE ErtsFreeSegDesc* snode_to_desc(RBTNode* snode)
+{
+ return (ErtsFreeSegDesc*) ((char*)snode - offsetof(ErtsFreeSegDesc, snode));
+}
+
+static ERTS_INLINE ErtsFreeSegDesc* node_to_desc(enum SortOrder order, RBTNode* node)
+{
+ return order==ADDR_ORDER ? anode_to_desc(node) : snode_to_desc(node);
+}
+
+static ERTS_INLINE SWord usable_size(enum SortOrder order,
+ ErtsFreeSegDesc* desc)
+{
+ return ((order == SA_SZ_ADDR_ORDER) ?
+ ERTS_SUPERALIGNED_FLOOR(desc->end) - ERTS_SUPERALIGNED_CEILING(desc->start)
+ : desc->end - desc->start);
+}
+
+#ifdef HARD_DEBUG
+static ERTS_INLINE SWord cmp_nodes(enum SortOrder order,
+ RBTNode* lhs, RBTNode* rhs)
+{
+ ErtsFreeSegDesc* ldesc = node_to_desc(order, lhs);
+ ErtsFreeSegDesc* rdesc = node_to_desc(order, rhs);
+ RBT_ASSERT(lhs != rhs);
+ if (order != ADDR_ORDER) {
+ SWord diff = usable_size(order, ldesc) - usable_size(order, rdesc);
+ if (diff) return diff;
+ }
+ if (order != SZ_REVERSE_ADDR_ORDER) {
+ return (char*)ldesc->start - (char*)rdesc->start;
+ }
+ else {
+ return (char*)rdesc->start - (char*)ldesc->start;
+ }
+}
+#endif /* HARD_DEBUG */
+
+static ERTS_INLINE SWord cmp_with_node(enum SortOrder order,
+ SWord sz, char* addr, RBTNode* rhs)
+{
+ ErtsFreeSegDesc* rdesc;
+ if (order != ADDR_ORDER) {
+ SWord diff;
+ rdesc = snode_to_desc(rhs);
+ diff = sz - usable_size(order, rdesc);
+ if (diff) return diff;
+ }
+ else
+ rdesc = anode_to_desc(rhs);
+
+ if (order != SZ_REVERSE_ADDR_ORDER)
+ return addr - (char*)rdesc->start;
+ else
+ return (char*)rdesc->start - addr;
+}
+
+
+static ERTS_INLINE void
+left_rotate(RBTNode **root, RBTNode *x)
+{
+ RBTNode *y = x->right;
+ x->right = y->left;
+ if (y->left)
+ set_parent(y->left, x);
+ set_parent(y, parent(x));
+ if (!parent(y)) {
+ RBT_ASSERT(*root == x);
+ *root = y;
+ }
+ else if (x == parent(x)->left)
+ parent(x)->left = y;
+ else {
+ RBT_ASSERT(x == parent(x)->right);
+ parent(x)->right = y;
+ }
+ y->left = x;
+ set_parent(x, y);
+}
+
+static ERTS_INLINE void
+right_rotate(RBTNode **root, RBTNode *x)
+{
+ RBTNode *y = x->left;
+ x->left = y->right;
+ if (y->right)
+ set_parent(y->right, x);
+ set_parent(y, parent(x));
+ if (!parent(y)) {
+ RBT_ASSERT(*root == x);
+ *root = y;
+ }
+ else if (x == parent(x)->right)
+ parent(x)->right = y;
+ else {
+ RBT_ASSERT(x == parent(x)->left);
+ parent(x)->left = y;
+ }
+ y->right = x;
+ set_parent(x, y);
+}
+
+/*
+ * Replace node x with node y
+ * NOTE: segment descriptor of y is not changed
+ */
+static ERTS_INLINE void
+replace(RBTNode **root, RBTNode *x, RBTNode *y)
+{
+
+ if (!parent(x)) {
+ RBT_ASSERT(*root == x);
+ *root = y;
+ }
+ else if (x == parent(x)->left)
+ parent(x)->left = y;
+ else {
+ RBT_ASSERT(x == parent(x)->right);
+ parent(x)->right = y;
+ }
+ if (x->left) {
+ RBT_ASSERT(parent(x->left) == x);
+ set_parent(x->left, y);
+ }
+ if (x->right) {
+ RBT_ASSERT(parent(x->right) == x);
+ set_parent(x->right, y);
+ }
+
+ y->parent_and_color = x->parent_and_color;
+ y->right = x->right;
+ y->left = x->left;
+}
+
+static void
+tree_insert_fixup(RBTNode** root, RBTNode *node)
+{
+ RBTNode *x = node, *y, *papa_x, *granpa_x;
+
+ /*
+ * Rearrange the tree so that it satisfies the Red-Black Tree properties
+ */
+
+ papa_x = parent(x);
+ RBT_ASSERT(x != *root && IS_RED(papa_x));
+ do {
+
+ /*
+ * x and its parent are both red. Move the red pair up the tree
+ * until we get to the root or until we can separate them.
+ */
+
+ granpa_x = parent(papa_x);
+ RBT_ASSERT(IS_RED(x));
+ RBT_ASSERT(IS_BLACK(granpa_x));
+ RBT_ASSERT(granpa_x);
+
+ if (papa_x == granpa_x->left) {
+ y = granpa_x->right;
+ if (IS_RED(y)) {
+ SET_BLACK(y);
+ SET_BLACK(papa_x);
+ SET_RED(granpa_x);
+ x = granpa_x;
+ }
+ else {
+
+ if (x == papa_x->right) {
+ left_rotate(root, papa_x);
+ papa_x = x;
+ x = papa_x->left;
+ }
+
+ RBT_ASSERT(x == granpa_x->left->left);
+ RBT_ASSERT(IS_RED(x));
+ RBT_ASSERT(IS_RED(papa_x));
+ RBT_ASSERT(IS_BLACK(granpa_x));
+ RBT_ASSERT(IS_BLACK(y));
+
+ SET_BLACK(papa_x);
+ SET_RED(granpa_x);
+ right_rotate(root, granpa_x);
+
+ RBT_ASSERT(x == parent(x)->left);
+ RBT_ASSERT(IS_RED(x));
+ RBT_ASSERT(IS_RED(parent(x)->right));
+ RBT_ASSERT(IS_BLACK(parent(x)));
+ break;
+ }
+ }
+ else {
+ RBT_ASSERT(papa_x == granpa_x->right);
+ y = granpa_x->left;
+ if (IS_RED(y)) {
+ SET_BLACK(y);
+ SET_BLACK(papa_x);
+ SET_RED(granpa_x);
+ x = granpa_x;
+ }
+ else {
+
+ if (x == papa_x->left) {
+ right_rotate(root, papa_x);
+ papa_x = x;
+ x = papa_x->right;
+ }
+
+ RBT_ASSERT(x == granpa_x->right->right);
+ RBT_ASSERT(IS_RED(x));
+ RBT_ASSERT(IS_RED(papa_x));
+ RBT_ASSERT(IS_BLACK(granpa_x));
+ RBT_ASSERT(IS_BLACK(y));
+
+ SET_BLACK(papa_x);
+ SET_RED(granpa_x);
+ left_rotate(root, granpa_x);
+
+ RBT_ASSERT(x == parent(x)->right);
+ RBT_ASSERT(IS_RED(x));
+ RBT_ASSERT(IS_RED(parent(x)->left));
+ RBT_ASSERT(IS_BLACK(parent(x)));
+ break;
+ }
+ }
+ } while (x != *root && (papa_x=parent(x), IS_RED(papa_x)));
+
+ SET_BLACK(*root);
+}
+
+static void
+rbt_delete(RBTree* tree, RBTNode* del)
+{
+ Uint spliced_is_black;
+ RBTNode *x, *y, *z = del, *papa_y;
+ RBTNode null_x; /* null_x is used to get the fixup started when we
+ splice out a node without children. */
+
+ HARD_CHECK_IS_MEMBER(tree->root, del);
+ HARD_CHECK_TREE(tree, 0);
+
+ null_x.parent_and_color = parent_and_color(NULL, !RED_FLG);
+
+ /* Remove node from tree... */
+
+ /* Find node to splice out */
+ if (!z->left || !z->right)
+ y = z;
+ else
+ /* Set y to z:s successor */
+ for(y = z->right; y->left; y = y->left);
+ /* splice out y */
+ x = y->left ? y->left : y->right;
+ spliced_is_black = IS_BLACK(y);
+ papa_y = parent(y);
+ if (x) {
+ set_parent(x, papa_y);
+ }
+ else if (spliced_is_black) {
+ x = &null_x;
+ x->right = x->left = NULL;
+ x->parent_and_color = parent_and_color(papa_y, !RED_FLG);
+ y->left = x;
+ }
+
+ if (!papa_y) {
+ RBT_ASSERT(tree->root == y);
+ tree->root = x;
+ }
+ else {
+ if (y == papa_y->left) {
+ papa_y->left = x;
+ }
+ else {
+ RBT_ASSERT(y == papa_y->right);
+ papa_y->right = x;
+ }
+ }
+ if (y != z) {
+ /* We spliced out the successor of z; replace z by the successor */
+ RBT_ASSERT(z != &null_x);
+ replace(&tree->root, z, y);
+ }
+
+ if (spliced_is_black) {
+ RBTNode* papa_x;
+ /* We removed a black node which makes the resulting tree
+ violate the Red-Black Tree properties. Fixup tree... */
+
+ papa_x = parent(x);
+ while (IS_BLACK(x) && papa_x) {
+
+ /*
+ * x has an "extra black" which we move up the tree
+ * until we reach the root or until we can get rid of it.
+ *
+ * y is the sibbling of x
+ */
+
+ if (x == papa_x->left) {
+ y = papa_x->right;
+ RBT_ASSERT(y);
+ if (IS_RED(y)) {
+ RBT_ASSERT(y->right);
+ RBT_ASSERT(y->left);
+ SET_BLACK(y);
+ RBT_ASSERT(IS_BLACK(papa_x));
+ SET_RED(papa_x);
+ left_rotate(&tree->root, papa_x);
+ RBT_ASSERT(papa_x == parent(x));
+ y = papa_x->right;
+ }
+ RBT_ASSERT(y);
+ RBT_ASSERT(IS_BLACK(y));
+ if (IS_BLACK(y->left) && IS_BLACK(y->right)) {
+ SET_RED(y);
+ }
+ else {
+ if (IS_BLACK(y->right)) {
+ SET_BLACK(y->left);
+ SET_RED(y);
+ right_rotate(&tree->root, y);
+ RBT_ASSERT(papa_x == parent(x));
+ y = papa_x->right;
+ }
+ RBT_ASSERT(y);
+ if (IS_RED(papa_x)) {
+
+ SET_BLACK(papa_x);
+ SET_RED(y);
+ }
+ RBT_ASSERT(y->right);
+ SET_BLACK(y->right);
+ left_rotate(&tree->root, papa_x);
+ x = tree->root;
+ break;
+ }
+ }
+ else {
+ RBT_ASSERT(x == papa_x->right);
+ y = papa_x->left;
+ RBT_ASSERT(y);
+ if (IS_RED(y)) {
+ RBT_ASSERT(y->right);
+ RBT_ASSERT(y->left);
+ SET_BLACK(y);
+ RBT_ASSERT(IS_BLACK(papa_x));
+ SET_RED(papa_x);
+ right_rotate(&tree->root, papa_x);
+ RBT_ASSERT(papa_x == parent(x));
+ y = papa_x->left;
+ }
+ RBT_ASSERT(y);
+ RBT_ASSERT(IS_BLACK(y));
+ if (IS_BLACK(y->right) && IS_BLACK(y->left)) {
+ SET_RED(y);
+ }
+ else {
+ if (IS_BLACK(y->left)) {
+ SET_BLACK(y->right);
+ SET_RED(y);
+ left_rotate(&tree->root, y);
+ RBT_ASSERT(papa_x == parent(x));
+ y = papa_x->left;
+ }
+ RBT_ASSERT(y);
+ if (IS_RED(papa_x)) {
+ SET_BLACK(papa_x);
+ SET_RED(y);
+ }
+ RBT_ASSERT(y->left);
+ SET_BLACK(y->left);
+ right_rotate(&tree->root, papa_x);
+ x = tree->root;
+ break;
+ }
+ }
+ x = papa_x;
+ papa_x = parent(x);
+ }
+ SET_BLACK(x);
+
+ papa_x = parent(&null_x);
+ if (papa_x) {
+ if (papa_x->left == &null_x)
+ papa_x->left = NULL;
+ else {
+ RBT_ASSERT(papa_x->right == &null_x);
+ papa_x->right = NULL;
+ }
+ RBT_ASSERT(!null_x.left);
+ RBT_ASSERT(!null_x.right);
+ }
+ else if (tree->root == &null_x) {
+ tree->root = NULL;
+ RBT_ASSERT(!null_x.left);
+ RBT_ASSERT(!null_x.right);
+ }
+ }
+ HARD_CHECK_TREE(tree, 0);
+}
+
+
+static void
+rbt_insert(RBTree* tree, RBTNode* node)
+{
+#ifdef RBT_DEBUG
+ ErtsFreeSegDesc *dbg_under=NULL, *dbg_over=NULL;
+#endif
+ ErtsFreeSegDesc* desc = node_to_desc(tree->order, node);
+ char* seg_addr = desc->start;
+ SWord seg_sz = desc->end - desc->start;
+
+ HARD_CHECK_TREE(tree, 0);
+
+ node->left = NULL;
+ node->right = NULL;
+
+ if (!tree->root) {
+ node->parent_and_color = parent_and_color(NULL, !RED_FLG);
+ tree->root = node;
+ }
+ else {
+ RBTNode *x = tree->root;
+ while (1) {
+ SWord diff = cmp_with_node(tree->order, seg_sz, seg_addr, x);
+ if (diff < 0) {
+ IF_RBT_DEBUG(dbg_over = node_to_desc(tree->order, x));
+ if (!x->left) {
+ node->parent_and_color = parent_and_color(x, RED_FLG);
+ x->left = node;
+ break;
+ }
+ x = x->left;
+ }
+ else {
+ RBT_ASSERT(diff > 0);
+ IF_RBT_DEBUG(dbg_under = node_to_desc(tree->order, x));
+ if (!x->right) {
+ node->parent_and_color = parent_and_color(x, RED_FLG);
+ x->right = node;
+ break;
+ }
+ x = x->right;
+ }
+ }
+
+ RBT_ASSERT(parent(node));
+#ifdef RBT_DEBUG
+ if (tree->order == ADDR_ORDER) {
+ RBT_ASSERT(!dbg_under || dbg_under->end < desc->start);
+ RBT_ASSERT(!dbg_over || dbg_over->start > desc->end);
+ }
+#endif
+ RBT_ASSERT(IS_RED(node));
+ if (IS_RED(parent(node)))
+ tree_insert_fixup(&tree->root, node);
+ }
+ HARD_CHECK_TREE(tree, 0);
+}
+
+/*
+ * Traverse tree in (reverse) sorting order
+ */
+static void
+rbt_foreach_node(RBTree* tree,
+ void (*fn)(RBTNode*,void*),
+ void* arg, int reverse)
+{
+#ifdef HARD_DEBUG
+ Sint blacks = -1;
+ Sint curr_blacks = 1;
+ Uint depth = 1;
+ Uint max_depth = 0;
+ Uint node_cnt = 0;
+#endif
+ enum { RECURSE_LEFT, DO_NODE, RECURSE_RIGHT, RETURN_TO_PARENT }state;
+ RBTNode *x = tree->root;
+
+ RBT_ASSERT(!x || !parent(x));
+
+ state = reverse ? RECURSE_RIGHT : RECURSE_LEFT;
+ while (x) {
+ switch (state) {
+ case RECURSE_LEFT:
+ if (x->left) {
+ RBT_ASSERT(parent(x->left) == x);
+ #ifdef HARD_DEBUG
+ ++depth;
+ if (IS_BLACK(x->left))
+ curr_blacks++;
+ #endif
+ x = x->left;
+ state = reverse ? RECURSE_RIGHT : RECURSE_LEFT;
+ }
+ else {
+ #ifdef HARD_DEBUG
+ if (blacks < 0)
+ blacks = curr_blacks;
+ RBT_ASSERT(blacks == curr_blacks);
+ #endif
+ state = reverse ? RETURN_TO_PARENT : DO_NODE;
+ }
+ break;
+
+ case DO_NODE:
+ #ifdef HARD_DEBUG
+ ++node_cnt;
+ if (depth > max_depth)
+ max_depth = depth;
+ #endif
+ (*fn) (x, arg); /* Do it! */
+ state = reverse ? RECURSE_LEFT : RECURSE_RIGHT;
+ break;
+
+ case RECURSE_RIGHT:
+ if (x->right) {
+ RBT_ASSERT(parent(x->right) == x);
+ #ifdef HARD_DEBUG
+ ++depth;
+ if (IS_BLACK(x->right))
+ curr_blacks++;
+ #endif
+ x = x->right;
+ state = reverse ? RECURSE_RIGHT : RECURSE_LEFT;
+ }
+ else {
+ #ifdef HARD_DEBUG
+ if (blacks < 0)
+ blacks = curr_blacks;
+ RBT_ASSERT(blacks == curr_blacks);
+ #endif
+ state = reverse ? DO_NODE : RETURN_TO_PARENT;
+ }
+ break;
+
+ case RETURN_TO_PARENT:
+ #ifdef HARD_DEBUG
+ if (IS_BLACK(x))
+ curr_blacks--;
+ --depth;
+ #endif
+ if (parent(x)) {
+ if (x == parent(x)->left) {
+ state = reverse ? RETURN_TO_PARENT : DO_NODE;
+ }
+ else {
+ RBT_ASSERT(x == parent(x)->right);
+ state = reverse ? DO_NODE : RETURN_TO_PARENT;
+ }
+ }
+ x = parent(x);
+ break;
+ }
+ }
+#ifdef HARD_DEBUG
+ RBT_ASSERT(depth == 0 || (!tree->root && depth==1));
+ RBT_ASSERT(curr_blacks == 0);
+ RBT_ASSERT((1 << (max_depth/2)) <= node_cnt);
+#endif
+}
+
+#if defined(RBT_DEBUG) || defined(HARD_DEBUG_MSEG)
+static RBTNode* rbt_prev_node(RBTNode* node)
+{
+ RBTNode* x;
+ if (node->left) {
+ for (x=node->left; x->right; x=x->right)
+ ;
+ return x;
+ }
+ for (x=node; parent(x); x=parent(x)) {
+ if (parent(x)->right == x)
+ return parent(x);
+ }
+ return NULL;
+}
+static RBTNode* rbt_next_node(RBTNode* node)
+{
+ RBTNode* x;
+ if (node->right) {
+ for (x=node->right; x->left; x=x->left)
+ ;
+ return x;
+ }
+ for (x=node; parent(x); x=parent(x)) {
+ if (parent(x)->left == x)
+ return parent(x);
+ }
+ return NULL;
+}
+#endif /* RBT_DEBUG || HARD_DEBUG_MSEG */
+
+
+/* The API to keep track of a bunch of separated (free) segments
+ (non-overlapping and non-adjacent).
+ */
+static void init_free_seg_map(ErtsFreeSegMap*, enum SortOrder);
+static void adjacent_free_seg(ErtsFreeSegMap*, char* start, char* end,
+ ErtsFreeSegDesc** under, ErtsFreeSegDesc** over);
+static void insert_free_seg(ErtsFreeSegMap*, ErtsFreeSegDesc*, char* start, char* end);
+static void resize_free_seg(ErtsFreeSegMap*, ErtsFreeSegDesc*, char* start, char* end);
+static void delete_free_seg(ErtsFreeSegMap*, ErtsFreeSegDesc*);
+static ErtsFreeSegDesc* lookup_free_seg(ErtsFreeSegMap*, SWord sz);
+
+
+static void init_free_seg_map(ErtsFreeSegMap* map, enum SortOrder order)
+{
+ map->atree.root = NULL;
+ map->atree.order = ADDR_ORDER;
+ map->stree.root = NULL;
+ map->stree.order = order;
+ map->nseg = 0;
+}
+
+/* Lookup directly adjacent free segments to the given area [start->end].
+ * The given area must not contain any free segments.
+ */
+static void adjacent_free_seg(ErtsFreeSegMap* map, char* start, char* end,
+ ErtsFreeSegDesc** under, ErtsFreeSegDesc** over)
+{
+ RBTNode* x = map->atree.root;
+
+ *under = NULL;
+ *over = NULL;
+ while (x) {
+ if (start < anode_to_desc(x)->start) {
+ RBT_ASSERT(end <= anode_to_desc(x)->start);
+ if (end == anode_to_desc(x)->start) {
+ RBT_ASSERT(!*over);
+ *over = anode_to_desc(x);
+ }
+ x = x->left;
+ }
+ else {
+ RBT_ASSERT(start >= anode_to_desc(x)->end);
+ if (start == anode_to_desc(x)->end) {
+ RBT_ASSERT(!*under);
+ *under = anode_to_desc(x);
+ }
+ x = x->right;
+ }
+ }
+}
+
+/* Initialize 'desc' and insert as new free segment [start->end].
+ * The new segment must not contain or be adjacent to any free segment in 'map'.
+ */
+static void insert_free_seg(ErtsFreeSegMap* map, ErtsFreeSegDesc* desc,
+ char* start, char* end)
+{
+ desc->start = start;
+ desc->end = end;
+ rbt_insert(&map->atree, &desc->anode);
+ rbt_insert(&map->stree, &desc->snode);
+ map->nseg++;
+}
+
+/* Resize existing free segment 'desc' to [start->end].
+ * The new segment location must overlap the old location and
+ * it must not contain or be adjacent to any other free segment in 'map'.
+ */
+static void resize_free_seg(ErtsFreeSegMap* map, ErtsFreeSegDesc* desc,
+ char* start, char* end)
+{
+#ifdef RBT_DEBUG
+ RBTNode* prev = rbt_prev_node(&desc->anode);
+ RBTNode* next = rbt_next_node(&desc->anode);
+ RBT_ASSERT(!prev || anode_to_desc(prev)->end < start);
+ RBT_ASSERT(!next || anode_to_desc(next)->start > end);
+#endif
+ rbt_delete(&map->stree, &desc->snode);
+ desc->start = start;
+ desc->end = end;
+ rbt_insert(&map->stree, &desc->snode);
+}
+
+/* Delete existing free segment 'desc' from 'map'.
+ */
+static void delete_free_seg(ErtsFreeSegMap* map, ErtsFreeSegDesc* desc)
+{
+ rbt_delete(&map->atree, &desc->anode);
+ rbt_delete(&map->stree, &desc->snode);
+ map->nseg--;
+}
+
+/* Lookup a free segment in 'map' with a size of at least 'need_sz' usable bytes.
+ */
+static ErtsFreeSegDesc* lookup_free_seg(ErtsFreeSegMap* map, SWord need_sz)
+{
+ RBTNode* x = map->stree.root;
+ ErtsFreeSegDesc* best_desc = NULL;
+ const enum SortOrder order = map->stree.order;
+
+ while (x) {
+ ErtsFreeSegDesc* desc = snode_to_desc(x);
+ SWord seg_sz = usable_size(order, desc);
+
+ if (seg_sz < need_sz) {
+ x = x->right;
+ }
+ else {
+ best_desc = desc;
+ x = x->left;
+ }
+ }
+ return best_desc;
+}
+
+struct build_arg_t
+{
+ Process* p;
+ Eterm* hp;
+ Eterm acc;
+};
+
+static void build_free_seg_tuple(RBTNode* node, void* arg)
+{
+ struct build_arg_t* a = (struct build_arg_t*)arg;
+ ErtsFreeSegDesc* desc = anode_to_desc(node);
+ Eterm start= erts_bld_uword(&a->hp, NULL, (UWord)desc->start);
+ Eterm end = erts_bld_uword(&a->hp, NULL, (UWord)desc->end);
+ Eterm tpl = TUPLE2(a->hp, start, end);
+
+ a->hp += 3;
+ a->acc = CONS(a->hp, tpl, a->acc);
+ a->hp += 2;
+}
+
+static
+Eterm build_free_seg_list(Process* p, ErtsFreeSegMap* map)
+{
+ struct build_arg_t barg;
+ Eterm* hp_end;
+ const Uint may_need = map->nseg * (2 + 3 + 2*2); /* cons + tuple + bigs */
+
+ barg.p = p;
+ barg.hp = HAlloc(p, may_need);
+ hp_end = barg.hp + may_need;
+ barg.acc = NIL;
+ rbt_foreach_node(&map->atree, build_free_seg_tuple, &barg, 1);
+
+ RBT_ASSERT(barg.hp <= hp_end);
+ HRelease(p, hp_end, barg.hp);
+ return barg.acc;
+}
+
+#if ERTS_HAVE_OS_MMAP
+/* Implementation of os_mmap()/os_munmap()/os_mremap()... */
+
+#if HAVE_MMAP
+# define ERTS_MMAP_PROT (PROT_READ|PROT_WRITE)
+# if defined(MAP_ANONYMOUS)
+# define ERTS_MMAP_FLAGS (MAP_ANON|MAP_PRIVATE)
+# define ERTS_MMAP_FD (-1)
+# elif defined(MAP_ANON)
+# define ERTS_MMAP_FLAGS (MAP_ANON|MAP_PRIVATE)
+# define ERTS_MMAP_FD (-1)
+# else
+# define ERTS_MMAP_FLAGS (MAP_PRIVATE)
+# define ERTS_MMAP_FD mmap_state.mmap_fd
+# endif
+#endif
+
+static ERTS_INLINE void *
+os_mmap(void *hint_ptr, UWord size, int try_superalign)
+{
+#if HAVE_MMAP
+ void *res;
+#ifdef MAP_ALIGN
+ if (try_superalign)
+ res = mmap((void *) ERTS_SUPERALIGNED_SIZE, size, ERTS_MMAP_PROT,
+ ERTS_MMAP_FLAGS|MAP_ALIGN, ERTS_MMAP_FD, 0);
+ else
+#endif
+ res = mmap((void *) hint_ptr, size, ERTS_MMAP_PROT,
+ ERTS_MMAP_FLAGS, ERTS_MMAP_FD, 0);
+ if (res == MAP_FAILED)
+ return NULL;
+ return res;
+#elif HAVE_VIRTUALALLOC
+ return (void *) VirtualAlloc(NULL, (SIZE_T) size,
+ MEM_COMMIT|MEM_RESERVE, PAGE_READWRITE);
+#else
+# error "missing mmap() or similar"
+#endif
+}
+
+static ERTS_INLINE void
+os_munmap(void *ptr, UWord size)
+{
+#if HAVE_MMAP
+#ifdef ERTS_MMAP_DEBUG
+ int res =
+#endif
+ munmap(ptr, size);
+ ERTS_MMAP_ASSERT(res == 0);
+#elif HAVE_VIRTUALALLOC
+#ifdef DEBUG
+ BOOL res =
+#endif
+ VirtualFree((LPVOID) ptr, (SIZE_T) 0, MEM_RELEASE);
+ ERTS_MMAP_ASSERT(res != 0);
+#else
+# error "missing munmap() or similar"
+#endif
+}
+
+#ifdef ERTS_HAVE_OS_MREMAP
+# if HAVE_MREMAP
+# if defined(__NetBSD__)
+# define ERTS_MREMAP_FLAGS (0)
+# else
+# define ERTS_MREMAP_FLAGS (MREMAP_MAYMOVE)
+# endif
+# endif
+static ERTS_INLINE void *
+os_mremap(void *ptr, UWord old_size, UWord new_size, int try_superalign)
+{
+ void *new_seg;
+#if HAVE_MREMAP
+ new_seg = mremap(ptr, (size_t) old_size,
+# if defined(__NetBSD__)
+ NULL,
+# endif
+ (size_t) new_size, ERTS_MREMAP_FLAGS);
+ if (new_seg == (void *) MAP_FAILED)
+ return NULL;
+ return new_seg;
+#else
+# error "missing mremap() or similar"
+#endif
+}
+#endif
+
+#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
+#if HAVE_MMAP
+
+#define ERTS_MMAP_RESERVE_PROT (ERTS_MMAP_PROT)
+#define ERTS_MMAP_RESERVE_FLAGS (ERTS_MMAP_FLAGS|MAP_FIXED)
+#define ERTS_MMAP_UNRESERVE_PROT (PROT_NONE)
+#define ERTS_MMAP_UNRESERVE_FLAGS (ERTS_MMAP_FLAGS|MAP_NORESERVE|MAP_FIXED)
+#define ERTS_MMAP_VIRTUAL_PROT (PROT_NONE)
+#define ERTS_MMAP_VIRTUAL_FLAGS (ERTS_MMAP_FLAGS|MAP_NORESERVE)
+
+static int
+os_reserve_physical(char *ptr, UWord size)
+{
+ void *res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_RESERVE_PROT,
+ ERTS_MMAP_RESERVE_FLAGS, ERTS_MMAP_FD, 0);
+ if (res == (void *) MAP_FAILED)
+ return 0;
+ return 1;
+}
+
+static void
+os_unreserve_physical(char *ptr, UWord size)
+{
+ void *res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_UNRESERVE_PROT,
+ ERTS_MMAP_UNRESERVE_FLAGS, ERTS_MMAP_FD, 0);
+ if (res == (void *) MAP_FAILED)
+ erl_exit(ERTS_ABORT_EXIT, "Failed to unreserve memory");
+}
+
+static void *
+os_mmap_virtual(char *ptr, UWord size)
+{
+ void *res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_VIRTUAL_PROT,
+ ERTS_MMAP_VIRTUAL_FLAGS, ERTS_MMAP_FD, 0);
+ if (res == (void *) MAP_FAILED)
+ return NULL;
+ return res;
+}
+
+#else
+#error "Missing reserve/unreserve physical memory implementation"
+#endif
+#endif /* ERTS_HAVE_OS_RESERVE_PHYSICAL_MEMORY */
+
+#endif /* ERTS_HAVE_OS_MMAP */
+
+static int reserve_noop(char *ptr, UWord size)
+{
+#ifdef ERTS_MMAP_DEBUG_FILL_AREAS
+ Uint32 *uip, *end = (Uint32 *) (ptr + size);
+
+ for (uip = (Uint32 *) ptr; uip < end; uip++)
+ ERTS_MMAP_ASSERT(*uip == (Uint32) 0xdeadbeef);
+ for (uip = (Uint32 *) ptr; uip < end; uip++)
+ *uip = (Uint32) 0xfeedfeed;
+#endif
+ return 1;
+}
+
+static void unreserve_noop(char *ptr, UWord size)
+{
+#ifdef ERTS_MMAP_DEBUG_FILL_AREAS
+ Uint32 *uip, *end = (Uint32 *) (ptr + size);
+
+ for (uip = (Uint32 *) ptr; uip < end; uip++)
+ *uip = (Uint32) 0xdeadbeef;
+#endif
+}
+
+static UWord
+alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
+{
+ char *ptr;
+ ErtsFreeSegMap *da_map;
+ ErtsFreeSegDesc *desc = alloc_desc();
+ if (desc) {
+ insert_free_seg(map, desc, start, end);
+ return 0;
+ }
+
+ /*
+ * Ahh; ran out of free segment descriptors.
+ *
+ * First try to map a new page...
+ */
+
+#if ERTS_HAVE_OS_MMAP
+ if (!mmap_state.no_os_mmap) {
+ ptr = os_mmap(mmap_state.desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0);
+ if (ptr) {
+ mmap_state.desc.new_area_hint = ptr+ERTS_PAGEALIGNED_SIZE;
+ ERTS_MMAP_SIZE_OS_INC(ERTS_PAGEALIGNED_SIZE);
+ add_free_desc_area(ptr, ptr+ERTS_PAGEALIGNED_SIZE);
+ desc = alloc_desc();
+ ERTS_MMAP_ASSERT(desc);
+ insert_free_seg(map, desc, start, end);
+ return 0;
+ }
+ }
+#endif
+
+ /*
+ * ...then try to find a good place in the supercarrier...
+ */
+ da_map = &mmap_state.sua.map;
+ desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE);
+ if (desc) {
+ if (mmap_state.reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
+ ERTS_MMAP_SIZE_SC_SUA_INC(ERTS_PAGEALIGNED_SIZE);
+ else
+ desc = NULL;
+
+ }
+ else {
+ da_map = &mmap_state.sa.map;
+ desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE);
+ if (desc) {
+ if (mmap_state.reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
+ ERTS_MMAP_SIZE_SC_SA_INC(ERTS_PAGEALIGNED_SIZE);
+ else
+ desc = NULL;
+ }
+ }
+ if (desc) {
+ char *da_end = desc->start + ERTS_PAGEALIGNED_SIZE;
+ add_free_desc_area(desc->start, da_end);
+ if (da_end != desc->end)
+ resize_free_seg(da_map, desc, da_end, desc->end);
+ else {
+ delete_free_seg(da_map, desc);
+ free_desc(desc);
+ }
+
+ desc = alloc_desc();
+ ERTS_MMAP_ASSERT(desc);
+ insert_free_seg(map, desc, start, end);
+ return 0;
+ }
+
+ /*
+ * ... and then as last resort use the first page of the
+ * free segment we are trying to insert for free descriptors.
+ */
+ ptr = start + ERTS_PAGEALIGNED_SIZE;
+ ERTS_MMAP_ASSERT(ptr <= end);
+
+ add_free_desc_area(start, ptr);
+
+ if (ptr != end) {
+ desc = alloc_desc();
+ ERTS_MMAP_ASSERT(desc);
+ insert_free_seg(map, desc, ptr, end);
+ }
+
+ return ERTS_PAGEALIGNED_SIZE;
+}
+
+void *
+erts_mmap(Uint32 flags, UWord *sizep)
+{
+ char *seg;
+ UWord asize = ERTS_PAGEALIGNED_CEILING(*sizep);
+
+ /* Map in premapped supercarrier */
+ if (mmap_state.supercarrier && !(ERTS_MMAPFLG_OS_ONLY & flags)) {
+ char *end;
+ ErtsFreeSegDesc *desc;
+ Uint32 superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags);
+
+ erts_smp_mtx_lock(&mmap_state.mtx);
+
+ ERTS_MMAP_OP_START(*sizep);
+
+ if (!superaligned) {
+ desc = lookup_free_seg(&mmap_state.sua.map, asize);
+ if (desc) {
+ seg = desc->start;
+ end = seg+asize;
+ if (!mmap_state.reserve_physical(seg, asize))
+ goto supercarrier_reserve_failure;
+ if (desc->end == end) {
+ delete_free_seg(&mmap_state.sua.map, desc);
+ free_desc(desc);
+ }
+ else {
+ ERTS_MMAP_ASSERT(end < desc->end);
+ resize_free_seg(&mmap_state.sua.map, desc, end, desc->end);
+ }
+ ERTS_MMAP_SIZE_SC_SUA_INC(asize);
+ goto supercarrier_success;
+ }
+
+ if (asize <= mmap_state.sua.bot - mmap_state.sa.top) {
+ if (!mmap_state.reserve_physical(mmap_state.sua.bot - asize,
+ asize))
+ goto supercarrier_reserve_failure;
+ mmap_state.sua.bot -= asize;
+ seg = mmap_state.sua.bot;
+ ERTS_MMAP_SIZE_SC_SUA_INC(asize);
+ goto supercarrier_success;
+ }
+ }
+
+ asize = ERTS_SUPERALIGNED_CEILING(asize);
+
+ desc = lookup_free_seg(&mmap_state.sa.map, asize);
+ if (desc) {
+ char *start = seg = desc->start;
+ seg = (char *) ERTS_SUPERALIGNED_CEILING(seg);
+ end = seg+asize;
+ if (!mmap_state.reserve_physical(start, (UWord) (end - start)))
+ goto supercarrier_reserve_failure;
+ ERTS_MMAP_SIZE_SC_SA_INC(asize);
+ if (desc->end == end) {
+ if (start != seg)
+ resize_free_seg(&mmap_state.sa.map, desc, start, seg);
+ else {
+ delete_free_seg(&mmap_state.sa.map, desc);
+ free_desc(desc);
+ }
+ }
+ else {
+ ERTS_MMAP_ASSERT(end < desc->end);
+ resize_free_seg(&mmap_state.sa.map, desc, end, desc->end);
+ if (start != seg) {
+ UWord ad_sz;
+ ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map,
+ start, seg);
+ start += ad_sz;
+ if (start != seg)
+ mmap_state.unreserve_physical(start, (UWord) (seg - start));
+ }
+ }
+ goto supercarrier_success;
+ }
+
+ if (superaligned) {
+ char *start = mmap_state.sa.top;
+ seg = (char *) ERTS_SUPERALIGNED_CEILING(start);
+
+ if (asize + (seg - start) <= mmap_state.sua.bot - start) {
+ end = seg + asize;
+ if (!mmap_state.reserve_physical(start, (UWord) (end - start)))
+ goto supercarrier_reserve_failure;
+ mmap_state.sa.top = end;
+ ERTS_MMAP_SIZE_SC_SA_INC(asize);
+ if (start != seg) {
+ UWord ad_sz;
+ ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map,
+ start, seg);
+ start += ad_sz;
+ if (start != seg)
+ mmap_state.unreserve_physical(start, (UWord) (seg - start));
+ }
+ goto supercarrier_success;
+ }
+
+ desc = lookup_free_seg(&mmap_state.sua.map, asize + ERTS_SUPERALIGNED_SIZE);
+ if (desc) {
+ char *org_start = desc->start;
+ char *org_end = desc->end;
+
+ seg = (char *) ERTS_SUPERALIGNED_CEILING(org_start);
+ end = seg + asize;
+ if (!mmap_state.reserve_physical(seg, (UWord) (org_end - seg)))
+ goto supercarrier_reserve_failure;
+ ERTS_MMAP_SIZE_SC_SUA_INC(asize);
+ if (org_start != seg) {
+ ERTS_MMAP_ASSERT(org_start < seg);
+ resize_free_seg(&mmap_state.sua.map, desc, org_start, seg);
+ desc = NULL;
+ }
+ if (end != org_end) {
+ UWord ad_sz = 0;
+ ERTS_MMAP_ASSERT(end < org_end);
+ if (desc)
+ resize_free_seg(&mmap_state.sua.map, desc, end, org_end);
+ else
+ ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map,
+ end, org_end);
+ end += ad_sz;
+ if (end != org_end)
+ mmap_state.unreserve_physical(end,
+ (UWord) (org_end - end));
+ }
+ goto supercarrier_success;
+ }
+ }
+
+ ERTS_MMAP_OP_ABORT();
+ erts_smp_mtx_unlock(&mmap_state.mtx);
+ }
+
+#if ERTS_HAVE_OS_MMAP
+ /* Map using OS primitives */
+ if (!(ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) && !mmap_state.no_os_mmap) {
+ if (!(ERTS_MMAPFLG_SUPERALIGNED & flags)) {
+ seg = os_mmap(NULL, asize, 0);
+ if (!seg)
+ goto failure;
+ }
+ else {
+ asize = ERTS_SUPERALIGNED_CEILING(*sizep);
+ seg = os_mmap(NULL, asize, 1);
+ if (!seg)
+ goto failure;
+
+ if (!ERTS_IS_SUPERALIGNED(seg)) {
+ char *ptr;
+ UWord sz;
+
+ os_munmap(seg, asize);
+
+ ptr = os_mmap(NULL, asize + ERTS_SUPERALIGNED_SIZE, 1);
+ if (!ptr)
+ goto failure;
+
+ seg = (char *) ERTS_SUPERALIGNED_CEILING(ptr);
+ sz = (UWord) (seg - ptr);
+ ERTS_MMAP_ASSERT(sz <= ERTS_SUPERALIGNED_SIZE);
+ if (sz)
+ os_munmap(ptr, sz);
+ sz = ERTS_SUPERALIGNED_SIZE - sz;
+ if (sz)
+ os_munmap(seg+asize, sz);
+ }
+ }
+
+ ERTS_MMAP_OP_LCK(seg, *sizep, asize);
+ ERTS_MMAP_SIZE_OS_INC(asize);
+ *sizep = asize;
+ return (void *) seg;
+ }
+failure:
+#endif
+ ERTS_MMAP_OP_LCK(NULL, *sizep, 0);
+ *sizep = 0;
+ return NULL;
+
+supercarrier_success:
+
+#ifdef ERTS_MMAP_DEBUG
+ if (ERTS_MMAPFLG_SUPERALIGNED & flags) {
+ ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(seg));
+ ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(asize));
+ }
+ else {
+ ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(seg));
+ ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(asize));
+ }
+#endif
+
+ ERTS_MMAP_OP_END(seg, asize);
+ erts_smp_mtx_unlock(&mmap_state.mtx);
+
+ *sizep = asize;
+ return (void *) seg;
+
+supercarrier_reserve_failure:
+ erts_smp_mtx_unlock(&mmap_state.mtx);
+ *sizep = 0;
+ return NULL;
+}
+
+void
+erts_munmap(Uint32 flags, void *ptr, UWord size)
+{
+ ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr));
+ ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(size));
+
+ if (!ERTS_MMAP_IN_SUPERCARRIER(ptr)) {
+ ERTS_MMAP_ASSERT(!mmap_state.no_os_mmap);
+#if ERTS_HAVE_OS_MMAP
+ ERTS_MUNMAP_OP_LCK(ptr, size);
+ ERTS_MMAP_SIZE_OS_DEC(size);
+ os_munmap(ptr, size);
+#endif
+ }
+ else {
+ char *start, *end;
+ ErtsFreeSegMap *map;
+ ErtsFreeSegDesc *prev, *next, *desc;
+ UWord ad_sz = 0;
+
+ ERTS_MMAP_ASSERT(mmap_state.supercarrier);
+
+ start = (char *) ptr;
+ end = start + size;
+
+ erts_smp_mtx_lock(&mmap_state.mtx);
+
+ ERTS_MUNMAP_OP(ptr, size);
+
+ if (ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) {
+
+ map = &mmap_state.sa.map;
+ adjacent_free_seg(map, start, end, &prev, &next);
+
+ ERTS_MMAP_SIZE_SC_SA_DEC(size);
+ if (end == mmap_state.sa.top) {
+ ERTS_MMAP_ASSERT(!next);
+ if (prev) {
+ start = prev->start;
+ delete_free_seg(map, prev);
+ free_desc(prev);
+ }
+ mmap_state.sa.top = start;
+ goto supercarrier_success;
+ }
+ }
+ else {
+ map = &mmap_state.sua.map;
+ adjacent_free_seg(map, start, end, &prev, &next);
+
+ ERTS_MMAP_SIZE_SC_SUA_DEC(size);
+ if (start == mmap_state.sua.bot) {
+ ERTS_MMAP_ASSERT(!prev);
+ if (next) {
+ end = next->end;
+ delete_free_seg(map, next);
+ free_desc(next);
+ }
+ mmap_state.sua.bot = end;
+ goto supercarrier_success;
+ }
+ }
+
+ desc = NULL;
+
+ if (next) {
+ ERTS_MMAP_ASSERT(end < next->end);
+ end = next->end;
+ if (prev) {
+ delete_free_seg(map, next);
+ free_desc(next);
+ goto save_prev;
+ }
+ desc = next;
+ } else if (prev) {
+ save_prev:
+ ERTS_MMAP_ASSERT(prev->start < start);
+ start = prev->start;
+ desc = prev;
+ }
+
+ if (desc)
+ resize_free_seg(map, desc, start, end);
+ else
+ ad_sz = alloc_desc_insert_free_seg(map, start, end);
+
+ supercarrier_success: {
+ UWord unres_sz;
+
+ ERTS_MMAP_ASSERT(size >= ad_sz);
+ unres_sz = size - ad_sz;
+ if (unres_sz)
+ mmap_state.unreserve_physical(((char *) ptr) + ad_sz, unres_sz);
+
+ erts_smp_mtx_unlock(&mmap_state.mtx);
+ }
+ }
+}
+
+static void *
+remap_move(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
+{
+ UWord size = *sizep;
+ void *new_ptr = erts_mmap(flags, &size);
+ if (!new_ptr)
+ return NULL;
+ *sizep = size;
+ if (old_size < size)
+ size = old_size;
+ sys_memcpy(new_ptr, ptr, (size_t) size);
+ erts_munmap(flags, ptr, old_size);
+ return new_ptr;
+}
+
+void *
+erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
+{
+ void *new_ptr;
+ Uint32 superaligned;
+ UWord asize;
+
+ ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr));
+ ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(old_size));
+ ERTS_MMAP_ASSERT(sizep && ERTS_IS_PAGEALIGNED(*sizep));
+
+ if (!ERTS_MMAP_IN_SUPERCARRIER(ptr)) {
+
+ ERTS_MMAP_ASSERT(!mmap_state.no_os_mmap);
+
+ if (!(ERTS_MMAPFLG_OS_ONLY & flags) && mmap_state.supercarrier) {
+ new_ptr = remap_move(ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags, ptr,
+ old_size, sizep);
+ if (new_ptr)
+ return new_ptr;
+ }
+
+ if (ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) {
+ ERTS_MREMAP_OP_LCK(NULL, ptr, old_size, *sizep, old_size);
+ return NULL;
+ }
+
+#if ERTS_HAVE_OS_MREMAP || ERTS_HAVE_GENUINE_OS_MMAP
+ superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags);
+
+ if (superaligned) {
+ asize = ERTS_SUPERALIGNED_CEILING(*sizep);
+ if (asize == old_size && ERTS_IS_SUPERALIGNED(ptr)) {
+ ERTS_MREMAP_OP_LCK(ptr, ptr, old_size, *sizep, asize);
+ *sizep = asize;
+ return ptr;
+ }
+ }
+ else {
+ asize = ERTS_PAGEALIGNED_CEILING(*sizep);
+ if (asize == old_size) {
+ ERTS_MREMAP_OP_LCK(ptr, ptr, old_size, *sizep, asize);
+ *sizep = asize;
+ return ptr;
+ }
+ }
+
+#if ERTS_HAVE_GENUINE_OS_MMAP
+ if (asize < old_size
+ && (!superaligned
+ || ERTS_IS_SUPERALIGNED(ptr))) {
+ UWord um_sz;
+ new_ptr = ((char *) ptr) + asize;
+ ERTS_MMAP_ASSERT((((char *)ptr) + old_size) > (char *) new_ptr);
+ um_sz = (UWord) ((((char *) ptr) + old_size) - (char *) new_ptr);
+ ERTS_MMAP_SIZE_OS_DEC(um_sz);
+ os_munmap(new_ptr, um_sz);
+ ERTS_MREMAP_OP_LCK(ptr, ptr, old_size, *sizep, asize);
+ *sizep = asize;
+ return ptr;
+ }
+#endif
+#if ERTS_HAVE_OS_MREMAP
+ if (superaligned)
+ return remap_move(flags, new_ptr, old_size, sizep);
+ else {
+ new_ptr = os_mremap(ptr, old_size, asize, 0);
+ if (!new_ptr)
+ return NULL;
+ if (asize > old_size)
+ ERTS_MMAP_SIZE_OS_INC(asize - old_size);
+ else
+ ERTS_MMAP_SIZE_OS_DEC(old_size - asize);
+ ERTS_MREMAP_OP_LCK(new_ptr, ptr, old_size, *sizep, asize);
+ *sizep = asize;
+ return new_ptr;
+ }
+#endif
+#endif
+ }
+ else { /* In super carrier */
+ char *start, *end, *new_end;
+ ErtsFreeSegMap *map;
+ ErtsFreeSegDesc *prev, *next;
+ UWord ad_sz = 0;
+
+ ERTS_MMAP_ASSERT(mmap_state.supercarrier);
+
+ if (ERTS_MMAPFLG_OS_ONLY & flags)
+ return remap_move(flags, ptr, old_size, sizep);
+
+ superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags);
+
+ asize = (superaligned
+ ? ERTS_SUPERALIGNED_CEILING(*sizep)
+ : ERTS_PAGEALIGNED_CEILING(*sizep));
+
+ erts_smp_mtx_lock(&mmap_state.mtx);
+
+ if (ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)
+ ? (!superaligned && lookup_free_seg(&mmap_state.sua.map, asize))
+ : (superaligned && lookup_free_seg(&mmap_state.sa.map, asize))) {
+ erts_smp_mtx_unlock(&mmap_state.mtx);
+ /*
+ * Segment currently in wrong area (due to a previous memory
+ * shortage), move it to the right area.
+ * (remap_move() will succeed)
+ */
+ return remap_move(ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags, ptr,
+ old_size, sizep);
+ }
+
+ ERTS_MREMAP_OP_START(ptr, old_size, *sizep);
+
+ if (asize == old_size) {
+ new_ptr = ptr;
+ goto supercarrier_resize_success;
+ }
+
+ start = (char *) ptr;
+ end = start + old_size;
+ new_end = start+asize;
+
+ ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr));
+ ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(old_size));
+ ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(asize));
+
+ if (asize < old_size) {
+ UWord unres_sz;
+ new_ptr = ptr;
+ if (!ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) {
+ map = &mmap_state.sua.map;
+ ERTS_MMAP_SIZE_SC_SUA_DEC(old_size - asize);
+ }
+ else {
+ if (end == mmap_state.sa.top) {
+ mmap_state.sa.top = new_end;
+ mmap_state.unreserve_physical(((char *) ptr) + asize,
+ old_size - asize);
+ goto supercarrier_resize_success;
+ }
+ ERTS_MMAP_SIZE_SC_SA_DEC(old_size - asize);
+ map = &mmap_state.sa.map;
+ }
+
+ adjacent_free_seg(map, start, end, &prev, &next);
+
+ if (next)
+ resize_free_seg(map, next, new_end, next->end);
+ else
+ ad_sz = alloc_desc_insert_free_seg(map, new_end, end);
+ ERTS_MMAP_ASSERT(old_size - asize >= ad_sz);
+ unres_sz = old_size - asize - ad_sz;
+ if (unres_sz)
+ mmap_state.unreserve_physical(((char *) ptr) + asize + ad_sz,
+ unres_sz);
+ goto supercarrier_resize_success;
+ }
+
+ if (!ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) {
+ ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr));
+ ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(old_size));
+ ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(asize));
+
+ adjacent_free_seg(&mmap_state.sua.map, start, end, &prev, &next);
+
+ if (next && new_end <= next->end) {
+ if (!mmap_state.reserve_physical(((char *) ptr) + old_size,
+ asize - old_size))
+ goto supercarrier_reserve_failure;
+ if (new_end < next->end)
+ resize_free_seg(&mmap_state.sua.map, next, new_end, next->end);
+ else {
+ delete_free_seg(&mmap_state.sua.map, next);
+ free_desc(next);
+ }
+ new_ptr = ptr;
+ ERTS_MMAP_SIZE_SC_SUA_INC(asize - old_size);
+ goto supercarrier_resize_success;
+ }
+ }
+ else { /* Superaligned area */
+
+ if (end == mmap_state.sa.top) {
+ if (new_end <= mmap_state.sua.bot) {
+ if (!mmap_state.reserve_physical(((char *) ptr) + old_size,
+ asize - old_size))
+ goto supercarrier_reserve_failure;
+ mmap_state.sa.top = new_end;
+ new_ptr = ptr;
+ ERTS_MMAP_SIZE_SC_SA_INC(asize - old_size);
+ goto supercarrier_resize_success;
+ }
+ }
+ else {
+ adjacent_free_seg(&mmap_state.sa.map, start, end, &prev, &next);
+ if (next && new_end <= next->end) {
+ if (!mmap_state.reserve_physical(((char *) ptr) + old_size,
+ asize - old_size))
+ goto supercarrier_reserve_failure;
+ if (new_end < next->end)
+ resize_free_seg(&mmap_state.sa.map, next, new_end, next->end);
+ else {
+ delete_free_seg(&mmap_state.sa.map, next);
+ free_desc(next);
+ }
+ new_ptr = ptr;
+ ERTS_MMAP_SIZE_SC_SA_INC(asize - old_size);
+ goto supercarrier_resize_success;
+ }
+ }
+ }
+
+ ERTS_MMAP_OP_ABORT();
+ erts_smp_mtx_unlock(&mmap_state.mtx);
+
+ /* Failed to resize... */
+ }
+
+ return remap_move(flags, ptr, old_size, sizep);
+
+supercarrier_resize_success:
+
+#ifdef ERTS_MMAP_DEBUG
+ if ((ERTS_MMAPFLG_SUPERALIGNED & flags)
+ || ERTS_MMAP_IN_SUPERALIGNED_AREA(new_ptr)) {
+ ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(new_ptr));
+ ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(asize));
+ }
+ else {
+ ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(new_ptr));
+ ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(asize));
+ }
+#endif
+
+ ERTS_MREMAP_OP_END(new_ptr, asize);
+ erts_smp_mtx_unlock(&mmap_state.mtx);
+
+ *sizep = asize;
+ return new_ptr;
+
+supercarrier_reserve_failure:
+ ERTS_MREMAP_OP_END(NULL, old_size);
+ erts_smp_mtx_unlock(&mmap_state.mtx);
+ *sizep = old_size;
+ return NULL;
+
+}
+
+int erts_mmap_in_supercarrier(void *ptr)
+{
+ return ERTS_MMAP_IN_SUPERCARRIER(ptr);
+}
+
+
+static struct {
+ Eterm total;
+ Eterm total_sa;
+ Eterm total_sua;
+ Eterm used;
+ Eterm used_sa;
+ Eterm used_sua;
+ Eterm max;
+ Eterm allocated;
+ Eterm reserved;
+ Eterm sizes;
+ Eterm free_segs;
+ Eterm supercarrier;
+ Eterm os;
+ Eterm scs;
+ Eterm sco;
+ Eterm scrpm;
+ Eterm scmgc;
+
+ int is_initialized;
+ erts_mtx_t init_mutex;
+}am;
+
+static void ERTS_INLINE atom_init(Eterm *atom, char *name)
+{
+ *atom = am_atom_put(name, strlen(name));
+}
+#define AM_INIT(AM) atom_init(&am.AM, #AM)
+
+static void init_atoms(void)
+{
+ erts_mtx_lock(&am.init_mutex);
+
+ if (!am.is_initialized) {
+ AM_INIT(total);
+ AM_INIT(total_sa);
+ AM_INIT(total_sua);
+ AM_INIT(used);
+ AM_INIT(used_sa);
+ AM_INIT(used_sua);
+ AM_INIT(max);
+ AM_INIT(allocated);
+ AM_INIT(reserved);
+ AM_INIT(sizes);
+ AM_INIT(free_segs);
+ AM_INIT(supercarrier);
+ AM_INIT(os);
+ AM_INIT(scs);
+ AM_INIT(sco);
+ AM_INIT(scrpm);
+ AM_INIT(scmgc);
+ am.is_initialized = 1;
+ }
+ erts_mtx_unlock(&am.init_mutex);
+};
+
+
+#ifdef HARD_DEBUG_MSEG
+static void hard_dbg_mseg_init(void);
+#endif
+
+void
+erts_mmap_init(ErtsMMapInit *init)
+{
+ int virtual_map = 0;
+ char *start = NULL, *end = NULL;
+ UWord pagesize;
+#if defined(__WIN32__)
+ SYSTEM_INFO sysinfo;
+ GetSystemInfo(&sysinfo);
+ pagesize = (UWord) sysinfo.dwPageSize;
+#elif defined(_SC_PAGESIZE)
+ pagesize = (UWord) sysconf(_SC_PAGESIZE);
+#elif defined(HAVE_GETPAGESIZE)
+ pagesize = (UWord) getpagesize();
+#else
+# error "Do not know how to get page size"
+#endif
+#if defined(HARD_DEBUG) || 0
+ erts_fprintf(stderr, "erts_mmap: scs = %bpu\n", init->scs);
+ erts_fprintf(stderr, "erts_mmap: sco = %i\n", init->sco);
+ erts_fprintf(stderr, "erts_mmap: scmgc = %i\n", init->scmgc);
+#endif
+ erts_page_inv_mask = pagesize - 1;
+ if (pagesize & erts_page_inv_mask)
+ erl_exit(-1, "erts_mmap: Invalid pagesize: %bpu\n",
+ pagesize);
+
+ ERTS_MMAP_OP_RINGBUF_INIT();
+
+ erts_have_erts_mmap = 0;
+
+ mmap_state.supercarrier = 0;
+ mmap_state.reserve_physical = reserve_noop;
+ mmap_state.unreserve_physical = unreserve_noop;
+
+#if HAVE_MMAP && !defined(MAP_ANON)
+ mmap_state.mmap_fd = open("/dev/zero", O_RDWR);
+ if (mmap_state.mmap_fd < 0)
+ erl_exit(-1, "erts_mmap: Failed to open /dev/zero\n");
+#endif
+
+ erts_smp_mtx_init(&mmap_state.mtx, "erts_mmap");
+ erts_mtx_init(&am.init_mutex, "mmap_init_atoms");
+
+#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
+ if (init->virtual_range.start) {
+ char *ptr;
+ UWord sz;
+ ptr = (char *) ERTS_PAGEALIGNED_CEILING(init->virtual_range.start);
+ end = (char *) ERTS_PAGEALIGNED_FLOOR(init->virtual_range.end);
+ sz = end - ptr;
+ start = os_mmap_virtual(ptr, sz);
+ if (!start || start > ptr || start >= end)
+ erl_exit(-1,
+ "erts_mmap: Failed to create virtual range for super carrier\n");
+ sz = start - ptr;
+ if (sz)
+ os_munmap(end, sz);
+ mmap_state.reserve_physical = os_reserve_physical;
+ mmap_state.unreserve_physical = os_unreserve_physical;
+ virtual_map = 1;
+ }
+ else
+#endif
+ if (init->predefined_area.start) {
+ start = init->predefined_area.start;
+ end = init->predefined_area.end;
+ if (end != (void *) 0 && end < start)
+ end = start;
+ }
+#if ERTS_HAVE_OS_MMAP
+ else if (init->scs) {
+ UWord sz;
+ sz = ERTS_PAGEALIGNED_CEILING(init->scs);
+#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
+ if (!init->scrpm) {
+ start = os_mmap_virtual(NULL, sz);
+ mmap_state.reserve_physical = os_reserve_physical;
+ mmap_state.unreserve_physical = os_unreserve_physical;
+ virtual_map = 1;
+ }
+ else
+#endif
+ {
+ /*
+ * The whole supercarrier will by physically
+ * reserved all the time.
+ */
+ start = os_mmap(NULL, sz, 1);
+ }
+ if (!start)
+ erl_exit(-1,
+ "erts_mmap: Failed to create super carrier of size %bpu MB\n",
+ init->scs/1024/1024);
+ end = start + sz;
+#ifdef ERTS_MMAP_DEBUG_FILL_AREAS
+ if (!virtual_map) {
+ Uint32 *uip;
+
+ for (uip = (Uint32 *) start; uip < (Uint32 *) end; uip++)
+ *uip = (Uint32) 0xdeadbeef;
+ }
+#endif
+ }
+ if (!mmap_state.no_os_mmap)
+ erts_have_erts_mmap |= ERTS_HAVE_ERTS_OS_MMAP;
+#endif
+
+ mmap_state.no.free_seg_descs = 0;
+ mmap_state.no.free_segs.curr = 0;
+ mmap_state.no.free_segs.max = 0;
+
+ mmap_state.size.supercarrier.total = 0;
+ mmap_state.size.supercarrier.used.total = 0;
+ mmap_state.size.supercarrier.used.sa = 0;
+ mmap_state.size.supercarrier.used.sua = 0;
+ mmap_state.size.os.used = 0;
+
+ mmap_state.desc.new_area_hint = NULL;
+
+ if (!start) {
+ mmap_state.sa.bot = NULL;
+ mmap_state.sua.top = NULL;
+ mmap_state.sa.bot = NULL;
+ mmap_state.sua.top = NULL;
+ mmap_state.no_os_mmap = 0;
+ mmap_state.supercarrier = 0;
+ }
+ else {
+ size_t desc_size;
+
+ mmap_state.no_os_mmap = init->sco;
+
+ desc_size = init->scmgc;
+ if (desc_size < 100)
+ desc_size = 100;
+ desc_size *= sizeof(ErtsFreeSegDesc);
+ if ((desc_size
+ + ERTS_SUPERALIGNED_SIZE
+ + ERTS_PAGEALIGNED_SIZE) > end - start)
+ erl_exit(-1, "erts_mmap: No space for segments in super carrier\n");
+
+ mmap_state.sa.bot = start;
+ mmap_state.sa.bot += desc_size;
+ mmap_state.sa.bot = (char *) ERTS_SUPERALIGNED_CEILING(mmap_state.sa.bot);
+ mmap_state.sa.top = mmap_state.sa.bot;
+ mmap_state.sua.top = end;
+ mmap_state.sua.bot = mmap_state.sua.top;
+
+ mmap_state.size.supercarrier.used.total += (UWord) (mmap_state.sa.bot - start);
+
+ mmap_state.desc.free_list = NULL;
+ mmap_state.desc.reserved = 0;
+
+ if (end == (void *) 0) {
+ /*
+ * Very unlikely, but we need a guarantee
+ * that `mmap_state.sua.top` always will
+ * compare as larger than all segment pointers
+ * into the super carrier...
+ */
+ mmap_state.sua.top -= ERTS_PAGEALIGNED_SIZE;
+ mmap_state.size.supercarrier.used.total += ERTS_PAGEALIGNED_SIZE;
+#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
+ if (!virtual_map || os_reserve_physical(mmap_state.sua.top, ERTS_PAGEALIGNED_SIZE))
+#endif
+ add_free_desc_area(mmap_state.sua.top, end);
+ mmap_state.desc.reserved += (end - mmap_state.sua.top) / sizeof(ErtsFreeSegDesc);
+ }
+
+ mmap_state.size.supercarrier.total = (UWord) (mmap_state.sua.top - start);
+
+ /*
+ * Area before (and after) super carrier
+ * will be used for free segment descritors.
+ */
+#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
+ if (virtual_map && !os_reserve_physical(start, mmap_state.sa.bot - start))
+ erl_exit(-1, "erts_mmap: Failed to reserve physical memory for descriptors\n");
+#endif
+ mmap_state.desc.unused_start = start;
+ mmap_state.desc.unused_end = mmap_state.sa.bot;
+ mmap_state.desc.reserved += ((mmap_state.desc.unused_end - start)
+ / sizeof(ErtsFreeSegDesc));
+
+ init_free_seg_map(&mmap_state.sa.map, SA_SZ_ADDR_ORDER);
+ init_free_seg_map(&mmap_state.sua.map, SZ_REVERSE_ADDR_ORDER);
+
+ mmap_state.supercarrier = 1;
+ erts_have_erts_mmap |= ERTS_HAVE_ERTS_SUPERCARRIER_MMAP;
+
+ mmap_state.desc.new_area_hint = end;
+
+ }
+
+#if !ERTS_HAVE_OS_MMAP
+ mmap_state.no_os_mmap = 1;
+#endif
+
+#ifdef HARD_DEBUG_MSEG
+ hard_dbg_mseg_init();
+#endif
+}
+
+
+static ERTS_INLINE void
+add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2)
+{
+ *lp = erts_bld_cons(hpp, szp, erts_bld_tuple(hpp, szp, 2, el1, el2), *lp);
+}
+
+Eterm erts_mmap_info(int *print_to_p,
+ void *print_to_arg,
+ Eterm** hpp, Uint* szp,
+ struct erts_mmap_info_struct* emis)
+{
+ Eterm size_tags[] = { am.total, am.total_sa, am.total_sua, am.used, am.used_sa, am.used_sua };
+ Eterm seg_tags[] = { am.used, am.max, am.allocated, am.reserved, am.used_sa, am.used_sua };
+ Eterm group[2];
+ Eterm group_tags[] = { am.sizes, am.free_segs };
+ Eterm list[2];
+ Eterm list_tags[2]; /* { am.supercarrier, am.os } */
+ int lix;
+ Eterm res = THE_NON_VALUE;
+
+ if (!hpp) {
+ erts_smp_mtx_lock(&mmap_state.mtx);
+ emis->sizes[0] = mmap_state.size.supercarrier.total;
+ emis->sizes[1] = mmap_state.sa.top - mmap_state.sa.bot;
+ emis->sizes[2] = mmap_state.sua.top - mmap_state.sua.bot;
+ emis->sizes[3] = mmap_state.size.supercarrier.used.total;
+ emis->sizes[4] = mmap_state.size.supercarrier.used.sa;
+ emis->sizes[5] = mmap_state.size.supercarrier.used.sua;
+
+ emis->segs[0] = mmap_state.no.free_segs.curr;
+ emis->segs[1] = mmap_state.no.free_segs.max;
+ emis->segs[2] = mmap_state.no.free_seg_descs;
+ emis->segs[3] = mmap_state.desc.reserved;
+ emis->segs[4] = mmap_state.sa.map.nseg;
+ emis->segs[5] = mmap_state.sua.map.nseg;
+
+ emis->os_used = mmap_state.size.os.used;
+ erts_smp_mtx_unlock(&mmap_state.mtx);
+ }
+
+ if (print_to_p) {
+ int to = *print_to_p;
+ void *arg = print_to_arg;
+ if (mmap_state.supercarrier) {
+ const char* prefix = "supercarrier ";
+ erts_print(to, arg, "%stotal size: %bpu\n", prefix, emis->sizes[0]);
+ erts_print(to, arg, "%stotal sa size: %bpu\n", prefix, emis->sizes[1]);
+ erts_print(to, arg, "%stotal sua size: %bpu\n", prefix, emis->sizes[2]);
+ erts_print(to, arg, "%sused size: %bpu\n", prefix, emis->sizes[3]);
+ erts_print(to, arg, "%sused sa size: %bpu\n", prefix, emis->sizes[4]);
+ erts_print(to, arg, "%sused sua size: %bpu\n", prefix, emis->sizes[5]);
+ erts_print(to, arg, "%sused free segs: %bpu\n", prefix, emis->segs[0]);
+ erts_print(to, arg, "%smax free segs: %bpu\n", prefix, emis->segs[1]);
+ erts_print(to, arg, "%sallocated free segs: %bpu\n", prefix, emis->segs[2]);
+ erts_print(to, arg, "%sreserved free segs: %bpu\n", prefix, emis->segs[3]);
+ erts_print(to, arg, "%ssa free segs: %bpu\n", prefix, emis->segs[4]);
+ erts_print(to, arg, "%ssua free segs: %bpu\n", prefix, emis->segs[5]);
+ }
+ if (!mmap_state.no_os_mmap) {
+ erts_print(to, arg, "os mmap size used: %bpu\n", emis->os_used);
+ }
+ }
+
+
+ if (hpp || szp) {
+ if (!am.is_initialized) {
+ init_atoms();
+ }
+
+ lix = 0;
+ if (mmap_state.supercarrier) {
+ group[0] = erts_bld_atom_uword_2tup_list(hpp, szp,
+ sizeof(size_tags)/sizeof(Eterm),
+ size_tags, emis->sizes);
+ group[1] = erts_bld_atom_uword_2tup_list(hpp, szp,
+ sizeof(seg_tags)/sizeof(Eterm),
+ seg_tags, emis->segs);
+ list[lix] = erts_bld_2tup_list(hpp, szp, 2, group_tags, group);
+ list_tags[lix] = am.supercarrier;
+ lix++;
+ }
+
+ if (!mmap_state.no_os_mmap) {
+ group[0] = erts_bld_atom_uword_2tup_list(hpp, szp,
+ 1, &am.used, &emis->os_used);
+ list[lix] = erts_bld_2tup_list(hpp, szp, 1, group_tags, group);
+ list_tags[lix] = am.os;
+ lix++;
+ }
+ res = erts_bld_2tup_list(hpp, szp, lix, list_tags, list);
+ }
+ return res;
+}
+
+Eterm erts_mmap_info_options(char *prefix,
+ int *print_to_p,
+ void *print_to_arg,
+ Uint **hpp,
+ Uint *szp)
+{
+ const UWord scs = mmap_state.sua.top - mmap_state.sa.bot;
+ const Eterm sco = mmap_state.no_os_mmap ? am_true : am_false;
+ const Eterm scrpm = (mmap_state.reserve_physical == reserve_noop) ? am_true : am_false;
+ Eterm res = THE_NON_VALUE;
+
+ if (print_to_p) {
+ int to = *print_to_p;
+ void *arg = print_to_arg;
+ erts_print(to, arg, "%sscs: %bpu\n", prefix, scs);
+ if (mmap_state.supercarrier) {
+ erts_print(to, arg, "%ssco: %T\n", prefix, sco);
+ erts_print(to, arg, "%sscrpm: %T\n", prefix, scrpm);
+ erts_print(to, arg, "%sscmgc: %beu\n", prefix, mmap_state.desc.reserved);
+ }
+ }
+
+ if (hpp || szp) {
+ if (!am.is_initialized) {
+ init_atoms();
+ }
+
+ res = NIL;
+ if (mmap_state.supercarrier) {
+ add_2tup(hpp, szp, &res, am.scmgc,
+ erts_bld_uint(hpp,szp, mmap_state.desc.reserved));
+ add_2tup(hpp, szp, &res, am.scrpm, scrpm);
+ add_2tup(hpp, szp, &res, am.sco, sco);
+ }
+ add_2tup(hpp, szp, &res, am.scs, erts_bld_uword(hpp, szp, scs));
+ }
+ return res;
+}
+
+
+Eterm erts_mmap_debug_info(Process* p)
+{
+ if (mmap_state.supercarrier) {
+ ERTS_DECL_AM(sabot);
+ ERTS_DECL_AM(satop);
+ ERTS_DECL_AM(suabot);
+ ERTS_DECL_AM(suatop);
+ Eterm sa_list, sua_list, list;
+ Eterm tags[] = { AM_sabot, AM_satop, AM_suabot, AM_suatop };
+ UWord values[4];
+ Eterm *hp, *hp_end;
+ Uint may_need;
+ const Uint PTR_BIG_SZ = HALFWORD_HEAP ? 3 : 2;
+
+ erts_smp_mtx_lock(&mmap_state.mtx);
+ values[0] = (UWord)mmap_state.sa.bot;
+ values[1] = (UWord)mmap_state.sa.top;
+ values[2] = (UWord)mmap_state.sua.bot;
+ values[3] = (UWord)mmap_state.sua.top;
+ sa_list = build_free_seg_list(p, &mmap_state.sa.map);
+ sua_list = build_free_seg_list(p, &mmap_state.sua.map);
+ erts_smp_mtx_unlock(&mmap_state.mtx);
+
+ may_need = 4*(2+3+PTR_BIG_SZ) + 2*(2+3);
+ hp = HAlloc(p, may_need);
+ hp_end = hp + may_need;
+
+ list = erts_bld_atom_uword_2tup_list(&hp, NULL,
+ sizeof(values)/sizeof(*values),
+ tags, values);
+
+ sa_list = TUPLE2(hp, am_atom_put("sa_free_segs",12), sa_list); hp+=3;
+ sua_list = TUPLE2(hp, am_atom_put("sua_free_segs",13), sua_list); hp+=3;
+ list = CONS(hp, sua_list, list); hp+=2;
+ list = CONS(hp, sa_list, list); hp+=2;
+
+ ASSERT(hp <= hp_end);
+ HRelease(p, hp_end, hp);
+ return list;
+ }
+ else {
+ return am_undefined;
+ }
+}
+
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Debug functions *
+\* */
+
+
+#ifdef HARD_DEBUG
+
+static int rbt_assert_is_member(RBTNode* root, RBTNode* node)
+{
+ while (node != root) {
+ RBT_ASSERT(parent(node));
+ RBT_ASSERT(parent(node)->left == node || parent(node)->right == node);
+ node = parent(node);
+ }
+ return 1;
+}
+
+
+#if 0
+# define PRINT_TREE
+#else
+# undef PRINT_TREE
+#endif
+
+#ifdef PRINT_TREE
+static void print_tree(enum SortOrder order, RBTNode*);
+#endif
+
+/*
+ * Checks that the order between parent and children are correct,
+ * and that the Red-Black Tree properies are satisfied. if size > 0,
+ * check_tree() returns the node that satisfies "address order first fit"
+ *
+ * The Red-Black Tree properies are:
+ * 1. Every node is either red or black.
+ * 2. Every leaf (NIL) is black.
+ * 3. If a node is red, then both its children are black.
+ * 4. Every simple path from a node to a descendant leaf
+ * contains the same number of black nodes.
+ *
+ */
+
+struct check_arg_t {
+ RBTree* tree;
+ ErtsFreeSegDesc* prev_seg;
+ Uint size;
+ RBTNode *res;
+};
+static void check_node_callback(RBTNode* x, void* arg);
+
+
+static RBTNode *
+check_tree(RBTree* tree, Uint size)
+{
+ struct check_arg_t carg;
+ carg.tree = tree;
+ carg.prev_seg = NULL;
+ carg.size = size;
+ carg.res = NULL;
+
+#ifdef PRINT_TREE
+ print_tree(tree->order, tree->root);
+#endif
+
+ if (!tree->root)
+ return NULL;
+
+ RBT_ASSERT(IS_BLACK(tree->root));
+ RBT_ASSERT(!parent(tree->root));
+
+ rbt_foreach_node(tree, check_node_callback, &carg, 0);
+
+ return carg.res;
+}
+
+static void check_node_callback(RBTNode* x, void* arg)
+{
+ struct check_arg_t* a = (struct check_arg_t*) arg;
+ ErtsFreeSegDesc* seg;
+
+ if (IS_RED(x)) {
+ RBT_ASSERT(IS_BLACK(x->right));
+ RBT_ASSERT(IS_BLACK(x->left));
+ }
+
+ RBT_ASSERT(parent(x) || x == a->tree->root);
+
+ if (x->left) {
+ RBT_ASSERT(cmp_nodes(a->tree->order, x->left, x) < 0);
+ }
+ if (x->right) {
+ RBT_ASSERT(cmp_nodes(a->tree->order, x->right, x) > 0);
+ }
+
+ seg = node_to_desc(a->tree->order, x);
+ RBT_ASSERT(seg->start < seg->end);
+ if (a->size && (seg->end - seg->start) >= a->size) {
+ if (!a->res || cmp_nodes(a->tree->order, x, a->res) < 0) {
+ a->res = x;
+ }
+ }
+ if (a->tree->order == ADDR_ORDER) {
+ RBT_ASSERT(!a->prev_seg || a->prev_seg->end < seg->start);
+ a->prev_seg = seg;
+ }
+}
+
+#endif /* HARD_DEBUG */
+
+
+#ifdef PRINT_TREE
+#define INDENT_STEP 2
+
+#include <stdio.h>
+
+static void
+print_tree_aux(enum SortOrder order, RBTNode *x, int indent)
+{
+ int i;
+
+ if (x) {
+ ErtsFreeSegDesc* desc = node_to_desc(order, x);
+ print_tree_aux(order, x->right, indent + INDENT_STEP);
+ for (i = 0; i < indent; i++) {
+ putc(' ', stderr);
+ }
+ fprintf(stderr, "%s: sz=%lx [%p - %p] desc=%p\r\n",
+ IS_BLACK(x) ? "BLACK" : "RED",
+ desc->end - desc->start, desc->start, desc->end, desc);
+ print_tree_aux(order, x->left, indent + INDENT_STEP);
+ }
+}
+
+
+static void
+print_tree(enum SortOrder order, RBTNode* root)
+{
+ fprintf(stderr, " --- %s ordered tree begin ---\r\n", sort_order_names[order]);
+ print_tree_aux(order, root, 0);
+ fprintf(stderr, " --- %s ordered tree end ---\r\n", sort_order_names[order]);
+}
+
+#endif /* PRINT_TREE */
+
+
+#ifdef FREE_SEG_API_SMOKE_TEST
+
+void test_it(void)
+{
+ ErtsFreeSegMap map;
+ ErtsFreeSegDesc *desc, *under, *over, *d1, *d2;
+ const int i = 1; /* reverse addr order */
+
+ {
+ init_free_seg_map(&map, SZ_REVERSE_ADDR_ORDER);
+
+ insert_free_seg(&map, alloc_desc(), (char*)0x11000, (char*)0x12000);
+ HARD_CHECK_TREE(&map.atree, 0); HARD_CHECK_TREE(&map.stree, 0);
+ insert_free_seg(&map, alloc_desc(), (char*)0x13000, (char*)0x14000);
+ HARD_CHECK_TREE(&map.atree, 0); HARD_CHECK_TREE(&map.stree, 0);
+ insert_free_seg(&map, alloc_desc(), (char*)0x15000, (char*)0x17000);
+ HARD_CHECK_TREE(&map.atree, 0); HARD_CHECK_TREE(&map.stree, 0);
+ insert_free_seg(&map, alloc_desc(), (char*)0x8000, (char*)0x10000);
+ HARD_CHECK_TREE(&map.atree, 0); HARD_CHECK_TREE(&map.stree, 0);
+
+ desc = lookup_free_seg(&map, 0x500);
+ ERTS_ASSERT(desc->start == (char*)(i?0x13000L:0x11000L));
+
+ desc = lookup_free_seg(&map, 0x1500);
+ ERTS_ASSERT(desc->start == (char*)0x15000);
+
+ adjacent_free_seg(&map, (char*)0x6666, (char*)0x7777, &under, &over);
+ ERTS_ASSERT(!under && !over);
+
+ adjacent_free_seg(&map, (char*)0x6666, (char*)0x8000, &under, &over);
+ ERTS_ASSERT(!under && over->start == (char*)0x8000);
+
+ adjacent_free_seg(&map, (char*)0x10000, (char*)0x10500, &under, &over);
+ ERTS_ASSERT(under->end == (char*)0x10000 && !over);
+
+ adjacent_free_seg(&map, (char*)0x10100, (char*)0x10500, &under, &over);
+ ERTS_ASSERT(!under && !over);
+
+ adjacent_free_seg(&map, (char*)0x10100, (char*)0x11000, &under, &over);
+ ERTS_ASSERT(!under && over && over->start == (char*)0x11000);
+
+ adjacent_free_seg(&map, (char*)0x12000, (char*)0x12500, &under, &over);
+ ERTS_ASSERT(under && under->end == (char*)0x12000 && !over);
+
+ adjacent_free_seg(&map, (char*)0x12000, (char*)0x13000, &under, &over);
+ ERTS_ASSERT(under && under->end == (char*)0x12000 &&
+ over && over->start == (char*)0x13000);
+
+ adjacent_free_seg(&map, (char*)0x12500, (char*)0x13000, &under, &over);
+ ERTS_ASSERT(!under && over && over->start == (char*)0x13000);
+
+ d1 = lookup_free_seg(&map, 0x500);
+ ERTS_ASSERT(d1->start == (char*)(i?0x13000L:0x11000L));
+
+ resize_free_seg(&map, d1, d1->start - 0x800, (char*)d1->end);
+ HARD_CHECK_TREE(&map.atree, 0); HARD_CHECK_TREE(&map.stree, 0);
+
+ d2 = lookup_free_seg(&map, 0x1200);
+ ERTS_ASSERT(d2 == d1);
+
+ delete_free_seg(&map, d1);
+ HARD_CHECK_TREE(&map.atree, 0); HARD_CHECK_TREE(&map.stree, 0);
+
+ d1 = lookup_free_seg(&map, 0x1200);
+ ERTS_ASSERT(d1->start == (char*)0x15000);
+ }
+}
+
+#endif /* FREE_SEG_API_SMOKE_TEST */
+
+
+#ifdef HARD_DEBUG_MSEG
+
+/*
+ * Debug stuff used by erl_mseg to check that it does the right thing.
+ * The reason for keeping it here is that we (ab)use the rb-tree code
+ * for keeping track of *allocated* segments.
+ */
+
+typedef struct ErtsFreeSegDesc_fake_ {
+ /*RBTNode snode; Save memory by skipping unused size tree node */
+ RBTNode anode; /* node in 'atree' */
+ union {
+ char* start;
+ struct ErtsFreeSegDesc_fake_* next_free;
+ }u;
+ char* end;
+}ErtsFreeSegDesc_fake;
+
+static ErtsFreeSegDesc_fake hard_dbg_mseg_desc_pool[10000];
+static ErtsFreeSegDesc_fake* hard_dbg_mseg_desc_first;
+RBTree hard_dbg_mseg_tree;
+
+static erts_mtx_t hard_dbg_mseg_mtx;
+
+static void hard_dbg_mseg_init(void)
+{
+ ErtsFreeSegDesc_fake* p;
+
+ erts_mtx_init(&hard_dbg_mseg_mtx, "hard_dbg_mseg");
+ hard_dbg_mseg_tree.root = NULL;
+ hard_dbg_mseg_tree.order = ADDR_ORDER;
+
+ p = &hard_dbg_mseg_desc_pool[(sizeof(hard_dbg_mseg_desc_pool) /
+ sizeof(*hard_dbg_mseg_desc_pool)) - 1];
+ p->u.next_free = NULL;
+ while (--p >= hard_dbg_mseg_desc_pool) {
+ p->u.next_free = (p+1);
+ }
+ hard_dbg_mseg_desc_first = &hard_dbg_mseg_desc_pool[0];
+}
+
+static ErtsFreeSegDesc* hard_dbg_alloc_desc(void)
+{
+ ErtsFreeSegDesc_fake* p = hard_dbg_mseg_desc_first;
+ ERTS_ASSERT(p || !"HARD_DEBUG_MSEG: Out of mseg descriptors");
+ hard_dbg_mseg_desc_first = p->u.next_free;
+
+ /* Creative pointer arithmetic to return something that looks like
+ * a ErtsFreeSegDesc as long as we don't use the absent 'snode'.
+ */
+ return (ErtsFreeSegDesc*) ((char*)p - offsetof(ErtsFreeSegDesc,anode));
+}
+
+static void hard_dbg_free_desc(ErtsFreeSegDesc* desc)
+{
+ ErtsFreeSegDesc_fake* p = (ErtsFreeSegDesc_fake*) &desc->anode;
+ memset(p, 0xfe, sizeof(*p));
+ p->u.next_free = hard_dbg_mseg_desc_first;
+ hard_dbg_mseg_desc_first = p;
+}
+
+static void check_seg_writable(void* seg, UWord sz)
+{
+ UWord* seg_end = (UWord*)((char*)seg + sz);
+ volatile UWord* p;
+ ERTS_ASSERT(ERTS_IS_PAGEALIGNED(seg));
+ ERTS_ASSERT(ERTS_IS_PAGEALIGNED(sz));
+ for (p=(UWord*)seg; p<seg_end; p += (ERTS_INV_PAGEALIGNED_MASK+1)/sizeof(UWord)) {
+ UWord write_back = *p;
+ *p = 0xfade2b1acc;
+ *p = write_back;
+ }
+}
+
+void hard_dbg_insert_mseg(void* seg, UWord sz)
+{
+ check_seg_writable(seg, sz);
+ erts_mtx_lock(&hard_dbg_mseg_mtx);
+ {
+ ErtsFreeSegDesc *desc = hard_dbg_alloc_desc();
+ RBTNode *prev, *next;
+ desc->start = (char*)seg;
+ desc->end = desc->start + sz - 1; /* -1 to allow adjacent segments in tree */
+ rbt_insert(&hard_dbg_mseg_tree, &desc->anode);
+ prev = rbt_prev_node(&desc->anode);
+ next = rbt_next_node(&desc->anode);
+ ERTS_ASSERT(!prev || anode_to_desc(prev)->end < desc->start);
+ ERTS_ASSERT(!next || anode_to_desc(next)->start > desc->end);
+ }
+ erts_mtx_unlock(&hard_dbg_mseg_mtx);
+}
+
+static ErtsFreeSegDesc* hard_dbg_lookup_seg_at(RBTree* tree, char* start)
+{
+ RBTNode* x = tree->root;
+
+ while (x) {
+ ErtsFreeSegDesc* desc = anode_to_desc(x);
+ if (start < desc->start) {
+ x = x->left;
+ }
+ else if (start > desc->start) {
+ ERTS_ASSERT(start > desc->end);
+ x = x->right;
+ }
+ else
+ return desc;
+ }
+ return NULL;
+}
+
+void hard_dbg_remove_mseg(void* seg, UWord sz)
+{
+ check_seg_writable(seg, sz);
+ erts_mtx_lock(&hard_dbg_mseg_mtx);
+ {
+ ErtsFreeSegDesc* desc = hard_dbg_lookup_seg_at(&hard_dbg_mseg_tree, (char*)seg);
+ ERTS_ASSERT(desc);
+ ERTS_ASSERT(desc->start == (char*)seg);
+ ERTS_ASSERT(desc->end == (char*)seg + sz - 1);
+
+ rbt_delete(&hard_dbg_mseg_tree, &desc->anode);
+ hard_dbg_free_desc(desc);
+ }
+ erts_mtx_unlock(&hard_dbg_mseg_mtx);
+}
+
+#endif /* HARD_DEBUG_MSEG */
diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h
new file mode 100644
index 0000000000..e6934dbb26
--- /dev/null
+++ b/erts/emulator/sys/common/erl_mmap.h
@@ -0,0 +1,134 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2013. 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_MMAP_H__
+#define ERL_MMAP_H__
+
+#include "sys.h"
+
+#define ERTS_MMAP_SUPERALIGNED_BITS (18)
+/* Affects hard limits for sbct and lmbcs documented in erts_alloc.xml */
+
+#define ERTS_MMAPFLG_OS_ONLY (((Uint32) 1) << 0)
+#define ERTS_MMAPFLG_SUPERCARRIER_ONLY (((Uint32) 1) << 1)
+#define ERTS_MMAPFLG_SUPERALIGNED (((Uint32) 1) << 2)
+
+#define ERTS_HAVE_ERTS_OS_MMAP (1 << 0)
+#define ERTS_HAVE_ERTS_SUPERCARRIER_MMAP (1 << 1)
+extern int erts_have_erts_mmap;
+extern UWord erts_page_inv_mask;
+
+typedef struct {
+ struct {
+ char *start;
+ char *end;
+ } virtual_range;
+ struct {
+ char *start;
+ char *end;
+ } predefined_area;
+ UWord scs; /* super carrier size */
+ int sco; /* super carrier only? */
+ Uint scmgc; /* super carrier: max guaranteed (number of) carriers */
+ int scrpm;
+}ErtsMMapInit;
+
+#define ERTS_MMAP_INIT_DEFAULT_INITER \
+ {{NULL, NULL}, {NULL, NULL}, 0, 1, (1 << 16), 1}
+
+void *erts_mmap(Uint32 flags, UWord *sizep);
+void erts_munmap(Uint32 flags, void *ptr, UWord size);
+void *erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep);
+int erts_mmap_in_supercarrier(void *ptr);
+void erts_mmap_init(ErtsMMapInit*);
+struct erts_mmap_info_struct
+{
+ UWord sizes[6];
+ UWord segs[6];
+ UWord os_used;
+};
+Eterm erts_mmap_info(int *print_to_p, void *print_to_arg,
+ Eterm** hpp, Uint* szp, struct erts_mmap_info_struct*);
+Eterm erts_mmap_info_options(char *prefix, int *print_to_p, void *print_to_arg,
+ Uint **hpp, Uint *szp);
+struct process;
+Eterm erts_mmap_debug_info(struct process*);
+
+#define ERTS_SUPERALIGNED_SIZE \
+ (1 << ERTS_MMAP_SUPERALIGNED_BITS)
+#define ERTS_INV_SUPERALIGNED_MASK \
+ ((UWord) (ERTS_SUPERALIGNED_SIZE - 1))
+#define ERTS_SUPERALIGNED_MASK \
+ (~ERTS_INV_SUPERALIGNED_MASK)
+#define ERTS_SUPERALIGNED_FLOOR(X) \
+ (((UWord) (X)) & ERTS_SUPERALIGNED_MASK)
+#define ERTS_SUPERALIGNED_CEILING(X) \
+ ERTS_SUPERALIGNED_FLOOR((X) + ERTS_INV_SUPERALIGNED_MASK)
+#define ERTS_IS_SUPERALIGNED(X) \
+ (((UWord) (X) & ERTS_INV_SUPERALIGNED_MASK) == 0)
+
+#define ERTS_INV_PAGEALIGNED_MASK \
+ (erts_page_inv_mask)
+#define ERTS_PAGEALIGNED_MASK \
+ (~ERTS_INV_PAGEALIGNED_MASK)
+#define ERTS_PAGEALIGNED_FLOOR(X) \
+ (((UWord) (X)) & ERTS_PAGEALIGNED_MASK)
+#define ERTS_PAGEALIGNED_CEILING(X) \
+ ERTS_PAGEALIGNED_FLOOR((X) + ERTS_INV_PAGEALIGNED_MASK)
+#define ERTS_IS_PAGEALIGNED(X) \
+ (((UWord) (X) & ERTS_INV_PAGEALIGNED_MASK) == 0)
+#define ERTS_PAGEALIGNED_SIZE \
+ (ERTS_INV_PAGEALIGNED_MASK + 1)
+
+#ifndef HAVE_MMAP
+# define HAVE_MMAP 0
+#endif
+#ifndef HAVE_MREMAP
+# define HAVE_MREMAP 0
+#endif
+#if HAVE_MMAP
+# define ERTS_HAVE_OS_MMAP 1
+# define ERTS_HAVE_GENUINE_OS_MMAP 1
+# if HAVE_MREMAP
+# define ERTS_HAVE_OS_MREMAP 1
+# endif
+# if defined(MAP_FIXED) && defined(MAP_NORESERVE)
+# define ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION 1
+# endif
+#endif
+
+#ifndef HAVE_VIRTUALALLOC
+# define HAVE_VIRTUALALLOC 0
+#endif
+#if HAVE_VIRTUALALLOC
+# define ERTS_HAVE_OS_MMAP 1
+#endif
+
+/*#define HARD_DEBUG_MSEG*/
+#ifdef HARD_DEBUG_MSEG
+# define HARD_DBG_INSERT_MSEG hard_dbg_insert_mseg
+# define HARD_DBG_REMOVE_MSEG hard_dbg_remove_mseg
+void hard_dbg_insert_mseg(void* seg, UWord sz);
+void hard_dbg_remove_mseg(void* seg, UWord sz);
+#else
+# define HARD_DBG_INSERT_MSEG(SEG,SZ)
+# define HARD_DBG_REMOVE_MSEG(SEG,SZ)
+#endif
+
+#endif /* ERL_MMAP_H__ */
diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c
index 2748edba02..94a381e168 100644
--- a/erts/emulator/sys/common/erl_mseg.c
+++ b/erts/emulator/sys/common/erl_mseg.c
@@ -100,45 +100,6 @@ static int atoms_initialized;
typedef struct mem_kind_t MemKind;
-#if HALFWORD_HEAP
-static int initialize_pmmap(void);
-static void *pmmap(size_t size);
-static int pmunmap(void *p, size_t size);
-static void *pmremap(void *old_address, size_t old_size,
- size_t new_size);
-#endif
-
-#if HAVE_MMAP
-/* Mmap ... */
-
-#define MMAP_PROT (PROT_READ|PROT_WRITE)
-
-
-#ifdef MAP_ANON
-# define MMAP_FLAGS (MAP_ANON|MAP_PRIVATE)
-# define MMAP_FD (-1)
-#else
-# define MMAP_FLAGS (MAP_PRIVATE)
-# define MMAP_FD mmap_fd
-static int mmap_fd;
-#endif
-
-#if HAVE_MREMAP
-# define HAVE_MSEG_RECREATE 1
-#else
-# define HAVE_MSEG_RECREATE 0
-#endif
-
-#if HALFWORD_HEAP
-#define CAN_PARTLY_DESTROY 0
-#else
-#define CAN_PARTLY_DESTROY 1
-#endif
-#else /* #if HAVE_MMAP */
-#define CAN_PARTLY_DESTROY 0
-#error "Not supported"
-#endif /* #if HAVE_MMAP */
-
const ErtsMsegOpt_t erts_mseg_default_opt = {
1, /* Use cache */
1, /* Preserv data */
@@ -163,9 +124,7 @@ typedef struct {
CallCounter create;
CallCounter create_resize;
CallCounter destroy;
-#if HAVE_MSEG_RECREATE
CallCounter recreate;
-#endif
CallCounter clear_cache;
CallCounter check_cache;
} ErtsMsegCalls;
@@ -173,7 +132,7 @@ typedef struct {
typedef struct cache_t_ cache_t;
struct cache_t_ {
- Uint size;
+ UWord size;
void *seg;
cache_t *next;
cache_t *prev;
@@ -236,11 +195,6 @@ struct ErtsMsegAllctr_t_ {
Uint rel_max_cache_bad_fit;
ErtsMsegCalls calls;
-
-#if CAN_PARTLY_DESTROY
- Uint min_seg_size;
-#endif
-
};
typedef union {
@@ -344,69 +298,31 @@ schedule_cache_check(ErtsMsegAllctr_t *ma) {
}
}
-/* remove ErtsMsegAllctr_t from arguments?
- * only used for statistics
- */
-static ERTS_INLINE void *
-mmap_align(ErtsMsegAllctr_t *ma, void *addr, size_t length, int prot, int flags, int fd, off_t offset) {
-
- char *p, *q;
- UWord d;
-
- p = mmap(addr, length, prot, flags, fd, offset);
-
- if (MAP_IS_ALIGNED(p) || p == MAP_FAILED)
- return p;
-
- if (ma)
- INC_CC(ma, create_resize);
-
- munmap(p, length);
-
- if ((p = mmap(addr, length + MSEG_ALIGNED_SIZE, prot, flags, fd, offset)) == MAP_FAILED)
- return MAP_FAILED;
-
- q = (void *)ALIGNED_CEILING((char *)p);
- d = (UWord)(q - p);
-
- if (d > 0)
- munmap(p, d);
-
- if (MSEG_ALIGNED_SIZE - d > 0)
- munmap((void *)(q + length), MSEG_ALIGNED_SIZE - d);
-
- return q;
-}
+/* #define ERTS_PRINT_ERTS_MMAP */
static ERTS_INLINE void *
-mseg_create(ErtsMsegAllctr_t *ma, MemKind* mk, Uint size)
+mseg_create(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, UWord *sizep)
{
+#ifdef ERTS_PRINT_ERTS_MMAP
+ UWord req_size = *sizep;
+#endif
void *seg;
- ASSERT(size % MSEG_ALIGNED_SIZE == 0);
-
+ Uint32 mmap_flags = 0;
#if HALFWORD_HEAP
- 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);
- return NULL;
- }
- } else
+ mmap_flags |= ((mk == &ma->low_mem)
+ ? ERTS_MMAPFLG_SUPERCARRIER_ONLY
+ : ERTS_MMAPFLG_OS_ONLY);
#endif
- {
-#if HAVE_MMAP
- {
- seg = (void *) mmap_align(ma, (void *) 0, (size_t) size,
- MMAP_PROT, MMAP_FLAGS, MMAP_FD, 0);
- if (seg == (void *) MAP_FAILED)
- seg = NULL;
-
- ASSERT(MAP_IS_ALIGNED(seg) || !seg);
- }
-#else
-# error "Missing mseg_create() implementation"
+ if (MSEG_FLG_IS_2POW(flags))
+ mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
+
+ seg = erts_mmap(mmap_flags, sizep);
+
+#ifdef ERTS_PRINT_ERTS_MMAP
+ erts_fprintf(stderr, "%p = erts_mmap(%s, {%bpu, %bpu});\n", seg,
+ (mmap_flags & ERTS_MMAPFLG_SUPERALIGNED) ? "sa" : "sua",
+ req_size, *sizep);
#endif
- }
INC_CC(ma, create);
@@ -414,91 +330,55 @@ mseg_create(ErtsMsegAllctr_t *ma, MemKind* mk, Uint size)
}
static ERTS_INLINE void
-mseg_destroy(ErtsMsegAllctr_t *ma, MemKind* mk, void *seg, Uint size) {
- ERTS_DECLARE_DUMMY(int res);
-
+mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *seg_p, UWord size) {
+
+ Uint32 mmap_flags = 0;
#if HALFWORD_HEAP
- if (mk == &ma->low_mem) {
- res = pmunmap((void *) seg, size);
- }
- else
+ mmap_flags |= ((mk == &ma->low_mem)
+ ? ERTS_MMAPFLG_SUPERCARRIER_ONLY
+ : ERTS_MMAPFLG_OS_ONLY);
#endif
- {
-#ifdef HAVE_MMAP
- res = munmap((void *) seg, size);
-#else
-# error "Missing mseg_destroy() implementation"
+ if (MSEG_FLG_IS_2POW(flags))
+ mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
+
+ erts_munmap(mmap_flags, seg_p, size);
+#ifdef ERTS_PRINT_ERTS_MMAP
+ erts_fprintf(stderr, "erts_munmap(%s, %p, %bpu);\n",
+ (mmap_flags & ERTS_MMAPFLG_SUPERALIGNED) ? "sa" : "sua",
+ seg_p, *size);
#endif
- }
-
- ASSERT(size % MSEG_ALIGNED_SIZE == 0);
- ASSERT(res == 0);
-
INC_CC(ma, destroy);
}
-#if HAVE_MSEG_RECREATE
-#if defined(__NetBSD__)
-#define MREMAP_FLAGS (0)
-#else
-#define MREMAP_FLAGS (MREMAP_MAYMOVE)
-#endif
-
-
-/* mseg_recreate
- * May return *unaligned* segments as in address not aligned to MSEG_ALIGNMENT
- * it is still page aligned
- *
- * This is fine for single block carriers as long as we don't cache misaligned
- * segments (since multiblock carriers may use them)
- *
- * For multiblock carriers we *need* MSEG_ALIGNMENT but mbc's will never be
- * reallocated.
- *
- * This should probably be fixed the following way:
- * 1) Use an option to segment allocation - NEED_ALIGNMENT
- * 2) Add mremap_align which takes care of aligning a new a mremaped area
- * 3) Fix the cache to handle of aligned and unaligned segments
- */
-
static ERTS_INLINE void *
-mseg_recreate(ErtsMsegAllctr_t *ma, MemKind* mk, void *old_seg, Uint old_size, Uint new_size)
+mseg_recreate(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *old_seg, UWord old_size, UWord *sizep)
{
+#ifdef ERTS_PRINT_ERTS_MMAP
+ UWord req_size = *sizep;
+#endif
void *new_seg;
-
- ASSERT(old_size % MSEG_ALIGNED_SIZE == 0);
- ASSERT(new_size % MSEG_ALIGNED_SIZE == 0);
-
+ Uint32 mmap_flags = 0;
#if HALFWORD_HEAP
- if (mk == &ma->low_mem) {
- new_seg = (void *) pmremap((void *) old_seg,
- (size_t) old_size,
- (size_t) new_size);
- }
- else
+ mmap_flags |= ((mk == &ma->low_mem)
+ ? ERTS_MMAPFLG_SUPERCARRIER_ONLY
+ : ERTS_MMAPFLG_OS_ONLY);
#endif
- {
-#if HAVE_MREMAP
-#if defined(__NetBSD__)
- new_seg = mremap(old_seg, (size_t)old_size, NULL, new_size, MREMAP_FLAGS);
-#else
- new_seg = mremap(old_seg, (size_t)old_size, (size_t)new_size, MREMAP_FLAGS);
-#endif
- if (new_seg == (void *) MAP_FAILED)
- new_seg = NULL;
-#else
-#error "Missing mseg_recreate() implementation"
-#endif
- }
+ if (MSEG_FLG_IS_2POW(flags))
+ mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
+ new_seg = erts_mremap(mmap_flags, old_seg, old_size, sizep);
+
+#ifdef ERTS_PRINT_ERTS_MMAP
+ erts_fprintf(stderr, "%p = erts_mremap(%s, %p, %bpu, {%bpu, %bpu});\n",
+ new_seg, (mmap_flags & ERTS_MMAPFLG_SUPERALIGNED) ? "sa" : "sua",
+ old_seg, old_size, req_size, *sizep);
+#endif
INC_CC(ma, recreate);
return new_seg;
}
-#endif /* #if HAVE_MSEG_RECREATE */
-
#ifdef DEBUG
#define ERTS_DBG_MA_CHK_THR_ACCESS(MA) \
do { \
@@ -528,7 +408,7 @@ static ERTS_INLINE void mseg_cache_clear_node(cache_t *c) {
c->prev = c;
}
-static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, Uint size, Uint flags) {
+static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, Uint flags) {
cache_t *c;
ERTS_DBG_MK_CHK_THR_ACCESS(mk);
@@ -566,14 +446,13 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, Uint size, Ui
return 1;
} else if (!MSEG_FLG_IS_2POW(flags) && !erts_circleq_is_empty(&(mk->cache_unpowered_node))) {
-
/* No free slots.
* Evict oldest slot from unpowered cache so we can cache an unpowered (sbc) segment */
c = erts_circleq_tail(&(mk->cache_unpowered_node));
erts_circleq_remove(c);
- mseg_destroy(mk->ma, mk, c->seg, c->size);
+ mseg_destroy(mk->ma, ERTS_MSEG_FLG_NONE, mk, c->seg, c->size);
mseg_cache_clear_node(c);
c->seg = seg;
@@ -599,7 +478,8 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, Uint size, Ui
c = erts_circleq_tail(&(mk->cache_powered_node[i]));
erts_circleq_remove(c);
- mseg_destroy(mk->ma, mk, c->seg, c->size);
+ mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, c->seg, c->size);
+
mseg_cache_clear_node(c);
c->seg = seg;
@@ -614,18 +494,18 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, Uint size, Ui
return 0;
}
-static ERTS_INLINE void *cache_get_segment(MemKind *mk, Uint *size_p, Uint flags) {
+static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flags) {
- Uint size = *size_p;
+ UWord size = *size_p;
ERTS_DBG_MK_CHK_THR_ACCESS(mk);
if (MSEG_FLG_IS_2POW(flags)) {
int i, ix = SIZE_TO_CACHE_AREA_IDX(size);
- void *seg;
+ char *seg;
cache_t *c;
- Uint csize;
+ UWord csize;
ASSERT(IS_2POW(size));
@@ -641,7 +521,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, Uint *size_p, Uint flags
ASSERT(MAP_IS_ALIGNED(c->seg));
csize = c->size;
- seg = c->seg;
+ seg = (char*) c->seg;
mk->cache_size--;
mk->cache_hits++;
@@ -652,9 +532,8 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, Uint *size_p, Uint flags
ASSERT(!(mk->cache_size < 0));
- if (csize != size) {
- mseg_destroy(mk->ma, mk, (char *)seg + size, csize - size);
- }
+ if (csize != size)
+ mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, seg + size, csize - size);
return seg;
}
@@ -663,10 +542,10 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, Uint *size_p, Uint flags
void *seg;
cache_t *c;
cache_t *best = NULL;
- Uint bdiff = 0;
- Uint csize;
- Uint bad_max_abs = mk->ma->abs_max_cache_bad_fit;
- Uint bad_max_rel = mk->ma->rel_max_cache_bad_fit;
+ UWord bdiff = 0;
+ UWord csize;
+ UWord bad_max_abs = mk->ma->abs_max_cache_bad_fit;
+ UWord bad_max_rel = mk->ma->rel_max_cache_bad_fit;
erts_circleq_foreach(c, &(mk->cache_unpowered_node)) {
csize = c->size;
@@ -728,7 +607,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, Uint *size_p, Uint flags
* using callbacks from aux-work in the scheduler.
*/
-static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, cache_t *head) {
+static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, Uint flags, cache_t *head) {
cache_t *c = NULL;
c = erts_circleq_tail(head);
@@ -737,7 +616,7 @@ static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, cache_t *h
if (erts_mtrace_enabled)
erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg);
- mseg_destroy(mk->ma, mk, c->seg, c->size);
+ mseg_destroy(mk->ma, flags, mk, c->seg, c->size);
mseg_cache_clear_node(c);
erts_circleq_push_head(&(mk->cache_free), c);
@@ -749,7 +628,7 @@ static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, cache_t *h
return mk->cache_size;
}
-static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, cache_t *head) {
+static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, Uint flags, cache_t *head) {
cache_t *c = NULL;
while (!erts_circleq_is_empty(head)) {
@@ -760,7 +639,7 @@ static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, cache_t *head)
if (erts_mtrace_enabled)
erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg);
- mseg_destroy(mk->ma, mk, c->seg, c->size);
+ mseg_destroy(mk->ma, flags, mk, c->seg, c->size);
mseg_cache_clear_node(c);
erts_circleq_push_head(&(mk->cache_free), c);
@@ -788,11 +667,11 @@ static Uint mseg_check_memkind_cache(MemKind *mk) {
for (i = 0; i < CACHE_AREAS; i++) {
if (!erts_circleq_is_empty(&(mk->cache_powered_node[i])))
- return mseg_drop_one_memkind_cache_size(mk, &(mk->cache_powered_node[i]));
+ return mseg_drop_one_memkind_cache_size(mk, ERTS_MSEG_FLG_2POW, &(mk->cache_powered_node[i]));
}
if (!erts_circleq_is_empty(&(mk->cache_unpowered_node)))
- return mseg_drop_one_memkind_cache_size(mk, &(mk->cache_unpowered_node));
+ return mseg_drop_one_memkind_cache_size(mk, ERTS_MSEG_FLG_NONE, &(mk->cache_unpowered_node));
return 0;
}
@@ -851,12 +730,12 @@ static void mseg_clear_memkind_cache(MemKind *mk) {
if (erts_circleq_is_empty(&(mk->cache_powered_node[i])))
continue;
- mseg_drop_memkind_cache_size(mk, &(mk->cache_powered_node[i]));
+ mseg_drop_memkind_cache_size(mk, ERTS_MSEG_FLG_2POW, &(mk->cache_powered_node[i]));
ASSERT(erts_circleq_is_empty(&(mk->cache_powered_node[i])));
}
/* drop varied caches */
if (!erts_circleq_is_empty(&(mk->cache_unpowered_node)))
- mseg_drop_memkind_cache_size(mk, &(mk->cache_unpowered_node));
+ mseg_drop_memkind_cache_size(mk, ERTS_MSEG_FLG_NONE, &(mk->cache_unpowered_node));
ASSERT(erts_circleq_is_empty(&(mk->cache_unpowered_node)));
ASSERT(mk->cache_size == 0);
@@ -896,36 +775,35 @@ static ERTS_INLINE MemKind* memkind(ErtsMsegAllctr_t *ma,
}
static void *
-mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, Uint *size_p,
+mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, UWord *size_p,
Uint flags, const ErtsMsegOpt_t *opt)
{
- Uint size;
+ UWord size;
void *seg;
MemKind* mk = memkind(ma, opt);
INC_CC(ma, alloc);
- /* Carrier align */
- size = ALIGNED_CEILING(*size_p);
-
- /* Cache optim (if applicable) */
- if (MSEG_FLG_IS_2POW(flags) && !IS_2POW(size))
- size = ceil_2pow(size);
+ if (!MSEG_FLG_IS_2POW(flags))
+ size = ERTS_PAGEALIGNED_CEILING(*size_p);
+ else {
+ size = ALIGNED_CEILING(*size_p);
+ if (!IS_2POW(size)) {
+ /* Cache optim (if applicable) */
+ size = ceil_2pow(size);
+ }
+ }
-#if CAN_PARTLY_DESTROY
- if (size < ma->min_seg_size)
- ma->min_seg_size = size;
-#endif
-
if (opt->cache && mk->cache_size > 0 && (seg = cache_get_segment(mk, &size, flags)) != NULL)
goto done;
- if ((seg = mseg_create(ma, mk, size)) == NULL)
- size = 0;
+ seg = mseg_create(ma, flags, mk, &size);
+ if (!seg)
+ *size_p = 0;
+ else {
done:
- *size_p = size;
- if (seg) {
+ *size_p = size;
if (erts_mtrace_enabled)
erts_mtrace_crr_alloc(seg, atype, ERTS_MTRACE_SEGMENT_ID, size);
@@ -937,7 +815,7 @@ done:
static void
-mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, Uint size,
+mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, UWord size,
Uint flags, const ErtsMsegOpt_t *opt)
{
MemKind* mk = memkind(ma, opt);
@@ -952,7 +830,7 @@ mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, Uint size,
if (erts_mtrace_enabled)
erts_mtrace_crr_free(atype, SEGTYPE, seg);
- mseg_destroy(ma, mk, seg, size);
+ mseg_destroy(ma, flags, mk, seg, size);
done:
@@ -961,11 +839,11 @@ done:
static void *
mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg,
- Uint old_size, Uint *new_size_p, Uint flags, const ErtsMsegOpt_t *opt)
+ UWord old_size, UWord *new_size_p, Uint flags, const ErtsMsegOpt_t *opt)
{
MemKind* mk;
void *new_seg;
- Uint new_size;
+ UWord new_size;
/* Just allocate a new segment if we didn't have one before */
if (!seg || !old_size) {
@@ -985,90 +863,47 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg,
mk = memkind(ma, opt);
new_seg = seg;
- /* Carrier align */
- new_size = ALIGNED_CEILING(*new_size_p);
-
- /* Cache optim (if applicable) */
- if (MSEG_FLG_IS_2POW(flags) && !IS_2POW(new_size))
- new_size = ceil_2pow(new_size);
-
- if (new_size == old_size)
- ;
- else if (new_size < old_size) {
- Uint shrink_sz = old_size - new_size;
+ if (!MSEG_FLG_IS_2POW(flags))
+ new_size = ERTS_PAGEALIGNED_CEILING(*new_size_p);
+ else {
+ new_size = ALIGNED_CEILING(*new_size_p);
+ if (!IS_2POW(new_size)) {
+ /* Cache optim (if applicable) */
+ new_size = ceil_2pow(new_size);
+ }
+ }
-#if CAN_PARTLY_DESTROY
- if (new_size < ma->min_seg_size)
- ma->min_seg_size = new_size;
-#endif
- /* +M<S>rsbcst <ratio> */
- if (shrink_sz < opt->abs_shrink_th
- && 100*shrink_sz < opt->rel_shrink_th*old_size) {
- new_size = old_size;
+ if (new_size > old_size) {
+ if (opt->preserv) {
+ new_seg = mseg_recreate(ma, flags, mk, (void *) seg, old_size, &new_size);
+ if (!new_seg)
+ new_size = old_size;
}
else {
-
-#if CAN_PARTLY_DESTROY
-
- if (erts_mtrace_enabled)
- erts_mtrace_crr_realloc(new_seg, atype, SEGTYPE, seg, new_size);
-
- mseg_destroy(ma, mk, ((char *) seg) + new_size, shrink_sz);
-
-#elif HAVE_MSEG_RECREATE
- goto do_recreate;
-#else
+ mseg_dealloc(ma, atype, seg, old_size, flags, opt);
new_seg = mseg_alloc(ma, atype, &new_size, flags, opt);
-
- ASSERT(MAP_IS_ALIGNED(new_seg) || !new_seg);
-
if (!new_seg)
- new_size = old_size;
- else {
- sys_memcpy(((char *) new_seg),
- ((char *) seg),
- MIN(new_size, old_size));
- mseg_dealloc(ma, atype, seg, old_size, flags, opt);
- }
-#endif
+ new_size = 0;
}
}
- else {
+ else if (new_size < old_size) {
+ UWord shrink_sz = old_size - new_size;
- if (!opt->preserv) {
- mseg_dealloc(ma, atype, seg, old_size, flags, opt);
- new_seg = mseg_alloc(ma, atype, &new_size, flags, opt);
- ASSERT(MAP_IS_ALIGNED(new_seg) || !new_seg);
+ /* +M<S>rsbcst <ratio> */
+ if (shrink_sz < opt->abs_shrink_th
+ && 100*shrink_sz < opt->rel_shrink_th*old_size) {
+ new_size = old_size;
}
else {
-#if HAVE_MSEG_RECREATE
-#if !CAN_PARTLY_DESTROY
- do_recreate:
-#endif
- new_seg = mseg_recreate(ma, mk, (void *) seg, old_size, new_size);
- /* ASSERT(MAP_IS_ALIGNED(new_seg) || !new_seg);
- * will not always be aligned and it ok for now
- */
-
- if (erts_mtrace_enabled)
- erts_mtrace_crr_realloc(new_seg, atype, SEGTYPE, seg, new_size);
+ new_seg = mseg_recreate(ma, flags, mk, (void *) seg, old_size, &new_size);
if (!new_seg)
new_size = old_size;
-#else
- new_seg = mseg_alloc(ma, atype, &new_size, flags, opt);
-
- ASSERT(MAP_IS_ALIGNED(new_seg) || !new_seg);
-
- if (!new_seg)
- new_size = old_size;
- else {
- sys_memcpy(((char *) new_seg), ((char *) seg), MIN(new_size, old_size));
- mseg_dealloc(ma, atype, seg, old_size, flags, opt);
- }
-#endif
}
}
+ if (erts_mtrace_enabled)
+ erts_mtrace_crr_realloc(new_seg, atype, SEGTYPE, seg, new_size);
+
INC_CC(ma, realloc);
ASSERT(!MSEG_FLG_IS_2POW(flags) || IS_2POW(new_size));
@@ -1106,9 +941,7 @@ static struct {
Eterm mseg_create;
Eterm mseg_create_resize;
Eterm mseg_destroy;
-#if HAVE_MSEG_RECREATE
Eterm mseg_recreate;
-#endif
Eterm mseg_clear_cache;
Eterm mseg_check_cache;
@@ -1129,8 +962,6 @@ init_atoms(ErtsMsegAllctr_t *ma)
#ifdef DEBUG
Eterm *atom;
#endif
-
- ERTS_MSEG_UNLOCK(ma);
erts_mtx_lock(&init_atoms_mutex);
if (!atoms_initialized) {
@@ -1163,9 +994,7 @@ init_atoms(ErtsMsegAllctr_t *ma)
AM_INIT(mseg_create);
AM_INIT(mseg_create_resize);
AM_INIT(mseg_destroy);
-#if HAVE_MSEG_RECREATE
AM_INIT(mseg_recreate);
-#endif
AM_INIT(mseg_clear_cache);
AM_INIT(mseg_check_cache);
@@ -1176,7 +1005,6 @@ init_atoms(ErtsMsegAllctr_t *ma)
#endif
}
- ERTS_MSEG_LOCK(ma);
atoms_initialized = 1;
erts_mtx_unlock(&init_atoms_mutex);
}
@@ -1239,7 +1067,9 @@ info_options(ErtsMsegAllctr_t *ma,
Uint **hpp,
Uint *szp)
{
- Eterm res = THE_NON_VALUE;
+ Eterm res;
+
+ res = erts_mmap_info_options(prefix, print_to_p, print_to_arg, hpp, szp);
if (print_to_p) {
int to = *print_to_p;
@@ -1254,7 +1084,6 @@ info_options(ErtsMsegAllctr_t *ma,
if (!atoms_initialized)
init_atoms(ma);
- res = NIL;
add_2tup(hpp, szp, &res,
am.mcs,
bld_uint(hpp, szp, ma->max_cache_size));
@@ -1293,9 +1122,7 @@ info_calls(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp
PRINT_CC(to, arg, create);
PRINT_CC(to, arg, create_resize);
PRINT_CC(to, arg, destroy);
-#if HAVE_MSEG_RECREATE
PRINT_CC(to, arg, recreate);
-#endif
PRINT_CC(to, arg, clear_cache);
PRINT_CC(to, arg, check_cache);
@@ -1316,12 +1143,10 @@ info_calls(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp
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, 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, ma->calls.destroy.giga_no),
@@ -1465,14 +1290,8 @@ erts_mseg_info_options(int ix,
ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_IX(ix);
Eterm res;
- ERTS_MSEG_LOCK(ma);
-
- ERTS_DBG_MA_CHK_THR_ACCESS(ma);
-
res = info_options(ma, "option ", print_to_p, print_to_arg, hpp, szp);
- ERTS_MSEG_UNLOCK(ma);
-
return res;
}
@@ -1490,10 +1309,6 @@ erts_mseg_info(int ix,
Eterm values[4];
Uint n = 0;
- ERTS_MSEG_LOCK(ma);
-
- ERTS_DBG_MA_CHK_THR_ACCESS(ma);
-
if (hpp || szp) {
if (!atoms_initialized)
@@ -1506,6 +1321,10 @@ erts_mseg_info(int ix,
}
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);
+
+ ERTS_MSEG_LOCK(ma);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
+
#if HALFWORD_HEAP
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);
@@ -1521,7 +1340,7 @@ erts_mseg_info(int ix,
}
void *
-erts_mseg_alloc_opt(ErtsAlcType_t atype, Uint *size_p, Uint flags, const ErtsMsegOpt_t *opt)
+erts_mseg_alloc_opt(ErtsAlcType_t atype, UWord *size_p, Uint flags, const ErtsMsegOpt_t *opt)
{
ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt);
void *seg;
@@ -1529,20 +1348,23 @@ erts_mseg_alloc_opt(ErtsAlcType_t atype, Uint *size_p, Uint flags, const ErtsMse
ERTS_DBG_MA_CHK_THR_ACCESS(ma);
seg = mseg_alloc(ma, atype, size_p, flags, opt);
ERTS_MSEG_UNLOCK(ma);
+ HARD_DBG_INSERT_MSEG(seg, *size_p);
return seg;
}
void *
-erts_mseg_alloc(ErtsAlcType_t atype, Uint *size_p, Uint flags)
+erts_mseg_alloc(ErtsAlcType_t atype, UWord *size_p, Uint flags)
{
return erts_mseg_alloc_opt(atype, size_p, flags, &erts_mseg_default_opt);
}
void
erts_mseg_dealloc_opt(ErtsAlcType_t atype, void *seg,
- Uint size, Uint flags, const ErtsMsegOpt_t *opt)
+ UWord size, Uint flags, const ErtsMsegOpt_t *opt)
{
ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt);
+
+ HARD_DBG_REMOVE_MSEG(seg, size);
ERTS_MSEG_LOCK(ma);
ERTS_DBG_MA_CHK_THR_ACCESS(ma);
mseg_dealloc(ma, atype, seg, size, flags, opt);
@@ -1550,29 +1372,32 @@ erts_mseg_dealloc_opt(ErtsAlcType_t atype, void *seg,
}
void
-erts_mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size, Uint flags)
+erts_mseg_dealloc(ErtsAlcType_t atype, void *seg, UWord size, Uint flags)
{
erts_mseg_dealloc_opt(atype, seg, size, flags, &erts_mseg_default_opt);
}
void *
erts_mseg_realloc_opt(ErtsAlcType_t atype, void *seg,
- Uint old_size, Uint *new_size_p,
+ UWord old_size, UWord *new_size_p,
Uint flags,
const ErtsMsegOpt_t *opt)
{
ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt);
void *new_seg;
+
+ HARD_DBG_REMOVE_MSEG(seg, old_size);
ERTS_MSEG_LOCK(ma);
ERTS_DBG_MA_CHK_THR_ACCESS(ma);
new_seg = mseg_realloc(ma, atype, seg, old_size, new_size_p, flags, opt);
ERTS_MSEG_UNLOCK(ma);
+ HARD_DBG_INSERT_MSEG(new_seg, *new_size_p);
return new_seg;
}
void *
erts_mseg_realloc(ErtsAlcType_t atype, void *seg,
- Uint old_size, Uint *new_size_p, Uint flags)
+ UWord old_size, UWord *new_size_p, Uint flags)
{
return erts_mseg_realloc_opt(atype, seg, old_size, new_size_p,
flags, &erts_mseg_default_opt);
@@ -1662,16 +1487,17 @@ erts_mseg_init(ErtsMsegInit_t *init)
erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms");
-#if HAVE_MMAP && !defined(MAP_ANON)
- mmap_fd = open("/dev/zero", O_RDWR);
- if (mmap_fd < 0)
- erl_exit(ERTS_ABORT_EXIT, "erts_mseg: unable to open /dev/zero\n");
-#endif
+#if HALFWORD_HEAP
+ if (sizeof(void *) != 8)
+ erl_exit(-1,"Halfword emulator cannot be run in 32bit mode");
-#if HAVE_MMAP && HALFWORD_HEAP
- initialize_pmmap();
+ init->mmap.virtual_range.start = (char *) sbrk(0);
+ init->mmap.virtual_range.end = (char *) 0x100000000UL;
+ init->mmap.sco = 0;
#endif
+ erts_mmap_init(&init->mmap);
+
if (!IS_2POW(GET_PAGE_SIZE))
erl_exit(ERTS_ABORT_EXIT, "erts_mseg: Unexpected page_size %beu\n", GET_PAGE_SIZE);
@@ -1712,10 +1538,6 @@ erts_mseg_init(ErtsMsegInit_t *init)
#endif
sys_memzero((void *) &ma->calls, sizeof(ErtsMsegCalls));
-
-#if CAN_PARTLY_DESTROY
- ma->min_seg_size = ~((Uint) 0);
-#endif
}
}
@@ -1757,7 +1579,7 @@ erts_mseg_test(UWord op, UWord a1, UWord a2, UWord a3)
case 0x400: /* Have erts_mseg */
return (UWord) 1;
case 0x401:
- return (UWord) erts_mseg_alloc(ERTS_ALC_A_INVALID, (Uint *) a1, (Uint) 0);
+ return (UWord) erts_mseg_alloc(ERTS_ALC_A_INVALID, (UWord *) a1, (Uint) 0);
case 0x402:
erts_mseg_dealloc(ERTS_ALC_A_INVALID, (void *) a1, (Uint) a2, (Uint) 0);
return (UWord) 0;
@@ -1765,7 +1587,7 @@ erts_mseg_test(UWord op, UWord a1, UWord a2, UWord a3)
return (UWord) erts_mseg_realloc(ERTS_ALC_A_INVALID,
(void *) a1,
(Uint) a2,
- (Uint *) a3,
+ (UWord *) a3,
(Uint) 0);
case 0x404:
erts_mseg_clear_cache();
@@ -1788,405 +1610,3 @@ erts_mseg_test(UWord op, UWord a1, UWord a2, UWord a3)
}
}
-
-
-#if HALFWORD_HEAP
-/*
- * Very simple page oriented mmap replacer. Works in the lower
- * 32 bit address range of a 64bit program.
- * Implements anonymous mmap mremap and munmap with address order first fit.
- * The free list is expected to be very short...
- * To be used for compressed pointers in Erlang halfword emulator
- * implementation. The MacOS X version is more of a toy, it's not really
- * for production as the halfword erlang VM relies on Linux specific memory
- * mapping tricks.
- */
-
-/* #define HARDDEBUG 1 */
-
-#ifdef HARDDEBUG
-static void dump_freelist(void)
-{
- FreeBlock *p = first;
-
- while (p) {
- fprintf(stderr, "p = %p\r\np->num = %ld\r\np->next = %p\r\n\r\n",
- (void *) p, (unsigned long) p->num, (void *) p->next);
- p = p->next;
- }
-}
-
-#define HARDDEBUG_HW_INCOMPLETE_ALIGNMENT(PTR, SZ) \
- fprintf(stderr,"Mapping of address %p with size %ld " \
- "does not map complete pages (%s:%d)\r\n", \
- (void *) (PTR), (unsigned long) (SZ),__FILE__, __LINE__)
-
-#define HARDDEBUG_HW_UNALIGNED_ALIGNMENT(PTR, SZ) \
- fprintf(stderr,"Mapping of address %p with size %ld " \
- "is not page aligned (%s:%d)\r\n", \
- (void *) (PTR), (unsigned long) (SZ),__FILE__, __LINE__)
-
-#define HARDDEBUG_MAP_FAILED(PTR, SZ) \
- fprintf(stderr, "Could not actually map memory " \
- "at address %p with size %ld (%s:%d) ..\r\n", \
- (void *) (PTR), (unsigned long) (SZ),__FILE__, __LINE__)
-#else
-#define HARDDEBUG_HW_INCOMPLETE_ALIGNMENT(PTR, SZ) do{}while(0)
-#define HARDDEBUG_HW_UNALIGNED_ALIGNMENT(PTR, SZ) do{}while(0)
-#define HARDDEBUG_MAP_FAILED(PTR, SZ) do{}while(0)
-#endif
-
-
-#ifdef __APPLE__
-#define MAP_ANONYMOUS MAP_ANON
-#endif
-
-#define INIT_LOCK() do {erts_mtx_init(&pmmap_mutex, "pmmap");} while(0)
-
-#define TAKE_LOCK() do {erts_mtx_lock(&pmmap_mutex);} while(0)
-
-#define RELEASE_LOCK() do {erts_mtx_unlock(&pmmap_mutex);} while(0)
-
-static erts_mtx_t pmmap_mutex; /* Also needed when !USE_THREADS */
-
-typedef struct _free_block {
- unsigned long num; /*pages*/
- struct _free_block *next;
-} FreeBlock;
-
-/* Protect with lock */
-static FreeBlock *first;
-
-static void *do_map(void *ptr, size_t sz)
-{
- void *res;
-
- if (ALIGNED_CEILING(sz) != sz) {
- HARDDEBUG_HW_INCOMPLETE_ALIGNMENT(ptr, sz);
- return NULL;
- }
-
- if (((unsigned long) ptr) % MSEG_ALIGNED_SIZE) {
- HARDDEBUG_HW_UNALIGNED_ALIGNMENT(ptr, sz);
- return NULL;
- }
-
-#if HAVE_MMAP
- res = mmap(ptr, sz,
- PROT_READ | PROT_WRITE, MAP_PRIVATE |
- MAP_ANONYMOUS | MAP_FIXED,
- -1 , 0);
-#else
-# error "Missing mmap support"
-#endif
-
- if (res == MAP_FAILED) {
- HARDDEBUG_MAP_FAILED(ptr, sz);
- return NULL;
- }
-
- return res;
-}
-
-static int do_unmap(void *ptr, size_t sz)
-{
- void *res;
-
- if (ALIGNED_CEILING(sz) != sz) {
- HARDDEBUG_HW_INCOMPLETE_ALIGNMENT(ptr, sz);
- return 1;
- }
-
- if (((unsigned long) ptr) % MSEG_ALIGNED_SIZE) {
- HARDDEBUG_HW_UNALIGNED_ALIGNMENT(ptr, sz);
- return 1;
- }
-
- res = mmap(ptr, sz,
- PROT_NONE, MAP_PRIVATE | MAP_ANONYMOUS | MAP_NORESERVE | MAP_FIXED,
- -1 , 0);
-
- if (res == MAP_FAILED) {
- HARDDEBUG_MAP_FAILED(ptr, sz);
- return 1;
- }
-
- return 0;
-}
-
-#ifdef __APPLE__
-/*
- * The first 4 gig's are protected on Macos X for 64bit processes :(
- * The range 0x1000000000 - 0x10FFFFFFFF is selected as an arbitrary
- * value of a normally unused range... Real MMAP's will avoid
- * it and all 32bit compressed pointers can be in that range...
- * More expensive than on Linux where expansion of compressed
- * poiters involves no masking (as they are in the first 4 gig's).
- * It's also very uncertain if the MAP_NORESERVE flag really has
- * any effect in MacOS X. Swap space may always be allocated...
- */
-#define SET_RANGE_MIN() /* nothing */
-#define RANGE_MIN 0x1000000000UL
-#define RANGE_MAX 0x1100000000UL
-#define RANGE_MASK (RANGE_MIN)
-#define EXTRA_MAP_FLAGS (MAP_FIXED)
-#else
-static size_t range_min;
-#define SET_RANGE_MIN() do { range_min = (size_t) sbrk(0); } while (0)
-#define RANGE_MIN range_min
-#define RANGE_MAX 0x100000000UL
-#define RANGE_MASK 0UL
-#define EXTRA_MAP_FLAGS (0)
-#endif
-
-static int initialize_pmmap(void)
-{
- char *p,*q,*rptr;
- size_t rsz;
- FreeBlock *initial;
-
- SET_RANGE_MIN();
- if (sizeof(void *) != 8) {
- erl_exit(1,"Halfword emulator cannot be run in 32bit mode");
- }
-
- p = (char *) RANGE_MIN;
- q = (char *) RANGE_MAX;
-
- rsz = ALIGNED_FLOOR(q - p);
-
- rptr = mmap_align(NULL, (void *) p, rsz,
- PROT_NONE, MAP_PRIVATE | MAP_ANONYMOUS |
- MAP_NORESERVE | EXTRA_MAP_FLAGS,
- -1 , 0);
-#ifdef HARDDEBUG
- printf("p=%p, rsz = %ld, pages = %ld, got range = %p -> %p\r\n",
- p, (unsigned long) rsz, (unsigned long) (rsz / MSEG_ALIGNED_SIZE),
- (void *) rptr, (void*)(rptr + rsz));
-#endif
- if ((UWord)(rptr + rsz) > RANGE_MAX) {
- size_t rsz_trunc = RANGE_MAX - (UWord)rptr;
-#ifdef HARDDEBUG
- printf("Reducing mmap'ed memory from %lu to %lu Mb, reduced range = %p -> %p\r\n",
- rsz/(1024*1024), rsz_trunc/(1024*1024), rptr, rptr+rsz_trunc);
-#endif
- munmap((void*)RANGE_MAX, rsz - rsz_trunc);
- rsz = rsz_trunc;
- }
- if (!do_map(rptr, MSEG_ALIGNED_SIZE)) {
- erl_exit(1,"Could not actually mmap first page for halfword emulator...\n");
- }
- initial = (FreeBlock *) rptr;
- initial->num = (rsz / MSEG_ALIGNED_SIZE);
- initial->next = NULL;
- first = initial;
- INIT_LOCK();
- return 0;
-}
-
-static void *pmmap(size_t size)
-{
- size_t real_size = ALIGNED_CEILING(size);
- size_t num_pages = real_size / MSEG_ALIGNED_SIZE;
- FreeBlock **block;
- FreeBlock *tail;
- FreeBlock *res;
-
- TAKE_LOCK();
-
- for (block = &first;
- *block != NULL && (*block)->num < num_pages;
- block = &((*block)->next))
- ;
- if (!(*block)) {
- RELEASE_LOCK();
- return NULL;
- }
- if ((*block)->num == num_pages) {
- /* nice, perfect fit */
- res = *block;
- *block = (*block)->next;
- } else {
- tail = (FreeBlock *) (((char *) ((void *) (*block))) + real_size);
- if (!do_map(tail, MSEG_ALIGNED_SIZE)) {
- HARDDEBUG_MAP_FAILED(tail, MSEG_ALIGNED_SIZE);
- RELEASE_LOCK();
- return NULL;
- }
- tail->num = (*block)->num - num_pages;
- tail->next = (*block)->next;
- res = *block;
- *block = tail;
- }
-
- RELEASE_LOCK();
-
- if (!do_map(res, real_size)) {
- HARDDEBUG_MAP_FAILED(res, real_size);
- return NULL;
- }
-
- return (void *) res;
-}
-
-static int pmunmap(void *p, size_t size)
-{
- size_t real_size = ALIGNED_CEILING(size);
- size_t num_pages = real_size / MSEG_ALIGNED_SIZE;
-
- FreeBlock *block;
- FreeBlock *last;
- FreeBlock *nb = (FreeBlock *) p;
-
- ASSERT(((unsigned long)p & CHECK_POINTER_MASK)==0);
-
- if (real_size > MSEG_ALIGNED_SIZE) {
- if (do_unmap(((char *) p) + MSEG_ALIGNED_SIZE, real_size - MSEG_ALIGNED_SIZE)) {
- return 1;
- }
- }
-
- TAKE_LOCK();
-
- last = NULL;
- block = first;
- while(block != NULL && ((void *) block) < p) {
- last = block;
- block = block->next;
- }
-
- if (block != NULL &&
- ((void *) block) == ((void *) (((char *) p) + real_size))) {
- /* Merge new free block with following */
- nb->num = block->num + num_pages;
- nb->next = block->next;
- if (do_unmap(block, MSEG_ALIGNED_SIZE)) {
- RELEASE_LOCK();
- return 1;
- }
- } else {
- /* just link in */
- nb->num = num_pages;
- nb->next = block;
- }
- if (last != NULL) {
- if (p == ((void *) (((char *) last) + (last->num * MSEG_ALIGNED_SIZE)))) {
- /* Merge with previous */
- last->num += nb->num;
- last->next = nb->next;
- if (do_unmap(nb, MSEG_ALIGNED_SIZE)) {
- RELEASE_LOCK();
- return 1;
- }
- } else {
- last->next = nb;
- }
- } else {
- first = nb;
- }
- RELEASE_LOCK();
- return 0;
-}
-
-static void *pmremap(void *old_address, size_t old_size,
- size_t new_size)
-{
- size_t new_real_size = ALIGNED_CEILING(new_size);
- size_t new_num_pages = new_real_size / MSEG_ALIGNED_SIZE;
- size_t old_real_size = ALIGNED_CEILING(old_size);
- size_t old_num_pages = old_real_size / MSEG_ALIGNED_SIZE;
- if (new_num_pages == old_num_pages) {
- return old_address;
- } else if (new_num_pages < old_num_pages) { /* Shrink */
- size_t nfb_pages = old_num_pages - new_num_pages;
- size_t nfb_real_size = old_real_size - new_real_size;
- void *vnfb = (void *) (((char *)old_address) + new_real_size);
- FreeBlock *nfb = (FreeBlock *) vnfb;
- FreeBlock **block;
- TAKE_LOCK();
- for (block = &first;
- *block != NULL && (*block) < nfb;
- block = &((*block)->next))
- ;
- if (!(*block) ||
- (*block) > ((FreeBlock *)(((char *) vnfb) + nfb_real_size))) {
- /* Normal link in */
- if (nfb_pages > 1) {
- if (do_unmap((void *)(((char *) vnfb) + MSEG_ALIGNED_SIZE),
- (nfb_pages - 1)*MSEG_ALIGNED_SIZE)) {
- return NULL;
- }
- }
- nfb->next = (*block);
- nfb->num = nfb_pages;
- (*block) = nfb;
- } else { /* block merge */
- nfb->next = (*block)->next;
- nfb->num = nfb_pages + (*block)->num;
- /* unmap also the first page of the next freeblock */
- (*block) = nfb;
- if (do_unmap((void *)(((char *) vnfb) + MSEG_ALIGNED_SIZE),
- nfb_pages*MSEG_ALIGNED_SIZE)) {
- return NULL;
- }
- }
- RELEASE_LOCK();
- return old_address;
- } else { /* Enlarge */
- FreeBlock **block;
- void *old_end = (void *) (((char *)old_address) + old_real_size);
- TAKE_LOCK();
- for (block = &first;
- *block != NULL && (*block) < (FreeBlock *) old_address;
- block = &((*block)->next))
- ;
- if ((*block) == NULL || old_end > ((void *) RANGE_MAX) ||
- (*block) != old_end ||
- (*block)->num < (new_num_pages - old_num_pages)) {
- /* cannot extend */
- void *result;
- RELEASE_LOCK();
- result = pmmap(new_size);
- if (result == NULL) {
- return NULL;
- }
- memcpy(result,old_address,old_size);
- if (pmunmap(old_address,old_size)) {
- /* Oups... */
- pmunmap(result,new_size);
- return NULL;
- }
- return result;
- } else { /* extend */
- size_t remaining_pages = (*block)->num -
- (new_num_pages - old_num_pages);
- if (!remaining_pages) {
- void *p = (void *) (((char *) (*block)) + MSEG_ALIGNED_SIZE);
- void *n = (*block)->next;
- size_t x = ((*block)->num - 1) * MSEG_ALIGNED_SIZE;
- if (x > 0) {
- if (do_map(p,x) == NULL) {
- RELEASE_LOCK();
- return NULL;
- }
- }
- (*block) = n;
- } else {
- FreeBlock *nfb = (FreeBlock *) ((void *)
- (((char *) old_address) +
- new_real_size));
- void *p = (void *) (((char *) (*block)) + MSEG_ALIGNED_SIZE);
- if (do_map(p,new_real_size - old_real_size) == NULL) {
- RELEASE_LOCK();
- return NULL;
- }
- nfb->num = remaining_pages;
- nfb->next = (*block)->next;
- (*block) = nfb;
- }
- RELEASE_LOCK();
- return old_address;
- }
- }
-}
-#endif /* HALFWORD_HEAP */
diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h
index a1b000f51c..2284b3f8f1 100644
--- a/erts/emulator/sys/common/erl_mseg.h
+++ b/erts/emulator/sys/common/erl_mseg.h
@@ -22,15 +22,16 @@
#include "sys.h"
#include "erl_alloc_types.h"
+#include "erl_mmap.h"
-#ifndef HAVE_MMAP
-# define HAVE_MMAP 0
-#endif
-#ifndef HAVE_MREMAP
-# define HAVE_MREMAP 0
-#endif
-
-#if HAVE_MMAP
+/*
+ * We currently only enable mseg_alloc if we got
+ * a genuine mmap()/munmap() primitive. It is possible
+ * to utilize erts_mmap() withiout a mmap support but
+ * alloc_util needs to be prepared before we can do
+ * that.
+ */
+#ifdef ERTS_HAVE_GENUINE_OS_MMAP
# define HAVE_ERTS_MSEG 1
# define ERTS_HAVE_MSEG_SUPER_ALIGNED 1
#else
@@ -39,8 +40,7 @@
#endif
#if ERTS_HAVE_MSEG_SUPER_ALIGNED
-# define MSEG_ALIGN_BITS (18)
- /* Affects hard limits for sbct and lmbcs documented in erts_alloc.xml */
+# define MSEG_ALIGN_BITS ERTS_MMAP_SUPERALIGNED_BITS
#else
/* If we don't use super aligned multiblock carriers
* we will mmap with page size alignment (and thus use corresponding
@@ -68,6 +68,7 @@ typedef struct {
Uint rmcbf;
Uint mcs;
Uint nos;
+ ErtsMMapInit mmap;
} ErtsMsegInit_t;
#define ERTS_MSEG_INIT_DEFAULT_INITIALIZER \
@@ -75,7 +76,8 @@ typedef struct {
4*1024*1024, /* amcbf: Absolute max cache bad fit */ \
20, /* rmcbf: Relative max cache bad fit */ \
10, /* mcs: Max cache size */ \
- 1000 /* cci: Cache check interval */ \
+ 1000, /* cci: Cache check interval */ \
+ ERTS_MMAP_INIT_DEFAULT_INITER \
}
typedef struct {
@@ -91,12 +93,12 @@ typedef struct {
extern const ErtsMsegOpt_t erts_mseg_default_opt;
-void *erts_mseg_alloc(ErtsAlcType_t, Uint *, Uint);
-void *erts_mseg_alloc_opt(ErtsAlcType_t, Uint *, Uint, const ErtsMsegOpt_t *);
-void erts_mseg_dealloc(ErtsAlcType_t, void *, Uint, Uint);
-void erts_mseg_dealloc_opt(ErtsAlcType_t, void *, Uint, Uint, const ErtsMsegOpt_t *);
-void *erts_mseg_realloc(ErtsAlcType_t, void *, Uint, Uint *, Uint);
-void *erts_mseg_realloc_opt(ErtsAlcType_t, void *, Uint, Uint *, Uint, const ErtsMsegOpt_t *);
+void *erts_mseg_alloc(ErtsAlcType_t, UWord *, Uint);
+void *erts_mseg_alloc_opt(ErtsAlcType_t, UWord *, Uint, const ErtsMsegOpt_t *);
+void erts_mseg_dealloc(ErtsAlcType_t, void *, UWord, Uint);
+void erts_mseg_dealloc_opt(ErtsAlcType_t, void *, UWord, Uint, const ErtsMsegOpt_t *);
+void *erts_mseg_realloc(ErtsAlcType_t, void *, UWord, UWord *, Uint);
+void *erts_mseg_realloc_opt(ErtsAlcType_t, void *, UWord, UWord *, Uint, const ErtsMsegOpt_t *);
void erts_mseg_clear_cache(void);
void erts_mseg_cache_check(void);
Uint erts_mseg_no( const ErtsMsegOpt_t *);
diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c
index fdc3167c62..401b37b9d2 100644
--- a/erts/emulator/sys/unix/sys.c
+++ b/erts/emulator/sys/unix/sys.c
@@ -2638,15 +2638,13 @@ int fd;
}
-#ifdef DEBUG
-
extern int erts_initialized;
void
-erl_assert_error(char* expr, char* file, int line)
+erl_assert_error(const char* expr, const char* func, const char* file, int line)
{
fflush(stdout);
- fprintf(stderr, "Assertion failed: %s in %s, line %d\n",
- expr, file, line);
+ fprintf(stderr, "%s:%d:%s() Assertion failed: %s\n",
+ file, line, func, expr);
fflush(stderr);
#if !defined(ERTS_SMP) && 0
/* Writing a crashdump from a failed assertion when smp support
@@ -2661,6 +2659,8 @@ erl_assert_error(char* expr, char* file, int line)
abort();
}
+#ifdef DEBUG
+
void
erl_debug(char* fmt, ...)
{
diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c
index 6a1d6b08f4..99951bb45e 100755
--- a/erts/emulator/sys/win32/sys.c
+++ b/erts/emulator/sys/win32/sys.c
@@ -3224,7 +3224,7 @@ erl_bin_write(buf, sz, max)
}
void
-erl_assert_error(char* expr, char* file, int line)
+erl_assert_error(const char* expr, const char* func, const char* file, int line)
{
char message[1024];
diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl
index 801ed0f85a..f6ff6bb813 100644
--- a/erts/emulator/test/alloc_SUITE.erl
+++ b/erts/emulator/test/alloc_SUITE.erl
@@ -29,6 +29,7 @@
bucket_mask/1,
rbtree/1,
mseg_clear_cache/1,
+ erts_mmap/1,
cpool/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
@@ -41,7 +42,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[basic, coalesce, threads, realloc_copy, bucket_index,
- bucket_mask, rbtree, mseg_clear_cache, cpool].
+ bucket_mask, rbtree, mseg_clear_cache, erts_mmap, cpool].
groups() ->
[].
@@ -110,6 +111,59 @@ cpool(suite) -> [];
cpool(doc) -> [];
cpool(Cfg) -> ?line drv_case(Cfg).
+erts_mmap(Config) when is_list(Config) ->
+ case {?t:os_type(), is_halfword_vm()} of
+ {{unix, _}, false} ->
+ [erts_mmap_do(Config, SCO, SCRPM, SCMGC)
+ || SCO <-[true,false], SCMGC <-[1234,0], SCRPM <- [true,false]];
+
+ {_,true} ->
+ {skipped, "No supercarrier support on halfword vm"};
+ {SkipOs,_} ->
+ ?line {skipped,
+ lists:flatten(["Not run on "
+ | io_lib:format("~p",[SkipOs])])}
+ end.
+
+
+erts_mmap_do(Config, SCO, SCRPM, SCMGC) ->
+ SCS = 100, % Mb
+ O1 = "+MMscs" ++ integer_to_list(SCS)
+ ++ " +MMsco" ++ atom_to_list(SCO)
+ ++ " +MMscrpm" ++ atom_to_list(SCRPM),
+ Opts = case SCMGC of
+ 0 -> O1;
+ _ -> O1 ++ " +MMscmgc"++integer_to_list(SCMGC)
+ end,
+ {ok, Node} = start_node(Config, Opts),
+ Self = self(),
+ Ref = make_ref(),
+ F = fun () ->
+ SI = erlang:system_info({allocator,mseg_alloc}),
+ {erts_mmap,EM} = lists:keyfind(erts_mmap, 1, SI),
+ {supercarrier,SC} = lists:keyfind(supercarrier, 1, EM),
+ {sizes,Sizes} = lists:keyfind(sizes, 1, SC),
+ {free_segs,Segs} = lists:keyfind(free_segs,1,SC),
+ {total,Total} = lists:keyfind(total,1,Sizes),
+ Total = SCS*1024*1024,
+
+ {reserved,Reserved} = lists:keyfind(reserved,1,Segs),
+ true = (Reserved >= SCMGC),
+
+ case {SCO,lists:keyfind(os,1,EM)} of
+ {true, false} -> ok;
+ {false, {os,_}} -> ok
+ end,
+
+ Self ! {Ref, ok}
+ end,
+
+ spawn_link(Node, F),
+ Result = receive {Ref, Rslt} -> Rslt end,
+ stop_node(Node),
+ Result.
+
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% %%
%% Internal functions %%
@@ -179,7 +233,9 @@ receive_drv_result(Port, CaseName) ->
?line {comment, Comment}
end.
-start_node(Config) when is_list(Config) ->
+start_node(Config) ->
+ start_node(Config, []).
+start_node(Config, Opts) when is_list(Config), is_list(Opts) ->
?line Pa = filename:dirname(code:which(?MODULE)),
?line {A, B, C} = now(),
?line Name = list_to_atom(atom_to_list(?MODULE)
@@ -191,7 +247,14 @@ start_node(Config) when is_list(Config) ->
++ integer_to_list(B)
++ "-"
++ integer_to_list(C)),
- ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa}]).
+ ?line ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]).
stop_node(Node) ->
?t:stop_node(Node).
+
+is_halfword_vm() ->
+ case {erlang:system_info({wordsize, internal}),
+ erlang:system_info({wordsize, external})} of
+ {4, 8} -> true;
+ {WS, WS} -> false
+ end.
diff --git a/erts/emulator/test/big_SUITE_data/eq_big.dat b/erts/emulator/test/big_SUITE_data/eq_big.dat
index 5511d1bf10..4ccb33d182 100644
--- a/erts/emulator/test/big_SUITE_data/eq_big.dat
+++ b/erts/emulator/test/big_SUITE_data/eq_big.dat
@@ -13001,4 +13001,5 @@
0 = 7153697524993 bsr 475833444444444444444444444444444444444444444444.
-1 = -83987348 bsr 475833444444444444444444444444444444444444444444.
+0 = 1183140560213014108063589658350 bsr 146783911423364576743092537299333564210980159306769991919205685720763064069663027716481187399048043939495935.
diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl
index eaecd32f95..ef1f2aa04c 100644
--- a/erts/emulator/test/call_trace_SUITE.erl
+++ b/erts/emulator/test/call_trace_SUITE.erl
@@ -1193,7 +1193,7 @@ bs_sum_b(Acc, <<>>) -> Acc.
-
+
%%% Help functions.
expect() ->
diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl
index 104bdf8aec..7087542899 100644
--- a/erts/emulator/test/driver_SUITE.erl
+++ b/erts/emulator/test/driver_SUITE.erl
@@ -367,7 +367,7 @@ compare(Got, Expected) ->
?t:fail(got_bad_data)
end.
-
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Driver timer test suites
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -515,7 +515,7 @@ try_change_timer(Port, Timeout) ->
?line test_server:fail("driver failed to timeout")
end.
-
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Queue test suites
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -719,7 +719,7 @@ deq(Port, Size) ->
read_head(Port, Size) ->
erlang:port_control(Port, ?READ_HEAD, <<Size:32>>).
-
+
driver_unloaded(doc) ->
[];
driver_unloaded(suite) ->
diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl
index a93dd309c1..c428be6c5a 100644
--- a/erts/emulator/test/statistics_SUITE.erl
+++ b/erts/emulator/test/statistics_SUITE.erl
@@ -75,7 +75,7 @@ end_per_group(_GroupName, Config) ->
Config.
-
+
%%% Testing statistics(wall_clock).
@@ -121,7 +121,7 @@ wall_clock_update1(N) when N > 0 ->
wall_clock_update1(0) ->
ok.
-
+
%%% Test statistics(runtime).
@@ -199,7 +199,7 @@ do_much(N) ->
_ = 4784728478274827 * 72874284728472,
do_much(N-1).
-
+
reductions(doc) ->
"Test that statistics(reductions) is callable, and that "
"Total_Reductions and Reductions_Since_Last_Call make sense. "
@@ -246,7 +246,7 @@ reductions_big_loop() ->
reductions_big_loop()
end.
-
+
%%% Tests of statistics(run_queue).
@@ -295,7 +295,7 @@ hog_iter(N, Mon) when N > 0 ->
end;
hog_iter(0, Mon) ->
?line hog_iter(10000, Mon).
-
+
%%% Tests of statistics(scheduler_wall_time).
scheduler_wall_time(doc) ->
@@ -363,7 +363,7 @@ load_percentage([{Id, WN, TN}|Ss], [{Id, WP, TP}|Ps]) ->
[100*(WN-WP) div (TN-TP)|load_percentage(Ss, Ps)];
load_percentage([], []) -> [].
-
+
garbage_collection(doc) ->
"Tests that statistics(garbage_collection) is callable. "
"It is not clear how to test anything more.";
diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl
index 4d12e3449c..a0a8a9c42c 100644
--- a/erts/emulator/test/time_SUITE.erl
+++ b/erts/emulator/test/time_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2013. 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
@@ -241,14 +241,26 @@ compare(Utc0, Local) ->
%% Two linear times can be subtracted to give their difference
%% in seconds.
%%
-%% XXX Limitations: The length of months and leap years are not
-%% taken into account; thus a comparision of dates is only
-%% valid if they are in the SAME month.
+%% XXX Limitations: Simplified leap year calc will fail for 2100 :-)
linear_time({{Year, Mon, Day}, {Hour, Min, Sec}}) ->
- 86400*(366*Year + 31*(Mon-1) + (Day-1)) +
+ 86400*(year_to_days(Year) + month_to_days(Year,Mon) + (Day-1)) +
3600*Hour + 60*Min + Sec.
+year_to_days(Year) ->
+ Year * 365 + (Year-1) div 4.
+
+month_to_days(Year, Mon) ->
+ DoM = [31,days_in_february(Year),31,30,31,30,31,31,30,31,30,31],
+ {PastMonths,_} = lists:split(Mon-1, DoM),
+ lists:sum(PastMonths).
+
+days_in_february(Year) ->
+ case (Year rem 4) of
+ 0 -> 29;
+ _ -> 28
+ end.
+
%% This functions returns either the normal timezone or the
%% the DST timezone, depending on the given UTC time.
%%
diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl
index 0f513f0dcb..2251575e5a 100644
--- a/erts/emulator/test/trace_SUITE.erl
+++ b/erts/emulator/test/trace_SUITE.erl
@@ -1427,7 +1427,7 @@ receive_nothing() ->
ok
end.
-
+
%%% Models for various kinds of processes.
process(Dest) ->
diff --git a/erts/emulator/test/trace_port_SUITE.erl b/erts/emulator/test/trace_port_SUITE.erl
index cc2eadafbc..99df8da107 100644
--- a/erts/emulator/test/trace_port_SUITE.erl
+++ b/erts/emulator/test/trace_port_SUITE.erl
@@ -648,7 +648,7 @@ fun_spawn(Fun, Opts) ->
% []
% end.
-
+
%%% Models for various kinds of processes.
%% Sends messages when ordered to.
diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c
index 30560f5a2f..c9908caf20 100644
--- a/erts/etc/common/erlexec.c
+++ b/erts/etc/common/erlexec.c
@@ -109,6 +109,10 @@ static char *plusM_other_switches[] = {
"Mamcbf",
"Mrmcbf",
"Mmcs",
+ "Mscs",
+ "Mscmgc",
+ "Msco",
+ "Mscrpm",
"Ye",
"Ym",
"Ytp",
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index f1791200e0..5a9ffa89d1 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
Binary files differ
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index d40ee7c59a..2b6760c675 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -3499,6 +3499,8 @@ mk_res_list([]) ->
mk_res_list([Alloc | Rest]) ->
[{Alloc, []} | mk_res_list(Rest)].
+insert_instance(I, N, Rest) when erlang:is_atom(N) ->
+ [{N, I} | Rest];
insert_instance(I, N, []) ->
[{instance, N, I}];
insert_instance(I, N, [{instance, M, _}|_] = Rest) when N < M ->
diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile
index 3f24e15c04..500f4a1358 100644
--- a/lib/asn1/src/Makefile
+++ b/lib/asn1/src/Makefile
@@ -135,7 +135,7 @@ $(EBIN)/asn1ct_func.$(EMULATOR): asn1ct_func.erl
asn1ct_eval_%.erl: asn1ct_eval_%.funcs
$(gen_verbose)erl -pa $(EBIN) -noshell -noinput \
- -run prepare_templates gen_asn1ct_eval $< >$@
+ -run prepare_templates gen_asn1ct_eval $<
$(APP_TARGET): $(APP_SRC) ../vsn.mk
$(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
@@ -180,7 +180,7 @@ RT_TEMPLATES_TARGET = $(RT_TEMPLATES:%=%.$(EMULATOR))
asn1ct_rtt.erl: prepare_templates.$(EMULATOR) $(RT_TEMPLATES_TARGET)
$(gen_verbose)erl -noshell -noinput -run prepare_templates gen_asn1ct_rtt \
- $(RT_TEMPLATES_TARGET) >asn1ct_rtt.erl
+ $(RT_TEMPLATES_TARGET)
prepare_templates.$(EMULATOR): prepare_templates.erl
$(V_ERLC) prepare_templates.erl
diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl
index eddcda0018..04227fd23b 100644
--- a/lib/asn1/src/asn1ct_check.erl
+++ b/lib/asn1/src/asn1ct_check.erl
@@ -2534,89 +2534,54 @@ normalize_integer(S,Int=#'Externalvaluereference'{value=Name},Type) ->
normalize_integer(_,Int,_) ->
exit({'Unknown INTEGER value',Int}).
-normalize_bitstring(S,Value,Type)->
- %% There are four different Erlang formats of BIT STRING:
- %% 1 - a list of ones and zeros.
- %% 2 - a list of atoms.
- %% 3 - as an integer, for instance in hexadecimal form.
- %% 4 - as a tuple {Unused, Binary} where Unused is an integer
- %% and tells how many bits of Binary are unused.
- %%
- %% normalize_bitstring/3 transforms Value according to:
- %% A to 3,
- %% B to 1,
- %% C to 1 or 3
- %% D to 2,
- %% Value can be on format:
- %% A - {hstring, String}, where String is a hexadecimal string.
- %% B - {bstring, String}, where String is a string on bit format
- %% C - #'Externalvaluereference'{value=V}, where V is a defined value
- %% D - list of #'Externalvaluereference', where each value component
- %% is an identifier corresponing to NamedBits in Type.
- %% E - list of ones and zeros, if Value already is normalized.
+%% normalize_bitstring(S, Value, Type) -> bitstring()
+%% Convert a literal value for a BIT STRING to an Erlang bit string.
+%%
+normalize_bitstring(S, Value, Type)->
case Value of
{hstring,String} when is_list(String) ->
- hstring_to_int(String);
+ hstring_to_bitstring(String);
{bstring,String} when is_list(String) ->
- bstring_to_bitlist(String);
- Rec when is_record(Rec,'Externalvaluereference') ->
- get_normalized_value(S,Value,Type,
- fun normalize_bitstring/3,[]);
+ bstring_to_bitstring(String);
+ #'Externalvaluereference'{} ->
+ get_normalized_value(S, Value, Type,
+ fun normalize_bitstring/3, []);
RecList when is_list(RecList) ->
- case Type of
- NBL when is_list(NBL) ->
- F = fun(#'Externalvaluereference'{value=Name}) ->
- case lists:keysearch(Name,1,NBL) of
- {value,{Name,_}} ->
- Name;
- Other ->
- throw({error,Other})
- end;
- (I) when I =:= 1; I =:= 0 ->
- I;
- (Other) ->
- throw({error,Other})
- end,
- case catch lists:map(F,RecList) of
- {error,Reason} ->
- asn1ct:warning("default value not "
- "compatible with type definition ~p~n",
- [Reason],S,
- "default value not "
- "compatible with type definition"),
- Value;
- NewList ->
- NewList
- end;
- _ ->
+ F = fun(#'Externalvaluereference'{value=Name}) ->
+ case lists:keymember(Name, 1, Type) of
+ true -> Name;
+ false -> throw({error,false})
+ end;
+ (Name) when is_atom(Name) ->
+ %% Already normalized.
+ Name;
+ (Other) ->
+ throw({error,Other})
+ end,
+ try
+ lists:map(F, RecList)
+ catch
+ throw:{error,Reason} ->
asn1ct:warning("default value not "
"compatible with type definition ~p~n",
- [RecList],S,
+ [Reason],S,
"default value not "
"compatible with type definition"),
Value
end;
- {Name,String} when is_atom(Name) ->
- normalize_bitstring(S,String,Type);
- Other ->
- asn1ct:warning("illegal default value ~p~n",[Other],S,
- "illegal default value"),
- Value
+ Bs when is_bitstring(Bs) ->
+ %% Already normalized.
+ Bs
end.
-hstring_to_int(L) when is_list(L) ->
- hstring_to_int(L,0).
-hstring_to_int([H|T],Acc) when H >= $A, H =< $F ->
- hstring_to_int(T,(Acc bsl 4) + (H - $A + 10) ) ;
-hstring_to_int([H|T],Acc) when H >= $0, H =< $9 ->
- hstring_to_int(T,(Acc bsl 4) + (H - $0));
-hstring_to_int([],Acc) ->
- Acc.
+hstring_to_bitstring(L) ->
+ << <<(hex_to_int(D)):4>> || D <- L >>.
-bstring_to_bitlist([H|T]) when H == $0; H == $1 ->
- [H - $0 | bstring_to_bitlist(T)];
-bstring_to_bitlist([]) ->
- [].
+bstring_to_bitstring(L) ->
+ << <<(D-$0):1>> || D <- L >>.
+
+hex_to_int(D) when $0 =< D, D =< $9 -> D - $0;
+hex_to_int(D) when $A =< D, D =< $F -> D - ($A - 10).
%% normalize_octetstring/1 changes representation of input Value to a
%% list of octets.
diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
index 8359b81b33..a38da8bcc2 100644
--- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
+++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
@@ -1155,7 +1155,8 @@ gen_dec_line(Erules,TopType,Cname,CTags,Type,OptOrMand,DecObjInf) ->
emit([indent(4),"_ ->",nl]),
case OptOrMand of
- {'DEFAULT', Def} ->
+ {'DEFAULT', Def0} ->
+ Def = asn1ct_gen:conform_value(Type, Def0),
emit([indent(8),"{",{asis,Def},",",{prev,tlv},"}",nl]);
'OPTIONAL' ->
emit([indent(8),"{ asn1_NOVALUE, ",{prev,tlv},"}",nl])
diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl
index 8d4afc0a0b..4672f7edd3 100644
--- a/lib/asn1/src/asn1ct_constructed_per.erl
+++ b/lib/asn1/src/asn1ct_constructed_per.erl
@@ -770,8 +770,10 @@ optionals(L) -> optionals(L,[],2).
optionals([#'ComponentType'{prop='OPTIONAL'}|Rest], Acc, Pos) ->
optionals(Rest, [Pos|Acc], Pos+1);
-optionals([#'ComponentType'{prop={'DEFAULT',Val}}|Rest], Acc, Pos) ->
- optionals(Rest, [{Pos,Val}|Acc], Pos+1);
+optionals([#'ComponentType'{typespec=T,prop={'DEFAULT',Val}}|Rest],
+ Acc, Pos) ->
+ Vals = def_values(T, Val),
+ optionals(Rest, [{Pos,Vals}|Acc], Pos+1);
optionals([#'ComponentType'{}|Rest], Acc, Pos) ->
optionals(Rest, Acc, Pos+1);
optionals([], Acc, _) ->
@@ -888,7 +890,8 @@ gen_enc_components_call1(Erule,TopType,
optional ->
asn1ct_imm:enc_absent(Element, [asn1_NOVALUE], Imm1);
{default,Def} ->
- asn1ct_imm:enc_absent(Element, [asn1_DEFAULT,Def], Imm1)
+ DefValues = def_values(Type, Def),
+ asn1ct_imm:enc_absent(Element, DefValues, Imm1)
end,
Imm = case Imm2 of
[] -> [];
@@ -899,6 +902,38 @@ gen_enc_components_call1(_Erule,_TopType,[],Pos,_,_, Acc) ->
ImmList = lists:reverse(Acc),
{ImmList,Pos}.
+def_values(#type{def=#'Externaltypereference'{module=Mod,type=Type}}, Def) ->
+ #typedef{typespec=T} = asn1_db:dbget(Mod, Type),
+ def_values(T, Def);
+def_values(#type{def={'BIT STRING',[]}}, Bs) when is_bitstring(Bs) ->
+ ListBs = [B || <<B:1>> <= Bs],
+ IntBs = lists:foldl(fun(B, A) ->
+ (A bsl 1) bor B
+ end, 0, lists:reverse(ListBs)),
+ Sz = bit_size(Bs),
+ Compact = case 8 - Sz rem 8 of
+ 8 ->
+ {0,Bs};
+ Unused ->
+ {Unused,<<Bs:Sz/bits,0:Unused>>}
+ end,
+ [asn1_DEFAULT,Bs,Compact,ListBs,IntBs];
+def_values(#type{def={'BIT STRING',[_|_]=Ns}}, List) when is_list(List) ->
+ Bs = asn1ct_gen:named_bitstring_value(List, Ns),
+ ListBs = [B || <<B:1>> <= Bs],
+ IntBs = lists:foldl(fun(B, A) ->
+ (A bsl 1) bor B
+ end, 0, lists:reverse(ListBs)),
+ Args = [List,Bs,ListBs,IntBs],
+ {call,per_common,is_default_bitstring,Args};
+def_values(#type{def={'INTEGER',Ns}}, Def) ->
+ [asn1_DEFAULT,Def|case lists:keyfind(Def, 2, Ns) of
+ false -> [];
+ {Val,Def} -> [Val]
+ end];
+def_values(_, Def) ->
+ [asn1_DEFAULT,Def].
+
gen_enc_line_imm(Erule, TopType, Cname, Type, Element, DynamicEnc, Ext) ->
Imm0 = gen_enc_line_imm_1(Erule, TopType, Cname, Type,
Element, DynamicEnc),
@@ -1207,7 +1242,8 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj,
comp_call_pre_post(noext, mandatory, _, _, _, _, _, _) ->
{[],[]};
-comp_call_pre_post(noext, Prop, _, _, TextPos, OptTable, NumOptionals, Ext) ->
+comp_call_pre_post(noext, Prop, _, Type, TextPos,
+ OptTable, NumOptionals, Ext) ->
%% OPTIONAL or DEFAULT
OptPos = get_optionality_pos(TextPos, OptTable),
Element = case NumOptionals - OptPos of
@@ -1225,7 +1261,7 @@ comp_call_pre_post(noext, Prop, _, _, TextPos, OptTable, NumOptionals, Ext) ->
emit([";",nl,
"0 ->",nl,
"{"]),
- gen_dec_component_no_val(Ext, Prop),
+ gen_dec_component_no_val(Ext, Type, Prop),
emit([",",{curr,bytes},"}",nl,
"end"]),
St
@@ -1247,10 +1283,10 @@ comp_call_pre_post({ext,_,_}, Prop, Pos, Type, _, _, _, Ext) ->
components=ExtGroupCompList2}}
when is_integer(Number2)->
emit("{extAddGroup,"),
- gen_dec_extaddGroup_no_val(Ext, ExtGroupCompList2),
+ gen_dec_extaddGroup_no_val(Ext, Type, ExtGroupCompList2),
emit("}");
_ ->
- gen_dec_component_no_val(Ext, Prop)
+ gen_dec_component_no_val(Ext, Type, Prop)
end,
emit([",",{curr,bytes},"}",nl,
"end"]),
@@ -1265,21 +1301,22 @@ is_mandatory_predef_tab_c(_, _, {"got objfun through args","ObjFun"}) ->
is_mandatory_predef_tab_c(_,_,_) ->
true.
-gen_dec_extaddGroup_no_val(Ext,[#'ComponentType'{prop=Prop}])->
- gen_dec_component_no_val(Ext,Prop),
+gen_dec_extaddGroup_no_val(Ext, Type, [#'ComponentType'{prop=Prop}])->
+ gen_dec_component_no_val(Ext, Type, Prop),
ok;
-gen_dec_extaddGroup_no_val(Ext,[#'ComponentType'{prop=Prop}|Rest])->
- gen_dec_component_no_val(Ext,Prop),
- emit({","}),
- gen_dec_extaddGroup_no_val(Ext,Rest);
-gen_dec_extaddGroup_no_val(_, []) ->
+gen_dec_extaddGroup_no_val(Ext, Type, [#'ComponentType'{prop=Prop}|Rest])->
+ gen_dec_component_no_val(Ext, Type, Prop),
+ emit(","),
+ gen_dec_extaddGroup_no_val(Ext, Type, Rest);
+gen_dec_extaddGroup_no_val(_, _, []) ->
ok.
-gen_dec_component_no_val(_,{'DEFAULT',DefVal}) ->
+gen_dec_component_no_val(_, Type, {'DEFAULT',DefVal0}) ->
+ DefVal = asn1ct_gen:conform_value(Type, DefVal0),
emit([{asis,DefVal}]);
-gen_dec_component_no_val(_,'OPTIONAL') ->
+gen_dec_component_no_val(_, _, 'OPTIONAL') ->
emit({"asn1_NOVALUE"});
-gen_dec_component_no_val({ext,_,_},mandatory) ->
+gen_dec_component_no_val({ext,_,_}, _, mandatory) ->
emit({"asn1_NOVALUE"}).
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl
index 3452d29085..30d337635b 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -33,7 +33,9 @@
insert_once/2,
ct_gen_module/1,
index2suffix/1,
- get_record_name_prefix/0]).
+ get_record_name_prefix/0,
+ conform_value/2,
+ named_bitstring_value/2]).
-export([pgen/5,
mk_var/1,
un_hyphen_var/1]).
@@ -1485,8 +1487,14 @@ gen_prim_check_call(PrimType, Default, Element, Type) ->
end,
check_call(check_int, [Default,Element,{asis,NNL}]);
'BIT STRING' ->
- {_,NBL} = Type#type.def,
- check_call(check_bitstring, [Default,Element,{asis,NBL}]);
+ case Type#type.def of
+ {_,[]} ->
+ check_call(check_bitstring,
+ [Default,Element]);
+ {_,[_|_]=NBL} ->
+ check_call(check_named_bitstring,
+ [Default,Element,{asis,NBL}])
+ end;
'OCTET STRING' ->
check_call(check_octetstring, [Default,Element]);
'NULL' ->
@@ -1640,9 +1648,33 @@ unify_if_string(PrimType) ->
Other -> Other
end.
-
-
-
+conform_value(#type{def={'BIT STRING',[]}}, Bs) ->
+ case asn1ct:get_bit_string_format() of
+ compact when is_binary(Bs) ->
+ {0,Bs};
+ compact when is_bitstring(Bs) ->
+ Sz = bit_size(Bs),
+ Unused = 8 - bit_size(Bs),
+ {Unused,<<Bs:Sz/bits,0:Unused>>};
+ legacy ->
+ [B || <<B:1>> <= Bs];
+ bitstring when is_bitstring(Bs) ->
+ Bs
+ end;
+conform_value(_, Value) -> Value.
+
+named_bitstring_value(List, Names) ->
+ Int = lists:foldl(fun(N, A) ->
+ {N,Pos} = lists:keyfind(N, 1, Names),
+ A bor (1 bsl Pos)
+ end, 0, List),
+ named_bitstring_value_1(<<>>, Int).
+
+named_bitstring_value_1(Bs, 0) ->
+ Bs;
+named_bitstring_value_1(Bs, Int) ->
+ B = Int band 1,
+ named_bitstring_value_1(<<Bs/bitstring,B:1>>, Int bsr 1).
get_inner(A) when is_atom(A) -> A;
get_inner(Ext) when is_record(Ext,'Externaltypereference') -> Ext;
diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl
index 892178f61b..20785cda8c 100644
--- a/lib/asn1/src/asn1ct_imm.erl
+++ b/lib/asn1/src/asn1ct_imm.erl
@@ -319,14 +319,22 @@ per_enc_extensions(Val0, Pos0, NumBits, Aligned) when NumBits > 0 ->
{'cond',[[{eq,Bitmap,0}],
['_'|Length ++ PutBits]],{var,"Extensions"}}].
-per_enc_optional(Val0, {Pos,Def}, _Aligned) when is_integer(Pos) ->
+per_enc_optional(Val0, {Pos,DefVals}, _Aligned) when is_integer(Pos),
+ is_list(DefVals) ->
Val1 = lists:concat(["element(",Pos,", ",Val0,")"]),
{B,[Val]} = mk_vars(Val1, []),
Zero = {put_bits,0,1,[1]},
One = {put_bits,1,1,[1]},
- B++[{'cond',[[{eq,Val,asn1_DEFAULT},Zero],
- [{eq,Val,Def},Zero],
- ['_',One]]}];
+ B++[{'cond',
+ [[{eq,Val,DefVal},Zero] || DefVal <- DefVals] ++ [['_',One]]}];
+per_enc_optional(Val0, {Pos,{call,M,F,A}}, _Aligned) when is_integer(Pos) ->
+ Val1 = lists:concat(["element(",Pos,", ",Val0,")"]),
+ {B,[Val,Tmp]} = mk_vars(Val1, [tmp]),
+ Zero = {put_bits,0,1,[1]},
+ One = {put_bits,1,1,[1]},
+ B++[{call,M,F,[Val|A],Tmp},
+ {'cond',
+ [[{eq,Tmp,true},Zero],['_',One]]}];
per_enc_optional(Val0, Pos, _Aligned) when is_integer(Pos) ->
Val1 = lists:concat(["element(",Pos,", ",Val0,")"]),
{B,[Val]} = mk_vars(Val1, []),
@@ -352,7 +360,12 @@ per_enc_sof(Val0, Constraint, ElementVar, ElementImm, Aligned) ->
PreBlock ++ EncLen ++ Lc
end.
-enc_absent(Val0, AbsVals, Body) ->
+enc_absent(Val0, {call,M,F,A}, Body) ->
+ {B,[Var,Tmp]} = mk_vars(Val0, [tmp]),
+ B++[{call,M,F,[Var|A],Tmp},
+ {'cond',
+ [[{eq,Tmp,true}],['_'|Body]]}];
+enc_absent(Val0, AbsVals, Body) when is_list(AbsVals) ->
{B,[Var]} = mk_vars(Val0, []),
Cs = [[{eq,Var,Aval}] || Aval <- AbsVals] ++ [['_'|Body]],
B++build_cond(Cs).
@@ -994,6 +1007,25 @@ mk_var(Base, V) ->
per_enc_integer_1(Val, [], Aligned) ->
[{'cond',[['_'|per_enc_unconstrained(Val, Aligned)]]}];
+per_enc_integer_1(Val, [{{'SingleValue',[_|_]=Svs}=Constr,[]}], Aligned) ->
+ %% An extensible constraint such as (1|17, ...).
+ %%
+ %% A subtle detail is that the extension root as described in the
+ %% ASN.1 spec should be used to determine whether a particular value
+ %% belongs to the extension root (as opposed to the effective
+ %% constraint, which will be used for the actual encoding).
+ %%
+ %% So for the example above, only the integers 1 and 17 should be
+ %% encoded as root values (extension bit = 0).
+
+ [{'ValueRange',{Lb,Ub}}] = effective_constraint(integer, [Constr]),
+ Root = [begin
+ {[],_,Put} = per_enc_constrained(Sv, Lb, Ub, Aligned),
+ [{eq,Val,Sv},{put_bits,0,1,[1]}|Put]
+ end || Sv <- Svs],
+ Cs = Root ++ [['_',{put_bits,1,1,[1]}|
+ per_enc_unconstrained(Val, Aligned)]],
+ build_cond(Cs);
per_enc_integer_1(Val0, [{{_,_}=Constr,[]}], Aligned) ->
{Prefix,Check,Action} = per_enc_integer_2(Val0, Constr, Aligned),
Prefix++build_cond([[Check,{put_bits,0,1,[1]}|Action],
@@ -1004,7 +1036,7 @@ per_enc_integer_1(Val0, [Constr], Aligned) ->
Prefix++build_cond([[Check|Action],
['_',{error,Val0}]]).
-per_enc_integer_2(Val, {'SingleValue',Sv}, Aligned) ->
+per_enc_integer_2(Val, {'SingleValue',Sv}, Aligned) when is_integer(Sv) ->
per_enc_constrained(Val, Sv, Sv, Aligned);
per_enc_integer_2(Val0, {'ValueRange',{Lb,'MAX'}}, Aligned)
when is_integer(Lb) ->
diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl
index 992210232f..862b3c4ea5 100644
--- a/lib/asn1/src/asn1ct_value.erl
+++ b/lib/asn1/src/asn1ct_value.erl
@@ -167,17 +167,16 @@ from_type_prim(M, D) ->
case D#type.def of
'INTEGER' ->
i_random(C);
- {'INTEGER',NamedNumberList} ->
- NN = [X||{X,_} <- NamedNumberList],
- case NN of
+ {'INTEGER',[_|_]=NNL} ->
+ case C of
[] ->
- i_random(C);
+ {N,_} = lists:nth(random(length(NNL)), NNL),
+ N;
_ ->
- case C of
- [] ->
- lists:nth(random(length(NN)),NN);
- _ ->
- lists:nth((fun(0)->1;(X)->X end(i_random(C))),NN)
+ V = i_random(C),
+ case lists:keyfind(V, 2, NNL) of
+ false -> V;
+ {N,V} -> N
end
end;
Enum when is_tuple(Enum),element(1,Enum)=='ENUMERATED' ->
diff --git a/lib/asn1/src/asn1rtt_check.erl b/lib/asn1/src/asn1rtt_check.erl
index e78b65a8fb..be4f9c8bff 100644
--- a/lib/asn1/src/asn1rtt_check.erl
+++ b/lib/asn1/src/asn1rtt_check.erl
@@ -20,7 +20,7 @@
-export([check_bool/2,
check_int/3,
- check_bitstring/3,
+ check_bitstring/2,check_named_bitstring/3,
check_octetstring/2,
check_null/2,
check_objectidentifier/2,
@@ -50,31 +50,54 @@ check_int(DefValue, Value, NNL) when is_atom(Value) ->
check_int(DefaultValue, _Value, _) ->
throw({error,DefaultValue}).
-%% Two equal lists or integers
-check_bitstring(_, asn1_DEFAULT, _) ->
+%% check_bitstring(Default, UserBitstring) -> true|false
+%% Default = bitstring()
+%% UserBitstring = integeger() | list(0|1) | {Unused,binary()} | bitstring()
+check_bitstring(_, asn1_DEFAULT) ->
true;
-check_bitstring(V, V, _) ->
- true;
-%% Default value as a list of 1 and 0 and user value as an integer
-check_bitstring(L=[H|T], Int, _) when is_integer(Int), is_integer(H) ->
- case bit_list_to_int(L, length(T)) of
- Int -> true;
- _ -> throw({error,L,Int})
+check_bitstring(DefVal, {Unused,Binary}) ->
+ %% User value in compact format.
+ Sz = bit_size(Binary) - Unused,
+ <<Val:Sz/bitstring,_:Unused>> = Binary,
+ check_bitstring(DefVal, Val);
+check_bitstring(DefVal, Val) when is_bitstring(Val) ->
+ case Val =:= DefVal of
+ false -> throw(error);
+ true -> true
end;
-%% Default value as an integer, val as list
-check_bitstring(Int, Val, NBL) when is_integer(Int), is_list(Val) ->
- BL = int_to_bit_list(Int, [], length(Val)),
- check_bitstring(BL, Val, NBL);
+check_bitstring(Def, Val) when is_list(Val) ->
+ check_bitstring_list(Def, Val);
+check_bitstring(Def, Val) when is_integer(Val) ->
+ check_bitstring_integer(Def, Val).
+
+check_bitstring_list(<<H:1,T1/bitstring>>, [H|T2]) ->
+ check_bitstring_list(T1, T2);
+check_bitstring_list(<<>>, []) ->
+ true;
+check_bitstring_list(_, _) ->
+ throw(error).
+
+check_bitstring_integer(<<H:1,T1/bitstring>>, Int) when H =:= Int band 1 ->
+ check_bitstring_integer(T1, Int bsr 1);
+check_bitstring_integer(<<>>, 0) ->
+ true;
+check_bitstring_integer(_, _) ->
+ throw(error).
+
+check_named_bitstring(_, asn1_DEFAULT, _) ->
+ true;
+check_named_bitstring(V, V, _) ->
+ true;
%% Default value and user value as lists of ones and zeros
-check_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL=[_H|_T]) when is_integer(H1), is_integer(H2) ->
+check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL=[_H|_T]) when is_integer(H1), is_integer(H2) ->
L2new = remove_trailing_zeros(L2),
- check_bitstring(L1, L2new, NBL);
+ check_named_bitstring(L1, L2new, NBL);
%% Default value as a list of 1 and 0 and user value as a list of atoms
-check_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_integer(H1), is_atom(H2) ->
+check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_integer(H1), is_atom(H2) ->
L3 = bit_list_to_nbl(L1, NBL, 0, []),
- check_bitstring(L3, L2, NBL);
+ check_named_bitstring(L3, L2, NBL);
%% Both default value and user value as a list of atoms
-check_bitstring(L1=[H1|T1], L2=[H2|_T2], _)
+check_named_bitstring(L1=[H1|T1], L2=[H2|_T2], _)
when is_atom(H1), is_atom(H2), length(L1) =:= length(L2) ->
case lists:member(H1, L2) of
true ->
@@ -82,27 +105,29 @@ check_bitstring(L1=[H1|T1], L2=[H2|_T2], _)
false -> throw({error,L2})
end;
%% Default value as a list of atoms and user value as a list of 1 and 0
-check_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_atom(H1), is_integer(H2) ->
+check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_atom(H1), is_integer(H2) ->
L3 = bit_list_to_nbl(L2, NBL, 0, []),
- check_bitstring(L1, L3, NBL);
+ check_named_bitstring(L1, L3, NBL);
%% User value in compact format
-check_bitstring(DefVal,CBS={_,_}, NBL) ->
+check_named_bitstring(DefVal,CBS={_,_}, NBL) ->
NewVal = cbs_to_bit_list(CBS),
- check_bitstring(DefVal, NewVal, NBL);
-check_bitstring(DV, V, _) ->
+ check_named_bitstring(DefVal, NewVal, NBL);
+%% User value as a binary
+check_named_bitstring(DefVal, CBS, NBL) when is_binary(CBS) ->
+ NewVal = cbs_to_bit_list({0,CBS}),
+ check_named_bitstring(DefVal, NewVal, NBL);
+%% User value as a bitstring
+check_named_bitstring(DefVal, CBS, NBL) when is_bitstring(CBS) ->
+ BitSize = bit_size(CBS),
+ Unused = 8 - (BitSize band 7),
+ NewVal = cbs_to_bit_list({Unused,<<CBS:BitSize/bits,0:Unused>>}),
+ check_named_bitstring(DefVal, NewVal, NBL);
+check_named_bitstring(DV, V, _) ->
throw({error,DV,V}).
-
-bit_list_to_int([0|Bs], ShL)->
- bit_list_to_int(Bs, ShL-1) + 0;
-bit_list_to_int([1|Bs], ShL) ->
- bit_list_to_int(Bs, ShL-1) + (1 bsl ShL);
-bit_list_to_int([], _) ->
- 0.
-
int_to_bit_list(0, Acc, 0) ->
Acc;
-int_to_bit_list(Int, Acc, Len) ->
+int_to_bit_list(Int, Acc, Len) when Len > 0 ->
int_to_bit_list(Int bsr 1, [Int band 1|Acc], Len - 1).
bit_list_to_nbl([0|T], NBL, Pos, Acc) ->
diff --git a/lib/asn1/src/asn1rtt_per_common.erl b/lib/asn1/src/asn1rtt_per_common.erl
index 9e9fd87ec3..3309e6a4ca 100644
--- a/lib/asn1/src/asn1rtt_per_common.erl
+++ b/lib/asn1/src/asn1rtt_per_common.erl
@@ -37,6 +37,7 @@
bitstring_from_positions/1,bitstring_from_positions/2,
to_bitstring/1,to_bitstring/2,
to_named_bitstring/1,to_named_bitstring/2,
+ is_default_bitstring/5,
extension_bitmap/3]).
-define('16K',16384).
@@ -271,6 +272,36 @@ to_named_bitstring(Val, Lb) ->
%% for correctness, not speed.
adjust_trailing_zeroes(to_bitstring(Val), Lb).
+is_default_bitstring(asn1_DEFAULT, _, _, _, _) ->
+ true;
+is_default_bitstring({Unused,Bin}, V0, V1, V2, V3) when is_integer(Unused) ->
+ %% Convert compact bitstring to a bitstring.
+ Sz = bit_size(Bin) - Unused,
+ <<Bs:Sz/bitstring,_:Unused>> = Bin,
+ is_default_bitstring(Bs, V0, V1, V2, V3);
+is_default_bitstring(Named, Named, _, _, _) ->
+ true;
+is_default_bitstring(Bs, _, Bs, _, _) ->
+ true;
+is_default_bitstring(List, _, _, List, _) ->
+ true;
+is_default_bitstring(Int, _, _, _, Int) ->
+ true;
+is_default_bitstring(Val, _, Def, _, _) when is_bitstring(Val) ->
+ Sz = bit_size(Def),
+ case Val of
+ <<Def:Sz/bitstring,T/bitstring>> ->
+ NumZeroes = bit_size(T),
+ case T of
+ <<0:NumZeroes>> -> true;
+ _ -> false
+ end;
+ _ ->
+ false
+ end;
+is_default_bitstring(Val, _, _, List, _) when is_list(Val) ->
+ is_default_bitstring_list(List, Val);
+is_default_bitstring(_, _, _, _, _) -> false.
extension_bitmap(Val, Pos, Limit) ->
extension_bitmap(Val, Pos, Limit, 0).
@@ -447,6 +478,16 @@ ntz(Byte) ->
4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0},
element(Byte+1, T).
+is_default_bitstring_list([H|Def], [H|Val]) ->
+ is_default_bitstring_list(Def, Val);
+is_default_bitstring_list([], []) ->
+ true;
+is_default_bitstring_list([], [_|_]=Val) ->
+ lists:all(fun(0) -> true;
+ (_) -> false
+ end, Val);
+is_default_bitstring_list(_, _) -> false.
+
extension_bitmap(_Val, Pos, Limit, Acc) when Pos >= Limit ->
Acc;
extension_bitmap(Val, Pos, Limit, Acc) ->
diff --git a/lib/asn1/src/prepare_templates.erl b/lib/asn1/src/prepare_templates.erl
index 83155b2e52..ccd15548d8 100644
--- a/lib/asn1/src/prepare_templates.erl
+++ b/lib/asn1/src/prepare_templates.erl
@@ -21,69 +21,77 @@
-export([gen_asn1ct_rtt/1,gen_asn1ct_eval/1]).
gen_asn1ct_rtt(Ms) ->
- io:format("%% Generated by ~s. DO NOT EDIT THIS FILE.\n"
+ {ok,Fd} = file:open("asn1ct_rtt.erl", [write]),
+ io:format(Fd,
+ "%% Generated by ~s. DO NOT EDIT THIS FILE.\n"
"%%\n"
"%% Input files:\n", [?MODULE]),
- [io:put_chars(["%% ",M,$\n]) || M <- Ms],
- io:nl(),
- io:put_chars("-module(asn1ct_rtt).\n"
+ [io:put_chars(Fd, ["%% ",M,$\n]) || M <- Ms],
+ io:nl(Fd),
+ io:put_chars(Fd,
+ "-module(asn1ct_rtt).\n"
"-export([assert_defined/1,dependencies/1,code/0]).\n"
"\n"),
Forms = lists:sort(lists:append([abstract(M) || M <- Ms])),
Exp = lists:sort(exports(Forms)),
- defined(Exp),
- io:nl(),
+ defined(Fd, Exp),
+ io:nl(Fd),
Calls = calls(Forms),
R = sofs:relation(Calls),
Fam0 = sofs:relation_to_family(R),
Fam = sofs:to_external(Fam0),
- dependencies(Fam),
- io:nl(),
+ dependencies(Fd, Fam),
+ io:nl(Fd),
Funcs = [begin
Bin = list_to_binary([$\n|erl_pp:function(Func)]),
{{M,F,A},Bin}
end || {M,{function,_,F,A,_}=Func} <- Forms],
- io:format("code() ->\n~p.\n\n", [Funcs]),
+ io:format(Fd, "code() ->\n~p.\n\n", [Funcs]),
+ ok = file:close(Fd),
halt(0).
gen_asn1ct_eval([File]) ->
+ Output = filename:rootname(File, ".funcs") ++ ".erl",
+ {ok,Fd} = file:open(Output, [write]),
{ok,Funcs} = file:consult(File),
asn1ct_func:start_link(),
[asn1ct_func:need(MFA) || MFA <- Funcs],
- io:format("%% Generated by ~s. DO NOT EDIT THIS FILE.\n"
+ io:format(Fd,
+ "%% Generated by ~s. DO NOT EDIT THIS FILE.\n"
"%%\n"
"%% Input file: ~s\n\n", [?MODULE,File]),
- io:format("-module(~s).\n", [filename:rootname(File)]),
- gen_asn1ct_eval_exp(Funcs),
- asn1ct_func:generate(group_leader()),
+ io:format(Fd, "-module(~s).\n", [filename:rootname(File)]),
+ gen_asn1ct_eval_exp(Fd, Funcs),
+ asn1ct_func:generate(Fd),
+ ok = file:close(Fd),
halt(0).
-gen_asn1ct_eval_exp(Funcs) ->
- io:put_chars("-export(["),
- gen_asn1ct_eval_exp_1(Funcs, ""),
- io:put_chars("]).\n").
+gen_asn1ct_eval_exp(Fd, Funcs) ->
+ io:put_chars(Fd, "-export(["),
+ gen_asn1ct_eval_exp_1(Fd, Funcs, ""),
+ io:put_chars(Fd, "]).\n").
-gen_asn1ct_eval_exp_1([{_,F,A}|T], Sep) ->
- io:put_chars(Sep),
- io:format("~p/~p", [F,A]),
- gen_asn1ct_eval_exp_1(T, ",\n");
-gen_asn1ct_eval_exp_1([], _) -> ok.
+gen_asn1ct_eval_exp_1(Fd, [{_,F,A}|T], Sep) ->
+ io:put_chars(Fd, Sep),
+ io:format(Fd, "~p/~p", [F,A]),
+ gen_asn1ct_eval_exp_1(Fd, T, ",\n");
+gen_asn1ct_eval_exp_1(_, [], _) -> ok.
-defined([H|T]) ->
- io:format("assert_defined(~p) -> ok", [H]),
+defined(Fd, [H|T]) ->
+ io:format(Fd, "assert_defined(~p) -> ok", [H]),
case T of
[] ->
- io:put_chars(".\n");
+ io:put_chars(Fd, ".\n");
[_|_] ->
- io:put_chars(";\n"),
- defined(T)
+ io:put_chars(Fd, ";\n"),
+ defined(Fd, T)
end.
-dependencies([{K,V}|T]) ->
- io:format("dependencies(~p) ->\n~p;\n", [K,V]),
- dependencies(T);
-dependencies([]) ->
- io:put_chars("dependencies(_) -> [].\n").
+dependencies(Fd, [{K,V}|T]) ->
+ io:format(Fd, "dependencies(~p) ->\n~p;\n", [K,V]),
+ dependencies(Fd, T);
+dependencies(Fd, []) ->
+ io:put_chars(Fd, "dependencies(_) -> [].\n").
abstract(File) ->
{ok,{M0,[{abstract_code,Abstract}]}} =
diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl
index 61b360ddf2..83bd66a631 100644
--- a/lib/asn1/test/asn1_SUITE.erl
+++ b/lib/asn1/test/asn1_SUITE.erl
@@ -96,7 +96,6 @@ groups() ->
testChoTypeRefSeq,
testChoTypeRefSet,
testMultipleLevels,
- testDef,
testOpt,
testSeqDefault,
% Uses 'External'
@@ -141,9 +140,9 @@ groups() ->
testDeepTConstr,
testExport,
testImport,
- % Uses 'ParamBasic'
- {group, [], [testParamBasic,
- testDER]},
+ testParamBasic,
+ testDER,
+ testDEFAULT,
testMvrasn6,
testContextSwitchingTypes,
testOpenTypeImplicitTag,
@@ -326,20 +325,21 @@ testCompactBitString(Config, Rule, Opts) ->
[Rule, compact_bit_string|Opts]),
testCompactBitString:otp_4869(Rule).
-testPrimStrings(Config) -> test(Config, fun testPrimStrings/3).
+testPrimStrings(Config) ->
+ test(Config, fun testPrimStrings/3, [ber,{ber,[der]},per,uper]).
testPrimStrings(Config, Rule, Opts) ->
asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [Rule|Opts]),
- testPrimStrings_cases(Rule),
+ testPrimStrings_cases(Rule, Opts),
asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config,
[legacy_bit_string,Rule|Opts]),
- testPrimStrings:bit_string(Rule),
+ testPrimStrings:bit_string(Rule, Opts),
asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config,
[compact_bit_string,Rule|Opts]),
- testPrimStrings:bit_string(Rule),
+ testPrimStrings:bit_string(Rule, Opts),
testPrimStrings:more_strings(Rule).
-testPrimStrings_cases(Rule) ->
- testPrimStrings:bit_string(Rule),
+testPrimStrings_cases(Rule, Opts) ->
+ testPrimStrings:bit_string(Rule, Opts),
testPrimStrings:octet_string(Rule),
testPrimStrings:numeric_string(Rule),
testPrimStrings:other_strings(Rule),
@@ -429,6 +429,13 @@ testDef(Config, Rule, Opts) ->
asn1_test_lib:compile("Def", Config, [Rule|Opts]),
testDef:main(Rule).
+testDEFAULT(Config) ->
+ test(Config, fun testDEFAULT/3, [ber,{ber,[der]},per,uper]).
+testDEFAULT(Config, Rule, Opts) ->
+ asn1_test_lib:compile_all(["Def","Default"], Config, [Rule|Opts]),
+ testDef:main(Rule),
+ testSeqSetDefaultVal:main(Rule, Opts).
+
testOpt(Config) -> test(Config, fun testOpt/3).
testOpt(Config, Rule, Opts) ->
asn1_test_lib:compile("Opt", Config, [Rule|Opts]),
@@ -516,7 +523,8 @@ testSetDefault(Config, Rule, Opts) ->
asn1_test_lib:compile("SetDefault", Config, [Rule|Opts]),
testSetDefault:main(Rule).
-testParamBasic(Config) -> test(Config, fun testParamBasic/3).
+testParamBasic(Config) ->
+ test(Config, fun testParamBasic/3, [ber,{ber,[der]},per,uper]).
testParamBasic(Config, Rule, Opts) ->
asn1_test_lib:compile("ParamBasic", Config, [Rule|Opts]),
testParamBasic:main(Rule).
@@ -873,11 +881,7 @@ testDER(Config) ->
test(Config, fun testDER/3, [ber]).
testDER(Config, Rule, Opts) ->
asn1_test_lib:compile("DERSpec", Config, [Rule, der|Opts]),
- testDER:test(),
- asn1_test_lib:compile("ParamBasic", Config, [Rule, der|Opts]),
- testParamBasic:main(der),
- asn1_test_lib:compile("Default", Config, [Rule, der|Opts]),
- testSeqSetDefaultVal:main(Rule).
+ testDER:test().
specialized_decodes(Config) ->
test(Config, fun specialized_decodes/3, [ber]).
diff --git a/lib/asn1/test/asn1_SUITE_data/Constraints.py b/lib/asn1/test/asn1_SUITE_data/Constraints.py
index e4bc987e4c..581ec2f467 100644
--- a/lib/asn1/test/asn1_SUITE_data/Constraints.py
+++ b/lib/asn1/test/asn1_SUITE_data/Constraints.py
@@ -17,6 +17,11 @@ NegSemiConstrained ::= INTEGER (-128..MAX)
SemiConstrainedExt ::= INTEGER (42..MAX, ...)
NegSemiConstrainedExt ::= INTEGER (-128..MAX, ...)
+-- Union of single values
+Sv1 ::= INTEGER (2|3|17)
+Sv2 ::= INTEGER (2|3|17, ...)
+Sv3 ::= INTEGER {a(2),b(3),z(17)} (2|3|17, ...)
+
-- Other constraints
FixedSize ::= OCTET STRING (SIZE(10))
FixedSize2 ::= OCTET STRING (SIZE(10|20))
diff --git a/lib/asn1/test/asn1_SUITE_data/Default.asn b/lib/asn1/test/asn1_SUITE_data/Default.asn
index 6604953c1f..168ce50bb2 100644
--- a/lib/asn1/test/asn1_SUITE_data/Default.asn
+++ b/lib/asn1/test/asn1_SUITE_data/Default.asn
@@ -21,7 +21,8 @@ SeqBS ::= SEQUENCE {
a BIT STRING DEFAULT '1010110'B,
b BIT STRING DEFAULT 'A8A'H,
c BIT STRING {first(0),second(1),third(2)} DEFAULT {second},
- d BIT STRING DEFAULT onelist
+ d BIT STRING DEFAULT onelist,
+ e BIT STRING DEFAULT '01011010'B
}
SetBS ::= SET {
diff --git a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1
index 08e7f94ab6..a5b4c8a53d 100644
--- a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1
+++ b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1
@@ -46,7 +46,13 @@ BS256 ::= BIT STRING (SIZE (256))
BS1024 ::= BIT STRING (SIZE (1024))
-
+ BsDef1 ::= SEQUENCE {
+ s BIT STRING DEFAULT '101111'B
+ }
+
+ BsDef2 ::= SEQUENCE {
+ s BIT STRING DEFAULT 'DEADBEEF'H
+ }
Os ::= OCTET STRING
OsCon ::= [60] OCTET STRING
diff --git a/lib/asn1/test/testConstraints.erl b/lib/asn1/test/testConstraints.erl
index 9a1d62993d..34fbbcf6cc 100644
--- a/lib/asn1/test/testConstraints.erl
+++ b/lib/asn1/test/testConstraints.erl
@@ -122,6 +122,42 @@ int_constraints(Rules) ->
range_error(Rules, 'X1', 21),
%%==========================================================
+ %% Union of single values
+ %% Sv1 ::= INTEGER (2|3|17)
+ %% Sv2 ::= INTEGER (2|3|17, ...)
+ %% Sv3 ::= INTEGER {a(2),b(3),z(17)} (2|3|17, ...)
+ %%==========================================================
+
+ range_error(Rules, 'Sv1', 1),
+ range_error(Rules, 'Sv1', 18),
+ roundtrip('Sv1', 2),
+ roundtrip('Sv1', 3),
+ roundtrip('Sv1', 7),
+
+ %% Encoded as root
+ v_roundtrip(Rules, 'Sv2', 2),
+ v_roundtrip(Rules, 'Sv2', 3),
+ v_roundtrip(Rules, 'Sv2', 17),
+
+ %% Encoded as extension
+ v_roundtrip(Rules, 'Sv2', 1),
+ v_roundtrip(Rules, 'Sv2', 4),
+ v_roundtrip(Rules, 'Sv2', 18),
+
+ %% Encoded as root
+ v_roundtrip(Rules, 'Sv3', a),
+ v_roundtrip(Rules, 'Sv3', b),
+ v_roundtrip(Rules, 'Sv3', z),
+ v_roundtrip(Rules, 'Sv3', 2, a),
+ v_roundtrip(Rules, 'Sv3', 3, b),
+ v_roundtrip(Rules, 'Sv3', 17, z),
+
+ %% Encoded as extension
+ v_roundtrip(Rules, 'Sv3', 1),
+ v_roundtrip(Rules, 'Sv3', 4),
+ v_roundtrip(Rules, 'Sv3', 18),
+
+ %%==========================================================
%% SemiConstrained
%%==========================================================
@@ -197,7 +233,29 @@ v(per, 'SemiConstrainedExt', 42+128) -> "000180";
v(uper, 'SemiConstrainedExt', 42+128) -> "00C000";
v(ber, 'NegSemiConstrainedExt', 0) -> "020100";
v(per, 'NegSemiConstrainedExt', 0) -> "000180";
-v(uper, 'NegSemiConstrainedExt', 0) -> "00C000".
+v(uper, 'NegSemiConstrainedExt', 0) -> "00C000";
+v(ber, 'Sv2', 1) -> "020101";
+v(per, 'Sv2', 1) -> "800101";
+v(uper, 'Sv2', 1) -> "808080";
+v(ber, 'Sv2', 2) -> "020102";
+v(per, 'Sv2', 2) -> "00";
+v(uper, 'Sv2', 2) -> "00";
+v(ber, 'Sv2', 3) -> "020103";
+v(per, 'Sv2', 3) -> "08";
+v(uper, 'Sv2', 3) -> "08";
+v(ber, 'Sv2', 4) -> "020104";
+v(per, 'Sv2', 4) -> "800104";
+v(uper, 'Sv2', 4) -> "808200";
+v(ber, 'Sv2', 17) -> "020111";
+v(per, 'Sv2', 17) -> "78";
+v(uper, 'Sv2', 17) -> "78";
+v(ber, 'Sv2', 18) -> "020112";
+v(per, 'Sv2', 18) -> "800112";
+v(uper, 'Sv2', 18) -> "808900";
+v(Rule, 'Sv3', a) -> v(Rule, 'Sv2', 2);
+v(Rule, 'Sv3', b) -> v(Rule, 'Sv2', 3);
+v(Rule, 'Sv3', z) -> v(Rule, 'Sv2', 17);
+v(Rule, 'Sv3', Val) when is_integer(Val) -> v(Rule, 'Sv2', Val).
shorter_ext(per, "a") -> <<16#80,16#01,16#61>>;
shorter_ext(uper, "a") -> <<16#80,16#E1>>;
@@ -211,6 +269,10 @@ v_roundtrip(Erule, Type, Value) ->
Encoded = asn1_test_lib:hex_to_bin(v(Erule, Type, Value)),
Encoded = roundtrip('Constraints', Type, Value).
+v_roundtrip(Erule, Type, Value, Expected) ->
+ Encoded = asn1_test_lib:hex_to_bin(v(Erule, Type, Value)),
+ Encoded = asn1_test_lib:roundtrip_enc('Constraints', Type, Value, Expected).
+
roundtrip(Type, Value) ->
roundtrip('Constraints', Type, Value).
diff --git a/lib/asn1/test/testParamBasic.erl b/lib/asn1/test/testParamBasic.erl
index 3a55408e94..3db89ca174 100644
--- a/lib/asn1/test/testParamBasic.erl
+++ b/lib/asn1/test/testParamBasic.erl
@@ -38,7 +38,9 @@ main(Rules) ->
<<48,3,128,1,11>> =
roundtrip_enc('T11', #'T11'{number=11,string="hej"}),
<<48,3,128,1,11>> =
- roundtrip_enc('T12', #'T12'{number=11,string=[1,0,1,0]});
+ roundtrip_enc('T12',
+ #'T12'{number=11,string=[1,0,1,0]},
+ #'T12'{number=11,string = <<10:4>>});
_ -> ok
end,
ok.
@@ -48,3 +50,6 @@ roundtrip(Type, Value) ->
roundtrip_enc(Type, Value) ->
asn1_test_lib:roundtrip_enc('ParamBasic', Type, Value).
+
+roundtrip_enc(Type, Value, Expected) ->
+ asn1_test_lib:roundtrip_enc('ParamBasic', Type, Value, Expected).
diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl
index be5409aa92..2fe0780701 100644
--- a/lib/asn1/test/testPrimStrings.erl
+++ b/lib/asn1/test/testPrimStrings.erl
@@ -19,7 +19,7 @@
%%
-module(testPrimStrings).
--export([bit_string/1]).
+-export([bit_string/2]).
-export([octet_string/1]).
-export([numeric_string/1]).
-export([other_strings/1]).
@@ -68,7 +68,7 @@ fragmented_lengths() ->
K64-1,K64,K64+1,K64+(1 bsl 7)-1,K64+(1 bsl 7),K64+(1 bsl 7)+1,
K64+K16-1,K64+K16,K64+K16+1].
-bit_string(Rules) ->
+bit_string(Rules, Opts) ->
%%==========================================================
%% Bs1 ::= BIT STRING
@@ -90,9 +90,10 @@ bit_string(Rules) ->
bs_roundtrip('Bs1', [0,1,0,0,1,0]),
bs_roundtrip('Bs1', [1,0,0,0,0,0,0,0,0]),
bs_roundtrip('Bs1', [0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]),
-
- case Rules of
- ber ->
+
+
+ case {Rules,Opts} of
+ {ber,[]} ->
bs_decode('Bs1', <<35,8,3,2,0,73,3,2,4,32>>,
[0,1,0,0,1,0,0,1,0,0,1,0]),
bs_decode('Bs1', <<35,9,3,2,0,234,3,3,7,156,0>>,
@@ -100,7 +101,17 @@ bit_string(Rules) ->
bs_decode('Bs1', <<35,128,3,2,0,234,3,3,7,156,0,0,0>>,
[1,1,1,0,1,0,1,0,1,0,0,1,1,1,0,0,0]);
_ ->
- ok
+ %% DER, PER, UPER
+ consistent_def_enc('BsDef1',
+ [2#111101,
+ [1,0,1,1,1,1],
+ {2,<<2#101111:6,0:2>>},
+ <<2#101111:6>>]),
+ consistent_def_enc('BsDef2',
+ [[1,1,0,1, 1,1,1,0, 1,0,1,0, 1,1,0,1,
+ 1,0,1,1, 1,1,1,0, 1,1,1,0, 1,1,1,1],
+ {0,<<16#DEADBEEF:4/unit:8>>},
+ <<16#DEADBEEF:4/unit:8>>])
end,
@@ -217,6 +228,24 @@ bit_string(Rules) ->
_ -> per_bs_strings()
end.
+consistent_def_enc(Type, Vs) ->
+ M = 'PrimStrings',
+ {ok,Enc} = M:encode(Type, {Type,asn1_DEFAULT}),
+ {ok,Val} = M:decode(Type, Enc),
+
+ %% Ensure that the value has the correct format.
+ case {M:bit_string_format(),Val} of
+ {bitstring,{_,Bs}} when is_bitstring(Bs) -> ok;
+ {compact,{_,{Unused,Bin}}} when is_integer(Unused),
+ is_binary(Bin) -> ok;
+ {legacy,{_,Bs}} when is_list(Bs) -> ok
+ end,
+
+ %% All values should be recognized and encoded as the
+ %% the default value (i.e. not encoded at all).
+ _ = [{ok,Enc} = M:encode(Type, {Type,V}) || V <- Vs],
+ ok.
+
%% The PER encoding rules requires that a BIT STRING with
%% named positions should never have any trailing zeroes
%% (except to reach the minimum number of bits as given by
diff --git a/lib/asn1/test/testSeqSetDefaultVal.erl b/lib/asn1/test/testSeqSetDefaultVal.erl
index fb61bf1647..044099199f 100644
--- a/lib/asn1/test/testSeqSetDefaultVal.erl
+++ b/lib/asn1/test/testSeqSetDefaultVal.erl
@@ -18,7 +18,7 @@
%%
%%
-module(testSeqSetDefaultVal).
--export([main/1]).
+-export([main/2]).
-include("External.hrl").
-include_lib("test_server/include/test_server.hrl").
@@ -34,7 +34,8 @@
-record('SeqBS',{a = asn1_DEFAULT,
b = asn1_DEFAULT,
c = asn1_DEFAULT,
- d = asn1_DEFAULT}).
+ d = asn1_DEFAULT,
+ e = asn1_DEFAULT}).
-record('SetBS',{a = asn1_DEFAULT,
b = asn1_DEFAULT,
c = asn1_DEFAULT,
@@ -93,7 +94,119 @@
-record('S4_b',{ba = asn1_DEFAULT,
bb = asn1_DEFAULT}).
-main(_Rules) ->
+main(ber, []) ->
+ %% Nothing to test because plain BER will only use
+ %% default values when explicitly told to do so by
+ %% asn1_DEFAULT.
+ ok;
+main(Rule, Opts) ->
+ %% DER, PER, UPER. These encodings should not encode
+ %% values that are equal to the default value.
+
+ case {Rule,Opts} of
+ {ber,[der]} ->
+ der();
+ {_,_} ->
+ ok
+ end,
+
+ Ts = [{#'SeqInts'{},
+ [{#'SeqInts'.c,
+ [asn1_DEFAULT,
+ three,
+ 3]}]},
+
+ {#'SeqBS'{},
+ [{#'SeqBS'.a,
+ [asn1_DEFAULT,
+ 2#0110101,
+ [1,0,1,0,1,1,0],
+ {1,<<16#AC>>},
+ <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>]},
+ {#'SeqBS'.b,
+ [asn1_DEFAULT,
+ 2#10100010101,
+ [1,0,1,0,1,0,0,0,1,0,1,0],
+ {4,<<16#A8,16#A0>>},
+ <<16#A8:8,16#A:4>>]},
+ {#'SeqBS'.c,
+ [asn1_DEFAULT,
+ [second],
+ [0,1],
+ {6,<<0:1,1:1,0:6>>},
+ <<1:2>>]},
+ {#'SeqBS'.c, %Zeroes on the right
+ [asn1_DEFAULT,
+ [second],
+ [0,1,0,0,0],
+ {4,<<0:1,1:1,0:6>>},
+ <<1:2,0:17>>]},
+ {#'SeqBS'.d,
+ [asn1_DEFAULT,
+ 2#1001,
+ [1,0,0,1],
+ {4,<<2#1001:4,0:4>>},
+ <<2#1001:4>>]},
+ {#'SeqBS'.e,
+ [asn1_DEFAULT,
+ [0,1,0,1,1,0,1,0],
+ {0,<<2#01011010:8>>},
+ <<2#01011010:8>>]},
+ %% Not EQUAL to DEFAULT.
+ {#'SeqBS'.b,
+ [[1,1,0], %Not equal to DEFAULT
+ {5,<<6:3,0:5>>},
+ <<6:3>>]}
+ ]},
+
+ {#'SeqOS'{},
+ [{#'SeqOS'.a,
+ [asn1_DEFAULT,
+ [172]]}]},
+
+ {#'SeqOI'{},
+ [{#'SeqOI'.a,
+ [asn1_DEFAULT,
+ {1,2,14,15}]},
+ {#'SeqOI'.b,
+ [asn1_DEFAULT,
+%% {iso,'member-body',250,3,4},
+ {1,2,250,3,4}]},
+ {#'SeqOI'.c,
+ [asn1_DEFAULT,
+%% {iso,standard,8571,2,250,4},
+ {1,0,8571,2,250,4}]}]}
+ ],
+ io:format("~p\n", [Ts]),
+ R0 = [[consistency(Rec, Pos, Vs) || {Pos,Vs} <- Fs] || {Rec,Fs} <- Ts],
+ case lists:flatten(R0) of
+ [] ->
+ ok;
+ [_|_]=R ->
+ io:format("~p\n", [R]),
+ ?t:fail()
+ end.
+
+consistency(Rec0, Pos, [V|Vs]) ->
+ T = element(1, Rec0),
+ Rec = setelement(Pos, Rec0, V),
+ {ok,Enc} = 'Default':encode(T, Rec),
+ {ok,_SmokeTest} = 'Default':decode(T, Enc),
+ consistency_1(Vs, Rec0, Pos, Enc).
+
+consistency_1([V|Vs], Rec0, Pos, Enc) ->
+ Rec = setelement(Pos, Rec0, V),
+ case 'Default':encode(element(1, Rec), Rec) of
+ {ok,Enc} ->
+ consistency_1(Vs, Rec0, Pos, Enc);
+ {ok,WrongEnc} ->
+ [{Rec,{wrong,WrongEnc},{should_be,Enc}}|
+ consistency_1(Vs, Rec0, Pos, Enc)]
+ end;
+consistency_1([], _, _, _) -> [].
+
+der() ->
+ io:put_chars("Peforming DER-specific tests..."),
roundtrip(<<48,0>>,
'SeqInts',
#'SeqInts'{a=asn1_DEFAULT,b=asn1_DEFAULT,
@@ -117,50 +230,88 @@ main(_Rules) ->
roundtrip(<<48,0>>,
'SeqBS',
- #'SeqBS'{a=2#1010110,b=16#A8A,c=[second],d=[1,0,0,1]},
- #'SeqBS'{a=[1,0,1,0,1,1,0],b=16#A8A,c=[second],d=[1,0,0,1]}),
+ #'SeqBS'{a=2#0110101,
+ b=2#010100010101,
+ c=[second],
+ d=[1,0,0,1]},
+ #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<2#1001:4>>,
+ e = <<2#01011010:8>>}),
roundtrip(<<48,0>>,
'SeqBS',
#'SeqBS'{a=[1,0,1,0,1,1,0],
b=[1,0,1,0,1,0,0,0,1,0,1,0],
c={5,<<64>>},
d=2#1001},
- #'SeqBS'{a=[1,0,1,0,1,1,0],b=16#A8A,c=[second],d=[1,0,0,1]}),
+ #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<2#1001:4>>,
+ e = <<2#01011010:8>>}),
roundtrip(<<48,3,131,1,0>>,
'SeqBS',
#'SeqBS'{a=[1,0,1,0,1,1,0],
b=[1,0,1,0,1,0,0,0,1,0,1,0],
c={5,<<64>>},
d=0},
- #'SeqBS'{a=[1,0,1,0,1,1,0],
- b=16#A8A,
- c=[second],
- d = <<>>}),
+ #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<>>,
+ e = <<2#01011010:8>>}),
+ roundtrip(<<48,3,131,1,0>>,
+ 'SeqBS',
+ #'SeqBS'{a = <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>,
+ b = <<1:1,0:1,1:1,0:1,1:1,0:1,0:1,0:1,1:1,0:1,1:1,0:1>>,
+ c = <<2:3>>,
+ d=0,
+ e = <<16#5A:8>>},
+ #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<>>,
+ e = <<2#01011010:8>>}),
+
+ %% None of the default values are used.
+ roundtrip(<<48,19,128,2,7,128,129,2,5,64,130,2,5,32,131,1,0,132,2,5,224>>,
+ 'SeqBS',
+ #'SeqBS'{a = <<1:1>>,
+ b = {5,<<64>>},
+ c = [third],
+ d = 0,
+ e = <<7:3>>},
+ #'SeqBS'{a = <<1:1>>,
+ b = <<2:3>>,
+ c = [third],
+ d = <<>>,
+ e = <<7:3>>}),
roundtrip(<<49,0>>,
'SetBS',
- #'SetBS'{a=2#1010110,b=16#A8A,c=[second],d=[1,0,0,1]},
- #'SetBS'{a=[1,0,1,0,1,1,0],b=16#A8A,c=[second],d=[1,0,0,1]}),
+ #'SetBS'{a=2#0110101,
+ b=2#010100010101,
+ c=[second],
+ d=[1,0,0,1]},
+ #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<2#1001:4>>}),
roundtrip(<<49,0>>,
'SetBS',
#'SetBS'{a=[1,0,1,0,1,1,0],
b=[1,0,1,0,1,0,0,0,1,0,1,0],
c={5,<<64>>},
d=9},
- #'SetBS'{a=[1,0,1,0,1,1,0],
- b=16#A8A,
- c=[second],
- d=[1,0,0,1]}),
+ #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<2#1001:4>>}),
roundtrip(<<49,3,131,1,0>>,
'SetBS',
#'SetBS'{a=[1,0,1,0,1,1,0],
b=[1,0,1,0,1,0,0,0,1,0,1,0],
c={5,<<64>>},
d=0},
- #'SetBS'{a=[1,0,1,0,1,1,0],
- b=16#A8A,
- c=[second],
- d = <<>>}),
+ #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<>>}),
+ roundtrip(<<49,3,131,1,0>>,
+ 'SetBS',
+ #'SetBS'{a = <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>,
+ b = <<1:1,0:1,1:1,0:1,1:1,0:1,0:1,0:1,1:1,0:1,1:1,0:1>>,
+ c = <<2:3>>,
+ d=0},
+ #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>,
+ c=[second], d = <<>>}),
roundtrip(<<48,0>>, 'SeqOS',
#'SeqOS'{a=[172],b=[16#A8,16#A0],c='NULL'}),
diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl
index 4ee7e48a67..8fed341600 100644
--- a/lib/common_test/src/cth_log_redirect.erl
+++ b/lib/common_test/src/cth_log_redirect.erl
@@ -34,13 +34,15 @@
%% Event handler Callbacks
-export([init/1,
handle_event/2, handle_call/2, handle_info/2,
- terminate/1]).
+ terminate/1, terminate/2, code_change/3]).
%% Other
-export([handle_remote_events/1]).
-include("ct.hrl").
+-behaviour(gen_event).
+
-record(eh_state, {log_func,
curr_suite,
curr_group,
@@ -184,10 +186,13 @@ handle_call({handle_remote_events,Bool}, State) ->
handle_call(_Query, _State) ->
{error, bad_query}.
-terminate(_State) ->
+terminate(_) ->
error_logger:delete_report_handler(?MODULE),
[].
+terminate(_Arg, _State) ->
+ ok.
+
tag_event(Event) ->
{calendar:local_time(), Event}.
@@ -236,3 +241,6 @@ format_header(#eh_state{curr_suite = Suite,
curr_func = TC}) ->
io_lib:format("System report during ~w:~w/1 in ~w",
[Suite,TC,Group]).
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
diff --git a/lib/common_test/test/common_test.cover b/lib/common_test/test/common_test.cover
index 3aa49623e7..87d00c420f 100644
--- a/lib/common_test/test/common_test.cover
+++ b/lib/common_test/test/common_test.cover
@@ -4,7 +4,6 @@
test_server,
test_server_ctrl,
test_server_gl,
- test_server_h,
test_server_io,
test_server_node,
test_server_sup]}]}.
diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl
index 84341a0b99..5de1ecc2bd 100644
--- a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl
+++ b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl
@@ -89,28 +89,31 @@ pre_post_io(Config) ->
%%!--------------------------------------------------------------------
spawn(fun() ->
+ ct:pal("CONTROLLER: Started!", []),
%% --- test run 1 ---
- ct:sleep(3000),
- ct_test_support:ct_rpc({cth_log_redirect,
- handle_remote_events,
- [true]}, Config),
- ct:sleep(2000),
- io:format(user, "Starting test run!~n", []),
- ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config),
- ct:sleep(6000),
- io:format(user, "Finishing off!~n", []),
- ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config),
+ timer:sleep(3000),
+ ct:pal("CONTROLLER: Handle remote events = true", []),
+ ok = ct_test_support:ct_rpc({cth_log_redirect,
+ handle_remote_events,
+ [true]}, Config),
+ timer:sleep(2000),
+ ct:pal("CONTROLLER: Proceeding with test run #1!", []),
+ ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config),
+ timer:sleep(6000),
+ ct:pal("CONTROLLER: Proceeding with shutdown #1!", []),
+ ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config),
%% --- test run 2 ---
- ct:sleep(3000),
- ct_test_support:ct_rpc({cth_log_redirect,
- handle_remote_events,
- [true]}, Config),
- ct:sleep(2000),
- io:format(user, "Starting test run!~n", []),
- ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config),
- ct:sleep(6000),
- io:format(user, "Finishing off!~n", []),
- ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config)
+ timer:sleep(3000),
+ ct:pal("CONTROLLER: Handle remote events = true", []),
+ ok = ct_test_support:ct_rpc({cth_log_redirect,
+ handle_remote_events,
+ [true]}, Config),
+ timer:sleep(2000),
+ ct:pal("CONTROLLER: Proceeding with test run #2!", []),
+ ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config),
+ timer:sleep(6000),
+ ct:pal("CONTROLLER: Proceeding with shutdown #2!", []),
+ ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config)
end),
ct_test_support:run(Opts, Config),
Events = ct_test_support:get_events(ERPid, Config),
diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl
index c8c08a5735..2ba991fc61 100644
--- a/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl
+++ b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl
@@ -28,7 +28,8 @@
%%%===================================================================
proceed() ->
- ?MODULE ! proceed.
+ ?MODULE ! proceed,
+ ok.
%%--------------------------------------------------------------------
%% Hook functions
diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl
index e208ffec1f..9d89e21a4e 100644
--- a/lib/compiler/src/beam_clean.erl
+++ b/lib/compiler/src/beam_clean.erl
@@ -86,7 +86,7 @@ add_to_work_list(F, {Fs,Used}=Sets) ->
false -> {[F|Fs],sets:add_element(F, Used)}
end.
-
+
%%%
%%% Coalesce adjacent labels. Renumber all labels to eliminate gaps.
%%% This cleanup will slightly reduce file size and slightly speed up loading.
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index 3b51216a6c..3ec57a67da 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -600,7 +600,7 @@ checkerror_1([], OrigIs) -> OrigIs.
checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs].
-
+
%%% Routines for maintaining a type database. The type database
%%% associates type information with registers.
%%%
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 802e3dfa2f..47d446273b 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -1556,7 +1556,7 @@ restore_expand_module([F|Fs]) ->
[F|restore_expand_module(Fs)];
restore_expand_module([]) -> [].
-
+
-spec options() -> 'ok'.
options() ->
@@ -1593,7 +1593,7 @@ help([_|T]) ->
help(_) ->
ok.
-
+
%% compile(AbsFileName, Outfilename, Options)
%% Compile entry point for erl_compile.
diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl
index 0ca2f57dde..c0dfecd1dc 100644
--- a/lib/compiler/src/core_scan.erl
+++ b/lib/compiler/src/core_scan.erl
@@ -96,7 +96,7 @@ format_error(Other) -> io_lib:write(Other).
string_thing($') -> "atom"; %' stupid emacs
string_thing($") -> "string". %" stupid emacs
-
+
%% Re-entrant pre-scanner.
%%
%% If the input list of characters is insufficient to build a term the
@@ -214,7 +214,7 @@ pre_comment(eof, Sofar, Pos) ->
pre_error(E, Epos, Pos) ->
{error,{Epos,core_scan,E}, Pos}.
-
+
%% scan(CharList, StartPos)
%% This takes a list of characters and tries to tokenise them.
%%
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 1195937d91..01bb8635cd 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -1912,7 +1912,7 @@ new_in_all([Le|Les]) ->
foldl(fun (L, Ns) -> intersection((get_anno(L))#a.ns, Ns) end,
(get_anno(Le))#a.ns, Les);
new_in_all([]) -> [].
-
+
%% The AfterVars are the variables which are used afterwards. We need
%% this to work out which variables are actually exported and used
%% from case/receive. In subblocks/clauses the AfterVars of the block
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 2b2b8bf550..65f1251099 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -160,8 +160,8 @@ function({#c_var{name={F,Arity}=FA},Body}, St0) ->
io:fwrite("Function: ~w/~w\n", [F,Arity]),
erlang:raise(Class, Error, Stack)
end.
-
-
+
+
%% body(Cexpr, Sub, State) -> {Kexpr,[PreKepxr],State}.
%% Do the main sequence of a body. A body ends in an atomic value or
%% values. Must check if vector first so do expr.
@@ -834,7 +834,7 @@ last([_|T]) -> last(T).
first([_]) -> [];
first([H|T]) -> [H|first(T)].
-
+
%% This code implements the algorithm for an optimizing compiler for
%% pattern matching given "The Implementation of Functional
%% Programming Languages" by Simon Peyton Jones. The code is much
@@ -1428,7 +1428,7 @@ arg_val(Arg, C) ->
{set_kanno(S, []),U,T,Fs}
end
end.
-
+
%% ubody_used_vars(Expr, State) -> [UsedVar]
%% Return all used variables for the body sequence. Much more
%% efficient than using ubody/3 if the body contains nested letrecs.
diff --git a/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl b/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl
index 0214983c11..db84ee5fc8 100644
--- a/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl
+++ b/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl
@@ -236,7 +236,7 @@ flatlength([H|T], L) when list(H) ->
flatlength([H|T], L) ->
flatlength(T, L + 1);
flatlength([], L) -> L.
-
+
%% keymember(Key, Index, [Tuple])
%% keysearch(Key, Index, [Tuple])
%% keydelete(Key, Index, [Tuple])
@@ -298,7 +298,7 @@ keymap(Fun, ExtraArgs, Index, [Tup|Tail]) ->
[setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))|
keymap(Fun, ExtraArgs, Index, Tail)];
keymap( _, _ , _, []) -> [].
-
+
%% all(Predicate, List)
%% any(Predicate, List)
%% map(Function, List)
diff --git a/lib/debugger/test/int_SUITE_data/lists1.erl b/lib/debugger/test/int_SUITE_data/lists1.erl
index 0214983c11..db84ee5fc8 100644
--- a/lib/debugger/test/int_SUITE_data/lists1.erl
+++ b/lib/debugger/test/int_SUITE_data/lists1.erl
@@ -236,7 +236,7 @@ flatlength([H|T], L) when list(H) ->
flatlength([H|T], L) ->
flatlength(T, L + 1);
flatlength([], L) -> L.
-
+
%% keymember(Key, Index, [Tuple])
%% keysearch(Key, Index, [Tuple])
%% keydelete(Key, Index, [Tuple])
@@ -298,7 +298,7 @@ keymap(Fun, ExtraArgs, Index, [Tup|Tail]) ->
[setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))|
keymap(Fun, ExtraArgs, Index, Tail)];
keymap( _, _ , _, []) -> [].
-
+
%% all(Predicate, List)
%% any(Predicate, List)
%% map(Function, List)
diff --git a/lib/debugger/test/int_SUITE_data/my_lists.erl b/lib/debugger/test/int_SUITE_data/my_lists.erl
index 98eb4396e3..f9399b1085 100644
--- a/lib/debugger/test/int_SUITE_data/my_lists.erl
+++ b/lib/debugger/test/int_SUITE_data/my_lists.erl
@@ -237,7 +237,7 @@ flatlength([H|T], L) when list(H) ->
flatlength([H|T], L) ->
flatlength(T, L + 1);
flatlength([], L) -> L.
-
+
%% keymember(Key, Index, [Tuple])
%% keysearch(Key, Index, [Tuple])
%% keydelete(Key, Index, [Tuple])
@@ -299,7 +299,7 @@ keymap(Fun, ExtraArgs, Index, [Tup|Tail]) ->
[setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))|
keymap(Fun, ExtraArgs, Index, Tail)];
keymap( _, _ , _, []) -> [].
-
+
%% all(Predicate, List)
%% any(Predicate, List)
%% map(Function, List)
@@ -698,7 +698,7 @@ flatlength_1([H|T], L) when list(H) ->
flatlength_1([H|T], L) ->
flatlength_1(T, L + 1);
flatlength_1([], L) -> L.
-
+
%% keymember(Key, Index, [Tuple])
%% keysearch(Key, Index, [Tuple])
%% keydelete(Key, Index, [Tuple])
@@ -760,7 +760,7 @@ keymap_1(Fun, ExtraArgs, Index, [Tup|Tail]) ->
[setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))|
keymap_1(Fun, ExtraArgs, Index, Tail)];
keymap_1( _, _ , _, []) -> [].
-
+
%% all(Predicate, List)
%% any(Predicate, List)
%% map(Function, List)
@@ -1162,7 +1162,7 @@ flatlength_2([H|T], L) when list(H) ->
flatlength_2([H|T], L) ->
flatlength_2(T, L + 1);
flatlength_2([], L) -> L.
-
+
%% keymember_2(Key, Index, [Tuple])
%% keysearch_2(Key, Index, [Tuple])
%% keydelete_2(Key, Index, [Tuple])
@@ -1224,7 +1224,7 @@ keymap_2(Fun, ExtraArgs, Index, [Tup|Tail]) ->
[setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))|
keymap_2(Fun, ExtraArgs, Index, Tail)];
keymap_2( _, _ , _, []) -> [].
-
+
%% all_2(Predicate, List)
%% any_2(Predicate, List)
%% map_2(Function, List)
@@ -1624,7 +1624,7 @@ flatlength_3([H|T], L) when list(H) ->
flatlength_3([H|T], L) ->
flatlength_3(T, L + 1);
flatlength_3([], L) -> L.
-
+
%% keymember_3(Key, Index, [Tuple])
%% keysearch_3(Key, Index, [Tuple])
%% keydelete_3(Key, Index, [Tuple])
@@ -1686,7 +1686,7 @@ keymap_3(Fun, ExtraArgs, Index, [Tup|Tail]) ->
[setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))|
keymap_3(Fun, ExtraArgs, Index, Tail)];
keymap_3( _, _ , _, []) -> [].
-
+
%% all_3(Predicate, List)
%% any_3(Predicate, List)
%% map_3(Function, List)
diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl
index 04225e9bd0..4fc4e89ce9 100644
--- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl
+++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl
@@ -80,7 +80,7 @@ add_to_work_list(F, {Fs,Used}=Sets) ->
false -> {[F|Fs],sets:add_element(F, Used)}
end.
-
+
%%%
%%% Coalesce adjacent labels. Renumber all labels to eliminate gaps.
%%% This cleanup will slightly reduce file size and slightly speed up loading.
diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl
index d2ac3fcd99..f59cc897d6 100644
--- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl
+++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl
@@ -456,7 +456,7 @@ are_live_regs_determinable([{'%live',_}|_]) -> true;
are_live_regs_determinable([_|Is]) -> are_live_regs_determinable(Is);
are_live_regs_determinable([]) -> false.
-
+
%%% Routines for maintaining a type database. The type database
%%% associates type information with registers.
%%%
diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl
index 2b6d14e300..9b56d384ab 100644
--- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl
+++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl
@@ -990,7 +990,7 @@ listing(LFun, Ext, St) ->
Es = [{Lfile,[{none,compile,write_error}]}],
{error,St#compile{errors=St#compile.errors ++ Es}}
end.
-
+
options() ->
help(standard_passes()).
@@ -1022,7 +1022,7 @@ help([_|T]) ->
help(_) ->
ok.
-
+
%% compile(AbsFileName, Outfilename, Options)
%% Compile entry point for erl_compile.
diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl
index f4e609bf5b..879af3efea 100644
--- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl
+++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl
@@ -123,7 +123,7 @@ format_error(Other) -> io_lib:write(Other).
string_thing($') -> "atom";
string_thing($") -> "string".
-
+
%% Re-entrant pre-scanner.
%%
%% If the input list of characters is insufficient to build a term the
@@ -241,7 +241,7 @@ pre_comment(eof, Sofar, Pos) ->
pre_error(E, Epos, Pos) ->
{error,{Epos,core_scan,E}, Pos}.
-
+
%% scan(CharList, StartPos)
%% This takes a list of characters and tries to tokenise them.
%%
diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl
index 41b7cb248d..590cc682c9 100644
--- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl
+++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl
@@ -647,7 +647,7 @@ new_fun_name(#expand{func=F,arity=A,fcount=I}=St) ->
++ "-fun-" ++ integer_to_list(I) ++ "-",
{list_to_atom(Name),St#expand{fcount=I+1}}.
-
+
%% normalise_fields([RecDef]) -> [Field].
%% Normalise the field definitions to always have a default value. If
%% none has been given then use 'undefined'.
@@ -881,7 +881,7 @@ bin_expand_strings(Es) ->
end, Es1, S);
(E, Es1) -> [E|Es1]
end, [], Es).
-
+
%% new_var_name(State) -> {VarName,State}.
new_var_name(St) ->
diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl
index c96837ab5e..45a8bc4ad9 100644
--- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl
+++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl
@@ -1127,7 +1127,7 @@ new_in_all([Le|Les]) ->
foldl(fun (L, Ns) -> intersection((core_lib:get_anno(L))#a.ns, Ns) end,
(core_lib:get_anno(Le))#a.ns, Les);
new_in_all([]) -> [].
-
+
%% The AfterVars are the variables which are used afterwards. We need
%% this to work out which variables are actually exported and used
%% from case/receive. In subblocks/clauses the AfterVars of the block
diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl
index d7c3e1add9..ecba19b1d1 100644
--- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl
+++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl
@@ -129,7 +129,7 @@ function(#c_def{anno=Af,name=#c_fname{id=F,arity=Arity},val=Body}, St0) ->
%%B1 = B0, St3 = St2, %Null second pass
{#k_fdef{anno=#k{us=[],ns=[],a=Af ++ Ab},
func=F,arity=Arity,vars=Kvs,body=B1},St3}.
-
+
%% body(Cexpr, Sub, State) -> {Kexpr,[PreKepxr],State}.
%% Do the main sequence of a body. A body ends in an atomic value or
%% values. Must check if vector first so do expr.
@@ -719,7 +719,7 @@ last([_|T]) -> last(T).
first([_]) -> [];
first([H|T]) -> [H|first(T)].
-
+
%% This code implements the algorithm for an optimizing compiler for
%% pattern matching given "The Implementation of Functional
%% Programming Languages" by Simon Peyton Jones. The code is much
@@ -1143,7 +1143,7 @@ arg_val(Arg) ->
#k_bin_end{} -> 0;
#k_binary{} -> 0
end.
-
+
%% ubody(Expr, Break, State) -> {Expr,[UsedVar],State}.
%% Tag the body sequence with its used variables. These bodies
%% either end with a #k_break{}, or with #k_return{} or an expression
diff --git a/lib/dialyzer/test/small_SUITE_data/results/trec b/lib/dialyzer/test/small_SUITE_data/results/trec
index 01ccc63761..b95df1e6ef 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/trec
+++ b/lib/dialyzer/test/small_SUITE_data/results/trec
@@ -1,7 +1,7 @@
-trec.erl:26: Function test/0 has no local return
-trec.erl:27: The call trec:mk_foo_loc(42,any()) will never return since it differs in the 1st argument from the success typing arguments: ('undefined',atom())
-trec.erl:29: Function mk_foo_loc/2 has no local return
-trec.erl:30: Record construction violates the declared type for #foo{} since variable A cannot be of type atom()
-trec.erl:36: Function mk_foo_exp/2 has no local return
-trec.erl:37: Record construction violates the declared type for #foo{} since variable A cannot be of type atom()
+trec.erl:28: Function test/0 has no local return
+trec.erl:29: The call trec:mk_foo_loc(42,any()) will never return since it differs in the 1st argument from the success typing arguments: ('undefined',atom())
+trec.erl:31: Function mk_foo_loc/2 has no local return
+trec.erl:32: Record construction violates the declared type for #foo{} since variable A cannot be of type atom()
+trec.erl:38: Function mk_foo_exp/2 has no local return
+trec.erl:39: Record construction violates the declared type for #foo{} since variable A cannot be of type atom()
diff --git a/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl b/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl
index 60ffbe818f..ddb97796fb 100644
--- a/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl
+++ b/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl
@@ -1,6 +1,6 @@
%%---------------------------------------------------------------------
%% This is added as a test because it was giving a false positive
-%% (function move/4 will nevr be called) due to the strange use of
+%% (function move/4 will never be called) due to the strange use of
%% self-recursive fun construction in placex/3.
%%
%% The analysis was getting confused that the foldl call will never
diff --git a/lib/dialyzer/test/small_SUITE_data/src/contract3.erl b/lib/dialyzer/test/small_SUITE_data/src/contract3.erl
index 5b0bee9694..a6ce91882e 100644
--- a/lib/dialyzer/test/small_SUITE_data/src/contract3.erl
+++ b/lib/dialyzer/test/small_SUITE_data/src/contract3.erl
@@ -18,16 +18,23 @@ t(X, Y, Z) ->
(atom()|list()) -> atom().
t1(X) ->
- foo:bar(X).
+ f(X).
-spec t2(atom(), integer()) -> integer();
(atom(), list()) -> atom().
t2(X, Y) ->
- foo:bar(X, Y).
+ g(X, Y).
-spec t3(atom(), integer(), list()) -> integer();
(X, integer(), list()) -> X.
t3(X, Y, Z) ->
X.
+
+%% dummy functions below
+
+f(X) -> X.
+
+g(X, Y) when is_atom(X), is_integer(Y) -> Y;
+g(X, Y) when is_atom(X), is_list(Y) -> X.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl b/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl
index b58fa732cb..3acc5ca065 100644
--- a/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl
+++ b/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl
@@ -1,6 +1,6 @@
%%
-%% The Original Code is RabbitMQ.
-%%
+%% This is stripped down code from RabbitMQ. It is used to report an
+%% invalid type specification for function list_vhost_permissions/1.
%% The Initial Developer of the Original Code is VMware, Inc.
%%
@@ -38,7 +38,7 @@ vhost_perms_info_keys() ->
-spec list_vhost_permissions(vhost()) -> infos().
list_vhost_permissions(VHostPath) ->
- list_permissions(vhost_perms_info_keys(), rabbit_foo:some_list()).
+ list_permissions(vhost_perms_info_keys(), some_mod:some_function()).
filter_props(Keys, Props) ->
[T || T = {K, _} <- Props, lists:member(K, Keys)].
diff --git a/lib/dialyzer/test/small_SUITE_data/src/gencall.erl b/lib/dialyzer/test/small_SUITE_data/src/gencall.erl
index d2875c9df1..762be55007 100644
--- a/lib/dialyzer/test/small_SUITE_data/src/gencall.erl
+++ b/lib/dialyzer/test/small_SUITE_data/src/gencall.erl
@@ -7,6 +7,6 @@
f() ->
gen_server:call(1,2,3),
ets:lookup(1,2,3),
- gencall2:foo(),
+ some_mod:some_function(),
gencall:foo(),
gen_server:handle_cast(1,2).
diff --git a/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl b/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl
index 1743d81493..6d2a35b7c8 100644
--- a/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl
+++ b/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl
@@ -1,7 +1,18 @@
+%%%========================================================================
+%%% Tests handling of maybe improper lists
+%%%========================================================================
-module(maybe_improper).
--export([s/1]).
+-export([s/1, t/0]).
-spec s(maybe_improper_list(X,Y)) -> {[X], maybe_improper_list(X,Y)}.
-s(A) ->
- lists:split(2,A).
+s(L) ->
+ lists:split(2, L).
+
+%% Having a remote type in the 'tail' of the list crashed dialyzer.
+%% The problem was fixed for R16B03.
+-type t_mil() :: maybe_improper_list(integer(), orddict:orddict()).
+
+-spec t() -> t_mil().
+t() ->
+ [42 | []].
diff --git a/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl b/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl
index 0af4f7446f..074a93e2fe 100644
--- a/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl
+++ b/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl
@@ -1,5 +1,5 @@
%%-----------------------------------------------------------------------------
-%% Test that tests overloaded contratcs.
+%% Test that tests overloaded contracts.
%% In December 2008 it works as far as intersection types are concerned (test1)
%% However, it does NOT work as far as type variables are concerned (test2)
%%-----------------------------------------------------------------------------
@@ -16,13 +16,13 @@ test2() ->
-type mod() :: atom().
--spec foo(ATM, list()) -> {'ok', ATM} | {'error', _} when is_subtype(ATM, mod())
- ; (MFA, list()) -> {'ok', MFA} | {'error', _} when is_subtype(MFA, mfa()).
+-spec foo(ATM, list()) -> {'ok', ATM} | {'error', _} when ATM :: mod()
+ ; (MFA, list()) -> {'ok', MFA} | {'error', _} when MFA :: mfa().
foo(F, _) when is_atom(F) ->
case atom_to_list(F) of
- [42|_] -> {ok, F};
- _Other -> {error, mod:bar(F)}
+ [42|_] -> {ok, F};
+ _Other -> {error, some_mod:some_function()}
end;
foo({M,F,A}, _) ->
case A =:= 0 of
diff --git a/lib/dialyzer/test/small_SUITE_data/src/trec.erl b/lib/dialyzer/test/small_SUITE_data/src/trec.erl
index ba50c3b401..06706162c1 100644
--- a/lib/dialyzer/test/small_SUITE_data/src/trec.erl
+++ b/lib/dialyzer/test/small_SUITE_data/src/trec.erl
@@ -18,20 +18,22 @@
%% ('undefined',atom())
%% 3. Function mk_foo_loc/2 has no local return
%%
-%% Arguably, the second warning is not what most users have in mind
-%% when they wrote the type declarations in the 'foo' record, so no
-%% doubt they'll find it confusing. But note that it is also inconsistent!
-%% How come there is a success typing for a function that has no local return?
+%% Arguably, the second warning is not what most users have in mind when
+%% they wrote the type declarations in the 'foo' record, so no doubt
+%% they'll find it confusing. But note that it is also quite confusing!
+%% Many users may be wondering: How come there is a success typing for a
+%% function that has no local return? Running typer on this module
+%% reveals a success typing for this function that is interesting indeed.
%%
test() ->
- mk_foo_loc(42, bar:f()).
+ mk_foo_loc(42, some_mod:some_function()).
mk_foo_loc(A, B) ->
#foo{a = A, b = [A,B]}.
%%
-%% For this function we currently get "has no local return" but we get
-%% no reason; I want us to get a reason.
+%% For this function we used to get a "has no local return" warning
+%% but we got no reason. This has now been fixed.
%%
mk_foo_exp(A, B) when is_integer(A) ->
#foo{a = A, b = [A,B]}.
diff --git a/lib/erl_interface/src/legacy/erl_eterm.c b/lib/erl_interface/src/legacy/erl_eterm.c
index 7ca4f430de..636d26b24b 100644
--- a/lib/erl_interface/src/legacy/erl_eterm.c
+++ b/lib/erl_interface/src/legacy/erl_eterm.c
@@ -686,7 +686,7 @@ int erl_length(const ETERM *ep)
return n;
}
-
+
/***********************************************************************
* I o l i s t f u n c t i o n s
*
diff --git a/lib/erl_interface/test/all_SUITE_data/ei_runner.c b/lib/erl_interface/test/all_SUITE_data/ei_runner.c
index 205f911e38..cdf32b48c4 100644
--- a/lib/erl_interface/test/all_SUITE_data/ei_runner.c
+++ b/lib/erl_interface/test/all_SUITE_data/ei_runner.c
@@ -77,7 +77,7 @@ run_tests(char* argv0, TestCase test_cases[], unsigned number)
}
}
-
+
/***********************************************************************
*
* R e a d i n g p a c k e t s
@@ -182,7 +182,7 @@ char *read_packet(int *len)
return io_buf;
}
-
+
/***********************************************************************
* S e n d i n g r e p l i e s
*
diff --git a/lib/erl_interface/test/all_SUITE_data/runner.c b/lib/erl_interface/test/all_SUITE_data/runner.c
index a474c17722..038d651275 100644
--- a/lib/erl_interface/test/all_SUITE_data/runner.c
+++ b/lib/erl_interface/test/all_SUITE_data/runner.c
@@ -78,7 +78,7 @@ run_tests(char* argv0, TestCase test_cases[], unsigned number)
}
}
-
+
/***********************************************************************
*
* R e a d i n g p a c k e t s
@@ -188,7 +188,7 @@ char *read_packet(int *len)
return io_buf;
}
-
+
/***********************************************************************
* S e n d i n g r e p l i e s
*
diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl
index 48469e68dc..642809ea7a 100644
--- a/lib/erl_interface/test/ei_accept_SUITE.erl
+++ b/lib/erl_interface/test/ei_accept_SUITE.erl
@@ -155,7 +155,7 @@ start_einode(Einode, N, Host, Port) ->
ok.
-
+
%%% Interface functions for ei (erl_interface) functions.
ei_connect_init(P, Num, Cookie, Creation) ->
diff --git a/lib/erl_interface/test/erl_connect_SUITE.erl b/lib/erl_interface/test/erl_connect_SUITE.erl
index bd54013402..c8becc760c 100644
--- a/lib/erl_interface/test/erl_connect_SUITE.erl
+++ b/lib/erl_interface/test/erl_connect_SUITE.erl
@@ -106,7 +106,7 @@ erl_reg_send(Config) when is_list(Config) ->
?line runner:recv_eot(P),
ok.
-
+
%%% Interface functions for erl_interface functions.
erl_connect_init(P, Num, Cookie, Creation) ->
diff --git a/lib/erl_interface/test/erl_eterm_SUITE.erl b/lib/erl_interface/test/erl_eterm_SUITE.erl
index 10a27e48e3..100e9b6f68 100644
--- a/lib/erl_interface/test/erl_eterm_SUITE.erl
+++ b/lib/erl_interface/test/erl_eterm_SUITE.erl
@@ -108,7 +108,7 @@ end_per_group(_GroupName, Config) ->
Config.
-
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%
%%% 1. B a s i c t e s t s
@@ -196,7 +196,7 @@ t_erl_free_compound(Config) when is_list(Config) ->
?line runner:test(?t_erl_free_compound),
ok.
-
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%
%%% 2. C o n s t r u c t i n g t e r m s
@@ -521,7 +521,7 @@ t_erl_cons(Config) when is_list(Config) ->
-
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%
%%% 3. E x t r a c t i n g & i n f o f u n c t i o n s
@@ -669,7 +669,7 @@ t_erl_element(Config) when is_list(Config) ->
ok.
-
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%
%%% 4. I / O l i s t f u n c t i o n s
@@ -894,7 +894,7 @@ iolist_to_string(Port, Term) ->
'NULL' -> 'NULL'
end.
-
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%
%%% 5. M i s c e l l a n o u s T e s t s
diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c b/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c
index 80d7f69520..94959187b9 100644
--- a/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c
+++ b/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c
@@ -269,7 +269,7 @@ TESTCASE(t_erl_free_compound)
report(1);
}
-
+
/***********************************************************************
*
* 2. C o n s t r u c t i n g t e r m s
@@ -1047,7 +1047,7 @@ TESTCASE(t_erl_cons)
-
+
/***********************************************************************
*
* 3. E x t r a c t i n g & i n f o f u n c t i o n s
@@ -1296,7 +1296,7 @@ TESTCASE(extractor_macros)
}
-
+
/***********************************************************************
*
* 4. I / O l i s t f u n c t i o n s
@@ -1393,7 +1393,7 @@ TESTCASE(t_erl_iolist_to_string)
}
}
-
+
/***********************************************************************
*
* 5. M i s c e l l a n o u s T e s t s
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index d1243b2325..d7d8a878c5 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -671,8 +671,9 @@ t_solve_remote(?function(Domain, Range), ET, R, C) ->
{RT2, RR2} = t_solve_remote(Range, ET, R, C),
{?function(RT1, RT2), RR1 ++ RR2};
t_solve_remote(?list(Types, Term, Size), ET, R, C) ->
- {RT, RR} = t_solve_remote(Types, ET, R, C),
- {?list(RT, Term, Size), RR};
+ {RT1, RR1} = t_solve_remote(Types, ET, R, C),
+ {RT2, RR2} = t_solve_remote(Term, ET, R, C),
+ {?list(RT1, RT2, Size), RR1 ++ RR2};
t_solve_remote(?product(Types), ET, R, C) ->
{RL, RR} = list_solve_remote(Types, ET, R, C),
{?product(RL), RR};
@@ -1349,8 +1350,8 @@ t_maybe_improper_list() ->
t_maybe_improper_list(_Content, ?unit) -> ?none;
t_maybe_improper_list(?unit, _Termination) -> ?none;
t_maybe_improper_list(Content, Termination) ->
- %% Safety check
- true = t_is_subtype(t_nil(), Termination),
+ %% Safety check: would be nice to have but does not work with remote types
+ %% true = t_is_subtype(t_nil(), Termination),
?list(Content, Termination, ?unknown_qual).
-spec t_is_maybe_improper_list(erl_type()) -> boolean().
@@ -1365,8 +1366,8 @@ t_is_maybe_improper_list(_) -> false.
%% t_improper_list(?unit, _Termination) -> ?none;
%% t_improper_list(_Content, ?unit) -> ?none;
%% t_improper_list(Content, Termination) ->
-%% %% Safety check
-%% false = t_is_subtype(t_nil(), Termination),
+%% %% Safety check: would be nice to have but does not work with remote types
+%% %% false = t_is_subtype(t_nil(), Termination),
%% ?list(Content, Termination, ?any).
-spec lift_list_to_pos_empty(erl_type()) -> erl_type().
diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml
index d9a27e7d1e..db68cc3116 100644
--- a/lib/inets/doc/src/httpc.xml
+++ b/lib/inets/doc/src/httpc.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2004</year><year>2012</year>
+ <year>2004</year><year>2013</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -440,7 +440,10 @@ apply(Module, Function, [ReplyInfo | Args])
<v>Profile = profile() | pid() (when started <c>stand_alone</c>)</v>
</type>
<desc>
- <p>Cancels an asynchronous HTTP-request. </p>
+ <p>Cancels an asynchronous HTTP-request. Note this does not guarantee
+ that the request response will not be delivered, as it is asynchronous the
+ the request may already have been completed when the cancellation arrives.
+ </p>
<marker id="set_options"></marker>
</desc>
diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl
index 4d7023a8e9..da9bbdd1ec 100644
--- a/lib/inets/src/http_client/httpc.erl
+++ b/lib/inets/src/http_client/httpc.erl
@@ -208,16 +208,8 @@ cancel_request(RequestId) ->
cancel_request(RequestId, Profile)
when is_atom(Profile) orelse is_pid(Profile) ->
?hcrt("cancel request", [{request_id, RequestId}, {profile, Profile}]),
- ok = httpc_manager:cancel_request(RequestId, profile_name(Profile)),
- receive
- %% If the request was already fulfilled throw away the
- %% answer as the request has been canceled.
- {http, {RequestId, _}} ->
- ok
- after 0 ->
- ok
- end.
-
+ httpc_manager:cancel_request(RequestId, profile_name(Profile)).
+
%%--------------------------------------------------------------------------
%% set_options(Options) -> ok | {error, Reason}
@@ -241,14 +233,7 @@ set_options(Options, Profile) when is_atom(Profile) orelse is_pid(Profile) ->
?hcrt("set options", [{options, Options}, {profile, Profile}]),
case validate_options(Options) of
{ok, Opts} ->
- try
- begin
- httpc_manager:set_options(Opts, profile_name(Profile))
- end
- catch
- exit:{noproc, _} ->
- {error, inets_not_started}
- end;
+ httpc_manager:set_options(Opts, profile_name(Profile));
{error, Reason} ->
{error, Reason}
end.
@@ -343,8 +328,6 @@ store_cookies(SetCookieHeaders, Url, Profile)
ok
end
catch
- exit:{noproc, _} ->
- {error, {not_started, Profile}};
error:{badmatch, Bad} ->
{error, {parse_failed, Bad}}
end.
diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl
index 55794f57dc..80c8b2439e 100644
--- a/lib/inets/src/http_client/httpc_handler.erl
+++ b/lib/inets/src/http_client/httpc_handler.erl
@@ -32,7 +32,7 @@
start_link/4,
%% connect_and_send/2,
send/2,
- cancel/3,
+ cancel/2,
stream_next/1,
info/1
]).
@@ -117,8 +117,8 @@ send(Request, Pid) ->
%% Description: Cancels a request. Intended to be called by the httpc
%% manager process.
%%--------------------------------------------------------------------
-cancel(RequestId, Pid, From) ->
- cast({cancel, RequestId, From}, Pid).
+cancel(RequestId, Pid) ->
+ cast({cancel, RequestId}, Pid).
%%--------------------------------------------------------------------
@@ -400,19 +400,17 @@ handle_call(info, _, State) ->
%% handle_keep_alive_queue/2 on the other hand will just skip the
%% request as if it was never issued as in this case the request will
%% not have been sent.
-handle_cast({cancel, RequestId, From},
+handle_cast({cancel, RequestId},
#state{request = #request{id = RequestId} = Request,
profile_name = ProfileName,
canceled = Canceled} = State) ->
?hcrv("cancel current request", [{request_id, RequestId},
{profile, ProfileName},
{canceled, Canceled}]),
- httpc_manager:request_canceled(RequestId, ProfileName, From),
- ?hcrv("canceled", []),
{stop, normal,
State#state{canceled = [RequestId | Canceled],
request = Request#request{from = answer_sent}}};
-handle_cast({cancel, RequestId, From},
+handle_cast({cancel, RequestId},
#state{profile_name = ProfileName,
request = #request{id = CurrId},
canceled = Canceled} = State) ->
@@ -420,8 +418,6 @@ handle_cast({cancel, RequestId, From},
{curr_req_id, CurrId},
{profile, ProfileName},
{canceled, Canceled}]),
- httpc_manager:request_canceled(RequestId, ProfileName, From),
- ?hcrv("canceled", []),
{noreply, State#state{canceled = [RequestId | Canceled]}};
handle_cast(stream_next, #state{session = Session} = State) ->
@@ -521,19 +517,12 @@ handle_info({Proto, _Socket, Data},
activate_once(Session),
{noreply, State#state{mfa = NewMFA}}
catch
- exit:_Exit ->
- ?hcrd("data processing exit", [{exit, _Exit}]),
+ _:_Reason ->
+ ?hcrd("data processing exit", [{exit, _Reason}]),
ClientReason = {could_not_parse_as_http, Data},
ClientErrMsg = httpc_response:error(Request, ClientReason),
NewState = answer_request(Request, ClientErrMsg, State),
- {stop, normal, NewState};
- error:_Error ->
- ?hcrd("data processing error", [{error, _Error}]),
- ClientReason = {could_not_parse_as_http, Data},
- ClientErrMsg = httpc_response:error(Request, ClientReason),
- NewState = answer_request(Request, ClientErrMsg, State),
{stop, normal, NewState}
-
end,
?hcri("data processed", [{final_result, FinalResult}]),
FinalResult;
@@ -1165,7 +1154,7 @@ handle_http_body(Body, #state{headers = Headers,
handle_response(#state{status = new} = State) ->
?hcrd("handle response - status = new", []),
- handle_response(try_to_enable_pipeline_or_keep_alive(State));
+ handle_response(check_persistent(State));
handle_response(#state{request = Request,
status = Status,
@@ -1440,39 +1429,22 @@ is_keep_alive_enabled_server(_,_) ->
is_keep_alive_connection(Headers, #session{client_close = ClientClose}) ->
(not ((ClientClose) orelse httpc_response:is_server_closing(Headers))).
-try_to_enable_pipeline_or_keep_alive(
- #state{session = Session,
- request = #request{method = Method},
+check_persistent(
+ #state{session = #session{type = Type} = Session,
status_line = {Version, _, _},
headers = Headers,
- profile_name = ProfileName} = State) ->
- ?hcrd("try to enable pipeline or keep-alive",
- [{version, Version},
- {headers, Headers},
- {session, Session}]),
+ profile_name = ProfileName} = State) ->
case is_keep_alive_enabled_server(Version, Headers) andalso
- is_keep_alive_connection(Headers, Session) of
+ is_keep_alive_connection(Headers, Session) of
true ->
- case (is_pipeline_enabled_client(Session) andalso
- httpc_request:is_idempotent(Method)) of
- true ->
- insert_session(Session, ProfileName),
- State#state{status = pipeline};
- false ->
- insert_session(Session, ProfileName),
- %% Make sure type is keep_alive in session
- %% as it in this case might be pipeline
- NewSession = Session#session{type = keep_alive},
- State#state{status = keep_alive,
- session = NewSession}
- end;
+ mark_persistent(ProfileName, Session),
+ State#state{status = Type};
false ->
State#state{status = close}
end.
answer_request(#request{id = RequestId, from = From} = Request, Msg,
- #state{session = Session,
- timers = Timers,
+ #state{timers = Timers,
profile_name = ProfileName} = State) ->
?hcrt("answer request", [{request, Request}, {msg, Msg}]),
httpc_response:send(From, Msg),
@@ -1482,19 +1454,14 @@ answer_request(#request{id = RequestId, from = From} = Request, Msg,
Timer = {RequestId, TimerRef},
cancel_timer(TimerRef, {timeout, Request#request.id}),
httpc_manager:request_done(RequestId, ProfileName),
- NewSession = maybe_make_session_available(ProfileName, Session),
Timers2 = Timers#timers{request_timers = lists:delete(Timer,
RequestTimers)},
State#state{request = Request#request{from = answer_sent},
- session = NewSession,
timers = Timers2}.
-maybe_make_session_available(ProfileName,
- #session{available = false} = Session) ->
- update_session(ProfileName, Session, #session.available, true),
- Session#session{available = true};
-maybe_make_session_available(_ProfileName, Session) ->
- Session.
+mark_persistent(ProfileName, Session) ->
+ update_session(ProfileName, Session, #session.persistent, true),
+ Session#session{persistent = true}.
cancel_timers(#timers{request_timers = ReqTmrs, queue_timer = QTmr}) ->
cancel_timer(QTmr, timeout_queue),
diff --git a/lib/inets/src/http_client/httpc_internal.hrl b/lib/inets/src/http_client/httpc_internal.hrl
index 30e2742e9d..d5b3dd2a2a 100644
--- a/lib/inets/src/http_client/httpc_internal.hrl
+++ b/lib/inets/src/http_client/httpc_internal.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2013. 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
@@ -143,8 +143,8 @@
%% true | false
%% This will be true, when a response has been received for
- %% the first request. See type above.
- available = false
+ %% the first request and the server has not closed the connection
+ persistent = false
}).
diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl
index c45dcab802..a3ed371e61 100644
--- a/lib/inets/src/http_client/httpc_manager.erl
+++ b/lib/inets/src/http_client/httpc_manager.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2013. 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
@@ -29,7 +29,6 @@
start_link/3,
request/2,
cancel_request/2,
- request_canceled/3,
request_done/2,
retry_request/2,
redirect_request/2,
@@ -144,22 +143,7 @@ redirect_request(Request, ProfileName) ->
%%--------------------------------------------------------------------
cancel_request(RequestId, ProfileName) ->
- call(ProfileName, {cancel_request, RequestId}).
-
-
-%%--------------------------------------------------------------------
-%% Function: request_canceled(RequestId, ProfileName) -> ok
-%% RequestId - ref()
-%% ProfileName = atom()
-%%
-%% Description: Confirms that a request has been canceld. Intended to
-%% be called by the httpc handler process.
-%%--------------------------------------------------------------------
-
-request_canceled(RequestId, ProfileName, From) ->
- gen_server:reply(From, ok),
- cast(ProfileName, {request_canceled, RequestId}).
-
+ cast(ProfileName, {cancel_request, RequestId}).
%%--------------------------------------------------------------------
%% Function: request_done(RequestId, ProfileName) -> ok
@@ -467,33 +451,13 @@ do_init(ProfileName, CookiesDir) ->
%%--------------------------------------------------------------------
handle_call({request, Request}, _, State) ->
?hcri("request", [{request, Request}]),
- case (catch handle_request(Request, State)) of
+ case (catch handle_request(Request, State, false)) of
{reply, Msg, NewState} ->
{reply, Msg, NewState};
Error ->
{stop, Error, httpc_response:error(Request, Error), State}
end;
-handle_call({cancel_request, RequestId}, From,
- #state{handler_db = HandlerDb} = State) ->
- ?hcri("cancel_request", [{request_id, RequestId}]),
- case ets:lookup(HandlerDb, RequestId) of
- [] ->
- %% The request has allready compleated make sure
- %% it is deliverd to the client process queue so
- %% it can be thrown away by httpc:cancel_request
- %% This delay is hopfully a temporary workaround.
- %% Note that it will not not delay the manager,
- %% only the client that called httpc:cancel_request
- timer:apply_after(?DELAY, gen_server, reply, [From, ok]),
- {noreply, State};
- [{_, Pid, _}] ->
- httpc_handler:cancel(RequestId, Pid, From),
- {noreply,
- State#state{cancel =
- [{RequestId, Pid, From} | State#state.cancel]}}
- end;
-
handle_call(reset_cookies, _, #state{cookie_db = CookieDb} = State) ->
?hcrv("reset cookies", []),
httpc_cookie:reset_db(CookieDb),
@@ -547,7 +511,7 @@ handle_cast({retry_or_redirect_request, {Time, Request}},
{noreply, State};
handle_cast({retry_or_redirect_request, Request}, State) ->
- case (catch handle_request(Request, State)) of
+ case (catch handle_request(Request, State, true)) of
{reply, {ok, _}, NewState} ->
{noreply, NewState};
Error ->
@@ -555,19 +519,19 @@ handle_cast({retry_or_redirect_request, Request}, State) ->
{stop, Error, State}
end;
-handle_cast({request_canceled, RequestId}, State) ->
- ?hcrv("request canceled", [{request_id, RequestId}]),
- ets:delete(State#state.handler_db, RequestId),
- case lists:keysearch(RequestId, 1, State#state.cancel) of
- {value, Entry = {RequestId, _, From}} ->
- ?hcrt("found in cancel", [{from, From}]),
- {noreply,
- State#state{cancel = lists:delete(Entry, State#state.cancel)}};
- Else ->
- ?hcrt("not found in cancel", [{else, Else}]),
- {noreply, State}
+handle_cast({cancel_request, RequestId},
+ #state{handler_db = HandlerDb} = State) ->
+ case ets:lookup(HandlerDb, RequestId) of
+ [] ->
+ %% Request already compleated nothing to
+ %% cancel
+ {noreply, State};
+ [{_, Pid, _}] ->
+ httpc_handler:cancel(RequestId, Pid),
+ ets:delete(State#state.handler_db, RequestId),
+ {noreply, State}
end;
-
+
handle_cast({request_done, RequestId}, State) ->
?hcrv("request done", [{request_id, RequestId}]),
ets:delete(State#state.handler_db, RequestId),
@@ -629,22 +593,8 @@ handle_info({'EXIT', _, _}, State) ->
%% Handled in DOWN
{noreply, State};
handle_info({'DOWN', _, _, Pid, _}, State) ->
- ets:match_delete(State#state.handler_db, {'_', Pid, '_'}),
-
- %% If there where any canceled request, handled by the
- %% the process that now has terminated, the
- %% cancelation can be viewed as sucessfull!
- NewCanceldList =
- lists:foldl(fun(Entry = {_, HandlerPid, From}, Acc) ->
- case HandlerPid of
- Pid ->
- gen_server:reply(From, ok),
- lists:delete(Entry, Acc);
- _ ->
- Acc
- end
- end, State#state.cancel, State#state.cancel),
- {noreply, State#state{cancel = NewCanceldList}};
+ ets:match_delete(State#state.handler_db, {'_', Pid, '_'}),
+ {noreply, State};
handle_info(Info, State) ->
Report = io_lib:format("Unknown message in "
"httpc_manager:handle_info ~p~n", [Info]),
@@ -774,7 +724,7 @@ get_handler_info(Tab) ->
handle_request(#request{settings =
#http_options{version = "HTTP/0.9"}} = Request,
- State) ->
+ State, _) ->
%% Act as an HTTP/0.9 client that does not know anything
%% about persistent connections
@@ -787,7 +737,7 @@ handle_request(#request{settings =
handle_request(#request{settings =
#http_options{version = "HTTP/1.0"}} = Request,
- State) ->
+ State, _) ->
%% Act as an HTTP/1.0 client that does not
%% use persistent connections
@@ -798,13 +748,13 @@ handle_request(#request{settings =
start_handler(NewRequest#request{headers = NewHeaders}, State),
{reply, {ok, NewRequest#request.id}, State};
-handle_request(Request, State = #state{options = Options}) ->
+handle_request(Request, State = #state{options = Options}, Retry) ->
NewRequest = handle_cookies(generate_request_id(Request), State),
SessionType = session_type(Options),
case select_session(Request#request.method,
Request#request.address,
- Request#request.scheme, SessionType, State) of
+ Request#request.scheme, SessionType, State, Retry) of
{ok, HandlerPid} ->
pipeline_or_keep_alive(NewRequest, HandlerPid, State);
no_connection ->
@@ -828,6 +778,7 @@ start_handler(#request{id = Id,
#state{profile_name = ProfileName,
handler_db = HandlerDb,
options = Options}) ->
+ ClientClose = httpc_request:is_client_closing(Request#request.headers),
{ok, Pid} =
case is_inets_manager() of
true ->
@@ -838,13 +789,18 @@ start_handler(#request{id = Id,
end,
HandlerInfo = {Id, Pid, From},
ets:insert(HandlerDb, HandlerInfo),
+ insert_session(#session{id = {Request#request.address, Pid},
+ scheme = Request#request.scheme,
+ client_close = ClientClose,
+ type = session_type(Options)
+ }, ProfileName),
erlang:monitor(process, Pid).
select_session(Method, HostPort, Scheme, SessionType,
#state{options = #options{max_pipeline_length = MaxPipe,
max_keep_alive_length = MaxKeepAlive},
- session_db = SessionDb}) ->
+ session_db = SessionDb}, Retry) ->
?hcrd("select session", [{session_type, SessionType},
{max_pipeline_length, MaxPipe},
{max_keep_alive_length, MaxKeepAlive}]),
@@ -857,19 +813,29 @@ select_session(Method, HostPort, Scheme, SessionType,
%% client_close, scheme and type specified.
%% The fields id (part of: HandlerPid) and queue_length
%% specified.
- Pattern = #session{id = {HostPort, '$1'},
- client_close = false,
- scheme = Scheme,
- queue_length = '$2',
- type = SessionType,
- available = true,
- _ = '_'},
+ Pattern = case (Retry andalso SessionType == pipeline) of
+ true ->
+ #session{id = {HostPort, '$1'},
+ client_close = false,
+ scheme = Scheme,
+ queue_length = '$2',
+ type = SessionType,
+ persistent = true,
+ _ = '_'};
+ false ->
+ #session{id = {HostPort, '$1'},
+ client_close = false,
+ scheme = Scheme,
+ queue_length = '$2',
+ type = SessionType,
+ _ = '_'}
+ end,
%% {'_', {HostPort, '$1'}, false, Scheme, '_', '$2', SessionTyp},
Candidates = ets:match(SessionDb, Pattern),
?hcrd("select session", [{host_port, HostPort},
{scheme, Scheme},
{type, SessionType},
- {candidates, Candidates}]),
+ {candidates, Candidates}]),
select_session(Candidates, MaxKeepAlive, MaxPipe, SessionType);
false ->
no_connection
diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl
index 0c35f284f7..818edc12ac 100644
--- a/lib/inets/test/httpc_SUITE.erl
+++ b/lib/inets/test/httpc_SUITE.erl
@@ -277,9 +277,6 @@ trace(Config) when is_list(Config) ->
pipeline(Config) when is_list(Config) ->
Request = {url(group_name(Config), "/dummy.html", Config), []},
{ok, _} = httpc:request(get, Request, [], [], pipeline),
-
- %% Make sure pipeline session is registerd
- test_server:sleep(4000),
keep_alive_requests(Request, pipeline).
%%--------------------------------------------------------------------
@@ -287,9 +284,6 @@ pipeline(Config) when is_list(Config) ->
persistent_connection(Config) when is_list(Config) ->
Request = {url(group_name(Config), "/dummy.html", Config), []},
{ok, _} = httpc:request(get, Request, [], [], persistent),
-
- %% Make sure pipeline session is registerd
- test_server:sleep(4000),
keep_alive_requests(Request, persistent).
%%-------------------------------------------------------------------------
@@ -311,13 +305,8 @@ async(Config) when is_list(Config) ->
{ok, NewRequestId} =
httpc:request(get, Request, [], [{sync, false}]),
- ok = httpc:cancel_request(NewRequestId),
- receive
- {http, {NewRequestId, _}} ->
- ct:fail(http_cancel_request_failed)
- after 3000 ->
- ok
- end.
+ ok = httpc:cancel_request(NewRequestId).
+
%%-------------------------------------------------------------------------
save_to_file() ->
[{doc, "Test to save the http body to a file"}].
@@ -1149,7 +1138,7 @@ receive_replys([ID|IDs]) ->
{http, {ID, {{_, 200, _}, [_|_], _}}} ->
receive_replys(IDs);
{http, {Other, {{_, 200, _}, [_|_], _}}} ->
- ct:fail({recived_canceld_id, Other})
+ ct:pal({recived_canceld_id, Other})
end.
%% Perform a synchronous stop
diff --git a/lib/kernel/doc/src/gen_sctp.xml b/lib/kernel/doc/src/gen_sctp.xml
index 7ea58fffff..33f1c20608 100644
--- a/lib/kernel/doc/src/gen_sctp.xml
+++ b/lib/kernel/doc/src/gen_sctp.xml
@@ -322,7 +322,7 @@
<p>
Branch off an existing association <anno>Assoc</anno>
in a socket <anno>Socket</anno> of type <c>seqpacket</c>
- (one-to-may style) into
+ (one-to-many style) into
a new socket <anno>NewSocket</anno> of type <c>stream</c>
(one-to-one style).
</p>
diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl
index 58d84ae924..067e07304d 100644
--- a/lib/kernel/src/gen_sctp.erl
+++ b/lib/kernel/src/gen_sctp.erl
@@ -423,7 +423,11 @@ error_string(9) ->
error_string(10) ->
"Cookie Received While Shutting Down";
error_string(11) ->
+ "Restart of an Association with New Addresses";
+error_string(12) ->
"User Initiated Abort";
+error_string(13) ->
+ "Protocol Violation";
%% For more info on principal SCTP error codes: phone +44 7981131933
error_string(N) when is_integer(N) ->
unknown_error;
diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl
index 27f085c3aa..d4c78505da 100644
--- a/lib/kernel/src/inet.erl
+++ b/lib/kernel/src/inet.erl
@@ -120,6 +120,17 @@
'addr' | 'broadaddr' | 'dstaddr' |
'mtu' | 'netmask' | 'flags' |'hwaddr'.
+-type if_getopt_result() ::
+ {'addr', ip_address()} |
+ {'broadaddr', ip_address()} |
+ {'dstaddr', ip_address()} |
+ {'mtu', non_neg_integer()} |
+ {'netmask', ip_address()} |
+ {'flags', ['up' | 'down' | 'broadcast' | 'no_broadcast' |
+ 'pointtopoint' | 'no_pointtopoint' |
+ 'running' | 'multicast' | 'loopback']} |
+ {'hwaddr', ether_address()}.
+
-type address_family() :: 'inet' | 'inet6'.
-type socket_protocol() :: 'tcp' | 'udp' | 'sctp'.
-type socket_type() :: 'stream' | 'dgram' | 'seqpacket'.
@@ -266,13 +277,13 @@ getiflist() ->
-spec ifget(Socket :: socket(),
Name :: string() | atom(),
Opts :: [if_getopt()]) ->
- {'ok', [if_setopt()]} | {'error', posix()}.
+ {'ok', [if_getopt_result()]} | {'error', posix()}.
ifget(Socket, Name, Opts) ->
prim_inet:ifget(Socket, Name, Opts).
-spec ifget(Name :: string() | atom(), Opts :: [if_getopt()]) ->
- {'ok', [if_setopt()]} | {'error', posix()}.
+ {'ok', [if_getopt_result()]} | {'error', posix()}.
ifget(Name, Opts) ->
withsocket(fun(S) -> prim_inet:ifget(S, Name, Opts) end).
diff --git a/lib/observer/doc/src/ttb.xml b/lib/observer/doc/src/ttb.xml
index 4e63aecbf2..1453bbdf10 100644
--- a/lib/observer/doc/src/ttb.xml
+++ b/lib/observer/doc/src/ttb.xml
@@ -105,8 +105,9 @@ ttb:p(all, call)</code>
<v>Nodes = atom() | [atom()] | all | existing | new</v>
<v>Opts = Opt | [Opt]</v>
<v>Opt = {file,Client} | {handler, FormatHandler} | {process_info,PI} |
- shell | {shell, ShellSpec} | {timer, TimerSpec} | {overload, {MSec, Module, Function}}
- | {flush, MSec} | resume | {resume, FetchTimeout}</v>
+ shell | {shell, ShellSpec} | {timer, TimerSpec} |
+ {overload_check, {MSec, Module, Function}} |
+ {flush, MSec} | resume | {resume, FetchTimeout}</v>
<v>TimerSpec = MSec | {MSec, StopOpts}</v>
<v>MSec = FetchTimeout = integer()</v>
<v>Module = Function = atom() </v>
@@ -158,7 +159,7 @@ ttb:p(all, call)</code>
network communication are always present. The timer starts after
<c>ttb:p/2</c> is issued, so you can set up your trace patterns before.
</p>
- <p>The <c>overload</c> option allows to enable overload
+ <p>The <c>overload_check</c> option allows to enable overload
checking on the nodes under trace. <c>Module:Function(check)</c>
is performed each <c>MSec</c> milliseconds. If the check returns
<c>true</c>, the tracing is disabled on a given node.<br/>
diff --git a/lib/orber/test/multi_ORB_SUITE.erl b/lib/orber/test/multi_ORB_SUITE.erl
index 3c1ffd59d3..41a309ff16 100644
--- a/lib/orber/test/multi_ORB_SUITE.erl
+++ b/lib/orber/test/multi_ORB_SUITE.erl
@@ -75,8 +75,6 @@
close_connections_local_interface_ctx_override_api/1,
ssl_1_multi_orber_generation_3_api/1, ssl_2_multi_orber_generation_3_api/1,
ssl_reconfigure_generation_3_api/1,
- ssl_1_multi_orber_generation_3_api_old/1, ssl_2_multi_orber_generation_3_api_old/1,
- ssl_reconfigure_generation_3_api_old/1,
close_connections_alt_iiop_addr_api/1, close_connections_multiple_profiles_api/1]).
@@ -137,13 +135,10 @@ cases() ->
setup_multi_connection_timeout_attempts_api,
setup_multi_connection_timeout_random_api,
ssl_1_multi_orber_api,
- ssl_1_multi_orber_generation_3_api_old,
ssl_1_multi_orber_generation_3_api,
ssl_2_multi_orber_api,
- ssl_2_multi_orber_generation_3_api_old,
ssl_2_multi_orber_generation_3_api,
ssl_reconfigure_api,
- ssl_reconfigure_generation_3_api_old,
ssl_reconfigure_generation_3_api].
%%-----------------------------------------------------------------
@@ -155,10 +150,7 @@ init_per_testcase(TC,Config)
TC =:= ssl_reconfigure_api ->
init_ssl(Config);
init_per_testcase(TC,Config)
- when TC =:= ssl_1_multi_orber_generation_3_api_old;
- TC =:= ssl_2_multi_orber_generation_3_api_old;
- TC =:= ssl_reconfigure_generation_3_api_old;
- TC =:= ssl_1_multi_orber_generation_3_api;
+ when TC =:= ssl_1_multi_orber_generation_3_api;
TC =:= ssl_2_multi_orber_generation_3_api;
TC =:= ssl_reconfigure_generation_3_api ->
init_ssl_3(Config);
@@ -1632,22 +1624,6 @@ ssl_1_multi_orber_api(_Config) ->
ssl_suite(ServerOptions, ClientOptions).
-ssl_1_multi_orber_generation_3_api_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)",
- "This case set up two secure orbs and test if they can",
- "communicate. The case also test to access one of the",
- "secure orbs which must raise a NO_PERMISSION exception."];
-ssl_1_multi_orber_generation_3_api_old(suite) -> [];
-ssl_1_multi_orber_generation_3_api_old(_Config) ->
-
- ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server,
- 1, [{ssl_generation, 3},
- {iiop_ssl_port, 0}]),
- ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client,
- 1, [{ssl_generation, 3},
- {iiop_ssl_port, 0}]),
- ssl_suite(ServerOptions, ClientOptions).
-
-
ssl_1_multi_orber_generation_3_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)",
"This case set up two secure orbs and test if they can",
"communicate. The case also test to access one of the",
@@ -1681,22 +1657,6 @@ ssl_2_multi_orber_api(_Config) ->
ssl_suite(ServerOptions, ClientOptions).
-ssl_2_multi_orber_generation_3_api_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)",
- "This case set up two secure orbs and test if they can",
- "communicate. The case also test to access one of the",
- "secure orbs which must raise a NO_PERMISSION exception."];
-ssl_2_multi_orber_generation_3_api_old(suite) -> [];
-ssl_2_multi_orber_generation_3_api_old(_Config) ->
-
- ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server,
- 2, [{ssl_generation, 3},
- {iiop_ssl_port, 0}]),
- ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client,
- 2, [{ssl_generation, 3},
- {iiop_ssl_port, 0}]),
- ssl_suite(ServerOptions, ClientOptions).
-
-
ssl_2_multi_orber_generation_3_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)",
"This case set up two secure orbs and test if they can",
"communicate. The case also test to access one of the",
@@ -1724,11 +1684,6 @@ ssl_reconfigure_api(_Config) ->
ssl_reconfigure_old([]).
-ssl_reconfigure_generation_3_api_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)",
- "This case set up two secure orbs and test if they can",
- "communicate. The case also test to access one of the",
- "secure orbs which must raise a NO_PERMISSION exception."];
-ssl_reconfigure_generation_3_api_old(suite) -> [];
ssl_reconfigure_generation_3_api_old(_Config) ->
ssl_reconfigure_old([{ssl_generation, 3}]).
diff --git a/lib/orber/test/orber_nat_SUITE.erl b/lib/orber/test/orber_nat_SUITE.erl
index ee31b162c2..a21bd4d499 100644
--- a/lib/orber/test/orber_nat_SUITE.erl
+++ b/lib/orber/test/orber_nat_SUITE.erl
@@ -57,7 +57,6 @@
nat_ip_address_local/1, nat_ip_address_local_local/1,
nat_iiop_port/1, nat_iiop_port_local/1,
nat_iiop_port_local_local/1,
- nat_iiop_ssl_port_old/1, nat_iiop_ssl_port_local_old/1,
nat_iiop_ssl_port/1, nat_iiop_ssl_port_local/1]).
@@ -93,8 +92,6 @@ cases() ->
nat_iiop_port_local,
nat_ip_address_local_local,
nat_iiop_port_local_local,
- nat_iiop_ssl_port_old,
- nat_iiop_ssl_port_local_old,
nat_iiop_ssl_port,
nat_iiop_ssl_port_local].
@@ -103,9 +100,7 @@ cases() ->
%%-----------------------------------------------------------------
init_per_testcase(TC, Config)
when TC =:= nat_iiop_ssl_port;
- TC =:= nat_iiop_ssl_port_local;
- TC =:= nat_iiop_ssl_port_old;
- TC =:= nat_iiop_ssl_port_local_old ->
+ TC =:= nat_iiop_ssl_port_local ->
case ?config(crypto_started, Config) of
true ->
case orber_test_lib:ssl_version() of
@@ -291,106 +286,6 @@ nat_iiop_port_local_local(_Config) ->
%% API tests for ORB to ORB, ssl security depth 1
%%-----------------------------------------------------------------
-nat_iiop_ssl_port_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)",
- "Make sure NAT works for SSL"];
-nat_iiop_ssl_port_old(suite) -> [];
-nat_iiop_ssl_port_old(_Config) ->
-
- IP = orber_test_lib:get_host(),
- ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server,
- 1, [{iiop_ssl_port, 0},
- {flags, ?ORB_ENV_ENABLE_NAT},
- {ip_address, IP}]),
- ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client,
- 1, [{iiop_ssl_port, 0}]),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []),
- NATSSLServerPort = SSLServerPort+1,
- {ok, Ref} = ?match({ok, _},
- orber_test_lib:remote_apply(ServerNode, orber,
- add_listen_interface,
- [IP, ssl, NATSSLServerPort])),
- orber_test_lib:remote_apply(ServerNode, orber_env, configure_override,
- [nat_iiop_ssl_port,
- {local, NATSSLServerPort, [{4001, 43}]}]),
-
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)),
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [ssl])),
-
- IOR1 = ?match(#'IOP_IOR'{},
- orber_test_lib:remote_apply(ClientNode, corba,
- string_to_object,
- ["corbaname::1.2@"++IP++":"++
- integer_to_list(ServerPort)++"/NameService#mamba"])),
-
- ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP,
- #host_data{protocol = ssl,
- ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}},
- iop_ior:get_key(IOR1)),
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- uninstall_test_data,
- [ssl])),
- ?match(ok,
- orber_test_lib:remote_apply(ServerNode, orber,
- remove_listen_interface, [Ref])),
- ok.
-
-nat_iiop_ssl_port_local_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)",
- "Make sure NAT works for SSL"];
-nat_iiop_ssl_port_local_old(suite) -> [];
-nat_iiop_ssl_port_local_old(_Config) ->
-
- IP = orber_test_lib:get_host(),
- ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server,
- 1, [{iiop_ssl_port, 0},
- {flags,
- (?ORB_ENV_LOCAL_INTERFACE bor
- ?ORB_ENV_ENABLE_NAT)},
- {ip_address, IP}]),
- ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client,
- 1, [{iiop_ssl_port, 0}]),
- {ok, ServerNode, _ServerHost} =
- ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)),
- ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []),
- SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []),
- NATSSLServerPort = SSLServerPort+1,
- {ok, Ref} = ?match({ok, _},
- orber_test_lib:remote_apply(ServerNode, orber,
- add_listen_interface,
- [IP, ssl, NATSSLServerPort])),
- orber_test_lib:remote_apply(ServerNode, orber_env, configure_override,
- [nat_iiop_ssl_port,
- {local, NATSSLServerPort, [{NATSSLServerPort, NATSSLServerPort}]}]),
-
- {ok, ClientNode, _ClientHost} =
- ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)),
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- install_test_data,
- [ssl])),
-
- IOR1 = ?match(#'IOP_IOR'{},
- orber_test_lib:remote_apply(ClientNode, corba,
- string_to_object,
- ["corbaname::1.2@"++IP++":"++
- integer_to_list(ServerPort)++"/NameService#mamba"])),
-
- ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP,
- #host_data{protocol = ssl,
- ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}},
- iop_ior:get_key(IOR1)),
- ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib,
- uninstall_test_data,
- [ssl])),
- ?match(ok,
- orber_test_lib:remote_apply(ServerNode, orber,
- remove_listen_interface, [Ref])),
- ok.
-
nat_iiop_ssl_port(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)",
"Make sure NAT works for SSL"];
diff --git a/lib/public_key/doc/src/using_public_key.xml b/lib/public_key/doc/src/using_public_key.xml
index b744704c47..450bd7e35f 100644
--- a/lib/public_key/doc/src/using_public_key.xml
+++ b/lib/public_key/doc/src/using_public_key.xml
@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="iso-8859-1" ?>
+<?xml version="1.0" encoding="utf-8" ?>
<!DOCTYPE chapter SYSTEM "chapter.dtd">
<chapter>
@@ -90,7 +90,7 @@
[{'RSAPrivateKey',&lt;&lt;224,108,117,203,152,40,15,77,128,126,
221,195,154,249,85,208,202,251,109,
119,120,57,29,89,19,9,...&gt;&gt;,
- {"DES-EDE3-CBC",&lt;&lt;"k�e��p�L"&gt;&gt;}}]
+ {"DES-EDE3-CBC",&lt;&lt;"kÙeø¼pµL"&gt;&gt;}}]
</code>
diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index 141d3df38e..fb58a4b014 100644
--- a/lib/ssh/doc/src/ssh.xml
+++ b/lib/ssh/doc/src/ssh.xml
@@ -141,7 +141,7 @@
<p>Sets the preferred public key algorithm to use for user
authentication. If the the preferred algorithm fails for
some reason, the other algorithm is tried. The default is
- to try <c><![CDATA[ssh_rsa]]></c> first.</p>
+ to try <c><![CDATA['ssh-rsa']]></c> first.</p>
</item>
<tag><c><![CDATA[{pref_public_key_algs, list()}]]></c></tag>
<item>
@@ -248,7 +248,7 @@
requested by the client. Default is to use the erlang shell:
<c><![CDATA[{shell, start, []}]]></c>
</item>
- <tag><c><![CDATA[{ssh_cli,{channel_callback(),
+ <tag><c><![CDATA[{ssh_cli, {channel_callback(),
channel_init_args()}}]]></c></tag>
<item>
Provides your own cli implementation, i.e. a channel callback
diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index 6513042e98..e6ed0d8626 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -34,7 +34,7 @@
-export([security_parameters/2, security_parameters/3, suite_definition/1,
decipher/5, cipher/5,
- suite/1, suites/1, anonymous_suites/0, psk_suites/1, srp_suites/0,
+ suite/1, suites/1, ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0,
openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1,
hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2]).
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index 29a8996bd6..b18452a8f2 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -49,13 +49,13 @@
]).
%% Cipher suites handling
--export([available_suites/2, available_suites/3, cipher_suites/2,
- select_session/10]).
+-export([available_suites/2, cipher_suites/2,
+ select_session/10, supported_ecc/1]).
%% Extensions handling
-export([client_hello_extensions/5,
handle_client_hello_extensions/8, %% Returns server hello extensions
- handle_server_hello_extensions/9
+ handle_server_hello_extensions/9, select_curve/2
]).
%% MISC
@@ -89,7 +89,7 @@ client_hello_extensions(Version, CipherSuites, SslOpts, ConnectionStates, Renego
{EcPointFormats, EllipticCurves} =
case advertises_ec_ciphers(lists:map(fun ssl_cipher:suite_definition/1, CipherSuites)) of
true ->
- ecc_extensions(tls_v1, Version);
+ client_ecc_extensions(tls_v1, Version);
false ->
{undefined, undefined}
end,
@@ -861,22 +861,29 @@ available_suites(UserSuites, Version) ->
UserSuites
end.
-available_suites(ServerCert, UserSuites, Version) ->
- ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version)).
+available_suites(ServerCert, UserSuites, Version, Curve) ->
+ ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version))
+ -- unavailable_ecc_suites(Curve).
+
+unavailable_ecc_suites(no_curve) ->
+ ssl_cipher:ec_keyed_suites();
+unavailable_ecc_suites(_) ->
+ [].
cipher_suites(Suites, false) ->
[?TLS_EMPTY_RENEGOTIATION_INFO_SCSV | Suites];
cipher_suites(Suites, true) ->
Suites.
-select_session(SuggestedSessionId, CipherSuites, Compressions, Port, Session, Version,
+select_session(SuggestedSessionId, CipherSuites, Compressions, Port, #session{ecc = ECCCurve} =
+ Session, Version,
#ssl_options{ciphers = UserSuites} = SslOpts, Cache, CacheCb, Cert) ->
{SessionId, Resumed} = ssl_session:server_id(Port, SuggestedSessionId,
SslOpts, Cert,
Cache, CacheCb),
- Suites = ssl_handshake:available_suites(Cert, UserSuites, Version),
case Resumed of
undefined ->
+ Suites = available_suites(Cert, UserSuites, Version, ECCCurve),
CipherSuite = select_cipher_suite(CipherSuites, Suites),
Compression = select_compression(Compressions),
{new, Session#session{session_id = SessionId,
@@ -886,6 +893,13 @@ select_session(SuggestedSessionId, CipherSuites, Compressions, Port, Session, Ve
{resumed, Resumed}
end.
+supported_ecc(Version) ->
+ case tls_v1:ecc_curves(Version) of
+ [] ->
+ undefined;
+ Curves ->
+ #elliptic_curves{elliptic_curve_list = Curves}
+ end.
%%-------------certificate handling --------------------------------
certificate_types({KeyExchange, _, _, _})
@@ -926,9 +940,8 @@ certificate_authorities_from_db(CertDbHandle, CertDbRef) ->
handle_client_hello_extensions(RecordCB, Random,
#hello_extensions{renegotiation_info = Info,
srp = SRP,
- next_protocol_negotiation = NextProtocolNegotiation,
- ec_point_formats = EcPointFormats0,
- elliptic_curves = EllipticCurves0}, Version,
+ ec_point_formats = ECCFormat,
+ next_protocol_negotiation = NextProtocolNegotiation}, Version,
#ssl_options{secure_renegotiate = SecureRenegotation} = Opts,
#session{cipher_suite = CipherSuite, compression_method = Compression} = Session0,
ConnectionStates0, Renegotiation) ->
@@ -937,12 +950,11 @@ handle_client_hello_extensions(RecordCB, Random,
Random, CipherSuite, Compression,
ConnectionStates0, Renegotiation, SecureRenegotation),
ProtocolsToAdvertise = handle_next_protocol_extension(NextProtocolNegotiation, Renegotiation, Opts),
- {EcPointFormats, EllipticCurves} = handle_ecc_extensions(Version, EcPointFormats0, EllipticCurves0),
+
ServerHelloExtensions = #hello_extensions{
renegotiation_info = renegotiation_info(RecordCB, server,
ConnectionStates, Renegotiation),
- ec_point_formats = EcPointFormats,
- elliptic_curves = EllipticCurves,
+ ec_point_formats = server_ecc_extension(Version, ECCFormat),
next_protocol_negotiation =
encode_protocols_advertised_on_server(ProtocolsToAdvertise)
},
@@ -1078,7 +1090,7 @@ srp_user(#ssl_options{srp_identity = {UserName, _}}) ->
srp_user(_) ->
undefined.
-ecc_extensions(Module, Version) ->
+client_ecc_extensions(Module, Version) ->
CryptoSupport = proplists:get_value(public_keys, crypto:supports()),
case proplists:get_bool(ecdh, CryptoSupport) of
true ->
@@ -1089,15 +1101,13 @@ ecc_extensions(Module, Version) ->
{undefined, undefined}
end.
-handle_ecc_extensions(Version, EcPointFormats0, EllipticCurves0) ->
+server_ecc_extension(_Version, EcPointFormats) ->
CryptoSupport = proplists:get_value(public_keys, crypto:supports()),
case proplists:get_bool(ecdh, CryptoSupport) of
true ->
- EcPointFormats1 = handle_ecc_point_fmt_extension(EcPointFormats0),
- EllipticCurves1 = handle_ecc_curves_extension(Version, EllipticCurves0),
- {EcPointFormats1, EllipticCurves1};
- _ ->
- {undefined, undefined}
+ handle_ecc_point_fmt_extension(EcPointFormats);
+ false ->
+ undefined
end.
handle_ecc_point_fmt_extension(undefined) ->
@@ -1105,11 +1115,6 @@ handle_ecc_point_fmt_extension(undefined) ->
handle_ecc_point_fmt_extension(_) ->
#ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}.
-handle_ecc_curves_extension(_Version, undefined) ->
- undefined;
-handle_ecc_curves_extension(Version, _) ->
- #elliptic_curves{elliptic_curve_list = tls_v1:ecc_curves(Version)}.
-
advertises_ec_ciphers([]) ->
false;
advertises_ec_ciphers([{ecdh_ecdsa, _,_,_} | _]) ->
@@ -1124,6 +1129,22 @@ advertises_ec_ciphers([{ecdh_anon, _,_,_} | _]) ->
true;
advertises_ec_ciphers([_| Rest]) ->
advertises_ec_ciphers(Rest).
+select_curve(#elliptic_curves{elliptic_curve_list = ClientCurves},
+ #elliptic_curves{elliptic_curve_list = ServerCurves}) ->
+ select_curve(ClientCurves, ServerCurves);
+select_curve(undefined, _) ->
+ %% Client did not send ECC extension use default curve if
+ %% ECC cipher is negotiated
+ {namedCurve, ?secp256k1};
+select_curve(_, []) ->
+ no_curve;
+select_curve(Curves, [Curve| Rest]) ->
+ case lists:member(Curve, Curves) of
+ true ->
+ {namedCurve, Curve};
+ false ->
+ select_curve(Curves, Rest)
+ end.
%%--------------------------------------------------------------------
%%% Internal functions
@@ -1648,3 +1669,4 @@ advertised_hash_signs({Major, Minor}) when Major >= 3 andalso Minor >= 3 ->
({Hash, _}) -> proplists:get_bool(Hash, Hashs) end, HashSigns)};
advertised_hash_signs(_) ->
undefined.
+
diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl
index 3a3ad8cf35..f25b0df806 100644
--- a/lib/ssl/src/ssl_handshake.hrl
+++ b/lib/ssl/src/ssl_handshake.hrl
@@ -45,7 +45,8 @@
master_secret,
srp_username,
is_resumable,
- time_stamp
+ time_stamp,
+ ecc
}).
-define(NUM_OF_SESSION_ID_BYTES, 32). % TSL 1.1 & SSL 3
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index 5618837506..39595b4f95 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -97,8 +97,7 @@
terminated = false, %
allow_renegotiate = true,
expecting_next_protocol_negotiation = false :: boolean(),
- next_protocol = undefined :: undefined | binary(),
- client_ecc % {Curves, PointFmt}
+ next_protocol = undefined :: undefined | binary()
}).
-define(DEFAULT_DIFFIE_HELLMAN_PARAMS,
@@ -405,26 +404,24 @@ hello(#server_hello{cipher_suite = CipherSuite,
hello(Hello = #client_hello{client_version = ClientVersion,
extensions = #hello_extensions{hash_signs = HashSigns}},
State = #state{connection_states = ConnectionStates0,
- port = Port, session = #session{own_certificate = Cert} = Session0,
+ port = Port,
+ session = #session{own_certificate = Cert} = Session0,
renegotiation = {Renegotiation, _},
session_cache = Cache,
session_cache_cb = CacheCb,
ssl_options = SslOpts}) ->
HashSign = ssl_handshake:select_hashsign(HashSigns, Cert),
case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb,
- ConnectionStates0, Cert}, Renegotiation) of
+ ConnectionStates0, Cert}, Renegotiation) of
{Version, {Type, #session{cipher_suite = CipherSuite} = Session},
- ConnectionStates,
- #hello_extensions{ec_point_formats = EcPointFormats,
- elliptic_curves = EllipticCurves} = ServerHelloExt} ->
+ ConnectionStates, ServerHelloExt} ->
{KeyAlg, _, _, _} = ssl_cipher:suite_definition(CipherSuite),
- NegotiatedHashSign = negotiated_hashsign(HashSign, KeyAlg, Version),
- do_server_hello(Type, ServerHelloExt,
+ NegotiatedHashSign = negotiated_hashsign(HashSign, KeyAlg, Version),
+ do_server_hello(Type, ServerHelloExt,
State#state{connection_states = ConnectionStates,
negotiated_version = Version,
session = Session,
- hashsign_algorithm = NegotiatedHashSign,
- client_ecc = {EllipticCurves, EcPointFormats}});
+ hashsign_algorithm = NegotiatedHashSign});
#alert{} = Alert ->
handle_own_alert(Alert, ClientVersion, hello, State)
end;
@@ -1647,12 +1644,13 @@ key_exchange(#state{role = server, key_algorithm = Algo,
negotiated_version = Version,
tls_handshake_history = Handshake0,
socket = Socket,
- transport_cb = Transport
+ transport_cb = Transport,
+ session = #session{ecc = Curve}
} = State)
when Algo == ecdhe_ecdsa; Algo == ecdhe_rsa;
Algo == ecdh_anon ->
- ECDHKeys = public_key:generate_key(select_curve(State)),
+ ECDHKeys = public_key:generate_key(Curve),
ConnectionState =
ssl_record:pending_connection_state(ConnectionStates0, read),
SecParams = ConnectionState#connection_state.security_parameters,
@@ -3086,12 +3084,7 @@ default_hashsign(_Version, KeyExchange)
KeyExchange == rsa_psk;
KeyExchange == srp_anon ->
{null, anon}.
-
-select_curve(#state{client_ecc = {[Curve|_], _}}) ->
- {namedCurve, Curve};
-select_curve(_) ->
- {namedCurve, ?secp256k1}.
-
+
is_anonymous(Algo) when Algo == dh_anon;
Algo == ecdh_anon;
Algo == psk;
diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl
index 02bfa69fc5..ecbca83e10 100644
--- a/lib/ssl/src/tls_handshake.erl
+++ b/lib/ssl/src/tls_handshake.erl
@@ -70,7 +70,7 @@ client_hello(Host, Port, ConnectionStates,
}.
%%--------------------------------------------------------------------
--spec server_hello(#session{}, tls_version(), #connection_states{},
+-spec server_hello(binary(), tls_version(), #connection_states{},
#hello_extensions{}) -> #server_hello{}.
%%
%% Description: Creates a server hello message.
@@ -120,17 +120,16 @@ hello(#client_hello{client_version = ClientVersion,
cipher_suites = CipherSuites,
compression_methods = Compressions,
random = Random,
- extensions = HelloExt},
+ extensions = #hello_extensions{elliptic_curves = Curves} = HelloExt},
#ssl_options{versions = Versions} = SslOpts,
{Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) ->
Version = ssl_handshake:select_version(tls_record, ClientVersion, Versions),
case tls_record:is_acceptable_version(Version, Versions) of
true ->
- %% TODO: need to take supported Curves into Account when selecting the CipherSuite....
- %% if whe have an ECDSA cert with an unsupported curve, we need to drop ECDSA ciphers
+ ECCCurve = ssl_handshake:select_curve(Curves, ssl_handshake:supported_ecc(Version)),
{Type, #session{cipher_suite = CipherSuite} = Session1}
= ssl_handshake:select_session(SugesstedId, CipherSuites, Compressions,
- Port, Session0, Version,
+ Port, Session0#session{ecc = ECCCurve}, Version,
SslOpts, Cache, CacheCb, Cert),
case CipherSuite of
no_suite ->
diff --git a/lib/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl
index 4f8d45dc8d..4b42f64609 100644
--- a/lib/stdlib/src/dict.erl
+++ b/lib/stdlib/src/dict.erl
@@ -387,7 +387,7 @@ merge(F, D1, D2) ->
update(K, fun (V1) -> F(K, V1, V2) end, V2, D)
end, D1, D2).
-
+
%% get_slot(Hashdb, Key) -> Slot.
%% Get the slot. First hash on the new range, if we hit a bucket
%% which has not been split use the unsplit buddy bucket.
diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl
index 73b8da335a..ca6a4b5c58 100644
--- a/lib/stdlib/src/erl_eval.erl
+++ b/lib/stdlib/src/erl_eval.erl
@@ -912,7 +912,7 @@ type_test(binary) -> is_binary;
type_test(record) -> is_record;
type_test(Test) -> Test.
-
+
%% match(Pattern, Term, Bindings) ->
%% {match,NewBindings} | nomatch
%% or erlang:error({illegal_pattern, Pattern}).
@@ -1051,7 +1051,7 @@ match_list([], [], Bs, _BBs) ->
{match,Bs};
match_list(_, _, _Bs, _BBs) ->
nomatch.
-
+
%% new_bindings()
%% bindings(Bindings)
%% binding(Name, Bindings)
diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl
index 4b654833ed..40ef6c8998 100644
--- a/lib/stdlib/src/erl_tar.erl
+++ b/lib/stdlib/src/erl_tar.erl
@@ -222,7 +222,7 @@ format_error(Atom) when is_atom(Atom) ->
format_error(Term) ->
lists:flatten(io_lib:format("~tp", [Term])).
-
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%
%%% Useful definitions (also start of implementation).
@@ -412,7 +412,7 @@ split_filename([Comp|Rest], Prefix, Suffix, Len) ->
split_filename([], Prefix, Suffix, _) ->
{filename:join(Prefix),filename:join(Suffix)}.
-
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%
%%% Retrieving files from a tape archive.
diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl
index 9ef4954194..b8c0576e56 100644
--- a/lib/stdlib/src/filelib.erl
+++ b/lib/stdlib/src/filelib.erl
@@ -248,7 +248,7 @@ ensure_dir(F) ->
end
end.
-
+
%%%
%%% Pattern matching using a compiled wildcard.
%%%
@@ -360,7 +360,7 @@ do_alt([], _File) ->
do_list_dir(Dir, Mod) -> eval_list_dir(Dir, Mod).
-
+
%%% Compiling a wildcard.
%% Only for debugging.
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index 7f65131f67..df68a37c06 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -393,7 +393,7 @@ decode_msg(Msg, Parent, Name, State, Mod, Time, Debug, Hib) ->
end.
%%% ---------------------------------------------------
-%%% Send/recive functions
+%%% Send/receive functions
%%% ---------------------------------------------------
do_send(Dest, Msg) ->
case catch erlang:send(Dest, Msg, [noconnect]) of
diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl
index 92a086b077..9e69601770 100644
--- a/lib/stdlib/src/io_lib.erl
+++ b/lib/stdlib/src/io_lib.erl
@@ -583,7 +583,7 @@ printable_unicode_list(_) -> false. %Everything else is false
nl() ->
"\n".
-
+
%%
%% Utilities for collecting characters in input files
%%
diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl
index b5577165f4..d6a9f4645d 100644
--- a/lib/stdlib/src/lists.erl
+++ b/lib/stdlib/src/lists.erl
@@ -630,7 +630,7 @@ flatlength([H|T], L) when is_list(H) ->
flatlength([_|T], L) ->
flatlength(T, L + 1);
flatlength([], L) -> L.
-
+
%% keymember(Key, Index, [Tuple]) Now a BIF!
%% keyfind(Key, Index, [Tuple]) A BIF!
%% keysearch(Key, Index, [Tuple]) Now a BIF!
@@ -1163,7 +1163,7 @@ rumerge(T1, []) ->
T1;
rumerge(T1, [H2 | T2]) ->
lists:reverse(rumerge2_1(T1, T2, [], H2), []).
-
+
%% all(Predicate, List)
%% any(Predicate, List)
%% map(Function, List)
diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl
index 4ed27ff4eb..d0bd0cb26e 100644
--- a/lib/stdlib/src/string.erl
+++ b/lib/stdlib/src/string.erl
@@ -257,7 +257,7 @@ chars(C, N, Tail) when N > 0 ->
chars(C, N-1, [C|Tail]);
chars(C, 0, Tail) when is_integer(C) ->
Tail.
-
+
%% Torbjörn's bit.
%%% COPIES %%%
@@ -461,7 +461,7 @@ sub_string(String, Start) -> substr(String, Start).
Stop :: pos_integer().
sub_string(String, Start, Stop) -> substr(String, Start, Stop - Start + 1).
-
+
%% ISO/IEC 8859-1 (latin1) letters are converted, others are ignored
%%
diff --git a/lib/stdlib/test/slave_SUITE.erl b/lib/stdlib/test/slave_SUITE.erl
index 37fc694083..1d6a3ac90d 100644
--- a/lib/stdlib/test/slave_SUITE.erl
+++ b/lib/stdlib/test/slave_SUITE.erl
@@ -230,7 +230,7 @@ rsh_test(ResultTo) ->
link(ResultTo),
?line {error, no_rsh} = slave:start(super, slave3).
-
+
%%% Utilities.
diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl
index 8e71c69d35..189a71a8ce 100644
--- a/lib/test_server/src/ts.erl
+++ b/lib/test_server/src/ts.erl
@@ -622,7 +622,7 @@ run_test(File, Args, Options) ->
run_test(File, Args, Options, Vars) ->
ts_run:run(File, Args, Options, Vars).
-
+
%% This module provides some convenient shortcuts to running
%% the test server from within a started Erlang shell.
%% (This are here for backwards compatibility.)
diff --git a/lib/tools/emacs/erlang-eunit.el b/lib/tools/emacs/erlang-eunit.el
index f2c0db67dd..0adeff1a02 100644
--- a/lib/tools/emacs/erlang-eunit.el
+++ b/lib/tools/emacs/erlang-eunit.el
@@ -40,6 +40,10 @@ This is useful, reducing the save-compile-load-test cycle to one keychord.")
(defvar erlang-eunit-recent-info '((mode . nil) (module . nil) (test . nil) (cover . nil))
"Info about the most recent running of an EUnit test representation.")
+(defvar erlang-error-regexp-alist
+ '(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2)))
+ "*Patterns for matching Erlang errors.")
+
;;;
;;; Switch between src/EUnit test buffers
;;;
diff --git a/lib/tools/emacs/erlang-start.el b/lib/tools/emacs/erlang-start.el
index e1dc86621e..76e0575e68 100644
--- a/lib/tools/emacs/erlang-start.el
+++ b/lib/tools/emacs/erlang-start.el
@@ -52,7 +52,7 @@
;;
;; To set the variable you can use the following command:
;; M-x set-variable RET debug-on-error RET t RET
-
+
;;; Code:
;;
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index d459239c38..c395d22356 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -1027,7 +1027,7 @@ behaviour.")
(defvar erlang-mode-syntax-table nil
"Syntax table in use in Erlang-mode buffers.")
-
+
(defvar erlang-skel-file "erlang-skels"
"The type of erlang-skeletons that should be used, default
@@ -1274,7 +1274,7 @@ Unfortunately, XEmacs hasn't got support for a special Font
Lock syntax table. The effect is that `apply' in the atom
`foo_apply' will be highlighted as a bif.")
-
+
;;; Avoid errors while compiling this file.
;; `eval-when-compile' is not defined in Emacs 18. We define it as a
@@ -1323,7 +1323,7 @@ Lock syntax table. The effect is that `apply' in the atom
(require 'tempo)
(require 'compile))))
-
+
(defun erlang-version ()
"Return the current version of Erlang mode."
(interactive)
@@ -1518,7 +1518,7 @@ Other commands:
(set (make-local-variable 'outline-level) (lambda () 1))
(set (make-local-variable 'add-log-current-defun-function)
'erlang-current-defun))
-
+
(defun erlang-font-lock-init ()
"Initialize Font Lock for Erlang mode."
(or erlang-font-lock-syntax-table
@@ -1688,7 +1688,7 @@ plus variables, macros and records."
(font-lock-mode 1)
(funcall (symbol-function 'font-lock-fontify-buffer)))
-
+
(defun erlang-menu-init ()
"Init menus for Erlang mode.
@@ -1907,7 +1907,7 @@ Example:
The new menu is returned. No guarantee is given that the original
menu is left unchanged."
(delq entry items))
-
+
;; Man code:
(defun erlang-man-init ()
@@ -2230,7 +2230,7 @@ For example:
After installing the line, kill and restart Emacs, or restart Erlang
mode with the command `M-x erlang-mode RET'.")))
-
+
;; Skeleton code:
;; This code is based on the package `tempo' which is part of modern
@@ -2351,7 +2351,7 @@ The first character of DD is space if the value is less than 10."
(erlang-string-to-int (substring date 8 10))
(substring date 4 7)
(substring date -4))))
-
+
;; Indentation code:
(defun erlang-indent-command (&optional whole-exp)
@@ -3134,7 +3134,7 @@ commands."
(skip-chars-backward " \t")
(max (if (bolp) 0 (1+ (current-column)))
comment-column)))))
-
+
;;; Erlang movement commands
;; All commands below work as movement commands. I.e. if the point is
@@ -3338,7 +3338,7 @@ With negative argument go towards the beginning of the buffer."
(forward-sexp 1)
(buffer-substring start (point)))))
-
+
;;; Miscellaneous
(defun erlang-fill-paragraph (&optional justify)
@@ -3447,7 +3447,7 @@ at the end."
(error "Can't clone argument list"))
(insert args)
(set-mark p)))
-
+
;;; Information retrieval functions.
(defun erlang-buffer-substring (beg end)
@@ -3774,7 +3774,7 @@ exported function."
(store-match-data old-match-data)
(member (cons name arity) exports))))
-
+
;;; Check module name
;; The function `write-file', bound to C-x C-w, calls
@@ -3837,7 +3837,7 @@ This function is normally placed in the hook `local-write-file-hooks'."
;; Must return nil since it is added to `local-write-file-hook'.
nil)
-
+
;;; Electric functions.
(defun erlang-electric-semicolon (&optional arg)
@@ -4231,7 +4231,7 @@ This function is designed to be a member of a criteria list."
(erlang-skip-blank)
(looking-at "end[^_a-zA-Z0-9]")))
-
+
;; Erlang tags support which is aware of erlang modules.
;;
;; Not yet implemented under XEmacs. (Hint: The Emacs 19 etags
@@ -4541,7 +4541,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'."
(or default (error "There is no default tag"))
spec)))))
-
+
;; Search tag functions which are aware of Erlang modules. The tactic
;; is to store new search functions into the local variables of the
;; TAGS buffers. The variables are restored directly after the
@@ -4717,7 +4717,7 @@ for a tag on the form `module:tag'."
(string= mod (erlang-get-module-from-file-name
(file-of-tag)))))))
-
+
;;; Tags completion, Emacs 19 `etags' specific.
;;;
;;; The basic idea is to create a second completion table `erlang-tags-
@@ -4836,7 +4836,7 @@ about Erlang modules."
;; Only the first one will be stored in the table.
(intern (concat module ":") table))))))
table))
-
+
;;;
;;; Prepare for other methods to run an Erlang slave process.
;;;
@@ -4918,7 +4918,7 @@ future, a new shell on an already running host will be started."
(call-interactively erlang-next-error-function))
-
+
;;;
;;; Erlang Shell Mode -- Major mode used for Erlang shells.
;;;
@@ -5054,7 +5054,7 @@ Selects Comint or Compilation mode command as appropriate."
(define-key map "\M-\C-m" 'compile-goto-error)
(unless inferior-erlang-use-cmm
(define-key map "\C-x`" 'erlang-next-error)))
-
+
;;;
;;; Inferior Erlang -- Run an Erlang shell as a subprocess.
;;;
diff --git a/lib/tools/src/tags.erl b/lib/tools/src/tags.erl
index 1c72ef8db5..e3cc51cdb2 100644
--- a/lib/tools/src/tags.erl
+++ b/lib/tools/src/tags.erl
@@ -292,7 +292,7 @@ word_char(C) when C >= $0, C =< $9 -> true;
word_char($_) -> true;
word_char(_) -> false.
-
+
%%% Output routines
%% Check the options `outfile' and `outdir'.
@@ -323,7 +323,7 @@ genout(Os, Name, Entries) ->
io:put_chars(Os, lists:reverse(Entries)).
-
+
%%% help routines
%% Flatten and reverse a nested list.
diff --git a/lib/tools/test/eprof_SUITE_data/eed.erl b/lib/tools/test/eprof_SUITE_data/eed.erl
index 520c5f3dd1..5f2a21aa60 100644
--- a/lib/tools/test/eprof_SUITE_data/eed.erl
+++ b/lib/tools/test/eprof_SUITE_data/eed.erl
@@ -146,7 +146,7 @@ format_error({'EXIT', {Code, {Mod, Func, Args}}}) ->
[{Code, {Mod, Func, length(Args)}}]));
format_error(A) -> atom_to_list(A).
-
+
%%% Parsing commands.
@@ -327,7 +327,7 @@ when 0 =< Num1, Num1 =< Num2, Num2 =< State#state.lines ->
check_lines(_, _, _, _) ->
error(bad_linenum).
-
+
%%% Executing commands.
%% ($)= - print line number
@@ -657,7 +657,7 @@ undo_command(_, _, _) ->
write_command(_Cmd, [_First, _Last], _St) ->
error(not_implemented).
-
+
%%% Primitive buffer operations.
print_current(St) ->
@@ -717,7 +717,7 @@ wrap_next_line(State) when State#state.dot == State#state.lines ->
wrap_next_line(State) ->
next_line(State).
-
+
%%% Utilities.
get_pattern(End, Cmd, State) ->
diff --git a/lib/xmerl/src/xmerl_regexp.erl b/lib/xmerl/src/xmerl_regexp.erl
index 0c53e6f34a..9303bdb125 100644
--- a/lib/xmerl/src/xmerl_regexp.erl
+++ b/lib/xmerl/src/xmerl_regexp.erl
@@ -593,7 +593,7 @@ sub_first_match(S, {regexp,RE}) ->
nomatch -> nomatch
end.
-
+
%% This is the regular expression grammar used. It is equivalent to the
%% one used in AWK, except that we allow ^ $ to be used anywhere and fail
%% in the matching.
@@ -961,7 +961,7 @@ re_apply_or(never_match, R2) -> R2;
re_apply_or(R1, never_match) -> R1;
re_apply_or(nomatch, R2) -> R2;
re_apply_or(R1, nomatch) -> R1.
-
+
%% Record definitions for the NFA, DFA and compiler.
-record(nfa_state, {no,edges=[],accept=no}).
@@ -1026,7 +1026,7 @@ parse_reas([{RegExp,A}|REAs], S) ->
{error,E} -> {error,E}
end;
parse_reas([], Stack) -> {ok,reverse(Stack)}.
-
+
%% build_combined_nfa(RegExpActionList) -> {NFA,StartState}.
%% Build the combined NFA using Thompson's construction straight out
%% of the book. Build the separate NFAs in the same order as the
@@ -1147,7 +1147,7 @@ nfa_comp_class(Cc) ->
comp_crs([{C1,C2}|Crs], Last) ->
[{Last,C1-1}|comp_crs(Crs, C2+1)];
comp_crs([], Last) -> [{Last,maxchar}].
-
+
%% build_dfa(NFA, NfaStartState) -> {DFA,DfaStartState}.
%% Build a DFA from an NFA using "subset construction". The major
%% difference from the book is that we keep the marked and unmarked
@@ -1282,7 +1282,7 @@ accept([St|Sts], NFA) ->
#nfa_state{accept=no} -> accept(Sts, NFA)
end;
accept([], _NFA) -> no.
-
+
%% minimise_dfa(DFA, StartState, FirstState) -> {DFA,StartState}.
%% Minimise the DFA by removing equivalent states. We consider a
%% state if both the transitions and the their accept state is the
@@ -1331,7 +1331,7 @@ pack_dfa([D|DFA], NewN, Rs, PDFA) ->
pack_dfa(DFA, NewN+1, [{D#dfa_state.no,NewN}|Rs],
[D#dfa_state{no=NewN}|PDFA]);
pack_dfa([], _NewN, Rs, PDFA) -> {PDFA,Rs}.
-
+
%% comp_apply(String, StartPos, DFAReg) -> {match,RestPos,Rest} | nomatch.
%% Apply the DFA of a regular expression to a string. If
%% there is a match return the position of the remaining string and
diff --git a/system/doc/top/src/erl_html_tools.erl b/system/doc/top/src/erl_html_tools.erl
index 1e2b8c86af..73d131ec0b 100644
--- a/system/doc/top/src/erl_html_tools.erl
+++ b/system/doc/top/src/erl_html_tools.erl
@@ -655,7 +655,7 @@ sub_repl([[{St, L}] |Ss], Fun, Acc0, S, Pos) ->
{string:substr(S, Pos+1, St-Pos) ++ Rep ++ Rs, NewAcc};
sub_repl([], _Fun, Acc, S, Pos) -> {string:substr(S, Pos+1), Acc}.
-
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Error and warnings