aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--README.md2
-rw-r--r--bootstrap/lib/stdlib/ebin/ets.beambin22544 -> 22808 bytes
-rw-r--r--erts/emulator/beam/bif.c126
-rw-r--r--erts/emulator/beam/bif.tab3
-rw-r--r--erts/emulator/beam/break.c2
-rw-r--r--erts/emulator/beam/erl_alloc.types1
-rw-r--r--erts/emulator/beam/erl_async.h8
-rw-r--r--erts/emulator/beam/erl_bif_info.c8
-rw-r--r--erts/emulator/beam/erl_db.c1953
-rw-r--r--erts/emulator/beam/erl_db.h46
-rw-r--r--erts/emulator/beam/erl_db_hash.c242
-rw-r--r--erts/emulator/beam/erl_db_hash.h12
-rw-r--r--erts/emulator/beam/erl_db_tree.c63
-rw-r--r--erts/emulator/beam/erl_db_util.h93
-rw-r--r--erts/emulator/beam/erl_init.c1
-rw-r--r--erts/emulator/beam/erl_lock_check.c6
-rw-r--r--erts/emulator/beam/erl_node_tables.c41
-rw-r--r--erts/emulator/beam/erl_process.c88
-rw-r--r--erts/emulator/beam/erl_process.h32
-rw-r--r--erts/emulator/beam/erl_rbtree.h66
-rw-r--r--erts/emulator/beam/sys.h6
-rw-r--r--erts/emulator/sys/common/erl_check_io.c14
-rw-r--r--erts/emulator/sys/unix/sys.c64
-rw-r--r--erts/preloaded/ebin/erlang.beambin106104 -> 106220 bytes
-rw-r--r--erts/preloaded/src/erlang.erl8
-rw-r--r--lib/asn1/c_src/asn1_erl_nif.c38
-rw-r--r--lib/asn1/src/asn1ct.erl129
-rw-r--r--lib/asn1/src/asn1ct_check.erl140
-rw-r--r--lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl111
-rw-r--r--lib/asn1/src/asn1ct_constructed_per.erl40
-rw-r--r--lib/asn1/src/asn1ct_func.erl2
-rw-r--r--lib/asn1/src/asn1ct_gen.erl89
-rw-r--r--lib/asn1/src/asn1ct_gen_ber_bin_v2.erl308
-rw-r--r--lib/asn1/src/asn1ct_gen_per.erl64
-rw-r--r--lib/asn1/src/asn1ct_name.erl2
-rw-r--r--lib/asn1/src/asn1ct_parser2.erl2
-rw-r--r--lib/asn1/src/asn1ct_value.erl51
-rw-r--r--lib/asn1/src/asn1rtt_ber.erl33
-rw-r--r--lib/asn1/test/asn1_SUITE.erl1
-rw-r--r--lib/asn1/test/asn1_SUITE_data/HighTagNumbers.asn117
-rw-r--r--lib/compiler/test/Makefile1
-rw-r--r--lib/crypto/src/crypto.erl2
-rw-r--r--lib/eunit/src/eunit_surefire.erl1
-rw-r--r--lib/hipe/amd64/hipe_amd64_ra_sse2_postconditions.erl17
-rw-r--r--lib/hipe/arm/hipe_arm.erl7
-rw-r--r--lib/hipe/arm/hipe_arm.hrl1
-rw-r--r--lib/hipe/arm/hipe_arm_cfg.erl21
-rw-r--r--lib/hipe/arm/hipe_arm_defuse.erl2
-rw-r--r--lib/hipe/arm/hipe_arm_frame.erl22
-rw-r--r--lib/hipe/arm/hipe_arm_ra_finalise.erl25
-rw-r--r--lib/hipe/arm/hipe_arm_ra_postconditions.erl24
-rw-r--r--lib/hipe/arm/hipe_arm_subst.erl24
-rw-r--r--lib/hipe/main/hipe.app.src4
-rw-r--r--lib/hipe/main/hipe.erl27
-rw-r--r--lib/hipe/opt/Makefile3
-rw-r--r--lib/hipe/opt/hipe_bb_weights.erl449
-rw-r--r--lib/hipe/opt/hipe_spillmin_color.erl90
-rw-r--r--lib/hipe/ppc/hipe_ppc.erl14
-rw-r--r--lib/hipe/ppc/hipe_ppc.hrl2
-rw-r--r--lib/hipe/ppc/hipe_ppc_cfg.erl37
-rw-r--r--lib/hipe/ppc/hipe_ppc_defuse.erl4
-rw-r--r--lib/hipe/ppc/hipe_ppc_frame.erl36
-rw-r--r--lib/hipe/ppc/hipe_ppc_ra_finalise.erl15
-rw-r--r--lib/hipe/ppc/hipe_ppc_ra_postconditions.erl24
-rw-r--r--lib/hipe/ppc/hipe_ppc_ra_postconditions_fp.erl18
-rw-r--r--lib/hipe/ppc/hipe_ppc_subst.erl6
-rw-r--r--lib/hipe/regalloc/Makefile2
-rw-r--r--lib/hipe/regalloc/hipe_amd64_specific_sse2.erl39
-rw-r--r--lib/hipe/regalloc/hipe_arm_specific.erl39
-rw-r--r--lib/hipe/regalloc/hipe_ppc_specific.erl30
-rw-r--r--lib/hipe/regalloc/hipe_ppc_specific_fp.erl30
-rw-r--r--lib/hipe/regalloc/hipe_range_split.erl1187
-rw-r--r--lib/hipe/regalloc/hipe_regalloc_loop.erl23
-rw-r--r--lib/hipe/regalloc/hipe_regalloc_prepass.erl71
-rw-r--r--lib/hipe/regalloc/hipe_restore_reuse.erl516
-rw-r--r--lib/hipe/regalloc/hipe_sparc_specific.erl30
-rw-r--r--lib/hipe/regalloc/hipe_sparc_specific_fp.erl30
-rw-r--r--lib/hipe/regalloc/hipe_x86_specific.erl39
-rw-r--r--lib/hipe/regalloc/hipe_x86_specific_x87.erl4
-rw-r--r--lib/hipe/sparc/hipe_sparc.erl14
-rw-r--r--lib/hipe/sparc/hipe_sparc.hrl2
-rw-r--r--lib/hipe/sparc/hipe_sparc_cfg.erl44
-rw-r--r--lib/hipe/sparc/hipe_sparc_defuse.erl4
-rw-r--r--lib/hipe/sparc/hipe_sparc_frame.erl36
-rw-r--r--lib/hipe/sparc/hipe_sparc_ra_finalise.erl15
-rw-r--r--lib/hipe/sparc/hipe_sparc_ra_postconditions.erl24
-rw-r--r--lib/hipe/sparc/hipe_sparc_ra_postconditions_fp.erl18
-rw-r--r--lib/hipe/sparc/hipe_sparc_subst.erl6
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_edge_cases.erl142
-rw-r--r--lib/hipe/util/Makefile2
-rw-r--r--lib/hipe/util/hipe_dsets.erl84
-rw-r--r--lib/hipe/x86/hipe_x86.erl14
-rw-r--r--lib/hipe/x86/hipe_x86.hrl2
-rw-r--r--lib/hipe/x86/hipe_x86_cfg.erl22
-rw-r--r--lib/hipe/x86/hipe_x86_defuse.erl4
-rw-r--r--lib/hipe/x86/hipe_x86_frame.erl46
-rw-r--r--lib/hipe/x86/hipe_x86_ra_finalise.erl10
-rw-r--r--lib/hipe/x86/hipe_x86_ra_postconditions.erl26
-rw-r--r--lib/hipe/x86/hipe_x86_subst.erl35
-rw-r--r--lib/kernel/doc/src/inet.xml6
-rw-r--r--lib/observer/src/cdv_ets_cb.erl19
-rw-r--r--lib/observer/src/crashdump_viewer.erl6
-rw-r--r--lib/observer/src/crashdump_viewer.hrl1
-rw-r--r--lib/observer/src/observer_tv_wx.erl8
-rw-r--r--lib/ssh/doc/src/ssh.xml15
-rw-r--r--lib/ssh/src/ssh_options.erl11
-rw-r--r--lib/ssh/test/Makefile3
-rw-r--r--lib/ssh/test/ssh.spec3
-rw-r--r--lib/ssh/test/ssh_bench.spec3
-rw-r--r--lib/ssh/test/ssh_bench_SUITE.erl252
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/id_dsa (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/id_dsa)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa256 (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa256.pub (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256.pub)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa384 (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa384.pub (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384.pub)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa521 (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa521.pub (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521.pub)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/id_rsa (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/id_rsa)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/ssh_host_dsa_key (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/ssh_host_dsa_key.pub (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key.pub)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key256 (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key256.pub (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256.pub)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key384 (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key384.pub (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384.pub)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key521 (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key521.pub (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521.pub)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/ssh_host_rsa_key (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key)0
-rw-r--r--lib/ssh/test/ssh_bench_SUITE_data/ssh_host_rsa_key.pub (renamed from lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key.pub)0
-rw-r--r--lib/ssh/test/ssh_bench_dev_null.erl58
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE.erl571
-rw-r--r--lib/ssh/test/ssh_to_openssh_SUITE.erl4
-rw-r--r--lib/ssl/doc/src/ssl.xml13
-rw-r--r--lib/ssl/src/dtls_handshake.erl28
-rw-r--r--lib/ssl/src/ssl.erl67
-rw-r--r--lib/ssl/src/ssl_connection.erl40
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl41
-rw-r--r--lib/ssl/test/ssl_packet_SUITE.erl10
-rw-r--r--lib/ssl/test/ssl_test_lib.erl12
-rw-r--r--lib/stdlib/doc/src/proplists.xml2
-rw-r--r--lib/stdlib/doc/src/unicode_usage.xml31
-rw-r--r--lib/stdlib/src/erl_lint.erl15
-rw-r--r--lib/stdlib/src/ets.erl18
-rw-r--r--lib/stdlib/src/otp_internal.erl176
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl29
-rw-r--r--lib/stdlib/test/ets_SUITE.erl136
-rw-r--r--system/doc/reference_manual/character_set.xml8
146 files changed, 5973 insertions, 2991 deletions
diff --git a/README.md b/README.md
index ccfce03a96..b3d1aaaad1 100644
--- a/README.md
+++ b/README.md
@@ -52,7 +52,7 @@ Please visit [bugs.erlang.org](https://bugs.erlang.org/issues/?jql=project%20%3D
### Security Disclosure
-We take security bugs in Erlang/OTP seriously. Please disclose the issues regarding security by sending an email to [email protected] and not by creating a public issue.
+We take security bugs in Erlang/OTP seriously. Please disclose the issues regarding security by sending an email to **erlang-security [at] erlang [dot] org** and not by creating a public issue.
## Contributing
diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam
index e66749048d..ee769b5dec 100644
--- a/bootstrap/lib/stdlib/ebin/ets.beam
+++ b/bootstrap/lib/stdlib/ebin/ets.beam
Binary files differ
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 614bedab12..2d37f977c0 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -4254,6 +4254,132 @@ BIF_RETTYPE list_to_pid_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
+BIF_RETTYPE list_to_ref_1(BIF_ALIST_1)
+{
+ /*
+ * A valid reference is on the format
+ * "#Ref<N.X.Y.Z>" where N, X, Y, and Z are
+ * 32-bit integers (i.e., max 10 characters).
+ */
+ Eterm *hp;
+ Eterm res;
+ Uint32 refn[ERTS_MAX_REF_NUMBERS];
+ int n = 0;
+ Uint ints[1 + ERTS_MAX_REF_NUMBERS] = {0};
+ char* cp;
+ Sint i;
+ DistEntry *dep = NULL;
+ char buf[5 /* #Ref< */
+ + (1 + ERTS_MAX_REF_NUMBERS)*(10 + 1) /* N.X.Y.Z> */
+ + 1 /* \0 */];
+
+ /* walk down the list and create a C string */
+ if ((i = intlist_to_buf(BIF_ARG_1, buf, sizeof(buf)-1)) < 0)
+ goto bad;
+
+ buf[i] = '\0'; /* null terminal */
+
+ cp = &buf[0];
+ if (*cp++ != '#') goto bad;
+ if (*cp++ != 'R') goto bad;
+ if (*cp++ != 'e') goto bad;
+ if (*cp++ != 'f') goto bad;
+ if (*cp++ != '<') goto bad;
+
+ for (i = 0; i < sizeof(ints)/sizeof(Uint); i++) {
+ if (*cp < '0' || *cp > '9') goto bad;
+
+ while (*cp >= '0' && *cp <= '9') {
+ ints[i] = 10*ints[i] + (*cp - '0');
+ cp++;
+ }
+
+ n++;
+ if (ints[i] > ~((Uint32) 0)) goto bad;
+ if (*cp == '>') break;
+ if (*cp++ != '.') goto bad;
+ }
+
+ if (*cp++ != '>') goto bad;
+ if (*cp != '\0') goto bad;
+
+ if (n < 2) goto bad;
+
+ for (n = 0; i > 0; i--)
+ refn[n++] = (Uint32) ints[i];
+
+ ASSERT(n <= ERTS_MAX_REF_NUMBERS);
+
+ dep = erts_channel_no_to_dist_entry(ints[0]);
+
+ if (!dep)
+ goto bad;
+
+ if(dep == erts_this_dist_entry) {
+ ErtsMagicBinary *mb;
+ Uint32 sid;
+ if (refn[0] > MAX_REFERENCE) goto bad;
+ if (n != ERTS_REF_NUMBERS) goto bad;
+ sid = erts_get_ref_numbers_thr_id(refn);
+ if (sid > erts_no_schedulers) goto bad;
+ mb = erts_magic_ref_lookup_bin(refn);
+ if (mb) {
+ hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE);
+ res = erts_mk_magic_ref(&hp, &BIF_P->off_heap,
+ (Binary *) mb);
+ }
+ else {
+ hp = HAlloc(BIF_P, ERTS_REF_THING_SIZE);
+ write_ref_thing(hp, refn[0], refn[1], refn[2]);
+ res = make_internal_ref(hp);
+ }
+ }
+ else {
+ ExternalThing *etp;
+ ErlNode *enp;
+ Uint hsz;
+ int j;
+
+ if (is_nil(dep->cid))
+ goto bad;
+
+ enp = erts_find_or_insert_node(dep->sysname, dep->creation);
+ ASSERT(enp != erts_this_node);
+
+ hsz = EXTERNAL_THING_HEAD_SIZE;
+#if defined(ARCH_64)
+ hsz += n/2 + 1;
+#else
+ hsz += n;
+#endif
+
+ etp = (ExternalThing *) HAlloc(BIF_P, hsz);
+ etp->header = make_external_ref_header(n/2);
+ etp->next = BIF_P->off_heap.first;
+ etp->node = enp;
+ i = 0;
+#if defined(ARCH_64)
+ etp->data.ui32[i] = n;
+#endif
+ for (j = 0; j < n; j++) {
+ etp->data.ui32[i] = refn[j];
+ i++;
+ }
+
+ BIF_P->off_heap.first = (struct erl_off_heap_header*) etp;
+ res = make_external_ref(etp);
+ }
+
+ erts_deref_dist_entry(dep);
+ BIF_RET(res);
+
+ bad:
+ if (dep)
+ erts_deref_dist_entry(dep);
+ BIF_ERROR(BIF_P, BADARG);
+}
+
+
/**********************************************************************/
BIF_RETTYPE group_leader_0(BIF_ALIST_0)
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index ce2cffa498..6f50297fc5 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -88,6 +88,7 @@ bif erlang:list_to_binary/1
bif erlang:list_to_float/1
bif erlang:list_to_integer/1
bif erlang:list_to_pid/1
+bif erlang:list_to_ref/1
bif erlang:list_to_tuple/1
bif erlang:loaded/0
bif erlang:localtime/0
@@ -324,7 +325,7 @@ bif erlang:match_spec_test/3
# Bifs in ets module.
#
-bif ets:all/0
+bif ets:internal_request_all/0
bif ets:new/2
bif ets:delete/1
bif ets:delete/2
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index 4dad5736c5..0b40d70cb7 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -512,6 +512,8 @@ do_break(void)
erts_free_read_env(mode);
#endif /* __WIN32__ */
+ ASSERT(erts_smp_thr_progress_is_blocking());
+
erts_printf("\n"
"BREAK: (a)bort (c)ontinue (p)roc info (i)nfo (l)oaded\n"
" (v)ersion (k)ill (D)b-tables (d)istribution\n");
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 3d5de72ee7..32f84c8593 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -227,6 +227,7 @@ type DB_DMC_ERROR ETS ETS db_dmc_error
type DB_DMC_ERR_INFO ETS ETS db_dmc_error_info
type DB_TERM ETS ETS db_term
type DB_PROC_CLEANUP SHORT_LIVED ETS db_proc_cleanup_state
+type ETS_ALL_REQ SHORT_LIVED ETS ets_all_request
type INSTR_INFO LONG_LIVED SYSTEM instr_info
type LOGGER_DSBUF TEMPORARY SYSTEM logger_dsbuf
type TMP_DSBUF TEMPORARY SYSTEM tmp_dsbuf
diff --git a/erts/emulator/beam/erl_async.h b/erts/emulator/beam/erl_async.h
index 473c7686e5..c884a5040d 100644
--- a/erts/emulator/beam/erl_async.h
+++ b/erts/emulator/beam/erl_async.h
@@ -27,7 +27,6 @@ extern int erts_async_max_threads;
#define ERTS_ASYNC_THREAD_MAX_STACK_SIZE 8192 /* Kilo words */
extern int erts_async_thread_suggested_stack_size;
-#ifdef USE_THREADS
#ifdef ERTS_SMP
/*
@@ -47,6 +46,10 @@ extern int erts_async_thread_suggested_stack_size;
# define ERTS_USE_ASYNC_READY_Q 0
#endif
+#ifndef USE_THREADS
+# undef ERTS_USE_ASYNC_READY_Q
+# define ERTS_USE_ASYNC_READY_Q 0
+#endif /* !USE_THREADS */
#if ERTS_USE_ASYNC_READY_Q
int erts_check_async_ready(void *);
int erts_async_ready_clean(void *, void *);
@@ -58,10 +61,7 @@ void *erts_get_async_ready_queue(Uint sched_id);
#endif
#endif /* ERTS_USE_ASYNC_READY_Q */
-#endif /* USE_THREADS */
-
void erts_init_async(void);
void erts_exit_flush_async(void);
-
#endif /* ERL_ASYNC_H__ */
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 06a73ffea5..025f99330a 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -3634,10 +3634,6 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
BIF_RET(TUPLE2(hp, make_small((Uint) words),
erts_ets_hash_sizeof_ext_segtab()));
}
- else if (ERTS_IS_ATOM_STR("DbTable_meta", BIF_ARG_1)) {
- /* Used by ets_SUITE (stdlib) */
- BIF_RET(erts_ets_get_meta_state(BIF_P));
- }
else if (ERTS_IS_ATOM_STR("check_io_debug", BIF_ARG_1)) {
/* Used by driver_SUITE (emulator) */
Uint sz, *szp;
@@ -4398,10 +4394,6 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
}
BIF_RET(am_ok);
}
- else if (ERTS_IS_ATOM_STR("DbTable_meta", BIF_ARG_1)) {
- /* Used by ets_SUITE (stdlib) */
- BIF_RET(erts_ets_restore_meta_state(BIF_P, BIF_ARG_2));
- }
else if (ERTS_IS_ATOM_STR("make", BIF_ARG_1)) {
if (ERTS_IS_ATOM_STR("magic_ref", BIF_ARG_2)) {
Binary *bin = erts_create_magic_binary(0, empty_magic_ref_destructor);
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index 9f077dd407..2f188b5391 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -19,9 +19,7 @@
*/
/*
- * This file contains the bif interface functions and
- * the handling of the "meta tables" ie the tables of
- * db tables.
+ * This file contains the 'ets' bif interface functions.
*/
/*
@@ -43,6 +41,7 @@
#include "erl_db.h"
#include "bif.h"
#include "big.h"
+#include "erl_binary.h"
erts_smp_atomic_t erts_ets_misc_mem_size;
@@ -74,62 +73,226 @@ enum DbIterSafety {
#define DID_TRAP(P,Ret) (!is_value(Ret) && ((P)->freason == TRAP))
+/*
+ * "fixed_tabs": list of all fixed tables for a process
+ */
+#ifdef DEBUG
+static int fixed_tabs_find(DbFixation* first, DbFixation* fix);
+#endif
-/*
-** The main meta table, containing all ets tables.
-*/
-#ifdef ERTS_SMP
+static void fixed_tabs_insert(Process* p, DbFixation* fix)
+{
+ DbFixation* first = erts_psd_get(p, ERTS_PSD_ETS_FIXED_TABLES);
+
+ if (!first) {
+ fix->tabs.next = fix->tabs.prev = fix;
+ erts_psd_set(p, ERTS_PSD_ETS_FIXED_TABLES, fix);
+ }
+ else {
+ ASSERT(!fixed_tabs_find(first, fix));
+ fix->tabs.prev = first->tabs.prev;
+ fix->tabs.next = first;
+ fix->tabs.prev->tabs.next = fix;
+ first->tabs.prev = fix;
+ }
+}
+
+static void fixed_tabs_delete(Process *p, DbFixation* fix)
+{
+ if (fix->tabs.next == fix) {
+ DbFixation* old;
+ ASSERT(fix->tabs.prev == fix);
+ old = erts_psd_set(p, ERTS_PSD_ETS_FIXED_TABLES, NULL);
+ ASSERT(old == fix); (void)old;
+ }
+ else {
+ DbFixation *first = (DbFixation*) erts_psd_get(p, ERTS_PSD_ETS_FIXED_TABLES);
-#define ERTS_META_MAIN_TAB_LOCK_TAB_BITS 8
-#define ERTS_META_MAIN_TAB_LOCK_TAB_SIZE (1 << ERTS_META_MAIN_TAB_LOCK_TAB_BITS)
-#define ERTS_META_MAIN_TAB_LOCK_TAB_MASK (ERTS_META_MAIN_TAB_LOCK_TAB_SIZE - 1)
+ ASSERT(fixed_tabs_find(first, fix));
+ fix->tabs.prev->tabs.next = fix->tabs.next;
+ fix->tabs.next->tabs.prev = fix->tabs.prev;
-typedef union {
- erts_smp_rwmtx_t rwmtx;
- byte cache_line_align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(
- sizeof(erts_smp_rwmtx_t))];
-} erts_meta_main_tab_lock_t;
+ if (fix == first)
+ erts_psd_set(p, ERTS_PSD_ETS_FIXED_TABLES, fix->tabs.next);
+ }
+}
-static erts_meta_main_tab_lock_t *meta_main_tab_locks;
+#ifdef DEBUG
+static int fixed_tabs_find(DbFixation* first, DbFixation* fix)
+{
+ DbFixation* p;
+ if (!first) {
+ first = (DbFixation*) erts_psd_get(fix->procs.p, ERTS_PSD_ETS_FIXED_TABLES);
+ }
+ p = first;
+ do {
+ if (p == fix)
+ return 1;
+ ASSERT(p->procs.p == fix->procs.p);
+ ASSERT(p->tabs.next->tabs.prev == p);
+ p = p->tabs.next;
+ } while (p != first);
+ return 0;
+}
#endif
-static struct {
- union {
- DbTable *tb; /* Only directly readable if slot is ALIVE */
- UWord next_free; /* (index<<2)|1 if slot is FREE */
- }u;
-} *meta_main_tab;
-/* A slot in meta_main_tab can have three states:
- * FREE : Free to use for new table. Part of linked free-list.
- * ALIVE: Contains a table
- * DEAD : Contains a table that is being removed.
+
+/*
+ * fixing_procs: tree of all processes fixating a table
*/
-#define IS_SLOT_FREE(i) (meta_main_tab[(i)].u.next_free & 1)
-#define IS_SLOT_DEAD(i) (meta_main_tab[(i)].u.next_free & 2)
-#define IS_SLOT_ALIVE(i) (!(meta_main_tab[(i)].u.next_free & (1|2)))
-#define GET_NEXT_FREE_SLOT(i) (meta_main_tab[(i)].u.next_free >> 2)
-#define SET_NEXT_FREE_SLOT(i,next) (meta_main_tab[(i)].u.next_free = ((next)<<2)|1)
-#define MARK_SLOT_DEAD(i) (meta_main_tab[(i)].u.next_free |= 2)
-#define GET_ANY_SLOT_TAB(i) ((DbTable*)(meta_main_tab[(i)].u.next_free & ~(1|2))) /* dead or alive */
+#define ERTS_RBT_PREFIX fixing_procs
+#define ERTS_RBT_T DbFixation
+#define ERTS_RBT_KEY_T Process*
+#define ERTS_RBT_FLAGS_T int
+#define ERTS_RBT_INIT_EMPTY_TNODE(T) \
+ do { \
+ (T)->procs.parent = NULL; \
+ (T)->procs.right = NULL; \
+ (T)->procs.left = NULL; \
+ } while (0)
+#define ERTS_RBT_IS_RED(T) ((T)->procs.is_red)
+#define ERTS_RBT_SET_RED(T) ((T)->procs.is_red = 1)
+#define ERTS_RBT_IS_BLACK(T) (!(T)->procs.is_red)
+#define ERTS_RBT_SET_BLACK(T) ((T)->procs.is_red = 0)
+#define ERTS_RBT_GET_FLAGS(T) ((T)->procs.is_red)
+#define ERTS_RBT_SET_FLAGS(T, F) ((T)->procs.is_red = (F))
+#define ERTS_RBT_GET_PARENT(T) ((T)->procs.parent)
+#define ERTS_RBT_SET_PARENT(T, P) ((T)->procs.parent = (P))
+#define ERTS_RBT_GET_RIGHT(T) ((T)->procs.right)
+#define ERTS_RBT_SET_RIGHT(T, R) ((T)->procs.right = (R))
+#define ERTS_RBT_GET_LEFT(T) ((T)->procs.left)
+#define ERTS_RBT_SET_LEFT(T, L) ((T)->procs.left = (L))
+#define ERTS_RBT_GET_KEY(T) ((T)->procs.p)
+#define ERTS_RBT_IS_LT(KX, KY) ((KX) < (KY))
+#define ERTS_RBT_IS_EQ(KX, KY) ((KX) == (KY))
+
+#define ERTS_RBT_WANT_INSERT
+#define ERTS_RBT_WANT_LOOKUP
+#define ERTS_RBT_WANT_DELETE
+#define ERTS_RBT_WANT_FOREACH
+#define ERTS_RBT_WANT_FOREACH_DESTROY
+#ifdef DEBUG
+# define ERTS_RBT_WANT_LOOKUP
+#endif
+#define ERTS_RBT_UNDEF
-static ERTS_INLINE erts_smp_rwmtx_t *
-get_meta_main_tab_lock(unsigned slot)
+#include "erl_rbtree.h"
+
+#ifdef HARDDEBUG
+# error Do something useful with CHECK_TABLES maybe
+#else
+# define CHECK_TABLES()
+#endif
+
+
+static void
+send_ets_transfer_message(Process *c_p, Process *proc,
+ ErtsProcLocks *locks,
+ DbTable *tb, Eterm heir_data);
+static void schedule_free_dbtable(DbTable* tb);
+static void delete_sched_table(Process *c_p, DbTable *tb);
+
+static void table_dec_refc(DbTable *tb, erts_aint_t min_val)
+{
+ if (erts_smp_refc_dectest(&tb->common.refc, min_val) == 0)
+ schedule_free_dbtable(tb);
+}
+
+static int
+db_table_tid_destructor(Binary *unused)
+{
+ return 1;
+}
+
+static ERTS_INLINE void
+make_btid(DbTable *tb)
+{
+ Binary *btid = erts_create_magic_indirection(db_table_tid_destructor);
+ erts_smp_atomic_t *tbref = erts_smp_binary_to_magic_indirection(btid);
+ erts_smp_atomic_init_nob(tbref, (erts_aint_t) tb);
+ tb->common.btid = btid;
+ /*
+ * Table and magic indirection refer eachother,
+ * and table is refered once by being alive...
+ */
+ erts_smp_refc_init(&tb->common.refc, 2);
+ erts_refc_inc(&btid->refc, 1);
+}
+
+static ERTS_INLINE DbTable* btid2tab(Binary* btid)
+{
+ erts_smp_atomic_t *tbref = erts_smp_binary_to_magic_indirection(btid);
+ return (DbTable *) erts_smp_atomic_read_nob(tbref);
+}
+
+static DbTable *
+tid2tab(Eterm tid)
+{
+ DbTable *tb;
+ Binary *btid;
+ erts_smp_atomic_t *tbref;
+ if (!is_internal_magic_ref(tid))
+ return NULL;
+
+ btid = erts_magic_ref2bin(tid);
+ if (ERTS_MAGIC_BIN_DESTRUCTOR(btid) != db_table_tid_destructor)
+ return NULL;
+
+ tbref = erts_smp_binary_to_magic_indirection(btid);
+ tb = (DbTable *) erts_smp_atomic_read_nob(tbref);
+
+ ASSERT(!tb || tb->common.btid == btid);
+
+ return tb;
+}
+
+static ERTS_INLINE int
+is_table_alive(DbTable *tb)
+{
+ erts_smp_atomic_t *tbref;
+ DbTable *rtb;
+
+ tbref = erts_smp_binary_to_magic_indirection(tb->common.btid);
+ rtb = (DbTable *) erts_smp_atomic_read_nob(tbref);
+
+ ASSERT(!rtb || rtb == tb);
+
+ return !!rtb;
+}
+
+static ERTS_INLINE int
+is_table_named(DbTable *tb)
{
#ifdef ERTS_SMP
- return &meta_main_tab_locks[slot & ERTS_META_MAIN_TAB_LOCK_TAB_MASK].rwmtx;
+ return tb->common.type & DB_NAMED_TABLE;
#else
- return NULL;
+ return tb->common.status & DB_NAMED_TABLE;
#endif
}
-static erts_smp_spinlock_t meta_main_tab_main_lock;
-static Uint meta_main_tab_first_free; /* Index of first free slot */
-static int meta_main_tab_cnt; /* Number of active tables */
-static int meta_main_tab_top; /* Highest ever used slot + 1 */
-static Uint meta_main_tab_slot_mask; /* The slot index part of an unnamed table id */
-static Uint meta_main_tab_seq_incr;
-static Uint meta_main_tab_seq_cnt = 0; /* To give unique(-ish) table identifiers */
+
+static ERTS_INLINE void
+tid_clear(Process *c_p, DbTable *tb)
+{
+ DbTable *rtb;
+ Binary *btid = tb->common.btid;
+ erts_smp_atomic_t *tbref = erts_smp_binary_to_magic_indirection(btid);
+ rtb = (DbTable *) erts_smp_atomic_xchg_nob(tbref, (erts_aint_t) NULL);
+ ASSERT(!rtb || tb == rtb);
+ if (rtb) {
+ table_dec_refc(tb, 1);
+ delete_sched_table(c_p, tb);
+ }
+}
+
+static ERTS_INLINE Eterm
+make_tid(Process *c_p, DbTable *tb)
+{
+ Eterm *hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE);
+ return erts_mk_magic_ref(&hp, &c_p->off_heap, tb->common.btid);
+}
+
/*
** The meta hash table of all NAMED ets tables
@@ -181,8 +344,6 @@ int user_requested_db_max_tabs;
int erts_ets_realloc_always_moves;
int erts_ets_always_compress;
static int db_max_tabs;
-static DbTable *meta_pid_to_tab; /* Pid mapped to owned tables */
-static DbTable *meta_pid_to_fixed_tab; /* Pid mapped to fixed tables */
static Eterm ms_delete_all;
static Eterm ms_delete_all_buff[8]; /* To compare with for deletion
of all objects */
@@ -195,12 +356,9 @@ static void fix_table_locked(Process* p, DbTable* tb);
static void unfix_table_locked(Process* p, DbTable* tb, db_lock_kind_t* kind);
static void set_heir(Process* me, DbTable* tb, Eterm heir, UWord heir_data);
static void free_heir_data(DbTable*);
-static void free_fixations_locked(DbTable *tb);
+static SWord free_fixations_locked(Process* p, DbTable *tb);
-static int free_table_cont(Process *p,
- DbTable *tb,
- int first,
- int clean_meta_tab);
+static SWord free_table_continue(Process *p, DbTable *tb, SWord reds);
static void print_table(fmtfn_t to, void *to_arg, int show, DbTable* tb);
static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1);
static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1);
@@ -235,23 +393,16 @@ free_dbtable(void *vtb)
erts_smp_atomic_read_nob(&tb->common.memory_size)-sizeof(DbTable),
tb->common.fixations);
}
- erts_fprintf(stderr, "ets: free_dbtable(%T) deleted!!!\r\n",
- tb->common.id);
-
- erts_fprintf(stderr, "ets: free_dbtable: meta_pid_to_tab common.memory_size = %ld\n",
- erts_smp_atomic_read_nob(&meta_pid_to_tab->common.memory_size));
- print_table(ERTS_PRINT_STDOUT, NULL, 1, meta_pid_to_tab);
-
-
- erts_fprintf(stderr, "ets: free_dbtable: meta_pid_to_fixed_tab common.memory_size = %ld\n",
- erts_smp_atomic_read_nob(&meta_pid_to_fixed_tab->common.memory_size));
- print_table(ERTS_PRINT_STDOUT, NULL, 1, meta_pid_to_fixed_tab);
#endif
#ifdef ERTS_SMP
erts_smp_rwmtx_destroy(&tb->common.rwlock);
erts_smp_mtx_destroy(&tb->common.fixlock);
#endif
ASSERT(is_immed(tb->common.heir_data));
+
+ if (tb->common.btid && erts_refc_dectest(&tb->common.btid->refc, 0) == 0)
+ erts_bin_free(tb->common.btid);
+
erts_db_free(ERTS_ALC_T_DB_TABLE, tb, (void *) tb, sizeof(DbTable));
}
@@ -266,13 +417,163 @@ static void schedule_free_dbtable(DbTable* tb)
* Caller is *not* allowed to access the specialized part
* (hash or tree) of *tb after this function has returned.
*/
- ASSERT(erts_smp_refc_read(&tb->common.ref, 0) == 0);
+ ASSERT(erts_smp_refc_read(&tb->common.refc, 0) == 0);
+ ASSERT(erts_smp_refc_read(&tb->common.fix_count, 0) == 0);
erts_schedule_thr_prgr_later_cleanup_op(free_dbtable,
(void *) tb,
&tb->release.data,
sizeof(DbTable));
}
+static ERTS_INLINE void
+save_sched_table(Process *c_p, DbTable *tb)
+{
+ ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
+ DbTable *first;
+
+ ASSERT(esdp);
+ esdp->ets_tables.count++;
+ erts_smp_refc_inc(&tb->common.refc, 1);
+
+ first = esdp->ets_tables.clist;
+ if (!first) {
+ tb->common.all.next = tb->common.all.prev = tb;
+ esdp->ets_tables.clist = tb;
+ }
+ else {
+ tb->common.all.prev = first->common.all.prev;
+ tb->common.all.next = first;
+ tb->common.all.prev->common.all.next = tb;
+ first->common.all.prev = tb;
+ }
+}
+
+static ERTS_INLINE void
+remove_sched_table(ErtsSchedulerData *esdp, DbTable *tb)
+{
+ ErtsEtsAllYieldData *eaydp;
+ ASSERT(esdp);
+ ASSERT(erts_get_ref_numbers_thr_id(ERTS_MAGIC_BIN_REFN(tb->common.btid))
+ == (Uint32) esdp->no);
+
+ ASSERT(esdp->ets_tables.count > 0);
+ esdp->ets_tables.count--;
+
+ eaydp = ERTS_SCHED_AUX_YIELD_DATA(esdp, ets_all);
+ if (eaydp->ongoing) {
+ /* ets:all() op process list from last to first... */
+ if (eaydp->tab == tb) {
+ if (eaydp->tab == esdp->ets_tables.clist)
+ eaydp->tab = NULL;
+ else
+ eaydp->tab = tb->common.all.prev;
+ }
+ }
+
+ if (tb->common.all.next == tb) {
+ ASSERT(tb->common.all.prev == tb);
+ ASSERT(esdp->ets_tables.clist == tb);
+ esdp->ets_tables.clist = NULL;
+ }
+ else {
+#ifdef DEBUG
+ DbTable *tmp = esdp->ets_tables.clist;
+ do {
+ if (tmp == tb) break;
+ tmp = tmp->common.all.next;
+ } while (tmp != esdp->ets_tables.clist);
+ ASSERT(tmp == tb);
+#endif
+ tb->common.all.prev->common.all.next = tb->common.all.next;
+ tb->common.all.next->common.all.prev = tb->common.all.prev;
+
+ if (esdp->ets_tables.clist == tb)
+ esdp->ets_tables.clist = tb->common.all.next;
+
+ }
+
+ table_dec_refc(tb, 0);
+}
+
+static void
+scheduled_remove_sched_table(void *vtb)
+{
+ remove_sched_table(erts_get_scheduler_data(), (DbTable *) vtb);
+}
+
+static void
+delete_sched_table(Process *c_p, DbTable *tb)
+{
+ ErtsSchedulerData *esdp = erts_proc_sched_data(c_p);
+ Uint32 sid;
+
+ ASSERT(esdp);
+
+ ASSERT(tb->common.btid);
+ sid = erts_get_ref_numbers_thr_id(ERTS_MAGIC_BIN_REFN(tb->common.btid));
+ ASSERT(1 <= sid && sid <= erts_no_schedulers);
+ if (sid == (Uint32) esdp->no)
+ remove_sched_table(esdp, tb);
+ else
+ erts_schedule_misc_aux_work((int) sid, scheduled_remove_sched_table, tb);
+}
+
+static ERTS_INLINE void
+save_owned_table(Process *c_p, DbTable *tb)
+{
+ DbTable *first;
+
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
+
+ first = (DbTable*) erts_psd_get(c_p, ERTS_PSD_ETS_OWNED_TABLES);
+
+ erts_smp_refc_inc(&tb->common.refc, 1);
+
+ if (!first) {
+ tb->common.owned.next = tb->common.owned.prev = tb;
+ erts_psd_set(c_p, ERTS_PSD_ETS_OWNED_TABLES, tb);
+ }
+ else {
+ tb->common.owned.prev = first->common.owned.prev;
+ tb->common.owned.next = first;
+ tb->common.owned.prev->common.owned.next = tb;
+ first->common.owned.prev = tb;
+ }
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
+}
+
+static ERTS_INLINE void
+delete_owned_table(Process *p, DbTable *tb)
+{
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ if (tb->common.owned.next == tb) {
+ DbTable* old;
+ ASSERT(tb->common.owned.prev == tb);
+ old = erts_psd_set(p, ERTS_PSD_ETS_OWNED_TABLES, NULL);
+ ASSERT(old == tb); (void)old;
+ }
+ else {
+ DbTable *first = (DbTable*) erts_psd_get(p, ERTS_PSD_ETS_OWNED_TABLES);
+#ifdef DEBUG
+ DbTable *tmp = first;
+ do {
+ if (tmp == tb) break;
+ tmp = tmp->common.owned.next;
+ } while (tmp != first);
+ ASSERT(tmp == tb);
+#endif
+ tb->common.owned.prev->common.owned.next = tb->common.owned.next;
+ tb->common.owned.next->common.owned.prev = tb->common.owned.prev;
+
+ if (tb == first)
+ erts_psd_set(p, ERTS_PSD_ETS_OWNED_TABLES, tb->common.owned.next);
+ }
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+
+ table_dec_refc(tb, 1);
+}
+
+
static ERTS_INLINE void db_init_lock(DbTable* tb, int use_frequent_read_lock,
char *rwname, char* fixname)
{
@@ -294,7 +595,6 @@ static ERTS_INLINE void db_init_lock(DbTable* tb, int use_frequent_read_lock,
static ERTS_INLINE void db_lock(DbTable* tb, db_lock_kind_t kind)
{
#ifdef ERTS_SMP
- ASSERT(tb != meta_pid_to_tab && tb != meta_pid_to_fixed_tab);
if (tb->common.type & DB_FINE_LOCKED) {
if (kind == LCK_WRITE) {
erts_smp_rwmtx_rwlock(&tb->common.rwlock);
@@ -327,8 +627,6 @@ static ERTS_INLINE void db_unlock(DbTable* tb, db_lock_kind_t kind)
* to follow the tb pointer!
*/
#ifdef ERTS_SMP
- ASSERT(tb != meta_pid_to_tab && tb != meta_pid_to_fixed_tab);
-
if (tb->common.type & DB_FINE_LOCKED) {
if (kind == LCK_WRITE) {
ASSERT(tb->common.is_thread_safe);
@@ -354,20 +652,6 @@ static ERTS_INLINE void db_unlock(DbTable* tb, db_lock_kind_t kind)
#endif
}
-
-static ERTS_INLINE void db_meta_lock(DbTable* tb, db_lock_kind_t kind)
-{
- ASSERT(tb == meta_pid_to_tab || tb == meta_pid_to_fixed_tab);
- ASSERT(kind != LCK_WRITE);
- /* As long as we only lock for READ we don't have to lock at all. */
-}
-
-static ERTS_INLINE void db_meta_unlock(DbTable* tb, db_lock_kind_t kind)
-{
- ASSERT(tb == meta_pid_to_tab || tb == meta_pid_to_fixed_tab);
- ASSERT(kind != LCK_WRITE);
-}
-
static ERTS_INLINE
DbTable* db_get_table_aux(Process *p,
Eterm id,
@@ -375,7 +659,7 @@ DbTable* db_get_table_aux(Process *p,
db_lock_kind_t kind,
int meta_already_locked)
{
- DbTable *tb = NULL;
+ DbTable *tb;
erts_smp_rwmtx_t *mtl = NULL;
/*
@@ -385,23 +669,7 @@ DbTable* db_get_table_aux(Process *p,
*/
ASSERT(erts_get_scheduler_data());
- if (is_small(id)) {
- Uint slot = unsigned_val(id) & meta_main_tab_slot_mask;
- if (!meta_already_locked) {
- mtl = get_meta_main_tab_lock(slot);
- erts_smp_rwmtx_rlock(mtl);
- }
-#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
- else {
- erts_smp_rwmtx_t *test_mtl = get_meta_main_tab_lock(slot);
- ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rlocked(test_mtl)
- || erts_lc_rwmtx_is_rwlocked(test_mtl));
- }
-#endif
- if (slot < db_max_tabs && IS_SLOT_ALIVE(slot))
- tb = meta_main_tab[slot].u.tb;
- }
- else if (is_atom(id)) {
+ if (is_atom(id)) {
struct meta_name_tab_entry* bucket = meta_name_tab_bucket(id,&mtl);
if (!meta_already_locked)
erts_smp_rwmtx_rlock(mtl);
@@ -410,7 +678,7 @@ DbTable* db_get_table_aux(Process *p,
|| erts_lc_rwmtx_is_rwlocked(mtl));
mtl = NULL;
}
-
+ tb = NULL;
if (bucket->pu.tb != NULL) {
if (is_atom(bucket->u.name_atom)) { /* single */
if (bucket->u.name_atom == id)
@@ -428,11 +696,13 @@ DbTable* db_get_table_aux(Process *p,
}
}
}
+ else
+ tb = tid2tab(id);
+
if (tb) {
db_lock(tb, kind);
- if (tb->common.id != id
- || ((tb->common.status & what) == 0
- && p->common.id != tb->common.owner)) {
+ if ((tb->common.status & what) == 0
+ && p->common.id != tb->common.owner) {
db_unlock(tb, kind);
tb = NULL;
}
@@ -451,18 +721,6 @@ DbTable* db_get_table(Process *p,
return db_get_table_aux(p, id, what, kind, 0);
}
-/* Requires meta_main_tab_locks[slot] locked.
-*/
-static ERTS_INLINE void free_slot(int slot)
-{
- ASSERT(!IS_SLOT_FREE(slot));
- erts_smp_spin_lock(&meta_main_tab_main_lock);
- SET_NEXT_FREE_SLOT(slot,meta_main_tab_first_free);
- meta_main_tab_first_free = slot;
- meta_main_tab_cnt--;
- erts_smp_spin_unlock(&meta_main_tab_main_lock);
-}
-
static int insert_named_tab(Eterm name_atom, DbTable* tb, int have_lock)
{
int ret = 0;
@@ -527,9 +785,10 @@ static int remove_named_tab(DbTable *tb, int have_lock)
{
int ret = 0;
erts_smp_rwmtx_t* rwlock;
- Eterm name_atom = tb->common.id;
+ Eterm name_atom = tb->common.the_name;
struct meta_name_tab_entry* bucket = meta_name_tab_bucket(name_atom,
&rwlock);
+ ASSERT(is_table_named(tb));
#ifdef ERTS_SMP
if (!have_lock && erts_smp_rwmtx_tryrwlock(rwlock) == EBUSY) {
db_unlock(tb, LCK_WRITE);
@@ -600,11 +859,11 @@ done:
*/
static ERTS_INLINE void local_fix_table(DbTable* tb)
{
- erts_smp_refc_inc(&tb->common.ref, 1);
+ erts_smp_refc_inc(&tb->common.fix_count, 1);
}
static ERTS_INLINE void local_unfix_table(DbTable* tb)
{
- if (erts_smp_refc_dectest(&tb->common.ref, 0) == 0) {
+ if (erts_smp_refc_dectest(&tb->common.fix_count, 0) == 0) {
ASSERT(IS_HASH_TABLE(tb->common.status));
db_unfix_table_hash(&(tb->hash));
}
@@ -1244,6 +1503,7 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2)
{
DbTable* tb;
Eterm ret;
+ Eterm old_name;
erts_smp_rwmtx_t *lck1, *lck2;
#ifdef HARDDEBUG
@@ -1260,12 +1520,10 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2)
(void) meta_name_tab_bucket(BIF_ARG_2, &lck1);
- if (is_small(BIF_ARG_1)) {
- Uint slot = unsigned_val(BIF_ARG_1) & meta_main_tab_slot_mask;
- lck2 = get_meta_main_tab_lock(slot);
- }
- else if (is_atom(BIF_ARG_1)) {
- (void) meta_name_tab_bucket(BIF_ARG_1, &lck2);
+ if (is_atom(BIF_ARG_1)) {
+ old_name = BIF_ARG_1;
+ named_tab:
+ (void) meta_name_tab_bucket(old_name, &lck2);
if (lck1 == lck2)
lck2 = NULL;
else if (lck1 > lck2) {
@@ -1275,7 +1533,16 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2)
}
}
else {
- BIF_ERROR(BIF_P, BADARG);
+ tb = tid2tab(BIF_ARG_1);
+ if (!tb)
+ BIF_ERROR(BIF_P, BADARG);
+ else {
+ if (is_table_named(tb)) {
+ old_name = tb->common.the_name;
+ goto named_tab;
+ }
+ lck2 = NULL;
+ }
}
erts_smp_rwmtx_rwlock(lck1);
@@ -1286,21 +1553,19 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2)
if (!tb)
goto badarg;
- if (is_not_atom(tb->common.id)) { /* Not a named table */
- tb->common.the_name = BIF_ARG_2;
- goto done;
- }
-
- if (!insert_named_tab(BIF_ARG_2, tb, 1))
- goto badarg;
+ if (is_table_named(tb)) {
+ if (!insert_named_tab(BIF_ARG_2, tb, 1))
+ goto badarg;
- if (!remove_named_tab(tb, 1))
- erts_exit(ERTS_ERROR_EXIT,"Could not find named tab %s", tb->common.id);
-
- tb->common.id = tb->common.the_name = BIF_ARG_2;
+ if (!remove_named_tab(tb, 1))
+ erts_exit(ERTS_ERROR_EXIT,"Could not find named tab %s", tb->common.the_name);
+ ret = BIF_ARG_2;
+ }
+ else { /* Not a named table */
+ ret = BIF_ARG_1;
+ }
+ tb->common.the_name = BIF_ARG_2;
- done:
- ret = tb->common.id;
db_unlock(tb, LCK_WRITE);
erts_smp_rwmtx_rwunlock(lck1);
if (lck2)
@@ -1324,7 +1589,6 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2)
BIF_RETTYPE ets_new_2(BIF_ALIST_2)
{
DbTable* tb = NULL;
- int slot;
Eterm list;
Eterm val;
Eterm ret;
@@ -1339,9 +1603,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
#ifdef DEBUG
int cret;
#endif
- DeclareTmpHeap(meta_tuple,3,BIF_P);
DbTableMethod* meth;
- erts_smp_rwmtx_t *mmtl;
if (is_not_atom(BIF_ARG_1)) {
BIF_ERROR(BIF_P, BADARG);
@@ -1350,7 +1612,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
BIF_ERROR(BIF_P, BADARG);
}
- status = DB_NORMAL | DB_SET | DB_PROTECTED;
+ status = DB_SET | DB_PROTECTED;
keypos = 1;
is_named = 0;
#ifdef ERTS_SMP
@@ -1433,6 +1695,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
}
else if (val == am_named_table) {
is_named = 1;
+ status |= DB_NAMED_TABLE;
}
else if (val == am_compressed) {
is_compressed = 1;
@@ -1487,7 +1750,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
tb->common.type = status & ERTS_ETS_TABLE_TYPES;
/* Note, 'type' is *read only* from now on... */
#endif
- erts_smp_refc_init(&tb->common.ref, 0);
+ erts_smp_refc_init(&tb->common.fix_count, 0);
db_init_lock(tb, status & (DB_FINE_LOCKED|DB_FREQ_READ),
"db_tab", "db_tab_fix");
tb->common.keypos = keypos;
@@ -1496,7 +1759,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
erts_smp_atomic_init_nob(&tb->common.nitems, 0);
- tb->common.fixations = NULL;
+ tb->common.fixing_procs = NULL;
tb->common.compress = is_compressed;
#ifdef DEBUG
@@ -1505,87 +1768,36 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
meth->db_create(BIF_P, tb);
ASSERT(cret == DB_ERROR_NONE);
- erts_smp_spin_lock(&meta_main_tab_main_lock);
+ make_btid(tb);
- if (meta_main_tab_cnt >= db_max_tabs) {
- erts_smp_spin_unlock(&meta_main_tab_main_lock);
- erts_send_error_to_logger_str(BIF_P->group_leader,
- "** Too many db tables **\n");
- free_heir_data(tb);
- tb->common.meth->db_free_table(tb);
- free_dbtable((void *) tb);
- BIF_ERROR(BIF_P, SYSTEM_LIMIT);
- }
-
- slot = meta_main_tab_first_free;
- ASSERT(slot>=0 && slot<db_max_tabs);
- meta_main_tab_first_free = GET_NEXT_FREE_SLOT(slot);
- meta_main_tab_cnt++;
- if (slot >= meta_main_tab_top) {
- ASSERT(slot == meta_main_tab_top);
- meta_main_tab_top = slot + 1;
- }
-
- if (is_named) {
- ret = BIF_ARG_1;
- }
- else {
- ret = make_small(slot | meta_main_tab_seq_cnt);
- meta_main_tab_seq_cnt += meta_main_tab_seq_incr;
- ASSERT((unsigned_val(ret) & meta_main_tab_slot_mask) == slot);
- }
- erts_smp_spin_unlock(&meta_main_tab_main_lock);
-
- tb->common.id = ret;
- tb->common.slot = slot; /* store slot for erase */
+ if (is_named)
+ ret = BIF_ARG_1;
+ else
+ ret = make_tid(BIF_P, tb);
- mmtl = get_meta_main_tab_lock(slot);
- erts_smp_rwmtx_rwlock(mmtl);
- meta_main_tab[slot].u.tb = tb;
- ASSERT(IS_SLOT_ALIVE(slot));
- erts_smp_rwmtx_rwunlock(mmtl);
+ save_sched_table(BIF_P, tb);
if (is_named && !insert_named_tab(BIF_ARG_1, tb, 0)) {
- mmtl = get_meta_main_tab_lock(slot);
- erts_smp_rwmtx_rwlock(mmtl);
- free_slot(slot);
- erts_smp_rwmtx_rwunlock(mmtl);
+ tid_clear(BIF_P, tb);
db_lock(tb,LCK_WRITE);
free_heir_data(tb);
tb->common.meth->db_free_table(tb);
- schedule_free_dbtable(tb);
db_unlock(tb,LCK_WRITE);
+ table_dec_refc(tb, 0);
BIF_ERROR(BIF_P, BADARG);
}
BIF_P->flags |= F_USING_DB; /* So we can remove tb if p dies */
+ save_owned_table(BIF_P, tb);
#ifdef HARDDEBUG
erts_fprintf(stderr,
"ets:new(%T,%T)=%T; Process: %T, initial: %T:%T/%bpu\n",
BIF_ARG_1, BIF_ARG_2, ret, BIF_P->common.id,
BIF_P->u.initial[0], BIF_P->u.initial[1], BIF_P->u.initial[2]);
- erts_fprintf(stderr, "ets: new: meta_pid_to_tab common.memory_size = %ld\n",
- erts_smp_atomic_read_nob(&meta_pid_to_tab->common.memory_size));
- erts_fprintf(stderr, "ets: new: meta_pid_to_fixed_tab common.memory_size = %ld\n",
- erts_smp_atomic_read_nob(&meta_pid_to_fixed_tab->common.memory_size));
#endif
- UseTmpHeap(3,BIF_P);
-
- db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC);
- if (db_put_hash(meta_pid_to_tab,
- TUPLE2(meta_tuple,
- BIF_P->common.id,
- make_small(slot)),
- 0) != DB_ERROR_NONE) {
- erts_exit(ERTS_ERROR_EXIT,"Could not update ets metadata.");
- }
- db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC);
-
- UnUseTmpHeap(3,BIF_P);
-
BIF_RET(ret);
}
@@ -1690,9 +1902,9 @@ BIF_RETTYPE ets_lookup_element_3(BIF_ALIST_3)
*/
BIF_RETTYPE ets_delete_1(BIF_ALIST_1)
{
- int trap;
+ SWord initial_reds = ERTS_BIF_REDS_LEFT(BIF_P);
+ SWord reds = initial_reds;
DbTable* tb;
- erts_smp_rwmtx_t *mmtl;
#ifdef HARDDEBUG
erts_fprintf(stderr,
@@ -1715,7 +1927,6 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1)
tb->common.status |= DB_DELETE;
if (tb->common.owner != BIF_P->common.id) {
- DeclareTmpHeap(meta_tuple,3,BIF_P);
/*
* The table is being deleted by a process other than its owner.
@@ -1723,50 +1934,33 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1)
* current process will be killed (e.g. by an EXIT signal), we will
* now transfer the ownership to the current process.
*/
- UseTmpHeap(3,BIF_P);
- db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC);
- db_erase_bag_exact2(meta_pid_to_tab, tb->common.owner,
- make_small(tb->common.slot));
-
- BIF_P->flags |= F_USING_DB;
- tb->common.owner = BIF_P->common.id;
-
- db_put_hash(meta_pid_to_tab,
- TUPLE2(meta_tuple,
- BIF_P->common.id,
- make_small(tb->common.slot)),
- 0);
- db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC);
- UnUseTmpHeap(3,BIF_P);
- }
- mmtl = get_meta_main_tab_lock(tb->common.slot);
-#ifdef ERTS_SMP
- if (erts_smp_rwmtx_tryrwlock(mmtl) == EBUSY) {
- /*
- * We keep our increased refc over this op in order to
- * prevent the table from disapearing.
- */
- db_unlock(tb, LCK_WRITE);
- erts_smp_rwmtx_rwlock(mmtl);
- db_lock(tb, LCK_WRITE);
+ Process *rp = erts_proc_lookup_raw(tb->common.owner);
+ /*
+ * Process 'rp' might be exiting, but our table lock prevents it
+ * from terminating as it cannot complete erts_db_process_exiting().
+ */
+ ASSERT(!(ERTS_PSFLG_FREE & erts_smp_atomic32_read_nob(&rp->state)));
+
+ delete_owned_table(rp, tb);
+ BIF_P->flags |= F_USING_DB;
+ tb->common.owner = BIF_P->common.id;
+ save_owned_table(BIF_P, tb);
}
-#endif
- /* We must keep the slot, to be found by db_proc_dead() if process dies */
- MARK_SLOT_DEAD(tb->common.slot);
- erts_smp_rwmtx_rwunlock(mmtl);
- if (is_atom(tb->common.id))
+
+ tid_clear(BIF_P, tb);
+
+ if (is_table_named(tb))
remove_named_tab(tb, 0);
/* disable inheritance */
free_heir_data(tb);
tb->common.heir = am_none;
- free_fixations_locked(tb);
-
- trap = free_table_cont(BIF_P, tb, 1, 1);
+ reds -= free_fixations_locked(BIF_P, tb);
db_unlock(tb, LCK_WRITE);
- if (trap) {
+
+ if (free_table_continue(BIF_P, tb, reds) < 0) {
/*
* Package the DbTable* pointer into a bignum so that it can be safely
* passed through a trap. We used to pass the DbTable* pointer directly
@@ -1776,9 +1970,11 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1)
Eterm *hp = HAlloc(BIF_P, 2);
hp[0] = make_pos_bignum_header(1);
hp[1] = (Eterm) tb;
+ BUMP_ALL_REDS(BIF_P);
BIF_TRAP1(&ets_delete_continue_exp, BIF_P, make_big(hp));
}
else {
+ BUMP_REDS(BIF_P, (initial_reds - reds));
BIF_RET(am_true);
}
}
@@ -1790,7 +1986,6 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3)
{
Process* to_proc = NULL;
ErtsProcLocks to_locks = ERTS_PROC_LOCK_MAIN;
- DeclareTmpHeap(buf,5,BIF_P);
Eterm to_pid = BIF_ARG_2;
Eterm from_pid;
DbTable* tb = NULL;
@@ -1812,26 +2007,14 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3)
goto badarg; /* or should we be idempotent? return false maybe */
}
- UseTmpHeap(5,BIF_P);
- db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC);
- db_erase_bag_exact2(meta_pid_to_tab, tb->common.owner,
- make_small(tb->common.slot));
-
+ delete_owned_table(BIF_P, tb);
to_proc->flags |= F_USING_DB;
tb->common.owner = to_pid;
-
- db_put_hash(meta_pid_to_tab,
- TUPLE2(buf,to_pid,make_small(tb->common.slot)),
- 0);
- db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC);
+ save_owned_table(to_proc, tb);
db_unlock(tb,LCK_WRITE);
- erts_send_message(BIF_P, to_proc, &to_locks,
- TUPLE4(buf, am_ETS_TRANSFER,
- tb->common.id,
- from_pid,
- BIF_ARG_3),
- 0);
+ send_ets_transfer_message(BIF_P, to_proc, &to_locks,
+ tb, BIF_ARG_3);
erts_smp_proc_unlock(to_proc, to_locks);
UnUseTmpHeap(5,BIF_P);
BIF_RET(am_true);
@@ -2074,7 +2257,7 @@ BIF_RETTYPE ets_select_delete_2(BIF_ALIST_2)
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_delete(BIF_P, tb, BIF_ARG_2, &ret);
+ cret = tb->common.meth->db_select_delete(BIF_P, tb, BIF_ARG_1, BIF_ARG_2, &ret);
if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
fix_table_locked(BIF_P,tb);
@@ -2101,46 +2284,254 @@ BIF_RETTYPE ets_select_delete_2(BIF_ALIST_2)
return result;
}
-/*
-** Return a list of tables on this node
-*/
-BIF_RETTYPE ets_all_0(BIF_ALIST_0)
+/*
+ * ets:all/0
+ *
+ * ets:all() calls ets:internal_request_all/0 which
+ * requests information about all tables from
+ * each scheduler thread. Each scheduler replies
+ * to the calling process with information about
+ * existing tables created on that specific scheduler.
+ */
+
+struct ErtsEtsAllReq_ {
+ erts_smp_atomic32_t refc;
+ Process *proc;
+ ErtsOIRefStorage ref;
+ ErtsEtsAllReqList list[1]; /* one per scheduler */
+};
+
+#define ERTS_ETS_ALL_REQ_SIZE \
+ (sizeof(ErtsEtsAllReq) \
+ + (sizeof(ErtsEtsAllReqList) \
+ * (erts_no_schedulers - 1)))
+
+typedef struct {
+ ErtsEtsAllReq *ongoing;
+ ErlHeapFragment *hfrag;
+ DbTable *tab;
+ ErtsEtsAllReq *queue;
+} ErtsEtsAllData;
+
+/* Tables handled before yielding */
+#define ERTS_ETS_ALL_TB_YCNT 200
+/*
+ * Min yield count required before starting
+ * an operation that will require yield.
+ */
+#define ERTS_ETS_ALL_TB_YCNT_START 10
+
+#ifdef DEBUG
+/* Test yielding... */
+#undef ERTS_ETS_ALL_TB_YCNT
+#undef ERTS_ETS_ALL_TB_YCNT_START
+#define ERTS_ETS_ALL_TB_YCNT 10
+#define ERTS_ETS_ALL_TB_YCNT_START 1
+#endif
+
+static int
+ets_all_reply(ErtsSchedulerData *esdp, ErtsEtsAllReq **reqpp,
+ ErlHeapFragment **hfragpp, DbTable **tablepp,
+ int *yield_count_p)
{
- DbTable* tb;
- Eterm previous;
- int i;
- Eterm* hp;
- Eterm* hendp;
- int t_tabs_cnt;
- int t_top;
-
- erts_smp_spin_lock(&meta_main_tab_main_lock);
- t_tabs_cnt = meta_main_tab_cnt;
- t_top = meta_main_tab_top;
- erts_smp_spin_unlock(&meta_main_tab_main_lock);
-
- hp = HAlloc(BIF_P, 2*t_tabs_cnt);
- hendp = hp + 2*t_tabs_cnt;
-
- previous = NIL;
- for(i = 0; i < t_top; i++) {
- erts_smp_rwmtx_t *mmtl = get_meta_main_tab_lock(i);
- erts_smp_rwmtx_rlock(mmtl);
- if (IS_SLOT_ALIVE(i)) {
- if (hp == hendp) {
- /* Racing table creator, grab some more heap space */
- t_tabs_cnt = 10;
- hp = HAlloc(BIF_P, 2*t_tabs_cnt);
- hendp = hp + 2*t_tabs_cnt;
- }
- tb = meta_main_tab[i].u.tb;
- previous = CONS(hp, tb->common.id, previous);
- hp += 2;
- }
- erts_smp_rwmtx_runlock(mmtl);
+ ErtsEtsAllReq *reqp = *reqpp;
+ ErlHeapFragment *hfragp = *hfragpp;
+ int ycount = *yield_count_p;
+ DbTable *tb, *first;
+ Uint sz;
+ Eterm list, msg, ref, *hp;
+ ErlOffHeap *ohp;
+ ErtsMessage *mp;
+
+ /*
+ * - save_sched_table() inserts at end of circular list.
+ *
+ * - This function scans from the end so we know that
+ * the amount of tables to scan wont grow even if we
+ * yield.
+ *
+ * - remove_sched_table() updates the table we yielded
+ * on if it removes it.
+ */
+
+ if (hfragp) {
+ /* Restart of a yielded operation... */
+ ASSERT(hfragp->used_size < hfragp->alloc_size);
+ ohp = &hfragp->off_heap;
+ hp = &hfragp->mem[hfragp->used_size];
+ list = *hp;
+ hfragp->used_size = hfragp->alloc_size;
+ first = esdp->ets_tables.clist;
+ tb = *tablepp;
+ }
+ else {
+ /* A new operation... */
+ ASSERT(!*tablepp);
+
+ /* Max heap size needed... */
+ sz = esdp->ets_tables.count;
+ sz *= ERTS_MAGIC_REF_THING_SIZE + 2;
+ sz += 3 + ERTS_REF_THING_SIZE;
+ hfragp = new_message_buffer(sz);
+
+ hp = &hfragp->mem[0];
+ ohp = &hfragp->off_heap;
+ list = NIL;
+ first = esdp->ets_tables.clist;
+ tb = first ? first->common.all.prev : NULL;
+ }
+
+ if (tb) {
+ while (1) {
+ if (is_table_alive(tb)) {
+ Eterm tid;
+ if (is_table_named(tb))
+ tid = tb->common.the_name;
+ else
+ tid = erts_mk_magic_ref(&hp, ohp, tb->common.btid);
+ list = CONS(hp, tid, list);
+ hp += 2;
+ }
+
+ if (tb == first)
+ break;
+
+ tb = tb->common.all.prev;
+
+ if (--ycount <= 0) {
+ sz = hp - &hfragp->mem[0];
+ ASSERT(hfragp->alloc_size > sz + 1);
+ *hp = list;
+ hfragp->used_size = sz;
+ *hfragpp = hfragp;
+ *reqpp = reqp;
+ *tablepp = tb;
+ *yield_count_p = 0;
+ return 1; /* Yield! */
+ }
+ }
+ }
+
+ ref = erts_oiref_storage_make_ref(&reqp->ref, &hp);
+ msg = TUPLE2(hp, ref, list);
+ hp += 3;
+
+ sz = hp - &hfragp->mem[0];
+ ASSERT(sz <= hfragp->alloc_size);
+
+ hfragp = erts_resize_message_buffer(hfragp, sz, &msg, 1);
+
+ mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = hfragp;
+
+ erts_queue_message(reqp->proc, 0, mp, msg, am_system);
+
+ erts_proc_dec_refc(reqp->proc);
+
+ if (erts_smp_atomic32_dec_read_nob(&reqp->refc) == 0)
+ erts_free(ERTS_ALC_T_ETS_ALL_REQ, reqp);
+
+ *reqpp = NULL;
+ *hfragpp = NULL;
+ *tablepp = NULL;
+ *yield_count_p = ycount;
+
+ return 0;
+}
+
+int
+erts_handle_yielded_ets_all_request(ErtsSchedulerData *esdp,
+ ErtsEtsAllYieldData *eaydp)
+{
+ int ix = (int) esdp->no - 1;
+ int yc = ERTS_ETS_ALL_TB_YCNT;
+
+ while (1) {
+ if (!eaydp->ongoing) {
+ ErtsEtsAllReq *ongoing;
+
+ if (!eaydp->queue)
+ return 0; /* All work completed! */
+
+ if (yc < ERTS_ETS_ALL_TB_YCNT_START && yc > esdp->ets_tables.count)
+ return 1; /* Yield! */
+
+ eaydp->ongoing = ongoing = eaydp->queue;
+ if (ongoing->list[ix].next == ongoing)
+ eaydp->queue = NULL;
+ else {
+ ongoing->list[ix].next->list[ix].prev = ongoing->list[ix].prev;
+ ongoing->list[ix].prev->list[ix].next = ongoing->list[ix].next;
+ eaydp->queue = ongoing->list[ix].next;
+ }
+ ASSERT(!eaydp->hfrag);
+ ASSERT(!eaydp->tab);
+ }
+
+ if (ets_all_reply(esdp, &eaydp->ongoing, &eaydp->hfrag, &eaydp->tab, &yc))
+ return 1; /* Yield! */
+ }
+}
+
+static void
+handle_ets_all_request(void *vreq)
+{
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ ErtsEtsAllYieldData *eayp = ERTS_SCHED_AUX_YIELD_DATA(esdp, ets_all);
+ ErtsEtsAllReq *req = (ErtsEtsAllReq *) vreq;
+
+ if (!eayp->ongoing && !eayp->queue) {
+ /* No ets:all() operations ongoing... */
+ ErlHeapFragment *hf = NULL;
+ DbTable *tb = NULL;
+ int yc = ERTS_ETS_ALL_TB_YCNT;
+ if (ets_all_reply(esdp, &req, &hf, &tb, &yc)) {
+ /* Yielded... */
+ ASSERT(hf);
+ eayp->ongoing = req;
+ eayp->hfrag = hf;
+ eayp->tab = tb;
+ erts_notify_new_aux_yield_work(esdp);
+ }
+ }
+ else {
+ /* Ongoing ets:all() operations; queue up this request... */
+ int ix = (int) esdp->no - 1;
+ if (!eayp->queue) {
+ req->list[ix].next = req;
+ req->list[ix].prev = req;
+ eayp->queue = req;
+ }
+ else {
+ req->list[ix].next = eayp->queue;
+ req->list[ix].prev = eayp->queue->list[ix].prev;
+ eayp->queue->list[ix].prev = req;
+ req->list[ix].prev->list[ix].next = req;
+ }
}
- HRelease(BIF_P, hendp, hp);
- BIF_RET(previous);
+}
+
+BIF_RETTYPE ets_internal_request_all_0(BIF_ALIST_0)
+{
+ Eterm ref = erts_make_ref(BIF_P);
+ ErtsEtsAllReq *req = erts_alloc(ERTS_ALC_T_ETS_ALL_REQ,
+ ERTS_ETS_ALL_REQ_SIZE);
+ erts_smp_atomic32_init_nob(&req->refc,
+ (erts_aint32_t) erts_no_schedulers);
+ erts_oiref_storage_save(&req->ref, ref);
+ req->proc = BIF_P;
+ erts_proc_add_refc(BIF_P, (Sint) erts_no_schedulers);
+
+#ifdef ERTS_SMP
+ if (erts_no_schedulers > 1)
+ erts_schedule_multi_misc_aux_work(1,
+ erts_no_schedulers,
+ handle_ets_all_request,
+ (void *) req);
+#endif
+
+ handle_ets_all_request((void *) req);
+ BIF_RET(ref);
}
@@ -2245,7 +2636,7 @@ ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3)
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_chunk(p, tb,
+ cret = tb->common.meth->db_select_chunk(p, tb, arg1,
arg2, chunk_size,
0 /* not reversed */,
&ret);
@@ -2414,8 +2805,7 @@ ets_select2(Process* p, Eterm arg1, Eterm arg2)
local_fix_table(tb);
}
- cret = tb->common.meth->db_select(p, tb, arg2,
- 0, &ret);
+ cret = tb->common.meth->db_select(p, tb, arg1, arg2, 0, &ret);
if (DID_TRAP(p,ret) && safety != ITER_SAFE) {
fix_table_locked(p, tb);
@@ -2506,7 +2896,7 @@ BIF_RETTYPE ets_select_count_2(BIF_ALIST_2)
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_count(BIF_P,tb,BIF_ARG_2, &ret);
+ cret = tb->common.meth->db_select_count(BIF_P,tb, BIF_ARG_1, BIF_ARG_2, &ret);
if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
fix_table_locked(BIF_P, tb);
@@ -2560,7 +2950,7 @@ BIF_RETTYPE ets_select_reverse_3(BIF_ALIST_3)
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_chunk(BIF_P,tb,
+ cret = tb->common.meth->db_select_chunk(BIF_P,tb, BIF_ARG_1,
BIF_ARG_2, chunk_size,
1 /* reversed */, &ret);
if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
@@ -2610,7 +3000,7 @@ BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2)
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select(BIF_P,tb,BIF_ARG_2,
+ cret = tb->common.meth->db_select(BIF_P,tb, BIF_ARG_1, BIF_ARG_2,
1 /*reversed*/, &ret);
if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
@@ -2701,7 +3091,7 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1)
*/
if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) {
- if (is_atom(BIF_ARG_1) || is_small(BIF_ARG_1)) {
+ if (is_atom(BIF_ARG_1) || is_ref(BIF_ARG_1)) {
BIF_RET(am_undefined);
}
BIF_ERROR(BIF_P, BADARG);
@@ -2763,7 +3153,7 @@ BIF_RETTYPE ets_info_2(BIF_ALIST_2)
Eterm ret = THE_NON_VALUE;
if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) {
- if (is_atom(BIF_ARG_1) || is_small(BIF_ARG_1)) {
+ if (is_atom(BIF_ARG_1) || is_ref(BIF_ARG_1)) {
BIF_RET(am_undefined);
}
BIF_ERROR(BIF_P, BADARG);
@@ -2853,7 +3243,6 @@ int erts_ets_rwmtx_spin_count = -1;
void init_db(ErtsDbSpinCount db_spin_count)
{
- DbTable init_tb;
int i;
Eterm *hp;
unsigned bits;
@@ -2902,16 +3291,6 @@ void init_db(ErtsDbSpinCount db_spin_count)
if (erts_ets_rwmtx_spin_count >= 0)
rwmtx_opt.main_spincount = erts_ets_rwmtx_spin_count;
- meta_main_tab_locks =
- erts_alloc_permanent_cache_aligned(ERTS_ALC_T_DB_TABLES,
- sizeof(erts_meta_main_tab_lock_t)
- * ERTS_META_MAIN_TAB_LOCK_TAB_SIZE);
-
- for (i = 0; i < ERTS_META_MAIN_TAB_LOCK_TAB_SIZE; i++) {
- erts_smp_rwmtx_init_opt_x(&meta_main_tab_locks[i].rwmtx, &rwmtx_opt,
- "meta_main_tab_slot", make_small(i));
- }
- erts_smp_spinlock_init(&meta_main_tab_main_lock, "meta_main_tab_main");
for (i=0; i<META_NAME_TAB_LOCK_CNT; i++) {
erts_smp_rwmtx_init_opt_x(&meta_name_tab_rwlocks[i].lck, &rwmtx_opt,
"meta_name_tab", make_small(i));
@@ -2931,20 +3310,6 @@ void init_db(ErtsDbSpinCount db_spin_count)
erts_exit(ERTS_ERROR_EXIT,"Max limit for ets tabled too high %u (max %u).",
db_max_tabs, ((Uint)1)<<SMALL_BITS);
}
- meta_main_tab_slot_mask = (((Uint)1)<<bits) - 1;
- meta_main_tab_seq_incr = (((Uint)1)<<bits);
-
- size = sizeof(*meta_main_tab)*db_max_tabs;
- meta_main_tab = erts_db_alloc_nt(ERTS_ALC_T_DB_TABLES, size);
- ERTS_ETS_MISC_MEM_ADD(size);
-
- meta_main_tab_cnt = 0;
- meta_main_tab_top = 0;
- for (i=1; i<db_max_tabs; i++) {
- SET_NEXT_FREE_SLOT(i-1,i);
- }
- SET_NEXT_FREE_SLOT(db_max_tabs-1, (Uint)-1);
- meta_main_tab_first_free = 0;
meta_name_tab_mask = (((Uint) 1)<<(bits-1)) - 1; /* At least half the size of main tab */
size = sizeof(struct meta_name_tab_entry)*(meta_name_tab_mask+1);
@@ -2959,70 +3324,6 @@ void init_db(ErtsDbSpinCount db_spin_count)
db_initialize_hash();
db_initialize_tree();
- /*TT*/
- /* Create meta table invertion. */
- erts_smp_atomic_init_nob(&init_tb.common.memory_size, 0);
- meta_pid_to_tab = (DbTable*) erts_db_alloc(ERTS_ALC_T_DB_TABLE,
- &init_tb,
- sizeof(DbTable));
- erts_smp_atomic_init_nob(&meta_pid_to_tab->common.memory_size,
- erts_smp_atomic_read_nob(&init_tb.common.memory_size));
-
- meta_pid_to_tab->common.id = NIL;
- meta_pid_to_tab->common.the_name = am_true;
- meta_pid_to_tab->common.status = (DB_NORMAL | DB_BAG | DB_PUBLIC | DB_FINE_LOCKED);
-#ifdef ERTS_SMP
- meta_pid_to_tab->common.type
- = meta_pid_to_tab->common.status & ERTS_ETS_TABLE_TYPES;
- /* Note, 'type' is *read only* from now on... */
- meta_pid_to_tab->common.is_thread_safe = 0;
-#endif
- meta_pid_to_tab->common.keypos = 1;
- meta_pid_to_tab->common.owner = NIL;
- erts_smp_atomic_init_nob(&meta_pid_to_tab->common.nitems, 0);
- meta_pid_to_tab->common.slot = -1;
- meta_pid_to_tab->common.meth = &db_hash;
- meta_pid_to_tab->common.compress = 0;
-
- erts_smp_refc_init(&meta_pid_to_tab->common.ref, 0);
- /* Neither rwlock or fixlock used
- db_init_lock(meta_pid_to_tab, "meta_pid_to_tab", "meta_pid_to_tab_FIX");*/
-
- if (db_create_hash(NULL, meta_pid_to_tab) != DB_ERROR_NONE) {
- erts_exit(ERTS_ERROR_EXIT,"Unable to create ets metadata tables.");
- }
-
- erts_smp_atomic_set_nob(&init_tb.common.memory_size, 0);
- meta_pid_to_fixed_tab = (DbTable*) erts_db_alloc(ERTS_ALC_T_DB_TABLE,
- &init_tb,
- sizeof(DbTable));
- erts_smp_atomic_init_nob(&meta_pid_to_fixed_tab->common.memory_size,
- erts_smp_atomic_read_nob(&init_tb.common.memory_size));
-
- meta_pid_to_fixed_tab->common.id = NIL;
- meta_pid_to_fixed_tab->common.the_name = am_true;
- meta_pid_to_fixed_tab->common.status = (DB_NORMAL | DB_BAG | DB_PUBLIC | DB_FINE_LOCKED);
-#ifdef ERTS_SMP
- meta_pid_to_fixed_tab->common.type
- = meta_pid_to_fixed_tab->common.status & ERTS_ETS_TABLE_TYPES;
- /* Note, 'type' is *read only* from now on... */
- meta_pid_to_fixed_tab->common.is_thread_safe = 0;
-#endif
- meta_pid_to_fixed_tab->common.keypos = 1;
- meta_pid_to_fixed_tab->common.owner = NIL;
- erts_smp_atomic_init_nob(&meta_pid_to_fixed_tab->common.nitems, 0);
- meta_pid_to_fixed_tab->common.slot = -1;
- meta_pid_to_fixed_tab->common.meth = &db_hash;
- meta_pid_to_fixed_tab->common.compress = 0;
-
- erts_smp_refc_init(&meta_pid_to_fixed_tab->common.ref, 0);
- /* Neither rwlock or fixlock used
- db_init_lock(meta_pid_to_fixed_tab, "meta_pid_to_fixed_tab", "meta_pid_to_fixed_tab_FIX");*/
-
- if (db_create_hash(NULL, meta_pid_to_fixed_tab) != DB_ERROR_NONE) {
- erts_exit(ERTS_ERROR_EXIT,"Unable to create ets metadata tables.");
- }
-
/* Non visual BIF to trap to. */
erts_init_trap_export(&ets_select_delete_continue_exp,
am_ets, am_atom_put("delete_trap",11), 1,
@@ -3051,81 +3352,18 @@ void init_db(ErtsDbSpinCount db_spin_count)
ms_delete_all = CONS(hp, ms_delete_all,NIL);
}
-#define ARRAY_CHUNK 100
-
-typedef enum {
- ErtsDbProcCleanupProgressTables,
- ErtsDbProcCleanupProgressFixations,
- ErtsDbProcCleanupProgressDone,
-} ErtsDbProcCleanupProgress;
-
-typedef enum {
- ErtsDbProcCleanupOpGetTables,
- ErtsDbProcCleanupOpDeleteTables,
- ErtsDbProcCleanupOpGetFixations,
- ErtsDbProcCleanupOpDeleteFixations,
- ErtsDbProcCleanupOpDone
-} ErtsDbProcCleanupOperation;
-
-typedef struct {
- ErtsDbProcCleanupProgress progress;
- ErtsDbProcCleanupOperation op;
- struct {
- Eterm arr[ARRAY_CHUNK];
- int size;
- int ix;
- int clean_ix;
- } slots;
-} ErtsDbProcCleanupState;
-
-
-static void
-proc_exit_cleanup_tables_meta_data(Eterm pid, ErtsDbProcCleanupState *state)
+void
+erts_ets_sched_spec_data_init(ErtsSchedulerData *esdp)
{
- ASSERT(state->slots.clean_ix <= state->slots.ix);
- if (state->slots.clean_ix < state->slots.ix) {
- db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC);
- if (state->slots.size < ARRAY_CHUNK
- && state->slots.ix == state->slots.size) {
- Eterm dummy;
- db_erase_hash(meta_pid_to_tab,pid,&dummy);
- }
- else {
- int ix;
- /* Need to erase each explicitly */
- for (ix = state->slots.clean_ix; ix < state->slots.ix; ix++)
- db_erase_bag_exact2(meta_pid_to_tab,
- pid,
- state->slots.arr[ix]);
- }
- db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC);
- state->slots.clean_ix = state->slots.ix;
- }
+ ErtsEtsAllYieldData *eaydp = ERTS_SCHED_AUX_YIELD_DATA(esdp, ets_all);
+ eaydp->ongoing = NULL;
+ eaydp->hfrag = NULL;
+ eaydp->tab = NULL;
+ eaydp->queue = NULL;
+ esdp->ets_tables.clist = NULL;
+ esdp->ets_tables.count = 0;
}
-static void
-proc_exit_cleanup_fixations_meta_data(Eterm pid, ErtsDbProcCleanupState *state)
-{
- ASSERT(state->slots.clean_ix <= state->slots.ix);
- if (state->slots.clean_ix < state->slots.ix) {
- db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
- if (state->slots.size < ARRAY_CHUNK
- && state->slots.ix == state->slots.size) {
- Eterm dummy;
- db_erase_hash(meta_pid_to_fixed_tab,pid,&dummy);
- }
- else {
- int ix;
- /* Need to erase each explicitly */
- for (ix = state->slots.clean_ix; ix < state->slots.ix; ix++)
- db_erase_bag_exact2(meta_pid_to_fixed_tab,
- pid,
- state->slots.arr[ix]);
- }
- db_meta_unlock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
- state->slots.clean_ix = state->slots.ix;
- }
-}
/* In: Table LCK_WRITE
** Return TRUE : ok, table not mine and NOT locked anymore.
@@ -3135,7 +3373,6 @@ static int give_away_to_heir(Process* p, DbTable* tb)
{
Process* to_proc;
ErtsProcLocks to_locks = ERTS_PROC_LOCK_MAIN;
- DeclareTmpHeap(buf,5,p);
Eterm to_pid;
UWord heir_data;
@@ -3179,19 +3416,12 @@ retry:
erts_smp_proc_unlock(to_proc, to_locks);
return 0; /* heir dead and pid reused, table still mine */
}
- UseTmpHeap(5,p);
- db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC);
- db_erase_bag_exact2(meta_pid_to_tab, tb->common.owner,
- make_small(tb->common.slot));
+ delete_owned_table(p, tb);
to_proc->flags |= F_USING_DB;
tb->common.owner = to_pid;
-
- db_put_hash(meta_pid_to_tab,
- TUPLE2(buf,to_pid,make_small(tb->common.slot)),
- 0);
- db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC);
- UnUseTmpHeap(5,p);
+ save_owned_table(to_proc, tb);
+
db_unlock(tb,LCK_WRITE);
heir_data = tb->common.heir_data;
if (!is_immed(heir_data)) {
@@ -3199,17 +3429,100 @@ retry:
ASSERT(arityval(*tpv) == 1);
heir_data = tpv[1];
}
- erts_send_message(p, to_proc, &to_locks,
- TUPLE4(buf,
- am_ETS_TRANSFER,
- tb->common.id,
- p->common.id,
- heir_data),
- 0);
+ send_ets_transfer_message(p, to_proc, &to_locks, tb, heir_data);
erts_smp_proc_unlock(to_proc, to_locks);
return !0;
}
+static void
+send_ets_transfer_message(Process *c_p, Process *proc,
+ ErtsProcLocks *locks,
+ DbTable *tb, Eterm heir_data)
+{
+ Uint hsz, hd_sz;
+ ErtsMessage *mp;
+ Eterm *hp;
+ ErlOffHeap *ohp;
+ Eterm tid, hd_copy, msg, sender;
+
+ hsz = 5;
+ if (!is_table_named(tb))
+ hsz += ERTS_MAGIC_REF_THING_SIZE;
+ if (is_immed(heir_data))
+ hd_sz = 0;
+ else {
+ hd_sz = size_object(heir_data);
+ hsz += hd_sz;
+ }
+
+ mp = erts_alloc_message_heap(proc, locks, hsz, &hp, &ohp);
+ if (is_table_named(tb))
+ tid = tb->common.the_name;
+ else
+ tid = erts_mk_magic_ref(&hp, ohp, tb->common.btid);
+ if (!hd_sz)
+ hd_copy = heir_data;
+ else
+ hd_copy = copy_struct(heir_data, hd_sz, &hp, ohp);
+ sender = c_p->common.id;
+ msg = TUPLE4(hp, am_ETS_TRANSFER, tid, sender, hd_copy);
+ erts_queue_message(proc, *locks, mp, msg, sender);
+}
+
+
+/* Auto-release fixation from exiting process */
+static SWord proc_cleanup_fixed_table(Process* p, DbFixation* fix)
+{
+ DbTable* tb = btid2tab(fix->tabs.btid);
+ SWord work = 0;
+
+ ASSERT(fix->procs.p == p); (void)p;
+ if (tb) {
+ db_lock(tb, LCK_WRITE_REC);
+ if (!(tb->common.status & DB_DELETE)) {
+ erts_aint_t diff;
+ #ifdef ERTS_SMP
+ erts_smp_mtx_lock(&tb->common.fixlock);
+ #endif
+
+ ASSERT(fixing_procs_rbt_lookup(tb->common.fixing_procs, p));
+
+ diff = -((erts_aint_t) fix->counter);
+ erts_smp_refc_add(&tb->common.fix_count,diff,0);
+ fix->counter = 0;
+
+ fixing_procs_rbt_delete(&tb->common.fixing_procs, fix);
+
+ #ifdef ERTS_SMP
+ erts_smp_mtx_unlock(&tb->common.fixlock);
+ #endif
+ if (!IS_FIXED(tb) && IS_HASH_TABLE(tb->common.status)) {
+ work += db_unfix_table_hash(&(tb->hash));
+ }
+
+ ASSERT(sizeof(DbFixation) == ERTS_ALC_DBG_BLK_SZ(fix));
+ ERTS_DB_ALC_MEM_UPDATE_(tb, sizeof(DbFixation), 0);
+ }
+ else {
+ ASSERT(fix->counter == 0);
+ }
+ db_unlock(tb, LCK_WRITE_REC);
+ }
+ else {
+ ASSERT(fix->counter == 0);
+ }
+
+ if (erts_refc_dectest(&fix->tabs.btid->refc, 0) == 0) {
+ erts_bin_free(fix->tabs.btid);
+ }
+ erts_free(ERTS_ALC_T_DB_FIXATION, fix);
+ ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
+ ++work;
+
+ return work;
+}
+
+
/*
* erts_db_process_exiting() is called when a process terminates.
* It returns 0 when completely done, and !0 when it wants to
@@ -3223,276 +3536,160 @@ retry:
int
erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks)
{
- ErtsDbProcCleanupState *state = (ErtsDbProcCleanupState *) c_p->u.terminate;
+ typedef struct {
+ enum {
+ GET_OWNED_TABLE,
+ FREE_OWNED_TABLE,
+ UNFIX_TABLES,
+ }op;
+ DbTable *tb;
+ } CleanupState;
+ CleanupState *state = (CleanupState *) c_p->u.terminate;
Eterm pid = c_p->common.id;
- ErtsDbProcCleanupState default_state;
- int ret;
+ CleanupState default_state;
+ SWord initial_reds = ERTS_BIF_REDS_LEFT(c_p);
+ SWord reds = initial_reds;
if (!state) {
state = &default_state;
- state->progress = ErtsDbProcCleanupProgressTables;
- state->op = ErtsDbProcCleanupOpGetTables;
+ state->op = GET_OWNED_TABLE;
+ state->tb = NULL;
}
- while (!0) {
+ do {
switch (state->op) {
- case ErtsDbProcCleanupOpGetTables:
- state->slots.size = ARRAY_CHUNK;
- db_meta_lock(meta_pid_to_tab, LCK_READ);
- ret = db_get_element_array(meta_pid_to_tab,
- pid,
- 2,
- state->slots.arr,
- &state->slots.size);
- db_meta_unlock(meta_pid_to_tab, LCK_READ);
- if (ret == DB_ERROR_BADKEY) {
- /* Done with tables; now fixations */
- state->progress = ErtsDbProcCleanupProgressFixations;
- state->op = ErtsDbProcCleanupOpGetFixations;
- break;
- } else if (ret != DB_ERROR_NONE) {
- ERTS_DB_INTERNAL_ERROR("Inconsistent ets table metadata");
- }
-
- state->slots.ix = 0;
- state->slots.clean_ix = 0;
- state->op = ErtsDbProcCleanupOpDeleteTables;
- /* Fall through */
-
- case ErtsDbProcCleanupOpDeleteTables:
-
- while (state->slots.ix < state->slots.size) {
- DbTable *tb = NULL;
- Sint ix = unsigned_val(state->slots.arr[state->slots.ix]);
- erts_smp_rwmtx_t *mmtl = get_meta_main_tab_lock(ix);
- erts_smp_rwmtx_rlock(mmtl);
- if (!IS_SLOT_FREE(ix)) {
- tb = GET_ANY_SLOT_TAB(ix);
- ASSERT(tb);
- }
- erts_smp_rwmtx_runlock(mmtl);
- if (tb) {
- int do_yield;
- db_lock(tb, LCK_WRITE);
- /* Ownership may have changed since
- we looked up the table. */
- if (tb->common.owner != pid) {
- do_yield = 0;
- db_unlock(tb, LCK_WRITE);
- }
- else if (tb->common.heir != am_none
- && tb->common.heir != pid
- && give_away_to_heir(c_p, tb)) {
- do_yield = 0;
- }
- else {
- int first_call;
-#ifdef HARDDEBUG
- erts_fprintf(stderr,
- "erts_db_process_exiting(); Table: %T, "
- "Process: %T\n",
- tb->common.id, pid);
-#endif
- first_call = (tb->common.status & DB_DELETE) == 0;
- if (first_call) {
- /* Clear all access bits. */
- tb->common.status &= ~(DB_PROTECTED
- | DB_PUBLIC
- | DB_PRIVATE);
- tb->common.status |= DB_DELETE;
-
- if (is_atom(tb->common.id))
- remove_named_tab(tb, 0);
-
- free_heir_data(tb);
- free_fixations_locked(tb);
- }
-
- do_yield = free_table_cont(c_p, tb, first_call, 0);
- db_unlock(tb, LCK_WRITE);
- }
- if (do_yield)
- goto yield;
- }
- state->slots.ix++;
- if (ERTS_BIF_REDS_LEFT(c_p) <= 0)
- goto yield;
- }
+ case GET_OWNED_TABLE: {
+ DbTable* tb;
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
+ tb = (DbTable*) erts_psd_get(c_p, ERTS_PSD_ETS_OWNED_TABLES);
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
+
+ if (!tb) {
+ /* Done with owned tables; now fixations */
+ state->op = UNFIX_TABLES;
+ break;
+ }
- proc_exit_cleanup_tables_meta_data(pid, state);
- state->op = ErtsDbProcCleanupOpGetTables;
- break;
+ ASSERT(tb != state->tb);
+ state->tb = tb;
+ db_lock(tb, LCK_WRITE);
+ /*
+ * Ownership may have changed since we looked up the table.
+ */
+ if (tb->common.owner != pid) {
+ db_unlock(tb, LCK_WRITE);
+ break;
+ }
+ if (tb->common.heir != am_none
+ && tb->common.heir != pid
+ && give_away_to_heir(c_p, tb)) {
+ break;
+ }
+ tid_clear(c_p, tb);
+ /* Clear all access bits. */
+ tb->common.status &= ~(DB_PROTECTED | DB_PUBLIC | DB_PRIVATE);
+ tb->common.status |= DB_DELETE;
+
+ if (is_table_named(tb))
+ remove_named_tab(tb, 0);
+
+ free_heir_data(tb);
+ reds -= free_fixations_locked(c_p, tb);
+ db_unlock(tb, LCK_WRITE);
+ state->op = FREE_OWNED_TABLE;
+ break;
+ }
+ case FREE_OWNED_TABLE:
+ reds = free_table_continue(c_p, state->tb, reds);
+ if (reds < 0)
+ goto yield;
- case ErtsDbProcCleanupOpGetFixations:
- state->slots.size = ARRAY_CHUNK;
- db_meta_lock(meta_pid_to_fixed_tab, LCK_READ);
- ret = db_get_element_array(meta_pid_to_fixed_tab,
- pid,
- 2,
- state->slots.arr,
- &state->slots.size);
- db_meta_unlock(meta_pid_to_fixed_tab, LCK_READ);
-
- if (ret == DB_ERROR_BADKEY) {
- /* Done */
- state->progress = ErtsDbProcCleanupProgressDone;
- state->op = ErtsDbProcCleanupOpDone;
- break;
- } else if (ret != DB_ERROR_NONE) {
- ERTS_DB_INTERNAL_ERROR("Inconsistent ets fix table metadata");
- }
+ state->op = GET_OWNED_TABLE;
+ break;
- state->slots.ix = 0;
- state->slots.clean_ix = 0;
- state->op = ErtsDbProcCleanupOpDeleteFixations;
- /* Fall through */
+ case UNFIX_TABLES: {
+ DbFixation* fix;
- case ErtsDbProcCleanupOpDeleteFixations:
+ fix = (DbFixation*) erts_psd_get(c_p, ERTS_PSD_ETS_FIXED_TABLES);
- while (state->slots.ix < state->slots.size) {
- DbTable *tb = NULL;
- Sint ix = unsigned_val(state->slots.arr[state->slots.ix]);
- erts_smp_rwmtx_t *mmtl = get_meta_main_tab_lock(ix);
- erts_smp_rwmtx_rlock(mmtl);
- if (IS_SLOT_ALIVE(ix)) {
- tb = meta_main_tab[ix].u.tb;
- ASSERT(tb);
- }
- erts_smp_rwmtx_runlock(mmtl);
- if (tb) {
- int reds = 0;
-
- db_lock(tb, LCK_WRITE_REC);
- if (!(tb->common.status & DB_DELETE)) {
- DbFixation** pp;
-
- #ifdef ERTS_SMP
- erts_smp_mtx_lock(&tb->common.fixlock);
- #endif
- reds = 10;
-
- for (pp = &tb->common.fixations; *pp != NULL;
- pp = &(*pp)->next) {
- if ((*pp)->pid == pid) {
- DbFixation* fix = *pp;
- erts_aint_t diff = -((erts_aint_t) fix->counter);
- erts_smp_refc_add(&tb->common.ref,diff,0);
- *pp = fix->next;
- erts_db_free(ERTS_ALC_T_DB_FIXATION,
- tb, fix, sizeof(DbFixation));
- ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
- break;
- }
- }
- #ifdef ERTS_SMP
- erts_smp_mtx_unlock(&tb->common.fixlock);
- #endif
- if (!IS_FIXED(tb) && IS_HASH_TABLE(tb->common.status)) {
- db_unfix_table_hash(&(tb->hash));
- reds += 40;
- }
- }
- db_unlock(tb, LCK_WRITE_REC);
- BUMP_REDS(c_p, reds);
- }
- state->slots.ix++;
- if (ERTS_BIF_REDS_LEFT(c_p) <= 0)
- goto yield;
- }
+ if (!fix) {
+ /* Done */
- proc_exit_cleanup_fixations_meta_data(pid, state);
- state->op = ErtsDbProcCleanupOpGetFixations;
- break;
+ if (state != &default_state)
+ erts_free(ERTS_ALC_T_DB_PROC_CLEANUP, state);
+ c_p->u.terminate = NULL;
- case ErtsDbProcCleanupOpDone:
+ BUMP_REDS(c_p, (initial_reds - reds));
+ return 0;
+ }
- if (state != &default_state)
- erts_free(ERTS_ALC_T_DB_PROC_CLEANUP, state);
- c_p->u.terminate = NULL;
- return 0;
+ fixed_tabs_delete(c_p, fix);
+ reds -= proc_cleanup_fixed_table(c_p, fix);
+ break;
+ }
default:
ERTS_DB_INTERNAL_ERROR("Bad internal state");
- }
- }
-
- yield:
+ }
- switch (state->progress) {
- case ErtsDbProcCleanupProgressTables:
- proc_exit_cleanup_tables_meta_data(pid, state);
- break;
- case ErtsDbProcCleanupProgressFixations:
- proc_exit_cleanup_fixations_meta_data(pid, state);
- break;
- default:
- break;
- }
+ } while (reds > 0);
- ASSERT(c_p->u.terminate == (void *) state
- || state == &default_state);
+ yield:
if (state == &default_state) {
c_p->u.terminate = erts_alloc(ERTS_ALC_T_DB_PROC_CLEANUP,
- sizeof(ErtsDbProcCleanupState));
- sys_memcpy(c_p->u.terminate,
- (void*) state,
- sizeof(ErtsDbProcCleanupState));
+ sizeof(CleanupState));
+ sys_memcpy(c_p->u.terminate, (void*) state, sizeof(CleanupState));
}
+ else
+ ASSERT(state == c_p->u.terminate);
return !0;
}
+
/* SMP note: table only need to be LCK_READ locked */
static void fix_table_locked(Process* p, DbTable* tb)
{
DbFixation *fix;
- DeclareTmpHeap(meta_tuple,3,p);
#ifdef ERTS_SMP
erts_smp_mtx_lock(&tb->common.fixlock);
#endif
- erts_smp_refc_inc(&tb->common.ref,1);
- fix = tb->common.fixations;
+ erts_smp_refc_inc(&tb->common.fix_count,1);
+ fix = tb->common.fixing_procs;
if (fix == NULL) {
tb->common.time.monotonic
= erts_get_monotonic_time(erts_proc_sched_data(p));
tb->common.time.offset = erts_get_time_offset();
}
else {
- for (; fix != NULL; fix = fix->next) {
- if (fix->pid == p->common.id) {
- ++(fix->counter);
+ fix = fixing_procs_rbt_lookup(fix, p);
+ if (fix) {
+ ASSERT(fixed_tabs_find(NULL, fix));
+ ++(fix->counter);
+
#ifdef ERTS_SMP
- erts_smp_mtx_unlock(&tb->common.fixlock);
+ erts_smp_mtx_unlock(&tb->common.fixlock);
#endif
- return;
- }
+ return;
}
}
fix = (DbFixation *) erts_db_alloc(ERTS_ALC_T_DB_FIXATION,
tb, sizeof(DbFixation));
ERTS_ETS_MISC_MEM_ADD(sizeof(DbFixation));
- fix->pid = p->common.id;
+ fix->tabs.btid = tb->common.btid;
+ erts_refc_inc(&fix->tabs.btid->refc, 2);
+ fix->procs.p = p;
fix->counter = 1;
- fix->next = tb->common.fixations;
- tb->common.fixations = fix;
+ fixing_procs_rbt_insert(&tb->common.fixing_procs, fix);
+
#ifdef ERTS_SMP
erts_smp_mtx_unlock(&tb->common.fixlock);
#endif
- p->flags |= F_USING_DB;
- UseTmpHeap(3,p);
- db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
- if (db_put_hash(meta_pid_to_fixed_tab,
- TUPLE2(meta_tuple,
- p->common.id,
- make_small(tb->common.slot)),
- 0) != DB_ERROR_NONE) {
- UnUseTmpHeap(3,p);
- erts_exit(ERTS_ERROR_EXIT,"Could not insert ets metadata in safe_fixtable.");
- }
- UnUseTmpHeap(3,p);
- db_meta_unlock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
+ p->flags |= F_USING_DB;
+
+ fixed_tabs_insert(p, fix);
}
/* SMP note: May re-lock table
@@ -3500,28 +3697,26 @@ static void fix_table_locked(Process* p, DbTable* tb)
static void unfix_table_locked(Process* p, DbTable* tb,
db_lock_kind_t* kind_p)
{
- DbFixation** pp;
+ DbFixation* fix;
#ifdef ERTS_SMP
erts_smp_mtx_lock(&tb->common.fixlock);
#endif
- for (pp = &tb->common.fixations; *pp != NULL; pp = &(*pp)->next) {
- if ((*pp)->pid == p->common.id) {
- DbFixation* fix = *pp;
- erts_smp_refc_dec(&tb->common.ref,0);
- --(fix->counter);
- ASSERT(fix->counter >= 0);
- if (fix->counter > 0) {
- break;
- }
- *pp = fix->next;
+ fix = fixing_procs_rbt_lookup(tb->common.fixing_procs, p);
+
+ if (fix) {
+ erts_smp_refc_dec(&tb->common.fix_count,0);
+ --(fix->counter);
+ ASSERT(fix->counter >= 0);
+ if (fix->counter == 0) {
+ fixing_procs_rbt_delete(&tb->common.fixing_procs, fix);
#ifdef ERTS_SMP
erts_smp_mtx_unlock(&tb->common.fixlock);
#endif
- db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
- db_erase_bag_exact2(meta_pid_to_fixed_tab,
- p->common.id, make_small(tb->common.slot));
- db_meta_unlock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
+ fixed_tabs_delete(p, fix);
+
+ erts_refc_dec(&fix->tabs.btid->refc, 1);
+
erts_db_free(ERTS_ALC_T_DB_FIXATION,
tb, (void *) fix, sizeof(DbFixation));
ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
@@ -3548,29 +3743,87 @@ unlocked:
}
}
-/* Assume that tb is WRITE locked */
-static void free_fixations_locked(DbTable *tb)
+struct free_fixations_ctx
{
- DbFixation *fix;
- DbFixation *next_fix;
+ Process* p;
+ DbTable* tb;
+ SWord cnt;
+};
+
+static void free_fixations_op(DbFixation* fix, void* vctx)
+{
+ struct free_fixations_ctx* ctx = (struct free_fixations_ctx*) vctx;
+ erts_aint_t diff;
+#ifdef DEBUG
+ DbTable* dbg_tb = btid2tab(fix->tabs.btid);
+#endif
- fix = tb->common.fixations;
- while (fix != NULL) {
- erts_aint_t diff = -((erts_aint_t) fix->counter);
- erts_smp_refc_add(&tb->common.ref,diff,0);
- next_fix = fix->next;
- db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
- db_erase_bag_exact2(meta_pid_to_fixed_tab,
- fix->pid,
- make_small(tb->common.slot));
- db_meta_unlock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
- erts_db_free(ERTS_ALC_T_DB_FIXATION,
- tb, (void *) fix, sizeof(DbFixation));
- ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
+ ASSERT(!dbg_tb || dbg_tb == ctx->tb);
+ ASSERT(fix->counter > 0);
+ ASSERT(ctx->tb->common.status & DB_DELETE);
- fix = next_fix;
+ diff = -((erts_aint_t) fix->counter);
+ erts_smp_refc_add(&ctx->tb->common.fix_count, diff, 0);
+
+#ifdef ERTS_SMP
+ if (fix->procs.p != ctx->p) { /* Fixated by other process */
+ fix->counter = 0;
+
+ /* Fake memory stats for table */
+ ASSERT(sizeof(DbFixation) == ERTS_ALC_DBG_BLK_SZ(fix));
+ ERTS_DB_ALC_MEM_UPDATE_(ctx->tb, sizeof(DbFixation), 0);
+
+ erts_schedule_ets_free_fixation(fix->procs.p->common.id, fix);
+ /*
+ * Either sys task is scheduled and erts_db_execute_free_fixation()
+ * will remove 'fix' or process will exit, drop sys task and
+ * proc_cleanup_fixed_table() will remove 'fix'.
+ */
+ }
+ else
+#endif
+ {
+ fixed_tabs_delete(fix->procs.p, fix);
+
+ if (erts_refc_dectest(&fix->tabs.btid->refc, 0) == 0) {
+ erts_bin_free(fix->tabs.btid);
+ }
+
+ erts_db_free(ERTS_ALC_T_DB_FIXATION,
+ ctx->tb, (void *) fix, sizeof(DbFixation));
+ ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
}
- tb->common.fixations = NULL;
+ ctx->cnt++;
+}
+
+#ifdef ERTS_SMP
+int erts_db_execute_free_fixation(Process* p, DbFixation* fix)
+{
+ ASSERT(fix->counter == 0);
+ fixed_tabs_delete(p, fix);
+
+ if (erts_refc_dectest(&fix->tabs.btid->refc, 0) == 0) {
+ erts_bin_free(fix->tabs.btid);
+ }
+ erts_free(ERTS_ALC_T_DB_FIXATION, fix);
+ ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
+ return 1;
+}
+#endif
+
+static SWord free_fixations_locked(Process* p, DbTable *tb)
+{
+ struct free_fixations_ctx ctx;
+
+ ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rwlocked(&tb->common.rwlock));
+
+ ctx.p = p;
+ ctx.tb = tb;
+ ctx.cnt = 0;
+ fixing_procs_rbt_foreach_destroy(&tb->common.fixing_procs,
+ free_fixations_op, &ctx);
+ tb->common.fixing_procs = NULL;
+ return ctx.cnt;
}
static void set_heir(Process* me, DbTable* tb, Eterm heir, UWord heir_data)
@@ -3634,55 +3887,40 @@ static void free_heir_data(DbTable* tb)
static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1)
{
- Process *p = BIF_P;
+ SWord initial_reds = ERTS_BIF_REDS_LEFT(BIF_P);
+ SWord reds = initial_reds;
Eterm cont = BIF_ARG_1;
- int trap;
Eterm* ptr = big_val(cont);
DbTable *tb = *((DbTable **) (UWord) (ptr + 1));
ASSERT(*ptr == make_pos_bignum_header(1));
- db_lock(tb, LCK_WRITE);
- trap = free_table_cont(p, tb, 0, 1);
- db_unlock(tb, LCK_WRITE);
-
- if (trap) {
- BIF_TRAP1(&ets_delete_continue_exp, p, cont);
+ if (free_table_continue(BIF_P, tb, reds) < 0) {
+ BUMP_ALL_REDS(BIF_P);
+ BIF_TRAP1(&ets_delete_continue_exp, BIF_P, cont);
}
else {
+ BUMP_REDS(BIF_P, (initial_reds - reds));
BIF_RET(am_true);
}
}
/*
- * free_table_cont() returns 0 when done and !0 when more work is needed.
+ * free_table_continue() returns reductions left
+ * done if >= 0
+ * yield if < 0
*/
-static int free_table_cont(Process *p,
- DbTable *tb,
- int first,
- int clean_meta_tab)
+static SWord free_table_continue(Process *p, DbTable *tb, SWord reds)
{
- Eterm result;
- erts_smp_rwmtx_t *mmtl;
-
-#ifdef HARDDEBUG
- if (!first) {
- erts_fprintf(stderr,"ets: free_table_cont %T (continue)\r\n",
- tb->common.id);
- }
-#endif
-
- result = tb->common.meth->db_free_table_continue(tb);
+ reds = tb->common.meth->db_free_table_continue(tb, reds);
- if (result == 0) {
+ if (reds < 0) {
#ifdef HARDDEBUG
erts_fprintf(stderr,"ets: free_table_cont %T (continue begin)\r\n",
tb->common.id);
#endif
/* More work to be done. Let other processes work and call us again. */
- BUMP_ALL_REDS(p);
- return !0;
}
else {
#ifdef HARDDEBUG
@@ -3690,27 +3928,28 @@ static int free_table_cont(Process *p,
tb->common.id);
#endif
/* Completely done - we will not get called again. */
- mmtl = get_meta_main_tab_lock(tb->common.slot);
-#ifdef ERTS_SMP
- if (erts_smp_rwmtx_tryrwlock(mmtl) == EBUSY) {
- erts_smp_rwmtx_rwunlock(&tb->common.rwlock);
- erts_smp_rwmtx_rwlock(mmtl);
- erts_smp_rwmtx_rwlock(&tb->common.rwlock);
- }
-#endif
- free_slot(tb->common.slot);
- erts_smp_rwmtx_rwunlock(mmtl);
-
- if (clean_meta_tab) {
- db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC);
- db_erase_bag_exact2(meta_pid_to_tab,tb->common.owner,
- make_small(tb->common.slot));
- db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC);
- }
- schedule_free_dbtable(tb);
- BUMP_REDS(p, 100);
- return 0;
+ delete_owned_table(p, tb);
+ table_dec_refc(tb, 0);
}
+ return reds;
+}
+
+struct fixing_procs_info_ctx
+{
+ Process* p;
+ Eterm list;
+};
+
+static void fixing_procs_info_op(DbFixation* fix, void* vctx)
+{
+ struct fixing_procs_info_ctx* ctx = (struct fixing_procs_info_ctx*) vctx;
+ Eterm* hp;
+ Eterm tpl;
+
+ hp = HAllocX(ctx->p, 5, 100);
+ tpl = TUPLE2(hp, fix->procs.p->common.id, make_small(fix->counter));
+ hp += 3;
+ ctx->list = CONS(hp, tpl, ctx->list);
}
static Eterm table_info(Process* p, DbTable* tb, Eterm What)
@@ -3759,7 +3998,7 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
} else if (What == am_node) {
ret = erts_this_dist_entry->sysname;
} else if (What == am_named_table) {
- ret = is_atom(tb->common.id) ? am_true : am_false;
+ ret = is_table_named(tb) ? am_true : am_false;
} else if (What == am_compressed) {
ret = tb->common.compress ? am_true : am_false;
}
@@ -3784,9 +4023,9 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
if (IS_FIXED(tb)) {
Uint need;
Eterm *hp;
- Eterm tpl, lst;
- DbFixation *fix;
+ Eterm time;
Sint64 mtime;
+ struct fixing_procs_info_ctx ctx;
need = 3;
if (use_monotonic) {
@@ -3799,19 +4038,15 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
mtime = 0;
need += 4;
}
- for (fix = tb->common.fixations; fix != NULL; fix = fix->next) {
- need += 5;
- }
+ ctx.p = p;
+ ctx.list = NIL;
+ fixing_procs_rbt_foreach(tb->common.fixing_procs,
+ fixing_procs_info_op,
+ &ctx);
+
hp = HAlloc(p, need);
- lst = NIL;
- for (fix = tb->common.fixations; fix != NULL; fix = fix->next) {
- tpl = TUPLE2(hp,fix->pid,make_small(fix->counter));
- hp += 3;
- lst = CONS(hp,tpl,lst);
- hp += 2;
- }
if (use_monotonic)
- tpl = (IS_SSMALL(mtime)
+ time = (IS_SSMALL(mtime)
? make_small(mtime)
: erts_sint64_to_big(mtime, &hp));
else {
@@ -3819,10 +4054,10 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
erts_make_timestamp_value(&ms, &s, &us,
tb->common.time.monotonic,
tb->common.time.offset);
- tpl = TUPLE3(hp, make_small(ms), make_small(s), make_small(us));
+ time = TUPLE3(hp, make_small(ms), make_small(s), make_small(us));
hp += 4;
}
- ret = TUPLE2(hp, tpl, lst);
+ ret = TUPLE2(hp, time, ctx.list);
} else {
ret = am_false;
}
@@ -3867,7 +4102,19 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
static void print_table(fmtfn_t to, void *to_arg, int show, DbTable* tb)
{
- erts_print(to, to_arg, "Table: %T\n", tb->common.id);
+ Eterm tid;
+ Eterm heap[ERTS_MAGIC_REF_THING_SIZE];
+
+ if (is_table_named(tb)) {
+ tid = tb->common.the_name;
+ } else {
+ ErlOffHeap oh;
+ ERTS_INIT_OFF_HEAP(&oh);
+ write_magic_ref_thing(heap, &oh, (ErtsMagicBinary *) tb->common.btid);
+ tid = make_internal_ref(heap);
+ }
+
+ erts_print(to, to_arg, "Table: %T\n", tid);
erts_print(to, to_arg, "Name: %T\n", tb->common.the_name);
tb->common.meth->db_print(to, to_arg, show, tb);
@@ -3885,21 +4132,30 @@ static void print_table(fmtfn_t to, void *to_arg, int show, DbTable* tb)
erts_print(to, to_arg, "Read Concurrency: %T\n", table_info(NULL, tb, am_read_concurrency));
}
+typedef struct {
+ fmtfn_t to;
+ void *to_arg;
+ int show;
+} ErtsPrintDbInfo;
+
+static void
+db_info_print(DbTable *tb, void *vpdbip)
+{
+ ErtsPrintDbInfo *pdbip = (ErtsPrintDbInfo *) vpdbip;
+ erts_print(pdbip->to, pdbip->to_arg, "=ets:%T\n", tb->common.owner);
+ erts_print(pdbip->to, pdbip->to_arg, "Slot: %bpu\n", (Uint) tb);
+ print_table(pdbip->to, pdbip->to_arg, pdbip->show, tb);
+}
+
void db_info(fmtfn_t to, void *to_arg, int show) /* Called by break handler */
{
- int i;
- for (i=0; i < db_max_tabs; i++)
- if (IS_SLOT_ALIVE(i)) {
- erts_print(to, to_arg, "=ets:%T\n", meta_main_tab[i].u.tb->common.owner);
- erts_print(to, to_arg, "Slot: %d\n", i);
- print_table(to, to_arg, show, meta_main_tab[i].u.tb);
- }
-#ifdef DEBUG
- erts_print(to, to_arg, "=internal_ets: Process to table index\n");
- print_table(to, to_arg, show, meta_pid_to_tab);
- erts_print(to, to_arg, "=internal_ets: Process to fixation index\n");
- print_table(to, to_arg, show, meta_pid_to_fixed_tab);
-#endif
+ ErtsPrintDbInfo pdbi;
+
+ pdbi.to = to;
+ pdbi.to_arg = to_arg;
+ pdbi.show = show;
+
+ erts_db_foreach_table(db_info_print, &pdbi);
}
Uint
@@ -3914,15 +4170,22 @@ erts_get_ets_misc_mem_size(void)
void
erts_db_foreach_table(void (*func)(DbTable *, void *), void *arg)
{
- int i, j;
- j = 0;
- for(i = 0; (i < db_max_tabs && j < meta_main_tab_cnt); i++) {
- if (IS_SLOT_ALIVE(i)) {
- j++;
- (*func)(meta_main_tab[i].u.tb, arg);
- }
+ int ix;
+
+ ASSERT(erts_smp_thr_progress_is_blocking());
+
+ for (ix = 0; ix < erts_no_schedulers; ix++) {
+ ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(ix);
+ DbTable *first = esdp->ets_tables.clist;
+ if (first) {
+ DbTable *tb = first;
+ do {
+ if (is_table_alive(tb))
+ (*func)(tb, arg);
+ tb = tb->common.all.next;
+ } while (tb != first);
+ }
}
- ASSERT(j == meta_main_tab_cnt);
}
/* SMP Note: May only be used when system is locked */
@@ -3972,53 +4235,3 @@ erts_ets_colliding_names(Process* p, Eterm name, Uint cnt)
return list;
}
-/*
- * For testing only
- * Retreive meta table size state
- */
-Eterm erts_ets_get_meta_state(Process* p)
-{
- Eterm* hp = HAlloc(p, 3);
- return TUPLE2(hp,
- erts_ets_hash_get_memstate(p, &meta_pid_to_tab->hash),
- erts_ets_hash_get_memstate(p, &meta_pid_to_fixed_tab->hash));
-}
-/*
- * For testing only
- * Restore a previously retrieved meta table size state.
- * We do this to suppress failed memory checks
- * caused by the hysteresis of meta tables grow/shrink limits.
- */
-Eterm erts_ets_restore_meta_state(Process* p, Eterm meta_state)
-{
- Eterm* tv;
- Eterm* hp;
- if (!is_tuple_arity(meta_state, 2))
- return am_badarg;
-
- tv = tuple_val(meta_state);
- hp = HAlloc(p, 3);
- return TUPLE2(hp,
- erts_ets_hash_restore_memstate(&meta_pid_to_tab->hash, tv[1]),
- erts_ets_hash_restore_memstate(&meta_pid_to_fixed_tab->hash, tv[2]));
-}
-
-#ifdef HARDDEBUG /* Here comes some debug functions */
-
-void db_check_tables(void)
-{
-#ifdef ERTS_SMP
- return;
-#else
- int i;
-
- for (i = 0; i < db_max_tabs; i++) {
- if (IS_SLOT_ALIVE(i)) {
- DbTable* tb = meta_main_tab[i].t;
- tb->common.meth->db_check_table(tb);
- }
- }
-#endif
-}
-
-#endif /* HARDDEBUG */
diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h
index 852440ff31..cbf4b9e007 100644
--- a/erts/emulator/beam/erl_db.h
+++ b/erts/emulator/beam/erl_db.h
@@ -24,8 +24,37 @@
*
*/
-#ifndef __DB_H__
-#define __DB_H__
+#ifndef ERTS_DB_SCHED_SPEC_TYPES__
+#define ERTS_DB_SCHED_SPEC_TYPES__
+
+union db_table;
+typedef union db_table DbTable;
+
+typedef struct ErtsEtsAllReq_ ErtsEtsAllReq;
+
+typedef struct {
+ ErtsEtsAllReq *next;
+ ErtsEtsAllReq *prev;
+} ErtsEtsAllReqList;
+
+typedef struct {
+ ErtsEtsAllReq *ongoing;
+ ErlHeapFragment *hfrag;
+ DbTable *tab;
+ ErtsEtsAllReq *queue;
+} ErtsEtsAllYieldData;
+
+typedef struct {
+ Uint count;
+ DbTable *clist;
+} ErtsEtsTables;
+
+#endif /* ERTS_DB_SCHED_SPEC_TYPES__ */
+
+#ifndef ERTS_ONLY_SCHED_SPEC_ETS_DATA
+
+#ifndef ERL_DB_H__
+#define ERL_DB_H__
#include "sys.h"
#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY
@@ -46,6 +75,12 @@ typedef struct {
ErtsThrPrgrLaterOp data;
} DbTableRelease;
+struct ErtsSchedulerData_;
+int erts_handle_yielded_ets_all_request(struct ErtsSchedulerData_ *esdp,
+ ErtsEtsAllYieldData *eadp);
+
+void erts_ets_sched_spec_data_init(struct ErtsSchedulerData_ *esdp);
+
/*
* So, the structure for a database table, NB this is only
* interesting in db.c.
@@ -74,6 +109,7 @@ typedef enum {
void init_db(ErtsDbSpinCount);
int erts_db_process_exiting(Process *, ErtsProcLocks);
+int erts_db_execute_free_fixation(Process*, DbFixation*);
void db_info(fmtfn_t, void *, int);
void erts_db_foreach_table(void (*)(DbTable *, void *), void *);
void erts_db_foreach_offheap(DbTable *,
@@ -90,12 +126,9 @@ extern Export ets_select_continue_exp;
extern erts_smp_atomic_t erts_ets_misc_mem_size;
Eterm erts_ets_colliding_names(Process*, Eterm name, Uint cnt);
-Eterm erts_ets_get_meta_state(Process* p);
-Eterm erts_ets_restore_meta_state(Process* p, Eterm target_state);
-
Uint erts_db_get_max_tabs(void);
-#endif
+#endif /* ERL_DB_H__ */
#if defined(ERTS_WANT_DB_INTERNAL__) && !defined(ERTS_HAVE_DB_INTERNAL__)
#define ERTS_HAVE_DB_INTERNAL__
@@ -271,3 +304,4 @@ erts_db_free_nt(ErtsAlcType_t type, void *ptr, Uint size)
#endif /* #if defined(ERTS_WANT_DB_INTERNAL__) && !defined(ERTS_HAVE_DB_INTERNAL__) */
+#endif /* !ERTS_ONLY_SCHED_SPEC_ETS_DATA */
diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c
index bb29d56aa7..18405342da 100644
--- a/erts/emulator/beam/erl_db_hash.c
+++ b/erts/emulator/beam/erl_db_hash.c
@@ -393,20 +393,20 @@ static int db_erase_object_hash(DbTable *tbl, Eterm object,Eterm *ret);
static int db_slot_hash(Process *p, DbTable *tbl,
Eterm slot_term, Eterm *ret);
-static int db_select_chunk_hash(Process *p, DbTable *tbl,
+static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Sint chunk_size,
int reverse, Eterm *ret);
-static int db_select_hash(Process *p, DbTable *tbl,
+static int db_select_hash(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, int reverse, Eterm *ret);
-static int db_select_count_hash(Process *p, DbTable *tbl,
+static int db_select_count_hash(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Eterm *ret);
-static int db_select_delete_hash(Process *p, DbTable *tbl,
+static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Eterm *ret);
static int db_select_continue_hash(Process *p, DbTable *tbl,
Eterm continuation, Eterm *ret);
-static int db_select_count_continue_hash(Process *p, DbTable *tbl,
+static int db_select_count_continue_hash(Process *p, DbTable *tbl,
Eterm continuation, Eterm *ret);
static int db_select_delete_continue_hash(Process *p, DbTable *tbl,
@@ -418,7 +418,7 @@ static void db_print_hash(fmtfn_t to,
DbTable *tbl);
static int db_free_table_hash(DbTable *tbl);
-static int db_free_table_continue_hash(DbTable *tbl);
+static SWord db_free_table_continue_hash(DbTable *tbl, SWord reds);
static void db_foreach_offheap_hash(DbTable *,
@@ -529,11 +529,6 @@ DbTableMethod db_hash =
db_free_table_continue_hash,
db_print_hash,
db_foreach_offheap_hash,
-#ifdef HARDDEBUG
- db_check_table_hash,
-#else
- NULL,
-#endif
db_lookup_dbterm_hash,
db_finalize_dbterm_hash
};
@@ -581,9 +576,10 @@ static void restore_fixdel(DbTableHash* tb, FixedDeletion* fixdel)
** Table interface routines ie what's called by the bif's
*/
-void db_unfix_table_hash(DbTableHash *tb)
+SWord db_unfix_table_hash(DbTableHash *tb)
{
FixedDeletion* fixdel;
+ SWord work = 0;
ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rwlocked(&tb->common.rwlock)
|| (erts_smp_lc_rwmtx_is_rlocked(&tb->common.rwlock)
@@ -604,7 +600,7 @@ restart:
if (!IS_FIXED(tb)) {
goto restart; /* unfixed again! */
}
- return;
+ return work;
}
if (ix < NACTIVE(tb)) {
bp = &BUCKET(tb, ix);
@@ -614,6 +610,7 @@ restart:
if (b->hvalue == INVALID_HASH) {
*bp = b->next;
free_term(tb, b);
+ work++;
b = *bp;
} else {
bp = &b->next;
@@ -629,9 +626,12 @@ restart:
(void *) fx,
sizeof(FixedDeletion));
ERTS_ETS_MISC_MEM_ADD(-sizeof(FixedDeletion));
+ work++;
}
/* ToDo: Maybe try grow/shrink the table as well */
+
+ return work;
}
int db_create_hash(Process *p, DbTable *tbl)
@@ -846,7 +846,6 @@ Lnew:
grow(tb, nitems);
}
}
- CHECK_TABLES();
return DB_ERROR_NONE;
Ldone:
@@ -871,7 +870,6 @@ get_term_list(Process *p, DbTableHash *tb, Eterm key, HashValue hval,
}
}
copy = build_term_list(p, b1, b2, sz, tb);
- CHECK_TABLES();
if (bend) {
*bend = b2;
}
@@ -903,70 +901,6 @@ done:
RUNLOCK_HASH(lck);
return DB_ERROR_NONE;
}
-
-int db_get_element_array(DbTable *tbl,
- Eterm key,
- int ndex,
- Eterm *ret,
- int *num_ret)
-{
- DbTableHash *tb = &tbl->hash;
- HashValue hval;
- int ix;
- HashDbTerm* b1;
- int num = 0;
- int retval;
- erts_smp_rwmtx_t* lck;
-
- ASSERT(!IS_FIXED(tbl)); /* no support for fixed tables here */
-
- hval = MAKE_HASH(key);
- lck = RLOCK_HASH(tb, hval);
- ix = hash_to_ix(tb, hval);
- b1 = BUCKET(tb, ix);
-
- while(b1 != 0) {
- if (has_live_key(tb,b1,key,hval)) {
- if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) {
- HashDbTerm* b;
- HashDbTerm* b2 = b1->next;
-
- while(b2 != NULL && has_live_key(tb,b2,key,hval)) {
- if (ndex > arityval(b2->dbterm.tpl[0])) {
- retval = DB_ERROR_BADITEM;
- goto done;
- }
- b2 = b2->next;
- }
-
- b = b1;
- while(b != b2) {
- if (num < *num_ret) {
- ret[num++] = b->dbterm.tpl[ndex];
- } else {
- retval = DB_ERROR_NONE;
- goto done;
- }
- b = b->next;
- }
- *num_ret = num;
- }
- else {
- ASSERT(*num_ret > 0);
- ret[0] = b1->dbterm.tpl[ndex];
- *num_ret = 1;
- }
- retval = DB_ERROR_NONE;
- goto done;
- }
- b1 = b1->next;
- }
- retval = DB_ERROR_BADKEY;
-done:
- RUNLOCK_HASH(lck);
- return retval;
-}
-
static int db_member_hash(DbTable *tbl, Eterm key, Eterm *ret)
{
@@ -1059,54 +993,6 @@ done:
}
/*
- * Very internal interface, removes elements of arity two from
- * BAG. Used for the PID meta table
- */
-int db_erase_bag_exact2(DbTable *tbl, Eterm key, Eterm value)
-{
- DbTableHash *tb = &tbl->hash;
- HashValue hval;
- int ix;
- HashDbTerm** bp;
- HashDbTerm* b;
- erts_smp_rwmtx_t* lck;
- int found = 0;
-
- hval = MAKE_HASH(key);
- lck = WLOCK_HASH(tb,hval);
- ix = hash_to_ix(tb, hval);
- bp = &BUCKET(tb, ix);
- b = *bp;
-
- ASSERT(!IS_FIXED(tb));
- ASSERT((tb->common.status & DB_BAG));
- ASSERT(!tb->common.compress);
-
- while(b != 0) {
- if (has_live_key(tb,b,key,hval)) {
- found = 1;
- if ((arityval(b->dbterm.tpl[0]) == 2) &&
- EQ(value, b->dbterm.tpl[2])) {
- *bp = b->next;
- free_term(tb, b);
- erts_smp_atomic_dec_nob(&tb->common.nitems);
- b = *bp;
- break;
- }
- } else if (found) {
- break;
- }
- bp = &b->next;
- b = b->next;
- }
- WUNLOCK_HASH(lck);
- if (found) {
- try_shrink(tb);
- }
- return DB_ERROR_NONE;
-}
-
-/*
** NB, this is for the db_erase/2 bif.
*/
int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret)
@@ -1401,14 +1287,14 @@ trap:
}
-static int db_select_hash(Process *p, DbTable *tbl,
+static int db_select_hash(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, int reverse,
Eterm *ret)
{
- return db_select_chunk_hash(p, tbl, pattern, 0, reverse, ret);
+ return db_select_chunk_hash(p, tbl, tid, pattern, 0, reverse, ret);
}
-static int db_select_chunk_hash(Process *p, DbTable *tbl,
+static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Sint chunk_size,
int reverse, /* not used */
Eterm *ret)
@@ -1556,7 +1442,7 @@ done:
mpb = erts_db_make_match_prog_ref(p,(mpi.mp),&hp);
if (mpi.all_objects)
(mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
- continuation = TUPLE6(hp, tb->common.id,make_small(slot_ix),
+ continuation = TUPLE6(hp, tid, make_small(slot_ix),
make_small(chunk_size),
mpb, rest,
make_small(rest_size));
@@ -1580,7 +1466,7 @@ trap:
(mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
hp = HAlloc(p,7+ERTS_MAGIC_REF_THING_SIZE);
mpb = erts_db_make_match_prog_ref(p,(mpi.mp),&hp);
- continuation = TUPLE6(hp, tb->common.id, make_small(slot_ix),
+ continuation = TUPLE6(hp, tid, make_small(slot_ix),
make_small(chunk_size),
mpb, match_list,
make_small(got));
@@ -1594,7 +1480,8 @@ trap:
}
static int db_select_count_hash(Process *p,
- DbTable *tbl,
+ DbTable *tbl,
+ Eterm tid,
Eterm pattern,
Eterm *ret)
{
@@ -1700,7 +1587,7 @@ trap:
hp += BIG_UINT_HEAP_SIZE;
}
mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp);
- continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix),
+ continuation = TUPLE4(hp, tid, make_small(slot_ix),
mpb,
egot);
mpi.mp = NULL; /*otherwise the return macro will destroy it */
@@ -1713,6 +1600,7 @@ trap:
static int db_select_delete_hash(Process *p,
DbTable *tbl,
+ Eterm tid,
Eterm pattern,
Eterm *ret)
{
@@ -1845,7 +1733,7 @@ trap:
hp += BIG_UINT_HEAP_SIZE;
}
mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp);
- continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix),
+ continuation = TUPLE4(hp, tid, make_small(slot_ix),
mpb,
egot);
mpi.mp = NULL; /*otherwise the return macro will destroy it */
@@ -1959,7 +1847,7 @@ trap:
egot = uint_to_big(got, hp);
hp += BIG_UINT_HEAP_SIZE;
}
- continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix),
+ continuation = TUPLE4(hp, tptr[1], make_small(slot_ix),
tptr[3],
egot);
RET_TO_BIF(bif_trap1(&ets_select_delete_continue_exp, p,
@@ -2050,7 +1938,7 @@ trap:
egot = uint_to_big(got, hp);
hp += BIG_UINT_HEAP_SIZE;
}
- continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix),
+ continuation = TUPLE4(hp, tptr[1], make_small(slot_ix),
tptr[3],
egot);
RET_TO_BIF(bif_trap1(&ets_select_count_continue_exp, p,
@@ -2197,19 +2085,17 @@ static void db_print_hash(fmtfn_t to, void *to_arg, int show, DbTable *tbl)
/* release all memory occupied by a single table */
static int db_free_table_hash(DbTable *tbl)
{
- while (!db_free_table_continue_hash(tbl))
+ while (db_free_table_continue_hash(tbl, ERTS_SWORD_MAX) < 0)
;
return 0;
}
-static int db_free_table_continue_hash(DbTable *tbl)
+static SWord db_free_table_continue_hash(DbTable *tbl, SWord reds)
{
DbTableHash *tb = &tbl->hash;
- int done;
FixedDeletion* fixdel = (FixedDeletion*) erts_smp_atomic_read_acqb(&tb->fixdel);
- ERTS_SMP_LC_ASSERT(IS_TAB_WLOCKED(tb));
+ ERTS_SMP_LC_ASSERT(IS_TAB_WLOCKED(tb) || (tb->common.status & DB_DELETE));
- done = 0;
while (fixdel != NULL) {
FixedDeletion *fx = fixdel;
@@ -2219,22 +2105,21 @@ static int db_free_table_continue_hash(DbTable *tbl)
(void *) fx,
sizeof(FixedDeletion));
ERTS_ETS_MISC_MEM_ADD(-sizeof(FixedDeletion));
- if (++done >= 2*DELETE_RECORD_LIMIT) {
+ if (--reds < 0) {
erts_smp_atomic_set_relb(&tb->fixdel, (erts_aint_t)fixdel);
- return 0; /* Not done */
+ return reds; /* Not done */
}
}
erts_smp_atomic_set_relb(&tb->fixdel, (erts_aint_t)NULL);
- done /= 2;
while(tb->nslots != 0) {
- done += 1 + EXT_SEGSZ/64 + free_seg(tb, 1);
+ reds -= EXT_SEGSZ/64 + free_seg(tb, 1);
/*
* If we have done enough work, get out here.
*/
- if (done >= DELETE_RECORD_LIMIT) {
- return 0; /* Not done */
+ if (reds < 0) {
+ return reds; /* Not done */
}
}
#ifdef ERTS_SMP
@@ -2249,7 +2134,7 @@ static int db_free_table_continue_hash(DbTable *tbl)
}
#endif
ASSERT(erts_smp_atomic_read_nob(&tb->common.memory_size) == sizeof(DbTable));
- return 1; /* Done */
+ return reds; /* Done */
}
@@ -3007,63 +2892,4 @@ Eterm erts_ets_hash_sizeof_ext_segtab(void)
{
return make_small(((SIZEOF_EXT_SEGTAB(0)-1) / sizeof(UWord)) + 1);
}
-/* For testing only */
-Eterm erts_ets_hash_get_memstate(Process* p, DbTableHash* tb)
-{
- Eterm seg_cnt;
- while (!begin_resizing(tb))
- /*spinn*/;
-
- seg_cnt = make_small(SLOT_IX_TO_SEG_IX(tb->nslots));
- done_resizing(tb);
- return seg_cnt;
-}
-/* For testing only */
-Eterm erts_ets_hash_restore_memstate(DbTableHash* tb, Eterm memstate)
-{
- int seg_cnt, target;
-
- if (!is_small(memstate))
- return make_small(__LINE__);
-
- target = signed_val(memstate);
- if (target < 1)
- return make_small(__LINE__);
- while (1) {
- while (!begin_resizing(tb))
- /*spin*/;
- seg_cnt = SLOT_IX_TO_SEG_IX(tb->nslots);
- done_resizing(tb);
-
- if (target == seg_cnt)
- return am_ok;
- if (IS_FIXED(tb))
- return make_small(__LINE__);
- if (target < seg_cnt)
- shrink(tb, 0);
- else
- grow(tb, INT_MAX);
- }
-}
-#ifdef HARDDEBUG
-
-void db_check_table_hash(DbTable *tbl)
-{
- DbTableHash *tb = &tbl->hash;
- HashDbTerm* list;
- int j;
-
- for (j = 0; j < NACTIVE(tb); j++) {
- if ((list = BUCKET(tb,j)) != 0) {
- while (list != 0) {
- if (!is_tuple(make_tuple(list->dbterm.tpl))) {
- erts_exit(ERTS_ERROR_EXIT, "Bad term in slot %d of ets table", j);
- }
- list = list->next;
- }
- }
- }
-}
-
-#endif
diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h
index 6d25c73549..c340c72311 100644
--- a/erts/emulator/beam/erl_db_hash.h
+++ b/erts/emulator/beam/erl_db_hash.h
@@ -75,7 +75,7 @@ typedef struct db_table_hash {
** table types. The process is always an [in out] parameter.
*/
void db_initialize_hash(void);
-void db_unfix_table_hash(DbTableHash *tb /* [in out] */);
+SWord db_unfix_table_hash(DbTableHash *tb);
Uint db_kept_items_hash(DbTableHash *tb);
/* Interface for meta pid table */
@@ -88,14 +88,6 @@ int db_get_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret);
int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret);
-int db_get_element_array(DbTable *tbl,
- Eterm key,
- int ndex,
- Eterm *ret,
- int *num_ret);
-
-int db_erase_bag_exact2(DbTable *tbl, Eterm key, Eterm value);
-
/* not yet in method table */
int db_mark_all_deleted_hash(DbTable *tbl);
@@ -110,7 +102,5 @@ typedef struct {
void db_calc_stats_hash(DbTableHash* tb, DbHashStats*);
Eterm erts_ets_hash_sizeof_ext_segtab(void);
-Eterm erts_ets_hash_get_memstate(Process*, DbTableHash* tb);
-Eterm erts_ets_hash_restore_memstate(DbTableHash* tb, Eterm memstate);
#endif /* _DB_HASH_H */
diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c
index c4ecd2ba37..14a7451267 100644
--- a/erts/emulator/beam/erl_db_tree.c
+++ b/erts/emulator/beam/erl_db_tree.c
@@ -180,7 +180,6 @@ static ERTS_INLINE TreeDbTerm* replace_dbterm(DbTableTree *tb, TreeDbTerm* old,
static TreeDbTerm *traverse_until(TreeDbTerm *t, int *current, int to);
static void check_slot_pos(DbTableTree *tb);
static void check_saved_stack(DbTableTree *tb);
-static int check_table_tree(DbTableTree* tb, TreeDbTerm *t);
#define TREE_DEBUG
#endif
@@ -283,7 +282,7 @@ struct select_delete_context {
static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key);
static TreeDbTerm *linkout_object_tree(DbTableTree *tb,
Eterm object);
-static int do_free_tree_cont(DbTableTree *tb, int num_left);
+static SWord do_free_tree_continue(DbTableTree *tb, SWord reds);
static void free_term(DbTableTree *tb, TreeDbTerm* p);
static int balance_left(TreeDbTerm **this);
static int balance_right(TreeDbTerm **this);
@@ -369,18 +368,18 @@ static int db_erase_tree(DbTable *tbl, Eterm key, Eterm *ret);
static int db_erase_object_tree(DbTable *tbl, Eterm object,Eterm *ret);
static int db_slot_tree(Process *p, DbTable *tbl,
Eterm slot_term, Eterm *ret);
-static int db_select_tree(Process *p, DbTable *tbl,
+static int db_select_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, int reversed, Eterm *ret);
-static int db_select_count_tree(Process *p, DbTable *tbl,
+static int db_select_count_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Eterm *ret);
-static int db_select_chunk_tree(Process *p, DbTable *tbl,
+static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Sint chunk_size,
int reversed, Eterm *ret);
static int db_select_continue_tree(Process *p, DbTable *tbl,
Eterm continuation, Eterm *ret);
static int db_select_count_continue_tree(Process *p, DbTable *tbl,
Eterm continuation, Eterm *ret);
-static int db_select_delete_tree(Process *p, DbTable *tbl,
+static int db_select_delete_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Eterm *ret);
static int db_select_delete_continue_tree(Process *p, DbTable *tbl,
Eterm continuation, Eterm *ret);
@@ -389,7 +388,7 @@ static void db_print_tree(fmtfn_t to, void *to_arg,
int show, DbTable *tbl);
static int db_free_table_tree(DbTable *tbl);
-static int db_free_table_continue_tree(DbTable *tbl);
+static SWord db_free_table_continue_tree(DbTable *tbl, SWord);
static void db_foreach_offheap_tree(DbTable *,
void (*)(ErlOffHeap *, void *),
@@ -442,11 +441,6 @@ DbTableMethod db_tree =
db_free_table_continue_tree,
db_print_tree,
db_foreach_offheap_tree,
-#ifdef HARDDEBUG
- db_check_table_tree,
-#else
- NULL,
-#endif
db_lookup_dbterm_tree,
db_finalize_dbterm_tree
@@ -1058,7 +1052,7 @@ static int db_select_continue_tree(Process *p,
}
-static int db_select_tree(Process *p, DbTable *tbl,
+static int db_select_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, int reverse, Eterm *ret)
{
/* Strategy: Traverse backwards to build resulting list from tail to head */
@@ -1151,7 +1145,7 @@ static int db_select_tree(Process *p, DbTable *tbl,
continuation = TUPLE8
(hp,
- tb->common.id,
+ tid,
key,
sc.end_condition, /* From the match program, needn't be copied */
make_small(0), /* Chunk size of zero means not chunked to the
@@ -1263,7 +1257,7 @@ static int db_select_count_continue_tree(Process *p,
}
-static int db_select_count_tree(Process *p, DbTable *tbl,
+static int db_select_count_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Eterm *ret)
{
DbTableTree *tb = &tbl->tree;
@@ -1349,7 +1343,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
continuation = TUPLE5
(hp,
- tb->common.id,
+ tid,
key,
sc.end_condition, /* From the match program, needn't be copied */
mpb,
@@ -1363,7 +1357,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
}
-static int db_select_chunk_tree(Process *p, DbTable *tbl,
+static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Sint chunk_size,
int reverse,
Eterm *ret)
@@ -1474,7 +1468,7 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
continuation = TUPLE8
(hp,
- tb->common.id,
+ tid,
key,
sc.end_condition, /* From the match program,
needn't be copied */
@@ -1499,7 +1493,7 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
mpb = erts_db_make_match_prog_ref(p,mpi.mp,&hp);
continuation = TUPLE8
(hp,
- tb->common.id,
+ tid,
key,
sc.end_condition, /* From the match program, needn't be copied */
make_small(chunk_size),
@@ -1605,7 +1599,7 @@ static int db_select_delete_continue_tree(Process *p,
#undef RET_TO_BIF
}
-static int db_select_delete_tree(Process *p, DbTable *tbl,
+static int db_select_delete_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Eterm *ret)
{
DbTableTree *tb = &tbl->tree;
@@ -1691,7 +1685,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
continuation = TUPLE5
(hp,
- tb->common.id,
+ tid,
key,
sc.end_condition, /* From the match program, needn't be copied */
mpb,
@@ -1757,23 +1751,22 @@ static void db_print_tree(fmtfn_t to, void *to_arg,
/* release all memory occupied by a single table */
static int db_free_table_tree(DbTable *tbl)
{
- while (!db_free_table_continue_tree(tbl))
+ while (db_free_table_continue_tree(tbl, ERTS_SWORD_MAX) < 0)
;
return 1;
}
-static int db_free_table_continue_tree(DbTable *tbl)
+static SWord db_free_table_continue_tree(DbTable *tbl, SWord reds)
{
DbTableTree *tb = &tbl->tree;
- int result;
if (!tb->deletion) {
tb->static_stack.pos = 0;
tb->deletion = 1;
PUSH_NODE(&tb->static_stack, tb->root);
}
- result = do_free_tree_cont(tb, DELETE_RECORD_LIMIT);
- if (result) { /* Completely done. */
+ reds = do_free_tree_continue(tb, reds);
+ if (reds >= 0) { /* Completely done. */
erts_db_free(ERTS_ALC_T_DB_STK,
(DbTable *) tb,
(void *) tb->static_stack.array,
@@ -1781,7 +1774,7 @@ static int db_free_table_continue_tree(DbTable *tbl)
ASSERT(erts_smp_atomic_read_nob(&tb->common.memory_size)
== sizeof(DbTable));
}
- return result;
+ return reds;
}
static int db_delete_all_objects_tree(Process* p, DbTable* tbl)
@@ -2064,7 +2057,7 @@ static int analyze_pattern(DbTableTree *tb, Eterm pattern,
return DB_ERROR_NONE;
}
-static int do_free_tree_cont(DbTableTree *tb, int num_left)
+static SWord do_free_tree_continue(DbTableTree *tb, SWord reds)
{
TreeDbTerm *root;
TreeDbTerm *p;
@@ -2083,15 +2076,14 @@ static int do_free_tree_cont(DbTableTree *tb, int num_left)
root = p;
} else {
free_term(tb, root);
- if (--num_left > 0) {
- break;
- } else {
- return 0; /* Done enough for now */
- }
+ if (--reds < 0) {
+ return reds; /* Done enough for now */
+ }
+ break;
}
}
}
- return 1;
+ return reds;
}
/*
@@ -3130,6 +3122,9 @@ static void do_dump_tree2(DbTableTree* tb, int to, void *to_arg, int show,
#ifdef HARDDEBUG
+/*
+ * No called, but kept as it might come to use
+ */
void db_check_table_tree(DbTable *tbl)
{
DbTableTree *tb = &tbl->tree;
diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h
index 471fefe3cb..72298842d7 100644
--- a/erts/emulator/beam/erl_db_util.h
+++ b/erts/emulator/beam/erl_db_util.h
@@ -75,9 +75,6 @@ typedef struct db_term {
*/
} DbTerm;
-union db_table;
-typedef union db_table DbTable;
-
#define DB_MUST_RESIZE 1
#define DB_NEW_OBJECT 2
#define DB_INC_TRY_GROW 4
@@ -138,30 +135,34 @@ typedef struct db_table_method
Eterm slot,
Eterm* ret);
int (*db_select_chunk)(Process* p,
- DbTable* tb, /* [in out] */
+ DbTable* tb, /* [in out] */
+ Eterm tid,
Eterm pattern,
Sint chunk_size,
int reverse,
Eterm* ret);
int (*db_select)(Process* p,
- DbTable* tb, /* [in out] */
+ DbTable* tb, /* [in out] */
+ Eterm tid,
Eterm pattern,
int reverse,
Eterm* ret);
int (*db_select_delete)(Process* p,
- DbTable* tb, /* [in out] */
+ DbTable* tb, /* [in out] */
+ Eterm tid,
Eterm pattern,
Eterm* ret);
int (*db_select_continue)(Process* p,
- DbTable* tb, /* [in out] */
+ DbTable* tb, /* [in out] */
Eterm continuation,
Eterm* ret);
int (*db_select_delete_continue)(Process* p,
- DbTable* tb, /* [in out] */
+ DbTable* tb, /* [in out] */
Eterm continuation,
Eterm* ret);
int (*db_select_count)(Process* p,
- DbTable* tb, /* [in out] */
+ DbTable* tb, /* [in out] */
+ Eterm tid,
Eterm pattern,
Eterm* ret);
int (*db_select_count_continue)(Process* p,
@@ -174,7 +175,7 @@ typedef struct db_table_method
DbTable* db /* [in out] */ );
int (*db_free_table)(DbTable* db /* [in out] */ );
- int (*db_free_table_continue)(DbTable* db); /* [in out] */
+ SWord (*db_free_table_continue)(DbTable* db, SWord reds);
void (*db_print)(fmtfn_t to,
void* to_arg,
@@ -184,7 +185,6 @@ typedef struct db_table_method
void (*db_foreach_offheap)(DbTable* db, /* [in out] */
void (*func)(ErlOffHeap *, void *),
void *arg);
- void (*db_check_table)(DbTable* tb);
/* Lookup a dbterm for updating. Return false if not found. */
int (*db_lookup_dbterm)(Process *, DbTable *, Eterm key, Eterm obj,
@@ -198,11 +198,27 @@ typedef struct db_table_method
} DbTableMethod;
typedef struct db_fixation {
- Eterm pid;
+ /* Node in fixed_tabs list */
+ struct {
+ struct db_fixation *next, *prev;
+ Binary* btid;
+ } tabs;
+
+ /* Node in fixing_procs tree */
+ struct {
+ struct db_fixation *left, *right, *parent;
+ int is_red;
+ Process* p;
+ } procs;
+
Uint counter;
- struct db_fixation *next;
} DbFixation;
+typedef struct {
+ DbTable *next;
+ DbTable *prev;
+} DbTableList;
+
/*
* This structure contains data for all different types of database
* tables. Note that these fields must match the same fields
@@ -212,10 +228,13 @@ typedef struct db_fixation {
*/
typedef struct db_table_common {
- erts_smp_refc_t ref; /* fixation counter */
+ erts_smp_refc_t refc; /* reference count of table struct */
+ erts_smp_refc_t fix_count;/* fixation counter */
+ DbTableList all;
+ DbTableList owned;
#ifdef ERTS_SMP
erts_smp_rwmtx_t rwlock; /* rw lock on table */
- erts_smp_mtx_t fixlock; /* Protects fixations,megasec,sec,microsec */
+ erts_smp_mtx_t fixlock; /* Protects fixing_procs and time */
int is_thread_safe; /* No fine locking inside table needed */
Uint32 type; /* table type, *read only* after creation */
#endif
@@ -224,7 +243,7 @@ typedef struct db_table_common {
UWord heir_data; /* To send in ETS-TRANSFER (is_immed or (DbTerm*) */
Uint64 heir_started_interval; /* To further identify the heir */
Eterm the_name; /* an atom */
- Eterm id; /* atom | integer */
+ Binary *btid;
DbTableMethod* meth; /* table methods */
erts_smp_atomic_t nitems; /* Total number of items in table */
erts_smp_atomic_t memory_size;/* Total memory size. NOTE: in bytes! */
@@ -232,36 +251,35 @@ typedef struct db_table_common {
ErtsMonotonicTime monotonic;
ErtsMonotonicTime offset;
} time;
- DbFixation* fixations; /* List of processes who have done safe_fixtable,
+ DbFixation* fixing_procs; /* Tree of processes who have done safe_fixtable,
"local" fixations not included. */
/* All 32-bit fields */
Uint32 status; /* bit masks defined below */
- int slot; /* slot index in meta_main_tab */
int keypos; /* defaults to 1 */
int compress;
} DbTableCommon;
/* These are status bit patterns */
-#define DB_NORMAL (1 << 0)
-#define DB_PRIVATE (1 << 1)
-#define DB_PROTECTED (1 << 2)
-#define DB_PUBLIC (1 << 3)
-#define DB_BAG (1 << 4)
-#define DB_SET (1 << 5)
-/*#define DB_LHASH (1 << 6)*/
-#define DB_FINE_LOCKED (1 << 7) /* fine grained locking enabled */
-#define DB_DUPLICATE_BAG (1 << 8)
-#define DB_ORDERED_SET (1 << 9)
-#define DB_DELETE (1 << 10) /* table is being deleted */
-#define DB_FREQ_READ (1 << 11)
-
-#define ERTS_ETS_TABLE_TYPES (DB_BAG|DB_SET|DB_DUPLICATE_BAG|DB_ORDERED_SET|DB_FINE_LOCKED|DB_FREQ_READ)
+#define DB_PRIVATE (1 << 0)
+#define DB_PROTECTED (1 << 1)
+#define DB_PUBLIC (1 << 2)
+#define DB_DELETE (1 << 3) /* table is being deleted */
+#define DB_SET (1 << 4)
+#define DB_BAG (1 << 5)
+#define DB_DUPLICATE_BAG (1 << 6)
+#define DB_ORDERED_SET (1 << 7)
+#define DB_FINE_LOCKED (1 << 8) /* write_concurrency */
+#define DB_FREQ_READ (1 << 9) /* read_concurrency */
+#define DB_NAMED_TABLE (1 << 10)
+
+#define ERTS_ETS_TABLE_TYPES (DB_BAG|DB_SET|DB_DUPLICATE_BAG|DB_ORDERED_SET\
+ |DB_FINE_LOCKED|DB_FREQ_READ|DB_NAMED_TABLE)
#define IS_HASH_TABLE(Status) (!!((Status) & \
(DB_BAG | DB_SET | DB_DUPLICATE_BAG)))
#define IS_TREE_TABLE(Status) (!!((Status) & \
DB_ORDERED_SET))
-#define NFIXED(T) (erts_smp_refc_read(&(T)->common.ref,0))
+#define NFIXED(T) (erts_smp_refc_read(&(T)->common.fix_count,0))
#define IS_FIXED(T) (NFIXED(T) != 0)
/*
@@ -506,14 +524,5 @@ erts_db_get_match_prog_binary(Eterm term)
#define Binary2MatchProg(BP) \
(ASSERT(IsMatchProgBinary((BP))), \
((MatchProg *) ERTS_MAGIC_BIN_DATA((BP))))
-/*
-** Debugging
-*/
-#ifdef HARDDEBUG
-void db_check_tables(void); /* in db.c */
-#define CHECK_TABLES() db_check_tables()
-#else
-#define CHECK_TABLES()
-#endif
#endif /* _DB_UTIL_H */
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index b2c307e826..61477af316 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -2307,6 +2307,7 @@ erl_start(int argc, char **argv)
#endif
set_main_stack_size();
erts_sched_init_time_sup(esdp);
+ erts_ets_sched_spec_data_init(esdp);
process_main(esdp->x_reg_array, esdp->f_reg_array);
}
#endif
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index 6ff9aea5ab..da73469516 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -100,14 +100,12 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "dist_entry_links", "address" },
{ "code_write_permission", NULL },
{ "purge_state", NULL },
+ { "meta_name_tab", "address" },
+ { "db_tab", "address" },
{ "proc_status", "pid" },
{ "proc_trace", "pid" },
{ "ports_snapshot", NULL },
- { "meta_name_tab", "address" },
- { "meta_main_tab_slot", "address" },
- { "db_tab", "address" },
{ "db_tab_fix", "address" },
- { "meta_main_tab_main", NULL },
{ "db_hash_slot", "address" },
{ "node_table", NULL },
{ "dist_table", NULL },
diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c
index e2072fe30f..89b627aaf5 100644
--- a/erts/emulator/beam/erl_node_tables.c
+++ b/erts/emulator/beam/erl_node_tables.c
@@ -850,14 +850,15 @@ static Eterm AM_timer;
static Eterm AM_delayed_delete_timer;
static void setup_reference_table(void);
-static Eterm reference_table_term(Uint **hpp, Uint *szp);
+static Eterm reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp);
static void delete_reference_table(void);
-#if BIG_UINT_HEAP_SIZE > 3 /* 2-tuple */
-#define ID_HEAP_SIZE BIG_UINT_HEAP_SIZE
-#else
-#define ID_HEAP_SIZE 3 /* 2-tuple */
-#endif
+#undef ERTS_MAX__
+#define ERTS_MAX__(A, B) ((A) > (B) ? (A) : (B))
+
+#define ID_HEAP_SIZE \
+ ERTS_MAX__(ERTS_MAGIC_REF_THING_SIZE, \
+ ERTS_MAX__(BIG_UINT_HEAP_SIZE, 3))
typedef struct node_referrer_ {
struct node_referrer_ *next;
@@ -870,6 +871,7 @@ typedef struct node_referrer_ {
int system_ref;
Eterm id;
Uint id_heap[ID_HEAP_SIZE];
+ ErlOffHeap off_heap;
} NodeReferrer;
typedef struct {
@@ -942,7 +944,7 @@ erts_get_node_and_dist_references(struct process *proc)
/* Get term size */
size = 0;
- (void) reference_table_term(NULL, &size);
+ (void) reference_table_term(NULL, NULL, &size);
hp = HAlloc(proc, size);
#ifdef DEBUG
@@ -951,7 +953,7 @@ erts_get_node_and_dist_references(struct process *proc)
#endif
/* Write term */
- res = reference_table_term(&hp, NULL);
+ res = reference_table_term(&hp, &proc->off_heap, NULL);
ASSERT(endp == hp);
@@ -1048,13 +1050,14 @@ insert_node_referrer(ReferredNode *referred_node, int type, Eterm id)
nrp = (NodeReferrer *) erts_alloc(ERTS_ALC_T_NC_TMP,
sizeof(NodeReferrer));
nrp->next = referred_node->referrers;
+ ERTS_INIT_OFF_HEAP(&nrp->off_heap);
referred_node->referrers = nrp;
if(IS_CONST(id))
nrp->id = id;
else {
Uint *hp = &nrp->id_heap[0];
- ASSERT(is_big(id) || is_tuple(id));
- nrp->id = copy_struct(id, size_object(id), &hp, NULL);
+ ASSERT(is_big(id) || is_tuple(id) || is_internal_magic_ref(id));
+ nrp->id = copy_struct(id, size_object(id), &hp, &nrp->off_heap);
}
nrp->heap_ref = 0;
nrp->link_ref = 0;
@@ -1211,10 +1214,20 @@ insert_links2(ErtsLink *lnk, Eterm id)
static void
insert_ets_table(DbTable *tab, void *unused)
{
+ ErlOffHeap off_heap;
+ Eterm heap[ERTS_MAGIC_REF_THING_SIZE];
struct insert_offheap2_arg a;
a.type = ETS_REF;
- a.id = tab->common.id;
+ if (tab->common.status & DB_NAMED_TABLE)
+ a.id = tab->common.the_name;
+ else {
+ Eterm *hp = &heap[0];
+ ERTS_INIT_OFF_HEAP(&off_heap);
+ a.id = erts_mk_magic_ref(&hp, &off_heap, tab->common.btid);
+ }
erts_db_foreach_offheap(tab, insert_offheap2, (void *) &a);
+ if (is_not_atom(a.id))
+ erts_cleanup_offheap(&off_heap);
}
static void
@@ -1518,7 +1531,7 @@ setup_reference_table(void)
*/
static Eterm
-reference_table_term(Uint **hpp, Uint *szp)
+reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp)
{
#undef MK_2TUP
#undef MK_3TUP
@@ -1573,12 +1586,11 @@ reference_table_term(Uint **hpp, Uint *szp)
nrid = nrp->id;
if (!IS_CONST(nrp->id)) {
-
Uint nrid_sz = size_object(nrp->id);
if (szp)
*szp += nrid_sz;
if (hpp)
- nrid = copy_struct(nrp->id, nrid_sz, hpp, NULL);
+ nrid = copy_struct(nrp->id, nrid_sz, hpp, ohp);
}
if (is_internal_pid(nrid) || nrid == am_error_logger) {
@@ -1713,6 +1725,7 @@ delete_reference_table(void)
NodeReferrer *tnrp;
nrp = referred_nodes[i].referrers;
while(nrp) {
+ erts_cleanup_offheap(&nrp->off_heap);
tnrp = nrp;
nrp = nrp->next;
erts_free(ERTS_ALC_T_NC_TMP, (void *) tnrp);
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 52d9f9ddf7..88fae30845 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -449,7 +449,8 @@ typedef enum {
ERTS_PSTT_CPC, /* Check Process Code */
ERTS_PSTT_CLA, /* Copy Literal Area */
ERTS_PSTT_COHMQ, /* Change off heap message queue */
- ERTS_PSTT_FTMQ /* Flush trace msg queue */
+ ERTS_PSTT_FTMQ, /* Flush trace msg queue */
+ ERTS_PSTT_ETS_FREE_FIXATION
} ErtsProcSysTaskType;
#define ERTS_MAX_PROC_SYS_TASK_ARGS 2
@@ -602,6 +603,7 @@ dbg_chk_aux_work_val(erts_aint32_t value)
valid |= ERTS_SSI_AUX_WORK_REAP_PORTS;
#endif
valid |= ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED;
+ valid |= ERTS_SSI_AUX_WORK_YIELD;
if (~valid & value)
erts_exit(ERTS_ABORT_EXIT,
@@ -690,6 +692,8 @@ erts_pre_init_process(void)
= "SET_TMO";
erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX]
= "MSEG_CACHE_CHECK";
+ erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_YIELD_IX]
+ = "YIELD";
erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_REAP_PORTS_IX]
= "REAP_PORTS";
erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED_IX]
@@ -726,6 +730,16 @@ erts_pre_init_process(void)
= ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS;
erts_psd_required_locks[ERTS_PSD_NIF_TRAP_EXPORT].set_locks
= ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS;
+
+ erts_psd_required_locks[ERTS_PSD_ETS_OWNED_TABLES].get_locks
+ = ERTS_PSD_ETS_OWNED_TABLES_GET_LOCKS;
+ erts_psd_required_locks[ERTS_PSD_ETS_OWNED_TABLES].set_locks
+ = ERTS_PSD_ETS_OWNED_TABLES_SET_LOCKS;
+
+ erts_psd_required_locks[ERTS_PSD_ETS_FIXED_TABLES].get_locks
+ = ERTS_PSD_ETS_FIXED_TABLES_GET_LOCKS;
+ erts_psd_required_locks[ERTS_PSD_ETS_FIXED_TABLES].set_locks
+ = ERTS_PSD_ETS_FIXED_TABLES_SET_LOCKS;
#endif
}
@@ -2557,6 +2571,48 @@ handle_reap_ports(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
return aux_work & ~ERTS_SSI_AUX_WORK_REAP_PORTS;
}
+void
+erts_notify_new_aux_yield_work(ErtsSchedulerData *esdp)
+{
+ ASSERT(esdp == erts_get_scheduler_data());
+ /* Always called by the scheduler itself... */
+ set_aux_work_flags_wakeup_nob(esdp->ssi, ERTS_SSI_AUX_WORK_YIELD);
+}
+
+static ERTS_INLINE erts_aint32_t
+handle_yield(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
+{
+ int yield = 0;
+ /*
+ * Yield operations are always requested by the scheduler itself.
+ *
+ * The following handlers should *not* set the ERTS_SSI_AUX_WORK_YIELD
+ * flag in order to indicate more work. They should instead return
+ * information so this "main handler" can manipulate the flag...
+ *
+ * The following handlers should be able to handle being called
+ * even though no work is to be done...
+ */
+
+ /* Various yielding operations... */
+
+ yield |= erts_handle_yielded_ets_all_request(awdp->esdp,
+ &awdp->yield.ets_all);
+
+ /*
+ * Other yielding operations...
+ *
+ */
+
+ if (!yield) {
+ unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_YIELD);
+ return aux_work & ~ERTS_SSI_AUX_WORK_YIELD;
+ }
+
+ return aux_work;
+}
+
+
#if HAVE_ERTS_MSEG
static ERTS_INLINE erts_aint32_t
@@ -2697,6 +2753,9 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting)
handle_mseg_cache_check);
#endif
+ HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_YIELD,
+ handle_yield);
+
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_REAP_PORTS,
handle_reap_ports);
@@ -8727,6 +8786,8 @@ sched_thread_func(void *vesdp)
ERTS_VERIFY_UNUSED_TEMP_ALLOC(NULL);
#endif
+ erts_ets_sched_spec_data_init(esdp);
+
process_main(esdp->x_reg_array, esdp->f_reg_array);
/* No schedulers should *ever* terminate */
@@ -11148,6 +11209,12 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
st_res = am_true;
break;
#endif
+#ifdef ERTS_SMP
+ case ERTS_PSTT_ETS_FREE_FIXATION:
+ reds -= erts_db_execute_free_fixation(c_p, (DbFixation*)st->arg[0]);
+ st_res = am_true;
+ break;
+#endif
default:
ERTS_INTERNAL_ERROR("Invalid process sys task type");
st_res = am_false;
@@ -11199,7 +11266,8 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds)
case ERTS_PSTT_GC_MAJOR:
case ERTS_PSTT_GC_MINOR:
case ERTS_PSTT_CPC:
- case ERTS_PSTT_COHMQ:
+ case ERTS_PSTT_COHMQ:
+ case ERTS_PSTT_ETS_FREE_FIXATION:
st_res = am_false;
break;
case ERTS_PSTT_CLA:
@@ -11553,13 +11621,12 @@ erts_internal_request_system_task_4(BIF_ALIST_4)
}
static void
-erts_schedule_generic_sys_task(Eterm pid, ErtsProcSysTaskType type)
+erts_schedule_generic_sys_task(Eterm pid, ErtsProcSysTaskType type, void* arg)
{
Process *rp = erts_proc_lookup(pid);
if (rp) {
ErtsProcSysTask *st;
erts_aint32_t state, fail_state;
- int i;
st = erts_alloc(ERTS_ALC_T_PROC_SYS_TSK,
ERTS_PROC_SYS_TASK_SIZE(0));
@@ -11568,8 +11635,7 @@ erts_schedule_generic_sys_task(Eterm pid, ErtsProcSysTaskType type)
st->reply_tag = NIL;
st->req_id = NIL;
st->req_id_sz = 0;
- for (i = 0; i < ERTS_MAX_PROC_SYS_TASK_ARGS; i++)
- st->arg[i] = NIL;
+ st->arg[0] = (Eterm)arg;
ERTS_INIT_OFF_HEAP(&st->off_heap);
state = erts_smp_atomic32_read_nob(&rp->state);
@@ -11585,7 +11651,13 @@ erts_schedule_generic_sys_task(Eterm pid, ErtsProcSysTaskType type)
void
erts_schedule_complete_off_heap_message_queue_change(Eterm pid)
{
- erts_schedule_generic_sys_task(pid, ERTS_PSTT_COHMQ);
+ erts_schedule_generic_sys_task(pid, ERTS_PSTT_COHMQ, NULL);
+}
+
+void
+erts_schedule_ets_free_fixation(Eterm pid, DbFixation* fix)
+{
+ erts_schedule_generic_sys_task(pid, ERTS_PSTT_ETS_FREE_FIXATION, fix);
}
#ifdef ERTS_DIRTY_SCHEDULERS
@@ -11633,7 +11705,7 @@ erts_schedule_flush_trace_messages(Process *proc, int force_on_proc)
dhndl = erts_thr_progress_unmanaged_delay();
#endif
- erts_schedule_generic_sys_task(pid, ERTS_PSTT_FTMQ);
+ erts_schedule_generic_sys_task(pid, ERTS_PSTT_FTMQ, NULL);
#ifdef ERTS_SMP
erts_thr_progress_unmanaged_continue(dhndl);
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 8bf372dad5..baf830615d 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -63,6 +63,9 @@ typedef struct process Process;
#define ERTS_ONLY_INCLUDE_TRACE_FLAGS
#include "erl_trace.h"
#undef ERTS_ONLY_INCLUDE_TRACE_FLAGS
+#define ERTS_ONLY_SCHED_SPEC_ETS_DATA
+#include "erl_db.h"
+#undef ERTS_ONLY_SCHED_SPEC_ETS_DATA
#ifdef HIPE
#include "hipe_process.h"
@@ -312,6 +315,7 @@ typedef enum {
ERTS_SSI_AUX_WORK_PENDING_EXITERS_IX,
ERTS_SSI_AUX_WORK_SET_TMO_IX,
ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX,
+ ERTS_SSI_AUX_WORK_YIELD_IX,
ERTS_SSI_AUX_WORK_REAP_PORTS_IX,
ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED_IX, /* SHOULD be last flag index */
@@ -348,6 +352,8 @@ typedef enum {
(((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_SET_TMO_IX)
#define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK \
(((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX)
+#define ERTS_SSI_AUX_WORK_YIELD \
+ (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_YIELD_IX)
#define ERTS_SSI_AUX_WORK_REAP_PORTS \
(((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_REAP_PORTS_IX)
#define ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED \
@@ -613,6 +619,10 @@ typedef struct {
} delayed_wakeup;
#endif
struct {
+ ErtsEtsAllYieldData ets_all;
+ /* Other yielding operations... */
+ } yield;
+ struct {
struct {
erts_aint32_t flags;
void (*callback)(void *);
@@ -621,6 +631,10 @@ typedef struct {
} debug;
} ErtsAuxWorkData;
+#define ERTS_SCHED_AUX_YIELD_DATA(ESDP, NAME) \
+ (&(ESDP)->aux_work_data.yield.NAME)
+void erts_notify_new_aux_yield_work(ErtsSchedulerData *esdp);
+
#ifdef ERTS_DIRTY_SCHEDULERS
typedef enum {
ERTS_DIRTY_CPU_SCHEDULER,
@@ -688,7 +702,7 @@ struct ErtsSchedulerData_ {
ErtsSchedWallTime sched_wall_time;
ErtsGCInfo gc_info;
ErtsPortTaskHandle nosuspend_port_task_handle;
-
+ ErtsEtsTables ets_tables;
#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC
erts_alloc_verify_func_t verify_unused_temp_alloc;
Allctr_t *verify_unused_temp_alloc_data;
@@ -822,14 +836,16 @@ erts_smp_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi)
#define ERTS_PSD_CALL_TIME_BP 3
#define ERTS_PSD_DELAYED_GC_TASK_QS 4
#define ERTS_PSD_NIF_TRAP_EXPORT 5
-#define ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF 6
+#define ERTS_PSD_ETS_OWNED_TABLES 6
+#define ERTS_PSD_ETS_FIXED_TABLES 7
+#define ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF 8
-#define ERTS_PSD_SIZE 7
+#define ERTS_PSD_SIZE 9
#if !defined(HIPE)
# undef ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF
# undef ERTS_PSD_SIZE
-# define ERTS_PSD_SIZE 6
+# define ERTS_PSD_SIZE 8
#endif
typedef struct {
@@ -857,6 +873,12 @@ typedef struct {
#define ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS ERTS_PROC_LOCK_MAIN
#define ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS ERTS_PROC_LOCK_MAIN
+#define ERTS_PSD_ETS_OWNED_TABLES_GET_LOCKS ERTS_PROC_LOCK_STATUS
+#define ERTS_PSD_ETS_OWNED_TABLES_SET_LOCKS ERTS_PROC_LOCK_STATUS
+
+#define ERTS_PSD_ETS_FIXED_TABLES_GET_LOCKS ERTS_PROC_LOCK_MAIN
+#define ERTS_PSD_ETS_FIXED_TABLES_SET_LOCKS ERTS_PROC_LOCK_MAIN
+
typedef struct {
ErtsProcLocks get_locks;
ErtsProcLocks set_locks;
@@ -1782,6 +1804,8 @@ void erts_schedule_thr_prgr_later_cleanup_op(void (*)(void *),
ErtsThrPrgrLaterOp *,
UWord);
void erts_schedule_complete_off_heap_message_queue_change(Eterm pid);
+struct db_fixation;
+void erts_schedule_ets_free_fixation(Eterm pid, struct db_fixation*);
void erts_schedule_flush_trace_messages(Process *proc, int force_on_proc);
int erts_flush_trace_messages(Process *c_p, ErtsProcLocks locks);
diff --git a/erts/emulator/beam/erl_rbtree.h b/erts/emulator/beam/erl_rbtree.h
index 5fefaea978..6a42853957 100644
--- a/erts/emulator/beam/erl_rbtree.h
+++ b/erts/emulator/beam/erl_rbtree.h
@@ -105,7 +105,10 @@
* <ERTS_RBT_PREFIX>_rbt_yield_state_t.
*
* The yield state should be statically initialized by
- * ERTS_RBT_YIELD_STAT_INITER.
+ * ERTS_RBT_YIELD_STAT_INITER
+ *
+ * or dynamically initialized with
+ * ERTS_RBT_YIELD_STAT_INIT(<ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate)
*
*
* The following API functions are implemented if corresponding
@@ -178,8 +181,8 @@
* Operate by calling the operator 'op' on each element.
* Order is undefined.
*
- * Yield when 'ylimit' elements has been processed. Zero is
- * returned when yielding, and a non-zero value is returned when
+ * Yield when 'ylimit' elements has been processed. True is
+ * returned when yielding, and false is returned when
* the whole tree has been processed. The tree should not be
* modified until all of it has been processed.
*
@@ -195,8 +198,8 @@
* Order is undefined. Each element should be destroyed
* by 'op'.
*
- * Yield when 'ylimit' elements has been processed. Zero is
- * returned when yielding, and a non-zero value is returned when
+ * Yield when 'ylimit' elements has been processed. True is
+ * returned when yielding, and false is returned when
* the whole tree has been processed.
*
* 'arg' is passed as argument to 'op'.
@@ -228,8 +231,8 @@
* Operate by calling the operator 'op' on each element from
* smallest towards larger elements.
*
- * Yield when 'ylimit' elements has been processed. Zero is
- * returned when yielding, and a non-zero value is returned when
+ * Yield when 'ylimit' elements has been processed. True is
+ * returned when yielding, and false is returned when
* the whole tree has been processed. The tree should not be
* modified until all of it has been processed.
*
@@ -244,8 +247,8 @@
* Operate by calling the operator 'op' on each element from
* largest towards smaller elements.
*
- * Yield when 'ylimit' elements has been processed. Zero is
- * returned when yielding, and a non-zero value is returned when
+ * Yield when 'ylimit' elements has been processed. True is
+ * returned when yielding, and false is returned when
* the whole tree has been processed. The tree should not be
* modified until all of it has been processed.
*
@@ -296,8 +299,8 @@
* Note that elements are often destroyed in another order
* than the order that the elements are operated on.
*
- * Yield when 'ylimit' elements has been processed. Zero is
- * returned when yielding, and a non-zero value is returned when
+ * Yield when 'ylimit' elements has been processed. True is
+ * returned when yielding, and false is returned when
* the whole tree has been processed. The tree should not be
* modified until all of it has been processed.
*
@@ -318,8 +321,8 @@
* Note that elements are often destroyed in another order
* than the order that the elements are operated on.
*
- * Yield when 'ylimit' elements has been processed. Zero is
- * returned when yielding, and a non-zero value is returned when
+ * Yield when 'ylimit' elements has been processed. True is
+ * returned when yielding, and false is returned when
* the whole tree has been processed. The tree should not be
* modified until all of it has been processed.
*
@@ -422,6 +425,13 @@
#ifndef ERTS_RBT_YIELD_STAT_INITER
# define ERTS_RBT_YIELD_STAT_INITER {NULL, 0}
#endif
+#ifndef ERTS_RBT_YIELD_STAT_INIT
+# define ERTS_RBT_YIELD_STAT_INIT(YS) \
+ do { \
+ (YS)->x = NULL; \
+ (YS)->up = 0; \
+ } while (0)
+#endif
#define ERTS_RBT_CONCAT_MACRO_VALUES___(X, Y) \
X ## Y
@@ -476,12 +486,12 @@ typedef struct {
#if defined(ERTS_RBT_HARD_DEBUG) \
&& (defined(ERTS_RBT_WANT_DELETE) \
|| defined(ERTS_RBT_NEED_INSERT__))
-static void ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root);
+static void ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root, ERTS_RBT_T *node);
# define ERTS_RBT_NEED_HDBG_CHECK_TREE__
-# define ERTS_RBT_HDBG_CHECK_TREE__(R) \
- ERTS_RBT_FUNC__(hdbg_check_tree)((R))
+# define ERTS_RBT_HDBG_CHECK_TREE__(R,N) \
+ ERTS_RBT_FUNC__(hdbg_check_tree)((R),(N))
#else
-# define ERTS_RBT_HDBG_CHECK_TREE__(R) ((void) 1)
+# define ERTS_RBT_HDBG_CHECK_TREE__(R,N) ((void) 1)
#endif
#ifdef ERTS_RBT_NEED_ROTATE__
@@ -634,7 +644,7 @@ ERTS_RBT_FUNC__(delete)(ERTS_RBT_T **root, ERTS_RBT_T *n)
ERTS_RBT_T null_x; /* null_x is used to get the fixup started when we
splice out a node without children. */
- ERTS_RBT_HDBG_CHECK_TREE__(*root);
+ ERTS_RBT_HDBG_CHECK_TREE__(*root, n);
ERTS_RBT_INIT_EMPTY_TNODE(&null_x);
@@ -852,7 +862,7 @@ ERTS_RBT_FUNC__(delete)(ERTS_RBT_T **root, ERTS_RBT_T *n)
}
}
- ERTS_RBT_HDBG_CHECK_TREE__(*root);
+ ERTS_RBT_HDBG_CHECK_TREE__(*root, NULL);
}
@@ -982,7 +992,7 @@ ERTS_RBT_FUNC__(insert_aux__)(ERTS_RBT_T **root, ERTS_RBT_T *n, int lookup)
{
ERTS_RBT_KEY_T kn = ERTS_RBT_GET_KEY(n);
- ERTS_RBT_HDBG_CHECK_TREE__(*root);
+ ERTS_RBT_HDBG_CHECK_TREE__(*root, NULL);
ERTS_RBT_INIT_EMPTY_TNODE(n);
@@ -1004,7 +1014,7 @@ ERTS_RBT_FUNC__(insert_aux__)(ERTS_RBT_T **root, ERTS_RBT_T *n, int lookup)
if (lookup && ERTS_RBT_IS_EQ(kn, kx)) {
- ERTS_RBT_HDBG_CHECK_TREE__(*root);
+ ERTS_RBT_HDBG_CHECK_TREE__(*root, NULL);
return x;
}
@@ -1038,7 +1048,7 @@ ERTS_RBT_FUNC__(insert_aux__)(ERTS_RBT_T **root, ERTS_RBT_T *n, int lookup)
ERTS_RBT_FUNC__(insert_fixup__)(root, n);
}
- ERTS_RBT_HDBG_CHECK_TREE__(*root);
+ ERTS_RBT_HDBG_CHECK_TREE__(*root, n);
return NULL;
}
@@ -1364,7 +1374,7 @@ ERTS_RBT_FUNC__(foreach_ordered__)(ERTS_RBT_T **root,
ystate->x = NULL;
ystate->up = 0;
}
- return 1; /* Done */
+ return 0; /* Done */
}
x = p;
}
@@ -1579,15 +1589,17 @@ ERTS_RBT_FUNC__(debug_print)(FILE *filep, ERTS_RBT_T *x, int indent,
#ifdef ERTS_RBT_NEED_HDBG_CHECK_TREE__
static void
-ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root)
+ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root, ERTS_RBT_T *n)
{
int black_depth = -1, no_black = 0;
ERTS_RBT_T *c, *p, *x = root;
ERTS_RBT_KEY_T kx;
ERTS_RBT_KEY_T kc;
- if (!x)
+ if (!x) {
+ ERTS_RBT_ASSERT(!n);
return;
+ }
ERTS_RBT_ASSERT(!ERTS_RBT_GET_PARENT(x));
@@ -1597,6 +1609,9 @@ ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root)
while (1) {
+ if (x == n)
+ n = NULL;
+
if (ERTS_RBT_IS_BLACK(x))
no_black++;
else {
@@ -1668,6 +1683,7 @@ ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root)
if (!p) {
ERTS_RBT_ASSERT(root == x);
ERTS_RBT_ASSERT(no_black == 0);
+ ERTS_RBT_ASSERT(!n);
return; /* Done */
}
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index c6ea8049c3..144dd60d21 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -487,6 +487,12 @@ extern volatile int erts_break_requested;
void erts_do_break_handling(void);
#endif
+#if !defined(ERTS_SMP) && !defined(__WIN32__)
+extern volatile Uint erts_signal_state;
+#define ERTS_SIGNAL_STATE erts_signal_state
+void erts_handle_signal_state(void);
+#endif
+
#ifdef ERTS_SMP
extern erts_smp_atomic32_t erts_writing_erl_crash_dump;
extern erts_tsd_key_t erts_is_crash_dumping_key;
diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c
index 1ef9fa2a05..00c70268df 100644
--- a/erts/emulator/sys/common/erl_check_io.c
+++ b/erts/emulator/sys/common/erl_check_io.c
@@ -2169,6 +2169,12 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
erts_do_break_handling();
#endif
+#ifdef ERTS_SIGNAL_STATE /* ifndef ERTS_SMP */
+ if (ERTS_SIGNAL_STATE) {
+ erts_handle_signal_state();
+ }
+#endif
+
/* Figure out timeout value */
timeout_time = (do_wait
? erts_check_next_timeout_time(esdp)
@@ -2207,6 +2213,14 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
erts_do_break_handling();
#endif
+
+#ifdef ERTS_SIGNAL_STATE /* ifndef ERTS_SMP */
+ if (ERTS_SIGNAL_STATE) {
+ erts_handle_signal_state();
+ }
+#endif
+
+
if (poll_ret != 0) {
erts_smp_atomic_set_nob(&pollset.in_poll_wait, 0);
forget_removed(&pollset);
diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c
index e836f9bcc8..b48b3f8804 100644
--- a/erts/emulator/sys/unix/sys.c
+++ b/erts/emulator/sys/unix/sys.c
@@ -139,6 +139,28 @@ volatile int erts_break_requested = 0;
#define ERTS_SET_BREAK_REQUESTED (erts_break_requested = 1)
#define ERTS_UNSET_BREAK_REQUESTED (erts_break_requested = 0)
#endif
+
+#ifndef ERTS_SMP
+static Eterm signalstate_sigterm[] = {
+ am_sigint, /* 0 */
+ am_sighup, /* 1 */
+ am_sigquit, /* 2 */
+ am_sigabrt, /* 3 */
+ am_sigalrm, /* 4 */
+ am_sigterm, /* 5 */
+ am_sigusr1, /* 6 */
+ am_sigusr2, /* 7 */
+ am_sigchld, /* 8 */
+ am_sigstop, /* 9 */
+ am_sigtstp /* 10 */
+};
+
+volatile Uint erts_signal_state = 0;
+#define ERTS_SET_SIGNAL_STATE(S) (erts_signal_state |= signum_to_signalstate(S))
+#define ERTS_CLEAR_SIGNAL_STATE (erts_signal_state = 0)
+static ERTS_INLINE Uint signum_to_signalstate(int signum);
+#endif
+
/* set early so the break handler has access to initial mode */
static struct termios initial_tty_mode;
static int replace_intr = 0;
@@ -770,13 +792,34 @@ signum_to_signalterm(int signum)
}
}
+#ifndef ERTS_SMP
+static ERTS_INLINE Uint
+signum_to_signalstate(int signum)
+{
+ switch (signum) {
+ case SIGINT: return (1 << 0);
+ case SIGHUP: return (1 << 1);
+ case SIGQUIT: return (1 << 2);
+ case SIGABRT: return (1 << 3);
+ case SIGALRM: return (1 << 4);
+ case SIGTERM: return (1 << 5);
+ case SIGUSR1: return (1 << 6);
+ case SIGUSR2: return (1 << 7);
+ case SIGCHLD: return (1 << 8);
+ case SIGSTOP: return (1 << 9);
+ case SIGTSTP: return (1 << 10);
+ default: return 0;
+ }
+}
+#endif
+
static RETSIGTYPE generic_signal_handler(int signum)
{
#ifdef ERTS_SMP
smp_sig_notify(signum);
#else
- Eterm signal = signum_to_signalterm(signum);
- signal_notify_requested(signal);
+ ERTS_SET_SIGNAL_STATE(signum);
+ ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */
#endif
}
@@ -962,6 +1005,23 @@ void erts_do_break_handling(void)
erts_smp_thr_progress_unblock();
}
+#ifdef ERTS_SIGNAL_STATE
+void erts_handle_signal_state(void) {
+ Uint signal_state = ERTS_SIGNAL_STATE;
+ Uint i = 0;
+
+ ERTS_CLEAR_SIGNAL_STATE;
+
+ while (signal_state) {
+ if (signal_state & 0x1) {
+ signal_notify_requested(signalstate_sigterm[i]);
+ }
+ i++;
+ signal_state = signal_state >> 1;
+ }
+}
+#endif
+
/* Fills in the systems representation of the jam/beam process identifier.
** The Pid is put in STRING representation in the supplied buffer,
** no interpretatione of this should be done by the rest of the
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index 149d30d299..5d6f36b222 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 2b0c9ff2af..888d2beee0 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -129,7 +129,7 @@
-export([list_to_atom/1, list_to_binary/1]).
-export([list_to_bitstring/1, list_to_existing_atom/1, list_to_float/1]).
-export([list_to_integer/1, list_to_integer/2]).
--export([list_to_pid/1, list_to_tuple/1, loaded/0]).
+-export([list_to_pid/1, list_to_ref/1, list_to_tuple/1, loaded/0]).
-export([localtime/0, make_ref/0]).
-export([map_size/1, match_spec_test/3, md5/1, md5_final/1]).
-export([md5_init/0, md5_update/2, module_loaded/1, monitor/2]).
@@ -1159,6 +1159,12 @@ list_to_integer(_String,_Base) ->
String :: string().
list_to_pid(_String) ->
erlang:nif_error(undefined).
+
+%% list_to_ref/1
+-spec erlang:list_to_ref(String) -> reference() when
+ String :: string().
+list_to_ref(_String) ->
+ erlang:nif_error(undefined).
%% list_to_tuple/1
-spec list_to_tuple(List) -> tuple() when
diff --git a/lib/asn1/c_src/asn1_erl_nif.c b/lib/asn1/c_src/asn1_erl_nif.c
index b29c9a7ed3..7b7e11b02d 100644
--- a/lib/asn1/c_src/asn1_erl_nif.c
+++ b/lib/asn1/c_src/asn1_erl_nif.c
@@ -901,31 +901,35 @@ static int ber_decode_tag(ErlNifEnv* env, ERL_NIF_TERM *tag, unsigned char *in_b
/* then get the tag number */
if ((tmp_tag = (int) INVMASK(in_buf[*ib_index],ASN1_CLASSFORM)) < 31) {
- *tag = enif_make_uint(env, tag_no + tmp_tag);
+ *tag = enif_make_uint(env, tag_no | tmp_tag);
(*ib_index)++;
} else {
- int n = 0; /* n is used to check that the 64K limit is not
- exceeded*/
-
/* should check that at least three bytes are left in
in-buffer,at least two tag byte and at least one length byte */
if ((*ib_index + 3) > in_buf_len)
return ASN1_VALUE_ERROR;
(*ib_index)++;
- /* The tag is in the following bytes in in_buf as
- 1ttttttt 1ttttttt ... 0ttttttt, where the t-bits
- is the tag number*/
- /* In practice is the tag size limited to 64K, i.e. 16 bits. If
- the tag is greater then 64K return an error */
- while (((tmp_tag = (int) in_buf[*ib_index]) >= 128) && n < 2) {
- /* m.s.b. = 1 */
- tag_no = tag_no + (MASK(tmp_tag,ASN1_LONG_TAG) << 7);
+ /*
+ * The tag is in the following bytes in in_buf as:
+ *
+ * 1ttttttt 0ttttttt
+ *
+ * or
+ *
+ * 0ttttttt
+ *
+ * where the t-bits is the tag number. If the tag does not
+ * fit in two tag bytes (16K), return an error.
+ */
+ if ((tmp_tag = (int) in_buf[*ib_index]) >= 128) {
+ tag_no = tag_no | (MASK(tmp_tag,ASN1_LONG_TAG) << 7);
(*ib_index)++;
- n++;
- };
- if ((n == 2) && in_buf[*ib_index] > 3)
- return ASN1_TAG_ERROR; /* tag number > 64K */
- tag_no = tag_no + in_buf[*ib_index];
+ }
+ tmp_tag = (int) in_buf[*ib_index];
+ if (tmp_tag >= 128) {
+ return ASN1_TAG_ERROR; /* tag number > 16K */
+ }
+ tag_no = tag_no | tmp_tag;
(*ib_index)++;
*tag = enif_make_uint(env, tag_no);
}
diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl
index 9f77a557e5..58cbc89db5 100644
--- a/lib/asn1/src/asn1ct.erl
+++ b/lib/asn1/src/asn1ct.erl
@@ -23,10 +23,10 @@
%% Compile Time functions for ASN.1 (e.g ASN.1 compiler).
-%%-compile(export_all).
%% Public exports
-export([compile/1, compile/2]).
-export([test/1, test/2, test/3, value/2, value/3]).
+
%% Application internal exports
-export([compile_asn/3,compile_asn1/3,compile_py/3,compile/3,
vsn/0,
@@ -75,12 +75,9 @@
-define(ALTERNATIVE,alt).
-define(ALTERNATIVE_UNDECODED,alt_undec).
-define(ALTERNATIVE_PARTS,alt_parts).
-%-define(BINARY,bin).
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% This is the interface to the compiler
-%%
-%%
compile(File) ->
compile(File,[]).
@@ -751,7 +748,6 @@ remove_import_doubles([]) ->
remove_import_doubles(ImportList) ->
MergedImportList =
merge_symbols_from_module(ImportList,[]),
-%% io:format("MergedImportList: ~p~n",[MergedImportList]),
delete_double_of_symbol(MergedImportList,[]).
merge_symbols_from_module([Imp|Imps],Acc) ->
@@ -769,7 +765,6 @@ merge_symbols_from_module([Imp|Imps],Acc) ->
end,
Imps),
NewImps = lists:subtract(Imps,IfromModName),
-%% io:format("Imp: ~p~nIfromModName: ~p~n",[Imp,IfromModName]),
NewImp =
Imp#'SymbolsFromModule'{
symbols = lists:append(
@@ -835,7 +830,6 @@ generate({M,CodeTuple}, OutFile, EncodingRule, Options) ->
Code = #abst{name=M#module.name,
types=Types,values=Values,ptypes=Ptypes,
classes=Classes,objects=Objects,objsets=ObjectSets},
- debug_on(Options),
setup_bit_string_format(Options),
setup_legacy_erlang_types(Options),
asn1ct_table:new(check_functions),
@@ -855,7 +849,6 @@ generate({M,CodeTuple}, OutFile, EncodingRule, Options) ->
end,
asn1ct_gen:pgen(OutFile, Gen, Code),
- debug_off(Options),
cleanup_bit_string_format(),
erase(tlv_format), % used in ber
erase(class_default_type),% used in ber
@@ -990,12 +983,8 @@ get_input_file(Module,[]) ->
get_input_file(Module,[I|Includes]) ->
case (catch input_file_type(filename:join([I,Module]))) of
{single_file,FileName} ->
-%% case file:read_file_info(FileName) of
-%% {ok,_} ->
{file,FileName};
-%% _ -> get_input_file(Module,Includes)
-%% end;
- _ ->
+ _ ->
get_input_file(Module,Includes)
end.
@@ -1151,20 +1140,8 @@ is_asn1_flag(verbose) -> true;
%% 'warnings_as_errors' is intentionally passed through to the compiler.
is_asn1_flag(_) -> false.
-debug_on(Options) ->
- case lists:member(debug,Options) of
- true ->
- put(asndebug,true);
- _ ->
- true
- end.
-
-debug_off(_Options) ->
- erase(asndebug).
-
outfile(Base, Ext, Opts) ->
-% io:format("Opts. ~p~n",[Opts]),
Obase = case lists:keysearch(outdir, 1, Opts) of
{value, {outdir, Odir}} -> filename:join(Odir, Base);
_NotFound -> Base % Not found or bad format
@@ -1215,9 +1192,6 @@ compile_py(File,OutFile,Options) ->
compile(File, _OutFile, Options) ->
case compile(File, make_erl_options(Options)) of
{error,_Reason} ->
- %% case occurs due to error in asn1ct_parser2,asn1ct_check
-%% io:format("~p~n",[_Reason]),
-%% io:format("~p~n~s~n",[_Reason,"error"]),
error;
ok ->
ok;
@@ -1512,7 +1486,8 @@ create_pdec_inc_command(_ModName,_,[],Acc) ->
create_pdec_inc_command(ModName,{Comps1,Comps2},TNL,Acc)
when is_list(Comps1),is_list(Comps2) ->
create_pdec_inc_command(ModName,Comps1 ++ Comps2,TNL,Acc);
-%% The following two functionclauses matches on the type after the top type. This one if the top type had no tag, i.e. a CHOICE
+%% The following two clauses match on the type after the top
+%% type. This one if the top type had no tag, i.e. a CHOICE.
create_pdec_inc_command(ModN,Clist,[CL|_Rest],[[]]) when is_list(CL) ->
create_pdec_inc_command(ModN,Clist,CL,[]);
create_pdec_inc_command(ModN,Clist,[CL|_Rest],Acc) when is_list(CL) ->
@@ -1523,17 +1498,14 @@ create_pdec_inc_command(ModName,
prop=Prop}|Comps],
TNL=[C1|Cs],Acc) ->
case C1 of
-% Name ->
-% %% In this case C1 is an atom
-% TagCommand = get_tag_command(TS,?MANDATORY,Prop),
-% create_pdec_inc_command(ModName,get_components(TS#type.def),Cs,[TagCommand|Acc]);
{Name,undecoded} ->
TagCommand = get_tag_command(TS,?UNDECODED,Prop),
create_pdec_inc_command(ModName,Comps,Cs,concat_sequential(TagCommand,Acc));
{Name,parts} ->
TagCommand = get_tag_command(TS,?PARTS,Prop),
create_pdec_inc_command(ModName,Comps,Cs,concat_sequential(TagCommand,Acc));
- L when is_list(L) -> % I guess this never happens due to previous function clause
+ L when is_list(L) ->
+ %% I guess this never happens due to previous clause.
%% This case is only possible as the first element after
%% the top type element, when top type is SEGUENCE or SET.
%% Follow each element in L. Must note every tag on the
@@ -1555,8 +1527,6 @@ create_pdec_inc_command(ModName,
RestPartsList,[]),
create_pdec_inc_command(ModName,Comps,Cs,
[[?MANDATORY,InnerDirectives]|Acc]);
-% create_pdec_inc_command(ModName,Comps,Cs,
-% [InnerDirectives,?MANDATORY|Acc]);
[Opt,EncTag] ->
InnerDirectives =
create_pdec_inc_command(ModName,TS#type.def,
@@ -1564,9 +1534,8 @@ create_pdec_inc_command(ModName,
create_pdec_inc_command(ModName,Comps,Cs,
[[Opt,EncTag,InnerDirectives]|Acc])
end;
-% create_pdec_inc_command(ModName,CList,RestPartsList,Acc);
-%% create_pdec_inc_command(ModName,TS#type.def,RestPartsList,Acc);
- _ -> %% this component may not be in the config list
+ _ ->
+ %% this component may not be in the config list
TagCommand = get_tag_command(TS,?MANDATORY,Prop),
create_pdec_inc_command(ModName,Comps,TNL,concat_sequential(TagCommand,Acc))
end;
@@ -1577,7 +1546,6 @@ create_pdec_inc_command(ModName,
[{C1,Directive}|Rest],Acc) ->
case Directive of
List when is_list(List) ->
-% [Command,Tag] = get_tag_command(TS,?ALTERNATIVE,Prop),
TagCommand = get_tag_command(TS,?ALTERNATIVE,Prop),
CompAcc =
create_pdec_inc_command(ModName,
@@ -1586,9 +1554,6 @@ create_pdec_inc_command(ModName,
[Command,Tag] when is_atom(Command) ->
[[Command,Tag,CompAcc]|Acc];
[L1,_L2|Rest] when is_list(L1) ->
-% [LastComm|Comms] = lists:reverse(TagCommand),
-% [concat_sequential(lists:reverse(Comms),
-% [LastComm,CompAcc])|Acc]
case lists:reverse(TagCommand) of
[Atom|Comms] when is_atom(Atom) ->
[concat_sequential(lists:reverse(Comms),
@@ -1597,12 +1562,8 @@ create_pdec_inc_command(ModName,
[concat_sequential(lists:reverse(Comms),
[[Command2,Tag2,CompAcc]])|Acc]
end
-% [concat_sequential(lists:reverse(Comms),
-% InnerCommand)|Acc]
-
end,
create_pdec_inc_command(ModName,{'CHOICE',Comps},Rest,
-% [[Command,Tag,CompAcc]|Acc]);
NewAcc);
undecoded ->
TagCommand = get_tag_command(TS,?ALTERNATIVE_UNDECODED,Prop),
@@ -1658,7 +1619,6 @@ create_partial_decode_gen_info(_M1,{M2,_}) ->
throw({error,{"wrong module name in asn1 config file",
M2}}).
-%create_partial_decode_gen_info1(ModName,{ModName,TypeList}) ->
create_partial_decode_gen_info1(ModName,{FuncName,TypeList}) ->
case TypeList of
[TopType|Rest] ->
@@ -1678,11 +1638,6 @@ create_partial_decode_gen_info1(ModName,{FuncName,TypeList}) ->
end;
create_partial_decode_gen_info1(_,_) ->
ok.
-% create_partial_decode_gen_info1(_,[]) ->
-% [];
-% create_partial_decode_gen_info1(_M1,{M2,_}) ->
-% throw({error,{"wrong module name in asn1 config file",
-% M2}}).
%% create_pdec_command/4 for each name (type or component) in the
%% third argument, TypeNameList, a command is created. The command has
@@ -1698,7 +1653,6 @@ create_pdec_command(_ModName,_,[],Acc) ->
Fun(L,[H|Res],Fun)
end,
Remove_empty_lists(Acc,[],Remove_empty_lists);
-% lists:reverse(Acc);
create_pdec_command(ModName,[#'ComponentType'{name=C1,typespec=TS}|_Comps],
[C1|Cs],Acc) ->
%% this component is a constructed type or the last in the
@@ -1747,9 +1701,7 @@ create_pdec_command(ModName,TS=#type{def=Def},[C1|Cs],Acc) ->
create_pdec_command(_,_,TNL,_) ->
throw({error,{"unexpected error when creating partial "
"decode command",TNL}}).
-
-% get_components({'CHOICE',Components}) ->
-% Components;
+
get_components(#'SEQUENCE'{components={C1,C2}}) when is_list(C1),is_list(C2) ->
C1++C2;
get_components(#'SEQUENCE'{components=Components}) ->
@@ -1820,8 +1772,6 @@ get_tag_command(#type{tag=[Tag]},Command) ->
[Command,encode_tag_val(decode_class(Tag#tag.class),Tag#tag.form,
Tag#tag.number)];
get_tag_command(T=#type{tag=[Tag|Tags]},Command) ->
-% [get_tag_command(T#type{tag=[Tag]},Command)|
-% [get_tag_command(T#type{tag=Tags},Command)]].
TC = get_tag_command(T#type{tag=[Tag]},Command),
TCs = get_tag_command(T#type{tag=Tags},Command),
case many_tags(TCs) of
@@ -1849,7 +1799,6 @@ get_tag_command(#type{tag=Tag},Command,Prop) when is_record(Tag,tag) ->
get_tag_command(#type{tag=[Tag]},Command,Prop);
get_tag_command(T=#type{tag=[Tag|Tags]},Command,Prop) ->
[get_tag_command(T#type{tag=[Tag]},Command,Prop)|[
-% get_tag_command(T#type{tag=Tags},?MANDATORY,Prop)]].
get_tag_command(T#type{tag=Tags},Command,Prop)]].
anonymous_dec_command(?UNDECODED,'OPTIONAL') ->
@@ -1964,8 +1913,8 @@ read_config_data(Key) ->
true ->
case asn1ct_table:lookup(asn1_general,{asn1_config,Key}) of
[{_,Data}] -> Data;
- Err -> % Err is [] when nothing was saved in the ets table
-%% io:format("strange data from config file ~w~n",[Err]),
+ Err ->
+ %% Err is [] when nothing was saved in the ets table
Err
end
end.
@@ -1978,7 +1927,6 @@ read_config_data(Key) ->
%% saves input data in a new gen_state record
save_gen_state(exclusive_decode,{_,ConfList},PartIncTlvTagList) ->
- %ConfList=[{FunctionName,PatternList}|Rest]
State =
case get_gen_state() of
S when is_record(S,gen_state) -> S;
@@ -1988,14 +1936,12 @@ save_gen_state(exclusive_decode,{_,ConfList},PartIncTlvTagList) ->
inc_type_pattern=ConfList},
save_config(gen_state,StateRec);
save_gen_state(_,_,_) ->
-%% ok.
case get_gen_state() of
S when is_record(S,gen_state) -> ok;
_ -> save_config(gen_state,#gen_state{})
end.
save_gen_state(selective_decode,{_,Type_component_name_list}) ->
-%% io:format("Selective_decode: ~p~n",[Type_component_name_list]),
State =
case get_gen_state() of
S when is_record(S,gen_state) -> S;
@@ -2077,11 +2023,6 @@ update_gen_state(type_pattern,State,Data) ->
update_gen_state(func_name,State,Data) ->
save_gen_state(State#gen_state{func_name=Data});
update_gen_state(namelist,State,Data) ->
-% SData =
-% case Data of
-% [D] when is_list(D) -> D;
-% _ -> Data
-% end,
save_gen_state(State#gen_state{namelist=Data});
update_gen_state(tobe_refed_funcs,State,Data) ->
save_gen_state(State#gen_state{tobe_refed_funcs=Data});
@@ -2136,7 +2077,6 @@ get_tobe_refed_func(Name) ->
%% tuple. Do not save if it exists in generated_functions, because
%% then it will be or already is generated.
add_tobe_refed_func(Data) ->
- %%
{Name,SI,Pattern} =
fun({N,Si,P,_}) -> {N,Si,P};
(D) -> D end (Data),
@@ -2144,8 +2084,6 @@ add_tobe_refed_func(Data) ->
case SI of
I when is_integer(I) ->
fun(D) -> D end(Data);
-% fun({N,Ix,P}) -> {N,Ix+1,P};
-% ({N,Ix,P,T}) -> {N,Ix+1,P,T} end (Data);
_ ->
fun({N,_,P}) -> {N,0,P};
({N,_,P,T}) -> {N,0,P,T} end (Data)
@@ -2153,12 +2091,13 @@ add_tobe_refed_func(Data) ->
L = get_gen_state_field(generated_functions),
case generated_functions_member(get(currmod),Name,L,Pattern) of
- true -> % it exists in generated_functions, it has already
- % been generated or saved in tobe_refed_func
+ true ->
+ %% it exists in generated_functions, it has already
+ %% been generated or saved in tobe_refed_func
ok;
_ ->
add_once_tobe_refed_func(NewData),
- %%only to get it saved in generated_functions
+ %% only to get it saved in generated_functions
maybe_rename_function(tobe_refed,Name,Pattern)
end.
@@ -2173,16 +2112,13 @@ add_once_tobe_refed_func(Data) ->
({N,I,_,_}) when N==Name,I==Index -> true;
(_) -> false end,TRFL) of
[] ->
-%% case lists:keysearch(element(1,Data),1,TRFL) of
-%% false ->
update_gen_state(tobe_refed_funcs,[Data|TRFL]);
_ ->
ok
end.
-
-%% moves Name from the to be list to the generated list.
+%% Moves Name from the to be list to the generated list.
generated_refed_func(Name) ->
L = get_gen_state_field(tobe_refed_funcs),
NewL = lists:keydelete(Name,1,L),
@@ -2190,7 +2126,7 @@ generated_refed_func(Name) ->
L2 = get_gen_state_field(gen_refed_funcs),
update_gen_state(gen_refed_funcs,[Name|L2]).
-%% adds Data to gen_refed_funcs field in gen_state.
+%% Adds Data to gen_refed_funcs field in gen_state.
add_generated_refed_func(Data) ->
case is_function_generated(Data) of
true ->
@@ -2212,7 +2148,7 @@ next_refed_func() ->
reset_gen_state() ->
save_gen_state(#gen_state{}).
-%% adds Data to generated_functions field in gen_state.
+%% Adds Data to generated_functions field in gen_state.
add_generated_function(Data) ->
L = get_gen_state_field(generated_functions),
update_gen_state(generated_functions,[Data|L]).
@@ -2231,16 +2167,18 @@ maybe_rename_function(Mode,Name,Pattern) ->
{_,true} ->
L2 = generated_functions_filter(get(currmod),Name,L),
case lists:keysearch(Pattern,3,L2) of
- false -> %name existed, but not pattern
+ false ->
+ %% name existed, but not pattern
NextIndex = length(L2),
- %%rename function
+ %% rename function
Suffix = lists:concat(["_",NextIndex]),
NewName =
maybe_rename_function2(type_check(Name),Name,
Suffix),
add_generated_function({Name,NextIndex,Pattern}),
NewName;
- Value -> % name and pattern existed
+ Value ->
+ %% name and pattern existed
%% do not save any new index
Suffix = make_suffix(Value),
Name2 =
@@ -2250,9 +2188,9 @@ maybe_rename_function(Mode,Name,Pattern) ->
end,
lists:concat([Name2,Suffix])
end;
- {inc_disp,_} -> %% this is when
- %% decode_partial_inc_disp/2 is
- %% generated
+ {inc_disp,_} ->
+ %% this is when decode_partial_inc_disp/2 is
+ %% generated
add_generated_function({Name,0,Pattern}),
Name;
_ -> % this if call from add_tobe_refed_func
@@ -2298,23 +2236,12 @@ generated_functions_member(M,Name,[_|T]) ->
generated_functions_member(_,_,[]) ->
false.
-% generated_functions_member(M,Name,L) ->
-% case lists:keymember(Name,1,L) of
-% true ->
-% true;
-% _ ->
-% generated_functions_member1(M,Name,L)
-% end.
-% generated_functions_member1(M,#'Externaltypereference'{module=M,type=Name},L) ->
-% lists:keymember(Name,1,L);
-% generated_functions_member1(_,_,_) -> false.
-
generated_functions_filter(_,Name,L) when is_atom(Name);is_list(Name) ->
lists:filter(fun({N,_,_}) when N==Name -> true;
(_) -> false
end, L);
generated_functions_filter(M,#'Externaltypereference'{module=M,type=Name},L)->
- % remove toptypename from patterns
+ %% remove top typename from patterns
RemoveTType =
fun({N,I,[N,P]}) when N == Name ->
{N,I,P};
@@ -2351,8 +2278,6 @@ set_current_sindex(Index) ->
type_check(A) when is_atom(A) ->
atom;
-%% type_check(I) when is_integer(I) ->
-%% integer;
type_check(L) when is_list(L) ->
Pred = fun(X) when X=<255 ->
false;
diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl
index 4f04b78241..e867b9606a 100644
--- a/lib/asn1/src/asn1ct_check.erl
+++ b/lib/asn1/src/asn1ct_check.erl
@@ -23,10 +23,9 @@
%% Main Module for ASN.1 compile time functions
-%-compile(export_all).
-export([check/2,storeindb/2,format_error/1]).
-%-define(debug,1).
-include("asn1_records.hrl").
+
%%% The tag-number for universal types
-define(N_BOOLEAN, 1).
-define(N_INTEGER, 2).
@@ -63,7 +62,8 @@
-define(TAG_CONSTRUCTED(Num),
#tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=32}).
--record(newt,{type=unchanged,tag=unchanged,constraint=unchanged,inlined=no}). % used in check_type to update type and tag
+%% used in check_type to update type and tag
+-record(newt,{type=unchanged,tag=unchanged,constraint=unchanged,inlined=no}).
check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
%%Predicates used to filter errors
@@ -561,7 +561,6 @@ check_class_fields(S,[F|Fields],Acc) ->
D;
{undefined,user} ->
%% neither of {primitive,bif} or {constructed,bif}
-
{_,D} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=Type#type.def}),
D;
_ ->
@@ -623,7 +622,6 @@ if_current_checked_type(S,#type{def=Def}) ->
CurrentModule = S#state.mname,
CurrentCheckedName = S#state.tname,
MergedModules = S#state.inputmodules,
- % CurrentCheckedModule = S#state.mname,
case Def of
#'Externaltypereference'{module=CurrentModule,
type=CurrentCheckedName} ->
@@ -656,7 +654,6 @@ check_pobjectset(S,PObjSet) ->
ClassName = #'Externaltypereference'{module=Mod,
type=get_datastr_name(Def)},
{valueset,Set} = ValueSet,
-% ObjectSet = #'ObjectSet'{class={objectclassname,ClassName},
ObjectSet = #'ObjectSet'{class=ClassName,
set=Set},
#pobjectsetdef{pos=Pos,name=Name,args=Args,class=Type#type.def,
@@ -1696,7 +1693,7 @@ check_value(OldS,V) when is_record(V,typedef) ->
%% reference to class
check_value(OldS,V#typedef{typespec=TS#'ObjectSet'{class=Eref}});
#typedef{typespec=HostType} ->
- % an ordinary value set with a type in #typedef.typespec
+ %% an ordinary value set with a type in #typedef.typespec
ValueSet0 = TS#'ObjectSet'.set,
Constr = check_constraints(OldS, HostType, [ValueSet0]),
Type = check_type(OldS,TSDef,TSDef#typedef.typespec),
@@ -2381,15 +2378,6 @@ normalize_s_of(SorS,S,Value,Type,NameList)
%% normalize_restrictedstring handles all format of restricted strings.
-%% tuple case
-% normalize_restrictedstring(_S,[Int1,Int2],_) when is_integer(Int1),is_integer(Int2) ->
-% {Int1,Int2};
-% %% quadruple case
-% normalize_restrictedstring(_S,[Int1,Int2,Int3,Int4],_) when is_integer(Int1),
-% is_integer(Int2),
-% is_integer(Int3),
-% is_integer(Int4) ->
-% {Int1,Int2,Int3,Int4};
%% character string list case
normalize_restrictedstring(S,[H|T],CType) when is_list(H);is_tuple(H) ->
[normalize_restrictedstring(S,H,CType)|normalize_restrictedstring(S,T,CType)];
@@ -2491,7 +2479,7 @@ check_ptype(S,Type,Ts) when is_record(Ts,type) ->
Ts#type{def=TDef}
end,
Ts2;
-%parameterized class
+%% parameterized class
check_ptype(_S,_PTDef,Ts) when is_record(Ts,objectclass) ->
throw({asn1_param_class,Ts}).
@@ -2506,8 +2494,6 @@ check_formal_parameter(_, #'Externaltypereference'{}) ->
check_formal_parameter(S, #'Externalvaluereference'{value=Name}) ->
asn1_error(S, {illegal_typereference,Name}).
-% check_type(S,Type,ObjSpec={{objectclassname,_},_}) ->
- % check_class(S,ObjSpec);
check_type(_S,Type,Ts) when is_record(Type,typedef),
(Type#typedef.checked==true) ->
Ts;
@@ -2606,7 +2592,6 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
constraint = NewC};
_ ->
%% Here we only expand the tags and keep the ext ref.
-
NewExt = ExtRef#'Externaltypereference'{module=merged_mod(S,RefMod,Ext)},
TempNewDef#newt{
type = check_externaltypereference(S,NewExt),
@@ -2749,7 +2734,6 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
case TopName of
[] ->
[get_datastr_name(Type)];
-% [Type#typedef.name];
_ ->
TopName
end,
@@ -2773,7 +2757,6 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
case TopName of
[] ->
[get_datastr_name(Type)];
-% [Type#typedef.name];
_ ->
TopName
end,
@@ -2898,8 +2881,6 @@ tablecinf_choose(#'SEQUENCE'{tablecinf=TCI}) ->
get_innertag(_S,#'ObjectClassFieldType'{type=Type}) ->
case Type of
-% #type{tag=Tag} -> Tag;
-% {fixedtypevaluefield,_,#type{tag=[]}=T} -> get_taglist(S,T);
{fixedtypevaluefield,_,#type{tag=Tag}} -> Tag;
{TypeFieldName,_} when is_atom(TypeFieldName) -> [];
_ -> []
@@ -3754,14 +3735,8 @@ check_reference(S,#'Externaltypereference'{pos=Pos,module=Emod,type=Name}) ->
{ok,Imodule} ->
check_imported(S,Imodule,Name),
#'Externaltypereference'{module=Imodule,type=Name};
-%% case check_imported(S,Imodule,Name) of
-%% ok ->
-%% #'Externaltypereference'{module=Imodule,type=Name};
-%% Err ->
-%% Err
-%% end;
_ ->
- %may be a renamed type in multi file compiling!
+ %% may be a renamed type in multi file compiling!
{M,T}=get_renamed_reference(S,Name,Emod),
NewName = asn1ct:get_name_of_def(T),
NewPos = asn1ct:get_pos_of_def(T),
@@ -4170,7 +4145,6 @@ iof_associated_type(S,[]) ->
def=AssociateSeq}},
asn1_db:dbput(S#state.mname,'INSTANCE OF',TypeDef),
instance_of_decl(S#state.mname);
-%% put(instance_of,{generate,S#state.mname});
_ ->
instance_of_decl(S#state.mname),
ok
@@ -4199,14 +4173,12 @@ iof_associated_type1(S,C) ->
ObjectIdentifier =
#'ObjectClassFieldType'{classname=TypeIdentifierRef,
class=[],
-%% fieldname=[{valuefieldreference,id}],
fieldname={id,[]},
type={fixedtypevaluefield,id,
#type{def='OBJECT IDENTIFIER'}}},
Typefield =
#'ObjectClassFieldType'{classname=TypeIdentifierRef,
class=[],
-%% fieldname=[{typefieldreference,'Type'}],
fieldname={'Type',[]},
type=Typefield_type},
IOFComponents0 =
@@ -4360,11 +4332,11 @@ check_boolean(_S,_Constr) ->
check_octetstring(_S,_Constr) ->
ok.
-% check all aspects of a SEQUENCE
-% - that all component names are unique
-% - that all TAGS are ok (when TAG default is applied)
-% - that each component is of a valid type
-% - that the extension marks are valid
+%% check all aspects of a SEQUENCE
+%% - that all component names are unique
+%% - that all TAGS are ok (when TAG default is applied)
+%% - that each component is of a valid type
+%% - that the extension marks are valid
check_sequence(S,Type,Comps) ->
Components = expand_components(S,Comps),
@@ -4705,11 +4677,11 @@ check_objectidentifier(_S,_Constr) ->
check_relative_oid(_S,_Constr) ->
ok.
-% check all aspects of a CHOICE
-% - that all alternative names are unique
-% - that all TAGS are ok (when TAG default is applied)
-% - that each alternative is of a valid type
-% - that the extension marks are valid
+%% check all aspects of a CHOICE
+%% - that all alternative names are unique
+%% - that all TAGS are ok (when TAG default is applied)
+%% - that each alternative is of a valid type
+%% - that the extension marks are valid
check_choice(S,Type,Components) when is_list(Components) ->
Components1 = [C||C = #'ComponentType'{} <- Components],
case check_unique(Components1,#'ComponentType'.name) of
@@ -5063,12 +5035,12 @@ remove_doubles1(El,L) ->
%% referred to in the ObjectClassFieldType, and the name of the unique
%% field of the class of the ObjectClassFieldType.
%%
-% %% The level information outermost/innermost must be kept. There are
-% %% at least two possibilities to cover here for an outermost case: 1)
-% %% Both the simple table and the component relation have a common path
-% %% at least one step below the outermost level, i.e. the leading
-% %% information shall be on a sub level. 2) They don't have any common
-% %% path.
+%% The level information outermost/innermost must be kept. There are
+%% at least two possibilities to cover here for an outermost case: 1)
+%% Both the simple table and the component relation have a common path
+%% at least one step below the outermost level, i.e. the leading
+%% information shall be on a sub level. 2) They don't have any common
+%% path.
get_simple_table_info(S, Cs, AtLists) ->
[get_simple_table_info1(S, Cs, AtList, []) || AtList <- AtLists].
@@ -5109,10 +5081,10 @@ simple_table_info(S,#'ObjectClassFieldType'{classname=ClRef,
{_FirstFieldName,FieldNames} ->
lists:last(FieldNames)
end,
- %%ObjectClassFieldName is the last element in the dotted
- %%list of the ObjectClassFieldType. The last element may
- %%be of another class, that is referenced from the class
- %%of the ObjectClassFieldType
+ %% ObjectClassFieldName is the last element in the dotted list of
+ %% the ObjectClassFieldType. The last element may be of another
+ %% class, that is referenced from the class of the
+ %% ObjectClassFieldType
ClassDef =
case ObjectClass of
[] ->
@@ -5128,7 +5100,7 @@ simple_table_info(S,#'ObjectClassFieldType'{classname=ClRef,
%% the "name path" in the at-list to the component relation constraint
%% that must refer to a simple table constraint. The list is empty if
%% no component relation constraints were found.
-%%
+%%
%% NamePath has the names of all components that are followed from the
%% beginning of the search. CNames holds the names of all components
%% of the start level, this info is used if an outermost at-notation
@@ -5141,6 +5113,7 @@ any_component_relation(S,[#'ComponentType'{name=CName,typespec=Type}|Cs],CNames,
%% whether this constraint is relevant for the level
%% where the search started
AtNot = extract_at_notation(AtNotation),
+
%% evaluate_atpath returns the relative path to the
%% simple table constraint from where the component
%% relation is found.
@@ -5246,12 +5219,10 @@ get_components(_,#'SET'{components=Cs}) ->
tuple2complist(Cs);
get_components(_,{'CHOICE',Cs}) ->
tuple2complist(Cs);
-%do not step in inlined structures
+%%do not step in inlined structures
get_components(any,{'SEQUENCE OF',T = #type{def=_Def,inlined=no}}) ->
-% get_components(any,Def);
T;
get_components(any,{'SET OF',T = #type{def=_Def,inlined=no}}) ->
-% get_components(any,Def);
T;
get_components(_,_) ->
[].
@@ -5281,15 +5252,12 @@ extract_at_notation([{Level,ValueRefs}]) ->
componentrelation1(S,C = #type{def=Def,constraint=Constraint,tablecinf=TCI},
Path) ->
Ret =
-% case Constraint of
-% [{componentrelation,{_,_,ObjectSet},AtList}|_Rest] ->
case lists:keyfind(componentrelation, 1, Constraint) of
{_,{_,_,ObjectSet},AtList} ->
[{_,AL=[#'Externalvaluereference'{}|_R1]}|_R2] = AtList,
%% Note: if Path is longer than one,i.e. it is within
%% an inner type of the actual level, then the only
%% relevant at-list is of "outermost" type.
-%% #'ObjectClassFieldType'{class=ClassDef} = Def,
ClassDef = get_ObjectClassFieldType_classdef(S,Def),
AtPath =
lists:map(fun(#'Externalvaluereference'{value=V})->V end,
@@ -5375,7 +5343,6 @@ innertype_comprel1(S,T = #type{def=Def,constraint=Cons,tablecinf=TCI},Path) ->
%% relevent here.
[{_,AL=[#'Externalvaluereference'{value=_Attr}|_R1]}|_R2]
= AtList,
-%% #'ObjectClassFieldType'{class=ClassDef} = Def,
ClassDef = get_ObjectClassFieldType_classdef(S,Def),
AtPath =
lists:map(fun(#'Externalvaluereference'{value=V})->V end,
@@ -5444,7 +5411,7 @@ leading_attr_index1(S,[C|Cs],Arg={ObjectSet,_,CDef,P},
value_match(S,C,Name,SubAttr) ->
value_match(S,C,Name,SubAttr,[]). % C has name Name
value_match(_S,#'ComponentType'{},_Name,[],Acc) ->
- Acc;% do not reverse, indexes in reverse order
+ Acc; % do not reverse, indexes in reverse order
value_match(S,#'ComponentType'{typespec=Type},Name,[At|Ats],Acc) ->
InnerType = asn1ct_gen:get_inner(Type#type.def),
Components =
@@ -5514,8 +5481,6 @@ get_tableconstraint_info(S,Type,[C=#'ComponentType'{typespec=CheckedTs}|Cs],Acc)
CheckedTs#type{
def=NewOCFT
}};
-% constraint=[{tableconstraint_info,
-% FieldRef}]}};
{'SEQUENCE OF',SOType} when is_record(SOType,type),
(element(1,SOType#type.def)=='CHOICE') ->
CTypeList = element(2,SOType#type.def),
@@ -5618,51 +5583,6 @@ get_taglist1(S,[_H|Rest]) -> % skip EXTENSIONMARK
get_taglist1(_S,[]) ->
[].
-%% def_to_tag(S,Def) ->
-%% case asn1ct_gen:def_to_tag(Def) of
-%% {'UNIVERSAL',T} ->
-%% case asn1ct_gen:prim_bif(T) of
-%% true ->
-%% ?TAG_PRIMITIVE(tag_number(T));
-%% _ ->
-%% ?TAG_CONSTRUCTED(tag_number(T))
-%% end;
-%% _ -> []
-%% end.
-%% tag_number('BOOLEAN') -> 1;
-%% tag_number('INTEGER') -> 2;
-%% tag_number('BIT STRING') -> 3;
-%% tag_number('OCTET STRING') -> 4;
-%% tag_number('NULL') -> 5;
-%% tag_number('OBJECT IDENTIFIER') -> 6;
-%% tag_number('ObjectDescriptor') -> 7;
-%% tag_number('EXTERNAL') -> 8;
-%% tag_number('INSTANCE OF') -> 8;
-%% tag_number('REAL') -> 9;
-%% tag_number('ENUMERATED') -> 10;
-%% tag_number('EMBEDDED PDV') -> 11;
-%% tag_number('UTF8String') -> 12;
-%% %%tag_number('RELATIVE-OID') -> 13;
-%% tag_number('SEQUENCE') -> 16;
-%% tag_number('SEQUENCE OF') -> 16;
-%% tag_number('SET') -> 17;
-%% tag_number('SET OF') -> 17;
-%% tag_number('NumericString') -> 18;
-%% tag_number('PrintableString') -> 19;
-%% tag_number('TeletexString') -> 20;
-%% %%tag_number('T61String') -> 20;
-%% tag_number('VideotexString') -> 21;
-%% tag_number('IA5String') -> 22;
-%% tag_number('UTCTime') -> 23;
-%% tag_number('GeneralizedTime') -> 24;
-%% tag_number('GraphicString') -> 25;
-%% tag_number('VisibleString') -> 26;
-%% %%tag_number('ISO646String') -> 26;
-%% tag_number('GeneralString') -> 27;
-%% tag_number('UniversalString') -> 28;
-%% tag_number('CHARACTER STRING') -> 29;
-%% tag_number('BMPString') -> 30.
-
merge_tags(T1, T2) when is_list(T2) ->
merge_tags2(T1 ++ T2, []);
merge_tags(T1, T2) ->
diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
index 16af09bca9..bfb69a09b3 100644
--- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
+++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
@@ -32,17 +32,17 @@
-include("asn1_records.hrl").
--import(asn1ct_gen, [emit/1,demit/1,get_record_name_prefix/1]).
+-import(asn1ct_gen, [emit/1,get_record_name_prefix/1]).
-define(ASN1CT_GEN_BER,asn1ct_gen_ber_bin_v2).
-% the encoding of class of tag bits 8 and 7
+%% the encoding of class of tag bits 8 and 7
-define(UNIVERSAL, 0).
-define(APPLICATION, 16#40).
-define(CONTEXT, 16#80).
-define(PRIVATE, 16#C0).
-% primitive or constructed encoding % bit 6
+%% primitive or constructed encoding % bit 6
-define(PRIMITIVE, 0).
-define(CONSTRUCTED, 2#00100000).
@@ -103,7 +103,6 @@ gen_encode_sequence(Gen, Typename, #type{}=D) ->
uniqueclassfield=Unique} when Used /= Unique ->
false;
%% ObjectSet, name of the object set in constraints
- %%
#simpletableattributes{objectsetname=ObjectSetRef,
c_name=AttrN,
c_index=N,
@@ -230,7 +229,6 @@ gen_decode_sequence(Gen, Typename, #type{}=D) ->
usedclassfield=UniqueFieldName,
uniqueclassfield=UniqueFieldName,
valueindex=ValIndex} ->
-% {ObjectSetRef,AttrN,_N,UniqueFieldName} ->%% N is index of attribute that determines constraint
F = fun(#'ComponentType'{typespec=CT})->
case {asn1ct_gen:get_constraint(CT#type.constraint,componentrelation),CT#type.tablecinf} of
{no,[{objfun,_}|_]} -> true;
@@ -279,12 +277,12 @@ gen_decode_sequence(Gen, Typename, #type{}=D) ->
ValueMatch,"),",nl]),
gen_dec_postponed_decs(DecObj,PostponedDecArgs)
end,
- demit(["Result = "]), %dbg
%% return value as record
case Ext of
{ext,_,_} ->
emit(["case ",{prev,tlv}," of [] -> true; _ -> true end, % ... extra fields skipped",nl]);
- _ -> % noext | extensible
+ _ ->
+ %% noext | extensible
emit(["case ",{prev,tlv}," of",nl,
"[] -> true;",
"_ -> exit({error,{asn1, {unexpected,",{prev,tlv},
@@ -431,7 +429,6 @@ gen_decode_set(Gen, Typename, #type{}=D) ->
{DecObjInf,ValueIndex} =
case TableConsInfo of
-%% {ObjectSetRef,AttrN,_N,UniqueFieldName} ->%% N is index of attribute that determines constraint
#simpletableattributes{objectsetname=ObjectSetRef,
c_name=AttrN,
usedclassfield=UniqueFieldName,
@@ -446,7 +443,8 @@ gen_decode_set(Gen, Typename, #type{}=D) ->
end
end,
case lists:any(F,CompList) of
- true -> % when component relation constraint establish
+ true ->
+ %% when component relation constraint establish
%% relation from a component to another components
%% subtype component
{{AttrN,{deep,ObjectSetRef,UniqueFieldName,ValIndex}},
@@ -503,7 +501,6 @@ gen_decode_set(Gen, Typename, #type{}=D) ->
ValueMatch,"),",nl]),
gen_dec_postponed_decs(DecObj,PostponedDecArgs)
end,
- demit(["Result = "]), %dbg
%% return value as record
case Ext of
Extnsn when Extnsn =/= noext ->
@@ -722,7 +719,7 @@ gen_dec_sequence_call2(Erules,TopType,{Root1,EList,Root2},_Ext,DecObjInf) ->
length(Root1)+length(EList),noext,
DecObjInf,LA,ArgsAcc).
-%% returns a list of tags of the elements in the component (second
+%% Returns a list of tags of the elements in the component (second
%% root) list up to and including the first mandatory tag. See 24.6 in
%% X.680 (7/2002)
get_root2_taglist([],Acc) ->
@@ -811,8 +808,6 @@ gen_dec_set_cases(Erules,TopType,[Comp|RestComps],Pos) ->
[FirstTag|_] ->
[(?ASN1CT_GEN_BER:decode_class(FirstTag#tag.class) bsl 10) + FirstTag#tag.number]
end,
-% emit([indent(6),"%Tags: ",Tags,nl]),
-% emit([indent(6),"%Type#type.tag: ",Type#type.tag,nl]),
CaseFun = fun(TagList=[H|T],Fun,N) ->
Semicolon = case TagList of
[_Tag1,_|_] -> [";",nl];
@@ -827,7 +822,6 @@ gen_dec_set_cases(Erules,TopType,[Comp|RestComps],Pos) ->
emit([";",nl])
end,
CaseFun(Tags,CaseFun,0),
-%% emit([";",nl]),
gen_dec_set_cases(Erules,TopType,RestComps,Pos+1).
@@ -1007,14 +1001,6 @@ gen_enc_line(Erules,TopType,Cname,
["{",{curr,encBytes},",",{curr,encLen},"} = "],
EncObj)
end;
-% gen_enc_line(Erules,TopType,Cname,
-% Type=#type{constraint=[{componentrelation,_,_}],
-% def=#'ObjectClassFieldType'{type={typefield,_}}},
-% Element,Indent,OptOrMand=mandatory,EncObj)
-% when is_list(Element) ->
-% asn1ct_name:new(tmpBytes),
-% gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,
-% ["{",{curr,tmpBytes},",_} = "],EncObj);
gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,EncObj)
when is_list(Element) ->
gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,
@@ -1035,37 +1021,30 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj)
gen_optormand_case(OptOrMand, Erules, TopType, Cname, Type, Element),
case {Type,asn1ct_gen:get_constraint(Type#type.constraint,
componentrelation)} of
-% #type{constraint=[{tableconstraint_info,RefedFieldName}],
-% def={typefield,_}} ->
{#type{def=#'ObjectClassFieldType'{type={typefield,_},
fieldname=RefedFieldName}},
{componentrelation,_,_}} ->
{_LeadingAttrName,Fun} = EncObj,
- case RefedFieldName of
- {Name,RestFieldNames} when is_atom(Name) ->
- case OptOrMand of
- mandatory -> ok;
- _ ->
-% emit(["{",{curr,tmpBytes},",",{curr,tmpLen},
- emit(["{",{curr,tmpBytes},",_ } = "])
-% "} = "])
- end,
- emit([Fun,"(",{asis,Name},", ",Element,", ",
- {asis,RestFieldNames},"),",nl]),
- emit(IndDeep),
- case OptOrMand of
- mandatory ->
- emit(["{",{curr,encBytes},",",{curr,encLen},
- "} = ",
- {call,ber,encode_open_type,
- [{curr,tmpBytes},{asis,Tag}]},nl]);
- _ ->
- emit([{call,ber,encode_open_type,
- [{curr,tmpBytes},{asis,Tag}]}])
- end;
- Err ->
- throw({asn1,{'internal error',Err}})
- end;
+ {Name,RestFieldNames} = RefedFieldName,
+ true = is_atom(Name), %Assertion.
+ case OptOrMand of
+ mandatory -> ok;
+ _ ->
+ emit(["{",{curr,tmpBytes},",_ } = "])
+ end,
+ emit([Fun,"(",{asis,Name},", ",Element,", ",
+ {asis,RestFieldNames},"),",nl]),
+ emit(IndDeep),
+ case OptOrMand of
+ mandatory ->
+ emit(["{",{curr,encBytes},",",{curr,encLen},
+ "} = ",
+ {call,ber,encode_open_type,
+ [{curr,tmpBytes},{asis,Tag}]},nl]);
+ _ ->
+ emit([{call,ber,encode_open_type,
+ [{curr,tmpBytes},{asis,Tag}]}])
+ end;
_ ->
case WhatKind of
{primitive,bif} ->
@@ -1166,7 +1145,9 @@ gen_dec_line(Erules,TopType,Cname,CTags,Type,OptOrMand,DecObjInf) ->
gen_dec_call(InnerType,Erules,TopType,Cname,Type,
BytesVar,Tag,
mandatory,", mandatory, ",DecObjInf,OptOrMand);
- _ -> %optional or default or a mandatory component after an extensionmark
+ _ ->
+ %% optional or default, or a mandatory component after
+ %% an extension marker
{FirstTag,RestTag} =
case Tag of
[] ->
@@ -1241,9 +1222,9 @@ gen_dec_line(Erules,TopType,Cname,CTags,Type,OptOrMand,DecObjInf) ->
PostponedDec
end,
case DecObjInf of
- {Cname,ObjSet} -> % this must be the component were an object is
- %% choosen from the object set according to the table
- %% constraint.
+ {Cname,ObjSet} ->
+ %% This must be the component were an object is chosen
+ %% from the object set according to the table constraint.
ObjSetName = case ObjSet of
{deep,OSName,_,_} ->
OSName;
@@ -1280,10 +1261,7 @@ gen_dec_call({typefield,_},_,_,_Cname,Type,BytesVar,Tag,_,_,false,_) ->
[];
gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandComp) ->
call(decode_open_type, [BytesVar,{asis,Tag}]),
- RefedFieldName =
-% asn1ct_gen:get_constraint(Type#type.constraint,
-% tableconstraint_info),
- (Type#type.def)#'ObjectClassFieldType'.fieldname,
+ RefedFieldName = (Type#type.def)#'ObjectClassFieldType'.fieldname,
[{Cname,RefedFieldName,asn1ct_gen:mk_var(asn1ct_name:curr(term)),
asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}];
gen_dec_call(InnerType, Gen, TopType, Cname, Type, BytesVar,
@@ -1339,8 +1317,6 @@ gen_dec_call1(WhatKind, _, TopType, Cname, Type, BytesVar, Tag) ->
emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',",
BytesVar,"}"]);
_ ->
-% {DecFunName, _DecMod, _DecFun} =
-% case {asn1ct:get_gen_state_field(namelist),WhatKind} of
EmitDecFunCall =
fun(FuncName) ->
case {WhatKind,Type#type.tablecinf} of
@@ -1356,14 +1332,11 @@ gen_dec_call1(WhatKind, _, TopType, Cname, Type, BytesVar, Tag) ->
Sindex =
case WhatKind of
#'Externaltypereference'{} ->
-% asn1ct:maybe_rename_function(WhatKind,List),
SI = asn1ct:maybe_saved_sindex(WhatKind,List),
Saves = {WhatKind,SI,List},
asn1ct:add_tobe_refed_func(Saves),
SI;
_ ->
-% asn1ct:maybe_rename_function([Cname|TopType],
-% List),
SI = asn1ct:maybe_saved_sindex([Cname|TopType],List),
Saves = {[Cname|TopType],SI,List,Type},
asn1ct:add_tobe_refed_func(Saves),
@@ -1371,8 +1344,6 @@ gen_dec_call1(WhatKind, _, TopType, Cname, Type, BytesVar, Tag) ->
end,
asn1ct:update_gen_state(namelist,Rest),
Prefix=asn1ct:get_gen_state_field(prefix),
-% Suffix =
-% lists:concat(["_",asn1ct:latest_sindex()]),
Suffix =
case Sindex of
I when is_integer(I),I>0 -> lists:concat(["_",I]);
@@ -1380,8 +1351,6 @@ gen_dec_call1(WhatKind, _, TopType, Cname, Type, BytesVar, Tag) ->
end,
{DecFunName,_,_}=
mkfuncname(TopType,Cname,WhatKind,Prefix,Suffix),
-% SuffixedName =
-% lists:concat([DecFunName,asn1ct:latest_sindex()]),
EmitDecFunCall(DecFunName);
[{Cname,parts}|Rest] ->
asn1ct:update_gen_state(namelist,Rest),
@@ -1401,13 +1370,6 @@ gen_dec_call1(WhatKind, _, TopType, Cname, Type, BytesVar, Tag) ->
mkfuncname(TopType,Cname,WhatKind,"dec_",""),
EmitDecFunCall(DecFunName)
end
-% case {WhatKind,Type#type.tablecinf} of
-% {{constructed,bif},[{objfun,_}|_Rest]} ->
-% emit([DecFunName,"(",BytesVar,", ",{asis,Tag},
-% ", ObjFun)"]);
-% _ ->
-% emit([DecFunName,"(",BytesVar,", ",{asis,Tag},")"])
-% end
end.
@@ -1464,6 +1426,9 @@ print_attribute_comment(InnerType,Pos,Cname,Prop) ->
case InnerType of
#'Externaltypereference'{module=XModule,type=Name} ->
emit([nl,"%% attribute ",Cname,"(",Pos,") External ",XModule,":",Name]);
+ _ when is_tuple(InnerType) ->
+ emit([nl,"%% attribute ",Cname,"(",Pos,") with type "|
+ tuple_to_list(InnerType)]);
_ ->
emit([nl,"%% attribute ",Cname,"(",Pos,") with type ",InnerType])
end,
diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl
index 9cd9864b80..986d88b677 100644
--- a/lib/asn1/src/asn1ct_constructed_per.erl
+++ b/lib/asn1/src/asn1ct_constructed_per.erl
@@ -30,9 +30,8 @@
-export([gen_decode_choice/3]).
-include("asn1_records.hrl").
-%-compile(export_all).
--import(asn1ct_gen, [emit/1,demit/1,get_record_name_prefix/1]).
+-import(asn1ct_gen, [emit/1,get_record_name_prefix/1]).
-type type_name() :: any().
@@ -357,7 +356,6 @@ gen_dec_constructed_imm(Erule, Typename, #type{}=D) ->
#'SEQUENCE'{tablecinf=TCI,components=CL} ->
{add_textual_order(CL),TCI};
#'SET'{tablecinf=TCI,components=CL} ->
-%% {add_textual_order(CL),TCI}
{CL,TCI} % the textual order is already taken care of
end,
Ext = extensible_dec(CompList),
@@ -375,13 +373,11 @@ gen_dec_constructed_imm(Erule, Typename, #type{}=D) ->
end,
ObjSetInfo =
case TableConsInfo of
-%% {ObjectSet,AttrN,N,UniqueFieldName} ->%% N is index of attribute that determines constraint
#simpletableattributes{objectsetname=ObjectSet,
c_name=AttrN,
usedclassfield=UniqueFieldName,
uniqueclassfield=UniqueFieldName,
valueindex=ValIndex} ->
-%% {AttrN,ObjectSet};
F = fun(#'ComponentType'{typespec=CT})->
case {asn1ct_gen:get_constraint(CT#type.constraint,componentrelation),CT#type.tablecinf} of
{no,[{objfun,_}|_R]} -> true;
@@ -686,10 +682,10 @@ gen_decode_choice(Erules,Typename,D) when is_record(D,type) ->
{'CHOICE',CompList} = D#type.def,
Ext = extensible_enc(CompList),
gen_dec_choice(Erules,Typename,CompList,Ext),
- emit({".",nl}).
+ emit([".",nl]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% Encode generator for SEQUENCE OF type
+%% Encode generator for SEQUENCE OF type
gen_encode_sof(Erule, Typename, SeqOrSetOf, D) ->
asn1ct_name:start(),
@@ -781,20 +777,20 @@ gen_decode_sof_components(Erule, Name, Typename, SeqOrSetOf, Cont) ->
case asn1ct_gen:type(Conttype) of
{primitive,bif} ->
asn1ct_gen_per:gen_dec_prim(Erule, Cont, "Bytes"),
- emit({com,nl});
+ emit([com,nl]);
{constructed,bif} ->
NewTypename = [Constructed_Suffix|Typename],
- emit({"'dec_",asn1ct_gen:list2name(NewTypename),
- "'(Bytes",ObjFun,"),",nl});
+ emit([{asis,dec_func(asn1ct_gen:list2name(NewTypename))},
+ "(Bytes",ObjFun,"),",nl]);
#'Externaltypereference'{}=Etype ->
asn1ct_gen_per:gen_dec_external(Etype, "Bytes"),
emit([com,nl]);
'ASN1_OPEN_TYPE' ->
asn1ct_gen_per:gen_dec_prim(Erule, #type{def='ASN1_OPEN_TYPE'},
"Bytes"),
- emit({com,nl});
+ emit([com,nl]);
_ ->
- emit({"'dec_",Conttype,"'(Bytes),",nl})
+ emit([{asis,dec_func(Conttype)},"(Bytes),",nl])
end,
emit([{asis,Name},"(Num-1, Remain",ObjFun,", [Term|Acc]).",nl]).
@@ -934,9 +930,7 @@ add_textual_order({R1,Ext,R2}) ->
{NewExt,Num2} = add_textual_order1(Ext,Num1),
{NewR2,_} = add_textual_order1(R2,Num2),
{NewR1,NewExt,NewR2}.
-%%add_textual_order1(Cs=[#'ComponentType'{textual_order=Int}|_],I)
-%% when is_integer(Int) ->
-%% {Cs,I};
+
add_textual_order1(Cs,NumIn) ->
lists:mapfoldl(fun(C=#'ComponentType'{},Num) ->
{C#'ComponentType'{textual_order=Num},
@@ -1494,9 +1488,9 @@ gen_dec_component_no_val(_, Type, {'DEFAULT',DefVal0}) ->
DefVal = asn1ct_gen:conform_value(Type, DefVal0),
emit([{asis,DefVal}]);
gen_dec_component_no_val(_, _, 'OPTIONAL') ->
- emit({"asn1_NOVALUE"});
+ emit(["asn1_NOVALUE"]);
gen_dec_component_no_val({ext,_,_}, _, mandatory) ->
- emit({"asn1_NOVALUE"}).
+ emit(["asn1_NOVALUE"]).
dec_map_extaddgroup_no_val(Ext, Type, Comp) ->
L0 = [dec_map_extaddgroup_no_val_1(N, P, Ext, Type) ||
@@ -1693,16 +1687,15 @@ gen_dec_line_other(Erule, Atype, TopType, Comp) ->
end;
{constructed,bif} ->
NewTypename = [Cname|TopType],
+ DecFunc = dec_func(asn1ct_gen:list2name(NewTypename)),
case Type#type.tablecinf of
[{objfun,_}|_R] ->
fun(BytesVar) ->
- emit({"'dec_",asn1ct_gen:list2name(NewTypename),
- "'(",BytesVar,", ObjFun)"})
+ emit([{asis,DecFunc},"(",BytesVar,", ObjFun)"])
end;
_ ->
fun(BytesVar) ->
- emit({"'dec_",asn1ct_gen:list2name(NewTypename),
- "'(",BytesVar,")"})
+ emit([{asis,DecFunc},"(",BytesVar,")"])
end
end
end.
@@ -1908,7 +1901,7 @@ emit_extaddgroupTerms(VarSeries,[_]) ->
ok;
emit_extaddgroupTerms(VarSeries,[_|Rest]) ->
asn1ct_name:new(VarSeries),
- emit({{curr,VarSeries},","}),
+ emit([{curr,VarSeries},","]),
emit_extaddgroupTerms(VarSeries,Rest);
emit_extaddgroupTerms(_,[]) ->
ok.
@@ -1990,3 +1983,6 @@ attribute_comment(InnerType, TextPos, Cname) ->
end,
Comment = ["attribute ",Cname,"(",TextPos,") with type ",DispType],
lists:concat(Comment).
+
+dec_func(Tname) ->
+ list_to_atom(lists:concat(["dec_",Tname])).
diff --git a/lib/asn1/src/asn1ct_func.erl b/lib/asn1/src/asn1ct_func.erl
index 0cd72acf9d..016161fcaf 100644
--- a/lib/asn1/src/asn1ct_func.erl
+++ b/lib/asn1/src/asn1ct_func.erl
@@ -65,7 +65,7 @@ generate(Fd) ->
Funcs = sofs:to_external(Funcs0),
ok = file:write(Fd, Funcs).
-is_used({_,_,_}=MFA) ->
+is_used({M,F,A}=MFA) when is_atom(M), is_atom(F), is_integer(A) ->
req({is_used,MFA}).
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl
index 9f628c7b04..fa312ed052 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -22,8 +22,7 @@
-include("asn1_records.hrl").
--export([demit/1,
- emit/1,
+-export([emit/1,
open_output_file/1,close_output_file/0,
get_inner/1,type/1,def_to_tag/1,prim_bif/1,
list2name/1,
@@ -191,13 +190,9 @@ pgen_partial_decode(_, _, _) ->
ok.
pgen_partial_inc_dec(Rtmod,Erules,Module) ->
-% io:format("Start partial incomplete decode gen?~n"),
case asn1ct:get_gen_state_field(inc_type_pattern) of
undefined ->
-% io:format("Partial incomplete decode gen not started: ~w~n",[asn1ct:get_gen_state_field(active)]),
ok;
-% [] ->
-% ok;
ConfList ->
PatternLists=lists:map(fun({_,P}) -> P end,ConfList),
pgen_partial_inc_dec1(Rtmod,Erules,Module,PatternLists),
@@ -215,11 +210,9 @@ pgen_partial_inc_dec1(Rtmod,Erules,Module,[P|Ps]) ->
asn1ct:update_gen_state(prefix,"dec-inc-"),
case asn1ct:maybe_saved_sindex(TopTypeName,P) of
I when is_integer(I),I > 0 ->
-% io:format("Index:~p~n",[I]),
asn1ct:set_current_sindex(I);
_I ->
asn1ct:set_current_sindex(0),
-% io:format("Index=~p~n",[_I]),
ok
end,
Rtmod:gen_decode(Erules,TypeDef),
@@ -250,8 +243,8 @@ gen_partial_inc_dec_refed_funcs(Rtmod, #gen{erule=ber}=Gen) ->
pgen_partial_dec(_Rtmod,Erules,_Module) ->
Type_pattern = asn1ct:get_gen_state_field(type_pattern),
-% io:format("Type_pattern: ~w~n",[Type_pattern]),
- %% Get the typedef of the top type and follow into the choosen components until the last type/component.
+ %% Get the typedef of the top type and follow into the choosen
+ %% components until the last type/component.
pgen_partial_types(Erules,Type_pattern),
ok.
@@ -266,7 +259,6 @@ pgen_partial_types(#gen{options=Options}=Gen, TypePattern) ->
pgen_partial_types1(Erules,[{FuncName,[TopType|RestTypes]}|Rest]) ->
-% emit([FuncName,"(Bytes) ->",nl]),
CurrMod = get(currmod),
TypeDef = asn1_db:dbget(CurrMod,TopType),
traverse_type_structure(Erules,TypeDef,RestTypes,FuncName,
@@ -291,8 +283,9 @@ traverse_type_structure(Erules,Type,[],FuncName,TopTypeName) ->
end,
Ctmod:gen_decode_selected(Erules,TypeDef,FuncName); % what if Type is #type{}
traverse_type_structure(Erules,#type{def=Def},[[N]],FuncName,TopTypeName)
- when is_integer(N) -> % this case a decode of one of the elements in
- % the SEQUENCE OF is required.
+ when is_integer(N) ->
+ %% In this case a decode of one of the elements in the SEQUENCE OF is
+ %% required.
InnerType = asn1ct_gen:get_inner(Def),
case InnerType of
'SEQUENCE OF' ->
@@ -368,8 +361,9 @@ traverse_type_structure(Erules,#typedef{typespec=Def},[T|Ts],FuncName,
TypeDef = asn1_db:dbget(M,TName),
traverse_type_structure(Erules,TypeDef,[T|Ts],FuncName,
[TypeDef#typedef.name]);
- _ -> %this may be a referenced type that shall be traversed or
- %the selected type
+ _ ->
+ %% This may be a referenced type that shall be traversed
+ %% or the selected type
traverse_type_structure(Erules,Def,Ts,FuncName,[T|TopTypeName])
end.
@@ -384,9 +378,7 @@ get_component(Name,{C1,C2}) when is_list(C1),is_list(C2) ->
get_component(Name,[C=#'ComponentType'{name=Name}|_Cs]) ->
C;
get_component(Name,[_C|Cs]) ->
- get_component(Name,Cs);
-get_component(Name,_) ->
- throw({error,{asn1,{internal_error,Name}}}).
+ get_component(Name,Cs).
%% generate code for all inner types that are called from the top type
%% of the partial incomplete decode and are defined within the top
@@ -451,7 +443,6 @@ pgen_partial_incomplete_decode1(#gen{erule=ber}) ->
lists:foreach(fun emit_partial_incomplete_decode/1,Data)
end,
GeneratedFs= asn1ct:get_gen_state_field(gen_refed_funcs),
-% io:format("GeneratedFs :~n~p~n",[GeneratedFs]),
gen_part_decode_funcs(GeneratedFs,0);
pgen_partial_incomplete_decode1(#gen{}) -> ok.
@@ -604,9 +595,7 @@ gen_encode_constructed(Erules,Typename,InnerType,D) when is_record(D,type) ->
Rtmod:gen_encode_sof(Erules,Typename,InnerType,D),
{_,Type} = D#type.def,
NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def),
- gen_types(Erules, [NameSuffix|Typename], Type, gen_encode);
- _ ->
- exit({nyi,InnerType})
+ gen_types(Erules, [NameSuffix|Typename], Type, gen_encode)
end;
gen_encode_constructed(Erules,Typename,InnerType,D)
when is_record(D,typedef) ->
@@ -879,7 +868,6 @@ gen_partial_inc_dispatcher(#gen{erule=ber}) ->
{_,undefined} ->
ok;
{Data1,Data2} ->
-% io:format("partial_incomplete_decode: ~p~ninc_type_pattern: ~p~n",[Data,Data2]),
gen_partial_inc_dispatcher(Data1, Data2, "")
end;
gen_partial_inc_dispatcher(#gen{}) ->
@@ -954,71 +942,39 @@ hrl_protector(OutFile) ->
end || C <- P].
-%% EMIT functions ************************
-%% ***************************************
-
- % debug generation
-demit(Term) ->
- case get(asndebug) of
- true -> emit(Term);
- _ ->true
- end.
-
- % always generation
emit(Term) ->
ok = file:write(get(gen_file_out), do_emit(Term)).
-do_emit({external,_M,T}) ->
- do_emit(T);
-
do_emit({prev,Variable}) when is_atom(Variable) ->
do_emit({var,asn1ct_name:prev(Variable)});
-
do_emit({next,Variable}) when is_atom(Variable) ->
do_emit({var,asn1ct_name:next(Variable)});
-
do_emit({curr,Variable}) when is_atom(Variable) ->
do_emit({var,asn1ct_name:curr(Variable)});
-
do_emit({var,Variable}) when is_atom(Variable) ->
[Head|V] = atom_to_list(Variable),
[Head-32|V];
-
-do_emit({var,Variable}) ->
- [Head|V] = Variable,
- [Head-32|V];
-
do_emit({asis,What}) ->
io_lib:format("~w", [What]);
-
do_emit({call,M,F,A}) ->
MFA = {M,F,length(A)},
asn1ct_func:need(MFA),
[atom_to_list(F),"(",call_args(A, "")|")"];
-
do_emit(nl) ->
"\n";
-
do_emit(com) ->
",";
-
-do_emit(tab) ->
- " ";
-
+do_emit([C|_]=Str) when is_integer(C) ->
+ Str;
+do_emit([_|_]=L) ->
+ [do_emit(E) || E <- L];
+do_emit([]) ->
+ [];
do_emit(What) when is_integer(What) ->
integer_to_list(What);
-
-do_emit(What) when is_list(What), is_integer(hd(What)) ->
- What;
-
do_emit(What) when is_atom(What) ->
- atom_to_list(What);
+ atom_to_list(What).
-do_emit(What) when is_tuple(What) ->
- [do_emit(E) || E <- tuple_to_list(What)];
-
-do_emit(What) when is_list(What) ->
- [do_emit(E) || E <- What].
call_args([A|As], Sep) ->
[Sep,do_emit(A)|call_args(As, ", ")];
@@ -1124,8 +1080,6 @@ gen_record(Gen, TorPtype, Name, #type{}=Type, Num) ->
case Seq#'SEQUENCE'.pname of
false ->
{record,Seq#'SEQUENCE'.components};
-%% _Pname when TorPtype == type ->
-%% false;
_ ->
{record,Seq#'SEQUENCE'.components}
end;
@@ -1138,8 +1092,6 @@ gen_record(Gen, TorPtype, Name, #type{}=Type, Num) ->
_ ->
{record,to_textual_order(Set#'SET'.components)}
end;
-% {'SET',{_,_CompList}} ->
-% {record,_CompList};
{'CHOICE',_CompList} -> {inner,Def};
{'SEQUENCE OF',_CompList} -> {['SEQOF'|Name],Def};
{'SET OF',_CompList} -> {['SETOF'|Name],Def};
@@ -1345,7 +1297,6 @@ get_inner({fixedtypevaluefield,_,Type}) ->
get_inner({typefield,TypeName}) ->
TypeName;
get_inner(#'ObjectClassFieldType'{type=Type}) ->
-% get_inner(Type);
Type;
get_inner(T) when is_tuple(T) ->
case element(1,T) of
@@ -1354,9 +1305,7 @@ get_inner(T) when is_tuple(T) ->
{valuefieldreference,FieldName} ->
get_fieldtype(element(2,Tuple),FieldName);
{typefieldreference,FieldName} ->
- get_fieldtype(element(2,Tuple),FieldName);
- {'EXIT',Reason} ->
- throw({asn1,{'internal error in get_inner/1',Reason}})
+ get_fieldtype(element(2,Tuple),FieldName)
end;
_ -> element(1,T)
end.
diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
index 6c6d4193f3..948566a6fc 100644
--- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
+++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
@@ -35,21 +35,21 @@
-export([extaddgroup2sequence/1]).
-export([dialyzer_suppressions/1]).
--import(asn1ct_gen, [emit/1,demit/1]).
+-import(asn1ct_gen, [emit/1]).
- % the encoding of class of tag bits 8 and 7
+%% The encoding of class of tag bits 8 and 7
-define(UNIVERSAL, 0).
-define(APPLICATION, 16#40).
-define(CONTEXT, 16#80).
-define(PRIVATE, 16#C0).
- % primitive or constructed encoding % bit 6
+%% Primitive or constructed encoding % bit 6
-define(PRIMITIVE, 0).
-define(CONSTRUCTED, 2#00100000).
-define(T_ObjectDescriptor, ?UNIVERSAL bor ?PRIMITIVE bor 7).
- % restricted character string types
+%% Restricted character string types
-define(T_NumericString, ?UNIVERSAL bor ?PRIMITIVE bor 18). %can be constructed
-define(T_PrintableString, ?UNIVERSAL bor ?PRIMITIVE bor 19). %can be constructed
-define(T_TeletexString, ?UNIVERSAL bor ?PRIMITIVE bor 20). %can be constructed
@@ -107,20 +107,12 @@ gen_encode(Erules,Typename,Type) when is_record(Type,type) ->
case asn1ct_gen:type(InnerType) of
{constructed,bif} ->
- emit([nl,nl,nl,"%%================================"]),
- emit([nl,"%% ",asn1ct_gen:list2name(Typename)]),
- emit([nl,"%%================================",nl]),
- case length(Typename) of
- 1 -> % top level type
- emit(["'enc_",asn1ct_gen:list2name(Typename),
- "'(Val",ObjFun,") ->",nl]),
- emit([" 'enc_",asn1ct_gen:list2name(Typename),
- "'(Val, ", {asis,lists:reverse(Type#type.tag)},ObjFun,").",nl,nl]);
- _ -> % embedded type with constructed name
- true
- end,
- emit(["'enc_",asn1ct_gen:list2name(Typename),
- "'(Val, TagIn",ObjFun,") ->",nl," "]),
+ Func = {asis,enc_func(asn1ct_gen:list2name(Typename))},
+ emit([nl,nl,nl,"%%================================",nl,
+ "%% ",asn1ct_gen:list2name(Typename),nl,
+ "%%================================",nl,
+ Func,"(Val, TagIn",ObjFun,") ->",nl,
+ " "]),
asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type);
_ ->
true
@@ -146,7 +138,7 @@ gen_encode_user(Erules, #typedef{}=D, Wrapper) ->
emit([nl,nl,"%%================================"]),
emit([nl,"%% ",Typename]),
emit([nl,"%%================================",nl]),
- FuncName = "'enc_" ++ asn1ct_gen:list2name(Typename) ++ "'",
+ FuncName = {asis,enc_func(asn1ct_gen:list2name(Typename))},
case Wrapper of
true ->
%% This is a top-level type. Generate an 'enc_Type'/1
@@ -169,9 +161,10 @@ gen_encode_user(Erules, #typedef{}=D, Wrapper) ->
gen_encode_prim(ber,Type,"TagIn","Val"),
emit([".",nl]);
#'Externaltypereference'{module=CurrentMod,type=Etype} ->
- emit([" 'enc_",Etype,"'(Val, TagIn).",nl]);
+ emit([" ",{asis,enc_func(Etype)},"(Val, TagIn).",nl]);
#'Externaltypereference'{module=Emod,type=Etype} ->
- emit([" '",Emod,"':'enc_",Etype,"'(Val, TagIn).",nl]);
+ emit([" ",{asis,Emod},":",{asis,enc_func(Etype)},
+ "(Val, TagIn).",nl]);
'ASN1_OPEN_TYPE' ->
emit(["%% OPEN TYPE",nl]),
gen_encode_prim(ber,
@@ -326,40 +319,39 @@ gen_decode(Erules,Type) when is_record(Type,typedef) ->
Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || X <- InnerTag],
- FunctionName =
+ FuncName0 =
case {asn1ct:get_gen_state_field(active),
asn1ct:get_gen_state_field(prefix)} of
{true,Pref} ->
%% prevent duplicated function definitions
-% Pattern = asn1ct:get_gen_state_field(namelist),
-% FuncName=asn1ct:maybe_rename_function(Type#typedef.name,
-% Pattern),
case asn1ct:current_sindex() of
- I when is_integer(I),I>0 ->
- lists:concat([Pref,Type#typedef.name,"_",I]);
+ I when is_integer(I), I > 0 ->
+ [Pref,Type#typedef.name,"_",I];
_->
- lists:concat([Pref,Type#typedef.name])
- end; % maybe the current_sindex must be reset
- _ -> lists:concat(["dec_",Type#typedef.name])
+ [Pref,Type#typedef.name]
+ end;
+ {_,_} ->
+ ["dec_",Type#typedef.name]
end,
- emit({nl,nl}),
- emit(["'",FunctionName,"'(Tlv) ->",nl]),
- emit([" '",FunctionName,"'(Tlv, ",{asis,Tag},").",nl,nl]),
- emit(["'",FunctionName,"'(Tlv, TagIn) ->",nl]),
- dbdec(Type#typedef.name,"Tlv"),
+ FuncName = {asis,list_to_atom(lists:concat(FuncName0))},
+ emit([nl,nl,
+ FuncName,"(Tlv) ->",nl,
+ " ",FuncName,"(Tlv, ",{asis,Tag},").",nl,nl,
+ FuncName,"(Tlv, TagIn) ->",nl]),
gen_decode_user(Erules,Type).
gen_inc_decode(Erules,Type) when is_record(Type,typedef) ->
Prefix = asn1ct:get_gen_state_field(prefix),
Suffix = asn1ct_gen:index2suffix(asn1ct:current_sindex()),
- emit({nl,nl}),
- emit(["'",Prefix,Type#typedef.name,Suffix,"'(Tlv, TagIn) ->",nl]),
+ FuncName0 = [Prefix,Type#typedef.name,Suffix],
+ FuncName = {asis,list_to_atom(lists:concat(FuncName0))},
+ emit([nl,nl,
+ FuncName,"(Tlv, TagIn) ->",nl]),
gen_decode_user(Erules,Type).
%% gen_decode_selected exported function for selected decode
gen_decode_selected(Erules,Type,FuncName) ->
emit([FuncName,"(Bin) ->",nl]),
-% Pattern = asn1ct:get_gen_state_field(tag_pattern),
Patterns = asn1ct:read_config_data(partial_decode),
Pattern =
case lists:keysearch(FuncName,1,Patterns) of
@@ -398,12 +390,10 @@ gen_decode_selected_type(_Erules,TypeDef) ->
asn1ct_gen:list2name(TopType),"'"]),
emit([DecFunName,"(",BytesVar,
", ",{asis,Tag},")"]);
-% emit([";",nl]);
TheType ->
DecFunName = mkfuncname(TheType,dec),
emit([DecFunName,"(",BytesVar,
", ",{asis,Tag},")"])
-% emit([";",nl])
end.
%%===============================================================================
@@ -418,7 +408,6 @@ gen_decode(Erules,Typename,Type) when is_record(Type,type) ->
FunctionName =
case asn1ct:get_gen_state_field(active) of
true ->
-% Suffix = asn1ct_gen:index2suffix(SIndex),
Pattern = asn1ct:get_gen_state_field(namelist),
Suffix =
case asn1ct:maybe_saved_sindex(Typename,Pattern) of
@@ -431,8 +420,6 @@ gen_decode(Erules,Typename,Type) when is_record(Type,type) ->
_ ->
lists:concat(["'dec_",asn1ct_gen:list2name(Typename)])
end,
-% io:format("Typename: ~p,~n",[Typename]),
-% io:format("FunctionName: ~p~n",[FunctionName]),
case asn1ct_gen:type(InnerType) of
{constructed,bif} ->
ObjFun =
@@ -442,9 +429,7 @@ gen_decode(Erules,Typename,Type) when is_record(Type,type) ->
_ ->
""
end,
-% emit([Prefix,asn1ct_gen:list2name(Typename),"'(Tlv, TagIn",ObjFun,") ->",nl]),
emit([FunctionName,"'(Tlv, TagIn",ObjFun,") ->",nl]),
- dbdec(Typename,"Tlv"),
asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type);
Rec when is_record(Rec,'Externaltypereference') ->
case {Typename,asn1ct:get_gen_state_field(namelist)} of
@@ -476,10 +461,10 @@ gen_decode(Erules,Typename,Type) when is_record(Type,type) ->
gen_decode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) ->
NewTname = [Cname|Tname],
- %% The tag is set to [] to avoid that it is
- %% taken into account twice, both as a component/alternative (passed as
- %% argument to the encode decode function and within the encode decode
- %% function it self.
+ %% The tag is set to [] to avoid that it is taken into account
+ %% twice, both as a component/alternative (passed as argument to
+ %% the encode/decode function), and within the encode decode
+ %% function itself.
NewType = Type#type{tag=[]},
case {asn1ct:get_gen_state_field(active),
asn1ct:get_tobe_refed_func(NewTname)} of
@@ -504,7 +489,7 @@ gen_decode_user(Erules,D) when is_record(D,typedef) ->
asn1ct_name:new(len),
gen_dec_prim(Def#type{def='ASN1_OPEN_TYPE'},
BytesVar, {string,"TagIn"}),
- emit({".",nl,nl});
+ emit([".",nl,nl]);
{primitive,bif} ->
asn1ct_name:new(len),
gen_dec_prim(Def, BytesVar, {string,"TagIn"}),
@@ -515,8 +500,7 @@ gen_decode_user(Erules,D) when is_record(D,typedef) ->
TheType ->
DecFunName = mkfuncname(TheType,dec),
emit([DecFunName,"(",BytesVar,
- ", TagIn)"]),
- emit([".",nl,nl])
+ ", TagIn).",nl,nl])
end.
@@ -746,9 +730,10 @@ gen_obj_code(Erules,_Module,Obj) when is_record(Obj,typedef) ->
#'Externaltypereference'{module=M,type=ClName} = Def#'Object'.classname,
Class = asn1_db:dbget(M,ClName),
{object,_,Fields} = Def#'Object'.def,
- emit({nl,nl,nl,"%%================================"}),
- emit({nl,"%% ",ObjName}),
- emit({nl,"%%================================",nl}),
+ emit([nl,nl,nl,
+ "%%================================",nl,
+ "%% ",ObjName,nl,
+ "%%================================",nl]),
EncConstructed =
gen_encode_objectfields(ClName,get_class_fields(Class),
ObjName,Fields,[]),
@@ -766,11 +751,9 @@ gen_encode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
ObjName,ObjectFields,ConstrAcc) ->
EmitFuncClause =
fun(Arg) ->
- emit(["'enc_",ObjName,"'(",{asis,Name},
- ", ",Arg,", _RestPrimFieldName) ->",nl])
+ emit([{asis,enc_func(ObjName)},"(",{asis,Name},
+ ", ",Arg,", _RestPrimFieldName) ->",nl])
end,
-% emit(["'enc_",ObjName,"'(",{asis,Name},
-% ", Val, RestPrimFieldName) ->",nl]),
MaybeConstr=
case {get_object_field(Name,ObjectFields),OptOrMand} of
{false,'OPTIONAL'} ->
@@ -799,11 +782,9 @@ gen_encode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
CurrentMod = get(currmod),
EmitFuncClause =
fun(Args) ->
- emit(["'enc_",ObjName,"'(",{asis,Name},
+ emit([{asis,enc_func(ObjName)},"(",{asis,Name},
", ",Args,") ->",nl])
end,
-% emit(["'enc_",ObjName,"'(",{asis,Name},
-% ", Val,[H|T]) ->",nl]),
case {get_object_field(Name,ObjectFields),OptOrMand} of
{false,'OPTIONAL'} ->
EmitFuncClause("_,_"),
@@ -814,19 +795,14 @@ gen_encode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
{{Name,#'Externalvaluereference'{module=CurrentMod,
value=TypeName}},_} ->
EmitFuncClause(" Val, [H|T]"),
- emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"});
+ emit([indent(3),{asis,enc_func(TypeName)},"(H, Val, T)"]);
{{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} ->
EmitFuncClause(" Val, [H|T]"),
- emit({indent(3),"'",M,"':'enc_",TypeName,"'(H, Val, T)"});
- {{Name,TypeSpec},_} ->
+ emit([indent(3),{asis,M},":",{asis,enc_func(TypeName)},
+ "(H, Val, T)"]);
+ {{Name,#typedef{name=TypeName}},_} when is_atom(TypeName) ->
EmitFuncClause(" Val, [H|T]"),
- case TypeSpec#typedef.name of
- {ExtMod,TypeName} ->
- emit({indent(3),"'",ExtMod,"':'enc_",TypeName,
- "'(H, Val, T)"});
- TypeName ->
- emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"})
- end
+ emit([indent(3),{asis,enc_func(TypeName)},"(H, Val, T)"])
end,
case more_genfields(Rest) of
true ->
@@ -862,10 +838,11 @@ gen_encode_field_call(_ObjName,_FieldName,
X <- OTag],
if
M == CurrentMod ->
- emit({" 'enc_",T,"'(Val, ",{asis,Tag},")"}),
+ emit([" ",{asis,enc_func(T)},"(Val, ",{asis,Tag},")"]),
[];
true ->
- emit({" '",M,"':'enc_",T,"'(Val, ",{asis,Tag},")"}),
+ emit([" ",{asis,M},":",{asis,enc_func(T)},
+ "(Val, ",{asis,Tag},")"]),
[]
end;
gen_encode_field_call(ObjName,FieldName,Type) ->
@@ -875,24 +852,21 @@ gen_encode_field_call(ObjName,FieldName,Type) ->
X#tag.form,X#tag.number)||
X <- OTag],
case Type#typedef.name of
- {primitive,bif} -> %%tag should be the primitive tag
-% OTag = Def#type.tag,
-% Tag = [encode_tag_val(decode_class(X#tag.class),
-% X#tag.form,X#tag.number)||
-% X <- OTag],
+ {primitive,bif} -> %tag should be the primitive tag
gen_encode_prim(ber,Def,{asis,lists:reverse(Tag)},
"Val"),
[];
{constructed,bif} ->
- emit({" 'enc_",ObjName,'_',FieldName,
- "'(Val,",{asis,Tag},")"}),
- [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}];
+ Name = lists:concat([ObjName,'_',FieldName]),
+ emit([" ",{asis,enc_func(Name)},"(Val,",{asis,Tag},")"]),
+ [Type#typedef{name=list_to_atom(Name)}];
{ExtMod,TypeName} ->
- emit({" '",ExtMod,"':'enc_",TypeName,
- "'(Val,",{asis,Tag},")"}),
+ emit([" ",{asis,ExtMod},":",{asis,enc_func(TypeName)},
+ "(Val,",{asis,Tag},")"]),
[];
TypeName ->
- emit({" 'enc_",TypeName,"'(Val,",{asis,Tag},")"}),
+ emit([" ",{asis,enc_func(TypeName)},
+ "(Val,",{asis,Tag},")"]),
[]
end.
@@ -903,10 +877,10 @@ gen_encode_default_call(ClassName,FieldName,Type) ->
Tag = [encode_tag_val(decode_class(X#tag.class),X#tag.form,X#tag.number)|| X <- OTag],
case asn1ct_gen:type(InnerType) of
{constructed,bif} ->
- emit([" 'enc_",ClassName,'_',FieldName,"'",
+ Name = lists:concat([ClassName,'_',FieldName]),
+ emit([" ",{asis,enc_func(Name)},
"(Val, ",{asis,Tag},")"]),
- [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])),
- typespec=Type}];
+ [#typedef{name=list_to_atom(Name),typespec=Type}];
{primitive,bif} ->
gen_encode_prim(ber,Type,{asis,lists:reverse(Tag)},"Val"),
[];
@@ -916,12 +890,6 @@ gen_encode_default_call(ClassName,FieldName,Type) ->
#'Externaltypereference'{module=Emod,type=Etype} ->
emit([" '",Emod,"':'enc_",Etype,"'(Val, ",{asis,Tag},")",nl]),
[]
-% 'ASN1_OPEN_TYPE' ->
-% emit(["%% OPEN TYPE",nl]),
-% gen_encode_prim(ber,
-% Type#type{def='ASN1_OPEN_TYPE'},
-% "TagIn","Val"),
-% emit([".",nl])
end.
%%%%%%%%%%%%%%%%
@@ -930,11 +898,9 @@ gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
ObjName,ObjectFields,ConstrAcc) ->
EmitFuncClause =
fun(Arg) ->
- emit(["'dec_",ObjName,"'(",{asis,Name},
+ emit([{asis,dec_func(ObjName)},"(",{asis,Name},
", ",Arg,",_) ->",nl])
end,
-% emit(["'dec_",ObjName,"'(",{asis,Name},
-% ", Bytes, RestPrimFieldName) ->",nl]),
MaybeConstr=
case {get_object_field(Name,ObjectFields),OptOrMand} of
{false,'OPTIONAL'} ->
@@ -964,12 +930,9 @@ gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
CurrentMod = get(currmod),
EmitFuncClause =
fun(Args) ->
- emit(["'dec_",ObjName,"'(",{asis,Name},
+ emit([{asis,dec_func(ObjName)},"(",{asis,Name},
", ",Args,") ->",nl])
end,
-% emit(["'dec_",ObjName,"'(",{asis,Name},
-% ", Bytes,[H|T]) ->",nl]),
-% emit_tlv_format("Bytes"),
case {get_object_field(Name,ObjectFields),OptOrMand} of
{false,'OPTIONAL'} ->
EmitFuncClause("_,_"),
@@ -980,21 +943,14 @@ gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
{{Name,#'Externalvaluereference'{module=CurrentMod,
value=TypeName}},_} ->
EmitFuncClause("Bytes,[H|T]"),
- emit({indent(3),"'dec_",TypeName,"'(H, Bytes, T)"});
+ emit([indent(3),{asis,dec_func(TypeName)},"(H, Bytes, T)"]);
{{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} ->
EmitFuncClause("Bytes,[H|T]"),
- emit({indent(3),"'",M,"':'dec_",TypeName,
- "'(H, Bytes, T)"});
- {{Name,TypeSpec},_} ->
- EmitFuncClause("Bytes,[H|T]"),
-% emit_tlv_format("Bytes"),
- case TypeSpec#typedef.name of
- {ExtMod,TypeName} ->
- emit({indent(3),"'",ExtMod,"':'dec_",TypeName,
- "'(H, Bytes, T)"});
- TypeName ->
- emit({indent(3),"'dec_",TypeName,"'(H, Bytes, T)"})
- end
+ emit([indent(3),{asis,M},":",{asis,dec_func(TypeName)},
+ "(H, Bytes, T)"]);
+ {{Name,#typedef{name=TypeName}},_} when is_atom(TypeName) ->
+ EmitFuncClause("Bytes,[H|T]"),
+ emit([indent(3),{asis,dec_func(TypeName)},"(H, Bytes, T)"])
end,
case more_genfields(Rest) of
true ->
@@ -1014,24 +970,20 @@ emit_tlv_format(Bytes) ->
notice_tlv_format_gen() ->
Module = get(currmod),
-% io:format("Noticed: ~p~n",[Module]),
case get(tlv_format) of
{done,Module} ->
ok;
- _ -> % true or undefined
+ _ -> % true or undefined
put(tlv_format,true)
end.
emit_tlv_format_function() ->
Module = get(currmod),
-% io:format("Tlv formated: ~p",[Module]),
case get(tlv_format) of
true ->
-% io:format(" YES!~n"),
emit_tlv_format_function1(),
put(tlv_format,{done,Module});
_ ->
-% io:format(" NO!~n"),
ok
end.
emit_tlv_format_function1() ->
@@ -1066,12 +1018,12 @@ gen_decode_field_call(_ObjName,_FieldName,Bytes,
X <- OTag],
if
M == CurrentMod ->
- emit({" 'dec_",T,"'(",Bytes,
- ", ",{asis,Tag},")"}),
+ emit([" ",{asis,dec_func(T)},"(",Bytes,
+ ", ",{asis,Tag},")"]),
[];
true ->
- emit({" '",M,"':'dec_",T,
- "'(",Bytes,", ",{asis,Tag},")"}),
+ emit([" ",{asis,M},":",{asis,dec_func(T)},
+ "(",Bytes,", ",{asis,Tag},")"]),
[]
end;
gen_decode_field_call(ObjName,FieldName,Bytes,Type) ->
@@ -1084,15 +1036,17 @@ gen_decode_field_call(ObjName,FieldName,Bytes,Type) ->
gen_dec_prim(Def, Bytes, Tag),
[];
{constructed,bif} ->
- emit({" 'dec_",ObjName,'_',FieldName,
- "'(",Bytes,",",{asis,Tag},")"}),
- [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}];
+ Name = lists:concat([ObjName,"_",FieldName]),
+ emit([" ",{asis,dec_func(Name)},
+ "(",Bytes,",",{asis,Tag},")"]),
+ [Type#typedef{name=list_to_atom(Name)}];
{ExtMod,TypeName} ->
- emit({" '",ExtMod,"':'dec_",TypeName,
- "'(",Bytes,",",{asis,Tag},")"}),
+ emit([" ",{asis,ExtMod},":",{asis,dec_func(TypeName)},
+ "(",Bytes,",",{asis,Tag},")"]),
[];
TypeName ->
- emit({" 'dec_",TypeName,"'(",Bytes,",",{asis,Tag},")"}),
+ emit([" ",{asis,dec_func(TypeName)},
+ "(",Bytes,",",{asis,Tag},")"]),
[]
end.
@@ -1118,12 +1072,6 @@ gen_decode_default_call(ClassName,FieldName,Bytes,Type) ->
emit([" '",Emod,"':'dec_",Etype,"'(",Bytes,", ",
{asis,Tag},")",nl]),
[]
-% 'ASN1_OPEN_TYPE' ->
-% emit(["%% OPEN TYPE",nl]),
-% gen_encode_prim(ber,
-% Type#type{def='ASN1_OPEN_TYPE'},
-% "TagIn","Val"),
-% emit([".",nl])
end.
%%%%%%%%%%%
@@ -1162,15 +1110,15 @@ more_genfields([Field|Fields]) ->
gen_objectset_code(Erules,ObjSet) ->
ObjSetName = ObjSet#typedef.name,
Def = ObjSet#typedef.typespec,
-% {ClassName,ClassDef} = Def#'ObjectSet'.class,
#'Externaltypereference'{module=ClassModule,
type=ClassName} = Def#'ObjectSet'.class,
ClassDef = asn1_db:dbget(ClassModule,ClassName),
UniqueFName = Def#'ObjectSet'.uniquefname,
Set = Def#'ObjectSet'.set,
- emit({nl,nl,nl,"%%================================"}),
- emit({nl,"%% ",ObjSetName}),
- emit({nl,"%%================================",nl}),
+ emit([nl,nl,nl,
+ "%%================================",nl,
+ "%% ",ObjSetName,nl,
+ "%%================================",nl]),
case ClassName of
{_Module,ExtClassName} ->
gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ExtClassName,ClassDef);
@@ -1200,19 +1148,20 @@ gen_objset_enc(Erules, ObjSetName, UniqueName,
{no_mod,no_name} ->
gen_inlined_enc_funs(Fields, ClFields, ObjSetName, Val, NthObj);
{CurrMod,Name} ->
- emit(["'getenc_",ObjSetName,"'(Id) when Id =:= ",
- {asis,Val}," ->",nl,
- " fun 'enc_",Name,"'/3;",nl]),
+ emit([asis_atom(["getenc_",ObjSetName]),
+ "(Id) when Id =:= ",{asis,Val}," ->",nl,
+ " fun ",asis_atom(["enc_",Name]),"/3;",nl]),
{[],NthObj};
{ModuleName,Name} ->
- emit(["'getenc_",ObjSetName,"'(Id) when Id =:= ",
- {asis,Val}," ->",nl]),
+ emit([asis_atom(["getenc_",ObjSetName]),
+ "(Id) when Id =:= ",{asis,Val}," ->",nl]),
emit_ext_fun(enc,ModuleName,Name),
emit([";",nl]),
{[],NthObj};
_ ->
- emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl,
- " fun 'enc_",ObjName,"'/3;",nl]),
+ emit([asis_atom(["getenc_",ObjSetName]),
+ "(",{asis,Val},") ->",nl,
+ " fun ",asis_atom(["enc_",ObjName]),"/3;",nl]),
{[],NthObj}
end,
gen_objset_enc(Erules, ObjSetName, UniqueName, T, ClName, ClFields,
@@ -1220,7 +1169,7 @@ gen_objset_enc(Erules, ObjSetName, UniqueName,
%% See X.681 Annex E for the following case
gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
_ClFields,_NthObj,Acc) ->
- emit(["'getenc_",ObjSetName,"'(_) ->",nl,
+ emit([asis_atom(["getenc_",ObjSetName]),"(_) ->",nl,
indent(2),"fun(_, Val, _RestPrimFieldName) ->",nl]),
emit_enc_open_type(4),
emit([nl,
@@ -1228,7 +1177,7 @@ gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
Acc;
gen_objset_enc(_, ObjSetName, UniqueName, [], _, _, _, Acc) ->
emit_default_getenc(ObjSetName, UniqueName),
- emit({".",nl,nl}),
+ emit([".",nl,nl]),
Acc.
emit_ext_fun(EncDec,ModuleName,Name) ->
@@ -1236,14 +1185,15 @@ emit_ext_fun(EncDec,ModuleName,Name) ->
Name,"'(T,V,O) end"]).
emit_default_getenc(ObjSetName,UniqueName) ->
- emit(["'getenc_",ObjSetName,"'(ErrV) ->",nl]),
- emit([indent(3),"fun(C,V,_) -> exit({'Type not compatible with table constraint',{component,C},{value,V}, {unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]).
+ emit([asis_atom(["getenc_",ObjSetName]),"(ErrV) ->",nl,
+ indent(3),"fun(C,V,_) ->",nl,
+ "exit({'Type not compatible with table constraint',{component,C},{value,V}, {unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]).
%% gen_inlined_enc_funs for each object iterates over all fields of a
%% class, and for each typefield it checks if the object has that
%% field and emits the proper code.
gen_inlined_enc_funs(Fields, [{typefield,_,_}|_]=T, ObjSetName, Val, NthObj) ->
- emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl,
+ emit([asis_atom(["getenc_",ObjSetName]),"(",{asis,Val},") ->",nl,
indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl,
indent(6),"case Type of",nl]),
gen_inlined_enc_funs1(Fields, T, ObjSetName, [], NthObj, []);
@@ -1283,8 +1233,8 @@ gen_inlined_enc_funs1(Fields, [{typefield,Name,_}|Rest], ObjSetName,
end,
{Acc0,0};
false ->
- %% This field was not present in the object thus there
- %% were no type in the table and we therefore generate
+ %% This field was not present in the object; thus, there
+ %% was no type in the table and we therefore generate
%% code that returns the input for application
%% treatment.
emit([indent(9),{asis,Name}," ->",nl]),
@@ -1322,7 +1272,6 @@ emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type},
InternalDefFunName) ->
OTag = Type#type.tag,
Tag = [encode_tag_val(decode_class(X#tag.class),X#tag.form,X#tag.number)|| X <- OTag],
-% remove Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
case {ExtMod,Name} of
{primitive,bif} ->
emit(indent(12)),
@@ -1333,20 +1282,14 @@ emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type},
InternalDefFunName,"'(Val, ",{asis,Tag},")"]),
{[TDef#typedef{name=InternalDefFunName}],1};
_ ->
- emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val",{asis,Tag},")"}),
+ emit([indent(12),"'",ExtMod,"':'enc_",Name,"'(Val",{asis,Tag},")"]),
{[],0}
end;
emit_inner_of_fun(#typedef{name=Name},_) ->
-% OTag = Type#type.tag,
-% remove Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
-% Tag = [encode_tag_val(decode_class(X#tag.class),X#tag.form,X#tag.number)|| X <- OTag],
- emit({indent(12),"'enc_",Name,"'(Val)"}),
+ emit([indent(12),"'enc_",Name,"'(Val)"]),
{[],0};
emit_inner_of_fun(Type,_) when is_record(Type,type) ->
CurrMod = get(currmod),
-% OTag = Type#type.tag,
-% remove Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
-% Tag = [encode_tag_val(decode_class(X#tag.class),X#tag.form,X#tag.number)|| X <- OTag],
case Type#type.def of
Def when is_atom(Def) ->
OTag = Type#type.tag,
@@ -1384,18 +1327,19 @@ gen_objset_dec(Erules, ObjSName, UniqueName, [{ObjName,Val,Fields}|T],
{no_mod,no_name} ->
gen_inlined_dec_funs(Fields,ClFields,ObjSName,Val,NthObj);
{CurrMod,Name} ->
- emit(["'getdec_",ObjSName,"'(Id) when Id =:= ",
- {asis,Val}," ->",nl,
+ emit([asis_atom(["getdec_",ObjSName]),
+ "(Id) when Id =:= ",{asis,Val}," ->",nl,
" fun 'dec_",Name,"'/3;", nl]),
NthObj;
{ModuleName,Name} ->
- emit(["'getdec_",ObjSName,"'(Id) when Id =:= ",
- {asis,Val}," ->",nl]),
+ emit([asis_atom(["getdec_",ObjSName]),
+ "(Id) when Id =:= ",{asis,Val}," ->",nl]),
emit_ext_fun(dec,ModuleName,Name),
emit([";",nl]),
NthObj;
_ ->
- emit(["'getdec_",ObjSName,"'(",{asis,Val},") ->",nl,
+ emit([asis_atom(["getdec_",ObjSName]),
+ "(",{asis,Val},") ->",nl,
" fun 'dec_",ObjName,"'/3;", nl]),
NthObj
end,
@@ -1403,8 +1347,8 @@ gen_objset_dec(Erules, ObjSName, UniqueName, [{ObjName,Val,Fields}|T],
ClFields, NewNthObj);
gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
_ClFields,_NthObj) ->
- emit(["'getdec_",ObjSetName,"'(_) ->",nl]),
- emit([indent(2),"fun(_,Bytes, _RestPrimFieldName) ->",nl]),
+ emit([asis_atom(["getdec_",ObjSetName]),"(_) ->",nl,
+ indent(2),"fun(_,Bytes, _RestPrimFieldName) ->",nl]),
emit_dec_open_type(4),
emit([nl,
indent(2),"end.",nl,nl]),
@@ -1495,7 +1439,6 @@ emit_dec_open_type(I) ->
emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type}, _Prop,
InternalDefFunName) ->
OTag = Type#type.tag,
-%% Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || X <- OTag],
case {ExtName,Name} of
{primitive,bif} ->
@@ -1504,8 +1447,6 @@ emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type}, _Prop,
0;
{constructed,bif} ->
emit([indent(12),"'dec_",
-% asn1ct_gen:list2name(InternalDefFunName),"'(Bytes, ",Prop,
-% ", ",{asis,Tag},")"]),
asn1ct_gen:list2name(InternalDefFunName),"'(Bytes, ",
{asis,Tag},")"]),
1;
@@ -1519,7 +1460,6 @@ emit_inner_of_decfun(#typedef{name=Name},_Prop,_) ->
0;
emit_inner_of_decfun(#type{}=Type, _Prop, _) ->
OTag = Type#type.tag,
-%% Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || X <- OTag],
CurrMod = get(currmod),
Def = Type#type.def,
@@ -1531,11 +1471,9 @@ emit_inner_of_decfun(#type{}=Type, _Prop, _) ->
gen_dec_prim(Type, "Bytes", Tag);
#'Externaltypereference'{module=CurrMod,type=T} ->
emit([indent(9),T," ->",nl,indent(12),"'dec_",T,
-% "'(Bytes, ",Prop,")"]);
"'(Bytes)"]);
#'Externaltypereference'{module=ExtMod,type=T} ->
emit([indent(9),T," ->",nl,indent(12),ExtMod,":'dec_",
-% T,"'(Bytes, ",Prop,")"])
T,"'(Bytes, ",{asis,Tag},")"])
end,
0.
@@ -1550,10 +1488,6 @@ gen_internal_funcs(Erules,[TypeDef|Rest]) ->
gen_internal_funcs(Erules,Rest).
-dbdec(Type,Arg) ->
- demit({"io:format(\"decoding: ",{asis,Type},"~w~n\",[",Arg,"]),",nl}).
-
-
decode_class('UNIVERSAL') ->
?UNIVERSAL;
decode_class('APPLICATION') ->
@@ -1605,7 +1539,7 @@ encode_tag_val(Class, Form, TagNo) ->
%%%%%%%%%%%
%% mk_object_val(Value) -> {OctetList, Len}
-%% returns a Val as a list of octets, the 8 bit is allways set to one except
+%% returns a Val as a list of octets, the 8 bit is always set to one except
%% for the last octet, where its 0
%%
@@ -1619,8 +1553,9 @@ mk_object_val(0, Ack, Len) ->
mk_object_val(Val, Ack, Len) ->
mk_object_val(Val bsr 7, [((Val band 127) bor 128) | Ack], Len + 1).
-%% For BER the ExtensionAdditionGroup notation has no impact on the encoding/decoding
-%% and therefore we only filter away the ExtensionAdditionGroup start and end markers
+%% For BER the ExtensionAdditionGroup notation has no impact on the
+%% encoding/decoding. Therefore we can filter away the
+%% ExtensionAdditionGroup start and end markers.
extaddgroup2sequence(ExtList) when is_list(ExtList) ->
lists:filter(fun(#'ExtensionAdditionGroup'{}) ->
false;
@@ -1632,3 +1567,12 @@ extaddgroup2sequence(ExtList) when is_list(ExtList) ->
call(F, Args) ->
asn1ct_func:call(ber, F, Args).
+
+enc_func(Tname) ->
+ list_to_atom(lists:concat(["enc_",Tname])).
+
+dec_func(Tname) ->
+ list_to_atom(lists:concat(["dec_",Tname])).
+
+asis_atom(List) ->
+ {asis,list_to_atom(lists:concat(List))}.
diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl
index 9671a566bf..22719bba74 100644
--- a/lib/asn1/src/asn1ct_gen_per.erl
+++ b/lib/asn1/src/asn1ct_gen_per.erl
@@ -24,7 +24,6 @@
%% all types in an ASN.1 module
-include("asn1_records.hrl").
-%-compile(export_all).
-export([gen_dec_imm/2]).
-export([gen_dec_prim/3,gen_encode_prim_imm/3]).
@@ -35,15 +34,20 @@
-export([extaddgroup2sequence/1]).
-export([dialyzer_suppressions/1]).
--import(asn1ct_gen, [emit/1,demit/1]).
+-import(asn1ct_gen, [emit/1]).
-import(asn1ct_func, [call/3]).
-%% Generate ENCODING ******************************
-%%****************************************x
+%%****************************************
+%% Generate ENCODING
+%%****************************************
-dialyzer_suppressions(Erules) ->
- case asn1ct_func:is_used({Erules,complete,1}) of
+dialyzer_suppressions(#gen{erule=per,aligned=Aligned}) ->
+ Mod = case Aligned of
+ false -> uper;
+ true -> per
+ end,
+ case asn1ct_func:is_used({Mod,complete,1}) of
false ->
ok;
true ->
@@ -54,14 +58,6 @@ dialyzer_suppressions(Erules) ->
gen_encode(Erules,Type) when is_record(Type,typedef) ->
gen_encode_user(Erules,Type).
-%% case Type#typedef.typespec of
-%% Def when is_record(Def,type) ->
-%% gen_encode_user(Erules,Type);
-%% Def when is_tuple(Def),(element(1,Def) == 'Object') ->
-%% gen_encode_object(Erules,Type);
-%% Other ->
-%% exit({error,{asn1,{unknown,Other}}})
-%% end.
gen_encode(Erules,Typename,#'ComponentType'{name=Cname,typespec=Type}) ->
NewTypename = [Cname|Typename],
@@ -72,15 +68,14 @@ gen_encode(Erules,Typename,Type) when is_record(Type,type) ->
ObjFun =
case lists:keysearch(objfun,1,Type#type.tablecinf) of
{value,{_,_Name}} ->
-%% lists:concat([", ObjFun",Name]);
", ObjFun";
false ->
""
end,
case asn1ct_gen:type(InnerType) of
{constructed,bif} ->
- emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val",ObjFun,
- ") ->",nl}),
+ Func = enc_func(asn1ct_gen:list2name(Typename)),
+ emit([{asis,Func},"(Val",ObjFun,") ->",nl]),
asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type);
_ ->
true
@@ -92,20 +87,21 @@ gen_encode_user(Erules,D) when is_record(D,typedef) ->
Typename = [D#typedef.name],
Def = D#typedef.typespec,
InnerType = asn1ct_gen:get_inner(Def#type.def),
- emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val) ->",nl}),
+ Func = enc_func(asn1ct_gen:list2name(Typename)),
+ emit([{asis,Func},"(Val) ->",nl]),
case asn1ct_gen:type(InnerType) of
{primitive,bif} ->
gen_encode_prim(Erules, Def),
- emit({".",nl});
+ emit([".",nl]);
'ASN1_OPEN_TYPE' ->
gen_encode_prim(Erules, Def#type{def='ASN1_OPEN_TYPE'}),
- emit({".",nl});
+ emit([".",nl]);
{constructed,bif} ->
asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,D);
#'Externaltypereference'{module=CurrMod,type=Etype} ->
- emit({"'enc_",Etype,"'(Val).",nl,nl});
+ emit([{asis,enc_func(Etype)},"(Val).",nl]);
#'Externaltypereference'{module=Emod,type=Etype} ->
- emit({"'",Emod,"':'enc_",Etype,"'(Val).",nl,nl})
+ emit([{asis,Emod},":",enc_func(Etype),"(Val).",nl])
end.
@@ -220,7 +216,6 @@ gen_objectset_code(_Erules, _ObjSet) ->
gen_decode(Erules, #typedef{}=Type) ->
DecFunc = dec_func(Type#typedef.name),
emit([nl,nl,{asis,DecFunc},"(Bytes) ->",nl]),
- dbdec(Type#typedef.name),
gen_decode_user(Erules, Type).
gen_decode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) ->
@@ -241,17 +236,11 @@ gen_decode(Erules,Typename,Type) when is_record(Type,type) ->
emit([nl,
{asis,dec_func(asn1ct_gen:list2name(Typename))},
"(Bytes",ObjFun,") ->",nl]),
- dbdec(Typename),
asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type);
_ ->
true
end.
-dbdec(Type) when is_list(Type)->
- demit({"io:format(\"decoding: ",asn1ct_gen:list2name(Type),"~w~n\",[Bytes]),",nl});
-dbdec(Type) ->
- demit({"io:format(\"decoding: ",{asis,Type},"~w~n\",[Bytes]),",nl}).
-
gen_decode_user(Erules,D) when is_record(D,typedef) ->
Typename = [D#typedef.name],
Def = D#typedef.typespec,
@@ -259,17 +248,15 @@ gen_decode_user(Erules,D) when is_record(D,typedef) ->
case asn1ct_gen:type(InnerType) of
{primitive,bif} ->
gen_dec_prim(Erules,Def,"Bytes"),
- emit({".",nl,nl});
+ emit([".",nl,nl]);
'ASN1_OPEN_TYPE' ->
gen_dec_prim(Erules,Def#type{def='ASN1_OPEN_TYPE'},"Bytes"),
- emit({".",nl,nl});
+ emit([".",nl,nl]);
{constructed,bif} ->
asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,D);
#'Externaltypereference'{}=Etype ->
gen_dec_external(Etype, "Bytes"),
- emit([".",nl,nl]);
- Other ->
- exit({error,{asn1,{unknown,Other}}})
+ emit([".",nl,nl])
end.
gen_dec_external(Ext, BytesVar) ->
@@ -398,10 +385,11 @@ gen_dec_prim(Erule, Type, BytesVar) ->
asn1ct_imm:dec_code_gen(Imm, BytesVar).
-%% For PER the ExtensionAdditionGroup notation has significance for the encoding and decoding
-%% the components within the ExtensionAdditionGroup is treated in a similar way as if they
-%% have been specified within a SEQUENCE, therefore we construct a fake sequence type here
-%% so that we can generate code for it
+%% For PER the ExtensionAdditionGroup notation has significance for
+%% the encoding and decoding. The components within the
+%% ExtensionAdditionGroup is treated in a similar way as if they have
+%% been specified within a SEQUENCE. Therefore we construct a fake
+%% sequence type here so that we can generate code for it.
extaddgroup2sequence(ExtList) ->
extaddgroup2sequence(ExtList,0,[]).
diff --git a/lib/asn1/src/asn1ct_name.erl b/lib/asn1/src/asn1ct_name.erl
index 72d541cbbc..06f6604a26 100644
--- a/lib/asn1/src/asn1ct_name.erl
+++ b/lib/asn1/src/asn1ct_name.erl
@@ -20,7 +20,6 @@
%%
-module(asn1ct_name).
-%%-compile(export_all).
-export([start/0,
curr/1,
clear/0,
@@ -44,7 +43,6 @@ start() ->
end.
name_server_loop({Ref, Parent} = Monitor,Vars) ->
-%% io:format("name -- ~w~n",[Vars]),
receive
{_From,clear} ->
name_server_loop(Monitor, []);
diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl
index 2de9b0e2f0..3f1819b660 100644
--- a/lib/asn1/src/asn1ct_parser2.erl
+++ b/lib/asn1/src/asn1ct_parser2.erl
@@ -1496,7 +1496,7 @@ parse_ContentsConstraint([{'ENCODED',_},{'BY',_}|Rest]) ->
parse_ContentsConstraint(Tokens) ->
parse_error(Tokens).
-% X.683 Parameterization of ASN.1 specifications
+%% X.683 Parameterization of ASN.1 specifications
parse_Governor(Tokens) ->
Flist = [fun parse_Type/1,
diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl
index 8bd99d995b..f7d986aa91 100644
--- a/lib/asn1/src/asn1ct_value.erl
+++ b/lib/asn1/src/asn1ct_value.erl
@@ -24,12 +24,12 @@
%% The value is randomized within it's constraints
-include("asn1_records.hrl").
-%-compile(export_all).
-export([from_type/2]).
-%% Generate examples of values ******************************
-%%****************************************x
+%%****************************************
+%% Generate examples of values
+%%****************************************
from_type(M,Typename) ->
@@ -92,9 +92,6 @@ get_inner(T) when is_tuple(T) ->
Other ->
Other
end.
-%%get_inner(T) when is_tuple(T) -> element(1,T).
-
-
from_type_constructed(M,Typename,InnerType,D) when is_record(D,type) ->
case InnerType of
@@ -111,9 +108,7 @@ from_type_constructed(M,Typename,InnerType,D) when is_record(D,type) ->
'SET OF' ->
{_,Type} = D#type.def,
NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def),
- get_sequence_of(M,Typename,D,NameSuffix);
- _ ->
- exit({nyi,InnerType})
+ get_sequence_of(M,Typename,D,NameSuffix)
end.
get_sequence(M,Typename,Type) ->
@@ -147,7 +142,8 @@ get_choice(M,Typename,Type) ->
case TCompList of
[] ->
{asn1_EMPTY,asn1_EMPTY};
- {CompList,ExtList} -> % Should be enhanced to handle extensions too
+ {CompList,ExtList} ->
+ %% should be enhanced to handle extensions too.
CList = CompList ++ ExtList,
C = lists:nth(random(length(CList)),CList),
{C#'ComponentType'.name,from_type(M,Typename,C)};
@@ -247,14 +243,6 @@ from_type_prim(M, D) ->
_ ->
{2#11111111,2,2}
end;
-%% Sign1 = random_sign(integer),
-%% Sign2 = random_sign(integer),
-%% {Sign1*random(10000),2,Sign2*random(1028)};
-%% 2 ->
-%% %% base 10 tuple format
-%% Sign1 = random_sign(integer),
-%% Sign2 = random_sign(integer),
-%% {Sign1*random(10000),10,Sign2*random(1028)};
_ ->
%% base 10 string format, NR3 format
case random(2) of
@@ -302,9 +290,7 @@ from_type_prim(M, D) ->
16#ffff,16#ffee,16#10ffff,16#ffff,16#fff]),
unicode:characters_to_binary(L);
'UniversalString' ->
- adjust_list(size_random(C),c_string(C,"UniversalString"));
- XX ->
- exit({asn1_error,nyi,XX})
+ adjust_list(size_random(C),c_string(C,"UniversalString"))
end.
c_string(C,Default) ->
@@ -343,22 +329,6 @@ random_unnamed_bit_string(M, C) ->
{PadLen,<<BitString/bitstring,0:PadLen>>}
end.
-%% FIXME:
-%% random_sign(integer) ->
-%% case random(2) of
-%% 2 ->
-%% -1;
-%% _ ->
-%% 1
-%% end;
-%% random_sign(string) ->
-%% case random(2) of
-%% 2 ->
-%% "-";
-%% _ ->
-%% ""
-%% end.
-
random(Upper) ->
rand:uniform(Upper).
@@ -409,13 +379,6 @@ c_random(VRange,Single) ->
S;
{_,S} when is_list(S) ->
lists:nth(random(length(S)),S)
-%% {S1,S2} ->
-%% io:format("asn1ct_value: hejsan hoppsan~n");
-%% _ ->
-%% io:format("asn1ct_value: hejsan hoppsan 2~n")
-%% io:format("asn1ct_value: c_random/2: S1 = ~w~n"
-%% "S2 = ~w,~n",[S1,S2])
-%% exit(self(),goodbye)
end.
adjust_list(Len,Orig) ->
diff --git a/lib/asn1/src/asn1rtt_ber.erl b/lib/asn1/src/asn1rtt_ber.erl
index fdb9b9061f..882a25c332 100644
--- a/lib/asn1/src/asn1rtt_ber.erl
+++ b/lib/asn1/src/asn1rtt_ber.erl
@@ -92,7 +92,7 @@
-define(N_BMPString, 30).
-% the complete tag-word of built-in types
+%% The complete tag-word of built-in types
-define(T_BOOLEAN, ?UNIVERSAL bor ?PRIMITIVE bor 1).
-define(T_INTEGER, ?UNIVERSAL bor ?PRIMITIVE bor 2).
-define(T_BIT_STRING, ?UNIVERSAL bor ?PRIMITIVE bor 3). % can be CONSTRUCTED
@@ -137,11 +137,11 @@ ber_decode_erlang(Tlv) ->
decode_primitive(Bin) ->
{Form,TagNo,V,Rest} = decode_tag_and_length(Bin),
case Form of
- 1 -> % constructed
+ 1 -> % constructed
{{TagNo,decode_constructed(V)},Rest};
- 0 -> % primitive
+ 0 -> % primitive
{{TagNo,V},Rest};
- 2 -> % constructed indefinite
+ 2 -> % constructed indefinite
{Vlist,Rest2} = decode_constructed_indefinite(V,[]),
{{TagNo,Vlist},Rest2}
end.
@@ -165,31 +165,30 @@ decode_primitive_incomplete([[default,TagNo]],Bin) -> %default
{Form,TagNo,V,Rest} ->
decode_incomplete2(Form,TagNo,V,[],Rest);
_ ->
- %{asn1_DEFAULT,Bin}
asn1_NOVALUE
end;
-decode_primitive_incomplete([[default,TagNo,Directives]],Bin) -> %default, constructed type, Directives points into this type
+decode_primitive_incomplete([[default,TagNo,Directives]],Bin) ->
+ %% default, constructed type, Directives points into this type
case decode_tag_and_length(Bin) of
{Form,TagNo,V,Rest} ->
decode_incomplete2(Form,TagNo,V,Directives,Rest);
_ ->
- %{asn1_DEFAULT,Bin}
asn1_NOVALUE
end;
-decode_primitive_incomplete([[opt,TagNo]],Bin) -> %optional
+decode_primitive_incomplete([[opt,TagNo]],Bin) ->
+ %% optional
case decode_tag_and_length(Bin) of
{Form,TagNo,V,Rest} ->
decode_incomplete2(Form,TagNo,V,[],Rest);
_ ->
- %{{TagNo,asn1_NOVALUE},Bin}
asn1_NOVALUE
end;
-decode_primitive_incomplete([[opt,TagNo,Directives]],Bin) -> %optional
+decode_primitive_incomplete([[opt,TagNo,Directives]],Bin) ->
+ %% optional
case decode_tag_and_length(Bin) of
{Form,TagNo,V,Rest} ->
decode_incomplete2(Form,TagNo,V,Directives,Rest);
_ ->
- %{{TagNo,asn1_NOVALUE},Bin}
asn1_NOVALUE
end;
%% An optional that shall be undecoded
@@ -236,7 +235,8 @@ decode_primitive_incomplete([[alt_parts,TagNo]|RestAlts],Bin) ->
_ ->
decode_primitive_incomplete(RestAlts,Bin)
end;
-decode_primitive_incomplete([[undec,_TagNo]|_RestTag],Bin) -> %incomlete decode
+decode_primitive_incomplete([[undec,_TagNo]|_RestTag],Bin) ->
+ %% incomlete decode
decode_incomplete_bin(Bin);
decode_primitive_incomplete([[parts,TagNo]|_RestTag],Bin) ->
case decode_tag_and_length(Bin) of
@@ -301,7 +301,8 @@ decode_constructed_incomplete(Directives=[[Alt,_]|_],Bin)
{TagNo,Tlv};
{alt_parts,_} ->
[{TagNo,decode_parts_incomplete(V)}];
- no_match -> %% if a choice alternative was encoded that
+ no_match ->
+ %% if a choice alternative was encoded that
%% was not specified in the config file,
%% thus decode component anonomous.
{Tlv,_}=decode_primitive(Bin),
@@ -546,7 +547,7 @@ decode_tag_and_length(<<Class:2, Form:1, 31:5, Buffer/binary>>) ->
decode_tag(<<0:1,PartialTag:7, Buffer/binary>>, TagAck) ->
TagNo = (TagAck bsl 7) bor PartialTag,
{TagNo, Buffer};
-% more tags
+%% more tags
decode_tag(<<_:1,PartialTag:7, Buffer/binary>>, TagAck) ->
TagAck1 = (TagAck bsl 7) bor PartialTag,
decode_tag(Buffer, TagAck1).
@@ -941,12 +942,12 @@ encode_bit_string_bits(C, BitListVal, _NamedBitList, TagIn) when is_list(BitList
case length(BitListVal) of
BitSize when BitSize == Size ->
{Len, Unused, OctetList} = encode_bitstring(BitListVal),
- %%add unused byte to the Len
+ %% add unused byte to the Len
encode_tags(TagIn, [Unused | OctetList], Len+1);
BitSize when BitSize < Size ->
PaddedList = pad_bit_list(Size-BitSize,BitListVal),
{Len, Unused, OctetList} = encode_bitstring(PaddedList),
- %%add unused byte to the Len
+ %% add unused byte to the Len
encode_tags(TagIn, [Unused | OctetList], Len+1);
BitSize ->
exit({error,{asn1,
diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl
index 580c919b9d..d99190b6b0 100644
--- a/lib/asn1/test/asn1_SUITE.erl
+++ b/lib/asn1/test/asn1_SUITE.erl
@@ -1108,6 +1108,7 @@ test_modules() ->
"From",
"H235-SECURITY-MESSAGES",
"H323-MESSAGES",
+ "HighTagNumbers",
"Import",
"Int",
"MAP-commonDataTypes",
diff --git a/lib/asn1/test/asn1_SUITE_data/HighTagNumbers.asn1 b/lib/asn1/test/asn1_SUITE_data/HighTagNumbers.asn1
new file mode 100644
index 0000000000..b681063965
--- /dev/null
+++ b/lib/asn1/test/asn1_SUITE_data/HighTagNumbers.asn1
@@ -0,0 +1,17 @@
+HighTagNumbers DEFINITIONS ::=
+BEGIN
+
+S ::= SEQUENCE {
+ a [127] INTEGER,
+ b [128] INTEGER,
+ c [150] INTEGER,
+ d [207] INTEGER,
+ e [255] INTEGER,
+ f [256] INTEGER,
+ g [7777] INTEGER,
+ h [9999] INTEGER,
+ i [16382] INTEGER,
+ j [16383] INTEGER
+}
+
+END
diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index e338dbb4e3..63763f31b2 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -185,6 +185,7 @@ release_tests_spec: make_emakefile
echo "-module($$module). %% dummy .erl file" >$$file; \
done
$(INSTALL_DATA) $(ERL_DUMMY_FILES) "$(RELSYSDIR)"
+ rm $(ERL_DUMMY_FILES)
chmod -R u+w "$(RELSYSDIR)"
@tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index 631af62615..ce8add6559 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -40,6 +40,8 @@
-export([ec_curve/1, ec_curves/0]).
-export([rand_seed/1]).
+-deprecated({rand_uniform, 2, next_major_release}).
+
%% This should correspond to the similar macro in crypto.c
-define(MAX_BYTES_TO_NIF, 20000). %% Current value is: erlang:system_info(context_reductions) * 10
diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl
index 6b306c51d3..2b9f82b075 100644
--- a/lib/eunit/src/eunit_surefire.erl
+++ b/lib/eunit/src/eunit_surefire.erl
@@ -424,6 +424,7 @@ escape_suitename(String) ->
escape_suitename([], Acc) -> lists:reverse(Acc);
escape_suitename([$ | Tail], Acc) -> escape_suitename(Tail, [$_ | Acc]);
escape_suitename([$' | Tail], Acc) -> escape_suitename(Tail, Acc);
+escape_suitename([$" | Tail], Acc) -> escape_suitename(Tail, Acc);
escape_suitename([$/ | Tail], Acc) -> escape_suitename(Tail, [$: | Acc]);
escape_suitename([$\\ | Tail], Acc) -> escape_suitename(Tail, [$: | Acc]);
escape_suitename([Char | Tail], Acc) when Char < $! -> escape_suitename(Tail, Acc);
diff --git a/lib/hipe/amd64/hipe_amd64_ra_sse2_postconditions.erl b/lib/hipe/amd64/hipe_amd64_ra_sse2_postconditions.erl
index 8a3ea92156..891c874a15 100644
--- a/lib/hipe/amd64/hipe_amd64_ra_sse2_postconditions.erl
+++ b/lib/hipe/amd64/hipe_amd64_ra_sse2_postconditions.erl
@@ -53,6 +53,8 @@ do_insn(I, TempMap, Strategy) -> % Insn -> {Insn list, DidSpill}
do_fp_unop(I, TempMap, Strategy);
#fp_binop{} ->
do_fp_binop(I, TempMap, Strategy);
+ #pseudo_spill_fmove{} ->
+ do_pseudo_spill_fmove(I, TempMap, Strategy);
_ ->
%% All non sse2 ops
{[I], false}
@@ -95,8 +97,13 @@ do_fmove(I, TempMap, Strategy) ->
of
true ->
Tmp = spill_temp(double, Strategy),
- {[#fmove{src=Src, dst=Tmp},I#fmove{src=Tmp,dst=Dst}],
- true};
+ %% pseudo_spill_fmove allows spill slot move coalescing, but must not
+ %% contain memory operands (except for spilled temps)
+ Is = case is_float_temp(Src) andalso is_float_temp(Dst) of
+ true -> [#pseudo_spill_fmove{src=Src, temp=Tmp, dst=Dst}];
+ false -> [#fmove{src=Src, dst=Tmp},I#fmove{src=Tmp,dst=Dst}]
+ end,
+ {Is, true};
false ->
{[I], false}
end.
@@ -104,6 +111,12 @@ do_fmove(I, TempMap, Strategy) ->
is_float_temp(#x86_temp{type=Type}) -> Type =:= double;
is_float_temp(#x86_mem{}) -> false.
+%%% Fix an pseudo_spill_fmove op.
+do_pseudo_spill_fmove(I = #pseudo_spill_fmove{temp=Temp}, TempMap, _Strategy) ->
+ %% Temp is above the low water mark and must not have been spilled
+ false = is_mem_opnd(Temp, TempMap),
+ {[I], false}. % nothing to do
+
%%% Check if an operand denotes a memory cell (mem or pseudo).
is_mem_opnd(Opnd, TempMap) ->
diff --git a/lib/hipe/arm/hipe_arm.erl b/lib/hipe/arm/hipe_arm.erl
index e34a00f561..3b090b501a 100644
--- a/lib/hipe/arm/hipe_arm.erl
+++ b/lib/hipe/arm/hipe_arm.erl
@@ -79,6 +79,9 @@
pseudo_move_dst/1,
pseudo_move_src/1,
+ mk_pseudo_spill_move/3,
+ is_pseudo_spill_move/1,
+
mk_pseudo_switch/3,
mk_pseudo_tailcall/4,
@@ -250,6 +253,10 @@ is_pseudo_move(I) -> case I of #pseudo_move{} -> true; _ -> false end.
pseudo_move_dst(#pseudo_move{dst=Dst}) -> Dst.
pseudo_move_src(#pseudo_move{src=Src}) -> Src.
+mk_pseudo_spill_move(Dst, Temp, Src) ->
+ #pseudo_spill_move{dst=Dst, temp=Temp, src=Src}.
+is_pseudo_spill_move(I) -> is_record(I, pseudo_spill_move).
+
mk_pseudo_switch(JTab, Index, Labels) ->
#pseudo_switch{jtab=JTab, index=Index, labels=Labels}.
diff --git a/lib/hipe/arm/hipe_arm.hrl b/lib/hipe/arm/hipe_arm.hrl
index 67bc07634e..be06b1ebd7 100644
--- a/lib/hipe/arm/hipe_arm.hrl
+++ b/lib/hipe/arm/hipe_arm.hrl
@@ -101,6 +101,7 @@
-record(pseudo_call_prepare, {nrstkargs}).
-record(pseudo_li, {dst, imm, label}). % pre-generated label for use by the assembler
-record(pseudo_move, {dst, src}).
+-record(pseudo_spill_move, {dst, temp, src}).
-record(pseudo_switch, {jtab, index, labels}).
-record(pseudo_tailcall, {funv, arity, stkargs, linkage}).
-record(pseudo_tailcall_prepare, {}).
diff --git a/lib/hipe/arm/hipe_arm_cfg.erl b/lib/hipe/arm/hipe_arm_cfg.erl
index ea6da67317..0bc3df30b9 100644
--- a/lib/hipe/arm/hipe_arm_cfg.erl
+++ b/lib/hipe/arm/hipe_arm_cfg.erl
@@ -24,6 +24,7 @@
-export([params/1, reverse_postorder/1]).
-export([arity/1]). % for linear scan
%%-export([redirect_jmp/3]).
+-export([branch_preds/1]).
%%% these tell cfg.inc what to define (ugly as hell)
-define(BREADTH_ORDER,true). % for linear scan
@@ -75,6 +76,26 @@ branch_successors(Branch) ->
#pseudo_tailcall{} -> []
end.
+branch_preds(Branch) ->
+ case Branch of
+ #pseudo_bc{true_label=TrueLab,false_label=FalseLab,pred=Pred} ->
+ [{FalseLab, 1.0-Pred}, {TrueLab, Pred}];
+ #pseudo_call{contlab=ContLab, sdesc=#arm_sdesc{exnlab=[]}} ->
+ %% A function can still cause an exception, even if we won't catch it
+ [{ContLab, 1.0-hipe_bb_weights:call_exn_pred()}];
+ #pseudo_call{contlab=ContLab, sdesc=#arm_sdesc{exnlab=ExnLab}} ->
+ CallExnPred = hipe_bb_weights:call_exn_pred(),
+ [{ContLab, 1.0-CallExnPred}, {ExnLab, CallExnPred}];
+ #pseudo_switch{labels=Labels} ->
+ Prob = 1.0/length(Labels),
+ [{L, Prob} || L <- Labels];
+ _ ->
+ case branch_successors(Branch) of
+ [] -> [];
+ [Single] -> [{Single, 1.0}]
+ end
+ end.
+
-ifdef(REMOVE_TRIVIAL_BBS_NEEDED).
fails_to(_Instr) -> [].
-endif.
diff --git a/lib/hipe/arm/hipe_arm_defuse.erl b/lib/hipe/arm/hipe_arm_defuse.erl
index 0e62070c6c..652299a514 100644
--- a/lib/hipe/arm/hipe_arm_defuse.erl
+++ b/lib/hipe/arm/hipe_arm_defuse.erl
@@ -40,6 +40,7 @@ insn_def_gpr(I) ->
#pseudo_call{} -> call_clobbered_gpr();
#pseudo_li{dst=Dst} -> [Dst];
#pseudo_move{dst=Dst} -> [Dst];
+ #pseudo_spill_move{dst=Dst, temp=Temp} -> [Dst, Temp];
#pseudo_tailcall_prepare{} -> tailcall_clobbered_gpr();
#smull{dstlo=DstLo,dsthi=DstHi,src1=Src1} ->
%% ARM requires DstLo, DstHi, and Src1 to be distinct.
@@ -83,6 +84,7 @@ insn_use_gpr(I) ->
#pseudo_call{funv=FunV,sdesc=#arm_sdesc{arity=Arity}} ->
funv_use(FunV, arity_use_gpr(Arity));
#pseudo_move{src=Src} -> [Src];
+ #pseudo_spill_move{src=Src} -> [Src];
#pseudo_switch{jtab=JTabR,index=IndexR} -> addtemp(JTabR, [IndexR]);
#pseudo_tailcall{funv=FunV,arity=Arity,stkargs=StkArgs} ->
addargs(StkArgs, addtemps(tailcall_clobbered_gpr(), funv_use(FunV, arity_use_gpr(Arity))));
diff --git a/lib/hipe/arm/hipe_arm_frame.erl b/lib/hipe/arm/hipe_arm_frame.erl
index e323907e31..a1004fb609 100644
--- a/lib/hipe/arm/hipe_arm_frame.erl
+++ b/lib/hipe/arm/hipe_arm_frame.erl
@@ -69,6 +69,8 @@ do_insn(I, LiveOut, Context, FPoff) ->
do_pseudo_call_prepare(I, FPoff);
#pseudo_move{} ->
{do_pseudo_move(I, Context, FPoff), FPoff};
+ #pseudo_spill_move{} ->
+ {do_pseudo_spill_move(I, Context, FPoff), FPoff};
#pseudo_tailcall{} ->
{do_pseudo_tailcall(I, Context), context_framesize(Context)};
_ ->
@@ -100,6 +102,26 @@ pseudo_offset(Temp, FPoff, Context) ->
FPoff + context_offset(Context, Temp).
%%%
+%%% Moves from one spill slot to another
+%%%
+
+do_pseudo_spill_move(I, Context, FPoff) ->
+ #pseudo_spill_move{dst=Dst, temp=Temp, src=Src} = I,
+ case temp_is_pseudo(Src) andalso temp_is_pseudo(Dst) of
+ false -> % Register allocator changed its mind, turn back to move
+ do_pseudo_move(hipe_arm:mk_pseudo_move(Dst, Src), Context, FPoff);
+ true ->
+ SrcOffset = pseudo_offset(Src, FPoff, Context),
+ DstOffset = pseudo_offset(Dst, FPoff, Context),
+ case SrcOffset =:= DstOffset of
+ true -> []; % omit move-to-self
+ false ->
+ mk_load('ldr', Temp, SrcOffset, mk_sp(),
+ mk_store('str', Temp, DstOffset, mk_sp(), []))
+ end
+ end.
+
+%%%
%%% Return - deallocate frame and emit 'ret $N' insn.
%%%
diff --git a/lib/hipe/arm/hipe_arm_ra_finalise.erl b/lib/hipe/arm/hipe_arm_ra_finalise.erl
index 9bfe0a9a83..80cd470708 100644
--- a/lib/hipe/arm/hipe_arm_ra_finalise.erl
+++ b/lib/hipe/arm/hipe_arm_ra_finalise.erl
@@ -25,11 +25,17 @@ ra_bb(BB, Map) ->
hipe_bb:code_update(BB, ra_code(hipe_bb:code(BB), Map, [])).
ra_code([I|Insns], Map, Accum) ->
- ra_code(Insns, Map, [ra_insn(I, Map) | Accum]);
+ ra_code(Insns, Map, ra_insn(I, Map, Accum));
ra_code([], _Map, Accum) ->
lists:reverse(Accum).
-ra_insn(I, Map) ->
+ra_insn(I, Map, Accum) ->
+ case I of
+ #pseudo_move{} -> ra_pseudo_move(I, Map, Accum);
+ _ -> [ra_insn_1(I, Map) | Accum]
+ end.
+
+ra_insn_1(I, Map) ->
case I of
#alu{} -> ra_alu(I, Map);
#cmp{} -> ra_cmp(I, Map);
@@ -38,7 +44,7 @@ ra_insn(I, Map) ->
#move{} -> ra_move(I, Map);
#pseudo_call{} -> ra_pseudo_call(I, Map);
#pseudo_li{} -> ra_pseudo_li(I, Map);
- #pseudo_move{} -> ra_pseudo_move(I, Map);
+ #pseudo_spill_move{} -> ra_pseudo_spill_move(I, Map);
#pseudo_switch{} -> ra_pseudo_switch(I, Map);
#pseudo_tailcall{} -> ra_pseudo_tailcall(I, Map);
#smull{} -> ra_smull(I, Map);
@@ -80,10 +86,19 @@ ra_pseudo_li(I=#pseudo_li{dst=Dst}, Map) ->
NewDst = ra_temp(Dst, Map),
I#pseudo_li{dst=NewDst}.
-ra_pseudo_move(I=#pseudo_move{dst=Dst,src=Src}, Map) ->
+ra_pseudo_move(I=#pseudo_move{dst=Dst,src=Src}, Map, Accum) ->
+ NewDst = ra_temp(Dst, Map),
+ NewSrc = ra_temp(Src, Map),
+ case NewSrc#arm_temp.reg =:= NewDst#arm_temp.reg of
+ true -> Accum;
+ false -> [I#pseudo_move{dst=NewDst,src=NewSrc} | Accum]
+ end.
+
+ra_pseudo_spill_move(I=#pseudo_spill_move{dst=Dst,temp=Temp,src=Src}, Map) ->
NewDst = ra_temp(Dst, Map),
+ NewTemp = ra_temp(Temp, Map),
NewSrc = ra_temp(Src, Map),
- I#pseudo_move{dst=NewDst,src=NewSrc}.
+ I#pseudo_spill_move{dst=NewDst, temp=NewTemp, src=NewSrc}.
ra_pseudo_switch(I=#pseudo_switch{jtab=JTab,index=Index}, Map) ->
NewJTab = ra_temp(JTab, Map),
diff --git a/lib/hipe/arm/hipe_arm_ra_postconditions.erl b/lib/hipe/arm/hipe_arm_ra_postconditions.erl
index 8d1ee1cb94..23c305511f 100644
--- a/lib/hipe/arm/hipe_arm_ra_postconditions.erl
+++ b/lib/hipe/arm/hipe_arm_ra_postconditions.erl
@@ -56,6 +56,7 @@ do_insn(I, TempMap, Strategy) ->
#pseudo_call{} -> do_pseudo_call(I, TempMap, Strategy);
#pseudo_li{} -> do_pseudo_li(I, TempMap, Strategy);
#pseudo_move{} -> do_pseudo_move(I, TempMap, Strategy);
+ #pseudo_spill_move{} -> do_pseudo_spill_move(I, TempMap, Strategy);
#pseudo_switch{} -> do_pseudo_switch(I, TempMap, Strategy);
#pseudo_tailcall{} -> do_pseudo_tailcall(I, TempMap, Strategy);
#smull{} -> do_smull(I, TempMap, Strategy);
@@ -108,18 +109,25 @@ do_pseudo_li(I=#pseudo_li{dst=Dst}, TempMap, Strategy) ->
do_pseudo_move(I=#pseudo_move{dst=Dst,src=Src}, TempMap, Strategy) ->
%% Either Dst or Src (but not both) may be a pseudo temp.
- %% pseudo_move and pseudo_tailcall are special cases: in
- %% all other instructions, all temps must be non-pseudos
- %% after register allocation.
- case temp_is_spilled(Dst, TempMap) of
- true -> % Src must not be a pseudo
- {FixSrc,NewSrc,DidSpill} = fix_src1(Src, TempMap, Strategy),
- NewI = I#pseudo_move{src=NewSrc},
- {FixSrc ++ [NewI], DidSpill};
+ %% pseudo_move, pseudo_spill_move, and pseudo_tailcall
+ %% are special cases: in all other instructions, all
+ %% temps must be non-pseudos after register allocation.
+ case temp_is_spilled(Dst, TempMap)
+ andalso temp_is_spilled(Dst, TempMap)
+ of
+ true -> % Turn into pseudo_spill_move
+ Temp = clone(Src, temp1(Strategy)),
+ NewI = #pseudo_spill_move{dst=Dst, temp=Temp, src=Src},
+ {[NewI], true};
_ ->
{[I], false}
end.
+do_pseudo_spill_move(I = #pseudo_spill_move{temp=Temp}, TempMap, _Strategy) ->
+ %% Temp is above the low water mark and must not have been spilled
+ false = temp_is_spilled(Temp, TempMap),
+ {[I], false}. % nothing to do
+
do_pseudo_switch(I=#pseudo_switch{jtab=JTab,index=Index}, TempMap, Strategy) ->
{FixJTab,NewJTab,DidSpill1} = fix_src1(JTab, TempMap, Strategy),
{FixIndex,NewIndex,DidSpill2} = fix_src2(Index, TempMap, Strategy),
diff --git a/lib/hipe/arm/hipe_arm_subst.erl b/lib/hipe/arm/hipe_arm_subst.erl
index 7510c197bd..4ff245f414 100644
--- a/lib/hipe/arm/hipe_arm_subst.erl
+++ b/lib/hipe/arm/hipe_arm_subst.erl
@@ -13,7 +13,7 @@
%% limitations under the License.
-module(hipe_arm_subst).
--export([insn_temps/2]).
+-export([insn_temps/2, insn_lbls/2]).
-include("hipe_arm.hrl").
%% These should be moved to hipe_arm and exported
@@ -31,6 +31,7 @@
-type am3() :: #am3{}.
-type arg() :: temp() | integer().
-type funv() :: #arm_mfa{} | #arm_prim{} | temp().
+-type label() :: non_neg_integer().
-type insn() :: tuple(). % for now
-type subst_fun() :: fun((temp()) -> temp()).
@@ -58,6 +59,8 @@ insn_temps(T, I) ->
#pseudo_call{funv=F} -> I#pseudo_call{funv=funv_temps(T, F)};
#pseudo_call_prepare{} -> I;
#pseudo_li{dst=D} -> I#pseudo_li{dst=T(D)};
+ #pseudo_spill_move{dst=D,temp=U,src=S} ->
+ I#pseudo_spill_move{dst=T(D),temp=T(U),src=T(S)};
#pseudo_switch{jtab=J=#arm_temp{},index=Ix=#arm_temp{}} ->
I#pseudo_switch{jtab=T(J),index=T(Ix)};
#pseudo_tailcall{funv=F,stkargs=Stk} ->
@@ -103,3 +106,22 @@ funv_temps(SubstTemp, T=#arm_temp{}) -> SubstTemp(T).
-spec arg_temps(subst_fun(), arg()) -> arg().
arg_temps(_SubstTemp, Imm) when is_integer(Imm) -> Imm;
arg_temps(SubstTemp, T=#arm_temp{}) -> SubstTemp(T).
+
+-type lbl_subst_fun() :: fun((label()) -> label()).
+
+%% @doc Maps over the branch targets in an instruction
+-spec insn_lbls(lbl_subst_fun(), insn()) -> insn().
+insn_lbls(SubstLbl, I) ->
+ case I of
+ #b_label{label=Label} ->
+ I#b_label{label=SubstLbl(Label)};
+ #pseudo_bc{true_label=T, false_label=F} ->
+ I#pseudo_bc{true_label=SubstLbl(T), false_label=SubstLbl(F)};
+ #pseudo_call{sdesc=Sdesc, contlab=Contlab} ->
+ I#pseudo_call{sdesc=sdesc_lbls(SubstLbl, Sdesc),
+ contlab=SubstLbl(Contlab)}
+ end.
+
+sdesc_lbls(_SubstLbl, Sdesc=#arm_sdesc{exnlab=[]}) -> Sdesc;
+sdesc_lbls(SubstLbl, Sdesc=#arm_sdesc{exnlab=Exnlab}) ->
+ Sdesc#arm_sdesc{exnlab=SubstLbl(Exnlab)}.
diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src
index af2c02006d..de0b255c01 100644
--- a/lib/hipe/main/hipe.app.src
+++ b/lib/hipe/main/hipe.app.src
@@ -76,6 +76,7 @@
hipe_arm_specific,
hipe_arm_subst,
hipe_bb,
+ hipe_bb_weights,
hipe_beam_to_icode,
hipe_coalescing_regalloc,
hipe_consttab,
@@ -83,6 +84,7 @@
hipe_digraph,
hipe_dominators,
hipe_dot,
+ hipe_dsets,
hipe_gen_cfg,
hipe_gensym,
hipe_graph_coloring_regalloc,
@@ -146,9 +148,11 @@
hipe_ppc_specific_fp,
hipe_ppc_subst,
hipe_profile,
+ hipe_range_split,
hipe_reg_worklists,
hipe_regalloc_loop,
hipe_regalloc_prepass,
+ hipe_restore_reuse,
hipe_rtl,
hipe_rtl_arch,
hipe_rtl_arith_32,
diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl
index fff397b060..19b4e8bfe2 100644
--- a/lib/hipe/main/hipe.erl
+++ b/lib/hipe/main/hipe.erl
@@ -1230,6 +1230,18 @@ option_text(regalloc) ->
" optimistic - another variant of a coalescing allocator";
option_text(remove_comments) ->
"Strip comments from intermediate code";
+option_text(ra_range_split) ->
+ "Split live ranges of temporaries live over call instructions\n"
+ "before performing register allocation.\n"
+ "Heuristically tries to move stack accesses to the cold path of function.\n"
+ "This range splitter is more sophisticated than 'ra_restore_reuse', but has\n"
+ "a significantly larger impact on compile time.\n"
+ "Should only be used with move coalescing register allocators.";
+option_text(ra_restore_reuse) ->
+ "Split live ranges of temporaries such that straight-line\n"
+ "code will not need to contain multiple restores from the same stack\n"
+ "location.\n"
+ "Should only be used with move coalescing register allocators.";
option_text(rtl_ssa) ->
"Perform SSA conversion on the RTL level -- default starting at O2";
option_text(rtl_ssa_const_prop) ->
@@ -1371,6 +1383,12 @@ opt_keys() ->
pp_rtl_linear,
ra_partitioned,
ra_prespill,
+ ra_range_split,
+ ra_restore_reuse,
+ range_split_min_gain,
+ range_split_mode1_fudge,
+ range_split_weight_power,
+ range_split_weights,
regalloc,
remove_comments,
rtl_ssa,
@@ -1409,7 +1427,8 @@ o1_opts(TargetArch) ->
icode_ssa_const_prop, icode_ssa_copy_prop, icode_inline_bifs,
rtl_ssa, rtl_ssa_const_prop, rtl_ssapre,
spillmin_color, use_indexing, remove_comments,
- binary_opt, {regalloc,coalescing} | o0_opts(TargetArch)],
+ binary_opt, {regalloc,coalescing}, ra_restore_reuse
+ | o0_opts(TargetArch)],
case TargetArch of
ultrasparc ->
Common;
@@ -1429,7 +1448,8 @@ o1_opts(TargetArch) ->
o2_opts(TargetArch) ->
Common = [icode_type, icode_call_elim, % icode_ssa_struct_reuse,
- rtl_lcm | (o1_opts(TargetArch) -- [rtl_ssapre])],
+ ra_range_split, range_split_weights, % XXX: Having defaults here is ugly
+ rtl_lcm | (o1_opts(TargetArch) -- [rtl_ssapre, ra_restore_reuse])],
case TargetArch of
T when T =:= amd64 orelse T =:= ppc64 -> % 64-bit targets
[icode_range | Common];
@@ -1477,6 +1497,9 @@ opt_negations() ->
{no_pp_rtl_ssapre, pp_rtl_ssapre},
{no_ra_partitioned, ra_partitioned},
{no_ra_prespill, ra_prespill},
+ {no_ra_range_split, ra_range_split},
+ {no_ra_restore_reuse, ra_restore_reuse},
+ {no_range_split_weights, range_split_weights},
{no_remove_comments, remove_comments},
{no_rtl_ssa, rtl_ssa},
{no_rtl_ssa_const_prop, rtl_ssa_const_prop},
diff --git a/lib/hipe/opt/Makefile b/lib/hipe/opt/Makefile
index 684d6f45b4..5a729d04ae 100644
--- a/lib/hipe/opt/Makefile
+++ b/lib/hipe/opt/Makefile
@@ -43,7 +43,8 @@ RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN)
# ----------------------------------------------------
# Target Specs
# ----------------------------------------------------
-MODULES = hipe_spillmin hipe_spillmin_color hipe_spillmin_scan
+MODULES = hipe_spillmin hipe_spillmin_color hipe_spillmin_scan \
+ hipe_bb_weights
HRL_FILES=
ERL_FILES= $(MODULES:%=%.erl)
diff --git a/lib/hipe/opt/hipe_bb_weights.erl b/lib/hipe/opt/hipe_bb_weights.erl
new file mode 100644
index 0000000000..8ef113b94c
--- /dev/null
+++ b/lib/hipe/opt/hipe_bb_weights.erl
@@ -0,0 +1,449 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%@doc
+%% BASIC BLOCK WEIGHTING
+%%
+%% Computes basic block weights by using branch probabilities as weights in a
+%% linear equation system, that is then solved using Gauss-Jordan Elimination.
+%%
+%% The equation system representation is intentionally sparse, since most blocks
+%% have at most two successors.
+-module(hipe_bb_weights).
+-export([compute/3, compute_fast/3, weight/2, call_exn_pred/0]).
+-export_type([bb_weights/0]).
+
+-compile(inline).
+
+%%-define(DO_ASSERT,1).
+%%-define(DEBUG,1).
+-include("../main/hipe.hrl").
+
+%% If the equation system is large, it might take too long to solve it exactly.
+%% Thus, if there are more than ?HEUR_MAX_SOLVE labels, we use the iterative
+%% approximation.
+-define(HEUR_MAX_SOLVE, 10000).
+
+-opaque bb_weights() :: #{label() => float()}.
+
+-type cfg() :: any().
+-type target_module() :: module().
+-type target_context() :: any().
+-type target() :: {target_module(), target_context()}.
+
+-type label() :: integer().
+-type var() :: label().
+-type assignment() :: {var(), float()}.
+-type eq_assoc() :: [{var(), key()}].
+-type solution() :: [assignment()].
+
+%% Constant. Predicted probability of a call resulting in an exception.
+-spec call_exn_pred() -> float().
+call_exn_pred() -> 0.01.
+
+-spec compute(cfg(), target_module(), target_context()) -> bb_weights().
+compute(CFG, TgtMod, TgtCtx) ->
+ Target = {TgtMod, TgtCtx},
+ Labels = labels(CFG, Target),
+ if length(Labels) > ?HEUR_MAX_SOLVE ->
+ ?debug_msg("~w: Too many labels (~w), approximating.~n",
+ [?MODULE, length(Labels)]),
+ compute_fast(CFG, TgtMod, TgtCtx);
+ true ->
+ {EqSys, EqAssoc} = build_eq_system(CFG, Labels, Target),
+ case solve(EqSys, EqAssoc) of
+ {ok, Solution} ->
+ maps:from_list(Solution)
+ end
+ end.
+
+-spec build_eq_system(cfg(), [label()], target()) -> {eq_system(), eq_assoc()}.
+build_eq_system(CFG, Labels, Target) ->
+ StartLb = hipe_gen_cfg:start_label(CFG),
+ EQS0 = eqs_new(),
+ {EQS1, Assoc} = build_eq_system(Labels, CFG, Target, [], EQS0),
+ {StartLb, StartKey} = lists:keyfind(StartLb, 1, Assoc),
+ StartRow0 = eqs_get(StartKey, EQS1),
+ StartRow = row_set_const(-1.0, StartRow0), % -1.0 since StartLb coef is -1.0
+ EQS = eqs_put(StartKey, StartRow, EQS1),
+ {EQS, Assoc}.
+
+build_eq_system([], _CFG, _Target, Map, EQS) -> {EQS, lists:reverse(Map)};
+build_eq_system([L|Ls], CFG, Target, Map, EQS0) ->
+ PredProb = pred_prob(L, CFG, Target),
+ {Key, EQS} = eqs_insert(row_new([{L, -1.0}|PredProb], 0.0), EQS0),
+ build_eq_system(Ls, CFG, Target, [{L, Key}|Map], EQS).
+
+pred_prob(L, CFG, Target) ->
+ [begin
+ BB = bb(CFG, Pred, Target),
+ Ps = branch_preds(hipe_bb:last(BB), Target),
+ ?ASSERT(length(lists:ukeysort(1, Ps))
+ =:= length(hipe_gen_cfg:succ(CFG, Pred))),
+ case lists:keyfind(L, 1, Ps) of
+ {L, Prob} when is_float(Prob) -> {Pred, Prob}
+ end
+ end || Pred <- hipe_gen_cfg:pred(CFG, L)].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+-spec triangelise(eq_system(), eq_assoc()) -> {eq_system(), eq_assoc()}.
+triangelise(EQS, VKs) ->
+ triangelise_1(mk_triix(EQS, VKs), []).
+
+triangelise_1(TIX0, Acc) ->
+ case triix_is_empty(TIX0) of
+ true -> {triix_eqs(TIX0), lists:reverse(Acc)};
+ false ->
+ {V,Key,TIX1} = triix_pop_smallest(TIX0),
+ Row0 = triix_get(Key, TIX1),
+ case row_get(V, Row0) of
+ Coef when Coef > -0.0001, Coef < 0.0001 ->
+ throw(error);
+ _ ->
+ Row = row_normalise(V, Row0),
+ TIX2 = triix_put(Key, Row, TIX1),
+ TIX = eliminate_triix(V, Key, Row, TIX2),
+ triangelise_1(TIX, [{V,Key}|Acc])
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Triangelisation maintains its own index, outside of eqs. This index is
+%% essentially a BST (used as a heap) of all equations by size, with {Key,Var}
+%% as the values and only containing a subset of all the keys in the whole
+%% equation system. The key operation is triix_pop_smallest/1, which pops a
+%% {Key,Var} from the heap corresponding to one of the smallest equations. This
+%% is critical in order to prevent the equations from growing during
+%% triangelisation, which would make the algorithm O(n^2) in the common case.
+-type tri_eq_system() :: {eq_system(),
+ gb_trees:tree(non_neg_integer(),
+ gb_trees:tree(key(), var()))}.
+
+triix_eqs({EQS, _}) -> EQS.
+triix_get(Key, {EQS, _}) -> eqs_get(Key, EQS).
+triix_is_empty({_, Tree}) -> gb_trees:is_empty(Tree).
+triix_lookup(V, {EQS, _}) -> eqs_lookup(V, EQS).
+
+mk_triix(EQS, VKs) ->
+ {EQS,
+ lists:foldl(fun({V,Key}, Tree) ->
+ Size = row_size(eqs_get(Key, EQS)),
+ sitree_insert(Size, Key, V, Tree)
+ end, gb_trees:empty(), VKs)}.
+
+sitree_insert(Size, Key, V, SiTree) ->
+ SubTree1 =
+ case gb_trees:lookup(Size, SiTree) of
+ none -> gb_trees:empty();
+ {value, SubTree0} -> SubTree0
+ end,
+ SubTree = gb_trees:insert(Key, V, SubTree1),
+ gb_trees:enter(Size, SubTree, SiTree).
+
+sitree_update_subtree(Size, SubTree, SiTree) ->
+ case gb_trees:is_empty(SubTree) of
+ true -> gb_trees:delete(Size, SiTree);
+ false -> gb_trees:update(Size, SubTree, SiTree)
+ end.
+
+triix_put(Key, Row, {EQS, Tree0}) ->
+ OldSize = row_size(eqs_get(Key, EQS)),
+ case row_size(Row) of
+ OldSize -> {eqs_put(Key, Row, EQS), Tree0};
+ Size ->
+ Tree =
+ case gb_trees:lookup(OldSize, Tree0) of
+ none -> Tree0;
+ {value, SubTree0} ->
+ case gb_trees:lookup(Key, SubTree0) of
+ none -> Tree0;
+ {value, V} ->
+ SubTree = gb_trees:delete(Key, SubTree0),
+ Tree1 = sitree_update_subtree(OldSize, SubTree, Tree0),
+ sitree_insert(Size, Key, V, Tree1)
+ end
+ end,
+ {eqs_put(Key, Row, EQS), Tree}
+ end.
+
+triix_pop_smallest({EQS, Tree}) ->
+ {Size, SubTree0} = gb_trees:smallest(Tree),
+ {Key, V, SubTree} = gb_trees:take_smallest(SubTree0),
+ {V, Key, {EQS, sitree_update_subtree(Size, SubTree, Tree)}}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+row_normalise(Var, Row) ->
+ %% Normalise v's coef to 1.0
+ %% row_set_coef ensures the coef is exactly 1.0 (no rounding errors)
+ row_set_coef(Var, 1.0, row_scale(Row, 1.0/row_get(Var, Row))).
+
+%% Precondition: Row must be normalised; i.e. Vars coef must be 1.0 (mod
+%% rounding errors)
+-spec eliminate(var(), key(), row(), eq_system()) -> eq_system().
+eliminate(Var, Key, Row, TIX0) ->
+ eliminate_abstr(Var, Key, Row, TIX0,
+ fun eqs_get/2, fun eqs_lookup/2, fun eqs_put/3).
+
+-spec eliminate_triix(var(), key(), row(), tri_eq_system()) -> tri_eq_system().
+eliminate_triix(Var, Key, Row, TIX0) ->
+ eliminate_abstr(Var, Key, Row, TIX0,
+ fun triix_get/2, fun triix_lookup/2, fun triix_put/3).
+
+%% The same function implemented for two data types, eqs and triix.
+-compile({inline, eliminate_abstr/7}).
+-spec eliminate_abstr(var(), key(), row(), ADT, fun((key(), ADT) -> row()),
+ fun((var(), ADT) -> [key()]),
+ fun((key(), row(), ADT) -> ADT)) -> ADT.
+eliminate_abstr(Var, Key, Row, ADT0, GetFun, LookupFun, PutFun) ->
+ ?ASSERT(1.0 =:= row_get(Var, Row)),
+ ADT =
+ lists:foldl(fun(RK, ADT1) when RK =:= Key -> ADT1;
+ (RK, ADT1) ->
+ R = GetFun(RK, ADT1),
+ PutFun(RK, row_addmul(R, Row, -row_get(Var, R)), ADT1)
+ end, ADT0, LookupFun(Var, ADT0)),
+ [Key] = LookupFun(Var, ADT),
+ ADT.
+
+-spec solve(eq_system(), eq_assoc()) -> error | {ok, solution()}.
+solve(EQS0, EqAssoc0) ->
+ try triangelise(EQS0, EqAssoc0)
+ of {EQS1, EqAssoc} ->
+ {ok, solve_1(EqAssoc, maps:from_list(EqAssoc), EQS1, [])}
+ catch error -> error
+ end.
+
+solve_1([], _VarEqs, _EQS, Acc) -> Acc;
+solve_1([{V,K}|Ps], VarEqs, EQS0, Acc0) ->
+ Row0 = eqs_get(K, EQS0),
+ VarsToKill = [Var || {Var, _} <- row_coefs(Row0), Var =/= V],
+ Row1 = kill_vars(VarsToKill, VarEqs, EQS0, Row0),
+ [{V,_}] = row_coefs(Row1), % assertion
+ Row = row_normalise(V, Row1),
+ [{V,1.0}] = row_coefs(Row), % assertion
+ EQS = eliminate(V, K, Row, EQS0),
+ [K] = eqs_lookup(V, EQS),
+ solve_1(Ps, VarEqs, eqs_remove(K, EQS), [{V, row_const(Row)}|Acc0]).
+
+kill_vars([], _VarEqs, _EQS, Row) -> Row;
+kill_vars([V|Vs], VarEqs, EQS, Row0) ->
+ VRow0 = eqs_get(maps:get(V, VarEqs), EQS),
+ VRow = row_normalise(V, VRow0),
+ ?ASSERT(1.0 =:= row_get(V, VRow)),
+ Row = row_addmul(Row0, VRow, -row_get(V, Row0)),
+ ?ASSERT(0.0 =:= row_get(V, Row)), % V has been killed
+ kill_vars(Vs, VarEqs, EQS, Row).
+
+-spec weight(label(), bb_weights()) -> float().
+weight(Lbl, Weights) ->
+ maps:get(Lbl, Weights).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Row datatype
+%% Invariant: No 0.0 coefficiets!
+-spec row_empty() -> row().
+row_empty() -> {orddict:new(), 0.0}.
+
+-spec row_new([{var(), float()}], float()) -> row().
+row_new(Coefs, Const) when is_float(Const) ->
+ row_ensure_invar({row_squash_multiples(lists:keysort(1, Coefs)), Const}).
+
+row_squash_multiples([{K, C1},{K, C2}|Ps]) ->
+ row_squash_multiples([{K,C1+C2}|Ps]);
+row_squash_multiples([P|Ps]) -> [P|row_squash_multiples(Ps)];
+row_squash_multiples([]) -> [].
+
+row_ensure_invar({Coef, Const}) ->
+ {orddict:filter(fun(_, 0.0) -> false; (_, F) when is_float(F) -> true end,
+ Coef), Const}.
+
+row_const({_, Const}) -> Const.
+row_coefs({Coefs, _}) -> orddict:to_list(Coefs).
+row_size({Coefs, _}) -> orddict:size(Coefs).
+
+row_get(Var, {Coefs, _}) ->
+ case lists:keyfind(Var, 1, Coefs) of
+ false -> 0.0;
+ {_, Coef} -> Coef
+ end.
+
+row_set_coef(Var, 0.0, {Coefs, Const}) ->
+ {orddict:erase(Var, Coefs), Const};
+row_set_coef(Var, Coef, {Coefs, Const}) ->
+ {orddict:store(Var, Coef, Coefs), Const}.
+
+row_set_const(Const, {Coefs, _}) -> {Coefs, Const}.
+
+%% Lhs + Rhs*Factor
+-spec row_addmul(row(), row(), float()) -> row().
+row_addmul({LhsCoefs, LhsConst}, {RhsCoefs, RhsConst}, Factor)
+ when is_float(Factor) ->
+ Coefs = row_addmul_coefs(LhsCoefs, RhsCoefs, Factor),
+ Const = LhsConst + RhsConst * Factor,
+ {Coefs, Const}.
+
+row_addmul_coefs(Ls, [], Factor) when is_float(Factor) -> Ls;
+row_addmul_coefs([], Rs, Factor) when is_float(Factor) ->
+ row_scale_coefs(Rs, Factor);
+row_addmul_coefs([L={LV, _}|Ls], Rs=[{RV,_}|_], Factor)
+ when LV < RV, is_float(Factor) ->
+ [L|row_addmul_coefs(Ls, Rs, Factor)];
+row_addmul_coefs(Ls=[{LV, _}|_], [{RV, RC}|Rs], Factor)
+ when LV > RV, is_float(RC), is_float(Factor) ->
+ [{RV, RC*Factor}|row_addmul_coefs(Ls, Rs, Factor)];
+row_addmul_coefs([{V, LC}|Ls], [{V, RC}|Rs], Factor)
+ when is_float(LC), is_float(RC), is_float(Factor) ->
+ case LC + RC * Factor of
+ 0.0 -> row_addmul_coefs(Ls, Rs, Factor);
+ C -> [{V,C}|row_addmul_coefs(Ls, Rs, Factor)]
+ end.
+
+row_scale(_, 0.0) -> row_empty();
+row_scale({RowCoefs, RowConst}, Factor) when is_float(Factor) ->
+ {row_scale_coefs(RowCoefs, Factor), RowConst * Factor}.
+
+row_scale_coefs([{V,C}|Cs], Factor) when is_float(Factor), is_float(C) ->
+ [{V,C*Factor}|row_scale_coefs(Cs, Factor)];
+row_scale_coefs([], Factor) when is_float(Factor) ->
+ [].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Equation system ADT
+%%
+%% Stores a linear equation system, allowing for efficient updates and efficient
+%% queries for all equations mentioning a variable.
+%%
+%% It is sort of like a "database" table of {Primary, Terms, Const} indexed both
+%% on Primary as well as the vars (map keys) in Terms.
+-type row() :: {Terms :: orddict:orddict(var(), float()),
+ Const :: float()}.
+-type key() :: non_neg_integer().
+-type rev_index() :: #{var() => ordsets:ordset(key())}.
+-record(eq_system, {
+ rows = #{} :: #{key() => row()},
+ revidx = revidx_empty() :: rev_index(),
+ next_key = 0 :: key()
+ }).
+-type eq_system() :: #eq_system{}.
+
+eqs_new() -> #eq_system{}.
+
+-spec eqs_insert(row(), eq_system()) -> {key(), eq_system()}.
+eqs_insert(Row, EQS=#eq_system{next_key=NextKey0}) ->
+ Key = NextKey0,
+ NextKey = NextKey0 + 1,
+ {Key, eqs_insert(Key, Row, EQS#eq_system{next_key=NextKey})}.
+
+eqs_insert(Key, Row, EQS=#eq_system{rows=Rows, revidx=RevIdx0}) ->
+ RevIdx = revidx_add(Key, Row, RevIdx0),
+ EQS#eq_system{rows=Rows#{Key => Row}, revidx=RevIdx}.
+
+eqs_put(Key, Row, EQS0) ->
+ eqs_insert(Key, Row, eqs_remove(Key, EQS0)).
+
+eqs_remove(Key, EQS=#eq_system{rows=Rows, revidx=RevIdx0}) ->
+ OldRow = maps:get(Key, Rows),
+ RevIdx = revidx_remove(Key, OldRow, RevIdx0),
+ EQS#eq_system{rows = maps:remove(Key, Rows), revidx=RevIdx}.
+
+-spec eqs_get(key(), eq_system()) -> row().
+eqs_get(Key, #eq_system{rows=Rows}) -> maps:get(Key, Rows).
+
+%% Keys of all equations containing a nonzero coefficient for Var
+-spec eqs_lookup(var(), eq_system()) -> ordsets:ordset(key()).
+eqs_lookup(Var, #eq_system{revidx=RevIdx}) -> maps:get(Var, RevIdx).
+
+%% eqs_rows(#eq_system{rows=Rows}) -> maps:to_list(Rows).
+
+%% eqs_print(EQS) ->
+%% lists:foreach(fun({_, Row}) ->
+%% row_print(Row)
+%% end, lists:sort(eqs_rows(EQS))).
+
+%% row_print(Row) ->
+%% CoefStrs = [io_lib:format("~wl~w", [Coef, Var])
+%% || {Var, Coef} <- row_coefs(Row)],
+%% CoefStr = lists:join(" + ", CoefStrs),
+%% io:format("~w = ~s~n", [row_const(Row), CoefStr]).
+
+revidx_empty() -> #{}.
+
+-spec revidx_add(key(), row(), rev_index()) -> rev_index().
+revidx_add(Key, Row, RevIdx0) ->
+ orddict:fold(fun(Var, _Coef, RevIdx1) ->
+ ?ASSERT(_Coef /= 0.0),
+ RevIdx1#{Var => ordsets:add_element(
+ Key, maps:get(Var, RevIdx1, ordsets:new()))}
+ end, RevIdx0, row_coefs(Row)).
+
+-spec revidx_remove(key(), row(), rev_index()) -> rev_index().
+revidx_remove(Key, {Coefs, _}, RevIdx0) ->
+ orddict:fold(fun(Var, _Coef, RevIdx1) ->
+ case RevIdx1 of
+ #{Var := Keys0} ->
+ case ordsets:del_element(Key, Keys0) of
+ [] -> maps:remove(Var, RevIdx1);
+ Keys -> RevIdx1#{Var := Keys}
+ end
+ end
+ end, RevIdx0, Coefs).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+-define(FAST_ITERATIONS, 5).
+
+%% @doc Computes a rough approximation of BB weights. The approximation is
+%% particularly poor (converges slowly) for recursive functions and loops.
+-spec compute_fast(cfg(), target_module(), target_context()) -> bb_weights().
+compute_fast(CFG, TgtMod, TgtCtx) ->
+ Target = {TgtMod, TgtCtx},
+ StartLb = hipe_gen_cfg:start_label(CFG),
+ RPO = reverse_postorder(CFG, Target),
+ PredProbs = [{L, pred_prob(L, CFG, Target)} || L <- RPO, L =/= StartLb],
+ Probs0 = (maps:from_list([{L, 0.0} || L <- RPO]))#{StartLb := 1.0},
+ fast_iterate(?FAST_ITERATIONS, PredProbs, Probs0).
+
+fast_iterate(0, _Pred, Probs) -> Probs;
+fast_iterate(Iters, Pred, Probs0) ->
+ fast_iterate(Iters-1, Pred,
+ fast_one(Pred, Probs0)).
+
+fast_one([{L, Pred}|Ls], Probs0) ->
+ Weight = fast_sum(Pred, Probs0, 0.0),
+ Probs = Probs0#{L => Weight},
+ fast_one(Ls, Probs);
+fast_one([], Probs) ->
+ Probs.
+
+fast_sum([{P,EWt}|Pred], Probs, Acc) when is_float(EWt), is_float(Acc) ->
+ case Probs of
+ #{P := PWt} when is_float(PWt) ->
+ fast_sum(Pred, Probs, Acc + PWt * EWt)
+ end;
+fast_sum([], _Probs, Acc) when is_float(Acc) ->
+ Acc.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Target module interface functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+-define(TGT_IFACE_0(N), N( {M,C}) -> M:N( C)).
+-define(TGT_IFACE_1(N), N(A1, {M,C}) -> M:N(A1, C)).
+-define(TGT_IFACE_2(N), N(A1,A2, {M,C}) -> M:N(A1,A2, C)).
+-define(TGT_IFACE_3(N), N(A1,A2,A3,{M,C}) -> M:N(A1,A2,A3,C)).
+
+?TGT_IFACE_2(bb).
+?TGT_IFACE_1(branch_preds).
+?TGT_IFACE_1(labels).
+?TGT_IFACE_1(reverse_postorder).
diff --git a/lib/hipe/opt/hipe_spillmin_color.erl b/lib/hipe/opt/hipe_spillmin_color.erl
index 41f1972df7..f87d9a5b61 100644
--- a/lib/hipe/opt/hipe_spillmin_color.erl
+++ b/lib/hipe/opt/hipe_spillmin_color.erl
@@ -166,9 +166,13 @@ remap_temp_map0(Cols, [_Y|Ys], SpillIndex) ->
%%
build_ig(CFG, Live, Target, TempMap) ->
- try build_ig0(CFG, Live, Target, TempMap)
- catch error:Rsn -> exit({regalloc, build_ig, Rsn})
- end.
+ TempMapping = map_spilled_temporaries(TempMap),
+ TempMappingTable = setup_ets(TempMapping),
+ NumSpilled = length(TempMapping),
+ IG = build_ig_bbs(labels(CFG, Target), CFG, Live, empty_ig(NumSpilled),
+ Target, TempMap, TempMappingTable),
+ ets:delete(TempMappingTable),
+ {normalize_ig(IG), NumSpilled}.
%% Creates an ETS table consisting of the keys given in List, with the values
%% being an integer which is the position of the key in List.
@@ -183,15 +187,6 @@ setup_ets0([X|Xs], Table, N) ->
ets:insert(Table, {X, N}),
setup_ets0(Xs, Table, N+1).
-build_ig0(CFG, Live, Target, TempMap) ->
- TempMapping = map_spilled_temporaries(TempMap),
- TempMappingTable = setup_ets(TempMapping),
- NumSpilled = length(TempMapping),
- IG = build_ig_bbs(labels(CFG, Target), CFG, Live, empty_ig(NumSpilled),
- Target, TempMap, TempMappingTable),
- ets:delete(TempMappingTable),
- {normalize_ig(IG), NumSpilled}.
-
build_ig_bbs([], _CFG, _Live, IG, _Target, _TempMap, _TempMapping) ->
IG;
build_ig_bbs([L|Ls], CFG, Live, IG, Target, TempMap, TempMapping) ->
@@ -212,16 +207,26 @@ build_ig_bb([X|Xs], LiveOut, IG, Target, TempMap, TempMapping) ->
build_ig_bb(Xs, LiveOut, IG, Target, TempMap, TempMapping),
build_ig_instr(X, Live, NewIG, Target, TempMap, TempMapping).
-build_ig_instr(X, Live, IG, Target, TempMap, TempMapping) ->
+build_ig_instr(X, Live0, IG0, Target, TempMap, TempMapping) ->
{Def, Use} = def_use(X, Target, TempMap),
- ?report3("Live ~w\n~w : Def: ~w Use ~w\n",[Live, X, Def,Use]),
+ ?report3("Live ~w\n~w : Def: ~w Use ~w\n",[Live0, X, Def,Use]),
DefListMapped = list_map(Def, TempMapping, []),
UseListMapped = list_map(Use, TempMapping, []),
DefSetMapped = ordsets:from_list(DefListMapped),
UseSetMapped = ordsets:from_list(UseListMapped),
- NewIG = interference_arcs(DefListMapped, ordsets:to_list(Live), IG),
- NewLive = ordsets:union(UseSetMapped, ordsets:subtract(Live, DefSetMapped)),
- {NewLive, NewIG}.
+ {Live1, IG1} =
+ analyze_move(X, Live0, IG0, Target, DefSetMapped, UseSetMapped),
+ IG = interference_arcs(DefListMapped, ordsets:to_list(Live1), IG1),
+ Live = ordsets:union(UseSetMapped, ordsets:subtract(Live1, DefSetMapped)),
+ {Live, IG}.
+
+analyze_move(X, Live0, IG0, Target, DefSetMapped, UseSetMapped) ->
+ case {is_spill_move(X, Target), DefSetMapped, UseSetMapped} of
+ {true, [Dst], [Src]} ->
+ {ordsets:del_element(Src, Live0), add_move(Src, Dst, IG0)};
+ {_, _, _} ->
+ {Live0, IG0}
+ end.
%% Given a list of Keys and an ets-table returns a list of the elements
%% in Mapping corresponding to the Keys and appends Acc to this list.
@@ -271,15 +276,6 @@ i_arcs(X, [Y|Ys], IG) ->
%% throw an exception (the caller should retry with more stack slots)
color(IG, StackSlots, NumNodes, Target) ->
- try
- color_0(IG, StackSlots, NumNodes, Target)
- catch
- error:Rsn ->
- ?error_msg("Coloring failed with ~p~n", [Rsn]),
- ?EXIT(Rsn)
- end.
-
-color_0(IG, StackSlots, NumNodes, Target) ->
?report("simplification of IG~n", []),
K = ordsets:size(StackSlots),
Nodes = list_ig(IG),
@@ -382,7 +378,8 @@ select_colors([{X,colorable}|Xs], IG, Cols, PhysRegs) ->
select_color(X, IG, Cols, PhysRegs) ->
UsedColors = get_colors(neighbors(X, IG), Cols),
- Reg = select_unused_color(UsedColors, PhysRegs),
+ Preferences = get_colors(move_connected(X, IG), Cols),
+ Reg = select_unused_color(UsedColors, Preferences, PhysRegs),
{Reg, set_color(X, Reg, Cols)}.
%%%%%%%%%%%%%%%%%%%%
@@ -396,10 +393,14 @@ get_colors([X|Xs], Cols) ->
[R|get_colors(Xs, Cols)]
end.
-select_unused_color(UsedColors, PhysRegs) ->
+select_unused_color(UsedColors, Preferences, PhysRegs) ->
Summary = ordsets:from_list(UsedColors),
- AvailRegs = ordsets:to_list(ordsets:subtract(PhysRegs, Summary)),
- hd(AvailRegs).
+ case ordsets:subtract(ordsets:from_list(Preferences), Summary) of
+ [PreferredColor|_] -> PreferredColor;
+ _ ->
+ AvailRegs = ordsets:to_list(ordsets:subtract(PhysRegs, Summary)),
+ hd(AvailRegs)
+ end.
push_colored(X, Stk) ->
[{X, colorable} | Stk].
@@ -456,7 +457,11 @@ init_stackslots(NumSlots, Acc) ->
%%
%% Note: later on, we may wish to add 'move-related' support.
--record(ig_info, {neighbors = [] :: [_], degree = 0 :: non_neg_integer()}).
+-record(ig_info, {
+ neighbors = [] :: [_],
+ degree = 0 :: non_neg_integer(),
+ move_connected = [] :: [_]
+ }).
empty_ig(NumNodes) ->
hipe_vectors:new(NumNodes, #ig_info{}).
@@ -467,16 +472,29 @@ degree(Info) ->
neighbors(Info) ->
Info#ig_info.neighbors.
+move_connected(Info) ->
+ Info#ig_info.move_connected.
+
add_edge(X, X, IG) -> IG;
add_edge(X, Y, IG) ->
add_arc(X, Y, add_arc(Y, X, IG)).
+add_move(X, X, IG) -> IG;
+add_move(X, Y, IG) ->
+ add_move_arc(X, Y, add_move_arc(Y, X, IG)).
+
add_arc(X, Y, IG) ->
Info = hipe_vectors:get(IG, X),
Old = neighbors(Info),
New = Info#ig_info{neighbors = [Y|Old]},
hipe_vectors:set(IG,X,New).
+add_move_arc(X, Y, IG) ->
+ Info = hipe_vectors:get(IG, X),
+ Old = move_connected(Info),
+ New = Info#ig_info{move_connected = [Y|Old]},
+ hipe_vectors:set(IG,X,New).
+
normalize_ig(IG) ->
Size = hipe_vectors:size(IG),
normalize_ig(Size-1, IG).
@@ -486,7 +504,8 @@ normalize_ig(-1, IG) ->
normalize_ig(I, IG) ->
Info = hipe_vectors:get(IG, I),
N = ordsets:from_list(neighbors(Info)),
- NewInfo = Info#ig_info{neighbors = N, degree = length(N)},
+ M = ordsets:subtract(ordsets:from_list(move_connected(Info)), N),
+ NewInfo = Info#ig_info{neighbors = N, degree = length(N), move_connected = M},
NewIG = hipe_vectors:set(IG, I, NewInfo),
normalize_ig(I-1, NewIG).
@@ -494,6 +513,10 @@ neighbors(X, IG) ->
Info = hipe_vectors:get(IG, X),
Info#ig_info.neighbors.
+move_connected(X, IG) ->
+ Info = hipe_vectors:get(IG, X),
+ Info#ig_info.move_connected.
+
decrement_degree(X, IG) ->
Info = hipe_vectors:get(IG, X),
Degree = degree(Info),
@@ -555,3 +578,6 @@ def_use(X, Target={TgtMod,TgtCtx}, TempMap) ->
reg_names(Regs, {TgtMod,TgtCtx}) ->
[TgtMod:reg_nr(X,TgtCtx) || X <- Regs].
+
+is_spill_move(Instr, {TgtMod,TgtCtx}) ->
+ TgtMod:is_spill_move(Instr, TgtCtx).
diff --git a/lib/hipe/ppc/hipe_ppc.erl b/lib/hipe/ppc/hipe_ppc.erl
index df9f193fa3..63ecd0a0b8 100644
--- a/lib/hipe/ppc/hipe_ppc.erl
+++ b/lib/hipe/ppc/hipe_ppc.erl
@@ -98,6 +98,9 @@
pseudo_move_dst/1,
pseudo_move_src/1,
+ mk_pseudo_spill_move/3,
+ is_pseudo_spill_move/1,
+
mk_pseudo_tailcall/4,
pseudo_tailcall_func/1,
pseudo_tailcall_stkargs/1,
@@ -131,6 +134,9 @@
pseudo_fmove_dst/1,
pseudo_fmove_src/1,
+ mk_pseudo_spill_fmove/3,
+ is_pseudo_spill_fmove/1,
+
mk_defun/8,
defun_mfa/1,
defun_formals/1,
@@ -412,6 +418,10 @@ is_pseudo_move(I) -> case I of #pseudo_move{} -> true; _ -> false end.
pseudo_move_dst(#pseudo_move{dst=Dst}) -> Dst.
pseudo_move_src(#pseudo_move{src=Src}) -> Src.
+mk_pseudo_spill_move(Dst, Temp, Src) ->
+ #pseudo_spill_move{dst=Dst, temp=Temp, src=Src}.
+is_pseudo_spill_move(I) -> is_record(I, pseudo_spill_move).
+
mk_pseudo_tailcall(FunC, Arity, StkArgs, Linkage) ->
#pseudo_tailcall{func=FunC, arity=Arity, stkargs=StkArgs, linkage=Linkage}.
pseudo_tailcall_func(#pseudo_tailcall{func=FunC}) -> FunC.
@@ -495,6 +505,10 @@ is_pseudo_fmove(I) -> case I of #pseudo_fmove{} -> true; _ -> false end.
pseudo_fmove_dst(#pseudo_fmove{dst=Dst}) -> Dst.
pseudo_fmove_src(#pseudo_fmove{src=Src}) -> Src.
+mk_pseudo_spill_fmove(Dst, Temp, Src) ->
+ #pseudo_spill_fmove{dst=Dst, temp=Temp, src=Src}.
+is_pseudo_spill_fmove(I) -> is_record(I, pseudo_spill_fmove).
+
mk_defun(MFA, Formals, IsClosure, IsLeaf, Code, Data, VarRange, LabelRange) ->
#defun{mfa=MFA, formals=Formals, code=Code, data=Data,
isclosure=IsClosure, isleaf=IsLeaf,
diff --git a/lib/hipe/ppc/hipe_ppc.hrl b/lib/hipe/ppc/hipe_ppc.hrl
index a96692c52e..3eef8be487 100644
--- a/lib/hipe/ppc/hipe_ppc.hrl
+++ b/lib/hipe/ppc/hipe_ppc.hrl
@@ -87,6 +87,7 @@
-record(pseudo_call_prepare, {nrstkargs}).
-record(pseudo_li, {dst, imm}).
-record(pseudo_move, {dst, src}).
+-record(pseudo_spill_move, {dst, temp, src}).
-record(pseudo_tailcall, {func, arity, stkargs, linkage}).
-record(pseudo_tailcall_prepare, {}).
-record(store, {stop, src, disp, base}). % non-indexed, non-update form
@@ -99,6 +100,7 @@
-record(fp_binary, {fp_binop, dst, src1, src2}).
-record(fp_unary, {fp_unop, dst, src}).
-record(pseudo_fmove, {dst, src}).
+-record(pseudo_spill_fmove, {dst, temp, src}).
%%% Function definitions.
diff --git a/lib/hipe/ppc/hipe_ppc_cfg.erl b/lib/hipe/ppc/hipe_ppc_cfg.erl
index f17c0ac503..d44d38f38d 100644
--- a/lib/hipe/ppc/hipe_ppc_cfg.erl
+++ b/lib/hipe/ppc/hipe_ppc_cfg.erl
@@ -21,8 +21,8 @@
bb/2, bb_add/3]).
-export([postorder/1]).
-export([linearise/1, params/1, reverse_postorder/1]).
--export([arity/1]).
-%%%-export([redirect_jmp/3, arity/1]).
+-export([redirect_jmp/3, arity/1]).
+-export([branch_preds/1]).
%%% these tell cfg.inc what to define (ugly as hell)
-define(BREADTH_ORDER,true).
@@ -75,11 +75,30 @@ branch_successors(Branch) ->
#pseudo_tailcall{} -> []
end.
+branch_preds(Branch) ->
+ case Branch of
+ #bctr{labels=Labels} ->
+ Prob = 1.0/length(Labels),
+ [{L, Prob} || L <- Labels];
+ #pseudo_bc{true_label=TrueLab,false_label=FalseLab,pred=Pred} ->
+ [{FalseLab, 1.0-Pred}, {TrueLab, Pred}];
+ #pseudo_call{contlab=ContLab, sdesc=#ppc_sdesc{exnlab=[]}} ->
+ %% A function can still cause an exception, even if we won't catch it
+ [{ContLab, 1.0-hipe_bb_weights:call_exn_pred()}];
+ #pseudo_call{contlab=ContLab, sdesc=#ppc_sdesc{exnlab=ExnLab}} ->
+ CallExnPred = hipe_bb_weights:call_exn_pred(),
+ [{ContLab, 1.0-CallExnPred}, {ExnLab, CallExnPred}];
+ _ ->
+ case branch_successors(Branch) of
+ [] -> [];
+ [Single] -> [{Single, 1.0}]
+ end
+ end.
+
-ifdef(REMOVE_TRIVIAL_BBS_NEEDED).
fails_to(_Instr) -> [].
-endif.
--ifdef(notdef).
redirect_jmp(I, Old, New) ->
case I of
#b_label{label=Label} ->
@@ -93,10 +112,16 @@ redirect_jmp(I, Old, New) ->
if Old =:= FalseLab -> I1#pseudo_bc{false_label=New};
true -> I1
end;
- %% handle pseudo_call too?
- _ -> I
+ #pseudo_call{sdesc=SDesc0, contlab=ContLab0} ->
+ SDesc = case SDesc0 of
+ #ppc_sdesc{exnlab=Old} -> SDesc0#ppc_sdesc{exnlab=New};
+ #ppc_sdesc{exnlab=_} -> SDesc0
+ end,
+ ContLab = if Old =:= ContLab0 -> New;
+ true -> ContLab0
+ end,
+ I#pseudo_call{sdesc=SDesc, contlab=ContLab}
end.
--endif.
mk_goto(Label) ->
hipe_ppc:mk_b_label(Label).
diff --git a/lib/hipe/ppc/hipe_ppc_defuse.erl b/lib/hipe/ppc/hipe_ppc_defuse.erl
index 9a99611493..d8a864f7d5 100644
--- a/lib/hipe/ppc/hipe_ppc_defuse.erl
+++ b/lib/hipe/ppc/hipe_ppc_defuse.erl
@@ -41,6 +41,7 @@ insn_def_gpr(I) ->
#pseudo_call{} -> call_clobbered_gpr();
#pseudo_li{dst=Dst} -> [Dst];
#pseudo_move{dst=Dst} -> [Dst];
+ #pseudo_spill_move{dst=Dst,temp=Temp} -> [Dst, Temp];
#pseudo_tailcall_prepare{} -> tailcall_clobbered_gpr();
#unary{dst=Dst} -> [Dst];
_ -> []
@@ -71,6 +72,7 @@ insn_use_gpr(I) ->
#mtspr{src=Src} -> [Src];
#pseudo_call{sdesc=#ppc_sdesc{arity=Arity}} -> arity_use_gpr(Arity);
#pseudo_move{src=Src} -> [Src];
+ #pseudo_spill_move{src=Src} -> [Src];
#pseudo_tailcall{arity=Arity,stkargs=StkArgs} ->
addsrcs(StkArgs, addtemps(tailcall_clobbered_gpr(), arity_use_gpr(Arity)));
#store{src=Src,base=Base} -> addtemp(Src, [Base]);
@@ -110,6 +112,7 @@ insn_def_fpr(I) ->
#fp_binary{dst=Dst} -> [Dst];
#fp_unary{dst=Dst} -> [Dst];
#pseudo_fmove{dst=Dst} -> [Dst];
+ #pseudo_spill_fmove{dst=Dst,temp=Temp} -> [Dst, Temp];
_ -> []
end.
@@ -126,6 +129,7 @@ insn_use_fpr(I) ->
#fp_binary{src1=Src1,src2=Src2} -> addtemp(Src1, [Src2]);
#fp_unary{src=Src} -> [Src];
#pseudo_fmove{src=Src} -> [Src];
+ #pseudo_spill_fmove{src=Src} -> [Src];
_ -> []
end.
diff --git a/lib/hipe/ppc/hipe_ppc_frame.erl b/lib/hipe/ppc/hipe_ppc_frame.erl
index a91cb18cc2..b88b75a5bd 100644
--- a/lib/hipe/ppc/hipe_ppc_frame.erl
+++ b/lib/hipe/ppc/hipe_ppc_frame.erl
@@ -66,10 +66,14 @@ do_insn(I, LiveOut, Context, FPoff) ->
do_pseudo_call_prepare(I, FPoff);
#pseudo_move{} ->
{do_pseudo_move(I, Context, FPoff), FPoff};
+ #pseudo_spill_move{} ->
+ {do_pseudo_spill_move(I, Context, FPoff), FPoff};
#pseudo_tailcall{} ->
{do_pseudo_tailcall(I, Context), context_framesize(Context)};
#pseudo_fmove{} ->
{do_pseudo_fmove(I, Context, FPoff), FPoff};
+ #pseudo_spill_fmove{} ->
+ {do_pseudo_spill_fmove(I, Context, FPoff), FPoff};
_ ->
{[I], FPoff}
end.
@@ -98,6 +102,22 @@ do_pseudo_move(I, Context, FPoff) ->
end
end.
+do_pseudo_spill_move(I, Context, FPoff) ->
+ #pseudo_spill_move{dst=Dst,temp=Temp,src=Src} = I,
+ case temp_is_pseudo(Src) andalso temp_is_pseudo(Dst) of
+ false -> % Register allocator changed its mind, turn back to move
+ do_pseudo_move(hipe_ppc:mk_pseudo_move(Dst, Src), Context, FPoff);
+ true ->
+ SrcOffset = pseudo_offset(Src, FPoff, Context),
+ DstOffset = pseudo_offset(Dst, FPoff, Context),
+ case SrcOffset =:= DstOffset of
+ true -> []; % omit move-to-self
+ false ->
+ mk_load(hipe_ppc:ldop_word(), Temp, SrcOffset, mk_sp(),
+ mk_store(hipe_ppc:stop_word(), Temp, DstOffset, mk_sp(), []))
+ end
+ end.
+
do_pseudo_fmove(I, Context, FPoff) ->
Dst = hipe_ppc:pseudo_fmove_dst(I),
Src = hipe_ppc:pseudo_fmove_src(I),
@@ -115,6 +135,22 @@ do_pseudo_fmove(I, Context, FPoff) ->
end
end.
+do_pseudo_spill_fmove(I, Context, FPoff) ->
+ #pseudo_spill_fmove{dst=Dst,temp=Temp,src=Src} = I,
+ case temp_is_pseudo(Src) andalso temp_is_pseudo(Dst) of
+ false -> % Register allocator changed its mind, turn back to move
+ do_pseudo_fmove(hipe_ppc:mk_pseudo_fmove(Dst, Src), Context, FPoff);
+ true ->
+ SrcOffset = pseudo_offset(Src, FPoff, Context),
+ DstOffset = pseudo_offset(Dst, FPoff, Context),
+ case SrcOffset =:= DstOffset of
+ true -> []; % omit move-to-self
+ false ->
+ hipe_ppc:mk_fload(Temp, SrcOffset, mk_sp(), 0)
+ ++ hipe_ppc:mk_fstore(Temp, DstOffset, mk_sp(), 0)
+ end
+ end.
+
pseudo_offset(Temp, FPoff, Context) ->
FPoff + context_offset(Context, Temp).
diff --git a/lib/hipe/ppc/hipe_ppc_ra_finalise.erl b/lib/hipe/ppc/hipe_ppc_ra_finalise.erl
index 74ef7475eb..bca504d754 100644
--- a/lib/hipe/ppc/hipe_ppc_ra_finalise.erl
+++ b/lib/hipe/ppc/hipe_ppc_ra_finalise.erl
@@ -41,6 +41,7 @@ ra_insn(I, Map, FPMap) ->
#mtspr{} -> ra_mtspr(I, Map);
#pseudo_li{} -> ra_pseudo_li(I, Map);
#pseudo_move{} -> ra_pseudo_move(I, Map);
+ #pseudo_spill_move{} -> ra_pseudo_spill_move(I, Map);
#pseudo_tailcall{} -> ra_pseudo_tailcall(I, Map);
#store{} -> ra_store(I, Map);
#storex{} -> ra_storex(I, Map);
@@ -52,6 +53,7 @@ ra_insn(I, Map, FPMap) ->
#fp_binary{} -> ra_fp_binary(I, FPMap);
#fp_unary{} -> ra_fp_unary(I, FPMap);
#pseudo_fmove{} -> ra_pseudo_fmove(I, FPMap);
+ #pseudo_spill_fmove{} -> ra_pseudo_spill_fmove(I, FPMap);
_ -> I
end.
@@ -98,6 +100,12 @@ ra_pseudo_move(I=#pseudo_move{dst=Dst,src=Src}, Map) ->
NewSrc = ra_temp(Src, Map),
I#pseudo_move{dst=NewDst,src=NewSrc}.
+ra_pseudo_spill_move(I=#pseudo_spill_move{dst=Dst,temp=Temp,src=Src}, Map) ->
+ NewDst = ra_temp(Dst, Map),
+ NewTemp = ra_temp(Temp, Map),
+ NewSrc = ra_temp(Src, Map),
+ I#pseudo_spill_move{dst=NewDst,temp=NewTemp,src=NewSrc}.
+
ra_pseudo_tailcall(I=#pseudo_tailcall{stkargs=StkArgs}, Map) ->
NewStkArgs = ra_args(StkArgs, Map),
I#pseudo_tailcall{stkargs=NewStkArgs}.
@@ -156,6 +164,13 @@ ra_pseudo_fmove(I=#pseudo_fmove{dst=Dst,src=Src}, FPMap) ->
NewSrc = ra_temp_fp(Src, FPMap),
I#pseudo_fmove{dst=NewDst,src=NewSrc}.
+ra_pseudo_spill_fmove(I=#pseudo_spill_fmove{dst=Dst,temp=Temp,src=Src},
+ FPMap) ->
+ NewDst = ra_temp_fp(Dst, FPMap),
+ NewTemp = ra_temp_fp(Temp, FPMap),
+ NewSrc = ra_temp_fp(Src, FPMap),
+ I#pseudo_spill_fmove{dst=NewDst,temp=NewTemp,src=NewSrc}.
+
ra_args([Arg|Args], Map) ->
[ra_temp_or_imm(Arg, Map) | ra_args(Args, Map)];
ra_args([], _) ->
diff --git a/lib/hipe/ppc/hipe_ppc_ra_postconditions.erl b/lib/hipe/ppc/hipe_ppc_ra_postconditions.erl
index 95aa294fe5..0a97129666 100644
--- a/lib/hipe/ppc/hipe_ppc_ra_postconditions.erl
+++ b/lib/hipe/ppc/hipe_ppc_ra_postconditions.erl
@@ -57,6 +57,7 @@ do_insn(I, TempMap, Strategy) ->
#mtspr{} -> do_mtspr(I, TempMap, Strategy);
#pseudo_li{} -> do_pseudo_li(I, TempMap, Strategy);
#pseudo_move{} -> do_pseudo_move(I, TempMap, Strategy);
+ #pseudo_spill_move{} -> do_pseudo_spill_move(I, TempMap, Strategy);
#store{} -> do_store(I, TempMap, Strategy);
#storex{} -> do_storex(I, TempMap, Strategy);
#unary{} -> do_unary(I, TempMap, Strategy);
@@ -117,18 +118,25 @@ do_pseudo_li(I=#pseudo_li{dst=Dst}, TempMap, Strategy) ->
do_pseudo_move(I=#pseudo_move{dst=Dst,src=Src}, TempMap, Strategy) ->
%% Either Dst or Src (but not both) may be a pseudo temp.
- %% pseudo_move and pseudo_tailcall are special cases: in
- %% all other instructions, all temps must be non-pseudos
- %% after register allocation.
- case temp_is_spilled(Dst, TempMap) of
- true -> % Src must not be a pseudo
- {FixSrc,NewSrc,DidSpill} = fix_src1(Src, TempMap, Strategy),
- NewI = I#pseudo_move{src=NewSrc},
- {FixSrc ++ [NewI], DidSpill};
+ %% pseudo_move, pseudo_spill_move, and pseudo_tailcall are
+ %% special cases: in all other instructions, all temps
+ %% must be non-pseudos after register allocation.
+ case temp_is_spilled(Src, TempMap)
+ andalso temp_is_spilled(Dst, TempMap)
+ of
+ true -> % Turn into pseudo_spill_move
+ Temp = clone(Src, temp1(Strategy)),
+ NewI = #pseudo_spill_move{dst=Dst,temp=Temp,src=Src},
+ {[NewI], true};
_ ->
{[I], false}
end.
+do_pseudo_spill_move(I=#pseudo_spill_move{temp=Temp}, TempMap, _Strategy) ->
+ %% Temp is above the low water mark and must not have been spilled
+ false = temp_is_spilled(Temp, TempMap),
+ {[I], false}.
+
do_store(I=#store{src=Src,base=Base}, TempMap, Strategy) ->
{FixSrc,NewSrc,DidSpill1} = fix_src1(Src, TempMap, Strategy),
{FixBase,NewBase,DidSpill2} = fix_src2(Base, TempMap, Strategy),
diff --git a/lib/hipe/ppc/hipe_ppc_ra_postconditions_fp.erl b/lib/hipe/ppc/hipe_ppc_ra_postconditions_fp.erl
index 5ec5f29577..7342053620 100644
--- a/lib/hipe/ppc/hipe_ppc_ra_postconditions_fp.erl
+++ b/lib/hipe/ppc/hipe_ppc_ra_postconditions_fp.erl
@@ -42,6 +42,7 @@ do_insn(I, TempMap) ->
#fp_binary{} -> do_fp_binary(I, TempMap);
#fp_unary{} -> do_fp_unary(I, TempMap);
#pseudo_fmove{} -> do_pseudo_fmove(I, TempMap);
+ #pseudo_spill_fmove{} -> do_pseudo_spill_fmove(I, TempMap);
_ -> {[I], false}
end.
@@ -81,15 +82,22 @@ do_fp_unary(I=#fp_unary{dst=Dst,src=Src}, TempMap) ->
{FixSrc ++ [NewI | FixDst], DidSpill1 or DidSpill2}.
do_pseudo_fmove(I=#pseudo_fmove{dst=Dst,src=Src}, TempMap) ->
- case temp_is_spilled(Dst, TempMap) of
- true ->
- {FixSrc,NewSrc,DidSpill} = fix_src(Src, TempMap),
- NewI = I#pseudo_fmove{src=NewSrc},
- {FixSrc ++ [NewI], DidSpill};
+ case temp_is_spilled(Src, TempMap)
+ andalso temp_is_spilled(Dst, TempMap)
+ of
+ true -> % Turn into pseudo_spill_fmove
+ Temp = clone(Src),
+ NewI = #pseudo_spill_fmove{dst=Dst,temp=Temp,src=Src},
+ {[NewI], true};
_ ->
{[I], false}
end.
+do_pseudo_spill_fmove(I=#pseudo_spill_fmove{temp=Temp}, TempMap) ->
+ %% Temp is above the low water mark and must not have been spilled
+ false = temp_is_spilled(Temp, TempMap),
+ {[I], false}.
+
%%% Fix Dst and Src operands.
fix_src(Src, TempMap) ->
diff --git a/lib/hipe/ppc/hipe_ppc_subst.erl b/lib/hipe/ppc/hipe_ppc_subst.erl
index 1cd18b5c01..e282b22774 100644
--- a/lib/hipe/ppc/hipe_ppc_subst.erl
+++ b/lib/hipe/ppc/hipe_ppc_subst.erl
@@ -48,6 +48,8 @@ insn_temps(T, I) ->
#pseudo_call_prepare{} -> I;
#pseudo_li{dst=D} -> I#pseudo_li{dst=T(D)};
#pseudo_move{dst=D,src=S} -> I#pseudo_move{dst=T(D),src=T(S)};
+ #pseudo_spill_move{dst=D,temp=U,src=S} ->
+ I#pseudo_spill_move{dst=T(D),temp=T(U),src=T(S)};
#pseudo_tailcall{func=F,stkargs=Stk} when not is_record(F, ppc_temp) ->
I#pseudo_tailcall{stkargs=lists:map(A,Stk)};
#pseudo_tailcall_prepare{} -> I;
@@ -62,7 +64,9 @@ insn_temps(T, I) ->
#fp_binary{dst=D,src1=L,src2=R} ->
I#fp_binary{dst=T(D),src1=T(L),src2=T(R)};
#fp_unary{dst=D,src=S} -> I#fp_unary{dst=T(D),src=T(S)};
- #pseudo_fmove{dst=D,src=S} -> I#pseudo_fmove{dst=T(D),src=T(S)}
+ #pseudo_fmove{dst=D,src=S} -> I#pseudo_fmove{dst=T(D),src=T(S)};
+ #pseudo_spill_fmove{dst=D,temp=U,src=S} ->
+ I#pseudo_spill_fmove{dst=T(D),temp=T(U),src=T(S)}
end.
-spec oper_temps(subst_fun(), oper()) -> oper().
diff --git a/lib/hipe/regalloc/Makefile b/lib/hipe/regalloc/Makefile
index 209f230a9b..81a92e5d35 100644
--- a/lib/hipe/regalloc/Makefile
+++ b/lib/hipe/regalloc/Makefile
@@ -50,8 +50,10 @@ MODULES = hipe_ig hipe_ig_moves hipe_moves \
hipe_optimistic_regalloc \
hipe_coalescing_regalloc \
hipe_graph_coloring_regalloc \
+ hipe_range_split \
hipe_regalloc_loop \
hipe_regalloc_prepass \
+ hipe_restore_reuse \
hipe_ls_regalloc \
hipe_ppc_specific hipe_ppc_specific_fp \
hipe_sparc_specific hipe_sparc_specific_fp \
diff --git a/lib/hipe/regalloc/hipe_amd64_specific_sse2.erl b/lib/hipe/regalloc/hipe_amd64_specific_sse2.erl
index 9682d37520..d592ba391c 100644
--- a/lib/hipe/regalloc/hipe_amd64_specific_sse2.erl
+++ b/lib/hipe/regalloc/hipe_amd64_specific_sse2.erl
@@ -30,6 +30,7 @@
def_use/2,
is_arg/2, %% used by hipe_ls_regalloc
is_move/2,
+ is_spill_move/2,
is_fixed/2, %% used by hipe_graph_coloring_regalloc
is_global/2,
is_precoloured/2,
@@ -50,12 +51,19 @@
-export([check_and_rewrite/3,
check_and_rewrite/4]).
-%% callbacks for hipe_regalloc_prepass
--export([new_reg_nr/1,
+%% callbacks for hipe_regalloc_prepass, hipe_range_split
+-export([mk_move/3,
+ mk_goto/2,
+ redirect_jmp/4,
+ new_label/1,
+ new_reg_nr/1,
update_reg_nr/3,
update_bb/4,
subst_temps/3]).
+%% callbacks for hipe_bb_weights
+-export([branch_preds/2]).
+
%%----------------------------------------------------------------------------
-include("../flow/cfg.hrl").
@@ -152,6 +160,9 @@ bb(CFG, L, _) ->
update_bb(CFG,L,BB,_) ->
hipe_x86_cfg:bb_add(CFG,L,BB).
+branch_preds(Instr,_) ->
+ hipe_x86_cfg:branch_preds(Instr).
+
%% AMD64 stuff
def_use(Instruction, _) ->
@@ -184,10 +195,34 @@ is_move(Instruction, _) ->
andalso hipe_x86:is_temp(Dst) andalso hipe_x86:temp_is_allocatable(Dst);
false -> false
end.
+
+is_spill_move(Instruction,_) ->
+ hipe_x86:is_pseudo_spill_fmove(Instruction).
reg_nr(Reg, _) ->
hipe_x86:temp_reg(Reg).
+mk_move(Src, Dst, _) ->
+ hipe_x86:mk_fmove(Src, Dst).
+
+mk_goto(Label, _) ->
+ hipe_x86:mk_jmp_label(Label).
+
+redirect_jmp(Jmp, ToOld, ToNew, _) when is_integer(ToOld), is_integer(ToNew) ->
+ Ref = make_ref(),
+ put(Ref, false),
+ I = hipe_x86_subst:insn_lbls(
+ fun(Tgt) ->
+ if Tgt =:= ToOld -> put(Ref, true), ToNew;
+ is_integer(Tgt) -> Tgt
+ end
+ end, Jmp),
+ true = erase(Ref), % Assert that something was rewritten
+ I.
+
+new_label(_) ->
+ hipe_gensym:get_next_label(x86).
+
new_reg_nr(_) ->
hipe_gensym:get_next_var(x86).
diff --git a/lib/hipe/regalloc/hipe_arm_specific.erl b/lib/hipe/regalloc/hipe_arm_specific.erl
index cef22e5af9..7ebc6aa336 100644
--- a/lib/hipe/regalloc/hipe_arm_specific.erl
+++ b/lib/hipe/regalloc/hipe_arm_specific.erl
@@ -24,6 +24,7 @@
,reg_nr/2
,def_use/2
,is_move/2
+ ,is_spill_move/2
,is_precoloured/2
,var_range/2
,allocatable/1
@@ -46,12 +47,19 @@
%% callbacks for hipe_regalloc_loop
-export([check_and_rewrite/3]).
-%% callbacks for hipe_regalloc_prepass
--export([new_reg_nr/1,
+%% callbacks for hipe_regalloc_prepass, hipe_range_split
+-export([mk_move/3,
+ mk_goto/2,
+ redirect_jmp/4,
+ new_label/1,
+ new_reg_nr/1,
update_reg_nr/3,
update_bb/4,
subst_temps/3]).
+%% callbacks for hipe_bb_weights, hipe_range_split
+-export([branch_preds/2]).
+
check_and_rewrite(CFG, Coloring, no_context) ->
hipe_arm_ra_postconditions:check_and_rewrite(CFG, Coloring, 'normal').
@@ -115,6 +123,9 @@ bb(CFG,L,_) ->
update_bb(CFG,L,BB,_) ->
hipe_arm_cfg:bb_add(CFG,L,BB).
+branch_preds(Branch,_) ->
+ hipe_arm_cfg:branch_preds(Branch).
+
%% ARM stuff
def_use(Instruction, Ctx) ->
@@ -144,9 +155,33 @@ is_move(Instruction, _) ->
false -> false
end.
+is_spill_move(Instruction, _) ->
+ hipe_arm:is_pseudo_spill_move(Instruction).
+
reg_nr(Reg, _) ->
hipe_arm:temp_reg(Reg).
+mk_move(Src, Dst, _) ->
+ hipe_arm:mk_pseudo_move(Dst, Src).
+
+mk_goto(Label, _) ->
+ hipe_arm:mk_b_label(Label).
+
+redirect_jmp(Jmp, ToOld, ToNew, _) when is_integer(ToOld), is_integer(ToNew) ->
+ Ref = make_ref(),
+ put(Ref, false),
+ I = hipe_arm_subst:insn_lbls(
+ fun(Tgt) ->
+ if Tgt =:= ToOld -> put(Ref, true), ToNew;
+ is_integer(Tgt) -> Tgt
+ end
+ end, Jmp),
+ true = erase(Ref), % Assert that something was rewritten
+ I.
+
+new_label(_) ->
+ hipe_gensym:get_next_label(arm).
+
new_reg_nr(_) ->
hipe_gensym:get_next_var(arm).
diff --git a/lib/hipe/regalloc/hipe_ppc_specific.erl b/lib/hipe/regalloc/hipe_ppc_specific.erl
index a6450b4d96..81bb551bd2 100644
--- a/lib/hipe/regalloc/hipe_ppc_specific.erl
+++ b/lib/hipe/regalloc/hipe_ppc_specific.erl
@@ -24,6 +24,7 @@
,reg_nr/2
,def_use/2
,is_move/2
+ ,is_spill_move/2
,is_precoloured/2
,var_range/2
,allocatable/1
@@ -46,12 +47,19 @@
%% callbacks for hipe_regalloc_loop
-export([check_and_rewrite/3]).
-%% callbacks for hipe_regalloc_prepass
--export([new_reg_nr/1,
+%% callbacks for hipe_regalloc_prepass, hipe_range_split
+-export([mk_move/3,
+ mk_goto/2,
+ redirect_jmp/4,
+ new_label/1,
+ new_reg_nr/1,
update_reg_nr/3,
update_bb/4,
subst_temps/3]).
+%% callbacks for hipe_bb_weights
+-export([branch_preds/2]).
+
check_and_rewrite(CFG, Coloring, _) ->
hipe_ppc_ra_postconditions:check_and_rewrite(CFG, Coloring, 'normal').
@@ -115,6 +123,9 @@ bb(CFG,L,_) ->
update_bb(CFG,L,BB,_) ->
hipe_ppc_cfg:bb_add(CFG,L,BB).
+branch_preds(Instr,_) ->
+ hipe_ppc_cfg:branch_preds(Instr).
+
%% PowerPC stuff
def_use(Instruction, Ctx) ->
@@ -144,9 +155,24 @@ is_move(Instruction, _) ->
false -> false
end.
+is_spill_move(Instruction, _) ->
+ hipe_ppc:is_pseudo_spill_move(Instruction).
+
reg_nr(Reg, _) ->
hipe_ppc:temp_reg(Reg).
+mk_move(Src, Dst, _) ->
+ hipe_ppc:mk_pseudo_move(Dst, Src).
+
+mk_goto(Label, _) ->
+ hipe_ppc:mk_b_label(Label).
+
+redirect_jmp(Jmp, ToOld, ToNew, _) when is_integer(ToOld), is_integer(ToNew) ->
+ hipe_ppc_cfg:redirect_jmp(Jmp, ToOld, ToNew).
+
+new_label(_) ->
+ hipe_gensym:get_next_label(ppc).
+
new_reg_nr(_) ->
hipe_gensym:get_next_var(ppc).
diff --git a/lib/hipe/regalloc/hipe_ppc_specific_fp.erl b/lib/hipe/regalloc/hipe_ppc_specific_fp.erl
index 23cb6c0318..dcfdf6592c 100644
--- a/lib/hipe/regalloc/hipe_ppc_specific_fp.erl
+++ b/lib/hipe/regalloc/hipe_ppc_specific_fp.erl
@@ -24,6 +24,7 @@
,reg_nr/2
,def_use/2
,is_move/2
+ ,is_spill_move/2
,is_precoloured/2
,var_range/2
,allocatable/1
@@ -46,12 +47,19 @@
%% callbacks for hipe_regalloc_loop
-export([check_and_rewrite/3]).
-%% callbacks for hipe_regalloc_prepass
--export([new_reg_nr/1,
+%% callbacks for hipe_regalloc_prepass, hipe_range_split
+-export([mk_move/3,
+ mk_goto/2,
+ redirect_jmp/4,
+ new_label/1,
+ new_reg_nr/1,
update_reg_nr/3,
update_bb/4,
subst_temps/3]).
+%% callbacks for hipe_bb_weights
+-export([branch_preds/2]).
+
check_and_rewrite(CFG, Coloring, _) ->
hipe_ppc_ra_postconditions_fp:check_and_rewrite(CFG, Coloring).
@@ -108,6 +116,9 @@ bb(CFG, L, _) ->
update_bb(CFG,L,BB,_) ->
hipe_ppc_cfg:bb_add(CFG,L,BB).
+branch_preds(Instr,_) ->
+ hipe_ppc_cfg:branch_preds(Instr).
+
%% PowerPC stuff
def_use(I, Ctx) ->
@@ -125,9 +136,24 @@ defines_all_alloc(I, _) ->
is_move(I, _) ->
hipe_ppc:is_pseudo_fmove(I).
+is_spill_move(I, _) ->
+ hipe_ppc:is_pseudo_spill_fmove(I).
+
reg_nr(Reg, _) ->
hipe_ppc:temp_reg(Reg).
+mk_move(Src, Dst, _) ->
+ hipe_ppc:mk_pseudo_fmove(Dst, Src).
+
+mk_goto(Label, _) ->
+ hipe_ppc:mk_b_label(Label).
+
+redirect_jmp(Jmp, ToOld, ToNew, _) when is_integer(ToOld), is_integer(ToNew) ->
+ hipe_ppc_cfg:redirect_jmp(Jmp, ToOld, ToNew).
+
+new_label(_) ->
+ hipe_gensym:get_next_label(ppc).
+
new_reg_nr(_) ->
hipe_gensym:get_next_var(ppc).
diff --git a/lib/hipe/regalloc/hipe_range_split.erl b/lib/hipe/regalloc/hipe_range_split.erl
new file mode 100644
index 0000000000..39b086d9f7
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_range_split.erl
@@ -0,0 +1,1187 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%@doc
+%% TEMPORARY LIVE RANGE SPLITTING PASS
+%%
+%% Live range splitting is useful to allow a register allocator to allocate a
+%% temporary to register for a part of its lifetime, even if it cannot be for
+%% the entirety. This improves register allocation quality, at the cost of
+%% making the allocation problem more time and memory intensive to solve.
+%%
+%% Optimal allocation can be achieved if all temporaries are split at every
+%% program point (between all instructions), but this makes register allocation
+%% infeasably slow in practice. Instead, this module uses heuristics to choose
+%% which temporaries should have their live ranges split, and at which points.
+%%
+%% The range splitter only considers temps which are live during a call
+%% instruction, since they're known to be spilled. The control-flow graph is
+%% partitioned at call instructions and splitting decisions are made separately
+%% for each partition. The register copy of a temp (if any) gets a separate name
+%% in each partition.
+%%
+%% There are three different ways the range splitter may choose to split a
+%% temporary in a program partition:
+%%
+%% * Mode1: Spill the temp before calls, and restore it after them
+%% * Mode2: Spill the temp after definitions, restore it after calls
+%% * Mode3: Spill the temp after definitions, restore it before uses
+%%
+%% To pick which of these should be used for each temp×partiton pair, the range
+%% splitter uses a cost function. The cost is simply the sum of the cost of all
+%% expected stack accesses, and the cost for an individual stack access is based
+%% on the probability weight of the basic block that it resides in. This biases
+%% the range splitter so that it attempts moving stack accesses from a functions
+%% hot path to the cold path.
+%%
+%% The heuristic has a couple of tuning knobs, adjusting its preference for
+%% different spilling modes, aggressiveness, and how much influence the basic
+%% block probability weights have.
+%%
+%% Edge case not handled: Call instructions directly defining a pseudo. In that
+%% case, if that pseudo has been selected for mode2 spills, no spill is inserted
+%% after the call.
+-module(hipe_range_split).
+
+-export([split/5]).
+
+-compile(inline).
+
+%% -define(DO_ASSERT, 1).
+%% -define(DEBUG, 1).
+-include("../main/hipe.hrl").
+
+%% Heuristic tuning constants
+-define(DEFAULT_MIN_GAIN, 1.1). % option: range_split_min_gain
+-define(DEFAULT_MODE1_FUDGE, 1.1). % option: range_split_mode1_fudge
+-define(DEFAULT_WEIGHT_POWER, 2). % option: range_split_weight_power
+-define(WEIGHT_CONST_FUN(Power), math:log(Power)/math:log(100)).
+-define(WEIGHT_FUN(Wt, Const), math:pow(Wt, Const)).
+-define(HEUR_MAX_TEMPS, 20000).
+
+-type target_cfg() :: any().
+-type target_instr() :: any().
+-type target_temp() :: any().
+-type liveness() :: any().
+-type target_module() :: module().
+-type target_context() :: any().
+-type target() :: {target_module(), target_context()}.
+-type liveset() :: ordsets:ordset(temp()).
+-type temp() :: non_neg_integer().
+-type label() :: non_neg_integer().
+
+-spec split(target_cfg(), liveness(), target_module(), target_context(),
+ comp_options())
+ -> target_cfg().
+split(TCFG0, Liveness, TargetMod, TargetContext, Options) ->
+ Target = {TargetMod, TargetContext},
+ NoTemps = number_of_temporaries(TCFG0, Target),
+ if NoTemps > ?HEUR_MAX_TEMPS ->
+ ?debug_msg("~w: Too many temps (~w), falling back on restore_reuse.~n",
+ [?MODULE, NoTemps]),
+ hipe_restore_reuse:split(TCFG0, Liveness, TargetMod, TargetContext);
+ true ->
+ Wts = compute_weights(TCFG0, TargetMod, TargetContext, Options),
+ {CFG0, Temps} = convert(TCFG0, Target),
+ Avail = avail_analyse(TCFG0, Liveness, Target),
+ Defs = def_analyse(CFG0, TCFG0),
+ RDefs = rdef_analyse(CFG0),
+ PLive = plive_analyse(CFG0),
+ {CFG, DUCounts, Costs, DSets0} =
+ scan(CFG0, Liveness, PLive, Wts, Defs, RDefs, Avail, Target),
+ {DSets, _} = hipe_dsets:to_map(DSets0),
+ Renames = decide(DUCounts, Costs, Target, Options),
+ rewrite(CFG, TCFG0, Target, Liveness, PLive, Defs, Avail, DSets, Renames,
+ Temps)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Internal program representation
+%%
+%% Second pass: Convert cfg to internal representation
+
+-record(cfg, {
+ rpo_labels :: [label()],
+ bbs :: #{label() => bb()}
+ }).
+-type cfg() :: #cfg{}.
+
+cfg_bb(L, #cfg{bbs=BBS}) -> maps:get(L, BBS).
+
+cfg_postorder(#cfg{rpo_labels=RPO}) -> lists:reverse(RPO).
+
+-record(bb, {
+ code :: [code_elem()],
+ %% If the last instruction of code defines all allocatable registers
+ has_call :: boolean(),
+ succ :: [label()]
+ }).
+-type bb() :: #bb{}.
+-type code_elem() :: instr() | mode2_spills() | mode3_restores().
+
+bb_code(#bb{code=Code}) -> Code.
+bb_has_call(#bb{has_call=HasCall}) -> HasCall.
+bb_succ(#bb{succ=Succ}) -> Succ.
+
+bb_butlast(#bb{code=Code}) ->
+ bb_butlast_1(Code).
+
+bb_butlast_1([_Last]) -> [];
+bb_butlast_1([I|Is]) -> [I|bb_butlast_1(Is)].
+
+bb_last(#bb{code=Code}) -> lists:last(Code).
+
+-record(instr, {
+ i :: target_instr(),
+ def :: ordsets:ordset(temp()),
+ use :: ordsets:ordset(temp())
+ }).
+-type instr() :: #instr{}.
+
+-record(mode2_spills, {
+ temps :: ordsets:ordset(temp())
+ }).
+-type mode2_spills() :: #mode2_spills{}.
+
+-record(mode3_restores, {
+ temps :: ordsets:ordset(temp())
+ }).
+-type mode3_restores() :: #mode3_restores{}.
+
+-spec convert(target_cfg(), target()) -> {cfg(), temps()}.
+convert(CFG, Target) ->
+ RPO = reverse_postorder(CFG, Target),
+ {BBsList, Temps} = convert_bbs(RPO, CFG, Target, #{}, []),
+ {#cfg{rpo_labels = RPO,
+ bbs = maps:from_list(BBsList)},
+ Temps}.
+
+convert_bbs([], _CFG, _Target, Temps, Acc) -> {Acc, Temps};
+convert_bbs([L|Ls], CFG, Target, Temps0, Acc) ->
+ Succs = hipe_gen_cfg:succ(CFG, L),
+ TBB = bb(CFG, L, Target),
+ TCode = hipe_bb:code(TBB),
+ {Code, Last, Temps} = convert_code(TCode, Target, Temps0, []),
+ HasCall = defines_all_alloc(Last#instr.i, Target),
+ BB = #bb{code = Code,
+ has_call = HasCall,
+ succ = Succs},
+ convert_bbs(Ls, CFG, Target, Temps, [{L,BB}|Acc]).
+
+convert_code([], _Target, Temps, [Last|_]=Acc) ->
+ {lists:reverse(Acc), Last, Temps};
+convert_code([TI|TIs], Target, Temps0, Acc) ->
+ {TDef, TUse} = def_use(TI, Target),
+ I = #instr{i = TI,
+ def = ordsets:from_list(reg_names(TDef, Target)),
+ use = ordsets:from_list(reg_names(TUse, Target))},
+ Temps = add_temps(TUse, Target, add_temps(TDef, Target, Temps0)),
+ convert_code(TIs, Target, Temps, [I|Acc]).
+
+-type temps() :: #{temp() => target_temp()}.
+add_temps([], _Target, Temps) -> Temps;
+add_temps([T|Ts], Target, Temps) ->
+ add_temps(Ts, Target, Temps#{reg_nr(T, Target) => T}).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Fourth pass: P({DEF}) lattice fwd dataflow (for eliding stores at SPILL
+%% splits)
+-type defsi() :: #{label() => defseti() | {call, defseti(), defseti()}}.
+-type defs() :: #{label() => defsetf()}.
+
+-spec def_analyse(cfg(), target_cfg()) -> defs().
+def_analyse(CFG = #cfg{rpo_labels = RPO}, TCFG) ->
+ Defs0 = def_init(CFG),
+ def_dataf(RPO, TCFG, Defs0).
+
+-spec def_init(cfg()) -> defsi().
+def_init(#cfg{bbs = BBs}) ->
+ maps:from_list(
+ [begin
+ {L, case HasCall of
+ false -> def_init_scan(bb_code(BB), defseti_new());
+ true ->
+ {call, def_init_scan(bb_butlast(BB), defseti_new()),
+ defseti_from_ordset((bb_last(BB))#instr.def)}
+ end}
+ end || {L, BB = #bb{has_call=HasCall}} <- maps:to_list(BBs)]).
+
+def_init_scan([], Defset) -> Defset;
+def_init_scan([#instr{def=Def}|Is], Defset0) ->
+ Defset = defseti_add_ordset(Def, Defset0),
+ def_init_scan(Is, Defset).
+
+-spec def_dataf([label()], target_cfg(), defsi()) -> defs().
+def_dataf(Labels, TCFG, Defs0) ->
+ case def_dataf_once(Labels, TCFG, Defs0, 0) of
+ {Defs, 0} ->
+ def_finalise(Defs);
+ {Defs, _Changed} ->
+ def_dataf(Labels, TCFG, Defs)
+ end.
+
+-spec def_finalise(defsi()) -> defs().
+def_finalise(Defs) ->
+ maps:from_list([{K, defseti_finalise(BL)}
+ || {K, {call, BL, _}} <- maps:to_list(Defs)]).
+
+-spec def_dataf_once([label()], target_cfg(), defsi(), non_neg_integer())
+ -> {defsi(), non_neg_integer()}.
+def_dataf_once([], _TCFG, Defs, Changed) -> {Defs, Changed};
+def_dataf_once([L|Ls], TCFG, Defs0, Changed0) ->
+ AddPreds =
+ fun(Defset1) ->
+ lists:foldl(fun(P, Defset2) ->
+ defseti_union(defout(P, Defs0), Defset2)
+ end, Defset1, hipe_gen_cfg:pred(TCFG, L))
+ end,
+ Defset =
+ case Defset0 = maps:get(L, Defs0) of
+ {call, Butlast, Defout} -> {call, AddPreds(Butlast), Defout};
+ _ -> AddPreds(Defset0)
+ end,
+ Changed = case Defset =:= Defset0 of
+ true -> Changed0;
+ false -> Changed0+1
+ end,
+ def_dataf_once(Ls, TCFG, Defs0#{L := Defset}, Changed).
+
+-spec defout(label(), defsi()) -> defseti().
+defout(L, Defs) ->
+ case maps:get(L, Defs) of
+ {call, _DefButLast, Defout} -> Defout;
+ Defout -> Defout
+ end.
+
+-spec defbutlast(label(), defs()) -> defsetf().
+defbutlast(L, Defs) -> maps:get(L, Defs).
+
+-spec defseti_new() -> defseti().
+-spec defseti_union(defseti(), defseti()) -> defseti().
+-spec defseti_add_ordset(ordset:ordset(temp()), defseti()) -> defseti().
+-spec defseti_from_ordset(ordset:ordset(temp())) -> defseti().
+-spec defseti_finalise(defseti()) -> defsetf().
+-spec defsetf_member(temp(), defsetf()) -> boolean().
+-spec defsetf_intersect_ordset(ordsets:ordset(temp()), defsetf())
+ -> ordsets:ordset(temp()).
+
+-type defseti() :: bitord().
+defseti_new() -> bitord_new().
+defseti_union(A, B) -> bitord_union(A, B).
+defseti_add_ordset(OS, D) -> defseti_union(defseti_from_ordset(OS), D).
+defseti_from_ordset(OS) -> bitord_from_ordset(OS).
+defseti_finalise(D) -> bitarr_from_bitord(D).
+
+-type defsetf() :: bitarr().
+defsetf_member(E, D) -> bitarr_get(E, D).
+
+defsetf_intersect_ordset([], _D) -> [];
+defsetf_intersect_ordset([E|Es], D) ->
+ case bitarr_get(E, D) of
+ true -> [E|defsetf_intersect_ordset(Es,D)];
+ false -> defsetf_intersect_ordset(Es,D)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Fifth pass: P({DEF}) lattice reverse dataflow (for eliding stores at defines
+%% in mode2)
+-type rdefsi() :: #{label() =>
+ {call, rdefseti(), [label()]}
+ | {nocall, rdefseti(), rdefseti(), [label()]}}.
+-type rdefs() :: #{label() => {final, rdefsetf(), [label()]}}.
+
+-spec rdef_analyse(cfg()) -> rdefs().
+rdef_analyse(CFG = #cfg{rpo_labels=RPO}) ->
+ Defs0 = rdef_init(CFG),
+ PO = rdef_postorder(RPO, CFG, []),
+ rdef_dataf(PO, Defs0).
+
+%% Filter out 'call' labels, since they don't change
+-spec rdef_postorder([label()], cfg(), [label()]) -> [label()].
+rdef_postorder([], _CFG, Acc) -> Acc;
+rdef_postorder([L|Ls], CFG, Acc) ->
+ case bb_has_call(cfg_bb(L, CFG)) of
+ true -> rdef_postorder(Ls, CFG, Acc);
+ false -> rdef_postorder(Ls, CFG, [L|Acc])
+ end.
+
+-spec rdef_init(cfg()) -> rdefsi().
+rdef_init(#cfg{bbs = BBs}) ->
+ maps:from_list(
+ [{L, case HasCall of
+ true ->
+ Defin = rdef_init_scan(bb_butlast(BB), rdefseti_empty()),
+ {call, Defin, Succs};
+ false ->
+ Gen = rdef_init_scan(bb_code(BB), rdefseti_empty()),
+ {nocall, Gen, rdefseti_top(), Succs}
+ end}
+ || {L, BB = #bb{has_call=HasCall, succ=Succs}} <- maps:to_list(BBs)]).
+
+-spec rdef_init_scan([instr()], rdefseti()) -> rdefseti().
+rdef_init_scan([], Defset) -> Defset;
+rdef_init_scan([#instr{def=Def}|Is], Defset0) ->
+ Defset = rdefseti_add_ordset(Def, Defset0),
+ rdef_init_scan(Is, Defset).
+
+-spec rdef_dataf([label()], rdefsi()) -> rdefs().
+rdef_dataf(Labels, Defs0) ->
+ case rdef_dataf_once(Labels, Defs0, 0) of
+ {Defs, 0} ->
+ rdef_finalise(Defs);
+ {Defs, _Changed} ->
+ rdef_dataf(Labels, Defs)
+ end.
+
+-spec rdef_finalise(rdefsi()) -> rdefs().
+rdef_finalise(Defs) ->
+ maps:map(fun(L, V) ->
+ Succs = rsuccs_val(V),
+ Defout0 = rdefout_intersect(L, Defs, rdefseti_top()),
+ {final, rdefset_finalise(Defout0), Succs}
+ end, Defs).
+
+-spec rdef_dataf_once([label()], rdefsi(), non_neg_integer())
+ -> {rdefsi(), non_neg_integer()}.
+rdef_dataf_once([], Defs, Changed) -> {Defs, Changed};
+rdef_dataf_once([L|Ls], Defs0, Changed0) ->
+ #{L := {nocall, Gen, Defin0, Succs}} = Defs0,
+ Defin = rdefseti_union(Gen, rdefout_intersect(L, Defs0, Defin0)),
+ Defset = {nocall, Gen, Defin, Succs},
+ Changed = case Defin =:= Defin0 of
+ true -> Changed0;
+ false -> Changed0+1
+ end,
+ rdef_dataf_once(Ls, Defs0#{L := Defset}, Changed).
+
+-spec rdefin(label(), rdefsi()) -> rdefseti().
+rdefin(L, Defs) -> rdefin_val(maps:get(L, Defs)).
+rdefin_val({nocall, _Gen, Defin, _Succs}) -> Defin;
+rdefin_val({call, Defin, _Succs}) -> Defin.
+
+-spec rsuccs(label(), rdefsi()) -> [label()].
+rsuccs(L, Defs) -> rsuccs_val(maps:get(L, Defs)).
+rsuccs_val({nocall, _Gen, _Defin, Succs}) -> Succs;
+rsuccs_val({call, _Defin, Succs}) -> Succs.
+
+-spec rdefout(label(), rdefs()) -> rdefsetf().
+rdefout(L, Defs) ->
+ #{L := {final, Defout, _Succs}} = Defs,
+ Defout.
+
+-spec rdefout_intersect(label(), rdefsi(), rdefseti()) -> rdefseti().
+rdefout_intersect(L, Defs, Init) ->
+ lists:foldl(fun(S, Acc) ->
+ rdefseti_intersect(rdefin(S, Defs), Acc)
+ end, Init, rsuccs(L, Defs)).
+
+-type rdefseti() :: bitord() | top.
+rdefseti_top() -> top.
+rdefseti_empty() -> bitord_new().
+-spec rdefseti_from_ordset(ordsets:ordset(temp())) -> rdefseti().
+rdefseti_from_ordset(OS) -> bitord_from_ordset(OS).
+
+-spec rdefseti_add_ordset(ordsets:ordset(temp()), rdefseti()) -> rdefseti().
+rdefseti_add_ordset(_, top) -> top; % Should never happen in rdef_dataf
+rdefseti_add_ordset(OS, D) -> rdefseti_union(rdefseti_from_ordset(OS), D).
+
+-spec rdefseti_union(rdefseti(), rdefseti()) -> rdefseti().
+rdefseti_union(top, _) -> top;
+rdefseti_union(_, top) -> top;
+rdefseti_union(A, B) -> bitord_union(A, B).
+
+-spec rdefseti_intersect(rdefseti(), rdefseti()) -> rdefseti().
+rdefseti_intersect(top, D) -> D;
+rdefseti_intersect(D, top) -> D;
+rdefseti_intersect(A, B) -> bitord_intersect(A, B).
+
+-type rdefsetf() :: {arr, bitarr()} | top.
+-spec rdefset_finalise(rdefseti()) -> rdefsetf().
+rdefset_finalise(top) -> top;
+rdefset_finalise(Ord) -> {arr, bitarr_from_bitord(Ord)}.
+
+%% rdefsetf_top() -> top.
+rdefsetf_empty() -> {arr, bitarr_new()}.
+
+-spec rdefsetf_add_ordset(ordset:ordset(temp()), rdefsetf()) -> rdefsetf().
+rdefsetf_add_ordset(_, top) -> top;
+rdefsetf_add_ordset(OS, {arr, Arr}) ->
+ {arr, lists:foldl(fun bitarr_set/2, Arr, OS)}.
+
+-spec rdef_step(instr(), rdefsetf()) -> rdefsetf().
+rdef_step(#instr{def=Def}, Defset) ->
+ %% ?ASSERT(not defines_all_alloc(I, Target)),
+ rdefsetf_add_ordset(Def, Defset).
+
+-spec ordset_subtract_rdefsetf(ordsets:ordset(temp()), rdefsetf())
+ -> ordsets:ordset(temp()).
+ordset_subtract_rdefsetf(_, top) -> [];
+ordset_subtract_rdefsetf(OS, {arr, Arr}) ->
+ %% Lazy implementation; could do better if OS can grow
+ lists:filter(fun(E) -> not bitarr_get(E, Arr) end, OS).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Integer sets represented as bit sets
+%%
+%% Two representations; bitord() and bitarr()
+-define(LIMB_IX_BITS, 11).
+-define(LIMB_BITS, (1 bsl ?LIMB_IX_BITS)).
+-define(LIMB_IX(Index), (Index bsr ?LIMB_IX_BITS)).
+-define(BIT_IX(Index), (Index band (?LIMB_BITS - 1))).
+-define(BIT_MASK(Index), (1 bsl ?BIT_IX(Index))).
+
+%% bitord(): fast at union/2 and can be compared for equality with '=:='
+-type bitord() :: orddict:orddict(non_neg_integer(), 0..((1 bsl ?LIMB_BITS)-1)).
+
+-spec bitord_new() -> bitord().
+bitord_new() -> [].
+
+-spec bitord_union(bitord(), bitord()) -> bitord().
+bitord_union(Lhs, Rhs) ->
+ orddict:merge(fun(_, L, R) -> L bor R end, Lhs, Rhs).
+
+-spec bitord_intersect(bitord(), bitord()) -> bitord().
+bitord_intersect([], _) -> [];
+bitord_intersect(_, []) -> [];
+bitord_intersect([{K, L}|Ls], [{K, R}|Rs]) ->
+ [{K, L band R} | bitord_intersect(Ls, Rs)];
+bitord_intersect([{LK, _}|Ls], [{RK, _}|_]=Rs) when LK < RK ->
+ bitord_intersect(Ls, Rs);
+bitord_intersect([{LK, _}|_]=Ls, [{RK, _}|Rs]) when LK > RK ->
+ bitord_intersect(Ls, Rs).
+
+-spec bitord_from_ordset(ordsets:ordset(non_neg_integer())) -> bitord().
+bitord_from_ordset([]) -> [];
+bitord_from_ordset([B|Bs]) ->
+ bitord_from_ordset_1(Bs, ?LIMB_IX(B), ?BIT_MASK(B)).
+
+bitord_from_ordset_1([B|Bs], Key, Val) when Key =:= ?LIMB_IX(B) ->
+ bitord_from_ordset_1(Bs, Key, Val bor ?BIT_MASK(B));
+bitord_from_ordset_1([B|Bs], Key, Val) ->
+ [{Key,Val} | bitord_from_ordset_1(Bs, ?LIMB_IX(B), ?BIT_MASK(B))];
+bitord_from_ordset_1([], Key, Val) -> [{Key, Val}].
+
+%% bitarr(): fast (enough) at get/2
+-type bitarr() :: array:array(0..((1 bsl ?LIMB_BITS)-1)).
+
+-spec bitarr_new() -> bitarr().
+bitarr_new() -> array:new({default, 0}).
+
+-spec bitarr_get(non_neg_integer(), bitarr()) -> boolean().
+bitarr_get(Index, Array) ->
+ Limb = array:get(?LIMB_IX(Index), Array),
+ 0 =/= (Limb band ?BIT_MASK(Index)).
+
+-spec bitarr_set(non_neg_integer(), bitarr()) -> bitarr().
+bitarr_set(Index, Array) ->
+ Limb0 = array:get(?LIMB_IX(Index), Array),
+ Limb = Limb0 bor ?BIT_MASK(Index),
+ array:set(?LIMB_IX(Index), Limb, Array).
+
+-spec bitarr_from_bitord(bitord()) -> bitarr().
+bitarr_from_bitord(Ord) ->
+ array:from_orddict(Ord, 0).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Sixth pass: Partition-local liveness analysis
+%%
+%% As temps are not spilled when exiting a partition in mode2, only
+%% partition-local uses need to be considered when deciding which temps need
+%% restoring at partition entry.
+
+-type plive() :: #{label() =>
+ {call, liveset(), [label()]}
+ | {nocall, {liveset(), liveset()}, liveset(), [label()]}}.
+
+-spec plive_analyse(cfg()) -> plive().
+plive_analyse(CFG) ->
+ Defs0 = plive_init(CFG),
+ PO = cfg_postorder(CFG),
+ plive_dataf(PO, Defs0).
+
+-spec plive_init(cfg()) -> plive().
+plive_init(#cfg{bbs = BBs}) ->
+ maps:from_list(
+ [begin
+ {L, case HasCall of
+ true ->
+ {Gen, _} = plive_init_scan(bb_code(BB)),
+ {call, Gen, Succs};
+ false ->
+ GenKill = plive_init_scan(bb_code(BB)),
+ {nocall, GenKill, liveset_empty(), Succs}
+ end}
+ end || {L, BB = #bb{has_call=HasCall, succ=Succs}} <- maps:to_list(BBs)]).
+
+-spec plive_init_scan([instr()]) -> {liveset(), liveset()}.
+plive_init_scan([]) -> {liveset_empty(), liveset_empty()};
+plive_init_scan([#instr{def=InstrKill, use=InstrGen}|Is]) ->
+ {Gen0, Kill0} = plive_init_scan(Is),
+ Gen1 = liveset_subtract(Gen0, InstrKill),
+ Gen = liveset_union(Gen1, InstrGen),
+ Kill1 = liveset_union(Kill0, InstrKill),
+ Kill = liveset_subtract(Kill1, InstrGen),
+ {Gen, Kill}.
+
+-spec plive_dataf([label()], plive()) -> plive().
+plive_dataf(Labels, PLive0) ->
+ case plive_dataf_once(Labels, PLive0, 0) of
+ {PLive, 0} -> PLive;
+ {PLive, _Changed} ->
+ plive_dataf(Labels, PLive)
+ end.
+
+-spec plive_dataf_once([label()], plive(), non_neg_integer()) ->
+ {plive(), non_neg_integer()}.
+plive_dataf_once([], PLive, Changed) -> {PLive, Changed};
+plive_dataf_once([L|Ls], PLive0, Changed0) ->
+ Liveset =
+ case Liveset0 = maps:get(L, PLive0) of
+ {call, Livein, Succs} ->
+ {call, Livein, Succs};
+ {nocall, {Gen, Kill} = GenKill, _OldLivein, Succs} ->
+ Liveout = pliveout(L, PLive0),
+ Livein = liveset_union(Gen, liveset_subtract(Liveout, Kill)),
+ {nocall, GenKill, Livein, Succs}
+ end,
+ Changed = case Liveset =:= Liveset0 of
+ true -> Changed0;
+ false -> Changed0+1
+ end,
+ plive_dataf_once(Ls, PLive0#{L := Liveset}, Changed).
+
+-spec pliveout(label(), plive()) -> liveset().
+pliveout(L, PLive) ->
+ liveset_union([plivein(S, PLive) || S <- psuccs(L, PLive)]).
+
+-spec psuccs(label(), plive()) -> [label()].
+psuccs(L, PLive) -> psuccs_val(maps:get(L, PLive)).
+psuccs_val({call, _Livein, Succs}) -> Succs;
+psuccs_val({nocall, _GenKill, _Livein, Succs}) -> Succs.
+
+-spec plivein(label(), plive()) -> liveset().
+plivein(L, PLive) -> plivein_val(maps:get(L, PLive)).
+plivein_val({call, Livein, _Succs}) -> Livein;
+plivein_val({nocall, _GenKill, Livein, _Succs}) -> Livein.
+
+liveset_empty() -> ordsets:new().
+liveset_subtract(A, B) -> ordsets:subtract(A, B).
+liveset_union(A, B) -> ordsets:union(A, B).
+liveset_union(LivesetList) -> ordsets:union(LivesetList).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Third pass: Compute dataflow analyses required for placing mode3
+%% spills/restores.
+%% Reuse analysis implementation in hipe_restore_reuse.
+%% XXX: hipe_restore_reuse has it's own "rdef"; we would like to reuse that one
+%% too.
+-type avail() :: hipe_restore_reuse:avail().
+
+-spec avail_analyse(target_cfg(), liveness(), target()) -> avail().
+avail_analyse(CFG, Liveness, Target) ->
+ hipe_restore_reuse:analyse(CFG, Liveness, Target).
+
+-spec mode3_split_in_block(label(), avail()) -> ordsets:ordset(temp()).
+mode3_split_in_block(L, Avail) ->
+ hipe_restore_reuse:split_in_block(L, Avail).
+
+-spec mode3_block_renameset(label(), avail()) -> ordsets:ordset(temp()).
+mode3_block_renameset(L, Avail) ->
+ hipe_restore_reuse:renamed_in_block(L, Avail).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Seventh pass
+%%
+%% Compute program space partitioning, collect information required by the
+%% heuristic.
+-type part_key() :: label().
+-type part_dsets() :: hipe_dsets:dsets(part_key()).
+-type part_dsets_map() :: #{part_key() => part_key()}.
+-type ducounts() :: #{part_key() => ducount()}.
+
+-spec scan(cfg(), liveness(), plive(), weights(), defs(), rdefs(), avail(),
+ target()) -> {cfg(), ducounts(), costs(), part_dsets()}.
+scan(CFG0, Liveness, PLive, Weights, Defs, RDefs, Avail, Target) ->
+ #cfg{rpo_labels = Labels, bbs = BBs0} = CFG0,
+ CFG = CFG0#cfg{bbs=#{}}, % kill reference
+ DSets0 = hipe_dsets:new(Labels),
+ Costs0 = costs_new(),
+ {BBs, DUCounts0, Costs1, DSets1} =
+ scan_bbs(maps:to_list(BBs0), Liveness, PLive, Weights, Defs, RDefs, Avail,
+ Target, #{}, Costs0, DSets0, []),
+ {RLList, DSets2} = hipe_dsets:to_rllist(DSets1),
+ {Costs, DSets} = costs_map_roots(DSets2, Costs1),
+ DUCounts = collect_ducounts(RLList, DUCounts0, #{}),
+ {CFG#cfg{bbs=maps:from_list(BBs)}, DUCounts, Costs, DSets}.
+
+-spec collect_ducounts([{label(), [label()]}], ducounts(), ducounts())
+ -> ducounts().
+collect_ducounts([], _, Acc) -> Acc;
+collect_ducounts([{R,Ls}|RLs], DUCounts, Acc) ->
+ DUCount = lists:foldl(
+ fun(Key, FAcc) ->
+ ducount_merge(maps:get(Key, DUCounts, ducount_new()), FAcc)
+ end, ducount_new(), Ls),
+ collect_ducounts(RLs, DUCounts, Acc#{R => DUCount}).
+
+-spec scan_bbs([{label(), bb()}], liveness(), plive(), weights(), defs(),
+ rdefs(), avail(), target(), ducounts(), costs(), part_dsets(),
+ [{label(), bb()}])
+ -> {[{label(), bb()}], ducounts(), costs(), part_dsets()}.
+scan_bbs([], _Liveness, _PLive, _Weights, _Defs, _RDefs, _Avail, _Target,
+ DUCounts, Costs, DSets, Acc) ->
+ {Acc, DUCounts, Costs, DSets};
+scan_bbs([{L,BB}|BBs], Liveness, PLive, Weights, Defs, RDefs, Avail, Target,
+ DUCounts0, Costs0, DSets0, Acc) ->
+ Wt = weight(L, Weights),
+ {DSets, Costs5, EntryCode, ExitCode, RDefout, Liveout} =
+ case bb_has_call(BB) of
+ false ->
+ DSets1 = lists:foldl(fun(S, DS) -> hipe_dsets:union(L, S, DS) end,
+ DSets0, bb_succ(BB)),
+ {DSets1, Costs0, bb_code(BB), [], rdefout(L, RDefs),
+ liveout(Liveness, L, Target)};
+ true ->
+ LastI = #instr{def=LastDef} = bb_last(BB),
+ LiveBefore = ordsets:subtract(liveout(Liveness, L, Target), LastDef),
+ %% We can omit the spill of a temp that has not been defined since the
+ %% last time it was spilled
+ SpillSet = defsetf_intersect_ordset(LiveBefore, defbutlast(L, Defs)),
+ Costs1 = costs_insert(exit, L, Wt, SpillSet, Costs0),
+ Costs4 = lists:foldl(fun({S, BranchWt}, Costs2) ->
+ SLivein = livein(Liveness, S, Target),
+ SPLivein = plivein(S, PLive),
+ SWt = weight_scaled(L, BranchWt, Weights),
+ Costs3 = costs_insert(entry1, S, SWt, SLivein, Costs2),
+ costs_insert(entry2, S, SWt, SPLivein, Costs3)
+ end, Costs1, branch_preds(LastI#instr.i, Target)),
+ {DSets0, Costs4, bb_butlast(BB), [LastI], rdefsetf_empty(), LiveBefore}
+ end,
+ Mode3Splits = mode3_split_in_block(L, Avail),
+ {RevEntryCode, Restored} = scan_bb_fwd(EntryCode, Mode3Splits, [], []),
+ {Code, DUCount, Mode2Spills} =
+ scan_bb(RevEntryCode, Wt, RDefout, Liveout, ducount_new(), [], ExitCode),
+ DUCounts = DUCounts0#{L => DUCount},
+ M2SpillSet = ordsets:from_list(Mode2Spills),
+ Costs6 = costs_insert(spill, L, Wt, M2SpillSet, Costs5),
+ Mode3Renames = mode3_block_renameset(L, Avail),
+ Costs7 = costs_insert(restore, L, Wt, ordsets:intersection(M2SpillSet, Mode3Renames), Costs6),
+ Costs8 = costs_insert(restore, L, Wt, ordsets:from_list(Restored), Costs7),
+ Costs = add_unsplit_mode3_costs(DUCount, Mode3Renames, L, Costs8),
+ scan_bbs(BBs, Liveness, PLive, Weights, Defs, RDefs, Avail, Target, DUCounts,
+ Costs, DSets, [{L,BB#bb{code=Code}}|Acc]).
+
+-spec add_unsplit_mode3_costs(ducount(), ordsets:ordset(temp()), label(), costs())
+ -> costs().
+add_unsplit_mode3_costs(DUCount, Mode3Renames, L, Costs) ->
+ Unsplit = orddict_without_ordset(Mode3Renames,
+ orddict:from_list(ducount_to_list(DUCount))),
+ add_unsplit_mode3_costs_1(Unsplit, L, Costs).
+
+-spec add_unsplit_mode3_costs_1([{temp(),float()}], label(), costs())
+ -> costs().
+add_unsplit_mode3_costs_1([], _L, Costs) -> Costs;
+add_unsplit_mode3_costs_1([{T,C}|Cs], L, Costs) ->
+ add_unsplit_mode3_costs_1(Cs, L, costs_insert(restore, L, C, [T], Costs)).
+
+%% @doc Returns a new orddict without keys in Set and their associated values.
+-spec orddict_without_ordset(ordsets:ordset(K), orddict:orddict(K, V))
+ -> orddict:orddict(K, V).
+orddict_without_ordset([S|Ss], [{K,_}|_]=Dict) when S < K ->
+ orddict_without_ordset(Ss, Dict);
+orddict_without_ordset([S|_]=Set, [D={K,_}|Ds]) when S > K ->
+ [D|orddict_without_ordset(Set, Ds)];
+orddict_without_ordset([_S|Ss], [{_K,_}|Ds]) -> % _S == _K
+ orddict_without_ordset(Ss, Ds);
+orddict_without_ordset(_, []) -> [];
+orddict_without_ordset([], Dict) -> Dict.
+
+%% Scans the code forward, collecting and inserting mode3 restores
+-spec scan_bb_fwd([instr()], ordsets:ordset(temp()), ordsets:ordset(temp()),
+ [code_elem()])
+ -> {[code_elem()], ordsets:ordset(temp())}.
+scan_bb_fwd([], [], Restored, Acc) -> {Acc, Restored};
+scan_bb_fwd([I|Is], SplitHere0, Restored0, Acc0) ->
+ #instr{def=Def, use=Use} = I,
+ {ToRestore, SplitHere1} =
+ lists:partition(fun(R) -> lists:member(R, Use) end, SplitHere0),
+ SplitHere = lists:filter(fun(R) -> not lists:member(R, Def) end, SplitHere1),
+ Acc =
+ case ToRestore of
+ [] -> [I | Acc0];
+ _ -> [I, #mode3_restores{temps=ToRestore} | Acc0]
+ end,
+ scan_bb_fwd(Is, SplitHere, ToRestore ++ Restored0, Acc).
+
+%% Scans the code backwards, collecting def/use counts and mode2 spills
+-spec scan_bb([code_elem()], float(), rdefsetf(), liveset(), ducount(),
+ [temp()], [code_elem()])
+ -> {[code_elem()], ducount(), [temp()]}.
+scan_bb([], _Wt, _RDefout, _Liveout, DUCount, Spills, Acc) ->
+ {Acc, DUCount, Spills};
+scan_bb([I=#mode3_restores{}|Is], Wt, RDefout, Liveout, DUCount, Spills, Acc) ->
+ scan_bb(Is, Wt, RDefout, Liveout, DUCount, Spills, [I|Acc]);
+scan_bb([I|Is], Wt, RDefout, Liveout, DUCount0, Spills0, Acc0) ->
+ #instr{def=Def,use=Use} = I,
+ DUCount = ducount_add(Use, Wt, ducount_add(Def, Wt, DUCount0)),
+ Livein = liveness_step(I, Liveout),
+ RDefin = rdef_step(I, RDefout),
+ %% The temps that would be spilled after I in mode 2
+ NewSpills = ordset_subtract_rdefsetf(
+ ordsets:intersection(Def, Liveout),
+ RDefout),
+ ?ASSERT(NewSpills =:= (NewSpills -- Spills0)),
+ Spills = NewSpills ++ Spills0,
+ Acc1 = case NewSpills of
+ [] -> Acc0;
+ _ -> [#mode2_spills{temps=NewSpills}|Acc0]
+ end,
+ scan_bb(Is, Wt, RDefin, Livein, DUCount, Spills, [I|Acc1]).
+
+-spec liveness_step(instr(), liveset()) -> liveset().
+liveness_step(#instr{def=Def, use=Use}, Liveout) ->
+ ordsets:union(Use, ordsets:subtract(Liveout, Def)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% First pass: compute basic-block weighting
+
+-type weights() :: no_bb_weights
+ | {hipe_bb_weights:bb_weights(), float()}.
+
+-spec weight(label(), weights()) -> float().
+weight(L, Weights) -> weight_scaled(L, 1.0, Weights).
+
+-spec compute_weights(target_cfg(), target_module(), target_context(),
+ comp_options()) -> weights().
+compute_weights(CFG, TargetMod, TargetContext, Options) ->
+ case proplists:get_bool(range_split_weights, Options) of
+ false -> no_bb_weights;
+ true ->
+ {hipe_bb_weights:compute(CFG, TargetMod, TargetContext),
+ ?WEIGHT_CONST_FUN(proplists:get_value(range_split_weight_power,
+ Options, ?DEFAULT_WEIGHT_POWER))}
+ end.
+
+-spec weight_scaled(label(), float(), weights()) -> float().
+weight_scaled(_L, _Scale, no_bb_weights) -> 1.0;
+weight_scaled(L, Scale, {Weights, Const}) ->
+ Wt0 = hipe_bb_weights:weight(L, Weights) * Scale,
+ Wt = erlang:min(erlang:max(Wt0, 0.0000000000000000001), 10000.0),
+ ?WEIGHT_FUN(Wt, Const).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Heuristic splitting decision.
+%%
+%% Decide which temps to split, in which parts, and pick new names for them.
+-type spill_mode() :: mode1 % Spill temps at partition exits
+ | mode2 % Spill temps at definitions
+ | mode3.% Spill temps at definitions, restore temps at uses
+-type ren() :: #{temp() => {spill_mode(), temp()}}.
+-type renames() :: #{label() => ren()}.
+
+-record(heur_par, {
+ mode1_fudge :: float(),
+ min_gain :: float()
+ }).
+-type heur_par() :: #heur_par{}.
+
+-spec decide(ducounts(), costs(), target(), comp_options()) -> renames().
+decide(DUCounts, Costs, Target, Options) ->
+ Par = #heur_par{
+ mode1_fudge = proplists:get_value(range_split_mode1_fudge, Options,
+ ?DEFAULT_MODE1_FUDGE),
+ min_gain = proplists:get_value(range_split_min_gain, Options,
+ ?DEFAULT_MIN_GAIN)},
+ decide_parts(maps:to_list(DUCounts), Costs, Target, Par, #{}).
+
+-spec decide_parts([{part_key(), ducount()}], costs(), target(),
+ heur_par(), renames())
+ -> renames().
+decide_parts([], _Costs, _Target, _Par, Acc) -> Acc;
+decide_parts([{Part,DUCount}|Ps], Costs, Target, Par, Acc) ->
+ Spills = decide_temps(ducount_to_list(DUCount), Part, Costs, Target, Par,
+ #{}),
+ decide_parts(Ps, Costs, Target, Par, Acc#{Part => Spills}).
+
+-spec decide_temps([{temp(), float()}], part_key(), costs(), target(),
+ heur_par(), ren())
+ -> ren().
+decide_temps([], _Part, _Costs, _Target, _Par, Acc) -> Acc;
+decide_temps([{Temp, SpillGain}|Ts], Part, Costs, Target, Par, Acc0) ->
+ SpillCost1 = costs_query(Temp, entry1, Part, Costs)
+ + costs_query(Temp, exit, Part, Costs),
+ SpillCost2 = costs_query(Temp, entry2, Part, Costs)
+ + costs_query(Temp, spill, Part, Costs),
+ SpillCost3 = costs_query(Temp, restore, Part, Costs),
+ Acc =
+ %% SpillCost1 =:= 0.0 usually means the temp is local to the partition;
+ %% hence no need to split it
+ case (SpillCost1 =/= 0.0) %% maps:is_key(Temp, S)
+ andalso (not is_precoloured(Temp, Target))
+ andalso ((Par#heur_par.min_gain*SpillCost1 < SpillGain)
+ orelse (Par#heur_par.min_gain*SpillCost2 < SpillGain)
+ orelse (Par#heur_par.min_gain*SpillCost3 < SpillGain))
+ of
+ false -> Acc0;
+ true ->
+ Mode =
+ if Par#heur_par.mode1_fudge*SpillCost1 < SpillCost2,
+ Par#heur_par.mode1_fudge*SpillCost1 < SpillCost3 ->
+ mode1;
+ SpillCost2 < SpillCost3 ->
+ mode2;
+ true ->
+ mode3
+ end,
+ Acc0#{Temp => {Mode, new_reg_nr(Target)}}
+ end,
+ decide_temps(Ts, Part, Costs, Target, Par, Acc).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Eighth pass: Rewrite program performing range splitting.
+
+-spec rewrite(cfg(), target_cfg(), target(), liveness(), plive(), defs(),
+ avail(), part_dsets_map(), renames(), temps())
+ -> target_cfg().
+rewrite(#cfg{bbs=BBs}, TCFG, Target, Liveness, PLive, Defs, Avail, DSets,
+ Renames, Temps) ->
+ rewrite_bbs(maps:to_list(BBs), Target, Liveness, PLive, Defs, Avail, DSets,
+ Renames, Temps, TCFG).
+
+-spec rewrite_bbs([{label(), bb()}], target(), liveness(), plive(), defs(),
+ avail(), part_dsets_map(), renames(), temps(), target_cfg())
+ -> target_cfg().
+rewrite_bbs([], _Target, _Liveness, _PLive, _Defs, _Avail, _DSets, _Renames,
+ _Temps, TCFG) ->
+ TCFG;
+rewrite_bbs([{L,BB}|BBs], Target, Liveness, PLive, Defs, Avail, DSets, Renames,
+ Temps, TCFG0) ->
+ Code0Rev = lists:reverse(bb_code(BB)),
+ EntryRen = maps:get(maps:get(L,DSets), Renames),
+ M3Ren = mode3_block_renameset(L, Avail),
+ SubstFun = rewrite_subst_fun(Target, EntryRen, M3Ren),
+ Fun = fun(I) -> subst_temps(SubstFun, I, Target) end,
+ {Code, TCFG} =
+ case bb_has_call(BB) of
+ false ->
+ Code1 = rewrite_instrs(Code0Rev, Fun, EntryRen, M3Ren, Temps, Target,
+ []),
+ {Code1, TCFG0};
+ true ->
+ CallI0 = hd(Code0Rev),
+ Succ = bb_succ(BB),
+ {CallTI, TCFG1} = inject_restores(Succ, Target, Liveness, PLive, DSets,
+ Renames, Temps, CallI0#instr.i, TCFG0),
+ Liveout1 = liveness_step(CallI0, liveout(Liveness, L, Target)),
+ Defout = defbutlast(L, Defs),
+ SpillMap = mk_spillmap(EntryRen, Liveout1, Defout, Temps, Target),
+ Code1 = rewrite_instrs(tl(Code0Rev), Fun, EntryRen, M3Ren, Temps,
+ Target, []),
+ Code2 = lift_spills(lists:reverse(Code1), Target, SpillMap, [CallTI]),
+ {Code2, TCFG1}
+ end,
+ TBB = hipe_bb:code_update(bb(TCFG, L, Target), Code),
+ rewrite_bbs(BBs, Target, Liveness, PLive, Defs, Avail, DSets, Renames, Temps,
+ update_bb(TCFG, L, TBB, Target)).
+
+-spec rewrite_instrs([code_elem()], rewrite_fun(), ren(),
+ ordsets:ordset(temp()), temps(), target(),
+ [target_instr()])
+ -> [target_instr()].
+rewrite_instrs([], _Fun, _Ren, _M3Ren, _Temps, _Target, Acc) -> Acc;
+rewrite_instrs([I|Is], Fun, Ren, M3Ren, Temps, Target, Acc0) ->
+ Acc =
+ case I of
+ #instr{i=TI} -> [Fun(TI)|Acc0];
+ #mode2_spills{temps=Mode2Spills} ->
+ add_mode2_spills(Mode2Spills, Target, Ren, M3Ren, Temps, Acc0);
+ #mode3_restores{temps=Mode3Restores} ->
+ add_mode3_restores(Mode3Restores, Target, Ren, Temps, Acc0)
+ end,
+ rewrite_instrs(Is, Fun, Ren, M3Ren, Temps, Target, Acc).
+
+-spec add_mode2_spills(ordsets:ordset(temp()), target(), ren(),
+ ordsets:ordset(temp()), temps(), [target_instr()])
+ -> [target_instr()].
+add_mode2_spills([], _Target, _Ren, _M3Ren, _Temps, Acc) -> Acc;
+add_mode2_spills([R|Rs], Target, Ren, M3Ren, Temps, Acc0) ->
+ Acc =
+ case Ren of
+ #{R := {Mode, NewName}} when Mode =:= mode2; Mode =:= mode3 ->
+ case Mode =/= mode3 orelse lists:member(R, M3Ren) of
+ false -> Acc0;
+ true ->
+ #{R := T} = Temps,
+ SpillInstr = mk_move(update_reg_nr(NewName, T, Target), T, Target),
+ [SpillInstr|Acc0]
+ end;
+ #{} ->
+ Acc0
+ end,
+ add_mode2_spills(Rs, Target, Ren, M3Ren, Temps, Acc).
+
+-spec add_mode3_restores(ordsets:ordset(temp()), target(), ren(), temps(),
+ [target_instr()])
+ -> [target_instr()].
+add_mode3_restores([], _Target, _Ren, _Temps, Acc) -> Acc;
+add_mode3_restores([R|Rs], Target, Ren, Temps, Acc) ->
+ case Ren of
+ #{R := {mode3, NewName}} ->
+ #{R := T} = Temps,
+ RestoreInstr = mk_move(T, update_reg_nr(NewName, T, Target), Target),
+ add_mode3_restores(Rs, Target, Ren, Temps, [RestoreInstr|Acc]);
+ #{} ->
+ add_mode3_restores(Rs, Target, Ren, Temps, Acc)
+ end.
+
+-type rewrite_fun() :: fun((target_instr()) -> target_instr()).
+-type subst_fun() :: fun((target_temp()) -> target_temp()).
+-spec rewrite_subst_fun(target(), ren(), ordsets:ordset(temp())) -> subst_fun().
+rewrite_subst_fun(Target, Ren, M3Ren) ->
+ fun(Temp) ->
+ Reg = reg_nr(Temp, Target),
+ case Ren of
+ #{Reg := {Mode, NewName}} ->
+ case Mode =/= mode3 orelse lists:member(Reg, M3Ren) of
+ false -> Temp;
+ true -> update_reg_nr(NewName, Temp, Target)
+ end;
+ #{} -> Temp
+ end
+ end.
+
+-type spillmap() :: [{temp(), target_instr()}].
+-spec mk_spillmap(ren(), liveset(), defsetf(), temps(), target())
+ -> spillmap().
+mk_spillmap(Ren, Livein, Defout, Temps, Target) ->
+ [begin
+ Temp = maps:get(Reg, Temps),
+ {NewName, mk_move(update_reg_nr(NewName, Temp, Target), Temp, Target)}
+ end || {Reg, {mode1, NewName}} <- maps:to_list(Ren),
+ lists:member(Reg, Livein), defsetf_member(Reg, Defout)].
+
+-spec mk_restores(ren(), liveset(), liveset(), temps(), target())
+ -> [target_instr()].
+mk_restores(Ren, Livein, PLivein, Temps, Target) ->
+ [begin
+ Temp = maps:get(Reg, Temps),
+ mk_move(Temp, update_reg_nr(NewName, Temp, Target), Target)
+ end || {Reg, {Mode, NewName}} <- maps:to_list(Ren),
+ ( (Mode =:= mode1 andalso lists:member(Reg, Livein ))
+ orelse (Mode =:= mode2 andalso lists:member(Reg, PLivein)))].
+
+-spec inject_restores([label()], target(), liveness(), plive(),
+ part_dsets_map(), renames(), temps(), target_instr(),
+ target_cfg())
+ -> {target_instr(), target_cfg()}.
+inject_restores([], _Target, _Liveness, _PLive, _DSets, _Renames, _Temps, CFTI,
+ TCFG) ->
+ {CFTI, TCFG};
+inject_restores([L|Ls], Target, Liveness, PLive, DSets, Renames, Temps, CFTI0,
+ TCFG0) ->
+ Ren = maps:get(maps:get(L,DSets), Renames),
+ Livein = livein(Liveness, L, Target),
+ PLivein = plivein(L, PLive),
+ {CFTI, TCFG} =
+ case mk_restores(Ren, Livein, PLivein, Temps, Target) of
+ [] -> {CFTI0, TCFG0}; % optimisation
+ Restores ->
+ RestBBLbl = new_label(Target),
+ Code = Restores ++ [mk_goto(L, Target)],
+ CFTI1 = redirect_jmp(CFTI0, L, RestBBLbl, Target),
+ TCFG1 = update_bb(TCFG0, RestBBLbl, hipe_bb:mk_bb(Code), Target),
+ {CFTI1, TCFG1}
+ end,
+ inject_restores(Ls, Target, Liveness, PLive, DSets, Renames, Temps, CFTI,
+ TCFG).
+
+%% Heuristic. Move spills up until we meet the edge of the BB or a definition of
+%% that temp.
+-spec lift_spills([target_instr()], target(), spillmap(), [target_instr()])
+ -> [target_instr()].
+lift_spills([], _Target, SpillMap, Acc) ->
+ [SpillI || {_, SpillI} <- SpillMap] ++ Acc;
+lift_spills([I|Is], Target, SpillMap0, Acc) ->
+ Def = reg_defines(I, Target),
+ {Spills0, SpillMap} =
+ lists:partition(fun({Reg,_}) -> lists:member(Reg, Def) end, SpillMap0),
+ Spills = [SpillI || {_, SpillI} <- Spills0],
+ lift_spills(Is, Target, SpillMap, [I|Spills ++ Acc]).
+
+reg_defines(I, Target) ->
+ reg_names(defines(I,Target), Target).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Costs ADT
+%%
+%% Keeps track of cumulative cost of spilling temps in particular partitions
+%% using particular spill modes.
+-type cost_map() :: #{[part_key()|temp()] => float()}.
+-type cost_key() :: entry1 | entry2 | exit | spill | restore.
+-record(costs, {entry1 = #{} :: cost_map()
+ ,entry2 = #{} :: cost_map()
+ ,exit = #{} :: cost_map()
+ ,spill = #{} :: cost_map()
+ ,restore = #{} :: cost_map()
+ }).
+-type costs() :: #costs{}.
+
+-spec costs_new() -> costs().
+costs_new() -> #costs{}.
+
+-spec costs_insert(cost_key(), part_key(), float(), liveset(), costs())
+ -> costs().
+costs_insert(entry1, A, Weight, Liveset, Costs=#costs{entry1=Entry1}) ->
+ Costs#costs{entry1=costs_insert_1(A, Weight, Liveset, Entry1)};
+costs_insert(entry2, A, Weight, Liveset, Costs=#costs{entry2=Entry2}) ->
+ Costs#costs{entry2=costs_insert_1(A, Weight, Liveset, Entry2)};
+costs_insert(exit, A, Weight, Liveset, Costs=#costs{exit=Exit}) ->
+ Costs#costs{exit=costs_insert_1(A, Weight, Liveset, Exit)};
+costs_insert(spill, A, Weight, Liveset, Costs=#costs{spill=Spill}) ->
+ Costs#costs{spill=costs_insert_1(A, Weight, Liveset, Spill)};
+costs_insert(restore, A, Weight, Liveset, Costs=#costs{restore=Restore}) ->
+ Costs#costs{restore=costs_insert_1(A, Weight, Liveset, Restore)}.
+
+costs_insert_1(A, Weight, Liveset, CostMap0) when is_float(Weight) ->
+ lists:foldl(fun(Live, CostMap1) ->
+ map_update_counter([A|Live], Weight, CostMap1)
+ end, CostMap0, Liveset).
+
+-spec costs_map_roots(part_dsets(), costs()) -> {costs(), part_dsets()}.
+costs_map_roots(DSets0, Costs) ->
+ {Entry1, DSets1} = costs_map_roots_1(DSets0, Costs#costs.entry1),
+ {Entry2, DSets2} = costs_map_roots_1(DSets1, Costs#costs.entry2),
+ {Exit, DSets3} = costs_map_roots_1(DSets2, Costs#costs.exit),
+ {Spill, DSets4} = costs_map_roots_1(DSets3, Costs#costs.spill),
+ {Restore, DSets} = costs_map_roots_1(DSets4, Costs#costs.restore),
+ {#costs{entry1=Entry1,entry2=Entry2,exit=Exit,spill=Spill,restore=Restore},
+ DSets}.
+
+costs_map_roots_1(DSets0, CostMap) ->
+ {NewEs, DSets} = lists:mapfoldl(fun({[A|T], Wt}, DSets1) ->
+ {AR, DSets2} = hipe_dsets:find(A, DSets1),
+ {{[AR|T], Wt}, DSets2}
+ end, DSets0, maps:to_list(CostMap)),
+ {maps_from_list_merge(NewEs, fun erlang:'+'/2, #{}), DSets}.
+
+maps_from_list_merge([], _MF, Acc) -> Acc;
+maps_from_list_merge([{K,V}|Ps], MF, Acc) ->
+ maps_from_list_merge(Ps, MF, case Acc of
+ #{K := OV} -> Acc#{K := MF(V, OV)};
+ #{} -> Acc#{K => V}
+ end).
+
+-spec costs_query(temp(), cost_key(), part_key(), costs()) -> float().
+costs_query(Temp, entry1, Part, #costs{entry1=Entry1}) ->
+ costs_query_1(Temp, Part, Entry1);
+costs_query(Temp, entry2, Part, #costs{entry2=Entry2}) ->
+ costs_query_1(Temp, Part, Entry2);
+costs_query(Temp, exit, Part, #costs{exit=Exit}) ->
+ costs_query_1(Temp, Part, Exit);
+costs_query(Temp, spill, Part, #costs{spill=Spill}) ->
+ costs_query_1(Temp, Part, Spill);
+costs_query(Temp, restore, Part, #costs{restore=Restore}) ->
+ costs_query_1(Temp, Part, Restore).
+
+costs_query_1(Temp, Part, CostMap) ->
+ Key = [Part|Temp],
+ case CostMap of
+ #{Key := Wt} -> Wt;
+ #{} -> 0.0
+ end.
+
+-spec map_update_counter(Key, number(), #{Key => number(), OK => OV})
+ -> #{Key := number(), OK => OV}.
+map_update_counter(Key, Incr, Map) ->
+ case Map of
+ #{Key := Orig} -> Map#{Key := Orig + Incr};
+ #{} -> Map#{Key => Incr}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Def and use counting ADT
+-type ducount() :: #{temp() => float()}.
+
+-spec ducount_new() -> ducount().
+ducount_new() -> #{}.
+
+-spec ducount_add([temp()], float(), ducount()) -> ducount().
+ducount_add([], _Weight, DUCount) -> DUCount;
+ducount_add([T|Ts], Weight, DUCount0) ->
+ DUCount =
+ case DUCount0 of
+ #{T := Count} -> DUCount0#{T := Count + Weight};
+ #{} -> DUCount0#{T => Weight}
+ end,
+ ducount_add(Ts, Weight, DUCount).
+
+ducount_to_list(DUCount) -> maps:to_list(DUCount).
+
+-spec ducount_merge(ducount(), ducount()) -> ducount().
+ducount_merge(DCA, DCB) when map_size(DCA) < map_size(DCB) ->
+ ducount_merge_1(ducount_to_list(DCA), DCB);
+ducount_merge(DCA, DCB) when map_size(DCA) >= map_size(DCB) ->
+ ducount_merge_1(ducount_to_list(DCB), DCA).
+
+ducount_merge_1([], DUCount) -> DUCount;
+ducount_merge_1([{T,AC}|Ts], DUCount0) ->
+ DUCount =
+ case DUCount0 of
+ #{T := BC} -> DUCount0#{T := AC + BC};
+ #{} -> DUCount0#{T => AC}
+ end,
+ ducount_merge_1(Ts, DUCount).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Target module interface functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+-define(TGT_IFACE_0(N), N( {M,C}) -> M:N( C)).
+-define(TGT_IFACE_1(N), N(A1, {M,C}) -> M:N(A1, C)).
+-define(TGT_IFACE_2(N), N(A1,A2, {M,C}) -> M:N(A1,A2, C)).
+-define(TGT_IFACE_3(N), N(A1,A2,A3,{M,C}) -> M:N(A1,A2,A3,C)).
+
+?TGT_IFACE_2(bb).
+?TGT_IFACE_1(def_use).
+?TGT_IFACE_1(defines).
+?TGT_IFACE_1(defines_all_alloc).
+?TGT_IFACE_1(is_precoloured).
+?TGT_IFACE_1(mk_goto).
+?TGT_IFACE_2(mk_move).
+?TGT_IFACE_0(new_label).
+?TGT_IFACE_0(new_reg_nr).
+?TGT_IFACE_1(number_of_temporaries).
+?TGT_IFACE_3(redirect_jmp).
+?TGT_IFACE_1(reg_nr).
+?TGT_IFACE_1(reverse_postorder).
+?TGT_IFACE_2(subst_temps).
+?TGT_IFACE_3(update_bb).
+?TGT_IFACE_2(update_reg_nr).
+
+branch_preds(Instr, {TgtMod,TgtCtx}) ->
+ merge_sorted_preds(lists:keysort(1, TgtMod:branch_preds(Instr, TgtCtx))).
+
+livein(Liveness, L, Target={TgtMod,TgtCtx}) ->
+ ordsets:from_list(reg_names(TgtMod:livein(Liveness, L, TgtCtx), Target)).
+
+liveout(Liveness, L, Target={TgtMod,TgtCtx}) ->
+ ordsets:from_list(reg_names(TgtMod:liveout(Liveness, L, TgtCtx), Target)).
+
+merge_sorted_preds([]) -> [];
+merge_sorted_preds([{L, P1}, {L, P2}|LPs]) ->
+ merge_sorted_preds([{L, P1+P2}|LPs]);
+merge_sorted_preds([LP|LPs]) -> [LP|merge_sorted_preds(LPs)].
+
+reg_names(Regs, {TgtMod,TgtCtx}) ->
+ [TgtMod:reg_nr(X,TgtCtx) || X <- Regs].
diff --git a/lib/hipe/regalloc/hipe_regalloc_loop.erl b/lib/hipe/regalloc/hipe_regalloc_loop.erl
index 5bbb0ba7c1..29ef3adcc2 100644
--- a/lib/hipe/regalloc/hipe_regalloc_loop.erl
+++ b/lib/hipe/regalloc/hipe_regalloc_loop.erl
@@ -32,9 +32,11 @@ ra_fp(CFG, Liveness, Options, RegAllocMod, TargetMod, TargetCtx) ->
ra_common(CFG0, Liveness0, SpillIndex, Options, RegAllocMod, TargetMod,
TargetCtx) ->
?inc_counter(ra_calls_counter, 1),
- SpillLimit0 = TargetMod:number_of_temporaries(CFG0, TargetCtx),
+ {CFG1, Liveness1} =
+ do_range_split(CFG0, Liveness0, TargetMod, TargetCtx, Options),
+ SpillLimit0 = TargetMod:number_of_temporaries(CFG1, TargetCtx),
{Coloring, _, CFG, Liveness} =
- call_allocator_initial(CFG0, Liveness0, SpillLimit0, SpillIndex, Options,
+ call_allocator_initial(CFG1, Liveness1, SpillLimit0, SpillIndex, Options,
RegAllocMod, TargetMod, TargetCtx),
%% The first iteration, the hipe_regalloc_prepass may create new temps, these
%% should not end up above SpillLimit.
@@ -96,3 +98,20 @@ call_allocator(CFG, Liveness, SpillLimit, SpillIndex, Options, RegAllocMod,
RegAllocMod:regalloc(CFG, Liveness, SpillIndex, SpillLimit, TargetMod,
TargetCtx, Options)
end.
+
+do_range_split(CFG0, Liveness0, TgtMod, TgtCtx, Options) ->
+ {CFG2, Liveness1} =
+ case proplists:get_bool(ra_restore_reuse, Options) of
+ true ->
+ CFG1 = hipe_restore_reuse:split(CFG0, Liveness0, TgtMod, TgtCtx),
+ {CFG1, TgtMod:analyze(CFG1, TgtCtx)};
+ false ->
+ {CFG0, Liveness0}
+ end,
+ case proplists:get_bool(ra_range_split, Options) of
+ true ->
+ CFG3 = hipe_range_split:split(CFG2, Liveness1, TgtMod, TgtCtx, Options),
+ {CFG3, TgtMod:analyze(CFG3, TgtCtx)};
+ false ->
+ {CFG2, Liveness1}
+ end.
diff --git a/lib/hipe/regalloc/hipe_regalloc_prepass.erl b/lib/hipe/regalloc/hipe_regalloc_prepass.erl
index e212420ad2..5024840237 100644
--- a/lib/hipe/regalloc/hipe_regalloc_prepass.erl
+++ b/lib/hipe/regalloc/hipe_regalloc_prepass.erl
@@ -483,8 +483,8 @@ merge_pointless_splits_1([], _ScanBBs, DSets, Acc) -> {Acc, DSets};
merge_pointless_splits_1([P={_,{single,_}}|Ps], ScanBBs, DSets, Acc) ->
merge_pointless_splits_1(Ps, ScanBBs, DSets, [P|Acc]);
merge_pointless_splits_1([P0={L,{split,_,_}}|Ps], ScanBBs, DSets0, Acc) ->
- {EntryRoot, DSets1} = dsets_find({entry,L}, DSets0),
- {ExitRoot, DSets} = dsets_find({exit,L}, DSets1),
+ {EntryRoot, DSets1} = hipe_dsets:find({entry,L}, DSets0),
+ {ExitRoot, DSets} = hipe_dsets:find({exit,L}, DSets1),
case EntryRoot =:= ExitRoot of
false -> merge_pointless_splits_1(Ps, ScanBBs, DSets, [P0|Acc]);
true ->
@@ -501,7 +501,7 @@ merge_pointless_splits_1([P0={L,{split,_,_}}|Ps], ScanBBs, DSets0, Acc) ->
-spec merge_small_parts(bb_dsets()) -> {bb_dsets_rllist(), bb_dsets()}.
merge_small_parts(DSets0) ->
- {RLList, DSets1} = dsets_to_rllist(DSets0),
+ {RLList, DSets1} = hipe_dsets:to_rllist(DSets0),
RLLList = [{R, length(Elems), Elems} || {R, Elems} <- RLList],
merge_small_parts_1(RLLList, DSets1, []).
@@ -518,8 +518,8 @@ merge_small_parts_1([Fst,{R, L, Es}|Ps], DSets, Acc)
merge_small_parts_1([Fst|Ps], DSets, [{R,Es}|Acc]);
merge_small_parts_1([{R1,L1,Es1},{R2,L2,Es2}|Ps], DSets0, Acc) ->
?ASSERT(L1 < ?TUNE_TOO_FEW_BBS andalso L2 < ?TUNE_TOO_FEW_BBS),
- DSets1 = dsets_union(R1, R2, DSets0),
- {R, DSets} = dsets_find(R1, DSets1),
+ DSets1 = hipe_dsets:union(R1, R2, DSets0),
+ {R, DSets} = hipe_dsets:find(R1, DSets1),
merge_small_parts_1([{R,L2+L1,Es2++Es1}|Ps], DSets, Acc).
%% @doc Partition an ordering over BBs into subsequences for the dsets that
@@ -531,8 +531,8 @@ part_order(Lbs, DSets) -> part_order(Lbs, DSets, #{}).
part_order([], DSets, Acc) -> {Acc, DSets};
part_order([L|Ls], DSets0, Acc0) ->
- {EntryRoot, DSets1} = dsets_find({entry,L}, DSets0),
- {ExitRoot, DSets2} = dsets_find({exit,L}, DSets1),
+ {EntryRoot, DSets1} = hipe_dsets:find({entry,L}, DSets0),
+ {ExitRoot, DSets2} = hipe_dsets:find({exit,L}, DSets1),
Acc1 = map_append(EntryRoot, L, Acc0),
%% Only include the label once if both entry and exit is in same partition
Acc2 = case EntryRoot =:= ExitRoot of
@@ -558,73 +558,26 @@ map_append(Key, Elem, Map) ->
%% split point, and one from the end to the last split point.
-type bb_dset_key() :: {entry | exit, label()}.
--type bb_dsets() :: dsets(bb_dset_key()).
+-type bb_dsets() :: hipe_dsets:dsets(bb_dset_key()).
-type bb_dsets_rllist() :: [{bb_dset_key(), [bb_dset_key()]}].
-spec initial_dsets(target_cfg(), module(), target_context()) -> bb_dsets().
initial_dsets(CFG, TgtMod, TgtCtx) ->
Labels = TgtMod:labels(CFG, TgtCtx),
- DSets0 = dsets_new(lists:append([[{entry,L},{exit,L}] || L <- Labels])),
+ DSets0 = hipe_dsets:new(lists:append([[{entry,L},{exit,L}] || L <- Labels])),
Edges = lists:append([[{L, S} || S <- hipe_gen_cfg:succ(CFG, L)]
|| L <- Labels]),
- lists:foldl(fun({X, Y}, DS) -> dsets_union({exit,X}, {entry,Y}, DS) end,
+ lists:foldl(fun({X, Y}, DS) -> hipe_dsets:union({exit,X}, {entry,Y}, DS) end,
DSets0, Edges).
-spec join_whole_blocks(part_bb_list(), bb_dsets()) -> bb_dsets().
join_whole_blocks(PartBBList, DSets0) ->
- lists:foldl(fun({L, {single, _}}, DS) -> dsets_union({entry,L}, {exit,L}, DS);
+ lists:foldl(fun({L, {single, _}}, DS) ->
+ hipe_dsets:union({entry,L}, {exit,L}, DS);
({_, {split, _, _}}, DS) -> DS
end, DSets0, PartBBList).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% The disjoint set forests data structure, for elements of arbitrary types.
-%% Note that the find operation mutates the set.
-%%
-%% We could do this more efficiently if we restricted the elements to integers,
-%% and used the (mutable) hipe arrays. For arbitrary terms ETS could be used,
-%% for a persistent interface (which isn't that nice when even accessors return
-%% modified copies), the array module could be used.
--type dsets(X) :: #{X => {node, X} | {root, non_neg_integer()}}.
-
--spec dsets_new([E]) -> dsets(E).
-dsets_new(Elems) -> maps:from_list([{E,{root,0}} || E <- Elems]).
-
--spec dsets_find(E, dsets(E)) -> {E, dsets(E)}.
-dsets_find(E, DS0) ->
- case DS0 of
- #{E := {root,_}} -> {E, DS0};
- #{E := {node,N}} ->
- case dsets_find(N, DS0) of
- {N, _}=T -> T;
- {R, DS1} -> {R, DS1#{E := {node,R}}}
- end
- ;_ -> error(badarg, [E, DS0])
- end.
-
--spec dsets_union(E, E, dsets(E)) -> dsets(E).
-dsets_union(X, Y, DS0) ->
- {XRoot, DS1} = dsets_find(X, DS0),
- case dsets_find(Y, DS1) of
- {XRoot, DS2} -> DS2;
- {YRoot, DS2} ->
- #{XRoot := {root,XRR}, YRoot := {root,YRR}} = DS2,
- if XRR < YRR -> DS2#{XRoot := {node,YRoot}};
- XRR > YRR -> DS2#{YRoot := {node,XRoot}};
- true -> DS2#{YRoot := {node,XRoot}, XRoot := {root,XRR+1}}
- end
- end.
-
--spec dsets_to_rllist(dsets(E)) -> {[{Root::E, Elems::[E]}], dsets(E)}.
-dsets_to_rllist(DS0) ->
- {Lists, DS} = dsets_to_rllist(maps:keys(DS0), #{}, DS0),
- {maps:to_list(Lists), DS}.
-
-dsets_to_rllist([], Acc, DS) -> {Acc, DS};
-dsets_to_rllist([E|Es], Acc, DS0) ->
- {ERoot, DS} = dsets_find(E, DS0),
- dsets_to_rllist(Es, map_append(ERoot, E, Acc), DS).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Third pass
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Collect all referenced temps in each partition.
diff --git a/lib/hipe/regalloc/hipe_restore_reuse.erl b/lib/hipe/regalloc/hipe_restore_reuse.erl
new file mode 100644
index 0000000000..2158bd185e
--- /dev/null
+++ b/lib/hipe/regalloc/hipe_restore_reuse.erl
@@ -0,0 +1,516 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%@doc
+%% RESTORE REUSE LIVE RANGE SPLITTING PASS
+%%
+%% This is a simple live range splitter that tries to avoid sequences where a
+%% temporary is accessed on stack multiple times by keeping a copy of that temp
+%% around in a register.
+%%
+%% At any point where a temporary that is expected to be spilled (see uses of
+%% spills_add_list/2) is defined or used, this pass considers that temporary
+%% "available".
+%%
+%% Limitations:
+%% * If a live range part starts with several different restores, this module
+%% will introduce a new temp number for each of them, and later be forced to
+%% generate phi blocks. It would be more efficient to introduce just a
+%% single temp number. That would also remove the need for the phi blocks.
+%% * If a live range part ends in a definition, that definition should just
+%% define the base temp rather than the substitution, since some CISC
+%% targets might be able to inline the memory access in the instruction.
+-module(hipe_restore_reuse).
+
+-export([split/4]).
+
+%% Exports for hipe_range_split, which uses restore_reuse as one possible spill
+%% "mode"
+-export([analyse/3
+ ,renamed_in_block/2
+ ,split_in_block/2
+ ]).
+-export_type([avail/0]).
+
+-compile(inline).
+
+%% -define(DO_ASSERT, 1).
+-include("../main/hipe.hrl").
+
+-type target_cfg() :: any().
+-type liveness() :: any().
+-type target_module() :: module().
+-type target_context() :: any().
+-type target() :: {target_module(), target_context()}.
+-type label() :: non_neg_integer().
+-type reg() :: non_neg_integer().
+-type instr() :: any().
+-type temp() :: any().
+
+-spec split(target_cfg(), liveness(), target_module(), target_context())
+ -> target_cfg().
+split(CFG, Liveness, TargetMod, TargetContext) ->
+ Target = {TargetMod, TargetContext},
+ Avail = analyse(CFG, Liveness, Target),
+ rewrite(CFG, Target, Avail).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+-opaque avail() :: #{label() => avail_bb()}.
+
+-record(avail_bb, {
+ %% Blocks where HasCall is true are considered to have too high
+ %% register pressure to support a register copy of a temp
+ has_call :: boolean(),
+ %% AvailOut: Temps that can be split (are available)
+ out :: availset(),
+ %% Gen: AvailOut generated locally
+ gen :: availset(),
+ %% WantIn: Temps that are split
+ want :: regset(),
+ %% Self: Temps with avail-want pairs locally
+ self :: regset(),
+ %% DefIn: Temps shadowed by later def in same live range part
+ defin :: regset(),
+ pred :: [label()],
+ succ :: [label()]
+ }).
+-type avail_bb() :: #avail_bb{}.
+
+avail_get(L, Avail) -> maps:get(L, Avail).
+avail_set(L, Val, Avail) -> maps:put(L, Val, Avail).
+avail_has_call(L, Avail) -> (avail_get(L, Avail))#avail_bb.has_call.
+avail_out(L, Avail) -> (avail_get(L, Avail))#avail_bb.out.
+avail_self(L, Avail) -> (avail_get(L, Avail))#avail_bb.self.
+avail_pred(L, Avail) -> (avail_get(L, Avail))#avail_bb.pred.
+avail_succ(L, Avail) -> (avail_get(L, Avail))#avail_bb.succ.
+
+avail_in(L, Avail) ->
+ case avail_pred(L, Avail) of
+ [] -> availset_empty(); % entry
+ Pred ->
+ lists:foldl(fun(P, ASet) ->
+ availset_intersect(avail_out(P, Avail), ASet)
+ end, availset_top(), Pred)
+ end.
+
+want_in(L, Avail) -> (avail_get(L, Avail))#avail_bb.want.
+want_out(L, Avail) ->
+ lists:foldl(fun(S, Set) ->
+ ordsets:union(want_in(S, Avail), Set)
+ end, ordsets:new(), avail_succ(L, Avail)).
+
+def_in(L, Avail) -> (avail_get(L, Avail))#avail_bb.defin.
+def_out(L, Avail) ->
+ case avail_succ(L, Avail) of
+ [] -> ordsets:new(); % entry
+ Succ ->
+ ordsets:intersection([def_in(S, Avail) || S <- Succ])
+ end.
+
+-type regset() :: ordsets:ordset(reg()).
+-type availset() :: top | regset().
+availset_empty() -> [].
+availset_top() -> top.
+availset_intersect(top, B) -> B;
+availset_intersect(A, top) -> A;
+availset_intersect(A, B) -> ordsets:intersection(A, B).
+availset_union(top, _) -> top;
+availset_union(_, top) -> top;
+availset_union(A, B) -> ordsets:union(A, B).
+ordset_intersect_availset(OS, top) -> OS;
+ordset_intersect_availset(OS, AS) -> ordsets:intersection(OS, AS).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Analysis pass
+%%
+%% The analysis pass collects the set of temps we're interested in splitting
+%% (Spills), and computes three dataflow analyses for this subset of temps.
+%%
+%% Avail, which is the set of temps which are available in register from a
+%% previous (potential) spill or restore without going through a HasCall
+%% block.
+%% Want, which is a liveness analysis for the subset of temps used by an
+%% instruction that are also in Avail at that point. In other words, Want is
+%% the set of temps that are split (has a register copy) at a particular
+%% point.
+%% Def, which are the temps that are already going to be spilled later, and so
+%% need not be spilled when they're defined.
+%%
+%% Lastly, it computes the set Self for each block, which is the temps that have
+%% avail-want pairs in the same block, and so should be split in that block even
+%% if they're not in WantIn for the block.
+
+-spec analyse(target_cfg(), liveness(), target()) -> avail().
+analyse(CFG, Liveness, Target) ->
+ Avail0 = analyse_init(CFG, Liveness, Target),
+ RPO = reverse_postorder(CFG, Target),
+ AvailLs = [L || L <- RPO, not avail_has_call(L, Avail0)],
+ Avail1 = avail_dataf(AvailLs, Avail0),
+ Avail2 = analyse_filter_want(maps:keys(Avail1), Avail1),
+ PO = lists:reverse(RPO),
+ want_dataf(PO, Avail2).
+
+-spec analyse_init(target_cfg(), liveness(), target()) -> avail().
+analyse_init(CFG, Liveness, Target) ->
+ analyse_init(labels(CFG, Target), CFG, Liveness, Target, #{}, []).
+
+-spec analyse_init([label()], target_cfg(), liveness(), target(), spillset(),
+ [{label(), avail_bb()}])
+ -> avail().
+analyse_init([], _CFG, _Liveness, Target, Spills0, Acc) ->
+ %% Precoloured temps can't be spilled
+ Spills = spills_filter(fun(R) -> not is_precoloured(R, Target) end, Spills0),
+ analyse_init_1(Acc, Spills, []);
+analyse_init([L|Ls], CFG, Liveness, Target, Spills0, Acc) ->
+ {DefIn, Gen, Self, Want, HasCall0} =
+ analyse_scan(hipe_bb:code(bb(CFG, L, Target)), Target,
+ ordsets:new(), ordsets:new(), ordsets:new(),
+ ordsets:new()),
+ {Spills, Out, HasCall} =
+ case HasCall0 of
+ false -> {Spills0, availset_top(), false};
+ {true, CallDefs} ->
+ Spill = ordsets:subtract(liveout(Liveness, L, Target), CallDefs),
+ {spills_add_list(Spill, Spills0), Gen, true}
+ end,
+ Pred = hipe_gen_cfg:pred(CFG, L),
+ Succ = hipe_gen_cfg:succ(CFG, L),
+ Val = #avail_bb{gen=Gen, want=Want, self=Self, out=Out, has_call=HasCall,
+ pred=Pred, succ=Succ, defin=DefIn},
+ analyse_init(Ls, CFG, Liveness, Target, Spills, [{L, Val} | Acc]).
+
+-spec analyse_init_1([{label(), avail_bb()}], spillset(),
+ [{label(), avail_bb()}])
+ -> avail().
+analyse_init_1([], _Spills, Acc) -> maps:from_list(Acc);
+analyse_init_1([{L, Val0}|Vs], Spills, Acc) ->
+ #avail_bb{out=Out,gen=Gen,want=Want,self=Self} = Val0,
+ Val = Val0#avail_bb{
+ out = spills_filter_availset(Out, Spills),
+ gen = spills_filter_availset(Gen, Spills),
+ want = spills_filter_availset(Want, Spills),
+ self = spills_filter_availset(Self, Spills)},
+ analyse_init_1(Vs, Spills, [{L, Val} | Acc]).
+
+-type spillset() :: #{reg() => []}.
+-spec spills_add_list([reg()], spillset()) -> spillset().
+spills_add_list([], Spills) -> Spills;
+spills_add_list([R|Rs], Spills) -> spills_add_list(Rs, Spills#{R => []}).
+
+-spec spills_filter_availset(availset(), spillset()) -> availset().
+spills_filter_availset([E|Es], Spills) ->
+ case Spills of
+ #{E := _} -> [E|spills_filter_availset(Es, Spills)];
+ #{} -> spills_filter_availset(Es, Spills)
+ end;
+spills_filter_availset([], _) -> [];
+spills_filter_availset(top, _) -> top.
+
+spills_filter(Fun, Spills) -> maps:filter(fun(K, _) -> Fun(K) end, Spills).
+
+-spec analyse_scan([instr()], target(), Defset, Gen, Self, Want)
+ -> {Defset, Gen, Self, Want, HasCall} when
+ HasCall :: false | {true, regset()},
+ Defset :: regset(),
+ Gen :: availset(),
+ Self :: regset(),
+ Want :: regset().
+analyse_scan([], _Target, Defs, Gen, Self, Want) ->
+ {Defs, Gen, Self, Want, false};
+analyse_scan([I|Is], Target, Defs0, Gen0, Self0, Want0) ->
+ {DefL, UseL} = reg_def_use(I, Target),
+ Use = ordsets:from_list(UseL),
+ Def = ordsets:from_list(DefL),
+ Self = ordsets:union(ordsets:intersection(Use, Gen0), Self0),
+ Want = ordsets:union(ordsets:subtract(Use, Defs0), Want0),
+ Defs = ordsets:union(Def, Defs0),
+ case defines_all_alloc(I, Target) of
+ true ->
+ [] = Is, %assertion
+ {Defs, ordsets:new(), Self, Want, {true, Def}};
+ false ->
+ Gen = ordsets:union(ordsets:union(Def, Use), Gen0),
+ analyse_scan(Is, Target, Defs, Gen, Self, Want)
+ end.
+
+-spec avail_dataf([label()], avail()) -> avail().
+avail_dataf(RPO, Avail0) ->
+ case avail_dataf_once(RPO, Avail0, 0) of
+ {Avail, 0} -> Avail;
+ {Avail, _Changed} ->
+ avail_dataf(RPO, Avail)
+ end.
+
+-spec avail_dataf_once([label()], avail(), non_neg_integer())
+ -> {avail(), non_neg_integer()}.
+avail_dataf_once([], Avail, Changed) -> {Avail, Changed};
+avail_dataf_once([L|Ls], Avail0, Changed0) ->
+ ABB = #avail_bb{out=OldOut, gen=Gen} = avail_get(L, Avail0),
+ In = avail_in(L, Avail0),
+ {Changed, Avail} =
+ case availset_union(In, Gen) of
+ OldOut -> {Changed0, Avail0};
+ Out -> {Changed0+1, avail_set(L, ABB#avail_bb{out=Out}, Avail0)}
+ end,
+ avail_dataf_once(Ls, Avail, Changed).
+
+-spec analyse_filter_want([label()], avail()) -> avail().
+analyse_filter_want([], Avail) -> Avail;
+analyse_filter_want([L|Ls], Avail0) ->
+ ABB = #avail_bb{want=Want0, defin=DefIn0} = avail_get(L, Avail0),
+ In = avail_in(L, Avail0),
+ Want = ordset_intersect_availset(Want0, In),
+ DefIn = ordset_intersect_availset(DefIn0, In),
+ Avail = avail_set(L, ABB#avail_bb{want=Want, defin=DefIn}, Avail0),
+ analyse_filter_want(Ls, Avail).
+
+-spec want_dataf([label()], avail()) -> avail().
+want_dataf(PO, Avail0) ->
+ case want_dataf_once(PO, Avail0, 0) of
+ {Avail, 0} -> Avail;
+ {Avail, _Changed} ->
+ want_dataf(PO, Avail)
+ end.
+
+-spec want_dataf_once([label()], avail(), non_neg_integer())
+ -> {avail(), non_neg_integer()}.
+want_dataf_once([], Avail, Changed) -> {Avail, Changed};
+want_dataf_once([L|Ls], Avail0, Changed0) ->
+ ABB0 = #avail_bb{want=OldIn,defin=OldDef} = avail_get(L, Avail0),
+ AvailIn = avail_in(L, Avail0),
+ Out = want_out(L, Avail0),
+ DefOut = def_out(L, Avail0),
+ {Changed, Avail} =
+ case {ordsets:union(ordset_intersect_availset(Out, AvailIn), OldIn),
+ ordsets:union(ordset_intersect_availset(DefOut, AvailIn), OldDef)}
+ of
+ {OldIn, OldDef} -> {Changed0, Avail0};
+ {In, DefIn} ->
+ ABB = ABB0#avail_bb{want=In,defin=DefIn},
+ {Changed0+1, avail_set(L, ABB, Avail0)}
+ end,
+ want_dataf_once(Ls, Avail, Changed).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Rewrite pass
+-type subst_dict() :: orddict:orddict(reg(), reg()).
+-type input() :: #{label() => subst_dict()}.
+
+-spec rewrite(target_cfg(), target(), avail()) -> target_cfg().
+rewrite(CFG, Target, Avail) ->
+ RPO = reverse_postorder(CFG, Target),
+ rewrite(RPO, Target, Avail, #{}, CFG).
+
+-spec rewrite([label()], target(), avail(), input(), target_cfg())
+ -> target_cfg().
+rewrite([], _Target, _Avail, _Input, CFG) -> CFG;
+rewrite([L|Ls], Target, Avail, Input0, CFG0) ->
+ SplitHere = split_in_block(L, Avail),
+ {Input1, LInput} =
+ case Input0 of
+ #{L := LInput0} -> {Input0, LInput0};
+ #{} -> {Input0#{L => []}, []} % entry block
+ end,
+ ?ASSERT([] =:= [X || X <- SplitHere, orddict:is_key(X, LInput)]),
+ ?ASSERT(want_in(L, Avail) =:= orddict:fetch_keys(LInput)),
+ {CFG1, LOutput} =
+ case {SplitHere, LInput} of
+ {[], []} -> % optimisation (rewrite will do nothing, so skip it)
+ {CFG0, LInput};
+ _ ->
+ Code0 = hipe_bb:code(BB=bb(CFG0, L, Target)),
+ DefOut = def_out(L, Avail),
+ {Code, LOutput0, _DefIn} =
+ rewrite_instrs(Code0, Target, LInput, DefOut, SplitHere),
+ {update_bb(CFG0, L, hipe_bb:code_update(BB, Code), Target), LOutput0}
+ end,
+ {Input, CFG} = rewrite_succs(avail_succ(L, Avail), Target, L, LOutput, Avail,
+ Input1, CFG1),
+ rewrite(Ls, Target, Avail, Input, CFG).
+
+-spec renamed_in_block(label(), avail()) -> ordsets:ordset(reg()).
+renamed_in_block(L, Avail) ->
+ ordsets:union([avail_self(L, Avail), want_in(L, Avail),
+ want_out(L, Avail)]).
+
+-spec split_in_block(label(), avail()) -> ordsets:ordset(reg()).
+split_in_block(L, Avail) ->
+ ordsets:subtract(ordsets:union(avail_self(L, Avail), want_out(L, Avail)),
+ want_in(L, Avail)).
+
+-spec rewrite_instrs([instr()], target(), subst_dict(), regset(), [reg()])
+ -> {[instr()], subst_dict(), regset()}.
+rewrite_instrs([], _Target, Output, DefOut, []) ->
+ {[], Output, DefOut};
+rewrite_instrs([I|Is], Target, Input0, BBDefOut, SplitHere0) ->
+ {TDef, TUse} = def_use(I, Target),
+ {Def, Use} = {reg_names(TDef, Target), reg_names(TUse, Target)},
+ %% Restores are generated in forward order by picking temps from SplitHere as
+ %% they're used or defined. After the last instruction, all temps have been
+ %% picked.
+ {ISplits, SplitHere} =
+ lists:partition(fun(R) ->
+ lists:member(R, Def) orelse lists:member(R, Use)
+ end, SplitHere0),
+ {Input, Restores} =
+ case ISplits of
+ [] -> {Input0, []};
+ _ ->
+ make_splits(ISplits, Target, TDef, TUse, Input0, [])
+ end,
+ %% Here's the recursive call
+ {Acc0, Output, DefOut} =
+ rewrite_instrs(Is, Target, Input, BBDefOut, SplitHere),
+ %% From here we're processing instructions in reverse order, because to avoid
+ %% redundant spills we need to walk the 'def' dataflow, which is in reverse.
+ SubstFun = fun(Temp) ->
+ case orddict:find(reg_nr(Temp, Target), Input) of
+ {ok, NewTemp} -> NewTemp;
+ error -> Temp
+ end
+ end,
+ Acc1 = insert_spills(TDef, Target, Input, DefOut, Acc0),
+ Acc = Restores ++ [subst_temps(SubstFun, I, Target) | Acc1],
+ DefIn = ordsets:union(DefOut, ordsets:from_list(Def)),
+ {Acc, Output, DefIn}.
+
+-spec make_splits([reg()], target(), [temp()], [temp()], subst_dict(),
+ [instr()])
+ -> {subst_dict(), [instr()]}.
+make_splits([], _Target, _TDef, _TUse, Input, Acc) ->
+ {Input, Acc};
+make_splits([S|Ss], Target, TDef, TUse, Input0, Acc0) ->
+ SubstReg = new_reg_nr(Target),
+ {Acc, Subst} =
+ case find_reg_temp(S, TUse, Target) of
+ error ->
+ {ok, Temp} = find_reg_temp(S, TDef, Target),
+ {Acc0, update_reg_nr(SubstReg, Temp, Target)};
+ {ok, Temp} ->
+ Subst0 = update_reg_nr(SubstReg, Temp, Target),
+ Acc1 = [mk_move(Temp, Subst0, Target) | Acc0],
+ {Acc1, Subst0}
+ end,
+ Input = orddict:store(S, Subst, Input0),
+ make_splits(Ss, Target, TDef, TUse, Input, Acc).
+
+-spec find_reg_temp(reg(), [temp()], target()) -> error | {ok, temp()}.
+find_reg_temp(_Reg, [], _Target) -> error;
+find_reg_temp(Reg, [T|Ts], Target) ->
+ case reg_nr(T, Target) of
+ Reg -> {ok, T};
+ _ -> find_reg_temp(Reg, Ts, Target)
+ end.
+
+-spec insert_spills([temp()], target(), subst_dict(), regset(), [instr()])
+ -> [instr()].
+insert_spills([], _Target, _Input, _DefOut, Acc) -> Acc;
+insert_spills([T|Ts], Target, Input, DefOut, Acc0) ->
+ R = reg_nr(T, Target),
+ Acc =
+ case orddict:find(R, Input) of
+ error -> Acc0;
+ {ok, Subst} ->
+ case lists:member(R, DefOut) of
+ true -> Acc0;
+ false -> [mk_move(Subst, T, Target) | Acc0]
+ end
+ end,
+ insert_spills(Ts, Target, Input, DefOut, Acc).
+
+-spec rewrite_succs([label()], target(), label(), subst_dict(), avail(),
+ input(), target_cfg()) -> {input(), target_cfg()}.
+rewrite_succs([], _Target, _P, _POutput, _Avail, Input, CFG) -> {Input, CFG};
+rewrite_succs([L|Ls], Target, P, POutput, Avail, Input0, CFG0) ->
+ NewLInput = orddict_with_ordset(want_in(L, Avail), POutput),
+ {Input, CFG} =
+ case Input0 of
+ #{L := LInput} ->
+ CFG2 =
+ case required_phi_moves(LInput, NewLInput) of
+ [] -> CFG0;
+ ReqMovs ->
+ PhiLb = new_label(Target),
+ Code = [mk_move(S,D,Target) || {S,D} <- ReqMovs]
+ ++ [mk_goto(L, Target)],
+ PhiBB = hipe_bb:mk_bb(Code),
+ CFG1 = update_bb(CFG0, PhiLb, PhiBB, Target),
+ bb_redirect_jmp(L, PhiLb, P, CFG1, Target)
+ end,
+ {Input0, CFG2};
+ #{} ->
+ {Input0#{L => NewLInput}, CFG0}
+ end,
+ rewrite_succs(Ls, Target, P, POutput, Avail, Input, CFG).
+
+-spec bb_redirect_jmp(label(), label(), label(), target_cfg(), target())
+ -> target_cfg().
+bb_redirect_jmp(From, To, Lb, CFG, Target) ->
+ BB0 = bb(CFG, Lb, Target),
+ Last = redirect_jmp(hipe_bb:last(BB0), From, To, Target),
+ BB = hipe_bb:code_update(BB0, hipe_bb:butlast(BB0) ++ [Last]),
+ update_bb(CFG, Lb, BB, Target).
+
+-spec required_phi_moves(subst_dict(), subst_dict()) -> [{reg(), reg()}].
+required_phi_moves([], []) -> [];
+required_phi_moves([P|Is], [P|Os]) -> required_phi_moves(Is, Os);
+required_phi_moves([{K, In}|Is], [{K, Out}|Os]) ->
+ [{Out, In}|required_phi_moves(Is, Os)].
+
+%% @doc Returns a new orddict with the keys in Set and their associated values.
+-spec orddict_with_ordset(ordsets:ordset(K), orddict:orddict(K, V))
+ -> orddict:orddict(K, V).
+orddict_with_ordset([S|Ss], [{K, _}|_]=Dict) when S < K ->
+ orddict_with_ordset(Ss, Dict);
+orddict_with_ordset([S|_]=Set, [{K, _}|Ds]) when S > K ->
+ orddict_with_ordset(Set, Ds);
+orddict_with_ordset([_S|Ss], [{_K, _}=P|Ds]) -> % _S == _K
+ [P|orddict_with_ordset(Ss, Ds)];
+orddict_with_ordset([], _) -> [];
+orddict_with_ordset(_, []) -> [].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Target module interface functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+-define(TGT_IFACE_0(N), N( {M,C}) -> M:N( C)).
+-define(TGT_IFACE_1(N), N(A1, {M,C}) -> M:N(A1, C)).
+-define(TGT_IFACE_2(N), N(A1,A2, {M,C}) -> M:N(A1,A2, C)).
+-define(TGT_IFACE_3(N), N(A1,A2,A3,{M,C}) -> M:N(A1,A2,A3,C)).
+
+?TGT_IFACE_2(bb).
+?TGT_IFACE_1(def_use).
+?TGT_IFACE_1(defines_all_alloc).
+?TGT_IFACE_1(is_precoloured).
+?TGT_IFACE_1(labels).
+?TGT_IFACE_1(mk_goto).
+?TGT_IFACE_2(mk_move).
+?TGT_IFACE_0(new_label).
+?TGT_IFACE_0(new_reg_nr).
+?TGT_IFACE_3(redirect_jmp).
+?TGT_IFACE_1(reg_nr).
+?TGT_IFACE_1(reverse_postorder).
+?TGT_IFACE_2(subst_temps).
+?TGT_IFACE_3(update_bb).
+?TGT_IFACE_2(update_reg_nr).
+
+liveout(Liveness, L, Target={TgtMod,TgtCtx}) ->
+ ordsets:from_list(reg_names(TgtMod:liveout(Liveness, L, TgtCtx), Target)).
+
+reg_names(Regs, {TgtMod,TgtCtx}) ->
+ [TgtMod:reg_nr(X,TgtCtx) || X <- Regs].
+
+reg_def_use(I, Target) ->
+ {TDef, TUse} = def_use(I, Target),
+ {reg_names(TDef, Target), reg_names(TUse, Target)}.
diff --git a/lib/hipe/regalloc/hipe_sparc_specific.erl b/lib/hipe/regalloc/hipe_sparc_specific.erl
index 31fca81316..78b6379eba 100644
--- a/lib/hipe/regalloc/hipe_sparc_specific.erl
+++ b/lib/hipe/regalloc/hipe_sparc_specific.erl
@@ -24,6 +24,7 @@
,reg_nr/2
,def_use/2
,is_move/2
+ ,is_spill_move/2
,is_precoloured/2
,var_range/2
,allocatable/1
@@ -46,12 +47,19 @@
%% callbacks for hipe_regalloc_loop
-export([check_and_rewrite/3]).
-%% callbacks for hipe_regalloc_prepass
--export([new_reg_nr/1,
+%% callbacks for hipe_regalloc_prepass, hipe_range_split
+-export([mk_move/3,
+ mk_goto/2,
+ redirect_jmp/4,
+ new_label/1,
+ new_reg_nr/1,
update_reg_nr/3,
update_bb/4,
subst_temps/3]).
+%% callbacks for hipe_bb_weights, hipe_range_split
+-export([branch_preds/2]).
+
check_and_rewrite(CFG, Coloring, no_context) ->
hipe_sparc_ra_postconditions:check_and_rewrite(CFG, Coloring, 'normal').
@@ -115,6 +123,9 @@ bb(CFG,L,_) ->
update_bb(CFG,L,BB,_) ->
hipe_sparc_cfg:bb_add(CFG,L,BB).
+branch_preds(Branch,_) ->
+ hipe_sparc_cfg:branch_preds(Branch).
+
%% SPARC stuff
def_use(Instruction, Ctx) ->
@@ -144,9 +155,24 @@ is_move(Instruction, _) ->
false -> false
end.
+is_spill_move(Instruction, _) ->
+ hipe_sparc:is_pseudo_spill_move(Instruction).
+
reg_nr(Reg, _) ->
hipe_sparc:temp_reg(Reg).
+mk_move(Src, Dst, _) ->
+ hipe_sparc:mk_pseudo_move(Src, Dst).
+
+mk_goto(Label, _) ->
+ hipe_sparc:mk_b_label(Label).
+
+redirect_jmp(Jmp, ToOld, ToNew, _) when is_integer(ToOld), is_integer(ToNew) ->
+ hipe_sparc_cfg:redirect_jmp(Jmp, ToOld, ToNew).
+
+new_label(_) ->
+ hipe_gensym:get_next_label(sparc).
+
new_reg_nr(_) ->
hipe_gensym:get_next_var(sparc).
diff --git a/lib/hipe/regalloc/hipe_sparc_specific_fp.erl b/lib/hipe/regalloc/hipe_sparc_specific_fp.erl
index 050d65e1a9..485fdc212a 100644
--- a/lib/hipe/regalloc/hipe_sparc_specific_fp.erl
+++ b/lib/hipe/regalloc/hipe_sparc_specific_fp.erl
@@ -24,6 +24,7 @@
,reg_nr/2
,def_use/2
,is_move/2
+ ,is_spill_move/2
,is_precoloured/2
,var_range/2
,allocatable/1
@@ -46,12 +47,19 @@
%% callbacks for hipe_regalloc_loop
-export([check_and_rewrite/3]).
-%% callbacks for hipe_regalloc_prepass
--export([new_reg_nr/1,
+%% callbacks for hipe_regalloc_prepass, hipe_range_split
+-export([mk_move/3,
+ mk_goto/2,
+ redirect_jmp/4,
+ new_label/1,
+ new_reg_nr/1,
update_reg_nr/3,
update_bb/4,
subst_temps/3]).
+%% callbacks for hipe_bb_weights, hipe_range_split
+-export([branch_preds/2]).
+
check_and_rewrite(CFG, Coloring, no_context) ->
hipe_sparc_ra_postconditions_fp:check_and_rewrite(CFG, Coloring).
@@ -108,6 +116,9 @@ bb(CFG, L, _) ->
update_bb(CFG,L,BB,_) ->
hipe_sparc_cfg:bb_add(CFG,L,BB).
+branch_preds(Branch,_) ->
+ hipe_sparc_cfg:branch_preds(Branch).
+
%% SPARC stuff
def_use(I, Ctx) ->
@@ -125,9 +136,24 @@ defines_all_alloc(I, _) ->
is_move(I, _) ->
hipe_sparc:is_pseudo_fmove(I).
+is_spill_move(I, _) ->
+ hipe_sparc:is_pseudo_spill_fmove(I).
+
reg_nr(Reg, _) ->
hipe_sparc:temp_reg(Reg).
+mk_move(Src, Dst, _) ->
+ hipe_sparc:mk_pseudo_fmove(Src, Dst).
+
+mk_goto(Label, _) ->
+ hipe_sparc:mk_b_label(Label).
+
+redirect_jmp(Jmp, ToOld, ToNew, _) when is_integer(ToOld), is_integer(ToNew) ->
+ hipe_sparc_cfg:redirect_jmp(Jmp, ToOld, ToNew).
+
+new_label(_) ->
+ hipe_gensym:get_next_label(sparc).
+
new_reg_nr(_) ->
hipe_gensym:get_next_var(sparc).
diff --git a/lib/hipe/regalloc/hipe_x86_specific.erl b/lib/hipe/regalloc/hipe_x86_specific.erl
index c1c8dbbcd6..dacfb71b00 100644
--- a/lib/hipe/regalloc/hipe_x86_specific.erl
+++ b/lib/hipe/regalloc/hipe_x86_specific.erl
@@ -46,6 +46,7 @@
def_use/2,
is_arg/2, % used by hipe_ls_regalloc
is_move/2,
+ is_spill_move/2,
is_fixed/2, % used by hipe_graph_coloring_regalloc
is_global/2,
is_precoloured/2,
@@ -63,12 +64,19 @@
%% callbacks for hipe_regalloc_loop
-export([check_and_rewrite/3]).
-%% callbacks for hipe_regalloc_prepass
--export([new_reg_nr/1,
+%% callbacks for hipe_regalloc_prepass, hipe_range_split
+-export([mk_move/3,
+ mk_goto/2,
+ redirect_jmp/4,
+ new_label/1,
+ new_reg_nr/1,
update_reg_nr/3,
update_bb/4,
subst_temps/3]).
+%% callbacks for hipe_bb_weights
+-export([branch_preds/2]).
+
check_and_rewrite(CFG, Coloring, _) ->
?HIPE_X86_RA_POSTCONDITIONS:check_and_rewrite(CFG, Coloring, 'normal').
@@ -156,6 +164,9 @@ bb(CFG,L,_) ->
update_bb(CFG,L,BB,_) ->
hipe_x86_cfg:bb_add(CFG,L,BB).
+branch_preds(Instr,_) ->
+ hipe_x86_cfg:branch_preds(Instr).
+
%% X86 stuff
def_use(Instruction,_) ->
@@ -200,9 +211,33 @@ is_move(Instruction,_) ->
false -> false
end.
+is_spill_move(Instruction,_) ->
+ hipe_x86:is_pseudo_spill_move(Instruction).
+
reg_nr(Reg,_) ->
hipe_x86:temp_reg(Reg).
+mk_move(Src, Dst, _) ->
+ hipe_x86:mk_move(Src, Dst).
+
+mk_goto(Label, _) ->
+ hipe_x86:mk_jmp_label(Label).
+
+redirect_jmp(Jmp, ToOld, ToNew, _) when is_integer(ToOld), is_integer(ToNew) ->
+ Ref = make_ref(),
+ put(Ref, false),
+ I = hipe_x86_subst:insn_lbls(
+ fun(Tgt) ->
+ if Tgt =:= ToOld -> put(Ref, true), ToNew;
+ is_integer(Tgt) -> Tgt
+ end
+ end, Jmp),
+ true = erase(Ref), % Assert that something was rewritten
+ I.
+
+new_label(_) ->
+ hipe_gensym:get_next_label(x86).
+
new_reg_nr(_) ->
hipe_gensym:get_next_var(x86).
diff --git a/lib/hipe/regalloc/hipe_x86_specific_x87.erl b/lib/hipe/regalloc/hipe_x86_specific_x87.erl
index 4b4c83f76d..3fe49e1f00 100644
--- a/lib/hipe/regalloc/hipe_x86_specific_x87.erl
+++ b/lib/hipe/regalloc/hipe_x86_specific_x87.erl
@@ -47,6 +47,7 @@
uses/2,
defines/2,
defines_all_alloc/2,
+ is_spill_move/2,
is_global/2,
reg_nr/2,
physical_name/2,
@@ -158,6 +159,9 @@ defines(I, _) ->
defines_all_alloc(I, _) -> hipe_amd64_defuse:insn_defs_all(I).
+is_spill_move(I, _) ->
+ hipe_x86:is_pseudo_spill_fmove(I).
+
temp_is_double(Temp) ->
hipe_x86:temp_type(Temp) =:= 'double'.
diff --git a/lib/hipe/sparc/hipe_sparc.erl b/lib/hipe/sparc/hipe_sparc.erl
index 916857b224..22e0761b69 100644
--- a/lib/hipe/sparc/hipe_sparc.erl
+++ b/lib/hipe/sparc/hipe_sparc.erl
@@ -87,6 +87,9 @@
mk_pseudo_set/2,
+ mk_pseudo_spill_move/3,
+ is_pseudo_spill_move/1,
+
mk_pseudo_tailcall/4,
pseudo_tailcall_funv/1,
pseudo_tailcall_linkage/1,
@@ -117,6 +120,9 @@
pseudo_fmove_src/1,
pseudo_fmove_dst/1,
+ mk_pseudo_spill_fmove/3,
+ is_pseudo_spill_fmove/1,
+
mk_pseudo_fstore/3,
mk_fstore/4,
@@ -269,6 +275,10 @@ mk_pseudo_ret() -> #pseudo_ret{}.
mk_pseudo_set(Imm, Dst) -> #pseudo_set{imm=Imm, dst=Dst}.
+mk_pseudo_spill_move(Src, Temp, Dst) ->
+ #pseudo_spill_move{src=Src, temp=Temp, dst=Dst}.
+is_pseudo_spill_move(I) -> is_record(I, pseudo_spill_move).
+
mk_pseudo_tailcall(FunV, Arity, StkArgs, Linkage) ->
#pseudo_tailcall{funv=FunV, arity=Arity, stkargs=StkArgs, linkage=Linkage}.
pseudo_tailcall_funv(#pseudo_tailcall{funv=FunV}) -> FunV.
@@ -375,6 +385,10 @@ is_pseudo_fmove(I) -> case I of #pseudo_fmove{} -> true; _ -> false end.
pseudo_fmove_src(#pseudo_fmove{src=Src}) -> Src.
pseudo_fmove_dst(#pseudo_fmove{dst=Dst}) -> Dst.
+mk_pseudo_spill_fmove(Src, Temp, Dst) ->
+ #pseudo_spill_fmove{src=Src, temp=Temp, dst=Dst}.
+is_pseudo_spill_fmove(I) -> is_record(I, pseudo_spill_fmove).
+
mk_pseudo_fstore(Src, Base, Disp) ->
#pseudo_fstore{src=Src, base=Base, disp=Disp}.
diff --git a/lib/hipe/sparc/hipe_sparc.hrl b/lib/hipe/sparc/hipe_sparc.hrl
index 4eae6777a9..f60e516e59 100644
--- a/lib/hipe/sparc/hipe_sparc.hrl
+++ b/lib/hipe/sparc/hipe_sparc.hrl
@@ -88,6 +88,8 @@
-record(pseudo_move, {src, dst}).
-record(pseudo_ret, {}).
-record(pseudo_set, {imm, dst}).
+-record(pseudo_spill_fmove, {src, temp, dst}).
+-record(pseudo_spill_move, {src, temp, dst}).
-record(pseudo_tailcall, {funv, arity, stkargs, linkage}).
-record(pseudo_tailcall_prepare, {}).
-record(rdy, {dst}).
diff --git a/lib/hipe/sparc/hipe_sparc_cfg.erl b/lib/hipe/sparc/hipe_sparc_cfg.erl
index 27374d187b..45c8e887b5 100644
--- a/lib/hipe/sparc/hipe_sparc_cfg.erl
+++ b/lib/hipe/sparc/hipe_sparc_cfg.erl
@@ -23,6 +23,7 @@
-export([linearise/1]).
-export([params/1]).
-export([arity/1]). % for linear scan
+-export([redirect_jmp/3, branch_preds/1]).
-define(SPARC_CFG, true). % needed for cfg.inc
@@ -77,28 +78,53 @@ branch_successors(Branch) ->
#pseudo_tailcall{} -> []
end.
+branch_preds(Branch) ->
+ case Branch of
+ #jmp{labels=Labels} ->
+ Prob = 1.0/length(Labels),
+ [{L, Prob} || L <- Labels];
+ #pseudo_bp{true_label=TrueLab,false_label=FalseLab,pred=Pred} ->
+ [{FalseLab, 1.0-Pred}, {TrueLab, Pred}];
+ #pseudo_call{contlab=ContLab, sdesc=#sparc_sdesc{exnlab=[]}} ->
+ %% A function can still cause an exception, even if we won't catch it
+ [{ContLab, 1.0-hipe_bb_weights:call_exn_pred()}];
+ #pseudo_call{contlab=ContLab, sdesc=#sparc_sdesc{exnlab=ExnLab}} ->
+ CallExnPred = hipe_bb_weights:call_exn_pred(),
+ [{ContLab, 1.0-CallExnPred}, {ExnLab, CallExnPred}];
+ _ ->
+ case branch_successors(Branch) of
+ [] -> [];
+ [Single] -> [{Single, 1.0}]
+ end
+ end.
+
-ifdef(REMOVE_TRIVIAL_BBS_NEEDED).
fails_to(_Instr) -> [].
-endif.
--ifdef(notdef).
redirect_jmp(I, Old, New) ->
case I of
- #b_label{label=Label} ->
- if Old =:= Label -> I#b_label{label=New};
+ #bp{'cond'='a',label=Label} ->
+ if Old =:= Label -> I#bp{label=New};
true -> I
end;
- #pseudo_bc{true_label=TrueLab, false_label=FalseLab} ->
- I1 = if Old =:= TrueLab -> I#pseudo_bc{true_label=New};
+ #pseudo_bp{true_label=TrueLab, false_label=FalseLab} ->
+ I1 = if Old =:= TrueLab -> I#pseudo_bp{true_label=New};
true -> I
end,
- if Old =:= FalseLab -> I1#pseudo_bc{false_label=New};
+ if Old =:= FalseLab -> I1#pseudo_bp{false_label=New};
true -> I1
end;
- %% handle pseudo_call too?
- _ -> I
+ #pseudo_call{contlab=ContLab0, sdesc=SDesc0} ->
+ SDesc = case SDesc0 of
+ #sparc_sdesc{exnlab=Old} -> SDesc0#sparc_sdesc{exnlab=New};
+ #sparc_sdesc{exnlab=_} -> SDesc0
+ end,
+ ContLab = if Old =:= ContLab0 -> New;
+ true -> ContLab0
+ end,
+ I#pseudo_call{sdesc=SDesc, contlab=ContLab}
end.
--endif.
mk_goto(Label) ->
hipe_sparc:mk_b_label(Label).
diff --git a/lib/hipe/sparc/hipe_sparc_defuse.erl b/lib/hipe/sparc/hipe_sparc_defuse.erl
index cb75f82e2b..4d4b11e301 100644
--- a/lib/hipe/sparc/hipe_sparc_defuse.erl
+++ b/lib/hipe/sparc/hipe_sparc_defuse.erl
@@ -39,6 +39,7 @@ insn_def_gpr(I) ->
#pseudo_call{} -> call_clobbered_gpr();
#pseudo_move{dst=Dst} -> [Dst];
#pseudo_set{dst=Dst} -> [Dst];
+ #pseudo_spill_move{temp=Temp, dst=Dst} -> [Temp, Dst];
#pseudo_tailcall_prepare{} -> tailcall_clobbered_gpr();
#rdy{dst=Dst} -> [Dst];
#sethi{dst=Dst} -> [Dst];
@@ -72,6 +73,7 @@ insn_use_gpr(I) ->
funv_use(FunV, arity_use_gpr(Arity));
#pseudo_move{src=Src} -> [Src];
#pseudo_ret{} -> [hipe_sparc:mk_rv()];
+ #pseudo_spill_move{src=Src} -> [Src];
#pseudo_tailcall{funv=FunV,arity=Arity,stkargs=StkArgs} ->
addsrcs(StkArgs, addtemps(tailcall_clobbered_gpr(), funv_use(FunV, arity_use_gpr(Arity))));
#store{src=Src,base=Base,disp=Disp} ->
@@ -112,6 +114,7 @@ insn_def_fpr(I) ->
#fp_unary{dst=Dst} -> [Dst];
#pseudo_fload{dst=Dst} -> [Dst];
#pseudo_fmove{dst=Dst} -> [Dst];
+ #pseudo_spill_fmove{temp=Temp, dst=Dst} -> [Temp, Dst];
_ -> []
end.
@@ -130,6 +133,7 @@ insn_use_fpr(I) ->
#fp_unary{src=Src} -> [Src];
#pseudo_fmove{src=Src} -> [Src];
#pseudo_fstore{src=Src} -> [Src];
+ #pseudo_spill_fmove{src=Src} -> [Src];
_ -> []
end.
diff --git a/lib/hipe/sparc/hipe_sparc_frame.erl b/lib/hipe/sparc/hipe_sparc_frame.erl
index 6f29c3c905..1f2a259ca1 100644
--- a/lib/hipe/sparc/hipe_sparc_frame.erl
+++ b/lib/hipe/sparc/hipe_sparc_frame.erl
@@ -82,6 +82,10 @@ do_insn(I, LiveOut, Context, FPoff) ->
{do_pseudo_tailcall(I, Context), context_framesize(Context)};
#pseudo_fmove{} ->
{do_pseudo_fmove(I, Context, FPoff), FPoff};
+ #pseudo_spill_move{} ->
+ {do_pseudo_spill_move(I, Context, FPoff), FPoff};
+ #pseudo_spill_fmove{} ->
+ {do_pseudo_spill_fmove(I, Context, FPoff), FPoff};
_ ->
{[I], FPoff}
end.
@@ -110,6 +114,22 @@ do_pseudo_move(I, Context, FPoff) ->
end
end.
+do_pseudo_spill_move(I, Context, FPoff) ->
+ #pseudo_spill_move{src=Src,temp=Temp,dst=Dst} = I,
+ case temp_is_pseudo(Src) andalso temp_is_pseudo(Dst) of
+ false -> % Register allocator changed its mind, turn back to move
+ do_pseudo_move(hipe_sparc:mk_pseudo_move(Src, Dst), Context, FPoff);
+ true ->
+ SrcOffset = pseudo_offset(Src, FPoff, Context),
+ DstOffset = pseudo_offset(Dst, FPoff, Context),
+ case SrcOffset =:= DstOffset of
+ true -> []; % omit move-to-self
+ false ->
+ mk_load(hipe_sparc:mk_sp(), SrcOffset, Temp,
+ mk_store(Temp, hipe_sparc:mk_sp(), DstOffset, []))
+ end
+ end.
+
do_pseudo_fmove(I, Context, FPoff) ->
Dst = hipe_sparc:pseudo_fmove_dst(I),
Src = hipe_sparc:pseudo_fmove_src(I),
@@ -127,6 +147,22 @@ do_pseudo_fmove(I, Context, FPoff) ->
end
end.
+do_pseudo_spill_fmove(I, Context, FPoff) ->
+ #pseudo_spill_fmove{src=Src,temp=Temp,dst=Dst} = I,
+ case temp_is_pseudo(Src) andalso temp_is_pseudo(Dst) of
+ false -> % Register allocator changed its mind, turn back to fmove
+ do_pseudo_fmove(hipe_sparc:mk_pseudo_fmove(Src, Dst), Context, FPoff);
+ true ->
+ SrcOffset = pseudo_offset(Src, FPoff, Context),
+ DstOffset = pseudo_offset(Dst, FPoff, Context),
+ case SrcOffset =:= DstOffset of
+ true -> []; % omit move-to-self
+ false ->
+ mk_fload(hipe_sparc:mk_sp(), SrcOffset, Temp)
+ ++ mk_fstore(Temp, hipe_sparc:mk_sp(), DstOffset)
+ end
+ end.
+
pseudo_offset(Temp, FPoff, Context) ->
FPoff + context_offset(Context, Temp).
diff --git a/lib/hipe/sparc/hipe_sparc_ra_finalise.erl b/lib/hipe/sparc/hipe_sparc_ra_finalise.erl
index 5fdb73e197..a724821992 100644
--- a/lib/hipe/sparc/hipe_sparc_ra_finalise.erl
+++ b/lib/hipe/sparc/hipe_sparc_ra_finalise.erl
@@ -38,6 +38,7 @@ ra_insn(I, Map, FPMap) ->
#pseudo_call{} -> ra_pseudo_call(I, Map);
#pseudo_move{} -> ra_pseudo_move(I, Map);
#pseudo_set{} -> ra_pseudo_set(I, Map);
+ #pseudo_spill_move{} -> ra_pseudo_spill_move(I, Map);
#pseudo_tailcall{} -> ra_pseudo_tailcall(I, Map);
#rdy{} -> ra_rdy(I, Map);
#sethi{} -> ra_sethi(I, Map);
@@ -47,6 +48,7 @@ ra_insn(I, Map, FPMap) ->
#pseudo_fload{} -> ra_pseudo_fload(I, Map, FPMap);
#pseudo_fmove{} -> ra_pseudo_fmove(I, FPMap);
#pseudo_fstore{} -> ra_pseudo_fstore(I, Map, FPMap);
+ #pseudo_spill_fmove{} -> ra_pseudo_spill_fmove(I, FPMap);
_ -> I
end.
@@ -80,6 +82,12 @@ ra_pseudo_set(I=#pseudo_set{dst=Dst}, Map) ->
NewDst = ra_temp(Dst, Map),
I#pseudo_set{dst=NewDst}.
+ra_pseudo_spill_move(I=#pseudo_spill_move{src=Src,temp=Temp,dst=Dst}, Map) ->
+ NewSrc = ra_temp(Src, Map),
+ NewTemp = ra_temp(Temp, Map),
+ NewDst = ra_temp(Dst, Map),
+ I#pseudo_spill_move{src=NewSrc,temp=NewTemp,dst=NewDst}.
+
ra_pseudo_tailcall(I=#pseudo_tailcall{funv=FunV,stkargs=StkArgs}, Map) ->
NewFunV = ra_funv(FunV, Map),
NewStkArgs = ra_args(StkArgs, Map),
@@ -120,6 +128,13 @@ ra_pseudo_fmove(I=#pseudo_fmove{src=Src,dst=Dst}, FPMap) ->
NewDst = ra_temp_fp(Dst, FPMap),
I#pseudo_fmove{src=NewSrc,dst=NewDst}.
+ra_pseudo_spill_fmove(I=#pseudo_spill_fmove{src=Src,temp=Temp,dst=Dst},
+ FPMap) ->
+ NewSrc = ra_temp_fp(Src, FPMap),
+ NewTemp = ra_temp_fp(Temp, FPMap),
+ NewDst = ra_temp_fp(Dst, FPMap),
+ I#pseudo_spill_fmove{src=NewSrc,temp=NewTemp,dst=NewDst}.
+
ra_pseudo_fstore(I=#pseudo_fstore{src=Src,base=Base}, Map, FPMap) ->
NewSrc = ra_temp_fp(Src, FPMap),
NewBase = ra_temp(Base, Map),
diff --git a/lib/hipe/sparc/hipe_sparc_ra_postconditions.erl b/lib/hipe/sparc/hipe_sparc_ra_postconditions.erl
index 984c97fbd4..d3ecb43ec6 100644
--- a/lib/hipe/sparc/hipe_sparc_ra_postconditions.erl
+++ b/lib/hipe/sparc/hipe_sparc_ra_postconditions.erl
@@ -54,6 +54,7 @@ do_insn(I, TempMap, Strategy) ->
#pseudo_call{} -> do_pseudo_call(I, TempMap, Strategy);
#pseudo_move{} -> do_pseudo_move(I, TempMap, Strategy);
#pseudo_set{} -> do_pseudo_set(I, TempMap, Strategy);
+ #pseudo_spill_move{} -> do_pseudo_spill_move(I, TempMap, Strategy);
#pseudo_tailcall{} -> do_pseudo_tailcall(I, TempMap, Strategy);
#rdy{} -> do_rdy(I, TempMap, Strategy);
#sethi{} -> do_sethi(I, TempMap, Strategy);
@@ -92,14 +93,16 @@ do_pseudo_call(I=#pseudo_call{funv=FunV}, TempMap, Strategy) ->
do_pseudo_move(I=#pseudo_move{src=Src,dst=Dst}, TempMap, Strategy) ->
%% Either Dst or Src (but not both) may be a pseudo temp.
- %% pseudo_move is a special case: in [XXX: not pseudo_tailcall]
- %% all other instructions, all temps must be non-pseudos
- %% after register allocation.
- case temp_is_spilled(Dst, TempMap) of
- true -> % Src must not be a pseudo
- {FixSrc,NewSrc,DidSpill} = fix_src1(Src, TempMap, Strategy),
- NewI = I#pseudo_move{src=NewSrc},
- {FixSrc ++ [NewI], DidSpill};
+ %% pseudo_move and pseudo_spill_move [XXX: not pseudo_tailcall]
+ %% are special cases: in all other instructions, all temps must
+ %% be non-pseudos after register allocation.
+ case temp_is_spilled(Src, TempMap)
+ andalso temp_is_spilled(Dst, TempMap)
+ of
+ true -> % Turn into pseudo_spill_move
+ Temp = clone(Src, temp1(Strategy)),
+ NewI = #pseudo_spill_move{src=Src,temp=Temp,dst=Dst},
+ {[NewI], true};
_ ->
{[I], false}
end.
@@ -109,6 +112,11 @@ do_pseudo_set(I=#pseudo_set{dst=Dst}, TempMap, Strategy) ->
NewI = I#pseudo_set{dst=NewDst},
{[NewI | FixDst], DidSpill}.
+do_pseudo_spill_move(I=#pseudo_spill_move{temp=Temp}, TempMap, _Strategy) ->
+ %% Temp is above the low water mark and must not have been spilled
+ false = temp_is_spilled(Temp, TempMap),
+ {[I], false}.
+
do_pseudo_tailcall(I=#pseudo_tailcall{funv=FunV}, TempMap, Strategy) ->
{FixFunV,NewFunV,DidSpill} = fix_funv(FunV, TempMap, Strategy),
NewI = I#pseudo_tailcall{funv=NewFunV},
diff --git a/lib/hipe/sparc/hipe_sparc_ra_postconditions_fp.erl b/lib/hipe/sparc/hipe_sparc_ra_postconditions_fp.erl
index 751e91425c..5fa3a5fc59 100644
--- a/lib/hipe/sparc/hipe_sparc_ra_postconditions_fp.erl
+++ b/lib/hipe/sparc/hipe_sparc_ra_postconditions_fp.erl
@@ -43,6 +43,7 @@ do_insn(I, TempMap) ->
#pseudo_fload{} -> do_pseudo_fload(I, TempMap);
#pseudo_fmove{} -> do_pseudo_fmove(I, TempMap);
#pseudo_fstore{} -> do_pseudo_fstore(I, TempMap);
+ #pseudo_spill_fmove{} -> do_pseudo_spill_fmove(I, TempMap);
_ -> {[I], false}
end.
@@ -67,11 +68,13 @@ do_pseudo_fload(I=#pseudo_fload{dst=Dst}, TempMap) ->
{[NewI | FixDst], DidSpill}.
do_pseudo_fmove(I=#pseudo_fmove{src=Src,dst=Dst}, TempMap) ->
- case temp_is_spilled(Dst, TempMap) of
- true ->
- {FixSrc,NewSrc,DidSpill} = fix_src(Src, TempMap),
- NewI = I#pseudo_fmove{src=NewSrc},
- {FixSrc ++ [NewI], DidSpill};
+ case temp_is_spilled(Src, TempMap)
+ andalso temp_is_spilled(Dst, TempMap)
+ of
+ true -> % Turn into pseudo_spill_fmove
+ Temp = clone(Src),
+ NewI = #pseudo_spill_fmove{src=Src,temp=Temp,dst=Dst},
+ {[NewI], true};
_ ->
{[I], false}
end.
@@ -81,6 +84,11 @@ do_pseudo_fstore(I=#pseudo_fstore{src=Src}, TempMap) ->
NewI = I#pseudo_fstore{src=NewSrc},
{FixSrc ++ [NewI], DidSpill}.
+do_pseudo_spill_fmove(I=#pseudo_spill_fmove{temp=Temp}, TempMap) ->
+ %% Temp is above the low water mark and must not have been spilled
+ false = temp_is_spilled(Temp, TempMap),
+ {[I], false}.
+
%%% Fix Dst and Src operands.
fix_src(Src, TempMap) ->
diff --git a/lib/hipe/sparc/hipe_sparc_subst.erl b/lib/hipe/sparc/hipe_sparc_subst.erl
index 1d0671464e..ce3bbb813a 100644
--- a/lib/hipe/sparc/hipe_sparc_subst.erl
+++ b/lib/hipe/sparc/hipe_sparc_subst.erl
@@ -44,6 +44,8 @@ insn_temps(T, I) ->
#pseudo_move{src=S,dst=D} -> I#pseudo_move{src=T(S),dst=T(D)};
#pseudo_ret{} -> I;
#pseudo_set{dst=D}-> I#pseudo_set{dst=T(D)};
+ #pseudo_spill_move{src=S,temp=U,dst=D} ->
+ I#pseudo_spill_move{src=T(S),temp=T(U),dst=T(D)};
#pseudo_tailcall{funv=F,stkargs=Stk} ->
I#pseudo_tailcall{funv=funv_temps(T,F),stkargs=lists:map(Arg,Stk)};
#pseudo_tailcall_prepare{} -> I;
@@ -57,7 +59,9 @@ insn_temps(T, I) ->
I#pseudo_fload{base=T(B),disp=S2(Di),dst=T(Ds)};
#pseudo_fmove{src=S,dst=D} -> I#pseudo_fmove{src=T(S),dst=T(D)};
#pseudo_fstore{src=S,base=B,disp=D} ->
- I#pseudo_fstore{src=T(S),base=T(B),disp=S2(D)}
+ I#pseudo_fstore{src=T(S),base=T(B),disp=S2(D)};
+ #pseudo_spill_fmove{src=S,temp=U,dst=D} ->
+ I#pseudo_spill_fmove{src=T(S),temp=T(U),dst=T(D)}
end.
-spec src2_temps(subst_fun(), src2()) -> src2().
diff --git a/lib/hipe/test/basic_SUITE_data/basic_edge_cases.erl b/lib/hipe/test/basic_SUITE_data/basic_edge_cases.erl
new file mode 100644
index 0000000000..9bf5cf52cd
--- /dev/null
+++ b/lib/hipe/test/basic_SUITE_data/basic_edge_cases.erl
@@ -0,0 +1,142 @@
+%%% -*- erlang-indent-level: 2 -*-
+%%%----------------------------------------------------------------------
+%%% Contains
+%%%----------------------------------------------------------------------
+-module(basic_edge_cases).
+
+-export([test/0]).
+
+test() ->
+ ok = test_float_spills(),
+ ok = test_infinite_loops(),
+ ok.
+
+%% Contains more float temps live at a single point than there are float
+%% registers in any backend
+
+test_float_spills() ->
+ {{{2942.0,4670.0,3198.0,4926.0,2206.0,4734.0},
+ {3118.0,2062.0,5174.0,3038.0,3618.0,3014.0},
+ {2542.0,2062.0,4934.0,2590.0,3098.0,3062.0},
+ {2950.0,3666.0,2574.0,5038.0,1866.0,2946.0},
+ {3126.0,3050.0,3054.0,5070.0,2258.0,2714.0},
+ {4734.0,2206.0,4926.0,3198.0,4670.0,2942.0}},
+ 58937.0} =
+ mat66_flip_sum(35.0,86.0,32.0,88.0,33.0,57.0,
+ 22.0,77.0,91.0,80.0,14.0,33.0,
+ 51.0,28.0,87.0,20.0,91.0,11.0,
+ 68.0,83.0,64.0,82.0,10.0,86.0,
+ 74.0,18.0,08.0,52.0,10.0,14.0,
+ 89.0,34.0,64.0,66.0,58.0,55.0,
+ 0.0, 5),
+ ok.
+
+mat66_flip_sum(M11, M12, M13, M14, M15, M16,
+ M21, M22, M23, M24, M25, M26,
+ M31, M32, M33, M34, M35, M36,
+ M41, M42, M43, M44, M45, M46,
+ M51, M52, M53, M54, M55, M56,
+ M61, M62, M63, M64, M65, M66,
+ Acc, Ctr)
+ when is_float(M11), is_float(M12), is_float(M13),
+ is_float(M14), is_float(M15), is_float(M16),
+ is_float(M21), is_float(M22), is_float(M23),
+ is_float(M24), is_float(M25), is_float(M26),
+ is_float(M31), is_float(M32), is_float(M33),
+ is_float(M34), is_float(M35), is_float(M36),
+ is_float(M41), is_float(M42), is_float(M43),
+ is_float(M44), is_float(M45), is_float(M46),
+ is_float(M51), is_float(M52), is_float(M53),
+ is_float(M54), is_float(M55), is_float(M56),
+ is_float(M61), is_float(M62), is_float(M63),
+ is_float(M64), is_float(M65), is_float(M66),
+ is_float(Acc) ->
+ R11 = M66+M11, R12 = M65+M12, R13 = M64+M13,
+ R14 = M63+M14, R15 = M62+M15, R16 = M61+M16,
+ R21 = M56+M21, R22 = M55+M22, R23 = M54+M23,
+ R24 = M53+M24, R25 = M52+M25, R26 = M51+M26,
+ R31 = M46+M31, R32 = M45+M32, R33 = M44+M33,
+ R34 = M43+M34, R35 = M42+M35, R36 = M41+M36,
+ R41 = M26+M41, R42 = M25+M42, R43 = M24+M43,
+ R44 = M23+M44, R45 = M22+M45, R46 = M21+M46,
+ R51 = M36+M51, R52 = M35+M52, R53 = M34+M53,
+ R54 = M33+M54, R55 = M32+M55, R56 = M31+M56,
+ R61 = M16+M61, R62 = M15+M62, R63 = M14+M63,
+ R64 = M13+M64, R65 = M12+M65, R66 = M11+M66,
+ case Ctr of
+ 0 ->
+ {{{R11, R12, R13, R14, R15, R16},
+ {R21, R22, R23, R24, R25, R26},
+ {R31, R32, R33, R34, R35, R36},
+ {R41, R42, R43, R44, R45, R46},
+ {R51, R52, R53, R54, R55, R56},
+ {R61, R62, R63, R64, R65, R66}},
+ Acc};
+ _ ->
+ NewAcc = 0.0 + M11 + M12 + M13 + M14 + M15 + M16 +
+ + M21 + M22 + M23 + M24 + M25 + M26
+ + M31 + M32 + M33 + M34 + M35 + M36
+ + M41 + M42 + M43 + M44 + M45 + M46
+ + M51 + M52 + M53 + M54 + M55 + M56
+ + M61 + M62 + M63 + M64 + M65 + M66
+ + Acc,
+ mat66_flip_sum(R11+1.0, R12+1.0, R13+1.0, R14+1.0, R15+1.0, R16+1.0,
+ R21+1.0, R22+1.0, R23+1.0, R24+1.0, R25+1.0, R26+1.0,
+ R31+1.0, R32+1.0, R33+1.0, R34+1.0, R35+1.0, R36+1.0,
+ R41+1.0, R42+1.0, R43+1.0, R44+1.0, R45+1.0, R46+1.0,
+ R51+1.0, R52+1.0, R53+1.0, R54+1.0, R55+1.0, R56+1.0,
+ R61+1.0, R62+1.0, R63+1.0, R64+1.0, R65+1.0, R66+1.0,
+ NewAcc, Ctr-1)
+ end.
+
+%% Infinite loops must receive reduction tests, and might trip up basic block
+%% weighting, leading to infinite weights and/or divisions by zero.
+
+test_infinite_loops() ->
+ OldTrapExit = process_flag(trap_exit, true),
+ ok = test_infinite_loop(fun infinite_recursion/0),
+ ok = test_infinite_loop(fun infinite_corecursion/0),
+ RecursiveFun = fun RecursiveFun() -> RecursiveFun() end,
+ ok = test_infinite_loop(RecursiveFun),
+ CorecursiveFunA = fun CorecursiveFunA() ->
+ CorecursiveFunA1 = fun () -> CorecursiveFunA() end,
+ CorecursiveFunA1()
+ end,
+ ok = test_infinite_loop(CorecursiveFunA),
+ CorecursiveFunB1 = fun(CorecursiveFunB) -> CorecursiveFunB() end,
+ CorecursiveFunB = fun CorecursiveFunB() ->
+ CorecursiveFunB1(CorecursiveFunB)
+ end,
+ ok = test_infinite_loop(CorecursiveFunB),
+ CorecursiveFunC1 = fun CorecursiveFunC1(Other) ->
+ Other(CorecursiveFunC1)
+ end,
+ CorecursiveFunC = fun CorecursiveFunC(Other) ->
+ Other(CorecursiveFunC)
+ end,
+ ok = test_infinite_loop(fun() -> CorecursiveFunC(CorecursiveFunC1) end),
+ ok = test_infinite_loop(fun() -> CorecursiveFunC(CorecursiveFunC) end),
+ true = process_flag(trap_exit, OldTrapExit),
+ ok.
+
+-define(INFINITE_LOOP_TIMEOUT, 100).
+test_infinite_loop(Fun) ->
+ Tester = spawn_link(Fun),
+ kill_soon(Tester),
+ receive {'EXIT', Tester, awake} ->
+ undefined = process_info(Tester),
+ ok
+ after ?INFINITE_LOOP_TIMEOUT -> error(timeout)
+ end.
+
+infinite_recursion() -> infinite_recursion().
+
+infinite_corecursion() -> infinite_corecursion_1().
+infinite_corecursion_1() -> infinite_corecursion().
+
+kill_soon(Pid) ->
+ _ = spawn_link(fun() ->
+ timer:sleep(1),
+ erlang:exit(Pid, awake)
+ end),
+ ok.
diff --git a/lib/hipe/util/Makefile b/lib/hipe/util/Makefile
index 04de7f7823..eeb81ac482 100644
--- a/lib/hipe/util/Makefile
+++ b/lib/hipe/util/Makefile
@@ -48,7 +48,7 @@ HIPE_MODULES = hipe_vectors
else
HIPE_MODULES =
endif
-MODULES = hipe_timing hipe_dot hipe_digraph $(HIPE_MODULES)
+MODULES = hipe_timing hipe_dot hipe_digraph hipe_dsets $(HIPE_MODULES)
HRL_FILES=
ERL_FILES= $(MODULES:%=%.erl)
diff --git a/lib/hipe/util/hipe_dsets.erl b/lib/hipe/util/hipe_dsets.erl
new file mode 100644
index 0000000000..9492cab0ff
--- /dev/null
+++ b/lib/hipe/util/hipe_dsets.erl
@@ -0,0 +1,84 @@
+%% -*- erlang-indent-level: 2 -*-
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%@doc
+%% IMMUTABLE DISJOINT SETS OF ARBITRARY TERMS
+%%
+%% The disjoint set forests data structure, for elements of arbitrary types.
+%% Note that the find operation mutates the set.
+%%
+%% We could do this more efficiently if we restricted the elements to integers,
+%% and used the (mutable) hipe arrays. For arbitrary terms ETS could be used,
+%% for a persistent interface (which isn't that nice when even accessors return
+%% modified copies), the array module could be used.
+-module(hipe_dsets).
+
+-export([new/1, find/2, union/3, to_map/1, to_rllist/1]).
+-export_type([dsets/1]).
+
+-opaque dsets(X) :: #{X => {node, X} | {root, non_neg_integer()}}.
+
+-spec new([E]) -> dsets(E).
+new(Elems) -> maps:from_list([{E,{root,0}} || E <- Elems]).
+
+-spec find(E, dsets(E)) -> {E, dsets(E)}.
+find(E, DS0) ->
+ case DS0 of
+ #{E := {root,_}} -> {E, DS0};
+ #{E := {node,N}} ->
+ case find(N, DS0) of
+ {N, _}=T -> T;
+ {R, DS1} -> {R, DS1#{E := {node,R}}}
+ end;
+ _ -> error(badarg, [E, DS0])
+ end.
+
+-spec union(E, E, dsets(E)) -> dsets(E).
+union(X, Y, DS0) ->
+ {XRoot, DS1} = find(X, DS0),
+ case find(Y, DS1) of
+ {XRoot, DS2} -> DS2;
+ {YRoot, DS2} ->
+ #{XRoot := {root,XRR}, YRoot := {root,YRR}} = DS2,
+ if XRR < YRR -> DS2#{XRoot := {node,YRoot}};
+ XRR > YRR -> DS2#{YRoot := {node,XRoot}};
+ true -> DS2#{YRoot := {node,XRoot}, XRoot := {root,XRR+1}}
+ end
+ end.
+
+-spec to_map(dsets(E)) -> {#{Elem::E => Root::E}, dsets(E)}.
+to_map(DS) ->
+ to_map(maps:keys(DS), DS, #{}).
+
+to_map([], DS, Acc) -> {Acc, DS};
+to_map([K|Ks], DS0, Acc) ->
+ {KR, DS} = find(K, DS0),
+ to_map(Ks, DS, Acc#{K => KR}).
+
+-spec to_rllist(dsets(E)) -> {[{Root::E, Elems::[E]}], dsets(E)}.
+to_rllist(DS0) ->
+ {Lists, DS} = to_rllist(maps:keys(DS0), #{}, DS0),
+ {maps:to_list(Lists), DS}.
+
+to_rllist([], Acc, DS) -> {Acc, DS};
+to_rllist([E|Es], Acc, DS0) ->
+ {ERoot, DS} = find(E, DS0),
+ to_rllist(Es, map_append(ERoot, E, Acc), DS).
+
+map_append(Key, Elem, Map) ->
+ case Map of
+ #{Key := List} -> Map#{Key := [Elem|List]};
+ #{} -> Map#{Key => [Elem]}
+ end.
diff --git a/lib/hipe/x86/hipe_x86.erl b/lib/hipe/x86/hipe_x86.erl
index cc1c75b04d..f514dd1ded 100644
--- a/lib/hipe/x86/hipe_x86.erl
+++ b/lib/hipe/x86/hipe_x86.erl
@@ -167,6 +167,12 @@
mk_pseudo_spill/1,
+ mk_pseudo_spill_fmove/3,
+ is_pseudo_spill_fmove/1,
+
+ mk_pseudo_spill_move/3,
+ is_pseudo_spill_move/1,
+
mk_pseudo_tailcall/4,
%% is_pseudo_tailcall/1,
pseudo_tailcall_fun/1,
@@ -425,6 +431,14 @@ mk_pseudo_jcc_simple(Cc, TrueLabel, FalseLabel, Pred) ->
mk_pseudo_spill(List) ->
#pseudo_spill{args=List}.
+mk_pseudo_spill_fmove(Src, Temp, Dst) ->
+ #pseudo_spill_fmove{src=Src, temp=Temp, dst=Dst}.
+is_pseudo_spill_fmove(I) -> is_record(I, pseudo_spill_fmove).
+
+mk_pseudo_spill_move(Src, Temp, Dst) ->
+ #pseudo_spill_move{src=Src, temp=Temp, dst=Dst}.
+is_pseudo_spill_move(I) -> is_record(I, pseudo_spill_move).
+
mk_pseudo_tailcall(Fun, Arity, StkArgs, Linkage) ->
check_linkage(Linkage),
#pseudo_tailcall{'fun'=Fun, arity=Arity, stkargs=StkArgs, linkage=Linkage}.
diff --git a/lib/hipe/x86/hipe_x86.hrl b/lib/hipe/x86/hipe_x86.hrl
index 567848bae5..6cd69905b2 100644
--- a/lib/hipe/x86/hipe_x86.hrl
+++ b/lib/hipe/x86/hipe_x86.hrl
@@ -91,6 +91,8 @@
-record(pseudo_call, {'fun', sdesc, contlab, linkage}).
-record(pseudo_jcc, {cc, true_label, false_label, pred}).
-record(pseudo_spill, {args=[]}).
+-record(pseudo_spill_move, {src, temp, dst}).
+-record(pseudo_spill_fmove, {src, temp, dst}).
-record(pseudo_tailcall, {'fun', arity, stkargs, linkage}).
-record(pseudo_tailcall_prepare, {}).
-record(push, {src}).
diff --git a/lib/hipe/x86/hipe_x86_cfg.erl b/lib/hipe/x86/hipe_x86_cfg.erl
index a4544e1086..0a3c0fc9d6 100644
--- a/lib/hipe/x86/hipe_x86_cfg.erl
+++ b/lib/hipe/x86/hipe_x86_cfg.erl
@@ -19,7 +19,7 @@
succ/2, pred/2,
bb/2, bb_add/3, map_bbs/2, fold_bbs/3]).
-export([postorder/1, reverse_postorder/1]).
--export([linearise/1, params/1, arity/1, redirect_jmp/3]).
+-export([linearise/1, params/1, arity/1, redirect_jmp/3, branch_preds/1]).
%%% these tell cfg.inc what to define (ugly as hell)
-define(PRED_NEEDED,true).
@@ -72,6 +72,26 @@ branch_successors(Branch) ->
#ret{} -> []
end.
+branch_preds(Branch) ->
+ case Branch of
+ #jmp_switch{labels=Labels} ->
+ Prob = 1.0/length(Labels),
+ [{L, Prob} || L <- Labels];
+ #pseudo_call{contlab=ContLab, sdesc=#x86_sdesc{exnlab=[]}} ->
+ %% A function can still cause an exception, even if we won't catch it
+ [{ContLab, 1.0-hipe_bb_weights:call_exn_pred()}];
+ #pseudo_call{contlab=ContLab, sdesc=#x86_sdesc{exnlab=ExnLab}} ->
+ CallExnPred = hipe_bb_weights:call_exn_pred(),
+ [{ContLab, 1.0-CallExnPred}, {ExnLab, CallExnPred}];
+ #pseudo_jcc{true_label=TrueLab,false_label=FalseLab,pred=Pred} ->
+ [{FalseLab, 1.0-Pred}, {TrueLab, Pred}];
+ _ ->
+ case branch_successors(Branch) of
+ [] -> [];
+ [Single] -> [{Single, 1.0}]
+ end
+ end.
+
-ifdef(REMOVE_TRIVIAL_BBS_NEEDED).
fails_to(_Instr) -> [].
-endif.
diff --git a/lib/hipe/x86/hipe_x86_defuse.erl b/lib/hipe/x86/hipe_x86_defuse.erl
index 5d7fadf8e5..2731836dc1 100644
--- a/lib/hipe/x86/hipe_x86_defuse.erl
+++ b/lib/hipe/x86/hipe_x86_defuse.erl
@@ -51,6 +51,8 @@ insn_def(I) ->
#movzx{dst=Dst} -> dst_def(Dst);
#pseudo_call{} -> call_clobbered();
#pseudo_spill{} -> [];
+ #pseudo_spill_fmove{temp=Temp, dst=Dst} -> [Temp, Dst];
+ #pseudo_spill_move{temp=Temp, dst=Dst} -> [Temp, Dst];
#pseudo_tailcall_prepare{} -> tailcall_clobbered();
#shift{dst=Dst} -> dst_def(Dst);
%% call, cmp, comment, jcc, jmp_fun, jmp_label, jmp_switch, label
@@ -108,6 +110,8 @@ insn_use(I) ->
#pseudo_call{'fun'=Fun,sdesc=#x86_sdesc{arity=Arity}} ->
addtemp(Fun, arity_use(Arity));
#pseudo_spill{args=Args} -> Args;
+ #pseudo_spill_fmove{src=Src} -> [Src];
+ #pseudo_spill_move{src=Src} -> [Src];
#pseudo_tailcall{'fun'=Fun,arity=Arity,stkargs=StkArgs} ->
addtemp(Fun, addtemps(StkArgs, addtemps(tailcall_clobbered(),
arity_use(Arity))));
diff --git a/lib/hipe/x86/hipe_x86_frame.erl b/lib/hipe/x86/hipe_x86_frame.erl
index 3c2b67967a..558321d0c3 100644
--- a/lib/hipe/x86/hipe_x86_frame.erl
+++ b/lib/hipe/x86/hipe_x86_frame.erl
@@ -95,13 +95,17 @@ do_insn(I, LiveOut, Context, FPoff) ->
#imul{} ->
{[do_imul(I, Context, FPoff)], FPoff};
#move{} ->
- {[do_move(I, Context, FPoff)], FPoff};
+ {do_move(I, Context, FPoff), FPoff};
#movsx{} ->
{[do_movsx(I, Context, FPoff)], FPoff};
#movzx{} ->
{[do_movzx(I, Context, FPoff)], FPoff};
#pseudo_call{} ->
do_pseudo_call(I, LiveOut, Context, FPoff);
+ #pseudo_spill_fmove{} ->
+ {do_pseudo_spill_fmove(I, Context, FPoff), FPoff};
+ #pseudo_spill_move{} ->
+ {do_pseudo_spill_move(I, Context, FPoff), FPoff};
#pseudo_tailcall{} ->
{do_pseudo_tailcall(I, Context), context_framesize(Context)};
#push{} ->
@@ -144,22 +148,50 @@ do_fp_binop(I, Context, FPoff) ->
Dst = conv_opnd(Dst0, FPoff, Context),
[I#fp_binop{src=Src,dst=Dst}].
-do_fmove(I, Context, FPoff) ->
- #fmove{src=Src0,dst=Dst0} = I,
+do_fmove(I0, Context, FPoff) ->
+ #fmove{src=Src0,dst=Dst0} = I0,
Src = conv_opnd(Src0, FPoff, Context),
Dst = conv_opnd(Dst0, FPoff, Context),
- I#fmove{src=Src,dst=Dst}.
+ I = I0#fmove{src=Src,dst=Dst},
+ case Src =:= Dst of
+ true -> []; % omit move-to-self
+ false -> [I]
+ end.
+
+do_pseudo_spill_fmove(I0, Context, FPoff) ->
+ #pseudo_spill_fmove{src=Src0,temp=Temp0,dst=Dst0} = I0,
+ Src = conv_opnd(Src0, FPoff, Context),
+ Temp = conv_opnd(Temp0, FPoff, Context),
+ Dst = conv_opnd(Dst0, FPoff, Context),
+ case Src =:= Dst of
+ true -> []; % omit move-to-self
+ false -> [#fmove{src=Src, dst=Temp}, #fmove{src=Temp, dst=Dst}]
+ end.
do_imul(I, Context, FPoff) ->
#imul{src=Src0} = I,
Src = conv_opnd(Src0, FPoff, Context),
I#imul{src=Src}.
-do_move(I, Context, FPoff) ->
- #move{src=Src0,dst=Dst0} = I,
+do_move(I0, Context, FPoff) ->
+ #move{src=Src0,dst=Dst0} = I0,
Src = conv_opnd(Src0, FPoff, Context),
Dst = conv_opnd(Dst0, FPoff, Context),
- I#move{src=Src,dst=Dst}.
+ I = I0#move{src=Src,dst=Dst},
+ case Src =:= Dst of
+ true -> []; % omit move-to-self
+ false -> [I]
+ end.
+
+do_pseudo_spill_move(I0, Context, FPoff) ->
+ #pseudo_spill_move{src=Src0,temp=Temp0,dst=Dst0} = I0,
+ Src = conv_opnd(Src0, FPoff, Context),
+ Temp = conv_opnd(Temp0, FPoff, Context),
+ Dst = conv_opnd(Dst0, FPoff, Context),
+ case Src =:= Dst of
+ true -> []; % omit move-to-self
+ false -> [#move{src=Src, dst=Temp}, #move{src=Temp, dst=Dst}]
+ end.
do_movsx(I, Context, FPoff) ->
#movsx{src=Src0,dst=Dst0} = I,
diff --git a/lib/hipe/x86/hipe_x86_ra_finalise.erl b/lib/hipe/x86/hipe_x86_ra_finalise.erl
index 4273e3cee8..e8abe78e00 100644
--- a/lib/hipe/x86/hipe_x86_ra_finalise.erl
+++ b/lib/hipe/x86/hipe_x86_ra_finalise.erl
@@ -140,6 +140,16 @@ ra_insn(I, Map, FpMap) ->
I#pseudo_call{'fun'=Fun};
#pseudo_jcc{} ->
I;
+ #pseudo_spill_fmove{src=Src0, temp=Temp0, dst=Dst0} ->
+ Src = ra_opnd(Src0, Map, FpMap),
+ Temp = ra_opnd(Temp0, Map, FpMap),
+ Dst = ra_opnd(Dst0, Map, FpMap),
+ I#pseudo_spill_fmove{src=Src, temp=Temp, dst=Dst};
+ #pseudo_spill_move{src=Src0, temp=Temp0, dst=Dst0} ->
+ Src = ra_opnd(Src0, Map),
+ Temp = ra_opnd(Temp0, Map),
+ Dst = ra_opnd(Dst0, Map),
+ I#pseudo_spill_move{src=Src, temp=Temp, dst=Dst};
#pseudo_tailcall{'fun'=Fun0,stkargs=StkArgs0} ->
Fun = ra_opnd(Fun0, Map),
StkArgs = ra_args(StkArgs0, Map),
diff --git a/lib/hipe/x86/hipe_x86_ra_postconditions.erl b/lib/hipe/x86/hipe_x86_ra_postconditions.erl
index 28ec9c4277..db6391d5c1 100644
--- a/lib/hipe/x86/hipe_x86_ra_postconditions.erl
+++ b/lib/hipe/x86/hipe_x86_ra_postconditions.erl
@@ -74,6 +74,8 @@ do_insn(I, TempMap, Strategy) -> % Insn -> {Insn list, DidSpill}
do_movx(I, TempMap, Strategy);
#fmove{} ->
do_fmove(I, TempMap, Strategy);
+ #pseudo_spill_move{} ->
+ do_pseudo_spill_move(I, TempMap, Strategy);
#shift{} ->
do_shift(I, TempMap, Strategy);
#test{} ->
@@ -190,10 +192,19 @@ do_lea(I, TempMap, Strategy) ->
do_move(I, TempMap, Strategy) ->
#move{src=Src0,dst=Dst0} = I,
- {FixSrc, Src, FixDst, Dst, DidSpill} =
- do_check_byte_move(Src0, Dst0, TempMap, Strategy),
- {FixSrc ++ FixDst ++ [I#move{src=Src,dst=Dst}],
- DidSpill}.
+ case
+ is_record(Src0, x86_temp) andalso is_record(Dst0, x86_temp)
+ andalso is_spilled(Src0, TempMap) andalso is_spilled(Dst0, TempMap)
+ of
+ true ->
+ Tmp = clone(Src0, Strategy),
+ {[hipe_x86:mk_pseudo_spill_move(Src0, Tmp, Dst0)], true};
+ false ->
+ {FixSrc, Src, FixDst, Dst, DidSpill} =
+ do_check_byte_move(Src0, Dst0, TempMap, Strategy),
+ {FixSrc ++ FixDst ++ [I#move{src=Src,dst=Dst}],
+ DidSpill}
+ end.
-ifdef(HIPE_AMD64).
@@ -287,6 +298,13 @@ do_fmove(I, TempMap, Strategy) ->
{FixSrc ++ FixDst ++ [I#fmove{src=Src,dst=Dst}],
DidSpill1 or DidSpill2}.
+%%% Fix an pseudo_spill_move op.
+
+do_pseudo_spill_move(I = #pseudo_spill_move{temp=Temp}, TempMap, _Strategy) ->
+ %% Temp is above the low water mark and must not have been spilled
+ false = is_spilled(Temp, TempMap),
+ {[I], false}. % nothing to do
+
%%% Fix a shift operation.
%%% 1. remove pseudos from any explicit memory operands
%%% 2. if the source is a register or memory position
diff --git a/lib/hipe/x86/hipe_x86_subst.erl b/lib/hipe/x86/hipe_x86_subst.erl
index 7b5fb1352b..7db3b23d92 100644
--- a/lib/hipe/x86/hipe_x86_subst.erl
+++ b/lib/hipe/x86/hipe_x86_subst.erl
@@ -19,7 +19,7 @@
-endif.
-module(?HIPE_X86_SUBST).
--export([insn_temps/2]).
+-export([insn_temps/2, insn_lbls/2]).
-include("../x86/hipe_x86.hrl").
%% These should be moved to hipe_x86 and exported
@@ -28,6 +28,7 @@
-type mfarec() :: #x86_mfa{}.
-type prim() :: #x86_prim{}.
-type funv() :: mfarec() | prim() | temp().
+-type label() :: non_neg_integer().
-type insn() :: tuple(). % for now
-type subst_fun() :: fun((temp()) -> temp()).
@@ -49,14 +50,19 @@ insn_temps(SubstTemp, I) ->
#movzx {src=S, dst=D} -> I#movzx {src=O(S), dst=O(D)};
#shift {src=S, dst=D} -> I#shift {src=O(S), dst=O(D)};
#test {src=S, dst=D} -> I#test {src=O(S), dst=O(D)};
- #fp_unop{arg=A} -> I#fp_unop{arg=O(A)};
- #move64 {dst=D} -> I#move64 {dst=O(D)};
- #push {src=S} -> I#push {src=O(S)};
- #pop {dst=D} -> I#pop {dst=O(D)};
+ #fp_unop{arg=[]} -> I;
+ #fp_unop{arg=A} -> I#fp_unop{arg=O(A)};
+ #move64 {dst=D} -> I#move64 {dst=O(D)};
+ #push {src=S} -> I#push {src=O(S)};
+ #pop {dst=D} -> I#pop {dst=O(D)};
#jmp_switch{temp=T, jtab=J} ->
I#jmp_switch{temp=O(T), jtab=jtab_temps(SubstTemp, J)};
#pseudo_call{'fun'=F} ->
I#pseudo_call{'fun'=funv_temps(SubstTemp, F)};
+ #pseudo_spill_fmove{src=S, temp=T, dst=D} ->
+ I#pseudo_spill_fmove{src=O(S), temp=O(T), dst=O(D)};
+ #pseudo_spill_move{src=S, temp=T, dst=D} ->
+ I#pseudo_spill_move{src=O(S), temp=O(T), dst=O(D)};
#pseudo_tailcall{'fun'=F, stkargs=Stk} ->
I#pseudo_tailcall{'fun'=funv_temps(SubstTemp, F),
stkargs=lists:map(O, Stk)};
@@ -85,3 +91,22 @@ jtab_temps(SubstTemp, T=#x86_temp{}) -> SubstTemp(T).
-else.
jtab_temps(_SubstTemp, DataLbl) when is_integer(DataLbl) -> DataLbl.
-endif.
+
+-type lbl_subst_fun() :: fun((label()) -> label()).
+
+%% @doc Maps over the branch targets in an instruction
+-spec insn_lbls(lbl_subst_fun(), insn()) -> insn().
+insn_lbls(SubstLbl, I) ->
+ case I of
+ #jmp_label{label=Label} ->
+ I#jmp_label{label=SubstLbl(Label)};
+ #pseudo_call{sdesc=Sdesc, contlab=Contlab} ->
+ I#pseudo_call{sdesc=sdesc_lbls(SubstLbl, Sdesc),
+ contlab=SubstLbl(Contlab)};
+ #pseudo_jcc{true_label=T, false_label=F} ->
+ I#pseudo_jcc{true_label=SubstLbl(T), false_label=SubstLbl(F)}
+ end.
+
+sdesc_lbls(_SubstLbl, Sdesc=#x86_sdesc{exnlab=[]}) -> Sdesc;
+sdesc_lbls(SubstLbl, Sdesc=#x86_sdesc{exnlab=Exnlab}) ->
+ Sdesc#x86_sdesc{exnlab=SubstLbl(Exnlab)}.
diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml
index 4c4a5c39cb..d557efb6a8 100644
--- a/lib/kernel/doc/src/inet.xml
+++ b/lib/kernel/doc/src/inet.xml
@@ -659,7 +659,8 @@ get_tcpi_sacked(Sock) ->
<tag><c>{buffer, Size}</c></tag>
<item>
<p>The size of the user-level software buffer used by
- the driver. Not to be confused with options <c>sndbuf</c>
+ the driver.
+ Not to be confused with options <c>sndbuf</c>
and <c>recbuf</c>, which correspond to the
Kernel socket buffers. It is recommended
to have <c>val(buffer) &gt;= max(val(sndbuf),val(recbuf))</c> to
@@ -670,6 +671,9 @@ get_tcpi_sacked(Sock) ->
usually become larger, you are encouraged to use
<seealso marker="#getopts/2"><c>getopts/2</c></seealso>
to analyze the behavior of your operating system.</p>
+ <p>Note that this is also the maximum amount of data that can be
+ received from a single recv call. If you are using higher than
+ normal MTU consider setting buffer higher.</p>
</item>
<tag><c>{delay_send, Boolean}</c></tag>
<item>
diff --git a/lib/observer/src/cdv_ets_cb.erl b/lib/observer/src/cdv_ets_cb.erl
index ddd2d42df6..18f0c86fd3 100644
--- a/lib/observer/src/cdv_ets_cb.erl
+++ b/lib/observer/src/cdv_ets_cb.erl
@@ -30,26 +30,23 @@
-include("crashdump_viewer.hrl").
%% Defines
--define(COL_ID, 0).
--define(COL_NAME, ?COL_ID+1).
--define(COL_SLOT, ?COL_NAME+1).
--define(COL_OWNER, ?COL_SLOT+1).
+-define(COL_NAME, 0).
+-define(COL_IS_NAMED, ?COL_NAME+1).
+-define(COL_OWNER, ?COL_IS_NAMED+1).
-define(COL_OBJ, ?COL_OWNER+1).
-define(COL_MEM, ?COL_OBJ+1).
%% Callbacks for cdv_virtual_list_wx
-col_to_elem(id) -> col_to_elem(?COL_ID);
-col_to_elem(?COL_ID) -> #ets_table.id;
+col_to_elem(id) -> col_to_elem(?COL_NAME);
+col_to_elem(?COL_IS_NAMED) -> #ets_table.is_named;
col_to_elem(?COL_NAME) -> #ets_table.name;
-col_to_elem(?COL_SLOT) -> #ets_table.slot;
col_to_elem(?COL_OWNER) -> #ets_table.pid;
col_to_elem(?COL_OBJ) -> #ets_table.size;
col_to_elem(?COL_MEM) -> #ets_table.memory.
col_spec() ->
- [{"Id", ?wxLIST_FORMAT_LEFT, 200},
- {"Name", ?wxLIST_FORMAT_LEFT, 200},
- {"Slot", ?wxLIST_FORMAT_RIGHT, 50},
+ [{"Name", ?wxLIST_FORMAT_LEFT, 200},
+ {"Is Named", ?wxLIST_FORMAT_CENTRE, 70},
{"Owner", ?wxLIST_FORMAT_CENTRE, 120},
{"Objects", ?wxLIST_FORMAT_RIGHT, 80},
{"Memory", ?wxLIST_FORMAT_RIGHT, 80}
@@ -68,7 +65,7 @@ get_details(Id, Data) ->
{ok,{"Table:" ++ Id,Proplist,""}}.
get_detail_cols(all) ->
- {[{ets, ?COL_ID}, {process, ?COL_OWNER}],true};
+ {[{ets, ?COL_NAME}, {process, ?COL_OWNER}],true};
get_detail_cols(_W) ->
{[],true}.
diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl
index 13e73f027d..e21f1c501b 100644
--- a/lib/observer/src/crashdump_viewer.erl
+++ b/lib/observer/src/crashdump_viewer.erl
@@ -1555,10 +1555,14 @@ split_pid_list_no_space([],[],Pids) ->
%% Page with external ets tables
get_ets_tables(File,Pid,WS) ->
ParseFun = fun(Fd,Id) ->
- get_etsinfo(Fd,#ets_table{pid=list_to_pid(Id)},WS)
+ ET = get_etsinfo(Fd,#ets_table{pid=list_to_pid(Id)},WS),
+ ET#ets_table{is_named=tab_is_named(ET)}
end,
lookup_and_parse_index(File,{?ets,Pid},ParseFun,"ets").
+tab_is_named(#ets_table{id=Name,name=Name}) -> "yes";
+tab_is_named(#ets_table{}) -> "no".
+
get_etsinfo(Fd,EtsTable = #ets_table{details=Ds},WS) ->
case line_head(Fd) of
"Slot" ->
diff --git a/lib/observer/src/crashdump_viewer.hrl b/lib/observer/src/crashdump_viewer.hrl
index a08659efd6..742e145641 100644
--- a/lib/observer/src/crashdump_viewer.hrl
+++ b/lib/observer/src/crashdump_viewer.hrl
@@ -118,6 +118,7 @@
slot,
id,
name,
+ is_named,
data_type="hash",
buckets="-",
size,
diff --git a/lib/observer/src/observer_tv_wx.erl b/lib/observer/src/observer_tv_wx.erl
index 4356cb890c..d04fb839c8 100644
--- a/lib/observer/src/observer_tv_wx.erl
+++ b/lib/observer/src/observer_tv_wx.erl
@@ -78,11 +78,11 @@ init([Notebook, Parent]) ->
Col + 1
end,
ListItems = [{"Table Name", ?wxLIST_FORMAT_LEFT, 200},
- {"Table Id", ?wxLIST_FORMAT_RIGHT, 100},
{"Objects", ?wxLIST_FORMAT_RIGHT, 100},
{"Size (kB)", ?wxLIST_FORMAT_RIGHT, 100},
{"Owner Pid", ?wxLIST_FORMAT_CENTER, 150},
- {"Owner Name", ?wxLIST_FORMAT_LEFT, 200}
+ {"Owner Name", ?wxLIST_FORMAT_LEFT, 200},
+ {"Table Id", ?wxLIST_FORMAT_LEFT, 250}
],
lists:foldl(AddListEntry, 0, ListItems),
wxListItem:destroy(Li),
@@ -387,8 +387,8 @@ update_grid2(Grid, #opt{sort_key=Sort,sort_incr=Dir}, Tables) ->
({Col, Val}) ->
wxListCtrl:setItem(Grid, Row, Col, observer_lib:to_str(Val))
end,
- [{0,Name}, {1,Id}, {2,Size}, {3, Memory div 1024},
- {4,Owner}, {5,RegName}]),
+ [{0,Name}, {1,Size}, {2, Memory div 1024},
+ {3,Owner}, {4,RegName}, {5,Id}]),
Row + 1
end,
ProcInfo = case Dir of
diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index 1f07e826ce..968983c862 100644
--- a/lib/ssh/doc/src/ssh.xml
+++ b/lib/ssh/doc/src/ssh.xml
@@ -243,21 +243,6 @@
<p><c>Peer</c> is in the format of <c>{Host,Port}</c>.</p>
</item>
- <tag><c><![CDATA[{public_key_alg, 'ssh-rsa' | 'ssh-dss'}]]></c></tag>
- <item>
- <note>
- <p>This option will be removed in OTP 20, but is kept for compatibility. It is ignored if
- the preferred <c>pref_public_key_algs</c> option is used.</p>
- </note>
- <p>Sets the preferred public key algorithm to use for user
- authentication. If the preferred algorithm fails,
- the other algorithm is tried. If <c>{public_key_alg, 'ssh-rsa'}</c> is set, it is translated
- to <c>{pref_public_key_algs, ['ssh-rsa','ssh-dss']}</c>. If it is
- <c>{public_key_alg, 'ssh-dss'}</c>, it is translated
- to <c>{pref_public_key_algs, ['ssh-dss','ssh-rsa']}</c>.
- </p>
- </item>
-
<tag><c><![CDATA[{pref_public_key_algs, list()}]]></c></tag>
<item>
<p>List of user (client) public key algorithms to try to use.</p>
diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl
index 395be6b220..a882a01eaf 100644
--- a/lib/ssh/src/ssh_options.erl
+++ b/lib/ssh/src/ssh_options.erl
@@ -200,17 +200,6 @@ save({K,V}, _, _) when K == reuseaddr ;
save({allow_user_interaction,V}, Opts, Vals) ->
save({user_interaction,V}, Opts, Vals);
-save({public_key_alg,V}, Defs, Vals) -> % To remove in OTP-20
- New = case V of
- 'ssh-rsa' -> ['ssh-rsa', 'ssh-dss'];
- ssh_rsa -> ['ssh-rsa', 'ssh-dss'];
- 'ssh-dss' -> ['ssh-dss', 'ssh-rsa'];
- ssh_dsa -> ['ssh-dss', 'ssh-rsa'];
- _ -> error({eoptions, {public_key_alg,V},
- "Unknown algorithm, try pref_public_key_algs instead"})
- end,
- save({pref_public_key_algs,New}, Defs, Vals);
-
%% Special case for socket options 'inet' and 'inet6'
save(Inet, Defs, OptMap) when Inet==inet ; Inet==inet6 ->
save({inet,Inet}, Defs, OptMap);
diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile
index 3fca78237c..fab79a7a43 100644
--- a/lib/ssh/test/Makefile
+++ b/lib/ssh/test/Makefile
@@ -36,7 +36,7 @@ MODULES= \
ssh_options_SUITE \
ssh_renegotiate_SUITE \
ssh_basic_SUITE \
- ssh_benchmark_SUITE \
+ ssh_bench_SUITE \
ssh_connection_SUITE \
ssh_protocol_SUITE \
ssh_sftp_SUITE \
@@ -50,6 +50,7 @@ MODULES= \
ssh_key_cb_options \
ssh_trpt_test_lib \
ssh_echo_server \
+ ssh_bench_dev_null \
ssh_peername_sockname_server \
ssh_test_cli \
ssh_relay \
diff --git a/lib/ssh/test/ssh.spec b/lib/ssh/test/ssh.spec
index 0076fc275e..68268cb20d 100644
--- a/lib/ssh/test/ssh.spec
+++ b/lib/ssh/test/ssh.spec
@@ -1,6 +1,7 @@
{suites,"../ssh_test",all}.
-{skip_suites, "../ssh_test", [ssh_benchmark_SUITE],
+{skip_suites, "../ssh_test", [ssh_bench_SUITE
+ ],
"Benchmarks run separately"}.
diff --git a/lib/ssh/test/ssh_bench.spec b/lib/ssh/test/ssh_bench.spec
index 029f0bd074..b0b64713cf 100644
--- a/lib/ssh/test/ssh_bench.spec
+++ b/lib/ssh/test/ssh_bench.spec
@@ -1 +1,2 @@
-{suites,"../ssh_test",[ssh_benchmark_SUITE]}.
+{suites,"../ssh_test",[ssh_bench_SUITE
+ ]}.
diff --git a/lib/ssh/test/ssh_bench_SUITE.erl b/lib/ssh/test/ssh_bench_SUITE.erl
new file mode 100644
index 0000000000..ac52bb7e28
--- /dev/null
+++ b/lib/ssh/test/ssh_bench_SUITE.erl
@@ -0,0 +1,252 @@
+%%%-------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2015-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ssh_bench_SUITE).
+-compile(export_all).
+
+-include_lib("common_test/include/ct_event.hrl").
+-include_lib("common_test/include/ct.hrl").
+
+-include_lib("ssh/src/ssh.hrl").
+-include_lib("ssh/src/ssh_transport.hrl").
+-include_lib("ssh/src/ssh_connect.hrl").
+-include_lib("ssh/src/ssh_userauth.hrl").
+
+%%%================================================================
+%%%
+%%% Suite declarations
+%%%
+
+suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]},
+ {timetrap,{minutes,1}}
+ ].
+all() -> [connect,
+ transfer_text
+ ].
+
+-define(UID, "foo").
+-define(PWD, "bar").
+-define(Nruns, 8).
+
+%%%================================================================
+%%%
+%%% Init per suite
+%%%
+
+init_per_suite(Config) ->
+ catch ssh:stop(),
+ try
+ ok = ssh:start()
+ of
+ ok ->
+ DataSize = 1000000,
+ SystemDir = proplists:get_value(data_dir, Config),
+ Algs = insert_none(ssh:default_algorithms()),
+ {_ServerPid, _Host, Port} =
+ ssh_test_lib:daemon([{system_dir, SystemDir},
+ {user_passwords, [{?UID,?PWD}]},
+ {failfun, fun ssh_test_lib:failfun/2},
+ {preferred_algorithms, Algs},
+ {max_random_length_padding, 0},
+ {subsystems, [{"/dev/null", {ssh_bench_dev_null,[DataSize]}}]}
+ ]),
+ [{host,"localhost"}, {port,Port}, {uid,?UID}, {pwd,?PWD}, {data_size,DataSize} | Config]
+ catch
+ C:E ->
+ {skip, io_lib:format("Couldn't start ~p:~p",[C,E])}
+ end.
+
+end_per_suite(_Config) ->
+ catch ssh:stop(),
+ ok.
+
+%%%================================================================
+%%%
+%%% Init per testcase
+%%%
+
+init_per_testcase(_Func, Conf) ->
+ Conf.
+
+end_per_testcase(_Func, _Conf) ->
+ ok.
+
+%%%================================================================
+%%%
+%%% Testcases
+%%%
+
+%%%----------------------------------------------------------------
+%%% Measure the time for an Erlang client to connect to an Erlang
+%%% server on the localhost
+
+connect(Config) ->
+ KexAlgs = proplists:get_value(kex, ssh:default_algorithms()),
+ ct:pal("KexAlgs = ~p",[KexAlgs]),
+ lists:foreach(
+ fun(KexAlg) ->
+ PrefAlgs = preferred_algorithms(KexAlg),
+ report([{value, measure_connect(Config,
+ [{preferred_algorithms,PrefAlgs}])},
+ {suite, ?MODULE},
+ {name, mk_name(["Connect erlc erld ",KexAlg," [µs]"])}
+ ])
+ end, KexAlgs).
+
+
+measure_connect(Config, Opts) ->
+ Port = proplists:get_value(port, Config),
+ ConnectOptions = [{user, proplists:get_value(uid, Config)},
+ {password, proplists:get_value(pwd, Config)},
+ {user_dir, proplists:get_value(priv_dir, Config)},
+ {silently_accept_hosts, true},
+ {user_interaction, false},
+ {max_random_length_padding, 0}
+ ] ++ Opts,
+ median(
+ [begin
+ {Time, {ok,Pid}} = timer:tc(ssh,connect,["localhost", Port, ConnectOptions]),
+ ssh:close(Pid),
+ Time
+ end || _ <- lists:seq(1,?Nruns)]).
+
+%%%----------------------------------------------------------------
+%%% Measure the time to transfer a set of data with
+%%% and without crypto
+
+transfer_text(Config) ->
+ Port = proplists:get_value(port, Config),
+ Options = [{user, proplists:get_value(uid, Config)},
+ {password, proplists:get_value(pwd, Config)},
+ {user_dir, proplists:get_value(priv_dir, Config)},
+ {silently_accept_hosts, true},
+ {user_interaction, false},
+ {max_random_length_padding, 0}
+ ],
+ Data = gen_data(proplists:get_value(data_size,Config)),
+
+ [connect_measure(Port, Crypto, Mac, Data, Options)
+ || {Crypto,Mac} <- [{ none, none},
+ {'aes128-ctr', 'hmac-sha1'},
+ {'aes256-ctr', 'hmac-sha1'},
+%% {'[email protected]', 'hmac-sha1'},
+ {'aes128-cbc', 'hmac-sha1'},
+ {'3des-cbc', 'hmac-sha1'},
+ {'aes128-ctr', 'hmac-sha2-256'},
+ {'aes128-ctr', 'hmac-sha2-512'}
+ ],
+ crypto_mac_supported(Crypto,Mac)].
+
+
+crypto_mac_supported(none, none) ->
+ true;
+crypto_mac_supported(C, M) ->
+ Algs = ssh:default_algorithms(),
+ [{_,Cs},_] = proplists:get_value(cipher, Algs),
+ [{_,Ms},_] = proplists:get_value(mac, Algs),
+ lists:member(C,Cs) andalso lists:member(M,Ms).
+
+
+gen_data(DataSz) ->
+ Data0 = << <<C>> || _ <- lists:seq(1,DataSz div 256),
+ C <- lists:seq(0,255) >>,
+ Data1 = << <<C>> || C <- lists:seq(0,(DataSz rem 256) - 1) >>,
+ <<Data0/binary, Data1/binary>>.
+
+
+%% connect_measure(Port, Cipher, Mac, Data, Options) ->
+%% report([{value, 1},
+%% {suite, ?MODULE},
+%% {name, mk_name(["Transfer 1M bytes ",Cipher,"/",Mac," [µs]"])}]);
+connect_measure(Port, Cipher, Mac, Data, Options) ->
+ Times =
+ [begin
+ {ok,C} = ssh:connect("localhost", Port, [{preferred_algorithms, [{cipher,[Cipher]},
+ {mac,[Mac]}]}
+ |Options]),
+ {ok,Ch} = ssh_connection:session_channel(C, 10000),
+ success = ssh_connection:subsystem(C, Ch, "/dev/null", 10000),
+ {Time,ok} = timer:tc(?MODULE, send_wait_acc, [C, Ch, Data]),
+ ok = ssh_connection:send_eof(C, Ch),
+ ssh:close(C),
+ Time
+ end || _ <- lists:seq(1,?Nruns)],
+
+ report([{value, median(Times)},
+ {suite, ?MODULE},
+ {name, mk_name(["Transfer 1M bytes ",Cipher,"/",Mac," [µs]"])}]).
+
+send_wait_acc(C, Ch, Data) ->
+ ssh_connection:send(C, Ch, Data),
+ receive
+ {ssh_cm, C, {data, Ch, 0, <<"READY">>}} -> ok
+ end.
+
+
+%%%================================================================
+%%%
+%%% Private
+%%%
+
+%%%----------------------------------------------------------------
+insert_none(L) ->
+ lists:foldl(fun insert_none/2, [], L).
+
+insert_none({T,L}, Acc) when T==cipher ;
+ T==mac ->
+ [{T, [{T1,L1++[none]} || {T1,L1} <- L]} | Acc];
+insert_none(_, Acc) ->
+ Acc.
+
+%%%----------------------------------------------------------------
+mk_name(Name) -> [char(C) || C <- lists:concat(Name)].
+
+char($-) -> $_;
+char(C) -> C.
+
+%%%----------------------------------------------------------------
+preferred_algorithms(KexAlg) ->
+ [{kex, [KexAlg]},
+ {public_key, ['ssh-rsa']},
+ {cipher, ['aes128-ctr']},
+ {mac, ['hmac-sha1']},
+ {compression, [none]}
+ ].
+
+%%%----------------------------------------------------------------
+median(Data) when is_list(Data) ->
+ SortedData = lists:sort(Data),
+ N = length(Data),
+ Median =
+ case N rem 2 of
+ 0 ->
+ MeanOfMiddle = (lists:nth(N div 2, SortedData) +
+ lists:nth(N div 2 + 1, SortedData)) / 2,
+ round(MeanOfMiddle);
+ 1 ->
+ lists:nth(N div 2 + 1, SortedData)
+ end,
+ ct:pal("median(~p) = ~p",[SortedData,Median]),
+ Median.
+
+
+report(Data) ->
+ ct:pal("EventData = ~p",[Data]),
+ ct_event:notify(#event{name = benchmark_data,
+ data = Data}).
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_dsa b/lib/ssh/test/ssh_bench_SUITE_data/id_dsa
index d306f8b26e..d306f8b26e 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/id_dsa
+++ b/lib/ssh/test/ssh_bench_SUITE_data/id_dsa
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256 b/lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa256
index 4b1eb12eaa..4b1eb12eaa 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256
+++ b/lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa256
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256.pub b/lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa256.pub
index a0147e60fa..a0147e60fa 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256.pub
+++ b/lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa256.pub
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384 b/lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa384
index 4e8aa40959..4e8aa40959 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384
+++ b/lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa384
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384.pub b/lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa384.pub
index 41e722e545..41e722e545 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384.pub
+++ b/lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa384.pub
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521 b/lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa521
index 7196f46e97..7196f46e97 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521
+++ b/lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa521
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521.pub b/lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa521.pub
index 8f059120bc..8f059120bc 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521.pub
+++ b/lib/ssh/test/ssh_bench_SUITE_data/id_ecdsa521.pub
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_rsa b/lib/ssh/test/ssh_bench_SUITE_data/id_rsa
index 9d7e0dd5fb..9d7e0dd5fb 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/id_rsa
+++ b/lib/ssh/test/ssh_bench_SUITE_data/id_rsa
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_dsa_key
index 51ab6fbd88..51ab6fbd88 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key
+++ b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_dsa_key
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_dsa_key.pub
index 4dbb1305b0..4dbb1305b0 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key.pub
+++ b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_dsa_key.pub
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256 b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key256
index 2979ea88ed..2979ea88ed 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256
+++ b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key256
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256.pub b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key256.pub
index 85dc419345..85dc419345 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256.pub
+++ b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key256.pub
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384 b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key384
index fb1a862ded..fb1a862ded 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384
+++ b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key384
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384.pub b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key384.pub
index 428d5fb7d7..428d5fb7d7 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384.pub
+++ b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key384.pub
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521 b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key521
index 3e51ec2ecd..3e51ec2ecd 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521
+++ b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key521
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521.pub b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key521.pub
index 017a29f4da..017a29f4da 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521.pub
+++ b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_ecdsa_key521.pub
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_rsa_key
index 79968bdd7d..79968bdd7d 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key
+++ b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_rsa_key
diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_rsa_key.pub
index 75d2025c71..75d2025c71 100644
--- a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key.pub
+++ b/lib/ssh/test/ssh_bench_SUITE_data/ssh_host_rsa_key.pub
diff --git a/lib/ssh/test/ssh_bench_dev_null.erl b/lib/ssh/test/ssh_bench_dev_null.erl
new file mode 100644
index 0000000000..0e390b7712
--- /dev/null
+++ b/lib/ssh/test/ssh_bench_dev_null.erl
@@ -0,0 +1,58 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+
+%%% Description: Example ssh server
+-module(ssh_bench_dev_null).
+-behaviour(ssh_daemon_channel).
+
+-record(state, {
+ cm,
+ chid,
+ n,
+ sum = 0
+ }).
+
+-export([init/1, handle_msg/2, handle_ssh_msg/2, terminate/2]).
+
+init([N]) -> {ok, #state{n=N}}.
+
+handle_msg({ssh_channel_up, ChId, CM}, S) ->
+ {ok, S#state{cm = CM,
+ chid = ChId}}.
+
+
+
+handle_ssh_msg({ssh_cm, CM, {data,ChId,0,Data}}, #state{n=N, sum=Sum0, cm=CM, chid=ChId} = S) ->
+ Sum = Sum0 + size(Data),
+ if Sum == N ->
+ %% Got all
+ ssh_connection:send(CM, ChId, <<"READY">>),
+ {ok, S#state{sum=Sum}};
+ Sum < N ->
+ %% Expects more
+ {ok, S#state{sum=Sum}}
+ end;
+handle_ssh_msg({ssh_cm, _, {exit_signal,ChId,_,_,_}}, S) -> {stop, ChId, S};
+handle_ssh_msg({ssh_cm, _, {exit_status,ChId,_} }, S) -> {stop, ChId, S};
+handle_ssh_msg({ssh_cm, _, _ }, S) -> {ok, S}.
+
+terminate(_, _) -> ok.
diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl
deleted file mode 100644
index fc90750455..0000000000
--- a/lib/ssh/test/ssh_benchmark_SUITE.erl
+++ /dev/null
@@ -1,571 +0,0 @@
-%%%-------------------------------------------------------------------
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2015-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(ssh_benchmark_SUITE).
--compile(export_all).
-
--include_lib("common_test/include/ct_event.hrl").
--include_lib("common_test/include/ct.hrl").
-
--include_lib("ssh/src/ssh.hrl").
--include_lib("ssh/src/ssh_transport.hrl").
--include_lib("ssh/src/ssh_connect.hrl").
--include_lib("ssh/src/ssh_userauth.hrl").
-
-
-suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]},
- {timetrap,{minutes,6}}
- ].
-%%suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() -> [{group, opensshc_erld}
-%% {group, erlc_opensshd}
- ].
-
-groups() ->
- [{opensshc_erld, [{repeat, 3}], [openssh_client_shell,
- openssh_client_sftp]}
- ].
-
-
-init_per_suite(Config) ->
- catch ssh:stop(),
- try
- report_client_algorithms(),
- ok = ssh:start(),
- {ok,TracerPid} = erlang_trace(),
- [{tracer_pid,TracerPid} | init_sftp_dirs(Config)]
- catch
- C:E ->
- {skip, io_lib:format("Couldn't start ~p:~p",[C,E])}
- end.
-
-end_per_suite(_Config) ->
- catch ssh:stop(),
- ok.
-
-
-
-init_per_group(opensshc_erld, Config) ->
- case ssh_test_lib:ssh_type() of
- openSSH ->
- DataDir = proplists:get_value(data_dir, Config),
- UserDir = proplists:get_value(priv_dir, Config),
- ssh_test_lib:setup_dsa(DataDir, UserDir),
- ssh_test_lib:setup_rsa(DataDir, UserDir),
- ssh_test_lib:setup_ecdsa("256", DataDir, UserDir),
- AlgsD = ssh:default_algorithms(),
- AlgsC = ssh_test_lib:default_algorithms(sshc),
- Common = ssh_test_lib:intersect_bi_dir(
- ssh_test_lib:intersection(AlgsD, AlgsC)),
- ct:pal("~p~n~nErld:~n~p~n~nOpenSSHc:~n~p~n~nCommon:~n~p",
- [inet:gethostname(), AlgsD, AlgsC, Common]),
- [{c_kexs, ssh_test_lib:sshc(kex)},
- {c_ciphers, ssh_test_lib:sshc(cipher)},
- {common_algs, Common}
- | Config];
- _ ->
- {skip, "No OpenSsh client found"}
- end;
-
-init_per_group(erlc_opensshd, _) ->
- {skip, "Group erlc_opensshd not implemented"};
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, _Config) ->
- ok.
-
-
-init_per_testcase(_Func, Conf) ->
- Conf.
-
-end_per_testcase(_Func, _Conf) ->
- ok.
-
-
-init_sftp_dirs(Config) ->
- UserDir = proplists:get_value(priv_dir, Config),
- SrcDir = filename:join(UserDir, "sftp_src"),
- ok = file:make_dir(SrcDir),
- SrcFile = "big_data",
- DstDir = filename:join(UserDir, "sftp_dst"),
- ok = file:make_dir(DstDir),
- N = 100 * 1024*1024,
- ok = file:write_file(filename:join(SrcDir,SrcFile), crypto:strong_rand_bytes(N)),
- [{sftp_src_dir,SrcDir}, {sftp_dst_dir,DstDir}, {src_file,SrcFile}, {sftp_size,N}
- | Config].
-
-%%%================================================================
-openssh_client_shell(Config) ->
- lists:foreach(
- fun(PrefAlgs=[{kex,[Kex]}]) when Kex == 'diffie-hellman-group-exchange-sha256' ->
- lists:foreach(
- fun(Grp) ->
- openssh_client_shell(Config,
- [{preferred_algorithms, PrefAlgs},
- {dh_gex_groups, [Grp]}
- ])
- end, moduli());
- (PrefAlgs) ->
- openssh_client_shell(Config,
- [{preferred_algorithms, PrefAlgs}])
- end, variants(kex,Config) ++ variants(cipher,Config)
- ).
-
-
-openssh_client_shell(Config, Options) ->
- SystemDir = proplists:get_value(data_dir, Config),
- UserDir = proplists:get_value(priv_dir, Config),
- KnownHosts = filename:join(UserDir, "known_hosts"),
-
- {ok, TracerPid} = erlang_trace(),
- {ServerPid, _Host, Port} =
- ssh_test_lib:daemon([{system_dir, SystemDir},
- {failfun, fun ssh_test_lib:failfun/2} |
- Options]),
- ct:sleep(500),
-
- Data = lists:duplicate(100000, $a),
- Cmd = lists:concat(["ssh -p ",Port,
- " -o UserKnownHostsFile=", KnownHosts,
- " -o \"StrictHostKeyChecking no\"",
- " localhost '\"",Data,"\"'."]),
-%% ct:pal("Cmd ="++Cmd),
-
- Parent = self(),
- SlavePid = spawn(fun() ->
- Parent ! {self(),os:cmd(Cmd)}
- end),
- receive
- {SlavePid, _ClientResponse} ->
-%% ct:pal("ClientResponse = ~p",[_ClientResponse]),
- {ok, List} = get_trace_list(TracerPid),
- Times = find_times(List, [accept_to_hello, kex, kex_to_auth, auth, to_prompt]),
- Algs = find_algs(List),
- ct:pal("Algorithms = ~p~n~nTimes = ~p",[Algs,Times]),
- lists:foreach(
- fun({Tag,Value,Unit}) ->
- EventData =
- case Tag of
- {A,B} when A==encrypt ; A==decrypt ->
- [{value, Value},
- {suite, ?MODULE},
- {name, mk_name(["Cipher ",A," ",B," [",Unit,"]"])}
- ];
- kex ->
- KexAlgStr = fmt_alg(Algs#alg.kex, List),
- [{value, Value},
- {suite, ?MODULE},
- {name, mk_name(["Erl server kex ",KexAlgStr," [",Unit,"]"])}
- ];
- _ when is_atom(Tag) ->
- [{value, Value},
- {suite, ?MODULE},
- {name, mk_name(["Erl server ",Tag," [",Unit,"]"])}
- ]
- end,
- ct:pal("ct_event:notify ~p",[EventData]),
- ct_event:notify(#event{name = benchmark_data,
- data = EventData})
- end, Times),
- ssh:stop_daemon(ServerPid),
- ok
- after 60*1000 ->
- ssh:stop_daemon(ServerPid),
- exit(SlavePid, kill),
- {fail, timeout}
- end.
-
-
-%%%================================================================
-openssh_client_sftp(Config) ->
- lists:foreach(
- fun(PrefAlgs) ->
- openssh_client_sftp(Config, [{preferred_algorithms,PrefAlgs}])
- end, variants(cipher,Config)).
-
-
-openssh_client_sftp(Config, Options) ->
- SystemDir = proplists:get_value(data_dir, Config),
- UserDir = proplists:get_value(priv_dir, Config),
- SftpSrcDir = proplists:get_value(sftp_src_dir, Config),
- SrcFile = proplists:get_value(src_file, Config),
- SrcSize = proplists:get_value(sftp_size, Config),
- KnownHosts = filename:join(UserDir, "known_hosts"),
-
- {ok, TracerPid} = erlang_trace(),
- {ServerPid, _Host, Port} =
- ssh_test_lib:daemon([{system_dir, SystemDir},
- {subsystems,[ssh_sftpd:subsystem_spec([%{cwd, SftpSrcDir},
- {root, SftpSrcDir}])]},
- {failfun, fun ssh_test_lib:failfun/2}
- | Options]),
- ct:pal("ServerPid = ~p",[ServerPid]),
- ct:sleep(500),
- Cmd = lists:concat(["sftp",
- " -b -",
- " -P ",Port,
- " -o UserKnownHostsFile=", KnownHosts,
- " -o \"StrictHostKeyChecking no\"",
- " localhost:",SrcFile
- ]),
-%% ct:pal("Cmd = ~p",[Cmd]),
-
- Parent = self(),
- SlavePid = spawn(fun() ->
- Parent ! {self(),os:cmd(Cmd)}
- end),
- receive
- {SlavePid, _ClientResponse} ->
- ct:pal("ClientResponse = ~p~nServerPid = ~p",[_ClientResponse,ServerPid]),
- {ok, List} = get_trace_list(TracerPid),
-%%ct:pal("List=~p",[List]),
- Times = find_times(List, [channel_open_close]),
- Algs = find_algs(List),
- ct:pal("Algorithms = ~p~n~nTimes = ~p",[Algs,Times]),
- lists:foreach(
- fun({{A,B},Value,Unit}) when A==encrypt ; A==decrypt ->
- Data = [{value, Value},
- {suite, ?MODULE},
- {name, mk_name(["Sftp Cipher ",A," ",B," [",Unit,"]"])}
- ],
- ct:pal("sftp ct_event:notify ~p",[Data]),
- ct_event:notify(#event{name = benchmark_data,
- data = Data});
- ({channel_open_close,Value,Unit}) ->
- Cipher = fmt_alg(Algs#alg.encrypt, List),
- Data = [{value, round( (1024*Value) / SrcSize )},
- {suite, ?MODULE},
- {name, mk_name(["Sftp transfer ",Cipher," [",Unit," per kbyte]"])}
- ],
- ct:pal("sftp ct_event:notify ~p",[Data]),
- ct_event:notify(#event{name = benchmark_data,
- data = Data});
- (_) ->
- skip
- end, Times),
- ssh:stop_daemon(ServerPid),
- ok
- after 2*60*1000 ->
- ssh:stop_daemon(ServerPid),
- exit(SlavePid, kill),
- {fail, timeout}
- end.
-
-%%%================================================================
-variants(Tag, Config) ->
- TagType =
- case proplists:get_value(Tag, ssh:default_algorithms()) of
- [{_,_}|_] -> one_way;
- [A|_] when is_atom(A) -> two_way
- end,
- [ [{Tag,tag_value(TagType,Alg)}]
- || Alg <- proplists:get_value(Tag, proplists:get_value(common_algs,Config))
- ].
-
-tag_value(two_way, Alg) -> [Alg];
-tag_value(one_way, Alg) -> [{client2server,[Alg]},
- {server2client,[Alg]}].
-
-%%%----------------------------------------------------------------
-fmt_alg(Alg, List) when is_atom(Alg) ->
- fmt_alg(atom_to_list(Alg), List);
-fmt_alg(Alg = "diffie-hellman-group-exchange-sha" ++ _, List) ->
- try
- integer_to_list(find_gex_size_string(List))
- of
- GexSize -> lists:concat([Alg," ",GexSize])
- catch
- _:_ -> Alg
- end;
-fmt_alg(Alg, _List) ->
- Alg.
-
-%%%----------------------------------------------------------------
-mk_name(Name) -> [char(C) || C <- lists:concat(Name)].
-
-char($-) -> $_;
-char(C) -> C.
-
-%%%----------------------------------------------------------------
-find_times(L, Xs) ->
- [find_time(X,L) || X <- Xs] ++
- function_algs_times_sizes([{ssh_transport,encrypt,2},
- {ssh_transport,decrypt,2},
- {ssh_message,decode,1},
- {ssh_message,encode,1}], L).
-
--record(call, {
- mfa,
- pid,
- t_call,
- t_return,
- args,
- result
- }).
-
-%%%----------------
--define(send(M), fun(C=#call{mfa = {ssh_message,encode,1},
- args = [M]}) ->
- C#call.t_return
- end).
-
--define(recv(M), fun(C=#call{mfa = {ssh_message,decode,1},
- result = M}) ->
- C#call.t_call
- end).
-
-find_time(accept_to_hello, L) ->
- [T0,T1] = find([fun(C=#call{mfa = {ssh_acceptor,handle_connection,5}}) ->
- C#call.t_call
- end,
- ?LINE,
- fun(C=#call{mfa = {ssh_connection_handler,handle_event,4},
- args = [_, {version_exchange,_}, {hello,_}, _]}) ->
- C#call.t_call
- end,
- ?LINE
- ], L, []),
- {accept_to_hello, now2micro_sec(now_diff(T1,T0)), microsec};
-find_time(kex, L) ->
- [T0,T1] = find([fun(C=#call{mfa = {ssh_connection_handler,handle_event,4},
- args = [_, {version_exchange,_}, {hello,_}, _]}) ->
- C#call.t_call
- end,
- ?LINE,
- ?send(#ssh_msg_newkeys{}),
- ?LINE
- ], L, []),
- {kex, now2micro_sec(now_diff(T1,T0)), microsec};
-find_time(kex_to_auth, L) ->
- [T0,T1] = find([?send(#ssh_msg_newkeys{}),
- ?LINE,
- ?recv(#ssh_msg_userauth_request{}),
- ?LINE
- ], L, []),
- {kex_to_auth, now2micro_sec(now_diff(T1,T0)), microsec};
-find_time(auth, L) ->
- [T0,T1] = find([?recv(#ssh_msg_userauth_request{}),
- ?LINE,
- ?send(#ssh_msg_userauth_success{}),
- ?LINE
- ], L, []),
- {auth, now2micro_sec(now_diff(T1,T0)), microsec};
-find_time(to_prompt, L) ->
- [T0,T1] = find([fun(C=#call{mfa = {ssh_acceptor,handle_connection,5}}) ->
- C#call.t_call
- end,
- ?LINE,
- ?recv(#ssh_msg_channel_request{request_type="env"}),
- ?LINE
- ], L, []),
- {to_prompt, now2micro_sec(now_diff(T1,T0)), microsec};
-find_time(channel_open_close, L) ->
- [T0,T1] = find([?recv(#ssh_msg_channel_request{request_type="subsystem"}),
- ?LINE,
- ?send(#ssh_msg_channel_close{}),
- ?LINE
- ], L, []),
- {channel_open_close, now2micro_sec(now_diff(T1,T0)), microsec}.
-
-
-
-find([F,Id|Fs], [C|Cs], Acc) when is_function(F,1) ->
- try
- F(C)
- of
- T -> find(Fs, Cs, [T|Acc])
- catch
- _:_ -> find([F,Id|Fs], Cs, Acc)
- end;
-find([], _, Acc) ->
- lists:reverse(Acc).
-
-
-find_algs(L) ->
- {value, #call{result={ok,Algs}}} =
- lists:keysearch({ssh_transport,select_algorithm,3}, #call.mfa, L),
- Algs.
-
-find_gex_size_string(L) ->
- %% server
- {value, #call{result={ok,{Size, _}}}} =
- lists:keysearch({public_key,dh_gex_group,4}, #call.mfa, L),
- Size.
-
-%%%----------------
-function_algs_times_sizes(EncDecs, L) ->
- Raw = [begin
- {Tag,Size} = function_ats_result(EncDec, C),
- {Tag, Size, now2micro_sec(now_diff(T1,T0))}
- end
- || EncDec <- EncDecs,
- C = #call{mfa = ED,
- % args = Args, %%[S,Data],
- t_call = T0,
- t_return = T1} <- L,
- ED == EncDec
- ],
- [{Alg, round(1024*Time/Size), "microsec per kbyte"} % Microseconds per 1k bytes.
- || {Alg,Size,Time} <- lists:foldl(fun increment/2, [], Raw)].
-
-function_ats_result({ssh_transport,encrypt,2}, #call{args=[S,Data]}) ->
- {{encrypt,S#ssh.encrypt}, binsize(Data)};
-function_ats_result({ssh_transport,decrypt,2}, #call{args=[S,Data]}) ->
- {{decrypt,S#ssh.decrypt}, binsize(Data)};
-function_ats_result({ssh_message,encode,1}, #call{result=Data}) ->
- {encode, size(Data)};
-function_ats_result({ssh_message,decode,1}, #call{args=[Data]}) ->
- {decode, size(Data)}.
-
-binsize(B) when is_binary(B) -> size(B);
-binsize({B1,B2}) when is_binary(B1), is_binary(B2) -> size(B1) + size(B2);
-binsize({B1,B2,_}) when is_binary(B1), is_binary(B2) -> size(B1) + size(B2).
-
-
-
-
-
-increment({Alg,Sz,T}, [{Alg,SumSz,SumT}|Acc]) ->
- [{Alg,SumSz+Sz,SumT+T} | Acc];
-increment(Spec, [X|Acc]) ->
- [X | increment(Spec,Acc)]; % Not so many Alg, 2 or 3
-increment({Alg,Sz,T},[]) ->
- [{Alg,Sz,T}].
-
-%%%----------------------------------------------------------------
-%%%
-%%% API for the traceing
-%%%
-get_trace_list(TracerPid) ->
- MonRef = monitor(process, TracerPid),
- TracerPid ! {get_trace_list,self()},
- receive
- {trace_list,L} ->
- demonitor(MonRef),
- {ok, pair_events(lists:reverse(L))};
- {'DOWN', MonRef, process, TracerPid, Info} ->
- {error, {tracer_down,Info}}
-
- after 3*60*1000 ->
- demonitor(MonRef),
- {error,no_reply}
- end.
-
-erlang_trace() ->
- TracerPid = spawn(fun trace_loop/0),
- 0 = erlang:trace(new, true, [call,timestamp,{tracer,TracerPid}]),
- [init_trace(MFA, tp(MFA))
- || MFA <- [{ssh_acceptor,handle_connection,5},
-%% {ssh_connection_handler,hello,2},
- {ssh_message,encode,1},
- {ssh_message,decode,1},
- {ssh_transport,select_algorithm,3},
- {ssh_transport,encrypt,2},
- {ssh_transport,decrypt,2},
- {ssh_message,encode,1},
- {ssh_message,decode,1},
- {public_key,dh_gex_group,4} % To find dh_gex group size
- ]],
- init_trace({ssh_connection_handler,handle_event,4},
- [{['_', {version_exchange,'_'}, {hello,'_'}, '_'],
- [],
- [return_trace]}]),
- {ok, TracerPid}.
-
-tp({_M,_F,Arity}) ->
- [{lists:duplicate(Arity,'_'), [], [{return_trace}]}].
-
-%%%----------------------------------------------------------------
-init_trace(MFA = {Module,_,_}, TP) ->
- case code:is_loaded(Module) of
- false -> code:load_file(Module);
- _ -> ok
- end,
- erlang:trace_pattern(MFA, TP, [local]).
-
-
-trace_loop() ->
- trace_loop([]).
-
-trace_loop(L) ->
- receive
- {get_trace_list, From} ->
- From ! {trace_list, L},
- trace_loop(L);
- Ev ->
- trace_loop([Ev|L])
- end.
-
-pair_events(L) ->
- pair_events(L, []).
-
-pair_events([{trace_ts,Pid,call,{M,F,Args},TS0} | L], Acc) ->
- Arity = length(Args),
- {ReturnValue,TS1} = find_return(Pid, {M,F,Arity}, L),
- pair_events(L, [#call{mfa = {M,F,Arity},
- pid = Pid,
- t_call = TS0,
- t_return = TS1,
- args = Args,
- result = ReturnValue} | Acc]);
-pair_events([_|L], Acc) ->
- pair_events(L, Acc);
-pair_events([], Acc) ->
- lists:reverse(Acc).
-
-
-find_return(Pid, MFA,
- [{trace_ts, Pid, return_from, MFA, ReturnValue, TS}|_]) ->
- {ReturnValue, TS};
-find_return(Pid, MFA, [_|L]) ->
- find_return(Pid, MFA, L);
-find_return(_, _, []) ->
- {undefined, undefined}.
-
-%%%----------------------------------------------------------------
-report_client_algorithms() ->
- try
- ssh_test_lib:extract_algos( ssh_test_lib:default_algorithms(sshc) )
- of
- ClientAlgs ->
- ct:pal("The client supports:~n~p",[ClientAlgs])
- catch
- Cls:Err ->
- ct:pal("Testing client about algorithms failed:~n~p ~p",[Cls,Err])
- end.
-
-%%%----------------------------------------------------------------
-
-
-now2sec({A,B,C}) -> A*1000000 + B + C/1000000.
-
-now2micro_sec({A,B,C}) -> (A*1000000 + B)*1000000 + C.
-
-now_diff({A1,B1,C1}, {A0,B0,C0}) -> {A1-A0, B1-B0, C1-C0}.
-
-%%%================================================================
-moduli() ->
- [{1023, 5, 16#CF973CD39DC7D62F2C45AAC5180491104C76E0FE5D80A10E6C06AE442F1F373167B0FCBC931F3C157B10A5557008FDE20D68051E6A4DB11CEE0B0749F76D7134B937A59DA998C42BC234A5C1A3CFCD70E624D253D7694076F7B1FD7B8D3427849C9377B3555796ACA58C69DFF542EEEC9859D3ADCE5CC88DF6F7817C9D182EB7},
- {2047, 5, 16#F7693FC11FDDEAA493D3BA36F1FFF9264AA9952209203192A88A697BE9D0E306E306A27430BD87AB9EE9DB4BC78C41950C2EB0E5E4C686E8B1BA6D6A2B1FE91EF40C5EA32C51018323E1D305FE637F35ACABDBFC40AD683F779570A76869EB90015A342B2D1F7C81602688081FCAAA8D623090258D9C5C729C8CDDC0C12CA2D561DD987DB79B6AD7A2A509EBC383BF223FD95BC5A2FCC26FB3F3A0DD3FDC1228E338D3290235A596F9465F7BF490974847E616229A9E60B8F4AA161C52F655843CCCAE8821B40C426B535DE087964778652BBD4EC601C0456AE7128B593FCC64402C891227AE6EE88CC839416FBF462B4852999C646BE0BED7D8CF2BE5E381EF},
- {4095, 2, 16#C8842271626E53546E0C712FA265713F2EE073C20A0723C96B6B182B1EAACC96233D4A199BD0E85F264078A513AD2454F284B8DF543D85019D1E70F2FF54BA43EFBC64AF465C170C3E376F5EC328F98E33E1ED8BED84FA097ABE584152B0E9827ED5CC2B1D4F5ECF2DC46F45C59816D02698EA26F319311E2B6973E83C37021CC8B416AEF653896A1764EE0CEE718A45E8B47CB960BD5907D0E843E8A8E7D4698363C3C3FB3ADC512368B72CAF16510C69052EA2AF51BE00BC8CA04DF1F00A00CC2CA4D74254A1E8738460FD244DDB446CB36554B0A24EEF3710E44DBCF39881E7D3F9AE223388084E7A49A3CB12612AE36416C0EB5628DF1477FEE4A5CF77CDC09AA0E2C989C0B7D1310AFA44B81DA79A65226C7EA510057991EABF9388DC5EA9F52FEA5D3B0872843F50878740794E523E9DC60E0EA1FC8746A7B2AA31FCA89AAA2FA907BED116C69D98F912DD5089BECF28577064225DE96FC214ED1794E7CCE8024F94036D915A123A464C951DA96A5ED7F286F205BEE71BDE2D133FD1891B31178FF25D31611A5B7839F0E68EAF0F8901A571E6917C580F31842A9F19C47E0638483B7947DDCD7864660AC2F8B2C430F1E7FC0F22FA51F96F0499332C5AD3FF9DC7F4332DD5BCCA820CC779B90C0F4C5F0CA52E96FAA187361753FBADC5C80D0492CD80A3EEA5D578772DA9FC1C0E10A0203098AF36D0ED2156BA7321EB},
- {6143, 5, 16#FD9E6B52785CD7BE64D396A599DA4B97CD0BB49183F932A97694D80CA553354DBC26E77B8A0EC002257AADDF6AD27819CE64A06416E4A80B6EA92F28EA8D5B96C774109EEE5816B4B18F84368D1B41864C11AA73D6881675D779B174F6B4E344303F3EFD11BD7DE468467242372FD00908F296F5A2B20E2684F9122D08A46D647B05E298F0BCDAB60468349CCA6DA1B9FEBBC69D256FB9A3F1980F68466364FCEF1C98C1405191A6737A3627BA7F7313A8A18FC0B8521BF3430B1C6805CB44BCEB39904DD30130D24B225B598ED83C5FD757B80189FD9D5C2F9596687C40BAB1C6ED6244944629849D074A4C33FB15DDB3F9760FC59C44BEBB0EC032177147F61789769DAAAE2123CE488F7ECF19BDA051925BA9ED11EAA72DF70C9ECC8F714B4C35728E6679E66A1B56CCAE0FBBD3F9EBF950D4D623ED78E77CC3AD604E91F304EA78CE876F036214BD6F1977BD04C9ADD707D7A3BCCE87AD5D5A11C95E7025B0EA9C649DCB37942A3970A4FB04C284E4DDB4DC90163353B98B1C254FFD28443353F17A87C02E0BDB9F05424CC44C86309F1D73706F039CDAAC3EDC1A64F38FB42707D351DB5360C2680ADC1CC8D1C4AD312ACC904382C26BE33DA0E61429A5940820356ED28586BEB629ED1521D12D25B4DA01926295F3DA504DC9F431B719AC63277BE675E6F6DD4F7499CA11A23744577D653941963E8DAB610F7F226DB52CE5C683F72AEED2B6CE35ED07C29410397A6F7F606477CCC0EDE18CD0D96A7863BC4606193A8799B5AC1EEE6AC5EE36AC3077EC8DAB30EE94434B45B78BC13D96F74D6C4056EAA528CD3C68D308344808819B12F2BFB95A5C1A7DEEE188BF139216DDB7D757D7A50D3C46CE18881D776D617DCFFAA62276045373AA4D9446D7570338F99C0CA8A08851B4F9D388B4C275D3F9B7BA25F235D4329F63F7457C2EB5C68CE2A96D19766F0ED8E19F66DF3C5E29A38795B2F92291BB6EAB6F70A7E89DC9691F28486E9CF87FF11D5DF2E6B030A30B5D476AD59A34EE7262712ED96CEF4A5CAC3F08B3563D44683F746DA094C9CDB34427AF8D8CC2AE1B23C3BEB637},
- {8191, 2, 16#DC61EF13E4F3FC10CC946EEABC33F83EFCB35E0F47E4EC25C1CCBB2C7B502B2EFB0691AA231C8476DD51BA73204E6EA10B1A970FE2CF14AF01E72E1AEA87519A91D00D1499189F94A6CDA9E29C05F11F17FE74A4919A710A2787E180744465DF81C62AA65662FDA46FA6175E8A31E5B29E66DED6701C8FC4217E91D733FE94380F046680967D4CEA7BAC8F3916CDF96AA2C474FAD9650F48403FD0B5B756D34667D36A07767FA33027AE55484D0F701C3CA16632F413A14E4B8645AFAF15B78978C19A7661EDC569BEC72394B1204B166A48FCD5F56BE29840C7794CA6D3440356F15858CDCA9B429C7EA92E17242893FDC8C9C63841A382C32F20CFAB121B4BCAFD7BF9EF07FBF7CDFFECA0CEF3A49C3E2B24FA836F3318435255655E1B281071F62D5E4CD63361299B7828F72936E3FEA9E8044562A6F6ADD5321187C3101E4669C6271598FE1A866C93FE2870A4CEB9254BA32A4719E439317EA42200A335B5CFFA7946A7D0F1BD1A69AA11288B73C71C80B77FE3707CB077DDDEA5CA36A449FAB230C9625A0B12F8275D3FF82F5DA380E7A3F11B6F155FE7E91AC960BD95D9B13F7423AB9B15CC3C4DC34EF296033F009468EA16A721AD659F56C18516025050749ABF05E6D3EBD9778142A530979291F46DAA399A86B7BCDF09CC3E6EEF101419762A306DB45AEFC96C64E83F28338D55905F6A387E0F515E580C3A9B35330E21C32198CDEE3AFB355967A098F635FCA7C49CB4E1E82464B2B390EF1F259E40B9A06235C0273F76284FE6BD534EF3AF7CB01A4A5252B8B94CADC2850B2E56D53F9A31D7C029DF967D0A30C05BC64E119BED6076818FABC8CDD93F3255693E14EFC1A740A5D63A5E847FFE87BAB1DDE0506E1762EA61EFA9F9756151ECCCADD91B98A961A901A2D8B01ABDDD29EC804E8C8D28214BBA26048F924CA66316696E51A49D02FF034D20E44914B1115339CAD3819E0CB1640F0084886FEDDE5E28C29DC48ED30A8C3D789734338F5A9DF42584326E536FD1CF30BC85B8DCBD6120D127C98FE4B3614074F13C2CA4854E6D794156C185C40EB3DA7619CE96ADAF0941BD5499848B034C2B11DFECC0BDFA81C594241F759EF53FC7CDE7F2DE4F23CF81A5A0B7D62E31DABB9198D40307F7824DD130B7D1B80E9B6D322FEEDB5ACE34944F0BFB7D016762A9B2E173BFDD69303766AFBAB45FAB75D05430B4A3515858C4B7F04E23414E4AD03842CB0A20D8FF4B59B7C852BA9A5BE982A8ADA5CB70C36CE2A4D2C31A7015C9F3275E43D192C1B2924424088907A057DA7F2D32A2149922AB2E33F2147D637A3508911CB3FEA5E1AAB4525BACF27B6DD7A3E0AFA978FC3A39DE8882FB22688C3CCC92B6E69ACB0BBF575AB3368E51A2F6A20C414C6F146727CC0045F29061E695D29F7C030CE6929EB3AD11A5CBD0CDEE37347869A3}].
diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl
index 687e6efaf3..7eda009552 100644
--- a/lib/ssh/test/ssh_to_openssh_SUITE.erl
+++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl
@@ -333,7 +333,7 @@ erlang_client_openssh_server_publickey_rsa(Config) when is_list(Config) ->
[{_,_, not_encrypted}] ->
ConnectionRef =
ssh_test_lib:connect(?SSH_DEFAULT_PORT,
- [{public_key_alg, ssh_rsa},
+ [{pref_public_key_algs, ['ssh-rsa','ssh-dss']},
{user_interaction, false},
silently_accept_hosts]),
{ok, Channel} =
@@ -354,7 +354,7 @@ erlang_client_openssh_server_publickey_dsa() ->
erlang_client_openssh_server_publickey_dsa(Config) when is_list(Config) ->
ConnectionRef =
ssh_test_lib:connect(?SSH_DEFAULT_PORT,
- [{public_key_alg, ssh_dsa},
+ [{pref_public_key_algs, ['ssh-dss','ssh-rsa']},
{user_interaction, false},
silently_accept_hosts]),
{ok, Channel} =
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index 916b41742e..91c590c247 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -935,13 +935,14 @@ fun(srp, Username :: string(), UserState :: term()) ->
<fsummary>Returns all the connection information.
</fsummary>
<type>
- <v>Item = protocol | cipher_suite | sni_hostname | ecc | atom()</v>
+ <v>Item = protocol | cipher_suite | sni_hostname | ecc | session_id | atom()</v>
<d>Meaningful atoms, not specified above, are the ssl option names.</d>
<v>Result = [{Item::atom(), Value::term()}]</v>
<v>Reason = term()</v>
</type>
- <desc><p>Returns all relevant information about the connection, ssl options that
- are undefined will be filtered out.</p>
+ <desc><p>Returns the most relevant information about the connection, ssl options that
+ are undefined will be filtered out. Note that values that affect the security of the
+ connection will only be returned if explicitly requested by connection_information/2.</p>
</desc>
</func>
@@ -952,8 +953,10 @@ fun(srp, Username :: string(), UserState :: term()) ->
</fsummary>
<type>
<v>Items = [Item]</v>
- <v>Item = protocol | cipher_suite | sni_hostname | atom()</v>
- <d>Meaningful atoms, not specified above, are the ssl option names.</d>
+ <v>Item = protocol | cipher_suite | sni_hostname | ecc | session_id | client_random
+ | server_random | master_secret | atom()</v>
+ <d>Note that client_random, server_random and master_secret are values
+ that affect the security of connection. Meaningful atoms, not specified above, are the ssl option names.</d>
<v>Result = [{Item::atom(), Value::term()}]</v>
<v>Reason = term()</v>
</type>
diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl
index fd1f9698fe..4c525fae1b 100644
--- a/lib/ssl/src/dtls_handshake.erl
+++ b/lib/ssl/src/dtls_handshake.erl
@@ -455,7 +455,7 @@ merge_fragments(#handshake_fragment{
fragment_offset = PreviousOffSet,
fragment_length = CurrentLen}) when CurrentLen < PreviousLen ->
Previous;
-%% Next fragment
+%% Next fragment, might be overlapping
merge_fragments(#handshake_fragment{
fragment_offset = PreviousOffSet,
fragment_length = PreviousLen,
@@ -464,10 +464,28 @@ merge_fragments(#handshake_fragment{
#handshake_fragment{
fragment_offset = CurrentOffSet,
fragment_length = CurrentLen,
- fragment = CurrentData}) when PreviousOffSet + PreviousLen == CurrentOffSet->
- Previous#handshake_fragment{
- fragment_length = PreviousLen + CurrentLen,
- fragment = <<PreviousData/binary, CurrentData/binary>>};
+ fragment = CurrentData})
+ when PreviousOffSet + PreviousLen >= CurrentOffSet andalso
+ PreviousOffSet + PreviousLen < CurrentOffSet + CurrentLen ->
+ CurrentStart = PreviousOffSet + PreviousLen - CurrentOffSet,
+ <<_:CurrentStart/bytes, Data/binary>> = CurrentData,
+ Previous#handshake_fragment{
+ fragment_length = PreviousLen + CurrentLen - CurrentStart,
+ fragment = <<PreviousData/binary, Data/binary>>};
+%% already fully contained fragment
+merge_fragments(#handshake_fragment{
+ fragment_offset = PreviousOffSet,
+ fragment_length = PreviousLen,
+ fragment = PreviousData
+ } = Previous,
+ #handshake_fragment{
+ fragment_offset = CurrentOffSet,
+ fragment_length = CurrentLen,
+ fragment = CurrentData})
+ when PreviousOffSet + PreviousLen >= CurrentOffSet andalso
+ PreviousOffSet + PreviousLen >= CurrentOffSet + CurrentLen ->
+ Previous;
+
%% No merge there is a gap
merge_fragments(Previous, Current) ->
[Previous, Current].
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 45fc29723f..b3d08bdfbe 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -38,16 +38,13 @@
getopts/2, setopts/2, getstat/1, getstat/2
]).
%% SSL/TLS protocol handling
--export([cipher_suites/0, cipher_suites/1, eccs/0, eccs/1,
- connection_info/1, versions/0, session_info/1, format_error/1,
- renegotiate/1, prf/5, negotiated_protocol/1, negotiated_next_protocol/1,
+
+-export([cipher_suites/0, cipher_suites/1, eccs/0, eccs/1, versions/0,
+ format_error/1, renegotiate/1, prf/5, negotiated_protocol/1,
connection_information/1, connection_information/2]).
%% Misc
-export([handle_options/2, tls_version/1]).
--deprecated({negotiated_next_protocol, 1, next_major_release}).
--deprecated({connection_info, 1, next_major_release}).
-
-include("ssl_api.hrl").
-include("ssl_internal.hrl").
-include("ssl_record.hrl").
@@ -307,7 +304,7 @@ controlling_process(#sslsocket{pid = {Listen,
%% Description: Return SSL information for the connection
%%--------------------------------------------------------------------
connection_information(#sslsocket{pid = Pid}) when is_pid(Pid) ->
- case ssl_connection:connection_information(Pid) of
+ case ssl_connection:connection_information(Pid, false) of
{ok, Info} ->
{ok, [Item || Item = {_Key, Value} <- Info, Value =/= undefined]};
Error ->
@@ -323,8 +320,8 @@ connection_information(#sslsocket{pid = {udp,_}}) ->
%%
%% Description: Return SSL information for the connection
%%--------------------------------------------------------------------
-connection_information(#sslsocket{} = SSLSocket, Items) ->
- case connection_information(SSLSocket) of
+connection_information(#sslsocket{pid = Pid}, Items) when is_pid(Pid) ->
+ case ssl_connection:connection_information(Pid, include_security_info(Items)) of
{ok, Info} ->
{ok, [Item || Item = {Key, Value} <- Info, lists:member(Key, Items),
Value =/= undefined]};
@@ -333,21 +330,6 @@ connection_information(#sslsocket{} = SSLSocket, Items) ->
end.
%%--------------------------------------------------------------------
-%% Deprecated
--spec connection_info(#sslsocket{}) -> {ok, {tls_record:tls_atom_version(), ssl_cipher:erl_cipher_suite()}} |
- {error, reason()}.
-%%
-%% Description: Returns ssl protocol and cipher used for the connection
-%%--------------------------------------------------------------------
-connection_info(#sslsocket{} = SSLSocket) ->
- case connection_information(SSLSocket) of
- {ok, Result} ->
- {ok, {proplists:get_value(protocol, Result), proplists:get_value(cipher_suite, Result)}};
- Error ->
- Error
- end.
-
-%%--------------------------------------------------------------------
-spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}.
%%
%% Description: same as inet:peername/1.
@@ -392,20 +374,6 @@ negotiated_protocol(#sslsocket{pid = Pid}) ->
ssl_connection:negotiated_protocol(Pid).
%%--------------------------------------------------------------------
--spec negotiated_next_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}.
-%%
-%% Description: Returns the next protocol that has been negotiated. If no
-%% protocol has been negotiated will return {error, next_protocol_not_negotiated}
-%%--------------------------------------------------------------------
-negotiated_next_protocol(Socket) ->
- case negotiated_protocol(Socket) of
- {error, protocol_not_negotiated} ->
- {error, next_protocol_not_negotiated};
- Res ->
- Res
- end.
-
-%%--------------------------------------------------------------------
-spec cipher_suites() -> [ssl_cipher:erl_cipher_suite()] | [string()].
%%--------------------------------------------------------------------
cipher_suites() ->
@@ -555,19 +523,6 @@ sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid)
tls_socket:sockname(Transport, Socket).
%%---------------------------------------------------------------
--spec session_info(#sslsocket{}) -> {ok, list()} | {error, reason()}.
-%%
-%% Description: Returns list of session info currently [{session_id, session_id(),
-%% {cipher_suite, cipher_suite()}]
-%%--------------------------------------------------------------------
-session_info(#sslsocket{pid = Pid}) when is_pid(Pid) ->
- ssl_connection:session_info(Pid);
-session_info(#sslsocket{pid = {udp,_}}) ->
- {error, enotconn};
-session_info(#sslsocket{pid = {Listen,_}}) when is_port(Listen) ->
- {error, enotconn}.
-
-%%---------------------------------------------------------------
-spec versions() -> [{ssl_app, string()} | {supported, [tls_record:tls_atom_version()]} |
{available, [tls_record:tls_atom_version()]}].
%%
@@ -1480,3 +1435,13 @@ default_cb_info(tls) ->
{gen_tcp, tcp, tcp_closed, tcp_error};
default_cb_info(dtls) ->
{gen_udp, udp, udp_closed, udp_error}.
+
+include_security_info([]) ->
+ false;
+include_security_info([Item | Items]) ->
+ case lists:member(Item, [client_random, server_random, master_secret]) of
+ true ->
+ true;
+ false ->
+ include_security_info(Items)
+ end.
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index ea139ac4b1..df9b9e8a63 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -42,9 +42,9 @@
%% User Events
-export([send/2, recv/3, close/2, shutdown/2,
- new_user/2, get_opts/2, set_opts/2, session_info/1,
+ new_user/2, get_opts/2, set_opts/2,
peer_certificate/1, renegotiation/1, negotiated_protocol/1, prf/5,
- connection_information/1, handle_common_event/5
+ connection_information/2, handle_common_event/5
]).
%% General gen_statem state functions with extra callback argument
@@ -185,12 +185,12 @@ recv(Pid, Length, Timeout) ->
call(Pid, {recv, Length, Timeout}).
%%--------------------------------------------------------------------
--spec connection_information(pid()) -> {ok, list()} | {error, reason()}.
+-spec connection_information(pid(), boolean()) -> {ok, list()} | {error, reason()}.
%%
%% Description: Get the SNI hostname
%%--------------------------------------------------------------------
-connection_information(Pid) when is_pid(Pid) ->
- call(Pid, connection_information).
+connection_information(Pid, IncludeSecrityInfo) when is_pid(Pid) ->
+ call(Pid, {connection_information, IncludeSecrityInfo}).
%%--------------------------------------------------------------------
-spec close(pid(), {close, Timeout::integer() |
@@ -247,14 +247,6 @@ set_opts(ConnectionPid, Options) ->
call(ConnectionPid, {set_opts, Options}).
%%--------------------------------------------------------------------
--spec session_info(pid()) -> {ok, list()} | {error, reason()}.
-%%
-%% Description: Returns info about the ssl session
-%%--------------------------------------------------------------------
-session_info(ConnectionPid) ->
- call(ConnectionPid, session_info).
-
-%%--------------------------------------------------------------------
-spec peer_certificate(pid()) -> {ok, binary()| undefined} | {error, reason()}.
%%
%% Description: Returns the peer cert
@@ -775,14 +767,12 @@ connection({call, From}, renegotiate, #state{protocol_cb = Connection} = State,
connection({call, From}, peer_certificate,
#state{session = #session{peer_certificate = Cert}} = State, _) ->
hibernate_after(connection, State, [{reply, From, {ok, Cert}}]);
-connection({call, From}, connection_information, State, _) ->
+connection({call, From}, {connection_information, true}, State, _) ->
+ Info = connection_info(State) ++ security_info(State),
+ hibernate_after(connection, State, [{reply, From, {ok, Info}}]);
+connection({call, From}, {connection_information, false}, State, _) ->
Info = connection_info(State),
hibernate_after(connection, State, [{reply, From, {ok, Info}}]);
-connection({call, From}, session_info, #state{session = #session{session_id = Id,
- cipher_suite = Suite}} = State, _) ->
- SessionInfo = [{session_id, Id},
- {cipher_suite, ssl_cipher:erl_suite_definition(Suite)}],
- hibernate_after(connection, State, [{reply, From, SessionInfo}]);
connection({call, From}, negotiated_protocol,
#state{negotiated_protocol = undefined} = State, _) ->
hibernate_after(connection, State, [{reply, From, {error, protocol_not_negotiated}}]);
@@ -1195,7 +1185,8 @@ handle_alert(#alert{level = ?WARNING} = Alert, StateName,
%%% Internal functions
%%--------------------------------------------------------------------
connection_info(#state{sni_hostname = SNIHostname,
- session = #session{cipher_suite = CipherSuite, ecc = ECCCurve},
+ session = #session{session_id = SessionId,
+ cipher_suite = CipherSuite, ecc = ECCCurve},
protocol_cb = Connection,
negotiated_version = {_,_} = Version,
ssl_options = Opts}) ->
@@ -1210,9 +1201,18 @@ connection_info(#state{sni_hostname = SNIHostname,
[]
end,
[{protocol, RecordCB:protocol_version(Version)},
+ {session_id, SessionId},
{cipher_suite, CipherSuiteDef},
{sni_hostname, SNIHostname} | CurveInfo] ++ ssl_options_list(Opts).
+security_info(#state{connection_states = ConnectionStates}) ->
+ #{security_parameters :=
+ #security_parameters{client_random = ClientRand,
+ server_random = ServerRand,
+ master_secret = MasterSecret}} =
+ ssl_record:current_connection_state(ConnectionStates, read),
+ [{client_random, ClientRand}, {server_random, ServerRand}, {master_secret, MasterSecret}].
+
do_server_hello(Type, #hello_extensions{next_protocol_negotiation = NextProtocols} =
ServerHelloExt,
#state{negotiated_version = Version,
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 86426bdb60..4eabe544d7 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -148,6 +148,7 @@ options_tests_tls() ->
api_tests() ->
[connection_info,
+ secret_connection_info,
connection_information,
peercert,
peercert_with_client_cert,
@@ -611,7 +612,7 @@ prf(Config) when is_list(Config) ->
%%--------------------------------------------------------------------
connection_info() ->
- [{doc,"Test the API function ssl:connection_information/1"}].
+ [{doc,"Test the API function ssl:connection_information/2"}].
connection_info(Config) when is_list(Config) ->
ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config),
ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
@@ -645,6 +646,38 @@ connection_info(Config) when is_list(Config) ->
%%--------------------------------------------------------------------
+secret_connection_info() ->
+ [{doc,"Test the API function ssl:connection_information/2"}].
+secret_connection_info(Config) when is_list(Config) ->
+ ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, secret_connection_info_result, []}},
+ {options, ServerOpts}]),
+
+ Port = ssl_test_lib:inet_port(Server),
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, secret_connection_info_result, []}},
+ {options, ClientOpts}]),
+
+ ct:log("Testcase ~p, Client ~p Server ~p ~n",
+ [self(), Client, Server]),
+
+ Version = ssl_test_lib:protocol_version(Config),
+
+ ssl_test_lib:check_result(Server, true, Client, true),
+
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
+
+
+%%--------------------------------------------------------------------
+
connection_information() ->
[{doc,"Test the API function ssl:connection_information/1"}].
connection_information(Config) when is_list(Config) ->
@@ -3414,7 +3447,6 @@ listen_socket(Config) ->
{error, enotconn} = ssl:connection_information(ListenSocket),
{error, enotconn} = ssl:peername(ListenSocket),
{error, enotconn} = ssl:peercert(ListenSocket),
- {error, enotconn} = ssl:session_info(ListenSocket),
{error, enotconn} = ssl:renegotiate(ListenSocket),
{error, enotconn} = ssl:prf(ListenSocket, 'master_secret', <<"Label">>, client_random, 256),
{error, enotconn} = ssl:shutdown(ListenSocket, read_write),
@@ -4638,6 +4670,11 @@ version_info_result(Socket) ->
{ok, [{version, Version}]} = ssl:connection_information(Socket, [version]),
{ok, Version}.
+secret_connection_info_result(Socket) ->
+ {ok, [{client_random, ClientRand}, {server_random, ServerRand}, {master_secret, MasterSecret}]}
+ = ssl:connection_information(Socket, [client_random, server_random, master_secret]),
+ is_binary(ClientRand) andalso is_binary(ServerRand) andalso is_binary(MasterSecret).
+
connect_dist_s(S) ->
Msg = term_to_binary({erlang,term}),
ok = ssl:send(S, Msg).
diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl
index 3446a566c4..c8caa9c11a 100644
--- a/lib/ssl/test/ssl_packet_SUITE.erl
+++ b/lib/ssl/test/ssl_packet_SUITE.erl
@@ -1973,14 +1973,14 @@ passive_recv_packet(Socket, _, 0) ->
{error, timeout} = ssl:recv(Socket, 0, 500),
ok;
Other ->
- {other, Other, ssl:session_info(Socket), 0}
+ {other, Other, ssl:connection_information(Socket, [session_id, cipher_suite]), 0}
end;
passive_recv_packet(Socket, Data, N) ->
case ssl:recv(Socket, 0) of
{ok, Data} ->
passive_recv_packet(Socket, Data, N-1);
Other ->
- {other, Other, ssl:session_info(Socket), N}
+ {other, Other, ssl:connection_information(Socket, [session_id, cipher_suite]), N}
end.
send(Socket,_, 0) ->
@@ -2032,7 +2032,7 @@ active_once_packet(Socket,_, 0) ->
{ssl, Socket, []} ->
ok;
{ssl, Socket, Other} ->
- {other, Other, ssl:session_info(Socket), 0}
+ {other, Other, ssl:connection_information(Socket, [session_id, cipher_suite]), 0}
end;
active_once_packet(Socket, Data, N) ->
receive
@@ -2077,7 +2077,7 @@ active_packet(Socket, _, 0) ->
{ssl, Socket, []} ->
ok;
Other ->
- {other, Other, ssl:session_info(Socket), 0}
+ {other, Other, ssl:connection_information(Socket, [session_id, cipher_suite]), 0}
end;
active_packet(Socket, Data, N) ->
receive
@@ -2089,7 +2089,7 @@ active_packet(Socket, Data, N) ->
{ssl, Socket, Data} ->
active_packet(Socket, Data, N -1);
Other ->
- {other, Other, ssl:session_info(Socket),N}
+ {other, Other, ssl:connection_information(Socket, [session_id, cipher_suite]),N}
end.
assert_packet_opt(Socket, Type) ->
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index d91f3de79e..ae378037dd 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -791,18 +791,18 @@ no_result(_) ->
no_result_msg.
trigger_renegotiate(Socket, [ErlData, N]) ->
- [{session_id, Id} | _ ] = ssl:session_info(Socket),
+ {ok, [{session_id, Id}]} = ssl:connection_information(Socket, [session_id]),
trigger_renegotiate(Socket, ErlData, N, Id).
trigger_renegotiate(Socket, _, 0, Id) ->
ct:sleep(1000),
- case ssl:session_info(Socket) of
- [{session_id, Id} | _ ] ->
+ case ssl:connection_information(Socket, [session_id]) of
+ {ok, [{session_id, Id}]} ->
fail_session_not_renegotiated;
%% Tests that uses this function will not reuse
%% sessions so if we get a new session id the
%% renegotiation has succeeded.
- [{session_id, _} | _ ] ->
+ {ok, [{session_id, _}]} ->
ok;
{error, closed} ->
fail_session_fatal_alert_during_renegotiation;
@@ -1007,8 +1007,8 @@ cipher_result(Socket, Result) ->
end.
session_info_result(Socket) ->
- ssl:session_info(Socket).
-
+ {ok, Info} = ssl:connection_information(Socket, [session_id, cipher_suite]),
+ Info.
public_key(#'PrivateKeyInfo'{privateKeyAlgorithm =
#'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?rsaEncryption},
diff --git a/lib/stdlib/doc/src/proplists.xml b/lib/stdlib/doc/src/proplists.xml
index fe6b8cc3bf..990d47b313 100644
--- a/lib/stdlib/doc/src/proplists.xml
+++ b/lib/stdlib/doc/src/proplists.xml
@@ -344,7 +344,7 @@ split([{c, 2}, {e, 1}, a, {c, 3, 4}, d, {b, 5}, b], [a, b, c])</code>
with <c>{K2, true}</c>, thus changing the name of the option and
simultaneously negating the value specified by
<seealso marker="#get_bool/2">
- <c>get_bool(Key, <anno>ListIn</anno></c></seealso>.
+ <c>get_bool(Key, <anno>ListIn</anno>)</c></seealso>.
If the same <c>K1</c> occurs more than once in
<c><anno>Negations</anno></c>, only the first occurrence is used.</p>
<p>For example, <c>substitute_negations([{no_foo, foo}], L)</c>
diff --git a/lib/stdlib/doc/src/unicode_usage.xml b/lib/stdlib/doc/src/unicode_usage.xml
index efc8b75075..a8ef8ff5c5 100644
--- a/lib/stdlib/doc/src/unicode_usage.xml
+++ b/lib/stdlib/doc/src/unicode_usage.xml
@@ -62,6 +62,10 @@
<item><p>In Erlang/OTP 17.0, the encoding default for Erlang
source files was switched to UTF-8.</p></item>
+
+ <item><p>In Erlang/OTP 20.0, atoms and function can contain
+ Unicode characters. Module names are still restricted to
+ the ISO-Latin-1 range.</p></item>
</list>
<p>This section outlines the current Unicode support and gives some
@@ -339,9 +343,10 @@
<tag>The language</tag>
<item>
<p>Having the source code in UTF-8 also allows you to write string
- literals containing Unicode characters with code points &gt; 255,
- although atoms, module names, and function names are restricted to
- the ISO Latin-1 range. Binary literals, where you use type
+ literals, function names, and atoms containing Unicode
+ characters with code points &gt; 255.
+ Module names are still restricted to the ISO Latin-1 range.
+ Binary literals, where you use type
<c>/utf8</c>, can also be expressed using Unicode characters &gt; 255.
Having module names using characters other than 7-bit ASCII can cause
trouble on operating systems with inconsistent file naming schemes,
@@ -432,15 +437,17 @@ external_charlist() = maybe_improper_list(char() | external_unicode_binary() |
<section>
<title>Basic Language Support</title>
- <p><marker id="unicode_in_erlang"/>As from Erlang/OTP R16, Erlang source
- files can be written in UTF-8 or bytewise (<c>latin1</c>) encoding. For
- information about how to state the encoding of an Erlang source file, see
- the <seealso marker="stdlib:epp#encoding"><c>epp(3)</c></seealso> module.
- Strings and comments can be written using Unicode, but functions must
- still be named using characters from the ISO Latin-1 character set, and
- atoms are restricted to the same ISO Latin-1 range. These restrictions in
- the language are of course independent of the encoding of the source
- file.</p>
+ <p><marker id="unicode_in_erlang"/>As from Erlang/OTP R16, Erlang
+ source files can be written in UTF-8 or bytewise (<c>latin1</c>)
+ encoding. For information about how to state the encoding of an
+ Erlang source file, see the <seealso
+ marker="stdlib:epp#encoding"><c>epp(3)</c></seealso> module. As
+ from Erlang/OTP R16, strings and comments can be written using
+ Unicode. As from Erlang/OTP 20, also atoms and functions can be
+ written using Unicode. Modules names must still be named using
+ characters from the ISO Latin-1 character set. (These
+ restrictions in the language are independent of the encoding of
+ the source file.)</p>
<section>
<title>Bit Syntax</title>
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index 0ffca0886f..0789f5dfb7 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -156,6 +156,8 @@ format_error(pmod_unsupported) ->
"parameterized modules are no longer supported";
%% format_error({redefine_mod_import, M, P}) ->
%% io_lib:format("module '~s' already imported from package '~s'", [M, P]);
+format_error(non_latin1_module_unsupported) ->
+ "module names with non-latin1 characters are not supported";
format_error(invalid_call) ->
"invalid function call";
@@ -733,9 +735,15 @@ form(Form, #lint{state=State}=St) ->
start_state({attribute,Line,module,{_,_}}=Form, St0) ->
St1 = add_error(Line, pmod_unsupported, St0),
attribute_state(Form, St1#lint{state=attribute});
-start_state({attribute,_,module,M}, St0) ->
+start_state({attribute,Line,module,M}, St0) ->
St1 = St0#lint{module=M},
- St1#lint{state=attribute};
+ St2 = St1#lint{state=attribute},
+ case is_non_latin1_name(M) of
+ true ->
+ add_error(Line, non_latin1_module_unsupported, St2);
+ false ->
+ St2
+ end;
start_state(Form, St) ->
Anno = case Form of
{eof, L} -> erl_anno:new(L);
@@ -745,6 +753,9 @@ start_state(Form, St) ->
St1 = add_error(Anno, undefined_module, St),
attribute_state(Form, St1#lint{state=attribute}).
+is_non_latin1_name(Name) ->
+ lists:any(fun(C) -> C > 255 end, atom_to_list(Name)).
+
%% attribute_state(Form, State) ->
%% State'
diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl
index d6fd1e3ea1..90e19e6b9f 100644
--- a/lib/stdlib/src/ets.erl
+++ b/lib/stdlib/src/ets.erl
@@ -75,10 +75,28 @@
take/2,
update_counter/3, update_counter/4, update_element/3]).
+%% internal exports
+-export([internal_request_all/0]).
+
-spec all() -> [Tab] when
Tab :: tab().
all() ->
+ receive_all(ets:internal_request_all(),
+ erlang:system_info(schedulers),
+ []).
+
+receive_all(_Ref, 0, All) ->
+ All;
+receive_all(Ref, N, All) ->
+ receive
+ {Ref, SchedAll} ->
+ receive_all(Ref, N-1, SchedAll ++ All)
+ end.
+
+-spec internal_request_all() -> reference().
+
+internal_request_all() ->
erlang:nif_error(undef).
-spec delete(Tab) -> true when
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index fda7a2cd8a..d89ff4a624 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -55,6 +55,11 @@ obsolete_1(erlang, now, 0) ->
obsolete_1(calendar, local_time_to_universal_time, 1) ->
{deprecated, {calendar, local_time_to_universal_time_dst, 1}};
+%% *** CRYPTO added in OTP 20 ***
+
+obsolete_1(crypto, rand_uniform, 2) ->
+ {deprecated, {rand, uniform, 1}};
+
%% *** CRYPTO added in OTP 19 ***
obsolete_1(crypto, rand_bytes, 1) ->
@@ -63,178 +68,178 @@ obsolete_1(crypto, rand_bytes, 1) ->
%% *** CRYPTO added in R16B01 ***
obsolete_1(crypto, md4, 1) ->
- {deprecated, {crypto, hash, 2}};
+ {removed, {crypto, hash, 2}, "20.0"};
obsolete_1(crypto, md5, 1) ->
- {deprecated, {crypto, hash, 2}};
+ {removed, {crypto, hash, 2}, "20.0"};
obsolete_1(crypto, sha, 1) ->
- {deprecated, {crypto, hash, 2}};
+ {removed, {crypto, hash, 2}, "20.0"};
obsolete_1(crypto, md4_init, 0) ->
- {deprecated, {crypto, hash_init, 1}};
+ {removed, {crypto, hash_init, 1}, "20.0"};
obsolete_1(crypto, md5_init, 0) ->
- {deprecated, {crypto, hash_init, 1}};
+ {removed, {crypto, hash_init, 1}, "20.0"};
obsolete_1(crypto, sha_init, 0) ->
- {deprecated, {crypto, hash_init, 1}};
+ {removed, {crypto, hash_init, 1}, "20.0"};
obsolete_1(crypto, md4_update, 2) ->
- {deprecated, {crypto, hash_update, 2}};
+ {removed, {crypto, hash_update, 2}, "20.0"};
obsolete_1(crypto, md5_update, 2) ->
- {deprecated, {crypto, hash_update, 2}};
+ {removed, {crypto, hash_update, 2}, "20.0"};
obsolete_1(crypto, sha_update, 2) ->
- {deprecated, {crypto, hash_update, 2}};
+ {removed, {crypto, hash_update, 2}, "20.0"};
obsolete_1(crypto, md4_final, 1) ->
- {deprecated, {crypto, hash_final, 1}};
+ {removed, {crypto, hash_final, 1}, "20.0"};
obsolete_1(crypto, md5_final, 1) ->
- {deprecated, {crypto, hash_final, 1}};
+ {removed, {crypto, hash_final, 1}, "20.0"};
obsolete_1(crypto, sha_final, 1) ->
- {deprecated, {crypto, hash_final, 1}};
+ {removed, {crypto, hash_final, 1}, "20.0"};
obsolete_1(crypto, md5_mac, 2) ->
- {deprecated, {crypto, hmac, 3}};
+ {removed, {crypto, hmac, 3}, "20.0"};
obsolete_1(crypto, sha_mac, 2) ->
- {deprecated, {crypto, hmac, 3}};
+ {removed, {crypto, hmac, 3}, "20.0"};
obsolete_1(crypto, sha_mac, 3) ->
- {deprecated, {crypto, hmac, 4}};
+ {removed, {crypto, hmac, 4}, "20.0"};
obsolete_1(crypto, sha_mac_96, 2) ->
- {deprecated, {crypto, hmac, 4}};
+ {removed, {crypto, hmac, 4}, "20.0"};
obsolete_1(crypto, md5_mac_96, 2) ->
- {deprecated, {crypto, hmac, 4}};
+ {removed, {crypto, hmac, 4}, "20.0"};
obsolete_1(crypto, rsa_sign, 2) ->
- {deprecated, {crypto, sign, 4}};
+ {removed, {crypto, sign, 4}, "20.0"};
obsolete_1(crypto, rsa_sign, 3) ->
- {deprecated, {crypto, sign, 4}};
+ {removed, {crypto, sign, 4}, "20.0"};
obsolete_1(crypto, rsa_verify, 3) ->
- {deprecated, {crypto, verify, 5}};
+ {removed, {crypto, verify, 5}, "20.0"};
obsolete_1(crypto, rsa_verify, 4) ->
- {deprecated, {crypto, verify, 5}};
+ {removed, {crypto, verify, 5}, "20.0"};
obsolete_1(crypto, dss_sign, 2) ->
- {deprecated, {crypto, sign, 4}};
+ {removed, {crypto, sign, 4}, "20.0"};
obsolete_1(crypto, dss_sign, 3) ->
- {deprecated, {crypto, sign, 4}};
+ {removed, {crypto, sign, 4}, "20.0"};
obsolete_1(crypto, dss_verify, 3) ->
- {deprecated, {crypto, verify, 5}};
+ {removed, {crypto, verify, 5}, "20.0"};
obsolete_1(crypto, dss_verify, 4) ->
- {deprecated, {crypto, verify, 5}};
+ {removed, {crypto, verify, 5}, "20.0"};
obsolete_1(crypto, mod_exp, 3) ->
- {deprecated, {crypto, mod_pow, 3}};
+ {removed, {crypto, mod_pow, 3}, "20.0"};
obsolete_1(crypto, dh_compute_key, 3) ->
- {deprecated, {crypto, compute_key, 4}};
+ {removed, {crypto, compute_key, 4}, "20.0"};
obsolete_1(crypto, dh_generate_key, 1) ->
- {deprecated, {crypto, generate_key, 2}};
+ {removed, {crypto, generate_key, 2}, "20.0"};
obsolete_1(crypto, dh_generate_key, 2) ->
- {deprecated, {crypto, generate_key, 3}};
+ {removed, {crypto, generate_key, 3}, "20.0"};
obsolete_1(crypto, des_cbc_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, des3_cbc_encrypt, 5) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, des_ecb_encrypt, 2) ->
- {deprecated, {crypto, block_encrypt, 3}};
+ {removed, {crypto, block_encrypt, 3}, "20.0"};
obsolete_1(crypto, des_ede3_cbc_encrypt, 5) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, des_cfb_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, des3_cfb_encrypt, 5) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, blowfish_ecb_encrypt, 2) ->
- {deprecated, {crypto, block_encrypt, 3}};
+ {removed, {crypto, block_encrypt, 3}, "20.0"};
obsolete_1(crypto, blowfish_cbc_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, blowfish_cfb64_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, blowfish_ofb64_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, aes_cfb_128_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, aes_cbc_128_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, aes_cbc_256_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto,rc2_cbc_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto,rc2_40_cbc_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, des_cbc_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, des3_cbc_decrypt, 5) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, des_ecb_decrypt, 2) ->
- {deprecated, {crypto, block_decrypt, 3}};
+ {removed, {crypto, block_decrypt, 3}, "20.0"};
obsolete_1(crypto, des_ede3_cbc_decrypt, 5) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, des_cfb_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, des3_cfb_decrypt, 5) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, blowfish_ecb_decrypt, 2) ->
- {deprecated, {crypto, block_decrypt, 3}};
+ {removed, {crypto, block_decrypt, 3}, "20.0"};
obsolete_1(crypto, blowfish_cbc_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, blowfish_cfb64_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, blowfish_ofb64_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, aes_cfb_128_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, aes_cbc_128_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, aes_cbc_256_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto,rc2_cbc_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto,rc2_40_cbc_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, aes_ctr_stream_decrypt, 2) ->
- {deprecated, {crypto, stream_decrypt, 2}};
+ {removed, {crypto, stream_decrypt, 2}, "20.0"};
obsolete_1(crypto, aes_ctr_stream_encrypt, 2) ->
- {deprecated, {crypto, stream_encrypt, 2}};
+ {removed, {crypto, stream_encrypt, 2}, "20.0"};
obsolete_1(crypto, aes_ctr_decrypt, 3) ->
- {deprecated, {crypto, stream_decrypt, 2}};
+ {removed, {crypto, stream_decrypt, 2}, "20.0"};
obsolete_1(crypto, aes_ctr_encrypt, 3) ->
- {deprecated, {crypto, stream_encrypt, 2}};
+ {removed, {crypto, stream_encrypt, 2}, "20.0"};
obsolete_1(crypto, rc4_encrypt, 2) ->
- {deprecated, {crypto, stream_encrypt, 2}};
+ {removed, {crypto, stream_encrypt, 2}, "20.0"};
obsolete_1(crypto, rc4_encrypt_with_state, 2) ->
- {deprecated, {crypto, stream_encrypt, 2}};
+ {removed, {crypto, stream_encrypt, 2}, "20.0"};
obsolete_1(crypto, aes_ctr_stream_init, 2) ->
- {deprecated, {crypto, stream_init, 3}};
+ {removed, {crypto, stream_init, 3}, "20.0"};
obsolete_1(crypto, rc4_set_key, 1) ->
- {deprecated, {crypto, stream_init, 2}};
+ {removed, {crypto, stream_init, 2}, "20.0"};
obsolete_1(crypto, rsa_private_decrypt, 3) ->
- {deprecated, {crypto, private_decrypt, 4}};
+ {removed, {crypto, private_decrypt, 4}, "20.0"};
obsolete_1(crypto, rsa_public_decrypt, 3) ->
- {deprecated, {crypto, public_decrypt, 4}};
+ {removed, {crypto, public_decrypt, 4}, "20.0"};
obsolete_1(crypto, rsa_private_encrypt, 3) ->
- {deprecated, {crypto, private_encrypt, 4}};
+ {removed, {crypto, private_encrypt, 4}, "20.0"};
obsolete_1(crypto, rsa_public_encrypt, 3) ->
- {deprecated, {crypto, public_encrypt, 4}};
+ {removed, {crypto, public_encrypt, 4}, "20.0"};
obsolete_1(crypto, des_cfb_ivec, 2) ->
- {deprecated, {crypto, next_iv, 3}};
+ {removed, {crypto, next_iv, 3}, "20.0"};
obsolete_1(crypto,des_cbc_ivec, 1) ->
- {deprecated, {crypto, next_iv, 2}};
+ {removed, {crypto, next_iv, 2}, "20.0"};
obsolete_1(crypto, aes_cbc_ivec, 1) ->
- {deprecated, {crypto, next_iv, 2}};
+ {removed, {crypto, next_iv, 2}, "20.0"};
obsolete_1(crypto,info, 0) ->
- {deprecated, {crypto, module_info, 0}};
+ {removed, {crypto, module_info, 0}, "20.0"};
obsolete_1(crypto, strong_rand_mpint, 3) ->
- {deprecated, "needed only by deprecated functions"};
+ {removed, "removed in 20.0; only needed by removed functions"};
obsolete_1(crypto, erlint, 1) ->
- {deprecated, "needed only by deprecated functions"};
+ {removed, "removed in 20.0; only needed by removed functions"};
obsolete_1(crypto, mpint, 1) ->
- {deprecated, "needed only by deprecated functions"};
+ {removed, "removed in 20.0; only needed by removed functions"};
%% *** SNMP ***
@@ -387,13 +392,13 @@ obsolete_1(erlang, concat_binary, 1) ->
%% Added in R14A.
obsolete_1(ssl, peercert, 2) ->
- {deprecated,"deprecated (will be removed in R15A); use ssl:peercert/1 and public_key:pkix_decode_cert/2 instead"};
+ {removed ,"removed in R15A; use ssl:peercert/1 and public_key:pkix_decode_cert/2 instead"};
%% Added in R14B.
obsolete_1(public_key, pem_to_der, 1) ->
- {deprecated,"deprecated (will be removed in R15A); use file:read_file/1 and public_key:pem_decode/1"};
+ {removed,"removed in R15A; use file:read_file/1 and public_key:pem_decode/1"};
obsolete_1(public_key, decode_private_key, A) when A =:= 1; A =:= 2 ->
- {deprecated,{public_key,pem_entry_decode,1},"R15A"};
+ {removed, "removed in R15A; use public_key:pem_entry_decode/1"};
%% Added in R14B03.
obsolete_1(docb_gen, _, _) ->
@@ -415,10 +420,10 @@ obsolete_1(inviso, _, _) ->
obsolete_1(gs, _, _) ->
{removed,"the gs application has been removed; use the wx application instead"};
obsolete_1(ssh, sign_data, 2) ->
- {deprecated,"deprecated (will be removed in R16A); use public_key:pem_decode/1, public_key:pem_entry_decode/1 "
+ {removed,"removed in R16A; use public_key:pem_decode/1, public_key:pem_entry_decode/1 "
"and public_key:sign/3 instead"};
obsolete_1(ssh, verify_data, 3) ->
- {deprecated,"deprecated (will be removed in R16A); use public_key:ssh_decode/1, and public_key:verify/4 instead"};
+ {removed,"removed in R16A; use public_key:ssh_decode/1, and public_key:verify/4 instead"};
%% Added in R16
obsolete_1(wxCalendarCtrl, enableYearChange, _) -> %% wx bug documented?
@@ -515,10 +520,9 @@ obsolete_1(erl_parse, get_attribute, 2) ->
obsolete_1(erl_lint, modify_line, 2) ->
{removed,{erl_parse,map_anno,2},"19.0"};
obsolete_1(ssl, negotiated_next_protocol, 1) ->
- {deprecated,{ssl,negotiated_protocol,1}};
-
+ {removed,"removed in 20.0; use ssl:negotiated_protocol/1 instead"};
obsolete_1(ssl, connection_info, 1) ->
- {deprecated, "deprecated; use connection_information/[1,2] instead"};
+ {removed, "removed in 20.0; use ssl:connection_information/[1,2] instead"};
obsolete_1(httpd_conf, check_enum, 2) ->
{deprecated, "deprecated; use lists:member/2 instead"};
diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index df38edf393..fd7de65302 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -64,7 +64,8 @@
predef/1,
maps/1,maps_type/1,maps_parallel_match/1,
otp_11851/1,otp_11879/1,otp_13230/1,
- record_errors/1, otp_xxxxx/1]).
+ record_errors/1, otp_xxxxx/1,
+ non_latin1_module/1]).
suite() ->
[{ct_hooks,[ts_install_cth]},
@@ -84,7 +85,7 @@ all() ->
too_many_arguments, basic_errors, bin_syntax_errors, predef,
maps, maps_type, maps_parallel_match,
otp_11851, otp_11879, otp_13230,
- record_errors, otp_xxxxx].
+ record_errors, otp_xxxxx, non_latin1_module].
groups() ->
[{unused_vars_warn, [],
@@ -2098,11 +2099,11 @@ otp_5362(Config) when is_list(Config) ->
[{2,erl_lint,disallowed_nowarn_bif_clash}],[]}},
{call_deprecated_function,
- <<"t(X) -> crypto:md5(X).">>,
+ <<"t(X) -> calendar:local_time_to_universal_time(X).">>,
[],
{warnings,
- [{1,erl_lint,{deprecated,{crypto,md5,1},
- {crypto,hash,2}, "a future release"}}]}},
+ [{1,erl_lint,{deprecated,{calendar,local_time_to_universal_time,1},
+ {calendar,local_time_to_universal_time_dst,1}, "a future release"}}]}},
{call_removed_function,
<<"t(X) -> regexp:match(X).">>,
@@ -3923,6 +3924,24 @@ otp_xxxxx(Config) ->
[]}],
run(Config, Ts).
+%% OTP-14285: We currently don't support non-latin1 module names.
+
+non_latin1_module(_Config) ->
+ do_non_latin1_module('юникод'),
+ do_non_latin1_module(list_to_atom([256,$a,$b,$c])),
+ do_non_latin1_module(list_to_atom([$a,$b,256,$c])),
+ ok.
+
+do_non_latin1_module(Mod) ->
+ File = atom_to_list(Mod) ++ ".erl",
+ Forms = [{attribute,1,file,{File,1}},
+ {attribute,1,module,Mod},
+ {eof,2}],
+ error = compile:forms(Forms),
+ {error,_,[]} = compile:forms(Forms, [return]),
+ ok.
+
+
run(Config, Tests) ->
F = fun({N,P,Ws,E}, BadL) ->
case catch run_test(Config, P, Ws) of
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 8581440d58..ebf7dbff62 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -75,7 +75,7 @@
-export([otp_9423/1]).
-export([otp_10182/1]).
-export([ets_all/1]).
--export([memory_check_summary/1]).
+-export([massive_ets_all/1]).
-export([take/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
@@ -93,7 +93,6 @@ init_per_testcase(Case, Config) ->
io:format("*** SEED: ~p ***\n", [rand:export_seed()]),
start_spawn_logger(),
wait_for_test_procs(), %% Ensure previous case cleaned up
- put('__ETS_TEST_CASE__', Case),
[{test_case, Case} | Config].
end_per_testcase(_Func, _Config) ->
@@ -134,9 +133,8 @@ all() ->
otp_9932,
otp_9423,
ets_all,
- take,
-
- memory_check_summary]. % MUST BE LAST
+ massive_ets_all,
+ take].
groups() ->
[{new, [],
@@ -181,27 +179,6 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-%% Test that we did not have "too many" failed verify_etsmem()'s
-%% in the test suite.
-%% verify_etsmem() may give a low number of false positives
-%% as concurrent activities, such as lingering processes
-%% from earlier test suites, may do unrelated ets (de)allocations.
-memory_check_summary(_Config) ->
- case whereis(ets_test_spawn_logger) of
- undefined ->
- ct:fail("No spawn logger exist");
- _ ->
- ets_test_spawn_logger ! {self(), get_failed_memchecks},
- receive {get_failed_memchecks, FailedMemchecks} -> ok end,
- io:format("Failed memchecks: ~p\n",[FailedMemchecks]),
- NoFailedMemchecks = length(FailedMemchecks),
- if NoFailedMemchecks > 1 ->
- ct:fail("Too many failed (~p) memchecks", [NoFailedMemchecks]);
- true ->
- ok
- end
- end.
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -5545,6 +5522,68 @@ ets_all_run() ->
false = lists:member(Table, ets:all()),
ets_all_run().
+create_tables(N) ->
+ create_tables(N, []).
+
+create_tables(0, Ts) ->
+ Ts;
+create_tables(N, Ts) ->
+ create_tables(N-1, [ets:new(tjo, [])|Ts]).
+
+massive_ets_all(Config) when is_list(Config) ->
+ Me = self(),
+ InitTables = lists:sort(ets:all()),
+ io:format("InitTables=~p~n", [InitTables]),
+ PMs0 = lists:map(fun (Sid) ->
+ my_spawn_opt(fun () ->
+ Ts = create_tables(250),
+ Me ! {self(), up, Ts},
+ receive {Me, die} -> ok end
+ end,
+ [link, monitor, {scheduler, Sid}])
+ end,
+ lists:seq(1, erlang:system_info(schedulers_online))),
+ AllRes = lists:sort(lists:foldl(fun ({P, _M}, Ts) ->
+ receive
+ {P, up, PTs} ->
+ PTs ++ Ts
+ end
+ end,
+ InitTables,
+ PMs0)),
+ AllRes = lists:sort(ets:all()),
+ PMs1 = lists:map(fun (_) ->
+ my_spawn_opt(fun () ->
+ AllRes = lists:sort(ets:all())
+ end,
+ [link, monitor])
+ end, lists:seq(1, 50)),
+ lists:foreach(fun ({P, M}) ->
+ receive
+ {'DOWN', M, process, P, _} ->
+ ok
+ end
+ end, PMs1),
+ PMs2 = lists:map(fun (_) ->
+ my_spawn_opt(fun () ->
+ _ = ets:all()
+ end,
+ [link, monitor])
+ end, lists:seq(1, 50)),
+ lists:foreach(fun ({P, _M}) ->
+ P ! {Me, die}
+ end, PMs0),
+ lists:foreach(fun ({P, M}) ->
+ receive
+ {'DOWN', M, process, P, _} ->
+ ok
+ end
+ end, PMs0 ++ PMs2),
+ EndTables = lists:sort(ets:all()),
+ io:format("EndTables=~p~n", [EndTables]),
+ InitTables = EndTables,
+ ok.
+
take(Config) when is_list(Config) ->
%% Simple test for set tables.
@@ -5712,45 +5751,27 @@ etsmem() ->
{Bl0+Bl,BlSz0+BlSz}
end, {0,0}, CS)
end},
- {Mem,AllTabs, erts_debug:get_internal_state('DbTable_meta')}.
+ {Mem,AllTabs}.
-verify_etsmem(EtsMem) ->
+verify_etsmem({MemInfo,AllTabs}) ->
wait_for_test_procs(),
- verify_etsmem(EtsMem, false).
-
-verify_etsmem({MemInfo,AllTabs,MetaState}=EtsMem, Adjusted) ->
case etsmem() of
- {MemInfo,_,_} ->
+ {MemInfo,_} ->
io:format("Ets mem info: ~p", [MemInfo]),
case MemInfo of
{ErlMem,EtsAlloc} when ErlMem == notsup; EtsAlloc == undefined ->
%% Use 'erl +Mea max' to do more complete memory leak testing.
{comment,"Incomplete or no mem leak testing"};
_ ->
- case Adjusted of
- true ->
- {comment, "Meta state adjusted"};
- false ->
- ok
- end
+ ok
end;
- {MemInfo2, AllTabs2, MetaState2} ->
+ {MemInfo2, AllTabs2} ->
io:format("Expected: ~p", [MemInfo]),
io:format("Actual: ~p", [MemInfo2]),
io:format("Changed tables before: ~p\n",[AllTabs -- AllTabs2]),
io:format("Changed tables after: ~p\n", [AllTabs2 -- AllTabs]),
- io:format("Meta state before: ~p\n", [MetaState]),
- io:format("Meta state after: ~p\n", [MetaState2]),
- case {MetaState =:= MetaState2, Adjusted} of
- {false, false} ->
- io:format("Adjust meta state and retry...\n\n",[]),
- {ok,ok} = erts_debug:set_internal_state('DbTable_meta', MetaState),
- verify_etsmem(EtsMem, true);
- _ ->
- ets_test_spawn_logger ! {failed_memcheck, get('__ETS_TEST_CASE__')},
- {comment, "Failed memory check"}
- end
+ ct:fail("Failed memory check")
end.
@@ -5772,10 +5793,10 @@ stop_loopers(Loopers) ->
looper(Fun, State) ->
looper(Fun, Fun(State)).
-spawn_logger(Procs, FailedMemchecks) ->
+spawn_logger(Procs) ->
receive
{new_test_proc, Proc} ->
- spawn_logger([Proc|Procs], FailedMemchecks);
+ spawn_logger([Proc|Procs]);
{sync_test_procs, Kill, From} ->
lists:foreach(fun (Proc) when From == Proc ->
ok;
@@ -5799,14 +5820,7 @@ spawn_logger(Procs, FailedMemchecks) ->
end
end, Procs),
From ! test_procs_synced,
- spawn_logger([From], FailedMemchecks);
-
- {failed_memcheck, TestCase} ->
- spawn_logger(Procs, [TestCase|FailedMemchecks]);
-
- {Pid, get_failed_memchecks} ->
- Pid ! {get_failed_memchecks, FailedMemchecks},
- spawn_logger(Procs, FailedMemchecks)
+ spawn_logger([From])
end.
pid_status(Pid) ->
@@ -5822,7 +5836,7 @@ start_spawn_logger() ->
case whereis(ets_test_spawn_logger) of
Pid when is_pid(Pid) -> true;
_ -> register(ets_test_spawn_logger,
- spawn_opt(fun () -> spawn_logger([], []) end,
+ spawn_opt(fun () -> spawn_logger([]) end,
[{priority, max}]))
end.
diff --git a/system/doc/reference_manual/character_set.xml b/system/doc/reference_manual/character_set.xml
index f0f4c23608..1129ad63d8 100644
--- a/system/doc/reference_manual/character_set.xml
+++ b/system/doc/reference_manual/character_set.xml
@@ -102,13 +102,15 @@
<tcaption>Character Classes</tcaption>
</table>
<p>In Erlang/OTP R16B the syntax of Erlang tokens was extended to
- handle Unicode. The support is limited to
- string literals and comments. Atoms, module names, and
- function names are restricted to the ISO-Latin-1 range.
+ handle Unicode. The support was limited to
+ string literals and comments.
More about the usage of Unicode in Erlang source files
can be found in <seealso
marker="stdlib:unicode_usage#unicode_in_erlang">STDLIB's User's
Guide</seealso>.</p>
+ <p>From Erlang/OTP 20, atoms and function names are also allowed
+ to contain Unicode characters outside the ISO-Latin-1 range.
+ Module names are still restricted to the ISO-Latin-1 range.</p>
</section>
<section>
<title>Source File Encoding</title>